Merge #4524

4524: cardano-tracer: optional state dir for RTView r=denisshevchenko a=denisshevchenko

Closes #4515 

Co-authored-by: Denis Shevchenko <[email protected]>

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

@@ -44,7 +44,7 @@ main = do
 
   currentLogLock <- newLock
   currentDPLock  <- newLock
-  eventsQueues   <- initEventsQueues connectedNodesNames dpRequestors currentDPLock
+  eventsQueues   <- initEventsQueues Nothing connectedNodesNames dpRequestors currentDPLock
 
   rtViewPageOpened <- newTVarIO False
 
@@ -64,6 +64,7 @@ main = do
           , teDPRequestors      = dpRequestors
           , teProtocolsBrake    = protocolsBrake
           , teRTViewPageOpened  = rtViewPageOpened
+          , teRTViewStateDir    = Nothing
           }
       te2 =
         TracerEnv
@@ -81,6 +82,7 @@ main = do
           , teDPRequestors      = dpRequestors
           , teProtocolsBrake    = protocolsBrake
           , teRTViewPageOpened  = rtViewPageOpened
+          , teRTViewStateDir    = Nothing
           }
 
   removePathForcibly root

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

@@ -6,8 +6,9 @@ module Cardano.Tracer.CLI
 import           Options.Applicative
 
 -- | CLI parameters required for the tracer.
-newtype TracerParams = TracerParams
-  { tracerConfig :: FilePath
+data TracerParams = TracerParams
+  { tracerConfig :: !FilePath
+  , stateDir     :: !(Maybe FilePath)
   }
 
 -- | Parse CLI parameters for the tracer.
@@ -20,3 +21,12 @@ parseTracerParams = TracerParams
           <> help "Configuration file for cardano-tracer"
           <> completer (bashCompleter "file")
         )
+  <*> optional
+        (
+          strOption
+            (    long "state-dir"
+              <> metavar "FILEPATH"
+              <> help "If specified, RTView saves its state in this directory"
+              <> completer (bashCompleter "file")
+            )
+        )

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

@@ -27,4 +27,5 @@ data TracerEnv = TracerEnv
   , teDPRequestors        :: !DataPointRequestors
   , teProtocolsBrake      :: !ProtocolsBrake
   , teRTViewPageOpened    :: !WebPageStatus
+  , teRTViewStateDir      :: !(Maybe FilePath)
   }

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

@@ -45,7 +45,7 @@ runMonitoringServer
 runMonitoringServer tracerEnv (Endpoint listHost listPort, monitorEP) = do
   -- Pause to prevent collision between "Listening"-notifications from servers.
   sleep 0.2
-  (certFile, keyFile) <- placeDefaultSSLFiles
+  (certFile, keyFile) <- placeDefaultSSLFiles tracerEnv
   UI.startGUI (config certFile keyFile) $ \window -> do
     void $ return window # set UI.title "EKG Monitoring Nodes"
     void $ mkPageBody window tracerEnv monitorEP

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

@@ -23,14 +23,16 @@ import           Cardano.Tracer.Types
 import           Cardano.Tracer.Utils
 
 makeAndSendNotification
-  :: ConnectedNodesNames
+  :: Maybe FilePath
+  -> ConnectedNodesNames
   -> DataPointRequestors
   -> Lock
   -> TVar UTCTime
   -> EventsQueue
   -> IO ()
-makeAndSendNotification connectedNodesNames dpRequestors currentDPLock lastTime eventsQueue = do
-  emailSettings <- readSavedEmailSettings
+makeAndSendNotification rtvSD connectedNodesNames dpRequestors
+                        currentDPLock lastTime eventsQueue = do
+  emailSettings <- readSavedEmailSettings rtvSD
   unless (incompleteEmailSettings emailSettings) $ do
     events <- atomically $ nub <$> flushTBQueue eventsQueue
     let (nodeIds, tss) = unzip $ nub [(nodeId, ts) | Event nodeId ts _ _ <- events]

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

@@ -1,4 +1,5 @@
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
@@ -22,12 +23,13 @@ import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as LBS
 import qualified Data.Text as T
 
