Merge #4293

4293: RTView: extended epoch info. r=denisshevchenko a=denisshevchenko Closes #3758 Now we display the number of current epoch, the time until it ends and its current progress (pct). Inspired by cardanoscan.io. Co-authored-by: Denis Shevchenko <denis.shevchenko@iohk.io>
IntersectMBO · Aug 12, 2022 · 7576d9b · 7576d9b
2 parents 2b6a78c + b63dd15
commit 7576d9b
Show file tree

Hide file tree

Showing 4 changed files with 90 additions and 23 deletions.
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
@@ -216,6 +216,38 @@ span[data-tooltip] {
   clear: right;
 }
 
+.rt-view-progress-container {
+  width: 110px;
+  background-color: #f5f5f5;
+  height: 32px;
+  position: relative;
+  border-radius: 4px;
+}
+
+.rt-view-progress-container-text {
+  position: absolute;
+  left: 0;
+  right: 0;
+  height: 100%;
+  border-radius: 4px;
+}
+
+.rt-view-progress-container-text-label {
+  display: flex;
+  height: 100%;
+  justify-content: center;
+  align-items: center;
+  border-radius: 4px;
+  color: #444;
+}
+
+.rt-view-loading-bar {
+  width: 0%;
+  height: 100%;
+  background-color: #f14668;
+  border-radius: 4px;
+}
+
 /* Dark Theme */
 
 .dark {

diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/Main.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/Main.hs
@@ -123,7 +123,7 @@ mkMainPage tracerEnv displayedElements nodesEraSettings reloadFlag
   on UI.tick uiEKGTimer . const $
     updateEKGMetrics tracerEnv
 
-  uiNodesTimer <- UI.timer # set UI.interval 1500
+  uiNodesTimer <- UI.timer # set UI.interval 1000
   on UI.tick uiNodesTimer . const $
     updateNodesUI
       tracerEnv

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
@@ -80,7 +80,7 @@ addNodeColumn tracerEnv loggingConfig nodesErrors updateErrorsTimer nodeId@(Node
   addNodeCell "basic-info" bi
   addNodeCell "era" [ UI.span ## (id' <> "__node-era") #. "has-text-weight-semibold" # set text "—"
                     ]
-  addNodeCell "epoch" epoch 
+  addNodeCell "epoch" epoch
   addNodeCell "block-replay" [ UI.span ## (id' <> "__node-block-replay")
                                        # set html "0&nbsp;%"
                              ]
@@ -89,7 +89,7 @@ addNodeColumn tracerEnv loggingConfig nodesErrors updateErrorsTimer nodeId@(Node
                      ]
   addNodeCell "start-time" st
   addNodeCell "uptime" ut
-  addNodeCell "logs" ls 
+  addNodeCell "logs" ls
   --addNodeCell "chunk-validation" [ UI.span ## (id' <> "__node-chunk-validation")
   --                                         # set text "—"
   --                               ]
@@ -114,7 +114,7 @@ addNodeColumn tracerEnv loggingConfig nodesErrors updateErrorsTimer nodeId@(Node
                        ]
   addNodeCell "leadership" leadership
   addNodeCell "kes" kes
-  addNodeCell "op-cert" opCert 
+  addNodeCell "op-cert" opCert
   addNodeCell "ekg-metrics" [ UI.div #. "buttons has-addons" #+
                                 [ UI.button ## (id' <> "__node-ekg-metrics-num")
                                             #. "button is-static"
@@ -183,14 +183,27 @@ nodeEpoch id' = return
           ]
       , UI.p #. "control" #+
           [ UI.div #. "tags has-addons has-tooltip-multiline has-tooltip-top"
-                   # set dataTooltip "End date of this epoch"
+                   # set dataTooltip "Current epoch ends..."
                    #+
               [ 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 "—"
               ]
           ]
+      , UI.p #. "control" #+
+          [ UI.div #. "rt-view-progress-container has-tooltip-multiline has-tooltip-top"
+                   # set dataTooltip "Current epoch progress"
+                   #+
+              [ UI.div #. "rt-view-progress-container-text" #+
+                  [ UI.div ## (id' <> "__node-epoch-progress-label")
+                           #. "rt-view-progress-container-text-label"
+                           # set text "0%"
+                  ]
+              , UI.div ## (id' <> "__node-epoch-progress")
+                       #. "rt-view-loading-bar"
+              ]
+          ]
       ]
   ]
 
@@ -206,7 +219,7 @@ nodeKES id' = return
                         #. "tag is-medium"
                         # set text "—"
               ]
