Remove wallet and node integration logs from stdout

And allow logging to a dedicated log directory by programatically
modifying the CM.Configurations.

lib/cli/src/Cardano/CLI.hs

@@ -57,6 +57,7 @@ module Cardano.CLI
 
     -- * Option parsers for configuring tracing
     , LoggingOptions (..)
+    , LogOutput (..)
     , helperTracing
     , loggingOptions
     , loggingSeverities
@@ -99,6 +100,13 @@ import Cardano.BM.Backend.Switchboard
     ( Switchboard )
 import Cardano.BM.Configuration.Static
     ( defaultConfigStdout )
+import Cardano.BM.Data.Output
+    ( ScribeDefinition (..)
+    , ScribeFormat (..)
+    , ScribeId
+    , ScribeKind (..)
+    , ScribePrivacy (..)
+    )
 import Cardano.BM.Data.Severity
     ( Severity (..) )
 import Cardano.BM.Data.Tracer
@@ -1464,34 +1472,61 @@ data Verbosity
         -- ^ Include more information in the log output.
     deriving (Eq, Show)
 
+data LogOutput
+    = LogToStdout Severity
+    | LogToFile FilePath Severity
+    deriving (Eq, Show)
+
+
+mkScribe :: LogOutput -> ScribeDefinition
+mkScribe (LogToStdout sev) = ScribeDefinition
+    { scName = "text"
+    , scFormat = ScText
+    , scKind = StdoutSK
+    , scMinSev = sev
+    , scMaxSev = Critical
+    , scPrivacy = ScPublic
+    , scRotation = Nothing
+    }
+mkScribe (LogToFile path sev) = ScribeDefinition
+    { scName = T.pack path
+    , scFormat = ScText
+    , scKind = FileSK
+    , scMinSev = sev
+    , scMaxSev = Critical
+    , scPrivacy = ScPublic
+    , scRotation = Nothing
+    }
+
+mkScribeId :: LogOutput -> ScribeId
+mkScribeId (LogToStdout _) = "StdoutSK::text"
+mkScribeId (LogToFile file _) = T.pack $ "FileSK::" <> file
+
+
 -- | Initialize logging at the specified minimum 'Severity' level.
 initTracer
-    :: Maybe FilePath
-    -> Severity
+    :: [LogOutput]
     -> IO (Switchboard Text, (CM.Configuration, Trace IO Text))
-initTracer configFile minSeverity = do
-    let defaultConfig = do
-            c <- defaultConfigStdout
-            CM.setMinSeverity c minSeverity
-            CM.setSetupBackends c [CM.KatipBK, CM.AggregationBK]
-            pure c
-    cfg <- maybe defaultConfig CM.setup configFile
+initTracer outputs = do
+    cfg <- do
+        c <- defaultConfigStdout
+        CM.setSetupBackends c [CM.KatipBK, CM.AggregationBK]
+        CM.setSetupScribes c $ map mkScribe outputs
+        CM.setDefaultScribes c $ map mkScribeId outputs
+        pure c
     (tr, sb) <- setupTrace_ cfg "cardano-wallet"
     pure (sb, (cfg, tr))
 
 -- | Run an action with logging available and configured. When the action is
 -- finished (normally or otherwise), log messages are flushed.
 withLogging
-    :: Maybe FilePath
-    -- ^ Configuration file - uses default otherwise.
-    -> Severity
-    -- ^ Minimum severity level to log
+    :: [LogOutput]
     -> ((CM.Configuration, Trace IO Text) -> IO a)
     -- ^ The action to run with logging configured.
     -> IO a
-withLogging configFile minSeverity action = bracket before after (action . snd)
+withLogging outputs action = bracket before after (action . snd)
   where
-    before = initTracer configFile minSeverity
+    before = initTracer outputs
     after (sb, (_, tr)) = do
         logDebug (appendName "main" tr) "Logging shutdown."
         shutdown sb

lib/jormungandr/exe/cardano-wallet-jormungandr.hs

@@ -28,7 +28,8 @@ import Cardano.BM.Data.Severity
 import Cardano.BM.Trace
     ( Trace, appendName, logInfo, logNotice )
 import Cardano.CLI
