cardano-node: integrate with trace-dispatcher

cardano-node/cardano-node.cabal

@@ -75,6 +75,29 @@ library
                        Cardano.Node.Run
                        Cardano.Node.STM
                        Cardano.Node.Types
+                       Cardano.TraceDispatcher.Era.Byron
+                       Cardano.TraceDispatcher.Era.HardFork
+                       Cardano.TraceDispatcher.Era.Shelley
+                       Cardano.TraceDispatcher.Era.ConvertTxId
+                       Cardano.TraceDispatcher.ChainDB.Docu
+                       Cardano.TraceDispatcher.ChainDB.Formatting
+                       Cardano.TraceDispatcher.ChainDB.Combinators
+                       Cardano.TraceDispatcher.Consensus.Docu
+                       Cardano.TraceDispatcher.Consensus.Formatting
+                       Cardano.TraceDispatcher.Consensus.Combinators
+                       Cardano.TraceDispatcher.Consensus.StateInfo
+                       Cardano.TraceDispatcher.Consensus.StartLeadershipCheck
+                       Cardano.TraceDispatcher.Consensus.ForgingThreadStats
+                       Cardano.TraceDispatcher.Resources
+                       Cardano.TraceDispatcher.BasicInfo.Types
+                       Cardano.TraceDispatcher.BasicInfo.Combinators
+                       Cardano.TraceDispatcher.Peer
+                       Cardano.TraceDispatcher.Network.Docu
+                       Cardano.TraceDispatcher.Network.Formatting
+                       Cardano.TraceDispatcher.Network.Combinators
+                       Cardano.TraceDispatcher.Formatting
+                       Cardano.TraceDispatcher.Render
+                       Cardano.TraceDispatcher.Tracers
                        Cardano.Tracing.Config
                        Cardano.Tracing.Constraints
                        Cardano.Tracing.ConvertTxId
@@ -146,6 +169,9 @@ library
                       , text
                       , time
                       , tracer-transformers
+                      , trace-dispatcher
+                      , trace-forward
+                      , trace-resources
                       , transformers
                       , transformers-except
                       , unordered-containers

cardano-node/src/Cardano/Node/Configuration/Logging.hs

