Add cluster logs-to-file option

cardano-foundation · Apr 23, 2024 · 6593fbb · 6593fbb
1 parent c017e1a
commit 6593fbb
Show file tree

Hide file tree

Showing 7 changed files with 40 additions and 11 deletions.
diff --git a/lib/benchmarks/exe/latency-bench.hs b/lib/benchmarks/exe/latency-bench.hs
@@ -673,6 +673,7 @@ withShelleyServer tracers action = withFaucet $ \faucetClientEnv -> do
                         , cfgTracer = stdoutTextTracer
                         , cfgNodeOutputFile = Nothing
                         , cfgRelayNodePath = mkRelDirOf "relay"
+                        , cfgClusterLogFile = Nothing
                         }
             withCluster
                 nullTracer

diff --git a/lib/integration/framework/Test/Integration/Framework/Cluster/Launch.hs b/lib/integration/framework/Test/Integration/Framework/Cluster/Launch.hs
@@ -88,7 +88,9 @@ import System.Environment
     ( getEnvironment
     )
 import System.IO.Extra
-    ( withTempFile
+    ( IOMode (..)
+    , withFile
+    , withTempFile
     )
 import System.Path
     ( absFile
@@ -107,18 +109,24 @@ import qualified Data.ByteString as BS
 localClusterProcess
     :: CommandLineOptions
     -> ClusterEra
-    -> IO CreateProcess
+    -> ContT r IO CreateProcess
 localClusterProcess CommandLineOptions{..} era = do
-    myEnv <- getEnvironment
+    myEnv <- lift getEnvironment
+
     let envs =
             [ ("LOCAL_CLUSTER_ERA", clusterEraToString era)
             ]
+    output <- case clusterLogs of
+            Nothing -> pure Inherit
+            Just (FileOf logFile) ->
+                fmap UseHandle
+                    $ ContT $ withFile (toFilePath logFile) WriteMode
     pure
         $ (proc "local-cluster" args)
             { env = Just $ myEnv ++ envs
             , -- , cwd = Just $ nodeDir cfg
-              std_out = Inherit
-            , std_err = Inherit
+              std_out = output
+            , std_err = output
             }
   where
     args =
@@ -194,17 +202,14 @@ withLocalCluster
                         </> relFile "genesis-shelley.json"
             clusterDir = Just cfgClusterDir
             pullingMode = initialPullingState
+            clusterLogs = cfgClusterLogFile
         evalContT $ do
             faucetFundsFile <- withFaucetFunds faucetFunds
             socketPath <- withSocketPath
                 $ DirOf
                 $ absDirOf cfgClusterDir
                     </> relDirOf cfgRelayNodePath
-            cp <-
-                lift
-                    $ localClusterProcess
-                        CommandLineOptions{..}
-                        cfgLastHardFork
+            cp <- localClusterProcess CommandLineOptions{..} cfgLastHardFork
             void
                 $ ContT
                 $ withBackendCreateProcess

diff --git a/lib/integration/framework/Test/Integration/Framework/Setup.hs b/lib/integration/framework/Test/Integration/Framework/Setup.hs
@@ -359,6 +359,9 @@ withServer
                             , cfgTracer = tr'
                             , cfgNodeOutputFile = nodeOutputFile
                             , cfgRelayNodePath = mkRelDirOf "relay"
+                            , cfgClusterLogFile = Just
+                                $ FileOf @"cluster-logs"
+                                $ absDirOf testDir </> relFile "cluster.logs"
                             }
                 traceWith tr $ MsgInfo "Starting local cluster ..."
                 withLocalCluster 6_080 NotPullingState clusterConfig faucetFunds
@@ -478,6 +481,9 @@ setupContext
                             , cfgTracer = tr'
                             , cfgNodeOutputFile = nodeOutputFile
                             , cfgRelayNodePath = mkRelDirOf "relay"
+                            , cfgClusterLogFile = Just
+                                $ FileOf @"cluster-logs"
+                                $ absDirOf testDir </> relFile "cluster.logs"
                             }
             traceWith tr $ MsgInfo "Context set up."
             putMVar

diff --git a/lib/local-cluster/exe/local-cluster.hs b/lib/local-cluster/exe/local-cluster.hs
@@ -154,6 +154,7 @@ main = withUtf8 $ do
         , clusterDir
         , monitoringPort
         , pullingMode
+        , clusterLogs
         } <-
         parseCommandLineOptions
     funds <- retrieveFunds faucetFundsFile
@@ -178,6 +179,7 @@ main = withUtf8 $ do
                     , cfgTracer = stdoutTextTracer
                     , cfgNodeOutputFile = Nothing
                     , cfgRelayNodePath = mkRelDirOf "relay"
+                    , cfgClusterLogFile = clusterLogs
                     }
         let clusterDirPath = absDirOf clusterPath
             walletDir = clusterDirPath </> relDir "wallet"

diff --git a/lib/local-cluster/lib/Cardano/Wallet/Launch/Cluster/CommandLine.hs b/lib/local-cluster/lib/Cardano/Wallet/Launch/Cluster/CommandLine.hs
@@ -57,6 +57,7 @@ data CommandLineOptions = CommandLineOptions
     , clusterDir :: Maybe (DirOf "cluster")
     , monitoringPort :: Port
     , pullingMode :: MonitorState
+    , clusterLogs :: Maybe (FileOf "cluster-logs")
     }
     deriving stock (Show)
 
@@ -71,6 +72,7 @@ parseCommandLineOptions = do
                 <*> clusterDirParser absolutizer
                 <*> portParser
                 <*> monitorStateParser
+                <*> clusterLogsParser absolutizer
                 <**> helper
             )
             (progDesc "Local Cluster for testing")
@@ -143,3 +145,13 @@ renderPullingMode :: MonitorState -> String
 renderPullingMode = \case
     NotPullingState -> "not-pulling"
     PullingState -> "pulling"
+
+clusterLogsParser :: Absolutizer -> Parser (Maybe (FileOf "cluster-logs"))
+clusterLogsParser (Absolutizer absOf) =
+    optional
+        $ FileOf . absOf . absRel
+            <$> strOption
+                ( long "cluster-logs"
+                    <> metavar "LOCAL_CLUSTER_LOGS"
+                    <> help "Path to the local cluster logs file"
+                )
diff --git a/lib/local-cluster/lib/Cardano/Wallet/Launch/Cluster/Config.hs b/lib/local-cluster/lib/Cardano/Wallet/Launch/Cluster/Config.hs
@@ -69,4 +69,7 @@ data Config = Config
     , cfgNodeOutputFile :: Maybe (FileOf "node-output")
     -- ^ File to write node output to.
     , cfgRelayNodePath :: RelDirOf "relay"
+    -- ^ Path segment for relay node.
+    , cfgClusterLogFile :: Maybe (FileOf "cluster-logs")
+    -- ^ File to write cluster logs to.
     }
diff --git a/lib/unit/test/unit/Cardano/Wallet/Shelley/NetworkSpec.hs b/lib/unit/test/unit/Cardano/Wallet/Shelley/NetworkSpec.hs
@@ -355,7 +355,7 @@ withTestNode tr action = do
                         , cfgTracer = tr
                         , cfgNodeOutputFile = Nothing
                         , cfgRelayNodePath = mkRelDirOf "relay"
-
+                        , cfgClusterLogFile = Nothing
                         }
             withCluster nullTracer clusterConfig (FaucetFunds [] [] [])
                 $ \(RunningNode sock genesisData vData) -> do