{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Cardano.RTView.GUI.Grid
    ( mkNodesGrid
    , metricLabel
    , allMetricsNames
    ) where

import           Cardano.Prelude
import           Prelude (String)

import           Data.Map.Strict ((!))
import qualified Data.Map.Strict as Map
import qualified Data.Text as T

import qualified Graphics.UI.Threepenny as UI
import           Graphics.UI.Threepenny.Core (Element, UI, element, set, string, ( # ), ( #+ ),
                                              ( #. ))

import           Cardano.RTView.GUI.Elements (ElementName (..), HTMLClass (..),
                                              HTMLId (..), HTMLW3Class (..),
                                              NodeStateElements, NodesStateElements,
                                              PeerInfoItem (..), ( ## ), (<+>))
import           Cardano.BM.Data.Configuration (RemoteAddrNamed (..))

mkNodesGrid
  :: UI.Window
  -> [RemoteAddrNamed]
  -> UI (Element, NodesStateElements)
mkNodesGrid :: Window -> [RemoteAddrNamed] -> UI (Element, NodesStateElements)
mkNodesGrid Window
_window [RemoteAddrNamed]
acceptors = do
  NodesStateElements
nodesEls
    <- [RemoteAddrNamed]
-> (RemoteAddrNamed
    -> UI (Text, NodeStateElements, [PeerInfoItem]))
-> UI NodesStateElements
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [RemoteAddrNamed]
acceptors ((RemoteAddrNamed -> UI (Text, NodeStateElements, [PeerInfoItem]))
 -> UI NodesStateElements)
-> (RemoteAddrNamed
    -> UI (Text, NodeStateElements, [PeerInfoItem]))
-> UI NodesStateElements
forall a b. (a -> b) -> a -> b
$ \(RemoteAddrNamed Text
nameOfNode RemoteAddr
_) -> do
         NodeStateElements
nodeEls <- Text -> UI NodeStateElements
mkNodeElements Text
nameOfNode
         (Text, NodeStateElements, [PeerInfoItem])
-> UI (Text, NodeStateElements, [PeerInfoItem])
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
nameOfNode, NodeStateElements
nodeEls, [])

  [UI Element]
nodesRowCells <- [RemoteAddrNamed] -> UI [UI Element]
mkNodesRowCells [RemoteAddrNamed]
acceptors

  [UI Element]
metricRows <-
    [ElementName]
-> (ElementName -> UI (UI Element)) -> UI [UI Element]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [ElementName]
allMetricsNames ((ElementName -> UI (UI Element)) -> UI [UI Element])
-> (ElementName -> UI (UI Element)) -> UI [UI Element]
forall a b. (a -> b) -> a -> b
$ \ElementName
aName -> do
      [UI Element]
row <- NodesStateElements -> ElementName -> UI [UI Element]
mkRowCells NodesStateElements
nodesEls ElementName
aName
      Element -> UI Element
forall (m :: * -> *) w. (MonadIO m, Widget w) => w -> m Element
element (Element -> UI Element) -> UI Element -> UI (UI Element)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UI Element
UI.tr UI Element -> String -> UI Element
## ElementName -> String
forall a b. (Show a, ConvertText String b) => a -> b
show ElementName
aName UI Element -> [UI Element] -> UI Element
#+ [UI Element]
row
  let allRows :: [UI Element]
allRows = UI Element
UI.tr UI Element -> [UI Element] -> UI Element
#+ [UI Element]
nodesRowCells UI Element -> [UI Element] -> [UI Element]
forall a. a -> [a] -> [a]
: [UI Element]
metricRows

  Element
nodesGrid
    <- UI Element
UI.div UI Element -> String -> UI Element
#. [HTMLW3Class
W3Container, HTMLW3Class
W3Margin] [HTMLW3Class] -> [HTMLClass] -> String
<+> [] UI Element -> [UI Element] -> UI Element
#+
         [ UI Element
UI.div UI Element -> String -> UI Element
#. HTMLW3Class -> String
forall a b. (Show a, ConvertText String b) => a -> b
show HTMLW3Class
W3Responsive UI Element -> [UI Element] -> UI Element
#+
             [ UI Element
UI.table UI Element -> String -> UI Element
#. [HTMLW3Class
W3Table, HTMLW3Class
W3Bordered] [HTMLW3Class] -> [HTMLClass] -> String
<+> [] UI Element -> [UI Element] -> UI Element
#+
                 [UI Element]
allRows
             ]
         ]

  (Element, NodesStateElements) -> UI (Element, NodesStateElements)
forall (m :: * -> *) a. Monad m => a -> m a
return (Element
nodesGrid, NodesStateElements
nodesEls)

metricLabel :: ElementName -> (String, String)
metricLabel :: ElementName -> (String, String)
metricLabel ElementName
ElNodeProtocol          = (String
"Node protocol", String
"Node's protocol")
metricLabel ElementName
ElNodeVersion           = (String
"Node version", String
"Version of the node")
metricLabel ElementName
ElNodePlatform          = (String
"Node platform", String
"Platform the node is working on")
metricLabel ElementName
ElNodeCommitHref        = (String
"Node commit", String
"Git commit the node was built from")
metricLabel ElementName
ElUptime                = (String
"Node uptime", String
"How long the node is working")
metricLabel ElementName
ElTraceAcceptorEndpoint = (String
"Node endpoint", String
"Socket/pipe used to connect the node with RTView")
metricLabel ElementName
ElPeersNumber           = (String
"Peers number", String
"Number of peers connected to the node")
metricLabel ElementName
ElOpCertStartKESPeriod  = (String
"Start KES period", String
"Certificate KES start period")
metricLabel ElementName
ElCurrentKESPeriod      = (String
"Current KES period", String
"Current KES period")
metricLabel ElementName
ElRemainingKESPeriods   = (String
"KES remaining periods", String
"KES periods until expiry")
metricLabel ElementName
ElMemoryUsageChart      = (String
"Memory usage", String
"Memory used by the node, in MB")
metricLabel ElementName
ElCPUUsageChart         = (String
"CPU usage", String
"CPU used by the node, in percents")
metricLabel ElementName
ElDiskUsageChart        = (String
"Disk usage", String
"Node's disk operations, both READ and WRITE")
metricLabel ElementName
ElNetworkUsageChart     = (String
"Network usage", String
"Node's network operations, both IN and OUT")
metricLabel ElementName
ElEpoch                 = (String
"Epoch", String
"Number of current epoch")
metricLabel ElementName
ElSlot                  = (String
"Slot in epoch", String
"Number of the current slot in this epoch")
metricLabel ElementName
ElChainDensity          = (String
"Chain density", String
"Chain density, in percents")
metricLabel ElementName
ElBlocksNumber          = (String
"Blocks number", String
"Total number of blocks in this blockchain")
metricLabel ElementName
ElBlocksForgedNumber    = (String
"Forged blocks number", String
"Number of blocks forged by this node")
metricLabel ElementName
ElNodeCannotForge       = (String
"Cannot forge, number", String
"Number of slots when this node was a leader but because of misconfiguration, it's impossible to forge a new block")
metricLabel ElementName
ElNodeIsLeaderNumber    = (String
"Slot leader, number", String
"Number of slots when this node was a leader")
metricLabel ElementName
ElSlotsMissedNumber     = (String
"Missed slots number", String
"Number of slots when this node was a leader but didn't forge a new block")
metricLabel ElementName
ElTxsProcessed          = (String
"TXs processed", String
"Number of processed transactions in this blockchain (these transactions are already removed from the mempool")
metricLabel ElementName
ElMempoolTxsNumber      = (String
"TXs in mempool, number", String
"Number of transactions in the mempool")
metricLabel ElementName
ElMempoolBytes          = (String
"Txs in mempool, bytes", String
"Size of all transactions in the mempool, in bytes")
metricLabel ElementName
ElRTSGcCpu              = (String
"GC CPU time", String
"Total CPU time used by the GC, in seconds")
metricLabel ElementName
ElRTSGcElapsed          = (String
"GC time elapsed", String
"Total elapsed time used by the GC, in seconds")
metricLabel ElementName
ElRTSGcNum              = (String
"Number of GC runs", String
"Total number of GCs")
metricLabel ElementName
ElRTSGcMajorNum         = (String
"Major GC runs", String
"Total number of major (oldest generation) GCs")
metricLabel ElementName
_                       = (String
"", String
"")

allMetricsNames :: [ElementName]
allMetricsNames :: [ElementName]
allMetricsNames =
  [ ElementName
ElNodeProtocol
  , ElementName
ElNodeVersion
  , ElementName
ElNodePlatform
  , ElementName
ElNodeCommitHref
  , ElementName
ElUptime
  , ElementName
ElTraceAcceptorEndpoint
  , ElementName
ElPeersNumber
  , ElementName
ElOpCertStartKESPeriod
  , ElementName
ElCurrentKESPeriod
  , ElementName
ElRemainingKESPeriods
  , ElementName
ElMemoryUsageChart
  , ElementName
ElCPUUsageChart
  , ElementName
ElDiskUsageChart
  , ElementName
ElNetworkUsageChart
  , ElementName
ElEpoch
  , ElementName
ElSlot
  , ElementName
ElBlocksNumber
  , ElementName
ElBlocksForgedNumber
  , ElementName
ElNodeCannotForge
  , ElementName
ElChainDensity
  , ElementName
ElNodeIsLeaderNumber
  , ElementName
ElSlotsMissedNumber
  , ElementName
ElTxsProcessed
  , ElementName
ElMempoolTxsNumber
  , ElementName
ElMempoolBytes
  , ElementName
ElRTSGcCpu
  , ElementName
ElRTSGcElapsed
  , ElementName
ElRTSGcNum
  , ElementName
ElRTSGcMajorNum
  ]

mkNodesRowCells
  :: [RemoteAddrNamed]
  -> UI [UI Element]
mkNodesRowCells :: [RemoteAddrNamed] -> UI [UI Element]
mkNodesRowCells [RemoteAddrNamed]
acceptors = do
  [UI Element]
nodesRowCells
    <- [RemoteAddrNamed]
-> (RemoteAddrNamed -> UI (UI Element)) -> UI [UI Element]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [RemoteAddrNamed]
acceptors ((RemoteAddrNamed -> UI (UI Element)) -> UI [UI Element])
-> (RemoteAddrNamed -> UI (UI Element)) -> UI [UI Element]
forall a b. (a -> b) -> a -> b
$ \(RemoteAddrNamed Text
nameOfNode RemoteAddr
_) ->
         Element -> UI Element
forall (m :: * -> *) w. (MonadIO m, Widget w) => w -> m Element
element (Element -> UI Element) -> UI Element -> UI (UI Element)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UI Element
UI.th UI Element -> String -> UI Element
## (HTMLId -> String
forall a b. (Show a, ConvertText String b) => a -> b
show HTMLId
GridNodeTH String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
nameOfNode) UI Element -> [UI Element] -> UI Element
#+
                       [ UI Element
UI.span UI Element -> String -> UI Element
#. HTMLClass -> String
forall a b. (Show a, ConvertText String b) => a -> b
show HTMLClass
GridNodeNameLabel UI Element -> [UI Element] -> UI Element
#+ [String -> UI Element
string String
"Node: "]
                       , String -> UI Element
string (String -> UI Element) -> String -> UI Element
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
nameOfNode
                       ]
  -- To keep top-left corner cell empty.
  UI Element
emptyRowCell <- Element -> UI Element
forall (m :: * -> *) w. (MonadIO m, Widget w) => w -> m Element
element (Element -> UI Element) -> UI Element -> UI (UI Element)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UI Element
UI.th UI Element -> [UI Element] -> UI Element
#+ [UI Element
UI.span UI Element -> (UI Element -> UI Element) -> UI Element
forall a b. a -> (a -> b) -> b
# ReadWriteAttr Element String ()
-> String -> UI Element -> UI Element
forall x i o. ReadWriteAttr x i o -> i -> UI x -> UI x
set ReadWriteAttr Element String ()
UI.html String
"&nbsp;" UI Element -> [UI Element] -> UI Element
#+ []]
  [UI Element] -> UI [UI Element]
forall (m :: * -> *) a. Monad m => a -> m a
return ([UI Element] -> UI [UI Element])
-> [UI Element] -> UI [UI Element]
forall a b. (a -> b) -> a -> b
$ UI Element
emptyRowCell UI Element -> [UI Element] -> [UI Element]
forall a. a -> [a] -> [a]
: [UI Element]
nodesRowCells

mkRowCells
  :: [(Text, NodeStateElements, [PeerInfoItem])]
  -> ElementName
  -> UI [UI Element]
mkRowCells :: NodesStateElements -> ElementName -> UI [UI Element]
mkRowCells NodesStateElements
nodesElements ElementName
elemName = do
  UI Element
tagTd <- Element -> UI Element
forall (m :: * -> *) w. (MonadIO m, Widget w) => w -> m Element
element (Element -> UI Element) -> UI Element -> UI (UI Element)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UI Element
UI.td UI Element -> [UI Element] -> UI Element
#+ [String -> UI Element
string ((String, String) -> String
forall a b. (a, b) -> a
fst ((String, String) -> String) -> (String, String) -> String
forall a b. (a -> b) -> a -> b
$ ElementName -> (String, String)
metricLabel ElementName
elemName)
                                        # set UI.title__ (snd $ metricLabel elemName)]
  -- We specify HTML-id for each td because each td corresponds to "node column".
  -- It can be used to hide/show the whole column.
  [UI Element]
tds <- NodesStateElements
-> ((Text, NodeStateElements, [PeerInfoItem]) -> UI (UI Element))
-> UI [UI Element]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM NodesStateElements
nodesElements (((Text, NodeStateElements, [PeerInfoItem]) -> UI (UI Element))
 -> UI [UI Element])
-> ((Text, NodeStateElements, [PeerInfoItem]) -> UI (UI Element))
-> UI [UI Element]
forall a b. (a -> b) -> a -> b
$ \(Text
nameOfNode, NodeStateElements
nodeElements, [PeerInfoItem]
_) ->
           Element -> UI Element
forall (m :: * -> *) w. (MonadIO m, Widget w) => w -> m Element
element (Element -> UI Element) -> UI Element -> UI (UI Element)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UI Element
UI.td UI Element -> String -> UI Element
## (ElementName -> String
forall a b. (Show a, ConvertText String b) => a -> b
show ElementName
elemName String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"-" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
nameOfNode)
                             #. show GridRowCell
                             #+ [element $ nodeElements ! elemName]
  [UI Element] -> UI [UI Element]
