Skip to content

Commit 3586f5b

Browse files
iohk-bors[bot]Denis Shevchenko
iohk-bors[bot]
and
Denis Shevchenko
authored
Merge #4524
4524: cardano-tracer: optional state dir for RTView r=denisshevchenko a=denisshevchenko Closes #4515 Co-authored-by: Denis Shevchenko <[email protected]>
2 parents 17bbfb7 + b86fa85 commit 3586f5b

File tree

22 files changed

+192
-152
lines changed

22 files changed

+192
-152
lines changed

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

+3-1
Original file line numberDiff line numberDiff line change
@@ -44,7 +44,7 @@ main = do
4444

4545
currentLogLock <- newLock
4646
currentDPLock <- newLock
47-
eventsQueues <- initEventsQueues connectedNodesNames dpRequestors currentDPLock
47+
eventsQueues <- initEventsQueues Nothing connectedNodesNames dpRequestors currentDPLock
4848

4949
rtViewPageOpened <- newTVarIO False
5050

@@ -64,6 +64,7 @@ main = do
6464
, teDPRequestors = dpRequestors
6565
, teProtocolsBrake = protocolsBrake
6666
, teRTViewPageOpened = rtViewPageOpened
67+
, teRTViewStateDir = Nothing
6768
}
6869
te2 =
6970
TracerEnv
@@ -81,6 +82,7 @@ main = do
8182
, teDPRequestors = dpRequestors
8283
, teProtocolsBrake = protocolsBrake
8384
, teRTViewPageOpened = rtViewPageOpened
85+
, teRTViewStateDir = Nothing
8486
}
8587

8688
removePathForcibly root

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

+12-2
Original file line numberDiff line numberDiff line change
@@ -6,8 +6,9 @@ module Cardano.Tracer.CLI
66
import Options.Applicative
77

88
-- | CLI parameters required for the tracer.
9-
newtype TracerParams = TracerParams
10-
{ tracerConfig :: FilePath
9+
data TracerParams = TracerParams
10+
{ tracerConfig :: !FilePath
11+
, stateDir :: !(Maybe FilePath)
1112
}
1213

1314
-- | Parse CLI parameters for the tracer.
@@ -20,3 +21,12 @@ parseTracerParams = TracerParams
2021
<> help "Configuration file for cardano-tracer"
2122
<> completer (bashCompleter "file")
2223
)
24+
<*> optional
25+
(
26+
strOption
27+
( long "state-dir"
28+
<> metavar "FILEPATH"
29+
<> help "If specified, RTView saves its state in this directory"
30+
<> completer (bashCompleter "file")
31+
)
32+
)

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

+1
Original file line numberDiff line numberDiff line change
@@ -27,4 +27,5 @@ data TracerEnv = TracerEnv
2727
, teDPRequestors :: !DataPointRequestors
2828
, teProtocolsBrake :: !ProtocolsBrake
2929
, teRTViewPageOpened :: !WebPageStatus
30+
, teRTViewStateDir :: !(Maybe FilePath)
3031
}

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

+1-1
Original file line numberDiff line numberDiff line change
@@ -45,7 +45,7 @@ runMonitoringServer
4545
runMonitoringServer tracerEnv (Endpoint listHost listPort, monitorEP) = do
4646
-- Pause to prevent collision between "Listening"-notifications from servers.
4747
sleep 0.2
48-
(certFile, keyFile) <- placeDefaultSSLFiles
48+
(certFile, keyFile) <- placeDefaultSSLFiles tracerEnv
4949
UI.startGUI (config certFile keyFile) $ \window -> do
5050
void $ return window # set UI.title "EKG Monitoring Nodes"
5151
void $ mkPageBody window tracerEnv monitorEP

‎cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Notifications/Send.hs

+5-3
Original file line numberDiff line numberDiff line change
@@ -23,14 +23,16 @@ import Cardano.Tracer.Types
2323
import Cardano.Tracer.Utils
2424