+import           Cardano.Tracer.Environment
 import           Cardano.Tracer.Handlers.RTView.Notifications.Types
 import           Cardano.Tracer.Handlers.RTView.System
 
-readSavedEmailSettings :: IO EmailSettings
-readSavedEmailSettings = do
-  (pathToEmailSettings, _) <- getPathsToNotificationsSettings
+readSavedEmailSettings :: Maybe FilePath -> IO EmailSettings
+readSavedEmailSettings rtvSD = do
+  (pathToEmailSettings, _) <- getPathsToNotificationsSettings rtvSD
   try_ (BS.readFile pathToEmailSettings) >>= \case
     Left _ -> return defaultSettings
     Right jsonSettings ->
@@ -72,9 +74,9 @@ incompleteEmailSettings emailSettings = T.null $ esSMTPHost emailSettings
 --   key :: BS.ByteString
 --   key = "n3+d6^jrodGe$1Ljwt;iBtsi_mxzp-47"
 
-readSavedEventsSettings :: IO EventsSettings
-readSavedEventsSettings = do
-  (_, pathToEventsSettings) <- getPathsToNotificationsSettings
+readSavedEventsSettings :: Maybe FilePath -> IO EventsSettings
+readSavedEventsSettings rtvSD = do
+  (_, pathToEventsSettings) <- getPathsToNotificationsSettings rtvSD
   try_ (BS.readFile pathToEventsSettings) >>= \case
     Left _ -> return defaultSettings
     Right jsonSettings ->
@@ -92,16 +94,16 @@ readSavedEventsSettings = do
     }
   defaultState = (False, 1800)
 
-saveEmailSettingsOnDisk :: EmailSettings -> IO ()
-saveEmailSettingsOnDisk settings = ignore $ do
-  (pathToEmailSettings, _) <- getPathsToNotificationsSettings
+saveEmailSettingsOnDisk :: TracerEnv -> EmailSettings -> IO ()
+saveEmailSettingsOnDisk TracerEnv{teRTViewStateDir} settings = ignore $ do
+  (pathToEmailSettings, _) <- getPathsToNotificationsSettings teRTViewStateDir
   LBS.writeFile pathToEmailSettings $ encode settings
   -- Encrypt JSON-content to avoid saving user's private data in "plain mode".
   -- case encryptJSON . LBS.toStrict . encode $ settings of
   --   Right encryptedJSON -> BS.writeFile pathToEmailSettings encryptedJSON
   --   Left _ -> return ()
 
-saveEventsSettingsOnDisk :: EventsSettings -> IO ()
-saveEventsSettingsOnDisk settings = ignore $ do
-  (_, pathToEventsSettings) <- getPathsToNotificationsSettings
+saveEventsSettingsOnDisk :: TracerEnv -> EventsSettings -> IO ()
+saveEventsSettingsOnDisk TracerEnv{teRTViewStateDir} settings = ignore $ do
+  (_, pathToEventsSettings) <- getPathsToNotificationsSettings teRTViewStateDir
   encodeFile pathToEventsSettings settings

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

@@ -24,11 +24,12 @@ import           Cardano.Tracer.Handlers.RTView.Update.Utils
 import           Cardano.Tracer.Types
 
 initEventsQueues
-  :: ConnectedNodesNames
+  :: Maybe FilePath
+  -> ConnectedNodesNames
   -> DataPointRequestors
   -> Lock
   -> IO EventsQueues
-initEventsQueues nodesNames dpReqs curDPLock = do
+initEventsQueues rtvSD nodesNames dpReqs curDPLock = do
   lastTime <- newTVarIO nullTime
 
   warnQ <- initEventsQueue
@@ -38,21 +39,21 @@ initEventsQueues nodesNames dpReqs curDPLock = do
   emrgQ <- initEventsQueue
   nodeDisconQ <- initEventsQueue
 