forall (m :: * -> *) a. Monad m => a -> m a
return ([UI Element] -> UI [UI Element])
-> [UI Element] -> UI [UI Element]
forall a b. (a -> b) -> a -> b
$ UI Element
tagTd UI Element -> [UI Element] -> [UI Element]
forall a. a -> [a] -> [a]
: [UI Element]
tds

mkNodeElements
  :: Text
  -> UI NodeStateElements
mkNodeElements :: Text -> UI NodeStateElements
mkNodeElements Text
nameOfNode = do
  Element
elNodeProtocol <- String -> UI Element
string String
"-"
  Element
elNodeVersion  <- String -> UI Element
string String
"-"
  Element
elNodePlatform <- String -> UI Element
string String
"-"
  Element
elNodeCommitHref
    <- UI Element
UI.anchor UI Element -> (UI Element -> UI Element) -> UI Element
forall a b. a -> (a -> b) -> b
# ReadWriteAttr Element String ()
-> String -> UI Element -> UI Element
forall x i o. ReadWriteAttr x i o -> i -> UI x -> UI x
set ReadWriteAttr Element String ()
UI.href String
""
                 # set UI.target "_blank"
                 # set UI.title__ "Browse cardano-node repository on this commit"
                 #+ [string ""]
  Element
elUptime      <- String -> UI Element
string String
"00:00:00"
  Element
