diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/CSS/Own.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/CSS/Own.hs
index 1aa439fe095..0e939761729 100644
--- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/CSS/Own.hs
+++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/CSS/Own.hs
@@ -177,7 +177,7 @@ span[data-tooltip] {
}
.rt-view-logs-input {
- max-width: 150px;
+ max-width: 200px;
}
.rt-view-error-msg-input {
@@ -317,6 +317,30 @@ span[data-tooltip] {
margin-top: 5px;
}
+.dark .rt-view-info-icon-on-button svg {
+ width: 20px;
+ color: whitesmoke;
+ margin-top: 6px;
+}
+
+.dark .rt-view-leader-icon-on-button svg {
+ width: 20px;
+ color: whitesmoke;
+ margin-top: 7px;
+}
+
+.dark .rt-view-leader-icon-2-on-button svg {
+ width: 14px;
+ color: whitesmoke;
+ margin-top: 7px;
+}
+
+.dark .rt-view-leader-icon-3-on-button svg {
+ width: 11px;
+ color: whitesmoke;
+ margin-top: 7px;
+}
+
.dark .rt-view-show-hide-pass-icon svg {
width: 20px;
cursor: pointer;
@@ -722,6 +746,30 @@ span[data-tooltip] {
margin-top: 5px;
}
+.light .rt-view-info-icon-on-button svg {
+ width: 20px;
+ color: whitesmoke;
+ margin-top: 6px;
+}
+
+.light .rt-view-leader-icon-on-button svg {
+ width: 20px;
+ color: whitesmoke;
+ margin-top: 7px;
+}
+
+.light .rt-view-leader-icon-2-on-button svg {
+ width: 14px;
+ color: whitesmoke;
+ margin-top: 7px;
+}
+
+.light .rt-view-leader-icon-3-on-button svg {
+ width: 11px;
+ color: whitesmoke;
+ margin-top: 7px;
+}
+
.light .rt-view-show-hide-pass-icon svg {
width: 20px;
cursor: pointer;
diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/Body.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/Body.hs
index 6c0ad816521..a7e34937259 100644
--- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/Body.hs
+++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/Body.hs
@@ -146,19 +146,9 @@ mkPageBody tracerEnv networkConfig dsIxs = do
]
]
, UI.mkElement "tbody" #+
- [ UI.tr ## "node-version-row" #+
- [ UI.td #+ [ image "rt-view-overview-icon" versionSVG
- , string "Version"
- ]
- ]
- , UI.tr ## "node-commit-row" #+
- [ UI.td #+ [ image "rt-view-overview-icon" commitSVG
- , string "Commit"
- ]
- ]
- , UI.tr ## "node-protocol-row" #+
- [ UI.td #+ [ image "rt-view-overview-icon" protocolSVG
- , string "Protocol"
+ [ UI.tr ## "node-basic-info-row" #+
+ [ UI.td #+ [ image "rt-view-overview-icon" infoSVG
+ , string "Basic info"
]
]
, UI.tr ## "node-era-row" #+
@@ -174,19 +164,19 @@ mkPageBody tracerEnv networkConfig dsIxs = do
<> " It can be outdated because of node's out of sync!")
]
]
+ , UI.tr ## "node-block-replay-row" #+
+ [ UI.td #+ [ image "rt-view-overview-icon" blocksSVG
+ , string "Block replay"
+ ]
+ ]
, UI.tr ## "node-sync-row" #+
[ UI.td #+ [ image "rt-view-overview-icon" refreshSVG
, string "Sync"
]
]
- , UI.tr ## "node-system-start-time-row" #+
- [ UI.td #+ [ image "rt-view-overview-icon" systemStartSVG
- , string "Blockchain start"
- ]
- ]
, UI.tr ## "node-start-time-row" #+
[ UI.td #+ [ image "rt-view-overview-icon" startSVG
- , string "Node start"
+ , string "Start time"
]
]
, UI.tr ## "node-uptime-row" #+
@@ -199,11 +189,6 @@ mkPageBody tracerEnv networkConfig dsIxs = do
, string "Logs"
]
]
- , UI.tr ## "node-block-replay-row" #+
- [ UI.td #+ [ image "rt-view-overview-icon" blocksSVG
- , string "Block replay"
- ]
- ]
--, UI.tr ## "node-chunk-validation-row" #+
-- [ UI.td #+ [ image "rt-view-overview-icon" dbSVG
-- , string "Chunk validation"
@@ -225,56 +210,18 @@ mkPageBody tracerEnv networkConfig dsIxs = do
]
]
, UI.tr ## "node-leadership-row" #+
- [ UI.td #+ [ image "rt-view-overview-icon" leaderSVG
+ [ UI.td #+ [ image "rt-view-overview-icon" firstSVG
, string "Leadership"
- , image "has-tooltip-multiline has-tooltip-right rt-view-what-icon" whatSVG
- # set dataTooltip "How many times this node was leader"
]
]
- , UI.tr ## "node-forged-blocks-row" #+
- [ UI.td #+ [ image "rt-view-overview-icon" forgeSVG
- , string "Forged blocks"
- , image "has-tooltip-multiline has-tooltip-right rt-view-what-icon" whatSVG
- # set dataTooltip "How many blocks did forge by this node"
+ , UI.tr ## "node-kes-row" #+
+ [ UI.td #+ [ image "rt-view-overview-icon" kesSVG
+ , string "KES"
]
]
- , UI.tr ## "node-cannot-forge-row" #+
- [ UI.td #+ [ image "rt-view-overview-icon" notForgeSVG
- , string "Cannot forge"
- , image "has-tooltip-multiline has-tooltip-right rt-view-what-icon" whatSVG
- # set dataTooltip "How many times this node could not forge"
- ]
- ]
- , UI.tr ## "node-missed-slots-row" #+
- [ UI.td #+ [ image "rt-view-overview-icon" missedSVG
- , string "Missed slots"
- , image "has-tooltip-multiline has-tooltip-right rt-view-what-icon" whatSVG
- # set dataTooltip "How many slots were missed by this node"
- ]
- ]
- , UI.tr ## "node-current-kes-period-row" #+
- [ UI.td #+ [ image "rt-view-overview-icon" certificateSVG
- , string "KES current"
- ]
- ]
- , UI.tr ## "node-op-cert-expiry-kes-period-row" #+
+ , UI.tr ## "node-op-cert-row" #+
[ UI.td #+ [ image "rt-view-overview-icon" certificateSVG
- , string "KES Expiry"
- ]
- ]
- , UI.tr ## "node-remaining-kes-periods-row" #+
- [ UI.td #+ [ image "rt-view-overview-icon" certificateSVG
- , string "Remainig KES"
- ]
- ]
- , UI.tr ## "node-op-cert-start-kes-period-row" #+
- [ UI.td #+ [ image "rt-view-overview-icon" certificateSVG
- , string "Op Cert Start KES"
- ]
- ]
- , UI.tr ## "node-days-until-op-cert-renew-row" #+
- [ UI.td #+ [ image "rt-view-overview-icon" endSVG
- , string "Days until Op Cert renew"
+ , string "Op Cert"
]
]
, UI.tr ## "node-ekg-metrics-row" #+
diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/Node/Column.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/Node/Column.hs
index 6f42e023d42..89881229123 100644
--- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/Node/Column.hs
+++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/Node/Column.hs
@@ -38,7 +38,15 @@ addNodeColumn tracerEnv loggingConfig nodesErrors updateErrorsTimer nodeId@(Node
nodeName <- liftIO $ askNodeName tracerEnv nodeId
let id' = unpack anId
+
+ bi <- basicInfo id'
+ st <- startTime id'
+ ut <- nodeUptime id'
ls <- logsSettings loggingConfig nodeName
+ leadership <- nodeLeadership id'
+ epoch <- nodeEpoch id'
+ kes <- nodeKES id'
+ opCert <- nodeOpCert id'
peersTable <- mkPeersTable id'
peersDetailsButton <- UI.button ## (id' <> "__node-peers-details-button")
@@ -69,48 +77,19 @@ addNodeColumn tracerEnv loggingConfig nodesErrors updateErrorsTimer nodeId@(Node
, image "has-tooltip-multiline has-tooltip-bottom rt-view-what-icon" whatSVG
# set dataTooltip "Node's name, taken from its configuration file"
]
- addNodeCell "version" [ UI.span ## (id' <> "__node-version")
- # set text "—"
- ]
- addNodeCell "commit" [ UI.anchor ## (id' <> "__node-commit")
- #. ("rt-view-href is-family-monospace has-text-weight-normal"
- <> " has-tooltip-multiline has-tooltip-right")
- # set UI.href "#"
- # set UI.target "_blank"
- # set dataTooltip "Browse cardano-node repository on this commit"
- # set text "—"
- , image "rt-view-href-icon" externalLinkSVG
- ]
- addNodeCell "protocol" [ UI.span ## (id' <> "__node-protocol")
- # set text "—"
- ]
- addNodeCell "era" [ UI.span ## (id' <> "__node-era")
- # set text "—"
+ addNodeCell "basic-info" bi
+ addNodeCell "era" [ UI.span ## (id' <> "__node-era") #. "has-text-weight-semibold" # set text "—"
]
- addNodeCell "epoch" [ string "#"
- , UI.span ## (id' <> "__node-epoch-num") # set text "—"
- , image "has-tooltip-multiline has-tooltip-top rt-view-epoch-end" endSVG
- # set dataTooltip "End date of this epoch"
- , UI.span ## (id' <> "__node-epoch-end") # set text "—"
- ]
- addNodeCell "sync" [ UI.span ## (id' <> "__node-sync-progress")
- # set text "—"
- ]
- addNodeCell "system-start-time" [ UI.span ## (id' <> "__node-system-start-time")
- # set text "—"
- ]
- addNodeCell "start-time" [ UI.span ## (id' <> "__node-start-time")
- # set text "—"
- ]
- addNodeCell "uptime" [ UI.span ## (id' <> "__node-uptime")
- # set text "—"
- ]
- addNodeCell "logs" [ UI.span ## (id' <> "__node-logs")
- #+ ls
- ]
+ addNodeCell "epoch" epoch
addNodeCell "block-replay" [ UI.span ## (id' <> "__node-block-replay")
# set html "0 %"
]
+ addNodeCell "sync" [ UI.span ## (id' <> "__node-sync-progress")
+ # set text "—"
+ ]
+ addNodeCell "start-time" st
+ addNodeCell "uptime" ut
+ addNodeCell "logs" ls
--addNodeCell "chunk-validation" [ UI.span ## (id' <> "__node-chunk-validation")
-- # set text "—"
-- ]
@@ -133,33 +112,9 @@ addNodeColumn tracerEnv loggingConfig nodesErrors updateErrorsTimer nodeId@(Node
]
, element errorsTable
]
- addNodeCell "leadership" [ UI.span ## (id' <> "__node-leadership")
- # set text "—"
- ]
- addNodeCell "forged-blocks" [ UI.span ## (id' <> "__node-forged-blocks")
- # set text "—"
- ]
- addNodeCell "cannot-forge" [ UI.span ## (id' <> "__node-cannot-forge")
- # set text "—"
- ]
- addNodeCell "missed-slots" [ UI.span ## (id' <> "__node-missed-slots")
- # set text "—"
- ]
- addNodeCell "current-kes-period" [ UI.span ## (id' <> "__node-current-kes-period")
- # set text "—"
- ]
- addNodeCell "op-cert-expiry-kes-period" [ UI.span ## (id' <> "__node-op-cert-expiry-kes-period")
- # set text "—"
- ]
- addNodeCell "remaining-kes-periods" [ UI.span ## (id' <> "__node-remaining-kes-periods")
- # set text "—"
- ]
- addNodeCell "op-cert-start-kes-period" [ UI.span ## (id' <> "__node-op-cert-start-kes-period")
- # set text "—"
- ]
- addNodeCell "days-until-op-cert-renew" [ UI.span ## (id' <> "__node-days-until-op-cert-renew")
- # set text "—"
- ]
+ addNodeCell "leadership" leadership
+ addNodeCell "kes" kes
+ addNodeCell "op-cert" opCert
addNodeCell "ekg-metrics" [ UI.div #. "buttons has-addons" #+
[ UI.button ## (id' <> "__node-ekg-metrics-num")
#. "button is-static"
@@ -182,6 +137,215 @@ addNodeColumn tracerEnv loggingConfig nodesErrors updateErrorsTimer nodeId@(Node
#+ cellContent
]
+basicInfo :: String -> UI [UI Element]
+basicInfo id' = return
+ [ UI.div #. "field is-grouped" #+
+ [ UI.p #. "control" #+
+ [ UI.div #. "tags has-addons" #+
+ [ UI.span #. "tag is-info is-medium" #+ [image "rt-view-info-icon-on-button" versionSVG]
+ , UI.span ## (id' <> "__node-version")
+ #. "tag is-medium has-tooltip-multiline has-tooltip-top"
+ # set dataTooltip "Node's version"
+ # set text "—"
+ ]
+ ]
+ , UI.p #. "control" #+
+ [ UI.div #. "tags has-addons" #+
+ [ UI.span #. "tag is-link is-medium" #+ [image "rt-view-info-icon-on-button" commitSVG]
+ , UI.span ## (id' <> "__node-commit")
+ #. "tag is-medium is-family-monospace has-tooltip-multiline has-tooltip-top"
+ # set dataTooltip "Node's commit hash"
+ # set text "—"
+ ]
+ ]
+ , UI.p #. "control" #+
+ [ UI.div #. "tags has-addons" #+
+ [ UI.span #. "tag is-success is-medium" #+ [image "rt-view-info-icon-on-button" protocolSVG]
+ , UI.span ## (id' <> "__node-protocol")
+ #. "tag is-medium has-tooltip-multiline has-tooltip-top"
+ # set dataTooltip "Node's protocol"
+ # set text "—"
+ ]
+ ]
+ ]
+ ]
+
+nodeEpoch :: String -> UI [UI Element]
+nodeEpoch id' = return
+ [ UI.div #. "field is-grouped" #+
+ [ UI.p #. "control" #+
+ [ UI.div #. "tags has-addons" #+
+ [ UI.span #. "tag is-info is-medium" #+ [image "rt-view-leader-icon-2-on-button" hashtagSVG]
+ , UI.span ## (id' <> "__node-epoch-num")
+ #. "tag is-medium"
+ # set text "—"
+ ]
+ ]
+ , UI.p #. "control" #+
+ [ UI.div #. "tags has-addons has-tooltip-multiline has-tooltip-top"
+ # set dataTooltip "End date of this epoch"
+ #+
+ [ UI.span #. "tag is-info is-medium" #+ [image "rt-view-leader-icon-2-on-button" endSVG]
+ , UI.span ## (id' <> "__node-epoch-end")
+ #. "tag is-medium"
+ # set text "—"
+ ]
+ ]
+ ]
+ ]
+
+nodeKES :: String -> UI [UI Element]
+nodeKES id' = return
+ [ UI.div #. "field is-grouped" #+
+ [ UI.p #. "control" #+
+ [ UI.div #. "tags has-addons has-tooltip-multiline has-tooltip-top"
+ # set dataTooltip "KES current"
+ #+
+ [ UI.span #. "tag is-info is-medium" #+ [image "rt-view-leader-icon-2-on-button" cSVG]
+ , UI.span ## (id' <> "__node-current-kes-period")
+ #. "tag is-medium"
+ # set text "—"
+ ]
+ ]
+ , UI.p #. "control" #+
+ [ UI.div #. "tags has-addons has-tooltip-multiline has-tooltip-top"
+ # set dataTooltip "KES expiry"
+ #+
+ [ UI.span #. "tag is-info is-medium" #+ [image "rt-view-leader-icon-3-on-button" eSVG]
+ , UI.span ## (id' <> "__node-op-cert-expiry-kes-period")
+ #. "tag is-medium"
+ # set text "—"
+ ]
+ ]
+ , UI.p #. "control" #+
+ [ UI.div #. "tags has-addons has-tooltip-multiline has-tooltip-top"
+ # set dataTooltip "KES remaining"
+ #+
+ [ UI.span #. "tag is-info is-medium" #+ [image "rt-view-leader-icon-3-on-button" rSVG]
+ , UI.span ## (id' <> "__node-remaining-kes-periods")
+ #. "tag is-medium"
+ # set text "—"
+ ]
+ ]
+ ]
+ ]
+
+nodeOpCert :: String -> UI [UI Element]
+nodeOpCert id' = return
+ [ UI.div #. "field is-grouped" #+
+ [ UI.p #. "control" #+
+ [ UI.div #. "tags has-addons has-tooltip-multiline has-tooltip-top"
+ # set dataTooltip "Op Cert start KES"
+ #+
+ [ UI.span #. "tag is-info is-medium" #+ [image "rt-view-leader-icon-2-on-button" start2SVG]
+ , UI.span ## (id' <> "__node-op-cert-start-kes-period")
+ #. "tag is-medium"
+ # set text "—"
+ ]
+ ]
+ , UI.p #. "control" #+
+ [ UI.div #. "tags has-addons has-tooltip-multiline has-tooltip-top"
+ # set dataTooltip "Days until Op Cert renew"
+ #+
+ [ UI.span #. "tag is-danger is-medium" #+ [image "rt-view-leader-icon-2-on-button" endSVG]
+ , UI.span ## (id' <> "__node-days-until-op-cert-renew")
+ #. "tag is-medium"
+ # set text "—"
+ ]
+ ]
+ ]
+ ]
+
+nodeLeadership :: String -> UI [UI Element]
+nodeLeadership id' = return
+ [ UI.div #. "field is-grouped" #+
+ [ UI.p #. "control" #+
+ [ UI.div #. "tags has-addons has-tooltip-multiline has-tooltip-top"
+ # set dataTooltip "How many times this node was a leader"
+ #+
+ [ UI.span #. "tag is-info is-medium" #+ [image "rt-view-leader-icon-on-button" leaderSVG]
+ , UI.span ## (id' <> "__node-leadership")
+ #. "tag is-medium"
+ # set text "—"
+ ]
+ ]
+ , UI.p #. "control" #+
+ [ UI.div #. "tags has-addons has-tooltip-multiline has-tooltip-top"
+ # set dataTooltip "How many blocks were forge by this node"
+ #+
+ [ UI.span #. "tag is-info is-medium" #+ [image "rt-view-leader-icon-on-button" forgeSVG]
+ , UI.span ## (id' <> "__node-forged-blocks")
+ #. "tag is-medium"
+ # set text "—"
+ ]
+ ]
+ , UI.p #. "control" #+
+ [ UI.div #. "tags has-addons has-tooltip-multiline has-tooltip-top"
+ # set dataTooltip "How many times this node could not forge"
+ #+
+ [ UI.span #. "tag is-danger is-medium" #+ [image "rt-view-leader-icon-on-button" notForgeSVG]
+ , UI.span ## (id' <> "__node-cannot-forge")
+ #. "tag is-medium"
+ # set text "—"
+ ]
+ ]
+ , UI.p #. "control" #+
+ [ UI.div #. "tags has-addons has-tooltip-multiline has-tooltip-top"
+ # set dataTooltip "How many slots were missed by this node"
+ #+
+ [ UI.span #. "tag is-danger is-medium" #+ [image "rt-view-leader-icon-2-on-button" missedSVG]
+ , UI.span ## (id' <> "__node-missed-slots")
+ #. "tag is-medium"
+ # set text "—"
+ ]
+ ]
+ ]
+ ]
+
+startTime :: String -> UI [UI Element]
+startTime id' = return
+ [ UI.div #. "field is-grouped" #+
+ [ UI.p #. "control" #+
+ [ UI.div #. "tags has-addons has-tooltip-multiline has-tooltip-top"
+ # set dataTooltip "Blockchain's start time in UTC"
+ #+
+ [ UI.span #. "tag is-primary is-medium" #+ [image "rt-view-leader-icon-2-on-button" bSVG]
+ , UI.span ## (id' <> "__node-system-start-time")
+ #. "tag is-medium"
+ # set text "—"
+ ]
+ ]
+ , UI.p #. "control" #+
+ [ UI.div #. "tags has-addons has-tooltip-multiline has-tooltip-top"
+ # set dataTooltip "Node's start time in UTC"
+ #+
+ [ UI.span #. "tag is-primary is-medium" #+ [image "rt-view-leader-icon-2-on-button" nSVG]
+ , UI.span ## (id' <> "__node-start-time")
+ #. "tag is-medium"
+ # set text "—"
+ ]
+ ]
+ ]
+ ]
+
+nodeUptime :: String -> UI [UI Element]
+nodeUptime id' = return
+ [ UI.div #. "field is-grouped" #+
+ [ UI.p #. "control" #+
+ [ UI.span ## (id' <> "__node-uptime-days") #. "tag is-medium is-link" # set text "—"
+ ]
+ , UI.p #. "control" #+
+ [ UI.span ## (id' <> "__node-uptime-hours") #. "tag is-medium is-link" # set text "—"
+ ]
+ , UI.p #. "control" #+
+ [ UI.span ## (id' <> "__node-uptime-mins") #. "tag is-medium is-link" # set text "—"
+ ]
+ , UI.p #. "control" #+
+ [ UI.span ## (id' <> "__node-uptime-secs") #. "tag is-medium is-link" # set text "—"
+ ]
+ ]
+ ]
+
-- | The new node is already connected, so we can display its logging settings.
logsSettings
:: NonEmpty LoggingParams
diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/Img/Icons.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/Img/Icons.hs
index 9f8638dc377..dd4d77bf543 100644
--- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/Img/Icons.hs
+++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/Img/Icons.hs
@@ -31,6 +31,7 @@ module Cardano.Tracer.Handlers.RTView.UI.Img.Icons
, whatSVG
, versionSVG
, startSVG
+ , start2SVG
, systemStartSVG
, uptimeSVG
, logsSVG
@@ -45,6 +46,7 @@ module Cardano.Tracer.Handlers.RTView.UI.Img.Icons
, refreshSVG
, timeRangeSVG
, leaderSVG
+ , firstSVG
, forgeSVG
, notForgeSVG
, missedSVG
@@ -62,6 +64,13 @@ module Cardano.Tracer.Handlers.RTView.UI.Img.Icons
, settingsSVG
, exportSVG
, docSVG
+ , infoSVG
+ , hashtagSVG
+ , bSVG
+ , nSVG
+ , cSVG
+ , eSVG
+ , rSVG
) where
import Data.String.QQ
@@ -211,11 +220,46 @@ startSVG = [s|
|]
+start2SVG :: String
+start2SVG = [s|
+
+|]
+
systemStartSVG :: String
systemStartSVG = [s|
|]
+hashtagSVG :: String
+hashtagSVG = [s|
+
+|]
+
+bSVG :: String
+bSVG = [s|
+
+|]
+
+nSVG :: String
+nSVG = [s|
+
+|]
+
+cSVG :: String
+cSVG = [s|
+
+|]
+
+eSVG :: String
+eSVG = [s|
+
+|]
+
+rSVG :: String
+rSVG = [s|
+
+|]
+
uptimeSVG :: String
uptimeSVG = [s|
@@ -281,6 +325,11 @@ leaderSVG = [s|
|]
+firstSVG :: String
+firstSVG = [s|
+
+|]
+
forgeSVG :: String
forgeSVG = [s|
@@ -366,6 +415,11 @@ docSVG = [s|
|]
+infoSVG :: String
+infoSVG = [s|
+
+|]
+
rectangleSVG :: String
rectangleSVG = [s|
diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/KES.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/KES.hs
index 87a2e12f44d..9efd16420f3 100644
--- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/KES.hs
+++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/KES.hs
@@ -29,7 +29,7 @@ updateKESInfo
-> DisplayedElements
-> UI ()
updateKESInfo tracerEnv settings displayed =
- forAcceptedMetricsUI_ tracerEnv $ \(nodeId@(NodeId anId), (ekgStore, _)) ->
+ forAcceptedMetricsUI_ tracerEnv $ \(nodeId@(NodeId anId), (ekgStore, _)) ->
forMM_ (liftIO $ getListOfMetrics ekgStore) $ \(metricName, metricValue) ->
case metricName of
"Forge.CurrentKESPeriod" ->
diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/NodeInfo.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/NodeInfo.hs
index 5bdacd6b705..4821771256d 100644
--- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/NodeInfo.hs
+++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/NodeInfo.hs
@@ -10,7 +10,6 @@ import Control.Monad.Extra (whenJustM)
import Data.Set (Set)
import qualified Data.Text as T
import Data.Time.Format (defaultTimeLocale, formatTime)
-import qualified Graphics.UI.Threepenny as UI
import Graphics.UI.Threepenny.Core
import Cardano.Node.Startup (NodeInfo (..))
@@ -41,11 +40,9 @@ askNSetNodeInfo TracerEnv{teDPRequestors, teCurrentDPLock} newlyConnected displa
, (anId <> "__node-name-for-errors", shortName)
]
- window <- askWindow
- findAndSet (set UI.href $ nodeLink (niCommit ni)) window (anId <> "__node-commit")
-
setProtocol (niProtocol ni) (anId <> "__node-protocol")
+ window <- askWindow
let nodeStartElId = anId <> "__node-start-time"
setTime window (niStartTime ni) nodeStartElId
setTime window (niSystemStartTime ni) (anId <> "__node-system-start-time")
@@ -53,8 +50,6 @@ askNSetNodeInfo TracerEnv{teDPRequestors, teCurrentDPLock} newlyConnected displa
liftIO $ saveDisplayedValue displayedElements nodeId nodeStartElId (T.pack . show $ niStartTime ni)
liftIO $ saveDisplayedValue displayedElements nodeId nodeNameElId (niName ni)
where
- nodeLink commit = T.unpack $ "https://github.com/input-output-hk/cardano-node/commit/" <> T.take 7 commit
-
setProtocol p id' = do
justCleanText id'
case p of
@@ -64,8 +59,5 @@ askNSetNodeInfo TracerEnv{teDPRequestors, teCurrentDPLock} newlyConnected displa
setTime window ts id' = do
justCleanText id'
- let time = formatTime defaultTimeLocale "%b %e, %Y %T" ts
- tz = formatTime defaultTimeLocale "%Z" ts
- findAndAdd [ string time
- , UI.span #. "has-text-weight-normal is-size-6 ml-2" # set text tz
- ] window id'
+ let time = formatTime defaultTimeLocale "%D %T" ts
+ findAndAdd [string time] window id'
diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Nodes.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Nodes.hs
index dba01f7c249..d23d2d63014 100644
--- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Nodes.hs
+++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Nodes.hs
@@ -18,7 +18,7 @@ import Control.Monad.Extra (whenJust)
import Data.List (find)
import Data.List.NonEmpty (NonEmpty)
import qualified Data.Map.Strict as M
-import Data.Maybe (catMaybes, fromMaybe)
+import Data.Maybe (fromMaybe)
import Data.Set (Set, (\\))
import qualified Data.Set as S
import qualified Data.Text as T
@@ -48,6 +48,7 @@ import Cardano.Tracer.Handlers.RTView.Update.NodeInfo
import Cardano.Tracer.Handlers.RTView.Update.Utils
import Cardano.Tracer.Handlers.RTView.Utils
import Cardano.Tracer.Types
+import Cardano.Tracer.Utils
updateNodesUI
:: TracerEnv
@@ -152,27 +153,32 @@ updateNodesUptime
updateNodesUptime tracerEnv displayedElements = do
now <- systemToUTCTime <$> liftIO getSystemTime
displayed <- liftIO $ readTVarIO displayedElements
- elsIdsWithUptimes <- forConnectedUI tracerEnv $ getUptimeForNode now displayed
- setTextValues $ catMaybes elsIdsWithUptimes
+ forConnectedUI_ tracerEnv $ getUptimeForNode now displayed
where
- getUptimeForNode now displayed nodeId@(NodeId anId) = do
- let nodeStartElId = anId <> "__node-start-time"
- nodeUptimeElId = anId <> "__node-uptime"
+ getUptimeForNode now displayed nodeId@(NodeId anId) = do
+ let nodeStartElId = anId <> "__node-start-time"
+ nodeUptimeDElId = anId <> "__node-uptime-days"
+ nodeUptimeHElId = anId <> "__node-uptime-hours"
+ nodeUptimeMElId = anId <> "__node-uptime-mins"
+ nodeUptimeSElId = anId <> "__node-uptime-secs"
case getDisplayedValuePure displayed nodeId nodeStartElId of
- Nothing -> return Nothing
- Just tsRaw ->
- case readMaybe (T.unpack tsRaw) of
- Nothing -> return Nothing
- Just (startTime :: UTCTime) -> do
- let uptimeDiff = now `diffUTCTime` startTime
- uptime = uptimeDiff `addUTCTime` nullTime
- uptimeFormatted = formatTime defaultTimeLocale "%X" uptime
- daysNum = utctDay uptime `diffDays` utctDay nullTime
- uptimeWithDays = if daysNum > 0
- -- Show days only if 'uptime' > 23:59:59.
- then show daysNum <> "d " <> uptimeFormatted
- else uptimeFormatted
- return $ Just (nodeUptimeElId, T.pack uptimeWithDays)
+ Nothing -> return ()
+ Just tsRaw ->
+ case readMaybe (T.unpack tsRaw) of
+ Nothing -> return ()
+ Just (startTime :: UTCTime) -> do
+ let uptimeDiff = now `diffUTCTime` startTime
+ uptime = uptimeDiff `addUTCTime` nullTime
+ hoursNum = formatTime defaultTimeLocale "%H" uptime
+ minsNum = formatTime defaultTimeLocale "%M" uptime
+ secsNum = formatTime defaultTimeLocale "%S" uptime
+ daysNum = utctDay uptime `diffDays` utctDay nullTime
+ setTextValues
+ [ (nodeUptimeDElId, showT daysNum <> "d")
+ , (nodeUptimeHElId, T.pack hoursNum <> "h")
+ , (nodeUptimeMElId, T.pack minsNum <> "m")
+ , (nodeUptimeSElId, T.pack secsNum <> "s")
+ ]
setBlockReplayProgress
:: Set NodeId