-    ( LoggingOptions (..)
+    ( LogOutput (..)
+    , LoggingOptions (..)
     , Port (..)
     , cli
     , cmdAddress
@@ -441,7 +442,7 @@ withTracers
     -> (Trace IO MainLog -> Tracers IO -> IO a)
     -> IO a
 withTracers logOpt action =
-    withLogging Nothing (loggingMinSeverity logOpt) $ \(_, tr) -> do
+    withLogging [LogToStdout $ loggingMinSeverity logOpt] $ \(_, tr) -> do
         let trMain = appendName "main" (transformTextTrace tr)
         let tracers = setupTracers (loggingTracers logOpt) tr
         logInfo trMain $ MsgVersion version gitRevision

lib/jormungandr/test/integration/Main.hs

@@ -20,7 +20,7 @@ import Cardano.BM.Data.Severity
 import Cardano.BM.Trace
     ( Trace, logInfo )
 import Cardano.CLI
-    ( Port (..), withLogging )
+    ( LogOutput (..), Port (..), withLogging )
 import Cardano.Launcher
     ( ProcessHasExited (..) )
 import Cardano.Pool.Jormungandr.Metadata
@@ -132,7 +132,7 @@ instance KnownCommand Jormungandr where
     commandName = "cardano-wallet-jormungandr"
 
 main :: forall t n. (t ~ Jormungandr, n ~ 'Testnet 0) => IO ()
-main = withUtf8Encoding $ withLogging Nothing Info $ \(_, tr) -> do
+main = withUtf8Encoding $ withLogging [LogToStdout Info] $ \(_, tr) -> do
     hspec $ do
         describe "No backend required" $ do
             describe "Cardano.Wallet.NetworkSpec" $ parallel NetworkLayer.spec

lib/shelley/bench/Latency.hs

@@ -375,6 +375,7 @@ withShelleyServer tracers action = do
                 Error
                 []
                 dir
+                Nothing
                 onByron
                 (afterFork dir)
                 (onClusterStart act dir)

lib/shelley/cardano-wallet.cabal

@@ -201,6 +201,8 @@ test-suite integration
     , cardano-wallet
     , cardano-wallet-test-utils
     , contra-tracer
+    , directory
+    , filepath
     , hspec
     , http-client
     , iohk-monitoring

lib/shelley/exe/cardano-wallet.hs

@@ -30,7 +30,8 @@ import Cardano.BM.Data.Severity
 import Cardano.BM.Trace
     ( Trace, appendName, logDebug, logError, logInfo, logNotice )
 import Cardano.CLI
-    ( LoggingOptions
+    ( LogOutput (..)
+    , LoggingOptions
     , cli
     , cmdAddress
     , cmdKey
@@ -291,7 +292,7 @@ withTracers
     -> (Trace IO MainLog -> Tracers IO -> IO a)
     -> IO a
 withTracers logOpt action =
-    withLogging Nothing (loggingMinSeverity logOpt) $ \(_, tr) -> do
+    withLogging [LogToStdout (loggingMinSeverity logOpt)] $ \(_, tr) -> do
         let trMain = appendName "main" (transformTextTrace tr)
         let tracers = setupTracers (loggingTracers logOpt) tr
         logInfo trMain $ MsgVersion version gitRevision

lib/shelley/src/Cardano/Wallet/Shelley/Launch.hs

@@ -53,6 +53,12 @@ import Cardano.Address.Derivation
     ( XPub, xpubPublicKey )
 import Cardano.Api.Shelley.Genesis
     ( ShelleyGenesis (..) )
+import Cardano.BM.Data.Output
+    ( ScribeDefinition (..)
+    , ScribeFormat (..)
+    , ScribeKind (..)
+    , ScribePrivacy (..)
+    )
 import Cardano.BM.Data.Severity
     ( Severity (..) )
 import Cardano.BM.Data.Tracer
@@ -415,6 +421,7 @@ withCluster
     -- ^ The configurations of pools to spawn.
     -> FilePath
     -- ^ Parent state directory for cluster
+    -> Maybe (FilePath, Severity)
     -> (RunningNode -> IO ())
     -- ^ Action to run when Byron is up
     -> (RunningNode -> IO ())
@@ -424,17 +431,18 @@ withCluster
     -> (RunningNode -> IO a)
     -- ^ Action to run when stake pools are running
     -> IO a
-withCluster tr severity poolConfigs dir onByron onFork onClusterStart =
+withCluster tr severity poolConfigs dir logFile onByron onFork onClusterStart =
     bracketTracer' tr "withCluster" $ do
+        traceWith tr $ MsgStartingCluster dir
         let poolCount = length poolConfigs
         (port0:ports) <- randomUnusedTCPPorts (poolCount + 2)
         systemStart <- addUTCTime 1 <$> getCurrentTime
-        let bftCfg = NodeParams severity systemStart (head $ rotate ports)
+        let bftCfg = NodeParams severity systemStart (head $ rotate ports) logFile
         withBFTNode tr dir bftCfg $ \bftSocket block0 params -> do
             let runningBftNode = RunningNode bftSocket block0 params
             waitForSocket tr bftSocket *> onByron runningBftNode
 
-            traceWith tr MsgForkCartouche
+            traceWith tr MsgWaitingForFork
             updateVersion tr dir
             waitForHardFork bftSocket (fst params) 1 *> onFork runningBftNode
 
@@ -466,13 +474,13 @@ withCluster tr severity poolConfigs dir onByron onFork onClusterStart =
                 \(idx, poolConfig, (port, peers)) -> do
                     link =<< async (handle onException $ do
                         let spCfg =
-                                NodeParams severity systemStart (port, peers)
+                                NodeParams severity systemStart (port, peers) logFile
                         withStakePool
                             tr dir idx spCfg (pledgeOf idx) poolConfig $ do
                                 writeChan waitGroup $ Right port
                                 readChan doneGroup)
 
-            traceWith tr MsgClusterCartouche
+            traceWith tr $ MsgRegisteringStakePools poolCount
             group <- waitAll
             if length (filter isRight group) /= poolCount then do
                 cancelAll
@@ -481,7 +489,7 @@ withCluster tr severity poolConfigs dir onByron onFork onClusterStart =
                     ("cluster didn't start correctly: " <> errors)
                     (ExitFailure 1)
             else do
-                let cfg = NodeParams severity systemStart (port0, ports)
+                let cfg = NodeParams severity systemStart (port0, ports) logFile
                 withRelayNode tr dir cfg $ \socket -> do
                     let runningRelay = RunningNode socket block0 params
                     onClusterStart runningRelay `finally` cancelAll
@@ -506,15 +514,21 @@ waitForHardFork _socket np epoch = threadDelay (ceiling (1e6 * delay))
 
 -- | Configuration parameters which update the @node.config@ test data file.
 data NodeParams = NodeParams
-    { minSeverity :: Severity -- ^ Minimum logging severity
-    , systemStart :: UTCTime -- ^ Genesis block start time
-    , nodePeers :: (Int, [Int]) -- ^ A list of ports used by peers and this node
+    { minSeverity :: Severity
+      -- ^ Minimum logging severity
+    , systemStart :: UTCTime
+      -- ^ Genesis block start time
+    , nodePeers :: (Int, [Int])
+      -- ^ A list of ports used by peers and this node
+    , extraLogFile :: Maybe (FilePath, Severity)
+      -- ^ The node will always log to "cardano-node.log" relative to the
+      -- config. This option can be set for an additional output.
     } deriving (Show)
 
-singleNodeParams :: Severity -> IO NodeParams
-singleNodeParams severity = do
+singleNodeParams :: Severity -> Maybe (FilePath, Severity) -> IO NodeParams
+singleNodeParams severity extraLogFile = do
     systemStart <- getCurrentTime
-    pure $ NodeParams severity systemStart (0, [])
+    pure $ NodeParams severity systemStart (0, []) extraLogFile
 
 withBFTNode
     :: Tracer IO ClusterLog
@@ -540,8 +554,9 @@ withBFTNode tr baseDir params action =
             ]
             (\f -> copyFile (source </> f) (dir </> f) $> (dir </> f))
 
+        let extraLogFile = (fmap (first (</> (name ++ ".log"))) logDir)
         (config, block0, networkParams, versionData)
-            <- genConfig dir severity systemStart
+            <- genConfig dir severity extraLogFile systemStart
         topology <- genTopology dir peers
 
         let cfg = CardanoNodeConfig
@@ -566,7 +581,7 @@ withBFTNode tr baseDir params action =
 
     name = "bft"
     dir = baseDir </> name
-    NodeParams severity systemStart (port, peers) = params
+    NodeParams severity systemStart (port, peers) logDir = params
 
 -- | Launches a @cardano-node@ with the given configuration which will not forge
 -- blocks, but has every other cluster node as its peer. Any transactions
@@ -582,11 +597,13 @@ withRelayNode
     -> (FilePath -> IO a)
     -- ^ Callback function with socket path
     -> IO a
-withRelayNode tr baseDir (NodeParams severity systemStart (port, peers)) act =
+withRelayNode tr baseDir (NodeParams severity systemStart (port, peers) logDir) act =
     bracketTracer' tr "withRelayNode" $ do
         createDirectory dir
 
-        (config, _, _, _) <- genConfig dir severity systemStart
+        let extraLogFile = (fmap (first (</> (name ++ ".log"))) logDir)
+        (config, _, _, _) <-
+            genConfig dir severity extraLogFile systemStart
         topology <- genTopology dir peers
 
         let cfg = CardanoNodeConfig
@@ -632,7 +649,7 @@ setupStakePoolData
     -- ^ Optional retirement epoch.
     -> IO (CardanoNodeConfig, FilePath, FilePath)
 setupStakePoolData tr dir name params url pledgeAmt mRetirementEpoch = do
-    let NodeParams severity systemStart (port, peers) = params
+    let NodeParams severity systemStart (port, peers) logDir = params
 
     (opPrv, opPub, opCount, metadata) <- genOperatorKeyPair tr dir
     (vrfPrv, vrfPub) <- genVrfKeyPair tr dir
@@ -647,7 +664,8 @@ setupStakePoolData tr dir name params url pledgeAmt mRetirementEpoch = do
     dlgCert <- issueDlgCert tr dir stakePub opPub
     opCert <- issueOpCert tr dir kesPub opPrv opCount
 
-    (config, _, _, _) <- genConfig dir severity systemStart
+    let extraLogFile = (fmap (first (</> (name ++ ".log"))) logDir)
+    (config, _, _, _) <- genConfig dir severity extraLogFile systemStart
     topology <- genTopology dir peers
 
     -- In order to get a working stake pool we need to.
@@ -779,19 +797,47 @@ genConfig
     -- ^ A top-level directory where to put the configuration.
     -> Severity
     -- ^ Minimum severity level for logging
+    -> Maybe (FilePath, Severity)
+    -- ^ Optional /extra/ logging output
     -> UTCTime
     -- ^ Genesis block start time
     -> IO (FilePath, Block, NetworkParameters, NodeVersionData)
-genConfig dir severity systemStart = do
+genConfig dir severity mExtraLogFile systemStart = do
     let startTime = round @_ @Int . utcTimeToPOSIXSeconds $ systemStart
     let systemStart' = posixSecondsToUTCTime . fromRational . toRational $ startTime
 
+--    let stdoutScribe = ScribeDefinition
+--                { scName = "stdout"
+--                , scFormat = ScText
+--                , scKind = StdoutSK
+--                , scMinSev = severity
+--                , scMaxSev = Critical
+--                , scPrivacy = ScPublic
+--                , scRotation = Nothing
+--                }
+    let fileScribe (path, sev) = ScribeDefinition
+                { scName = path
+                , scFormat = ScText
+                , scKind = FileSK
+                , scMinSev = sev
+                , scMaxSev = Critical
+                , scPrivacy = ScPublic
+                , scRotation = Nothing
+                }
+
+    let scribes = catMaybes
+            [ Just $ fileScribe ("cardano-node.log", severity)
+--            , Just stdoutScribe
+            , fileScribe . first T.pack <$> mExtraLogFile
+            ]
+
     ----
     -- Configuration
     Yaml.decodeFileThrow (source </> "node.config")
         >>= withAddedKey "ShelleyGenesisFile" shelleyGenesisFile
         >>= withAddedKey "ByronGenesisFile" byronGenesisFile
         >>= withAddedKey "minSeverity" Debug
+        >>= withScribes scribes
         >>= withObject (addMinSeverityStdout severity)
         >>= Yaml.encodeFile (dir </> "node.config")
 
@@ -808,6 +854,7 @@ genConfig dir severity systemStart = do
         >>= withObject (pure . updateSystemStart systemStart')
         >>= Aeson.encodeFile shelleyGenesisFile
 
+
     ----
     -- Initial Funds.
     PreserveInitialFundsOrdering initialFunds <-
@@ -848,6 +895,11 @@ genConfig dir severity systemStart = do
     byronGenesisFile :: FilePath
     byronGenesisFile = dir </> "byron-genesis.json"
 
+    withScribes scribes =
+        withAddedKey "setupScribes" scribes
+        >=> withAddedKey "defaultScribes"
+            (map (\s -> [toJSON $ scKind s, toJSON $ scName s]) scribes)
+
     -- we need to specify genesis file location every run in tmp
     withAddedKey k v = withObject (pure . HM.insert k (toJSON v))