elTraceAcceptorEndpoint <- String -> UI Element
string String
"localhost:0"
  Element
elPeersNumber <- String -> UI Element
string String
"0"
  Element
elOpCertStartKESPeriod <- String -> UI Element
string String
"-"
  Element
elCurrentKESPeriod     <- String -> UI Element
string String
"-"
  Element
elRemainingKESPeriods  <- String -> UI Element
string String
"-"

  Element
elMemoryUsageChart
    <- UI Element
UI.canvas UI Element -> String -> UI Element
## (HTMLId -> String
forall a b. (Show a, ConvertText String b) => a -> b
show HTMLId
GridMemoryUsageChartId String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
nameOfNode)
                 #. show GridMemoryUsageChart
                 #+ []
  Element
elCPUUsageChart
    <- UI Element
UI.canvas UI Element -> String -> UI Element
## (HTMLId -> String
forall a b. (Show a, ConvertText String b) => a -> b
show HTMLId
GridCPUUsageChartId String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
nameOfNode)
                 #. show GridCPUUsageChart
                 #+ []
  Element
elDiskUsageChart
    <- UI Element
UI.canvas UI Element -> String -> UI Element
## (HTMLId -> String
forall a b. (Show a, ConvertText String b) => a -> b
show HTMLId
GridDiskUsageChartId String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
nameOfNode)
                 #. show GridDiskUsageChart
                 #+ []
  Element
