1
1
{-# LANGUAGE LambdaCase #-}
2
+ {-# LANGUAGE NamedFieldPuns #-}
2
3
{-# LANGUAGE OverloadedStrings #-}
3
4
{-# LANGUAGE ScopedTypeVariables #-}
4
5
@@ -22,9 +23,10 @@ import Graphics.UI.Threepenny.Core (UI, Element, liftIO, set, (#), (#+
22
23
import System.Remote.Monitoring (forkServerWith , serverThreadId )
23
24
import System.Time.Extra (sleep )
24
25
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
28
30
29
31
-- | 'ekg' package allows to run only one EKG server, to display only one web page
30
32
-- for particular EKG.Store. Since 'cardano-tracer' can be connected to any number
@@ -37,17 +39,16 @@ import Cardano.Tracer.Types (AcceptedMetrics, ConnectedNodes, NodeId (
37
39
-- the EKG server will be restarted and the monitoring page will display the metrics
38
40
-- received from that node.
39
41
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).
43
44
-> IO ()
44
- runMonitoringServer (Endpoint listHost listPort, monitorEP) connectedNodes acceptedMetrics = do
45
+ runMonitoringServer tracerEnv (Endpoint listHost listPort, monitorEP) = do
45
46
-- Pause to prevent collision between "Listening"-notifications from servers.
46
47
sleep 0.2
47
48
(certFile, keyFile) <- placeDefaultSSLFiles
48
49
UI. startGUI (config certFile keyFile) $ \ window -> do
49
50
void $ return window # set UI. title " EKG Monitoring Nodes"
50
- void $ mkPageBody window connectedNodes monitorEP acceptedMetrics
51
+ void $ mkPageBody window tracerEnv monitorEP
51
52
where
52
53
config cert key = UI. defaultConfig
53
54
{ UI. jsSSLBind = Just . encodeUtf8 . T. pack $ listHost
@@ -64,12 +65,11 @@ type CurrentEKGServer = TMVar (NodeId, ThreadId)
64
65
-- corresponding to currently connected nodes.
65
66
mkPageBody
66
67
:: UI. Window
67
- -> ConnectedNodes
68
+ -> TracerEnv
68
69
-> Endpoint
69
- -> AcceptedMetrics
70
70
-> 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
73
73
nodesHrefs <-
74
74
if null nodes
75
75
then UI. string " There are no connected nodes yet"
@@ -85,23 +85,25 @@ mkPageBody window connectedNodes mEP@(Endpoint monitorHost monitorPort) accepted
85
85
# set UI. text (T. unpack anId)
86
86
]
87
87
void $ UI. on UI. click nodeLink $ const $
88
- restartEKGServer nodeId acceptedMetrics mEP currentServer
88
+ restartEKGServer tracerEnv nodeId mEP currentServer
89
89
return $ UI. element nodeLink
90
90
UI. ul #+ nodesLinks
91
91
UI. getBody window #+ [ UI. element nodesHrefs ]
92
+ where
93
+ TracerEnv {teConnectedNodes} = tracerEnv
92
94
93
95
-- | After clicking on the node's href, the user will be redirected to the monitoring page
94
96
-- which is rendered by 'ekg' package. But before, we have to check if EKG server is
95
97
-- already launched, and if so, restart the server if needed.
96
98
restartEKGServer
97
- :: NodeId
98
- -> AcceptedMetrics
99
+ :: TracerEnv
100
+ -> NodeId
99
101
-> Endpoint
100
102
-> CurrentEKGServer
101
103
-> UI ()
102
- restartEKGServer newNodeId acceptedMetrics
104
+ restartEKGServer TracerEnv {teAcceptedMetrics} newNodeId
103
105
(Endpoint monitorHost monitorPort) currentServer = liftIO $ do
104
- metrics <- readTVarIO acceptedMetrics
106
+ metrics <- readTVarIO teAcceptedMetrics
105
107
whenJust (metrics M. !? newNodeId) $ \ (storeForSelectedNode, _) ->
106
108
atomically (tryReadTMVar currentServer) >>= \ case
107
109
Just (_curNodeId, _sThread) ->
0 commit comments