2525
makeAndSendNotification
26-
:: ConnectedNodesNames
26+
:: Maybe FilePath
27+
-> ConnectedNodesNames
2728
-> DataPointRequestors
2829
-> Lock
2930
-> TVar UTCTime
3031
-> EventsQueue
3132
-> IO ()
32-
makeAndSendNotification connectedNodesNames dpRequestors currentDPLock lastTime eventsQueue = do
33-
emailSettings <- readSavedEmailSettings
33+
makeAndSendNotification rtvSD connectedNodesNames dpRequestors
34+
currentDPLock lastTime eventsQueue = do
35+
emailSettings <- readSavedEmailSettings rtvSD
3436
unless (incompleteEmailSettings emailSettings) $ do
3537
events <- atomically $ nub <$> flushTBQueue eventsQueue
3638
let (nodeIds, tss) = unzip $ nub [(nodeId, ts) | Event nodeId ts _ _ <- events]

‎cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Notifications/Settings.hs

+14-12
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,12 +23,13 @@ import qualified Data.ByteString as BS
2223
import qualified Data.ByteString.Lazy as LBS
2324
import qualified Data.Text as T
2425

26+
import Cardano.Tracer.Environment
2527
import Cardano.Tracer.Handlers.RTView.Notifications.Types
2628
import Cardano.Tracer.Handlers.RTView.System
2729

28-
readSavedEmailSettings :: IO EmailSettings
29-
readSavedEmailSettings = do
30-
(pathToEmailSettings, _) <- getPathsToNotificationsSettings
30+
readSavedEmailSettings :: Maybe FilePath -> IO EmailSettings
31+
readSavedEmailSettings rtvSD = do
32+
(pathToEmailSettings, _) <- getPathsToNotificationsSettings rtvSD
3133
try_ (BS.readFile pathToEmailSettings) >>= \case
3234
Left _ -> return defaultSettings
3335
Right jsonSettings ->
@@ -72,9 +74,9 @@ incompleteEmailSettings emailSettings = T.null $ esSMTPHost emailSettings
7274
-- key :: BS.ByteString
7375
-- key = "n3+d6^jrodGe$1Ljwt;iBtsi_mxzp-47"
7476

75-
readSavedEventsSettings :: IO EventsSettings
76-
readSavedEventsSettings = do
77-
(_, pathToEventsSettings) <- getPathsToNotificationsSettings
77+
readSavedEventsSettings :: Maybe FilePath -> IO EventsSettings
78+
readSavedEventsSettings rtvSD = do
79+
(_, pathToEventsSettings) <- getPathsToNotificationsSettings rtvSD
7880
try_ (BS.readFile pathToEventsSettings) >>= \case
7981
Left _ -> return defaultSettings
8082
Right jsonSettings ->
@@ -92,16 +94,16 @@ readSavedEventsSettings = do
9294
}
9395
defaultState = (False, 1800)
9496

95-
saveEmailSettingsOnDisk :: EmailSettings -> IO ()
96-
saveEmailSettingsOnDisk settings = ignore $ do
97-
(pathToEmailSettings, _) <- getPathsToNotificationsSettings
97+
saveEmailSettingsOnDisk :: TracerEnv -> EmailSettings -> IO ()
98+
saveEmailSettingsOnDisk TracerEnv{teRTViewStateDir} settings = ignore $ do
99+
(pathToEmailSettings, _) <- getPathsToNotificationsSettings teRTViewStateDir
98100
LBS.writeFile pathToEmailSettings $ encode settings
99101
-- Encrypt JSON-content to avoid saving user's private data in "plain mode".
100102
-- case encryptJSON . LBS.toStrict . encode $ settings of
101103
-- Right encryptedJSON -> BS.writeFile pathToEmailSettings encryptedJSON
102104
-- Left _ -> return ()
103105

