Skip to content

Commit fc27990

Browse files
author
Denis Shevchenko
committed
RTView: important fixes/improvements MVP.
1 parent aed8e71 commit fc27990

34 files changed

+740
-564
lines changed

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

+10-2
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,7 @@
11
{-# LANGUAGE OverloadedStrings #-}
22

33
import Control.Concurrent.Extra (newLock)
4+
import Control.Concurrent.STM.TVar (newTVarIO)
45
import Criterion.Main
56
import qualified Data.List.NonEmpty as NE
67
import Data.Time.Clock (getCurrentTime)
@@ -29,7 +30,8 @@ main = do
2930
to100 <- generate 100
3031
to1000 <- generate 1000
3132

32-
connectedNodes <- initConnectedNodes
33+
connectedNodes <- initConnectedNodes
34+
connectedNodesNames <- initConnectedNodesNames
3335
acceptedMetrics <- initAcceptedMetrics
3436
savedTO <- initSavedTraceObjects
3537

@@ -42,12 +44,15 @@ main = do
4244

4345
currentLogLock <- newLock
4446
currentDPLock <- newLock
45-
eventsQueues <- initEventsQueues dpRequestors currentDPLock
47+
eventsQueues <- initEventsQueues connectedNodesNames dpRequestors currentDPLock
48+
49+
rtViewPageOpened <- newTVarIO False
4650

4751
let te1 =
4852
TracerEnv
4953
{ teConfig = c1
5054
, teConnectedNodes = connectedNodes
55+
, teConnectedNodesNames = connectedNodesNames
5156
, teAcceptedMetrics = acceptedMetrics
5257
, teSavedTO = savedTO
5358
, teBlockchainHistory = chainHistory
@@ -58,11 +63,13 @@ main = do
5863
, teEventsQueues = eventsQueues
5964
, teDPRequestors = dpRequestors
6065
, teProtocolsBrake = protocolsBrake
66+
, teRTViewPageOpened = rtViewPageOpened
6167
}
6268
te2 =
6369
TracerEnv
6470
{ teConfig = c2
6571
, teConnectedNodes = connectedNodes
72+
, teConnectedNodesNames = connectedNodesNames
6673
, teAcceptedMetrics = acceptedMetrics
6774
, teSavedTO = savedTO
6875
, teBlockchainHistory = chainHistory
@@ -73,6 +80,7 @@ main = do
7380
, teEventsQueues = eventsQueues
7481
, teDPRequestors = dpRequestors
7582
, teProtocolsBrake = protocolsBrake
83+
, teRTViewPageOpened = rtViewPageOpened
7684
}
7785

7886
removePathForcibly root

‎cardano-tracer/cardano-tracer.cabal

+2
Original file line numberDiff line numberDiff line change
@@ -121,6 +121,7 @@ library
121121
, aeson-pretty
122122
, async
123123
, async-extras
124+
, bimap
124125
, blaze-html
125126
, blaze-markup
126127
, bytestring
@@ -299,6 +300,7 @@ benchmark cardano-tracer-bench
299300
, directory
300301
, extra
301302
, filepath
303+
, stm
302304
, time
303305
, trace-dispatcher
304306

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

+7-4
Original file line numberDiff line numberDiff line change
@@ -10,6 +10,7 @@ module Cardano.Tracer.Acceptors.Utils
1010

1111
import Control.Concurrent.STM (atomically)
1212
import Control.Concurrent.STM.TVar (TVar, newTVarIO, modifyTVar')
13+
import qualified Data.Bimap as BM
1314
import qualified Data.Map.Strict as M
1415
import qualified Data.Set as S
1516
import Data.Time.Clock.System (getSystemTime, systemToUTCTime)
@@ -64,13 +65,15 @@ removeDisconnectedNode
6465
:: TracerEnv
6566
-> ConnectionId LocalAddress
6667
-> IO ()
67-
removeDisconnectedNode TracerEnv{teConnectedNodes, teAcceptedMetrics, teDPRequestors} connId =
68+
removeDisconnectedNode tracerEnv connId =
6869
-- Remove all the stuff related to disconnected node.
6970
atomically $ do
70-
modifyTVar' teConnectedNodes $ S.delete nodeId
71-
modifyTVar' teAcceptedMetrics $ M.delete nodeId
72-
modifyTVar' teDPRequestors $ M.delete nodeId
71+
modifyTVar' teConnectedNodes $ S.delete nodeId
72+
modifyTVar' teConnectedNodesNames $ BM.delete nodeId
73+
modifyTVar' teAcceptedMetrics $ M.delete nodeId
74+
modifyTVar' teDPRequestors $ M.delete nodeId
7375
where
76+
TracerEnv{teConnectedNodes, teConnectedNodesNames, teAcceptedMetrics, teDPRequestors} = tracerEnv
7477
nodeId = connIdToNodeId connId
7578

7679
notifyAboutNodeDisconnected

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

+15-12
Original file line numberDiff line numberDiff line change
@@ -8,20 +8,23 @@ import Cardano.Tracer.Configuration
88
import Cardano.Tracer.Handlers.RTView.Notifications.Types
99
import Cardano.Tracer.Handlers.RTView.State.Historical
1010
import Cardano.Tracer.Handlers.RTView.State.TraceObjects
11+
import Cardano.Tracer.Handlers.RTView.UI.Types
1112
import Cardano.Tracer.Types
1213

1314
-- | Environment for all functions.
1415
data TracerEnv = TracerEnv
15-
{ teConfig :: !TracerConfig
16-
, teConnectedNodes :: !ConnectedNodes
17-
, teAcceptedMetrics :: !AcceptedMetrics
18-
, teSavedTO :: !SavedTraceObjects
19-
, teBlockchainHistory :: !BlockchainHistory
20-
, teResourcesHistory :: !ResourcesHistory
21-
, teTxHistory :: !TransactionsHistory
22-
, teCurrentLogLock :: !Lock
23-
, teCurrentDPLock :: !Lock
24-
, teEventsQueues :: !EventsQueues
25-
, teDPRequestors :: !DataPointRequestors
26-
, teProtocolsBrake :: !ProtocolsBrake
16+
{ teConfig :: !TracerConfig
17+
, teConnectedNodes :: !ConnectedNodes
18+
, teConnectedNodesNames :: !ConnectedNodesNames
19+
, teAcceptedMetrics :: !AcceptedMetrics
20+
, teSavedTO :: !SavedTraceObjects
21+
, teBlockchainHistory :: !BlockchainHistory
22+
, teResourcesHistory :: !ResourcesHistory
23+
, teTxHistory :: !TransactionsHistory
24+
, teCurrentLogLock :: !Lock
25+
, teCurrentDPLock :: !Lock
26+
, teEventsQueues :: !EventsQueues
27+
, teDPRequestors :: !DataPointRequestors
28+
, teProtocolsBrake :: !ProtocolsBrake
29+
, teRTViewPageOpened :: !WebPageStatus
2730
}

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

+10-10
Original file line numberDiff line numberDiff line change
@@ -24,10 +24,10 @@ import System.FilePath ((</>))
2424

2525
import Cardano.Logging (Namespace, TraceObject (..))
2626

27-
import Cardano.Tracer.Configuration (LogFormat (..))
28-
import Cardano.Tracer.Handlers.Logs.Utils (createEmptyLog, isItLog)
29-
import Cardano.Tracer.Types (NodeId (..))
30-
import Cardano.Tracer.Utils (nl)
27+
import Cardano.Tracer.Configuration
28+
import Cardano.Tracer.Handlers.Logs.Utils
29+
import Cardano.Tracer.Types
30+
import Cardano.Tracer.Utils
3131

3232
-- | Append the list of 'TraceObject's to the latest log via symbolic link.
3333
--
@@ -36,20 +36,20 @@ import Cardano.Tracer.Utils (nl)
3636
-- the symbolic link will be switched to the new log file and writing can
3737
-- be interrupted. To prevent it, we use 'Lock'.
3838
writeTraceObjectsToFile
39-
:: NodeId
39+
:: NodeName
4040
-> Lock
4141
-> FilePath
4242
-> LogFormat
4343
-> [TraceObject]
4444
-> IO ()
45-
writeTraceObjectsToFile nodeId currentLogLock rootDir format traceObjects = do
45+
writeTraceObjectsToFile nodeName currentLogLock rootDir format traceObjects = do
4646
rootDirAbs <- makeAbsolute rootDir
4747
let converter = case format of
4848
ForHuman -> traceObjectToText
4949
ForMachine -> traceObjectToJSON
5050
let itemsToWrite = mapMaybe converter traceObjects
5151
unless (null itemsToWrite) $ do
52-
pathToCurrentLog <- getPathToCurrentlog nodeId rootDirAbs format
52+
pathToCurrentLog <- getPathToCurrentlog nodeName rootDirAbs format
5353
let preparedLine = TE.encodeUtf8 $ T.concat itemsToWrite
5454
withLock currentLogLock $
5555
BS.appendFile pathToCurrentLog preparedLine
@@ -66,16 +66,16 @@ writeTraceObjectsToFile nodeId currentLogLock rootDir format traceObjects = do
6666
-- logs from node N
6767
--
6868
getPathToCurrentlog
69-
:: NodeId
69+
:: NodeName
7070
-> FilePath
7171
-> LogFormat
7272
-> IO FilePath
73-
getPathToCurrentlog (NodeId anId) rootDirAbs format =
73+
getPathToCurrentlog nodeName rootDirAbs format =
7474
ifM (doesDirectoryExist subDirForLogs)
7575
getPathToCurrentLogIfExists
7676
prepareLogsStructure
7777
where
78-
subDirForLogs = rootDirAbs </> T.unpack anId
78+
subDirForLogs = rootDirAbs </> T.unpack nodeName
7979

8080
getPathToCurrentLogIfExists = do
8181
logsWeNeed <- filter (isItLog format) <$> listFiles subDirForLogs

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

+6-6
Original file line numberDiff line numberDiff line change
@@ -25,17 +25,17 @@ import Systemd.Journal (Priority (..), message, mkJournalField, priori
2525
import Cardano.Logging (TraceObject (..))
2626
import qualified Cardano.Logging as L
2727

28-
import Cardano.Tracer.Types (NodeId (..))
28+
import Cardano.Tracer.Types
2929
#else
3030
import Cardano.Logging (TraceObject)
3131

32-
import Cardano.Tracer.Types (NodeId)
32+
import Cardano.Tracer.Types
3333
#endif
3434

3535
#ifdef LINUX
3636
-- | Store 'TraceObject's in Linux systemd's journal service.
37-
writeTraceObjectsToJournal :: NodeId -> [TraceObject] -> IO ()
38-
writeTraceObjectsToJournal (NodeId anId) = mapM_ (sendJournalFields . mkJournalFields)
37+
writeTraceObjectsToJournal :: NodeName -> [TraceObject] -> IO ()
38+
writeTraceObjectsToJournal nodeName = mapM_ (sendJournalFields . mkJournalFields)
3939
where
4040
mkJournalFields trOb@TraceObject{toHuman, toMachine} =
4141
case (toHuman, toMachine) of
@@ -45,7 +45,7 @@ writeTraceObjectsToJournal (NodeId anId) = mapM_ (sendJournalFields . mkJournalF
4545
(Nothing, Nothing) -> HM.empty
4646

4747
mkJournalFields' TraceObject{toSeverity, toNamespace, toThreadId, toTimestamp} msg =
48-
syslogIdentifier anId
48+
syslogIdentifier nodeName
4949
<> message msg
5050
<> priority (mkPriority toSeverity)
5151
<> HM.fromList
@@ -73,6 +73,6 @@ writeTraceObjectsToJournal (NodeId anId) = mapM_ (sendJournalFields . mkJournalF
7373
mkPriority L.Emergency = Emergency
7474
#else
7575
-- It works on Linux only.
76-
writeTraceObjectsToJournal :: NodeId -> [TraceObject] -> IO ()
76+
writeTraceObjectsToJournal :: NodeName -> [TraceObject] -> IO ()
7777
writeTraceObjectsToJournal _ _ = return ()
7878
#endif

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

+5-3
Original file line numberDiff line numberDiff line change
@@ -26,13 +26,15 @@ traceObjectsHandler
2626
-> [TraceObject] -- ^ The list of received 'TraceObject's (may be empty).
2727
-> IO ()
2828
traceObjectsHandler _ _ [] = return ()
29-
traceObjectsHandler TracerEnv{teConfig, teCurrentLogLock, teSavedTO} nodeId traceObjects = do
29+
traceObjectsHandler tracerEnv nodeId traceObjects = do
30+
nodeName <- askNodeName tracerEnv nodeId
3031
forConcurrently_ (NE.nub logging) $ \LoggingParams{logMode, logRoot, logFormat} ->
3132
showProblemIfAny verbosity $
3233
case logMode of
33-
FileMode -> writeTraceObjectsToFile nodeId teCurrentLogLock logRoot logFormat traceObjects
34-
JournalMode -> writeTraceObjectsToJournal nodeId traceObjects
34+
FileMode -> writeTraceObjectsToFile nodeName teCurrentLogLock logRoot logFormat traceObjects
35+
JournalMode -> writeTraceObjectsToJournal nodeName traceObjects
3536
whenJust hasRTView . const $
3637
saveTraceObjects teSavedTO nodeId traceObjects
3738
where
39+
TracerEnv{teConfig, teCurrentLogLock, teSavedTO} = tracerEnv
3840
TracerConfig{logging, verbosity, hasRTView} = teConfig

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

+19-17
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
{-# LANGUAGE LambdaCase #-}
2+
{-# LANGUAGE NamedFieldPuns #-}
23
{-# LANGUAGE OverloadedStrings #-}
34
{-# LANGUAGE ScopedTypeVariables #-}
45

@@ -22,9 +23,10 @@ import Graphics.UI.Threepenny.Core (UI, Element, liftIO, set, (#), (#+
2223
import System.Remote.Monitoring (forkServerWith, serverThreadId)
2324
import System.Time.Extra (sleep)
2425

25-
import Cardano.Tracer.Configuration (Endpoint (..))
26-
import Cardano.Tracer.Handlers.RTView.SSL.Certs (placeDefaultSSLFiles)
27-
import Cardano.Tracer.Types (AcceptedMetrics, ConnectedNodes, NodeId (..))
26+
import Cardano.Tracer.Configuration
27+
import Cardano.Tracer.Environment
28+
import Cardano.Tracer.Handlers.RTView.SSL.Certs
29+
import Cardano.Tracer.Types
2830

2931
-- | 'ekg' package allows to run only one EKG server, to display only one web page
3032
-- for particular EKG.Store. Since 'cardano-tracer' can be connected to any number
@@ -37,17 +39,16 @@ import Cardano.Tracer.Types (AcceptedMetrics, ConnectedNodes, NodeId (
3739
-- the EKG server will be restarted and the monitoring page will display the metrics
3840
-- received from that node.
3941
runMonitoringServer
40-
:: (Endpoint, Endpoint) -- ^ (web page with list of connected nodes, EKG web page).
41-
-> ConnectedNodes
42-
-> AcceptedMetrics
42+
:: TracerEnv
43+
-> (Endpoint, Endpoint) -- ^ (web page with list of connected nodes, EKG web page).
4344
-> IO ()
44-
runMonitoringServer (Endpoint listHost listPort, monitorEP) connectedNodes acceptedMetrics = do
45+
runMonitoringServer tracerEnv (Endpoint listHost listPort, monitorEP) = do
4546
-- Pause to prevent collision between "Listening"-notifications from servers.
4647
sleep 0.2
4748
(certFile, keyFile) <- placeDefaultSSLFiles
4849
UI.startGUI (config certFile keyFile) $ \window -> do
4950
void $ return window # set UI.title "EKG Monitoring Nodes"
50-
void $ mkPageBody window connectedNodes monitorEP acceptedMetrics
51+
void $ mkPageBody window tracerEnv monitorEP
5152
where
5253
config cert key = UI.defaultConfig
5354
{ UI.jsSSLBind = Just . encodeUtf8 . T.pack $ listHost
@@ -64,12 +65,11 @@ type CurrentEKGServer = TMVar (NodeId, ThreadId)
6465
-- corresponding to currently connected nodes.
6566
mkPageBody
6667
:: UI.Window
67-
-> ConnectedNodes
68+
-> TracerEnv
6869
-> Endpoint
69-
-> AcceptedMetrics
7070
-> UI Element
71-
mkPageBody window connectedNodes mEP@(Endpoint monitorHost monitorPort) acceptedMetrics = do
72-
nodes <- liftIO $ S.toList <$> readTVarIO connectedNodes
71+
mkPageBody window tracerEnv mEP@(Endpoint monitorHost monitorPort) = do
72+
nodes <- liftIO $ S.toList <$> readTVarIO teConnectedNodes
7373
nodesHrefs <-
7474
if null nodes
7575
then UI.string "There are no connected nodes yet"
@@ -85,23 +85,25 @@ mkPageBody window connectedNodes mEP@(Endpoint monitorHost monitorPort) accepted
8585
# set UI.text (T.unpack anId)
8686
]
8787
void $ UI.on UI.click nodeLink $ const $
88-
restartEKGServer nodeId acceptedMetrics mEP currentServer
88+
restartEKGServer tracerEnv nodeId mEP currentServer
8989
return $ UI.element nodeLink
9090
UI.ul #+ nodesLinks
9191
UI.getBody window #+ [ UI.element nodesHrefs ]
92+
where
93+
TracerEnv{teConnectedNodes} = tracerEnv
9294

9395
-- | After clicking on the node's href, the user will be redirected to the monitoring page
9496
-- which is rendered by 'ekg' package. But before, we have to check if EKG server is
9597
-- already launched, and if so, restart the server if needed.
9698
restartEKGServer
97-
:: NodeId
98-
-> AcceptedMetrics
99+
:: TracerEnv
100+
-> NodeId
99101
-> Endpoint
100102
-> CurrentEKGServer
101103
-> UI ()
102-
restartEKGServer newNodeId acceptedMetrics
104+
restartEKGServer TracerEnv{teAcceptedMetrics} newNodeId
103105
(Endpoint monitorHost monitorPort) currentServer = liftIO $ do
104-
metrics <- readTVarIO acceptedMetrics
106+
metrics <- readTVarIO teAcceptedMetrics
105107
whenJust (metrics M.!? newNodeId) $ \(storeForSelectedNode, _) ->
106108
atomically (tryReadTMVar currentServer) >>= \case
107109
Just (_curNodeId, _sThread) ->

0 commit comments

Comments
 (0)