elNetworkUsageChart
    <- UI Element
UI.canvas UI Element -> String -> UI Element
## (HTMLId -> String
forall a b. (Show a, ConvertText String b) => a -> b
show HTMLId
GridNetworkUsageChartId String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
nameOfNode)
                 #. show GridNetworkUsageChart
                 #+ []

  Element
elEpoch              <- String -> UI Element
string String
"0"
  Element
elSlot               <- String -> UI Element
string String
"0"
  Element
elBlocksNumber       <- String -> UI Element
string String
"0"
  Element
elBlocksForgedNumber <- String -> UI Element
string String
"0"
  Element
elNodeCannotForge    <- String -> UI Element
string String
"0"
  Element
elChainDensity       <- String -> UI Element
string String
"0"
  Element
elNodeIsLeaderNumber <- String -> UI Element
string String
"0"
  Element
elSlotsMissedNumber  <- String -> UI Element
string String
"0"
  Element
elTxsProcessed       <- String -> UI Element
string String
"0"
  Element
elMempoolTxsNumber   <- String -> UI Element
string String
"0"
  Element
elMempoolBytes       <- String -> UI Element
string String
"0"
  Element
elRTSGcCpu           <- String -> UI Element
string String
"0"
  Element
elRTSGcElapsed       <- String -> UI Element
string String
"0"
  Element