104-
saveEventsSettingsOnDisk :: EventsSettings -> IO ()
105-
saveEventsSettingsOnDisk settings = ignore $ do
106-
(_, pathToEventsSettings) <- getPathsToNotificationsSettings
106+
saveEventsSettingsOnDisk :: TracerEnv -> EventsSettings -> IO ()
107+
saveEventsSettingsOnDisk TracerEnv{teRTViewStateDir} settings = ignore $ do
108+
(_, pathToEventsSettings) <- getPathsToNotificationsSettings teRTViewStateDir
107109
encodeFile pathToEventsSettings settings

‎cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Notifications/Utils.hs

+11-10
Original file line numberDiff line numberDiff line change
@@ -24,11 +24,12 @@ import Cardano.Tracer.Handlers.RTView.Update.Utils
2424
import Cardano.Tracer.Types
2525

2626
initEventsQueues
27-
:: ConnectedNodesNames
27+
:: Maybe FilePath
28+
-> ConnectedNodesNames
2829
-> DataPointRequestors
2930
-> Lock
3031
-> IO EventsQueues
31-
initEventsQueues nodesNames dpReqs curDPLock = do
32+
initEventsQueues rtvSD nodesNames dpReqs curDPLock = do
3233
lastTime <- newTVarIO nullTime
3334

3435
warnQ <- initEventsQueue
@@ -38,21 +39,21 @@ initEventsQueues nodesNames dpReqs curDPLock = do
3839
emrgQ <- initEventsQueue
3940
nodeDisconQ <- initEventsQueue
4041

41-
settings <- readSavedEventsSettings
42+
settings <- readSavedEventsSettings rtvSD
4243
let (warnS, warnP) = evsWarnings settings
4344
(errsS, errsP) = evsErrors settings
4445
(critS, critP) = evsCriticals settings
4546
(alrtS, alrtP) = evsAlerts settings
4647
(emrgS, emrgP) = evsEmergencies settings
4748
(nodeDisconS, nodeDisconP) = evsNodeDisconnected settings
4849

49-
warnT <- mkTimer (makeAndSendNotification nodesNames dpReqs curDPLock lastTime warnQ) warnS warnP
50-
errsT <- mkTimer (makeAndSendNotification nodesNames dpReqs curDPLock lastTime errsQ) errsS errsP
51-
critT <- mkTimer (makeAndSendNotification nodesNames dpReqs curDPLock lastTime critQ) critS critP
52-
alrtT <- mkTimer (makeAndSendNotification nodesNames dpReqs curDPLock lastTime alrtQ) alrtS alrtP
53-
emrgT <- mkTimer (makeAndSendNotification nodesNames dpReqs curDPLock lastTime emrgQ) emrgS emrgP
54-
nodeDisconT <- mkTimer (makeAndSendNotification nodesNames dpReqs curDPLock lastTime nodeDisconQ)
55-
nodeDisconS nodeDisconP
50+
warnT <- mkTimer (makeAndSendNotification rtvSD nodesNames dpReqs curDPLock lastTime warnQ) warnS warnP
51+
errsT <- mkTimer (makeAndSendNotification rtvSD nodesNames dpReqs curDPLock lastTime errsQ) errsS errsP
52+
critT <- mkTimer (makeAndSendNotification rtvSD nodesNames dpReqs curDPLock lastTime critQ) critS critP
53+
alrtT <- mkTimer (makeAndSendNotification rtvSD nodesNames dpReqs curDPLock lastTime alrtQ) alrtS alrtP
54+
emrgT <- mkTimer (makeAndSendNotification rtvSD nodesNames dpReqs curDPLock lastTime emrgQ) emrgS emrgP
55+
nodeDisconT <-
56+
mkTimer (makeAndSendNotification rtvSD nodesNames dpReqs curDPLock lastTime nodeDisconQ) nodeDisconS nodeDisconP
5657