-          ] 
+          ]
       , UI.p #. "control" #+
           [ UI.div #. "tags has-addons has-tooltip-multiline has-tooltip-top"
                    # set dataTooltip "KES expiry"
@@ -242,7 +255,7 @@ nodeOpCert id' = return
                         #. "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"

diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Nodes.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Update/Nodes.hs
@@ -22,14 +22,15 @@ import           Data.Maybe (fromMaybe)
 import           Data.Set (Set, (\\))
 import qualified Data.Set as S
 import qualified Data.Text as T
-import           Data.Text.Read (double)
+import           Data.Text.Read (decimal, double)
 import           Data.Time.Calendar (diffDays)
 import           Data.Time.Clock (UTCTime, addUTCTime, diffUTCTime, utctDay)
 import           Data.Time.Clock.System (getSystemTime, systemToUTCTime)
 import           Data.Time.Format (defaultTimeLocale, formatTime)
 import           Data.Word (Word64)
 import qualified Graphics.UI.Threepenny as UI
 import           Graphics.UI.Threepenny.Core
+import           Text.Printf (printf)
 import           Text.Read (readMaybe)
 
 import           Cardano.Tracer.Configuration
@@ -173,7 +174,7 @@ updateNodesUptime tracerEnv displayedElements = do
                 minsNum    = formatTime defaultTimeLocale "%M" uptime
                 secsNum    = formatTime defaultTimeLocale "%S" uptime
                 daysNum    = utctDay uptime `diffDays` utctDay nullTime
-            setTextValues 
+            setTextValues
               [ (nodeUptimeDElId, showT daysNum   <> "d")
               , (nodeUptimeHElId, T.pack hoursNum <> "h")
               , (nodeUptimeMElId, T.pack minsNum  <> "m")
@@ -297,24 +298,31 @@ setEraEpochInfo connected displayed acceptedMetrics nodesEraSettings = do
     whenJust (M.lookup nodeId allSettings) $ \settings -> do
       setDisplayedValue nodeId displayed (anId <> "__node-era") $ esEra settings
       updateEpochInfo settings nodeId epochS
+      updateEpochSlotProgress settings nodeId allMetrics
  where
   updateEpochInfo settings (NodeId anId) epochS =
     unless (T.null epochS) $ do
       let epochNum = readInt epochS 0
-      case getEndOfCurrentEpoch settings epochNum of
-        Nothing -> return ()
-        Just (_start, end) -> do
-          setTextValue (anId <> "__node-epoch-end") $
-                       T.pack $ formatTime defaultTimeLocale "%D %T" end
-          {-
-          let elapsedSecondsFromEpochStart = nesSlotLengthInS settings * slotInEpoch
-              diffFromEndToStart = end `diffUTCTime` start
-              elapsed = secondsToNominalDiffTime (fromIntegral elapsedSecondsFromEpochStart)
-              diffFromNowToEnd = diffFromEndToStart - elapsed
-              timeLeft = diffFromNowToEnd `addUTCTime` nullTime
-              timeLeftF = T.pack $ formatTime defaultTimeLocale "%d:%H:%M:%S" timeLeft
-          setTextValue (anId <> "__node-epoch-end") timeLeftF
-          -}
+      whenJust (getEndOfCurrentEpoch settings epochNum) $ \(start, end) -> do
+        now <- systemToUTCTime <$> liftIO getSystemTime
+        if start < now && now < end
+          then do
+            -- We're synced and on the current epoch.
+            let diffFromNowToEnd = end `diffUTCTime` now
+                timeLeft  = diffFromNowToEnd `addUTCTime` nullTime
+                daysNum   = utctDay timeLeft `diffDays` utctDay nullTime
+                hoursNum   = formatTime defaultTimeLocale "%H" timeLeft
+                minsNum    = formatTime defaultTimeLocale "%M" timeLeft
+                secsNum    = formatTime defaultTimeLocale "%S" timeLeft
+                timeLeftF  =     showT daysNum  <> "d "
+                             <> T.pack hoursNum <> "h "
+                             <> T.pack minsNum  <> "m "
+                             <> T.pack secsNum  <> "s"
+            setTextValue (anId <> "__node-epoch-end") timeLeftF
+          else do
+            -- We're out of date (sync in progress), so just display the end date.
+            let endDateF = T.pack $ formatTime defaultTimeLocale "%D %T" end
+            setTextValue (anId <> "__node-epoch-end") endDateF
 
   getEndOfCurrentEpoch EraSettings{esEra, esSlotLengthInS, esEpochLength} currentEpoch =
     case lookup esEra epochsInfo of
@@ -334,6 +342,20 @@ setEraEpochInfo connected displayed acceptedMetrics nodesEraSettings = do
           !dateOfEpochEnd = dateOfEpochStart + fromIntegral epochLengthInS
       in Just (s2utc dateOfEpochStart, s2utc dateOfEpochEnd)
 
+  updateEpochSlotProgress EraSettings{esEpochLength} nodeId@(NodeId anId) allMetrics =
+    whenJust (M.lookup nodeId allMetrics) $ \(ekgStore, _) -> do
+      metrics <- liftIO $ getListOfMetrics ekgStore
+      whenJust (lookup "ChainDB.SlotInEpoch" metrics) $ \slotInEpochS ->
+        case decimal slotInEpochS of
+          Left _ -> return ()
+          Right (slotInEpoch :: Int, _) -> do
+            let slotsPct :: Double
+                slotsPct = fromIntegral slotInEpoch / fromIntegral (esEpochLength `div` 100)
+                slotsPctF = printf "%.1f" slotsPct <> "%"
+            setTextValue (anId <> "__node-epoch-progress-label") (T.pack slotsPctF)
+            window <- askWindow
+            findAndSet (set style [("width", slotsPctF)]) window (anId <> "__node-epoch-progress")
+
 type EraName         = T.Text
 type FirstEpochInEra = Int
 type EraStartPOSIX   = Word64