elRTSGcNum           <- String -> UI Element
string String
"0"
  Element
elRTSGcMajorNum      <- String -> UI Element
string String
"0"

  NodeStateElements -> UI NodeStateElements
forall (m :: * -> *) a. Monad m => a -> m a
return (NodeStateElements -> UI NodeStateElements)
-> NodeStateElements -> UI NodeStateElements
forall a b. (a -> b) -> a -> b
$
    [(ElementName, Element)] -> NodeStateElements
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
      [ (ElementName
ElNodeProtocol,          Element
elNodeProtocol)
      , (ElementName
ElNodeVersion,           Element
elNodeVersion)
      , (ElementName
ElNodePlatform,          Element
elNodePlatform)
      , (ElementName
ElNodeCommitHref,        Element
elNodeCommitHref)
      , (ElementName
ElUptime,                Element
elUptime)
      , (ElementName
ElTraceAcceptorEndpoint, Element
elTraceAcceptorEndpoint)
      , (ElementName
ElPeersNumber,           Element
elPeersNumber)
      , (ElementName
ElOpCertStartKESPeriod,  Element
elOpCertStartKESPeriod)
      , (ElementName
ElCurrentKESPeriod,      Element
elCurrentKESPeriod)
      , (ElementName
ElRemainingKESPeriods,   Element
elRemainingKESPeriods)
      , (ElementName
ElMemoryUsageChart,      Element
elMemoryUsageChart)
      , (ElementName
ElCPUUsageChart,         Element
elCPUUsageChart)
      , (ElementName
ElDiskUsageChart,        Element
elDiskUsageChart)
      , (ElementName
ElNetworkUsageChart,     Element
elNetworkUsageChart)
      , (ElementName
ElEpoch,                 Element
elEpoch)
      , (ElementName
ElSlot,                  Element
elSlot)
      , (ElementName
ElBlocksNumber,          Element
elBlocksNumber)
      , (ElementName
ElBlocksForgedNumber,    Element
elBlocksForgedNumber)
      , (ElementName
ElNodeCannotForge,       Element
elNodeCannotForge)
      , (ElementName
ElChainDensity,          Element
elChainDensity)
      , (ElementName
ElNodeIsLeaderNumber,    Element
elNodeIsLeaderNumber)
      , (ElementName
ElSlotsMissedNumber,     Element
elSlotsMissedNumber)
      , (ElementName
ElTxsProcessed,          Element
elTxsProcessed)
      , (ElementName
ElMempoolTxsNumber,      Element
elMempoolTxsNumber)
      , (ElementName
ElMempoolBytes,          Element
elMempoolBytes)
      , (ElementName
ElRTSGcCpu,              Element
elRTSGcCpu)
      , (ElementName
ElRTSGcElapsed,          Element
elRTSGcElapsed)
      , (ElementName
ElRTSGcNum,              Element
elRTSGcNum)
      , (ElementName
ElRTSGcMajorNum,         Element
elRTSGcMajorNum)
      ]