Add monitoring command to CLI options of local-cluster

cardano-foundation · Apr 23, 2024 · 5fa3a5d · 5fa3a5d
1 parent c93b88f
commit 5fa3a5d
Show file tree

Hide file tree

Showing 6 changed files with 68 additions and 37 deletions.
diff --git a/justfile b/justfile
@@ -31,6 +31,7 @@ bench target:
 local-cluster:
   nix shell '.#local-cluster' '.#cardano-node' '.#cardano-wallet' \
     -c "local-cluster" \
+    monitoring \
     --cluster-configs lib/local-cluster/test/data/cluster-configs \
     --faucet-funds ${FAUCET_FUNDS_FILE} \
     --monitoring-port 12798 \

diff --git a/lib/integration/framework/Test/Integration/Framework/Cluster/Launch.hs b/lib/integration/framework/Test/Integration/Framework/Cluster/Launch.hs
@@ -1,7 +1,6 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE RecordWildCards #-}
-
 {-# OPTIONS_GHC -Wno-redundant-constraints #-}
 
 {-
@@ -39,7 +38,8 @@ import Cardano.Wallet.Launch.Cluster
     )
 import Cardano.Wallet.Launch.Cluster.CommandLine
     ( CommandLineOptions (..)
-    , renderPullingMode
+    , Monitoring
+    , renderMonitoring
     )
 import Cardano.Wallet.Launch.Cluster.Config
     ( Config (..)
@@ -66,9 +66,6 @@ import Control.Monad.Cont
 import Control.Monad.Trans
     ( lift
     )
-import Control.Monitoring
-    ( MonitorState
-    )
 import Data.Aeson
     ( FromJSON
     )
@@ -130,16 +127,13 @@ localClusterProcess CommandLineOptions{..} era = do
             }
   where
     args =
-        [ "--cluster-configs"
+        renderMonitoring monitoring
+        <> [ "--cluster-configs"
         , toFilePath $ absDirOf clusterConfigsDir
         , "--faucet-funds"
         , toFilePath $ absFileOf faucetFundsFile
-        , "--monitoring-port"
-        , show monitoringPort
-        , "--pulling-mode"
-        , renderPullingMode pullingMode
-        ]
-            <> case clusterDir of
+        ] <>
+            case clusterDir of
                 Nothing -> []
                 Just clusterDir' ->
                     [ "--cluster"
@@ -177,10 +171,8 @@ withGenesisData shelleyGenesis = ContT $ \f -> do
 
 withLocalCluster
     :: HasCallStack
-    => Int
-    -- ^ Port for monitoring the local cluster.
-    -> MonitorState
-    -- ^ In which state the monitoring should start.
+    => Maybe Monitoring
+    -- ^ If to monitor the cluster.
     -> Config
     -- ^ Configuration for the cluster.
     -> FaucetFunds
@@ -189,8 +181,7 @@ withLocalCluster
     -- ^ Action to run once when all pools have started.
     -> IO a
 withLocalCluster
-    monitoringPort
-    initialPullingState
+    monitoring
     Config{..}
     faucetFunds
     action = do
@@ -201,7 +192,6 @@ withLocalCluster
                     $ absDirOf cfgClusterDir
                         </> relFile "shelley-genesis.json"
             clusterDir = Just cfgClusterDir
-            pullingMode = initialPullingState
             clusterLogs = cfgClusterLogFile
         evalContT $ do
             faucetFundsFile <- withFaucetFunds faucetFunds

diff --git a/lib/integration/framework/Test/Integration/Framework/Setup.hs b/lib/integration/framework/Test/Integration/Framework/Setup.hs
@@ -123,9 +123,6 @@ import Control.Monad
 import Control.Monad.IO.Class
     ( liftIO
     )
-import Control.Monitoring.Monitor
-    ( MonitorState (..)
-    )
 import Control.Tracer
     ( Tracer (..)
     , contramap
@@ -364,7 +361,7 @@ withServer
                                 $ absDirOf testDir </> relFile "cluster.logs"
                             }
                 traceWith tr $ MsgInfo "Starting local cluster ..."
-                withLocalCluster 6_080 NotPullingState clusterConfig faucetFunds
+                withLocalCluster Nothing clusterConfig faucetFunds
                     $ onClusterStart
                         ctx
                         (onReady (T.pack smashUrl))

diff --git a/lib/local-cluster/exe/local-cluster.hs b/lib/local-cluster/exe/local-cluster.hs
@@ -4,13 +4,17 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedLabels #-}
+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 import Prelude
 
 import Cardano.BM.Extra
     ( stdoutTextTracer
     )
+import Cardano.BM.Tracing
+    ( nullTracer
+    )
 import Cardano.Launcher.Node
     ( nodeSocketFile
     )
@@ -26,6 +30,7 @@ import Cardano.Wallet.Launch.Cluster
     )
 import Cardano.Wallet.Launch.Cluster.CommandLine
     ( CommandLineOptions (..)
+    , Monitoring (..)
     , parseCommandLineOptions
     )
 import Cardano.Wallet.Launch.Cluster.FileOf
@@ -152,14 +157,15 @@ main = withUtf8 $ do
         { clusterConfigsDir
         , faucetFundsFile
         , clusterDir
-        , monitoringPort
-        , pullingMode
+        , monitoring
         , clusterLogs
         } <-
         parseCommandLineOptions
     funds <- retrieveFunds faucetFundsFile
     flip runContT pure $ do
-        trace <- ContT $ withMonitor monitoringPort pullingMode
+        trace <- case monitoring of
+            Just Monitoring{..} -> ContT $ withMonitor monitoringPort pullingMode
+            Nothing -> pure nullTracer
         clusterPath <-
             case clusterDir of
                 Just path -> pure path

diff --git a/lib/local-cluster/lib/Cardano/Wallet/Launch/Cluster/CommandLine.hs b/lib/local-cluster/lib/Cardano/Wallet/Launch/Cluster/CommandLine.hs
@@ -2,13 +2,16 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module Cardano.Wallet.Launch.Cluster.CommandLine
     ( CommandLineOptions (..)
+    , Monitoring (..)
     , parseCommandLineOptions
     , clusterConfigsDirParser
     , renderPullingMode
+    , renderMonitoring
     ) where
 
 import Prelude
@@ -34,10 +37,12 @@ import Network.Wai.Handler.Warp
 import Options.Applicative
     ( Parser
     , auto
+    , command
     , eitherReader
     , execParser
     , help
     , helper
+    , hsubparser
     , info
     , long
     , metavar
@@ -51,30 +56,33 @@ import System.Path
     ( absRel
     )
 
+data Monitoring = Monitoring
+    { monitoringPort :: Port
+    , pullingMode :: MonitorState
+    }
+    deriving stock (Show)
+
 data CommandLineOptions = CommandLineOptions
     { clusterConfigsDir :: DirOf "cluster-configs"
     , faucetFundsFile :: FileOf "faucet-funds"
     , clusterDir :: Maybe (DirOf "cluster")
-    , monitoringPort :: Port
-    , pullingMode :: MonitorState
+    , monitoring :: Maybe Monitoring
     , clusterLogs :: Maybe (FileOf "cluster-logs")
     }
     deriving stock (Show)
 
 parseCommandLineOptions :: IO CommandLineOptions
 parseCommandLineOptions = do
     absolutizer <- newAbsolutizer
+    let options = monitoringParser $ do
+            clusterConfigsDir <- clusterConfigsDirParser absolutizer
+            faucetFundsFile <- faucetFundsParser absolutizer
+            clusterDir <- clusterDirParser absolutizer
+            clusterLogs <- clusterLogsParser absolutizer
+            pure $ \monitoring -> CommandLineOptions{..}
     execParser
         $ info
-            ( CommandLineOptions
-                <$> clusterConfigsDirParser absolutizer
-                <*> faucetFundsParser absolutizer
-                <*> clusterDirParser absolutizer
-                <*> portParser
-                <*> monitorStateParser
-                <*> clusterLogsParser absolutizer
-                <**> helper
-            )
+            (options <**> helper)
             (progDesc "Local Cluster for testing")
 
 clusterConfigsDirParser :: Absolutizer -> Parser (DirOf "cluster-configs")
@@ -146,6 +154,34 @@ renderPullingMode = \case
     NotPullingState -> "not-pulling"
     PullingState -> "pulling"
 
+renderMonitoring :: Maybe Monitoring -> [String]
+renderMonitoring (Just Monitoring{..})  =
+    [ "monitoring"
+    , "--monitoring-port", show monitoringPort
+    , "--pulling-mode", renderPullingMode pullingMode
+    ]
+renderMonitoring Nothing =
+    [ "no-monitoring"
+    ]
+
+monitoringParser :: Parser (Maybe Monitoring -> a) -> Parser a
+monitoringParser f =
+    hsubparser $ monitoringCommand <> noMonitoring
+  where
+    monitoringCommand =
+        command "monitoring"
+            $ info (f <*> yesMonitoringParser)
+            $ progDesc "Enable monitoring"
+    yesMonitoringParser =
+        fmap Just
+            $ Monitoring
+                <$> portParser
+                <*> monitorStateParser
+    noMonitoring =
+        command "no-monitoring"
+            $ info (f <*> pure Nothing)
+            $ progDesc "Disable monitoring"
+
 clusterLogsParser :: Absolutizer -> Parser (Maybe (FileOf "cluster-logs"))
 clusterLogsParser (Absolutizer absOf) =
     optional

diff --git a/lib/local-cluster/local-cluster.cabal b/lib/local-cluster/local-cluster.cabal
@@ -158,6 +158,7 @@ executable local-cluster
     , cardano-wallet-application-extras
     , cardano-wallet-launcher
     , cardano-wallet-primitive
+    , iohk-monitoring
     , iohk-monitoring-extra
     , foldl
     , lens