-  settings <- readSavedEventsSettings
+  settings <- readSavedEventsSettings rtvSD
   let (warnS, warnP) = evsWarnings settings
       (errsS, errsP) = evsErrors settings
       (critS, critP) = evsCriticals settings
       (alrtS, alrtP) = evsAlerts settings
       (emrgS, emrgP) = evsEmergencies settings
       (nodeDisconS, nodeDisconP) = evsNodeDisconnected settings
 
-  warnT <- mkTimer (makeAndSendNotification nodesNames dpReqs curDPLock lastTime warnQ) warnS warnP
-  errsT <- mkTimer (makeAndSendNotification nodesNames dpReqs curDPLock lastTime errsQ) errsS errsP
-  critT <- mkTimer (makeAndSendNotification nodesNames dpReqs curDPLock lastTime critQ) critS critP
-  alrtT <- mkTimer (makeAndSendNotification nodesNames dpReqs curDPLock lastTime alrtQ) alrtS alrtP
-  emrgT <- mkTimer (makeAndSendNotification nodesNames dpReqs curDPLock lastTime emrgQ) emrgS emrgP
-  nodeDisconT <- mkTimer (makeAndSendNotification nodesNames dpReqs curDPLock lastTime nodeDisconQ)
-                         nodeDisconS nodeDisconP
+  warnT <- mkTimer (makeAndSendNotification rtvSD nodesNames dpReqs curDPLock lastTime warnQ) warnS warnP
+  errsT <- mkTimer (makeAndSendNotification rtvSD nodesNames dpReqs curDPLock lastTime errsQ) errsS errsP
+  critT <- mkTimer (makeAndSendNotification rtvSD nodesNames dpReqs curDPLock lastTime critQ) critS critP
+  alrtT <- mkTimer (makeAndSendNotification rtvSD nodesNames dpReqs curDPLock lastTime alrtQ) alrtS alrtP
+  emrgT <- mkTimer (makeAndSendNotification rtvSD nodesNames dpReqs curDPLock lastTime emrgQ) emrgS emrgP
+  nodeDisconT <-
+    mkTimer (makeAndSendNotification rtvSD nodesNames dpReqs curDPLock lastTime nodeDisconQ) nodeDisconS nodeDisconP
 
   newTVarIO $ M.fromList
     [ (EventWarnings,         (warnQ, warnT))

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

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

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

@@ -12,11 +12,12 @@ import qualified Data.ByteString as BS
 import           Data.String.QQ
 import qualified System.Directory as D
 
+import           Cardano.Tracer.Environment
 import           Cardano.Tracer.Handlers.RTView.System
 
-placeDefaultSSLFiles :: IO (FilePath, FilePath)
-placeDefaultSSLFiles = do
-  (pathToCertFile, pathToKeyFile) <- getPathsToSSLCerts
+placeDefaultSSLFiles :: TracerEnv -> IO (FilePath, FilePath)
+placeDefaultSSLFiles tracerEnv = do
+  (pathToCertFile, pathToKeyFile) <- getPathsToSSLCerts tracerEnv
   writeIfNeeded pathToCertFile defaultCert
   writeIfNeeded pathToKeyFile  defaultKey
   -- Set permissions like 'openssl' does.

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

@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE NamedFieldPuns #-}
 
 module Cardano.Tracer.Handlers.RTView.System
   ( getPathToBackupDir
@@ -22,6 +23,8 @@ import           System.Posix.Process (getProcessID)
 import           System.Posix.Types (CPid (..))
 #endif
 
+import           Cardano.Tracer.Environment
+
 getProcessId :: UI Word32
 getProcessId =
 #if defined(mingw32_HOST_OS)
@@ -31,53 +34,60 @@ getProcessId =
      return $ fromIntegral pid
 #endif
 
-getPathToChartsConfig, getPathToThemeConfig :: IO FilePath
+getPathToChartsConfig, getPathToThemeConfig :: TracerEnv -> IO FilePath
 getPathToChartsConfig = getPathToConfig "charts"
 getPathToThemeConfig  = getPathToConfig "theme"
 
-getPathToConfig :: FilePath -> IO FilePath
-getPathToConfig configName = do
-  configDir <- getPathToConfigDir
+getPathToConfig :: FilePath -> TracerEnv -> IO FilePath
+getPathToConfig configName TracerEnv{teRTViewStateDir} = do
+  configDir <- getPathToConfigDir teRTViewStateDir
   return $ configDir </> configName
 
-getPathsToSSLCerts :: IO (FilePath, FilePath)
-getPathsToSSLCerts = do
-  configDir <- getPathToConfigDir
+getPathsToSSLCerts :: TracerEnv -> IO (FilePath, FilePath)
+getPathsToSSLCerts TracerEnv{teRTViewStateDir} = do
+  configDir <- getPathToConfigDir teRTViewStateDir
   let pathToSSLSubDir = configDir </> "ssl"
   D.createDirectoryIfMissing True pathToSSLSubDir
   return ( pathToSSLSubDir </> "cert.pem"
          , pathToSSLSubDir </> "key.pem"
          )
 
-getPathsToNotificationsSettings :: IO (FilePath, FilePath)
-getPathsToNotificationsSettings = do
-  configDir <- getPathToConfigDir
+getPathsToNotificationsSettings :: Maybe FilePath -> IO (FilePath, FilePath)
+getPathsToNotificationsSettings rtvSD = do
+  configDir <- getPathToConfigDir rtvSD
   let pathToNotifySubDir = configDir </> "notifications"
   D.createDirectoryIfMissing True pathToNotifySubDir
   return ( pathToNotifySubDir </> "email"
          , pathToNotifySubDir </> "events"
          )
 
-getPathToConfigDir :: IO FilePath
-getPathToConfigDir = do
-  configDir <- D.getXdgDirectory D.XdgConfig ""
+getPathToChartColorsDir :: TracerEnv -> IO FilePath
+getPathToChartColorsDir TracerEnv{teRTViewStateDir} = do
+  configDir <- getPathToConfigDir teRTViewStateDir
+  let pathToColorsSubDir = configDir </> "color"
+  D.createDirectoryIfMissing True pathToColorsSubDir
+  return pathToColorsSubDir
+
+getPathToConfigDir :: Maybe FilePath -> IO FilePath
+getPathToConfigDir rtvSD = do
+  configDir <- getStateDir rtvSD D.XdgConfig
   let pathToRTViewConfigDir = configDir </> rtViewRootDir
   D.createDirectoryIfMissing True pathToRTViewConfigDir
   return pathToRTViewConfigDir
 
-getPathToBackupDir :: IO FilePath
-getPathToBackupDir = do
-  dataDir <- D.getXdgDirectory D.XdgData ""
+getPathToBackupDir :: TracerEnv -> IO FilePath
+getPathToBackupDir TracerEnv{teRTViewStateDir} = do
+  dataDir <- getStateDir teRTViewStateDir D.XdgData
   let pathToRTViewBackupDir = dataDir </> rtViewRootDir </> "backup"
   D.createDirectoryIfMissing True pathToRTViewBackupDir
   return pathToRTViewBackupDir
 
-getPathToChartColorsDir :: IO FilePath
-getPathToChartColorsDir = do
-  configDir <- getPathToConfigDir
-  let pathToColorsSubDir = configDir </> "color"
-  D.createDirectoryIfMissing True pathToColorsSubDir
-  return pathToColorsSubDir
+getStateDir
+  :: Maybe FilePath
+  -> D.XdgDirectory
+  -> IO FilePath
+getStateDir Nothing xdgDir = D.getXdgDirectory xdgDir ""
+getStateDir (Just stateDir) _ = return stateDir
 
 rtViewRootDir :: FilePath
 rtViewRootDir = "cardano-rt-view"

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

@@ -95,11 +95,11 @@ addNodeDatasetsToCharts tracerEnv colors datasetIndices nodeId@(NodeId anId) = d
   -- If so - we have to take its color again, from the file.
   -- If not - we have to take the new color for it and save it for the future.
   colorForNode@(Color code) <-
-    liftIO (getSavedColorForNode nodeName) >>= \case
+    liftIO (getSavedColorForNode tracerEnv nodeName) >>= \case
       Just savedColor -> return savedColor
       Nothing -> do
         newColor <- getNewColor
-        liftIO $ saveColorForNode nodeName newColor
+        liftIO $ saveColorForNode tracerEnv nodeName newColor
         return newColor
   forM_ chartsIds $ \chartId ->
     case mIx of
@@ -194,8 +194,8 @@ replacePointsByAvgPoints points =
   -- Maximum number of points to calculate avg = 15 s.
   numberOfPointsToAverage = 15
 
-restoreChartsSettings :: UI ()
-restoreChartsSettings = readSavedChartsSettings >>= setCharts
+restoreChartsSettings :: TracerEnv -> UI ()
+restoreChartsSettings tracerEnv = readSavedChartsSettings tracerEnv >>= setCharts
  where
   setCharts settings =
     forM_ settings $ \(chartId, ChartSettings tr up) -> do
@@ -204,15 +204,15 @@ restoreChartsSettings = readSavedChartsSettings >>= setCharts
       Chart.setTimeRange chartId tr
       when (tr == 0) $ Chart.resetZoomChartJS chartId
 
-saveChartsSettings :: UI ()
-saveChartsSettings = do
+saveChartsSettings :: TracerEnv -> UI ()
+saveChartsSettings tracerEnv = do
   settings <-
     forM chartsIds $ \chartId -> do
       selectedTR <- getOptionValue $ show chartId <> show TimeRangeSelect
       selectedUP <- getOptionValue $ show chartId <> show UpdatePeriodSelect
       return (chartId, ChartSettings selectedTR selectedUP)
   liftIO . ignore $ do
-    pathToChartsConfig <- getPathToChartsConfig
+    pathToChartsConfig <- getPathToChartsConfig tracerEnv
     encodeFile pathToChartsConfig settings
  where
   getOptionValue selectId = do
@@ -222,9 +222,9 @@ saveChartsSettings = do
       Just (valueInS :: Int) -> return valueInS
       Nothing -> return 0
 
-readSavedChartsSettings :: UI ChartsSettings
-readSavedChartsSettings = liftIO $
-  try_ (decodeFileStrict' =<< getPathToChartsConfig) >>= \case
+readSavedChartsSettings :: TracerEnv -> UI ChartsSettings
+readSavedChartsSettings tracerEnv = liftIO $
+  try_ (decodeFileStrict' =<< getPathToChartsConfig tracerEnv) >>= \case
     Right (Just (settings :: ChartsSettings)) -> return settings
     _ -> return defaultSettings
  where
@@ -320,9 +320,12 @@ dataNameToChartId dataName =
     MempoolBytesData          -> MempoolBytesChart
     TxsInMempoolData          -> TxsInMempoolChart
 
-getSavedColorForNode :: NodeName -> IO (Maybe Color)
-getSavedColorForNode nodeName = do
-  colorsDir <- getPathToChartColorsDir
+getSavedColorForNode
+  :: TracerEnv
+  -> NodeName
+  -> IO (Maybe Color)
+getSavedColorForNode tracerEnv nodeName = do
+  colorsDir <- getPathToChartColorsDir tracerEnv
   colorFiles <- map (\cf -> colorsDir </> takeBaseName cf) <$> listFiles colorsDir
   case find (\cf -> unpack nodeName `isInfixOf` cf) colorFiles of
     Nothing -> return Nothing
@@ -341,7 +344,11 @@ getSavedColorForNode nodeName = do
     && all (\c -> isDigit c || c `elem` ['a' .. 'f'] )
            (tail $ lower code)
 
-saveColorForNode :: NodeName -> Color -> IO ()
-saveColorForNode nodeName (Color code) = do
-  colorsDir <- getPathToChartColorsDir
+saveColorForNode
+  :: TracerEnv
+  -> NodeName
+  -> Color
+  -> IO ()
+saveColorForNode tracerEnv nodeName (Color code) = do
+  colorsDir <- getPathToChartColorsDir tracerEnv
   ignore $ writeFile (colorsDir </> unpack nodeName) code