@@ -1,8 +1,9 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE CPP                 #-}
+{-# LANGUAGE FlexibleContexts    #-}
+{-# LANGUAGE GADTs               #-}
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE PackageImports      #-}
+{-# LANGUAGE Rank2Types          #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module Cardano.Node.Configuration.Logging
@@ -24,10 +25,11 @@ module Cardano.Node.Configuration.Logging
 
 import           Cardano.Prelude hiding (trace)
 
+import qualified Control.Concurrent as Conc
 import qualified Control.Concurrent.Async as Async
 import           Control.Exception.Safe (MonadCatch)
 import           Control.Monad.Trans.Except.Extra (catchIOExceptT)
-import           Control.Tracer
+import           "contra-tracer" Control.Tracer
 import           Data.List (nub)
 import qualified Data.Map as Map
 import           Data.Text (pack)
@@ -49,7 +51,8 @@ import qualified Cardano.BM.Configuration as Config
 import qualified Cardano.BM.Configuration.Model as Config
 import           Cardano.BM.Data.Aggregated (Measurable (..))
 import           Cardano.BM.Data.Backend (Backend, BackendKind (..))
-import           Cardano.BM.Data.LogItem (LOContent (..), LOMeta (..), LoggerName)
+import           Cardano.BM.Data.LogItem (LOContent (..), LOMeta (..),
+                     LoggerName)
 import qualified Cardano.BM.Observer.Monadic as Monadic
 import qualified Cardano.BM.Observer.STM as Stm
 import           Cardano.BM.Plugin (loadPlugin)
@@ -63,13 +66,13 @@ import qualified Cardano.BM.Trace as Trace
 import           Cardano.BM.Tracing
 
 import qualified Cardano.Chain.Genesis as Gen
-import           Cardano.Slotting.Slot (EpochSize (..))
 import qualified Ouroboros.Consensus.BlockchainTime.WallClock.Types as WCT
 import           Ouroboros.Consensus.Byron.Ledger.Conversions
 import           Ouroboros.Consensus.Cardano.Block
 import           Ouroboros.Consensus.Cardano.CanHardFork
 import qualified Ouroboros.Consensus.Config as Consensus
-import           Ouroboros.Consensus.Config.SupportsNode (ConfigSupportsNode (..))
+import           Ouroboros.Consensus.Config.SupportsNode
+                     (ConfigSupportsNode (..))
 import           Ouroboros.Consensus.HardFork.Combinator.Degenerate
 import           Ouroboros.Consensus.Node.ProtocolInfo
 import           Ouroboros.Consensus.Shelley.Ledger.Ledger
@@ -80,6 +83,8 @@ import           Cardano.Config.Git.Rev (gitRev)
 import           Cardano.Node.Configuration.POM (NodeConfiguration (..), ncProtocol)
 import           Cardano.Node.Protocol.Types (SomeConsensusProtocol (..))
 import           Cardano.Node.Types
+import           Cardano.Slotting.Slot (EpochSize (..))
+import           Cardano.Tracing.Config (TraceOptions (..))
 import           Cardano.Tracing.OrphanInstances.Common ()
 import           Paths_cardano_node (version)
 
@@ -148,12 +153,12 @@ loggingCLIConfiguration = maybe emptyConfig readConfig
 
 -- | Create logging feature for `cardano-node`
 createLoggingLayer
-  :: Text
+  :: TraceOptions
+  -> Text
   -> NodeConfiguration
   -> SomeConsensusProtocol
   -> ExceptT ConfigError IO LoggingLayer
-createLoggingLayer ver nodeConfig' p = do
-
+createLoggingLayer topt ver nodeConfig' p = do
   logConfig <- loggingCLIConfiguration $
     if ncLoggingSwitch nodeConfig'
     -- Re-interpret node config again, as logging 'Configuration':
@@ -165,13 +170,13 @@ createLoggingLayer ver nodeConfig' p = do
     Config.setTextOption logConfig "appversion" ver
     Config.setTextOption logConfig "appcommit" gitRev
 
-  (baseTrace, switchBoard) <- liftIO $ setupTrace_ logConfig "cardano"
+  (baseTrace', switchBoard) <- liftIO $ setupTrace_ logConfig "cardano"
 
   let loggingEnabled :: Bool
       loggingEnabled = ncLoggingSwitch nodeConfig'
       trace :: Trace IO Text
       trace = if loggingEnabled
-              then baseTrace
+              then baseTrace'
               else Trace.nullTracer
 
   when loggingEnabled $ liftIO $
@@ -244,7 +249,7 @@ createLoggingLayer ver nodeConfig' p = do
 
      when (ncLogMetrics nodeConfig) $
        -- Record node metrics, if configured
-       startCapturingMetrics trace
+       startCapturingMetrics topt trace
 
    mkLogLayer :: Configuration -> Switchboard Text -> Maybe EKGDirect -> Trace IO Text -> LoggingLayer
    mkLogLayer logConfig switchBoard mbEkgDirect trace =
@@ -267,14 +272,20 @@ createLoggingLayer ver nodeConfig' p = do
        , llEKGDirect = mbEkgDirect
        }
 
-   startCapturingMetrics :: Trace IO Text -> IO ()
-   startCapturingMetrics tr = do
+   startCapturingMetrics :: TraceOptions
+    -> Trace IO Text
+    -> IO ()
+   startCapturingMetrics (TraceDispatcher _) _tr = do
+      pure ()
+
+   startCapturingMetrics _ tr = do
      void . Async.async . forever $ do
        readResourceStats
          >>= maybe (pure ())
                    (traceResourceStats
                       (appendName "node" tr))
-       threadDelay 1000000 -- TODO:  make configurable
+       Conc.threadDelay 1000000 -- TODO:  make configurable
+
    traceResourceStats :: Trace IO Text -> ResourceStats -> IO ()
    traceResourceStats tr rs = do
      traceWith (toLogObject' NormalVerbosity $ appendName "resources" tr) rs

cardano-node/src/Cardano/Node/Configuration/POM.hs

@@ -148,9 +148,16 @@ instance FromJSON PartialNodeConfiguration where
       pncMaxConcurrencyDeadline <- Last <$> v .:? "MaxConcurrencyDeadline"
 
       -- Logging parameters
-      pncLoggingSwitch <- Last . Just <$> v .:? "TurnOnLogging" .!= True
-      pncLogMetrics    <- Last        <$> v .:? "TurnOnLogMetrics"
-      pncTraceConfig   <- Last . Just <$> traceConfigParser v
+      pncLoggingSwitch'  <-                 v .:? "TurnOnLogging" .!= True
+      pncLogMetrics      <- Last        <$> v .:? "TurnOnLogMetrics"
+      useTraceDispatcher <-                 v .:? "UseTraceDispatcher" .!= False
+      pncTraceConfig     <- if pncLoggingSwitch'
+                            then Last . Just <$>
+                                 traceConfigParser v
+                                 (if useTraceDispatcher
+                                  then TraceDispatcher
+                                  else TracingOn)
+                            else return . Last $ Just TracingOff
 
       -- Protocol parameters
       protocol <-  v .:? "Protocol" .!= ByronProtocol
@@ -175,7 +182,7 @@ instance FromJSON PartialNodeConfiguration where
            , pncTestEnableDevelopmentNetworkProtocols
            , pncMaxConcurrencyBulkSync
            , pncMaxConcurrencyDeadline
-           , pncLoggingSwitch
+           , pncLoggingSwitch = Last $ Just pncLoggingSwitch'
            , pncLogMetrics
            , pncTraceConfig
            , pncNodeIPv4Addr = mempty

cardano-node/src/Cardano/Node/Handlers/Shutdown.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE PackageImports #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -33,7 +34,7 @@ import qualified System.Process as IO (createPipeFd)
 import           Cardano.BM.Data.Tracer (TracingVerbosity (..), severityNotice, trTransformer)
 import           Cardano.BM.Trace
 import           Cardano.Slotting.Slot (WithOrigin (..))
-import           Control.Tracer
+import "contra-tracer" Control.Tracer
 import qualified Ouroboros.Consensus.Storage.ChainDB as ChainDB
 import           Ouroboros.Consensus.Util.ResourceRegistry (ResourceRegistry)
 import           Ouroboros.Consensus.Util.STM (Watcher(..), forkLinkedWatcher)

cardano-node/src/Cardano/Node/Protocol/Byron.hs

@@ -40,6 +40,10 @@ import           Cardano.Tracing.OrphanInstances.Byron ()
 import           Cardano.Tracing.OrphanInstances.HardFork ()
 import           Cardano.Tracing.OrphanInstances.Shelley ()
 
+import           Cardano.TraceDispatcher.Era.Byron ()
+import           Cardano.TraceDispatcher.Era.HardFork ()
+import           Cardano.TraceDispatcher.ChainDB.Formatting ()
+
 
 ------------------------------------------------------------------------------
 -- Byron protocol

cardano-node/src/Cardano/Node/Protocol/Shelley.hs

@@ -54,6 +54,10 @@ import           Cardano.Node.Types
 import           Cardano.Tracing.OrphanInstances.HardFork ()
 import           Cardano.Tracing.OrphanInstances.Shelley ()
 
+import           Cardano.TraceDispatcher.Era.HardFork ()
+import           Cardano.TraceDispatcher.Era.Shelley ()
+import           Cardano.TraceDispatcher.Formatting ()
+
 import           Cardano.Node.Protocol.Types
 
 ------------------------------------------------------------------------------

cardano-node/src/Cardano/Node/Protocol/Types.hs

@@ -5,6 +5,7 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE MonoLocalBinds #-}
 
 module Cardano.Node.Protocol.Types
   ( Protocol(..)
@@ -23,6 +24,7 @@ import           Cardano.Node.Orphans ()
 import           Cardano.Tracing.Constraints (TraceConstraints)
 import           Cardano.Tracing.Metrics (HasKESInfo, HasKESMetricsData)
 
+
 data Protocol = ByronProtocol
               | ShelleyProtocol
               | CardanoProtocol
@@ -47,8 +49,6 @@ instance FromJSON Protocol where
       _ -> fail $ "Parsing of Protocol failed. "
                 <> show str <> " is not a valid protocol"
 
-
-
 data SomeConsensusProtocol where
 
      SomeConsensusProtocol :: forall blk. ( Cardano.Protocol IO blk