5758
newTVarIO $ M.fromList
5859
[ (EventWarnings, (warnQ, warnT))

‎cardano-tracer/src/Cardano/Tracer/Handlers/RTView/Run.hs

+1-1
Original file line numberDiff line numberDiff line change
@@ -43,7 +43,7 @@ runRTView tracerEnv =
4343
-- Pause to prevent collision between "Listening"-notifications from servers.
4444
sleep 0.3
4545
-- Get paths to default SSL files for config.
46-
(certFile, keyFile) <- placeDefaultSSLFiles
46+
(certFile, keyFile) <- placeDefaultSSLFiles tracerEnv
4747
-- Initialize displayed stuff outside of main page renderer,
4848
-- to be able to update corresponding elements after page reloading.
4949
displayedElements <- initDisplayedElements

‎cardano-tracer/src/Cardano/Tracer/Handlers/RTView/SSL/Certs.hs

+4-3
Original file line numberDiff line numberDiff line change
@@ -12,11 +12,12 @@ import qualified Data.ByteString as BS
1212
import Data.String.QQ
1313
import qualified System.Directory as D
1414

15+
import Cardano.Tracer.Environment
1516
import Cardano.Tracer.Handlers.RTView.System
1617

17-
placeDefaultSSLFiles :: IO (FilePath, FilePath)
18-
placeDefaultSSLFiles = do
19-
(pathToCertFile, pathToKeyFile) <- getPathsToSSLCerts
18+
placeDefaultSSLFiles :: TracerEnv -> IO (FilePath, FilePath)
19+
placeDefaultSSLFiles tracerEnv = do
20+
(pathToCertFile, pathToKeyFile) <- getPathsToSSLCerts tracerEnv
2021
writeIfNeeded pathToCertFile defaultCert
2122
writeIfNeeded pathToKeyFile defaultKey
2223
-- Set permissions like 'openssl' does.

‎cardano-tracer/src/Cardano/Tracer/Handlers/RTView/System.hs

+32-22
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
{-# LANGUAGE CPP #-}
2+
{-# LANGUAGE NamedFieldPuns #-}
23

34
module Cardano.Tracer.Handlers.RTView.System
45
( getPathToBackupDir
@@ -22,6 +23,8 @@ import System.Posix.Process (getProcessID)
2223
import System.Posix.Types (CPid (..))
2324
#endif
2425

26+
import Cardano.Tracer.Environment
27+
2528
getProcessId :: UI Word32
2629
getProcessId =
2730
#if defined(mingw32_HOST_OS)
@@ -31,53 +34,60 @@ getProcessId =
3134
return $ fromIntegral pid
3235
#endif
3336

34-
getPathToChartsConfig, getPathToThemeConfig :: IO FilePath
37+
getPathToChartsConfig, getPathToThemeConfig :: TracerEnv -> IO FilePath
3538
getPathToChartsConfig = getPathToConfig "charts"
3639
getPathToThemeConfig = getPathToConfig "theme"
3740

38-
getPathToConfig :: FilePath -> IO FilePath
39-
getPathToConfig configName = do
40-
configDir <- getPathToConfigDir
41+
getPathToConfig :: FilePath -> TracerEnv -> IO FilePath
42+
getPathToConfig configName TracerEnv{teRTViewStateDir} = do
43+
configDir <- getPathToConfigDir teRTViewStateDir
4144
return $ configDir </> configName
4245

43-
getPathsToSSLCerts :: IO (FilePath, FilePath)
44-
getPathsToSSLCerts = do
45-
configDir <- getPathToConfigDir
46+
getPathsToSSLCerts :: TracerEnv -> IO (FilePath, FilePath)
47+
getPathsToSSLCerts TracerEnv{teRTViewStateDir} = do
48+
configDir <- getPathToConfigDir teRTViewStateDir
4649
let pathToSSLSubDir = configDir </> "ssl"
4750
D.createDirectoryIfMissing True pathToSSLSubDir
4851
return ( pathToSSLSubDir </> "cert.pem"
4952
, pathToSSLSubDir </> "key.pem"
5053
)
5154

52-
getPathsToNotificationsSettings :: IO (FilePath, FilePath)
53-
getPathsToNotificationsSettings = do
54-
configDir <- getPathToConfigDir
55+
getPathsToNotificationsSettings :: Maybe FilePath -> IO (FilePath, FilePath)
56+
getPathsToNotificationsSettings rtvSD = do
57+
configDir <- getPathToConfigDir rtvSD
5558
let pathToNotifySubDir = configDir </> "notifications"
5659
D.createDirectoryIfMissing True pathToNotifySubDir
5760
return ( pathToNotifySubDir </> "email"
5861
, pathToNotifySubDir </> "events"
5962
)
6063

61-
getPathToConfigDir :: IO FilePath
62-
getPathToConfigDir = do
63-
configDir <- D.getXdgDirectory D.XdgConfig ""
64+
getPathToChartColorsDir :: TracerEnv -> IO FilePath
65+
getPathToChartColorsDir TracerEnv{teRTViewStateDir} = do
66+
configDir <- getPathToConfigDir teRTViewStateDir
67+
let pathToColorsSubDir = configDir </> "color"
68+
D.createDirectoryIfMissing True pathToColorsSubDir
69+
return pathToColorsSubDir
70+
71+
getPathToConfigDir :: Maybe FilePath -> IO FilePath
72+
getPathToConfigDir rtvSD = do
73+
configDir <- getStateDir rtvSD D.XdgConfig
6474
let pathToRTViewConfigDir = configDir </> rtViewRootDir
6575
D.createDirectoryIfMissing True pathToRTViewConfigDir
6676
return pathToRTViewConfigDir
6777

68-
getPathToBackupDir :: IO FilePath
69-
getPathToBackupDir = do
70-
dataDir <- D.getXdgDirectory D.XdgData ""
78+
getPathToBackupDir :: TracerEnv -> IO FilePath
79+
getPathToBackupDir TracerEnv{teRTViewStateDir} = do
80+
dataDir <- getStateDir teRTViewStateDir D.XdgData
7181
let pathToRTViewBackupDir = dataDir </> rtViewRootDir </> "backup"
7282
D.createDirectoryIfMissing True pathToRTViewBackupDir
7383
return pathToRTViewBackupDir
7484

75-
getPathToChartColorsDir :: IO FilePath
76-
getPathToChartColorsDir = do
77-
configDir <- getPathToConfigDir
78-
let pathToColorsSubDir = configDir </> "color"
79-
D.createDirectoryIfMissing True pathToColorsSubDir
80-
return pathToColorsSubDir
85+
getStateDir
86+
:: Maybe FilePath
87+
-> D.XdgDirectory
88+
-> IO FilePath
89+
getStateDir Nothing xdgDir = D.getXdgDirectory xdgDir ""
90+
getStateDir (Just stateDir) _ = return stateDir
8191

8292
rtViewRootDir :: FilePath
8393
rtViewRootDir = "cardano-rt-view"

‎cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/Charts.hs

+23-16
Original file line numberDiff line numberDiff line change
@@ -95,11 +95,11 @@ addNodeDatasetsToCharts tracerEnv colors datasetIndices nodeId@(NodeId anId) = d
9595
-- If so - we have to take its color again, from the file.
9696
-- If not - we have to take the new color for it and save it for the future.
9797
colorForNode@(Color code) <-
98-
liftIO (getSavedColorForNode nodeName) >>= \case
98+
liftIO (getSavedColorForNode tracerEnv nodeName) >>= \case
9999
Just savedColor -> return savedColor
100100
Nothing -> do
101101
newColor <- getNewColor
102-
liftIO $ saveColorForNode nodeName newColor
102+
liftIO $ saveColorForNode tracerEnv nodeName newColor
103103
return newColor
104104
forM_ chartsIds $ \chartId ->
105105
case mIx of
@@ -194,8 +194,8 @@ replacePointsByAvgPoints points =
194194
-- Maximum number of points to calculate avg = 15 s.
195195
numberOfPointsToAverage = 15
196196

197-
restoreChartsSettings :: UI ()
198-
restoreChartsSettings = readSavedChartsSettings >>= setCharts
197+
restoreChartsSettings :: TracerEnv -> UI ()
198+
restoreChartsSettings tracerEnv = readSavedChartsSettings tracerEnv >>= setCharts
199199
where
200200
setCharts settings =
201201
forM_ settings $ \(chartId, ChartSettings tr up) -> do
@@ -204,15 +204,15 @@ restoreChartsSettings = readSavedChartsSettings >>= setCharts
204204
Chart.setTimeRange chartId tr
205205
when (tr == 0) $ Chart.resetZoomChartJS chartId
206206

207-
saveChartsSettings :: UI ()
208-
saveChartsSettings = do
207+
saveChartsSettings :: TracerEnv -> UI ()
208+
saveChartsSettings tracerEnv = do
209209
settings <-
210210
forM chartsIds $ \chartId -> do
211211
selectedTR <- getOptionValue $ show chartId <> show TimeRangeSelect
212212
selectedUP <- getOptionValue $ show chartId <> show UpdatePeriodSelect
213213
return (chartId, ChartSettings selectedTR selectedUP)
214214
liftIO . ignore $ do
215-
pathToChartsConfig <- getPathToChartsConfig
215+
pathToChartsConfig <- getPathToChartsConfig tracerEnv
216216
encodeFile pathToChartsConfig settings
217217
where
218218
getOptionValue selectId = do
@@ -222,9 +222,9 @@ saveChartsSettings = do
222222
Just (valueInS :: Int) -> return valueInS
223223
Nothing -> return 0
224224

225-
readSavedChartsSettings :: UI ChartsSettings
226-
readSavedChartsSettings = liftIO $
227-
try_ (decodeFileStrict' =<< getPathToChartsConfig) >>= \case
225+
readSavedChartsSettings :: TracerEnv -> UI ChartsSettings
226+
readSavedChartsSettings tracerEnv = liftIO $
227+
try_ (decodeFileStrict' =<< getPathToChartsConfig tracerEnv) >>= \case
228228
Right (Just (settings :: ChartsSettings)) -> return settings
229229
_ -> return defaultSettings
230230
where
@@ -320,9 +320,12 @@ dataNameToChartId dataName =
320320
MempoolBytesData -> MempoolBytesChart
321321
TxsInMempoolData -> TxsInMempoolChart
322322

323-
getSavedColorForNode :: NodeName -> IO (Maybe Color)
324-
getSavedColorForNode nodeName = do
325-
colorsDir <- getPathToChartColorsDir
323+
getSavedColorForNode
324+
:: TracerEnv
325+
-> NodeName
326+
-> IO (Maybe Color)
327+
getSavedColorForNode tracerEnv nodeName = do
328+
colorsDir <- getPathToChartColorsDir tracerEnv
326329
colorFiles <- map (\cf -> colorsDir </> takeBaseName cf) <$> listFiles colorsDir
327330
case find (\cf -> unpack nodeName `isInfixOf` cf) colorFiles of
328331
Nothing -> return Nothing
@@ -341,7 +344,11 @@ getSavedColorForNode nodeName = do
341344
&& all (\c -> isDigit c || c `elem` ['a' .. 'f'] )
342345
(tail $ lower code)
343346

344-
saveColorForNode :: NodeName -> Color -> IO ()
345-
saveColorForNode nodeName (Color code) = do
346-
colorsDir <- getPathToChartColorsDir
347+
saveColorForNode
348+
:: TracerEnv
349+
-> NodeName
350+
-> Color
351+
-> IO ()
352+
saveColorForNode tracerEnv nodeName (Color code) = do
353+
colorsDir <- getPathToChartColorsDir tracerEnv
347354
ignore $ writeFile (colorsDir </> unpack nodeName) code

0 commit comments

Comments
 (0)