RTView: important fixes

cardano-tracer/bench/cardano-tracer-bench.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 import           Control.Concurrent.Extra (newLock)
+import           Control.Concurrent.STM.TVar (newTVarIO)
 import           Criterion.Main
 import qualified Data.List.NonEmpty as NE
 import           Data.Time.Clock (getCurrentTime)
@@ -29,7 +30,8 @@ main = do
   to100  <- generate 100
   to1000 <- generate 1000
 
-  connectedNodes  <- initConnectedNodes
+  connectedNodes <- initConnectedNodes
+  connectedNodesNames <- initConnectedNodesNames
   acceptedMetrics <- initAcceptedMetrics
   savedTO         <- initSavedTraceObjects
 
@@ -42,12 +44,15 @@ main = do
 
   currentLogLock <- newLock
   currentDPLock  <- newLock
-  eventsQueues   <- initEventsQueues dpRequestors currentDPLock
+  eventsQueues   <- initEventsQueues connectedNodesNames dpRequestors currentDPLock
+
+  rtViewPageOpened <- newTVarIO False
 
   let te1 =
         TracerEnv
           { teConfig            = c1
           , teConnectedNodes    = connectedNodes
+          , teConnectedNodesNames = connectedNodesNames
           , teAcceptedMetrics   = acceptedMetrics
           , teSavedTO           = savedTO
           , teBlockchainHistory = chainHistory
@@ -58,11 +63,13 @@ main = do
           , teEventsQueues      = eventsQueues
           , teDPRequestors      = dpRequestors
           , teProtocolsBrake    = protocolsBrake
+          , teRTViewPageOpened  = rtViewPageOpened
           }
       te2 =
         TracerEnv
           { teConfig            = c2
           , teConnectedNodes    = connectedNodes
+          , teConnectedNodesNames = connectedNodesNames
           , teAcceptedMetrics   = acceptedMetrics
           , teSavedTO           = savedTO
           , teBlockchainHistory = chainHistory
@@ -73,6 +80,7 @@ main = do
           , teEventsQueues      = eventsQueues
           , teDPRequestors      = dpRequestors
           , teProtocolsBrake    = protocolsBrake
+          , teRTViewPageOpened  = rtViewPageOpened
           }
 
   removePathForcibly root

cardano-tracer/cardano-tracer.cabal

@@ -121,6 +121,7 @@ library
                        , aeson-pretty
                        , async
                        , async-extras
+                       , bimap
                        , blaze-html
                        , blaze-markup
                        , bytestring
@@ -299,6 +300,7 @@ benchmark cardano-tracer-bench
                        , directory
                        , extra
                        , filepath
+                       , stm
                        , time
                        , trace-dispatcher
 

cardano-tracer/src/Cardano/Tracer/Acceptors/Utils.hs

@@ -10,6 +10,7 @@ module Cardano.Tracer.Acceptors.Utils
 
 import           Control.Concurrent.STM (atomically)
 import           Control.Concurrent.STM.TVar (TVar, newTVarIO, modifyTVar')
+import qualified Data.Bimap as BM
 import qualified Data.Map.Strict as M
 import qualified Data.Set as S
 import           Data.Time.Clock.System (getSystemTime, systemToUTCTime)
@@ -64,13 +65,15 @@ removeDisconnectedNode
   :: TracerEnv
   -> ConnectionId LocalAddress
   -> IO ()
-removeDisconnectedNode TracerEnv{teConnectedNodes, teAcceptedMetrics, teDPRequestors} connId =
+removeDisconnectedNode tracerEnv connId =
   -- Remove all the stuff related to disconnected node.
   atomically $ do
-    modifyTVar' teConnectedNodes  $ S.delete nodeId
-    modifyTVar' teAcceptedMetrics $ M.delete nodeId
-    modifyTVar' teDPRequestors    $ M.delete nodeId
+    modifyTVar' teConnectedNodes      $ S.delete  nodeId
+    modifyTVar' teConnectedNodesNames $ BM.delete nodeId
+    modifyTVar' teAcceptedMetrics     $ M.delete  nodeId
+    modifyTVar' teDPRequestors        $ M.delete  nodeId
  where
+  TracerEnv{teConnectedNodes, teConnectedNodesNames, teAcceptedMetrics, teDPRequestors} = tracerEnv
   nodeId = connIdToNodeId connId
 
 notifyAboutNodeDisconnected

cardano-tracer/src/Cardano/Tracer/Environment.hs

@@ -8,20 +8,23 @@ import           Cardano.Tracer.Configuration
 import           Cardano.Tracer.Handlers.RTView.Notifications.Types
 import           Cardano.Tracer.Handlers.RTView.State.Historical
 import           Cardano.Tracer.Handlers.RTView.State.TraceObjects
+import           Cardano.Tracer.Handlers.RTView.UI.Types
 import           Cardano.Tracer.Types
 
 -- | Environment for all functions.
 data TracerEnv = TracerEnv
-  { teConfig            :: !TracerConfig
-  , teConnectedNodes    :: !ConnectedNodes
-  , teAcceptedMetrics   :: !AcceptedMetrics
-  , teSavedTO           :: !SavedTraceObjects
-  , teBlockchainHistory :: !BlockchainHistory
-  , teResourcesHistory  :: !ResourcesHistory
-  , teTxHistory         :: !TransactionsHistory
-  , teCurrentLogLock    :: !Lock
-  , teCurrentDPLock     :: !Lock
-  , teEventsQueues      :: !EventsQueues
-  , teDPRequestors      :: !DataPointRequestors
-  , teProtocolsBrake    :: !ProtocolsBrake
+  { teConfig              :: !TracerConfig
+  , teConnectedNodes      :: !ConnectedNodes
+  , teConnectedNodesNames :: !ConnectedNodesNames
+  , teAcceptedMetrics     :: !AcceptedMetrics
+  , teSavedTO             :: !SavedTraceObjects
+  , teBlockchainHistory   :: !BlockchainHistory
+  , teResourcesHistory    :: !ResourcesHistory
+  , teTxHistory           :: !TransactionsHistory
+  , teCurrentLogLock      :: !Lock
+  , teCurrentDPLock       :: !Lock
+  , teEventsQueues        :: !EventsQueues
+  , teDPRequestors        :: !DataPointRequestors
+  , teProtocolsBrake      :: !ProtocolsBrake
+  , teRTViewPageOpened    :: !WebPageStatus
   }

cardano-tracer/src/Cardano/Tracer/Handlers/Logs/File.hs

@@ -24,10 +24,10 @@ import           System.FilePath ((</>))
 
 import           Cardano.Logging (Namespace, TraceObject (..))
 
-import           Cardano.Tracer.Configuration (LogFormat (..))
-import           Cardano.Tracer.Handlers.Logs.Utils (createEmptyLog, isItLog)
-import           Cardano.Tracer.Types (NodeId (..))
-import           Cardano.Tracer.Utils (nl)
+import           Cardano.Tracer.Configuration
+import           Cardano.Tracer.Handlers.Logs.Utils
+import           Cardano.Tracer.Types
+import           Cardano.Tracer.Utils
 
 -- | Append the list of 'TraceObject's to the latest log via symbolic link.
 --
@@ -36,20 +36,20 @@ import           Cardano.Tracer.Utils (nl)
 -- the symbolic link will be switched to the new log file and writing can
 -- be interrupted. To prevent it, we use 'Lock'.
 writeTraceObjectsToFile
-  :: NodeId
+  :: NodeName
   -> Lock
   -> FilePath
   -> LogFormat
   -> [TraceObject]
   -> IO ()
-writeTraceObjectsToFile nodeId currentLogLock rootDir format traceObjects = do
+writeTraceObjectsToFile nodeName currentLogLock rootDir format traceObjects = do
   rootDirAbs <- makeAbsolute rootDir
   let converter = case format of
                     ForHuman   -> traceObjectToText
                     ForMachine -> traceObjectToJSON
   let itemsToWrite = mapMaybe converter traceObjects
   unless (null itemsToWrite) $ do
-    pathToCurrentLog <- getPathToCurrentlog nodeId rootDirAbs format
+    pathToCurrentLog <- getPathToCurrentlog nodeName rootDirAbs format
     let preparedLine = TE.encodeUtf8 $ T.concat itemsToWrite
     withLock currentLogLock $
       BS.appendFile pathToCurrentLog preparedLine
@@ -66,16 +66,16 @@ writeTraceObjectsToFile nodeId currentLogLock rootDir format traceObjects = do
 --       logs from node N
 --
 getPathToCurrentlog
-  :: NodeId
+  :: NodeName
   -> FilePath
   -> LogFormat
   -> IO FilePath
-getPathToCurrentlog (NodeId anId) rootDirAbs format =
+getPathToCurrentlog nodeName rootDirAbs format =
   ifM (doesDirectoryExist subDirForLogs)
     getPathToCurrentLogIfExists
     prepareLogsStructure
  where
-  subDirForLogs = rootDirAbs </> T.unpack anId
+  subDirForLogs = rootDirAbs </> T.unpack nodeName
 
   getPathToCurrentLogIfExists = do
     logsWeNeed <- filter (isItLog format) <$> listFiles subDirForLogs

cardano-tracer/src/Cardano/Tracer/Handlers/Logs/Journal.hs

@@ -25,17 +25,17 @@ import           Systemd.Journal (Priority (..), message, mkJournalField, priori
 import           Cardano.Logging (TraceObject (..))
 import qualified Cardano.Logging as L
 
-import           Cardano.Tracer.Types (NodeId (..))
+import           Cardano.Tracer.Types
 #else
 import           Cardano.Logging (TraceObject)
 
-import           Cardano.Tracer.Types (NodeId)
+import           Cardano.Tracer.Types
 #endif
 
 #ifdef LINUX
 -- | Store 'TraceObject's in Linux systemd's journal service.
-writeTraceObjectsToJournal :: NodeId -> [TraceObject] -> IO ()
-writeTraceObjectsToJournal (NodeId anId) = mapM_ (sendJournalFields . mkJournalFields)
+writeTraceObjectsToJournal :: NodeName -> [TraceObject] -> IO ()
+writeTraceObjectsToJournal nodeName = mapM_ (sendJournalFields . mkJournalFields)
  where
   mkJournalFields trOb@TraceObject{toHuman, toMachine} =
     case (toHuman, toMachine) of
@@ -45,7 +45,7 @@ writeTraceObjectsToJournal (NodeId anId) = mapM_ (sendJournalFields . mkJournalF
       (Nothing,          Nothing)            -> HM.empty
 
   mkJournalFields' TraceObject{toSeverity, toNamespace, toThreadId, toTimestamp} msg =
-       syslogIdentifier anId
+       syslogIdentifier nodeName
     <> message msg
     <> priority (mkPriority toSeverity)
     <> HM.fromList
@@ -73,6 +73,6 @@ writeTraceObjectsToJournal (NodeId anId) = mapM_ (sendJournalFields . mkJournalF
   mkPriority L.Emergency = Emergency
 #else
 -- It works on Linux only.
-writeTraceObjectsToJournal :: NodeId -> [TraceObject] -> IO ()
+writeTraceObjectsToJournal :: NodeName -> [TraceObject] -> IO ()
 writeTraceObjectsToJournal _ _ = return ()
 #endif

cardano-tracer/src/Cardano/Tracer/Handlers/Logs/TraceObjects.hs

@@ -26,13 +26,15 @@ traceObjectsHandler
   -> [TraceObject]     -- ^ The list of received 'TraceObject's (may be empty).
   -> IO ()
 traceObjectsHandler _ _ [] = return ()
-traceObjectsHandler TracerEnv{teConfig, teCurrentLogLock, teSavedTO} nodeId traceObjects = do
+traceObjectsHandler tracerEnv nodeId traceObjects = do
+  nodeName <- askNodeName tracerEnv nodeId
   forConcurrently_ (NE.nub logging) $ \LoggingParams{logMode, logRoot, logFormat} ->
     showProblemIfAny verbosity $
       case logMode of
-        FileMode    -> writeTraceObjectsToFile nodeId teCurrentLogLock logRoot logFormat traceObjects
-        JournalMode -> writeTraceObjectsToJournal nodeId traceObjects
+        FileMode    -> writeTraceObjectsToFile nodeName teCurrentLogLock logRoot logFormat traceObjects
+        JournalMode -> writeTraceObjectsToJournal nodeName traceObjects
   whenJust hasRTView . const $
     saveTraceObjects teSavedTO nodeId traceObjects
  where
+  TracerEnv{teConfig, teCurrentLogLock, teSavedTO} = tracerEnv
   TracerConfig{logging, verbosity, hasRTView} = teConfig

cardano-tracer/src/Cardano/Tracer/Handlers/Metrics/Monitoring.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
@@ -22,9 +23,10 @@ import           Graphics.UI.Threepenny.Core (UI, Element, liftIO, set, (#), (#+
 import           System.Remote.Monitoring (forkServerWith, serverThreadId)
 import           System.Time.Extra (sleep)
 
-import           Cardano.Tracer.Configuration (Endpoint (..))
-import           Cardano.Tracer.Handlers.RTView.SSL.Certs (placeDefaultSSLFiles)
-import           Cardano.Tracer.Types (AcceptedMetrics, ConnectedNodes, NodeId (..))
+import           Cardano.Tracer.Configuration
+import           Cardano.Tracer.Environment
+import           Cardano.Tracer.Handlers.RTView.SSL.Certs
+import           Cardano.Tracer.Types
 
 -- | 'ekg' package allows to run only one EKG server, to display only one web page
 --   for particular EKG.Store. Since 'cardano-tracer' can be connected to any number
@@ -37,17 +39,16 @@ import           Cardano.Tracer.Types (AcceptedMetrics, ConnectedNodes, NodeId (
 --   the EKG server will be restarted and the monitoring page will display the metrics
 --   received from that node.
 runMonitoringServer
-  :: (Endpoint, Endpoint) -- ^ (web page with list of connected nodes, EKG web page).
-  -> ConnectedNodes
-  -> AcceptedMetrics
+  :: TracerEnv
+  -> (Endpoint, Endpoint) -- ^ (web page with list of connected nodes, EKG web page).
   -> IO ()
-runMonitoringServer (Endpoint listHost listPort, monitorEP) connectedNodes acceptedMetrics = do
+runMonitoringServer tracerEnv (Endpoint listHost listPort, monitorEP) = do
   -- Pause to prevent collision between "Listening"-notifications from servers.
   sleep 0.2
   (certFile, keyFile) <- placeDefaultSSLFiles
   UI.startGUI (config certFile keyFile) $ \window -> do
     void $ return window # set UI.title "EKG Monitoring Nodes"
-    void $ mkPageBody window connectedNodes monitorEP acceptedMetrics
+    void $ mkPageBody window tracerEnv monitorEP
  where
   config cert key = UI.defaultConfig
     { UI.jsSSLBind = Just . encodeUtf8 . T.pack $ listHost
@@ -64,12 +65,11 @@ type CurrentEKGServer = TMVar (NodeId, ThreadId)
 --   corresponding to currently connected nodes.
 mkPageBody
   :: UI.Window
-  -> ConnectedNodes
+  -> TracerEnv
   -> Endpoint
-  -> AcceptedMetrics
   -> UI Element
-mkPageBody window connectedNodes mEP@(Endpoint monitorHost monitorPort) acceptedMetrics = do
-  nodes <- liftIO $ S.toList <$> readTVarIO connectedNodes
+mkPageBody window tracerEnv mEP@(Endpoint monitorHost monitorPort) = do
+  nodes <- liftIO $ S.toList <$> readTVarIO teConnectedNodes
   nodesHrefs <-
     if null nodes
       then UI.string "There are no connected nodes yet"
@@ -85,23 +85,25 @@ mkPageBody window connectedNodes mEP@(Endpoint monitorHost monitorPort) accepted
                             # set UI.text (T.unpack anId)
                 ]
             void $ UI.on UI.click nodeLink $ const $
-              restartEKGServer nodeId acceptedMetrics mEP currentServer
+              restartEKGServer tracerEnv nodeId mEP currentServer
             return $ UI.element nodeLink
         UI.ul #+ nodesLinks
   UI.getBody window #+ [ UI.element nodesHrefs ]
+ where
+  TracerEnv{teConnectedNodes} = tracerEnv
 
 -- | After clicking on the node's href, the user will be redirected to the monitoring page
 --   which is rendered by 'ekg' package. But before, we have to check if EKG server is
 --   already launched, and if so, restart the server if needed.
 restartEKGServer
-  :: NodeId
-  -> AcceptedMetrics
+  :: TracerEnv
+  -> NodeId
   -> Endpoint
   -> CurrentEKGServer
   -> UI ()
-restartEKGServer newNodeId acceptedMetrics
+restartEKGServer TracerEnv{teAcceptedMetrics} newNodeId
                  (Endpoint monitorHost monitorPort) currentServer = liftIO $ do
-  metrics <- readTVarIO acceptedMetrics
+  metrics <- readTVarIO teAcceptedMetrics
   whenJust (metrics M.!? newNodeId) $ \(storeForSelectedNode, _) ->
     atomically (tryReadTMVar currentServer) >>= \case
       Just (_curNodeId, _sThread) ->