Fmaste/dmq node

cabal.project

@@ -20,6 +20,14 @@ index-state:
   -- Bump this if you need newer packages from CHaP
   , cardano-haskell-packages 2025-03-18T17:41:11Z
 
+-- `trace-dispatcher` from repo "cardano-node" branch "fmaste/dmq-node".
+source-repository-package
+  type: git
+  location: https://github.com/IntersectMBO/cardano-node.git
+  subdir: trace-dispatcher
+  tag: 9d25e72454269ecca5f138ee2abf3cbbfa619428
+  --sha256: 1asb9gx7w50p31wv6hnac7hcmvs3h2m5zrm57p1dpmb70h38xz74
+
 packages: ./cardano-ping
           ./monoidal-synchronisation
           ./network-mux

dmq-node/app/Main.hs

@@ -3,14 +3,14 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TemplateHaskell     #-}
 {-# LANGUAGE TypeApplications    #-}
+{-# LANGUAGE PackageImports      #-}
 
 module Main where
 
 import Control.Monad (void, when)
-import Control.Tracer (Tracer (..), nullTracer, traceWith)
+import "contra-tracer" Control.Tracer (Tracer (..), traceWith)
 
 import Data.Act
-import Data.Aeson (ToJSON)
 import Data.Functor.Contravariant ((>$<))
 import Data.Maybe (maybeToList)
 import Data.Text qualified as Text
@@ -46,6 +46,8 @@ import Ouroboros.Network.TxSubmission.Mempool.Simple qualified as Mempool
 
 import Paths_dmq_node qualified as Meta
 
+import qualified Cardano.Logging as Logging
+
 main :: IO ()
 main = toplevelExceptionHandler $ void . runDMQ =<< execParser opts
   where
@@ -66,16 +68,25 @@ runDMQ commandLineConfig = do
     -- combine default configuration, configuration file and command line
     -- options
     let dmqConfig@Configuration {
-          dmqcPrettyLog            = I prettyLog,
           dmqcTopologyFile         = I topologyFile,
-          dmqcHandshakeTracer      = I handshakeTracer,
-          dmqcLocalHandshakeTracer = I localHandshakeTracer,
           dmqcVersion              = I version
         } = config' <> commandLineConfig
             `act`
             defaultConfiguration
-    let tracer :: ToJSON ev => Tracer IO (WithEventType ev)
-        tracer = dmqTracer prettyLog
+    {-- Alternative A
+    -- Also available "readConfigurationWithDefault"!
+    --}
+    traceConfig <- Logging.readConfiguration configFilePath
+
+    {--
+    (dmqTracer' :: forall ev. ToJSON ev => Logging.Trace IO (WithEventType ev))
+      <- mkCardanoTracer traceConfig
+    dmqTracer' :: forall ev. ToJSON ev => Logging.Trace IO (WithEventType ev)
+    --}
+    dmqTracer' <- mkCardanoTracer traceConfig
+
+    let tracer :: Tracer IO WithEventType
+        tracer = dmqTracer dmqTracer'
 
     when version $ do
       let gitrev = $(gitRev)
@@ -95,9 +106,10 @@ runDMQ commandLineConfig = do
         ]
       exitSuccess
 
-    traceWith tracer (WithEventType "Configuration" dmqConfig)
+    traceWith tracer (WithEventType (DMQ "Configuration") dmqConfig)
+
     nt <- readTopologyFileOrError topologyFile
-    traceWith tracer (WithEventType "NetworkTopology" nt)
+    traceWith tracer (WithEventType (DMQ "NetworkTopology") nt)
 
     stdGen <- newStdGen
     let (psRng, policyRng) = split stdGen
@@ -128,12 +140,8 @@ runDMQ commandLineConfig = do
                             mempoolReader mempoolWriter maxMsgs
                             (NtC.dmqCodecs encodeReject decodeReject)
           dmqDiffusionArguments =
-            diffusionArguments (if handshakeTracer
-                                  then WithEventType "Handshake" >$< tracer
-                                  else nullTracer)
-                               (if localHandshakeTracer
-                                  then WithEventType "Handshake" >$< tracer
-                                  else nullTracer)
+            diffusionArguments (WithEventType (DMQ "Handshake") >$< tracer)
+                               (WithEventType (DMQ "LocalHandshake") >$< tracer)
           dmqDiffusionApplications =
             diffusionApplications nodeKernel
                                   dmqConfig

dmq-node/config.json

@@ -1,2 +1,46 @@
 { "NetworkMagic": 12
+, "TraceOptions": {
+    "": {
+      "backends": [
+        "Stdout MachineFormat"
+      ],
+      "severity": "Info"
+    }
+  , "Handshake": {
+      "severity": "Debug"
+    }
+  , "LocalMux": {
+      "severity": "Debug"
+    }
+  , "LocalHandshake": {
+      "severity": "Debug"
+    }
+  , "Diffusion": {
+      "severity": "Debug"
+    }
+  , "PeerSelection": {
+      "severity": "Debug"
+    }
+  , "PeerSelectionCounters": {
+      "severity": "Debug"
+    }
+  , "ConnectionManager": {
+      "severity": "Debug"
+    }
+  , "Server": {
+      "severity": "Debug"
+    }
+  , "InboundGovernor": {
+      "severity": "Debug"
+    }
+  , "LocalMsgSubmission.Protocol.Server": {
+      "severity": "Debug"
+    }
+  , "LocalMsgNotification.Protocol.Server": {
+      "severity": "Debug"
+    }
+  , "SigSubmission.Inbound": {
+      "severity": "Debug"
+    }
+  }
 }

dmq-node/dmq-node.cabal

@@ -108,6 +108,7 @@ library
     singletons,
     text >=1.2.4 && <2.2,
     time ^>=1.12,
+    trace-dispatcher ^>= 2.10.0,
     typed-protocols:{typed-protocols, cborg} ^>=1.1,
 
   hs-source-dirs: src
@@ -127,7 +128,6 @@ executable dmq-node
 
   build-depends:
     acts,
-    aeson,
     base,
     cardano-git-rev,
     contra-tracer >=0.1 && <0.3,
@@ -137,6 +137,7 @@ executable dmq-node
     ouroboros-network:{ouroboros-network, api},
     random,
     text,
+    trace-dispatcher ^>= 2.10.0
 
   hs-source-dirs: app
   default-language: Haskell2010
@@ -175,6 +176,7 @@ test-suite dmq-tests
     serialise,
     tasty,
     tasty-quickcheck,
+    trace-dispatcher ^>= 2.10.0,
     typed-protocols:{typed-protocols, codec-properties},
     with-utf8,
 

dmq-node/src/DMQ/Configuration.hs

@@ -103,51 +103,6 @@ data Configuration' f =
     dmqcChurnInterval                              :: f DiffTime,
     dmqcPeerSharing                                :: f PeerSharing,
     dmqcNetworkMagic                               :: f NetworkMagic,
-    dmqcPrettyLog                                  :: f Bool,
-
-    dmqcMuxTracer                                  :: f Bool,
-    dmqcChannelTracer                              :: f Bool,
-    dmqcBearerTracer                               :: f Bool,
-    dmqcHandshakeTracer                            :: f Bool,
-    dmqcLocalMuxTracer                             :: f Bool,
-    dmqcLocalChannelTracer                         :: f Bool,
-    dmqcLocalBearerTracer                          :: f Bool,
-    dmqcLocalHandshakeTracer                       :: f Bool,
-    dmqcDiffusionTracer                            :: f Bool,
-    dmqcTraceLocalRootPeersTracer                  :: f Bool,
-    dmqcTracePublicRootPeersTracer                 :: f Bool,
-    dmqcTraceLedgerPeersTracer                     :: f Bool,
-    dmqcTracePeerSelectionTracer                   :: f Bool,
-    dmqcTraceChurnCounters                         :: f Bool,
-    dmqcDebugPeerSelectionInitiatorTracer          :: f Bool,
-    dmqcDebugPeerSelectionInitiatorResponderTracer :: f Bool,
-    dmqcTracePeerSelectionCounters                 :: f Bool,
-    dmqcPeerSelectionActionsTracer                 :: f Bool,
-    dmqcConnectionManagerTracer                    :: f Bool,
-    dmqcConnectionManagerTransitionTracer          :: f Bool,
-    dmqcServerTracer                               :: f Bool,
-    dmqcInboundGovernorTracer                      :: f Bool,
-    dmqcInboundGovernorTransitionTracer            :: f Bool,
-    dmqcLocalConnectionManagerTracer               :: f Bool,
-    dmqcLocalServerTracer                          :: f Bool,
-    dmqcLocalInboundGovernorTracer                 :: f Bool,
-    dmqcDnsTracer                                  :: f Bool,
-
-    -- low level verbose traces which trace protocol messages
-    -- TODO: pref
-    dmqcSigSubmissionClientProtocolTracer          :: f Bool,
-    dmqcSigSubmissionServerProtocolTracer          :: f Bool,
-    dmqcKeepAliveClientProtocolTracer              :: f Bool,
-    dmqcKeepAliveServerProtocolTracer              :: f Bool,
-    dmqcPeerSharingClientProtocolTracer            :: f Bool,
-    dmqcPeerSharingServerProtocolTracer            :: f Bool,
-    dmqcLocalMsgSubmissionServerProtocolTracer     :: f Bool,
-    dmqcLocalMsgNotificationServerProtocolTracer   :: f Bool,
-
-    dmqcSigSubmissionLogicTracer                   :: f Bool,
-    dmqcSigSubmissionOutboundTracer                :: f Bool,
-    dmqcSigSubmissionInboundTracer                 :: f Bool,
-    dmqcLocalMsgSubmissionServerTracer             :: f Bool,
 
     dmqcVersion                                    :: f Bool
   }
@@ -222,48 +177,6 @@ defaultConfiguration = Configuration {
       dmqcProtocolIdleTimeout                        = I defaultProtocolIdleTimeout,
       dmqcChurnInterval                              = I defaultDeadlineChurnInterval,
       dmqcPeerSharing                                = I PeerSharingEnabled,
-      dmqcPrettyLog                                  = I False,
-      dmqcMuxTracer                                  = I False,
-      dmqcChannelTracer                              = I False,
-      dmqcBearerTracer                               = I False,
-      dmqcHandshakeTracer                            = I True,
-      dmqcLocalMuxTracer                             = I True,
-      dmqcLocalChannelTracer                         = I False,
-      dmqcLocalBearerTracer                          = I False,
-      dmqcLocalHandshakeTracer                       = I True,
-      dmqcDiffusionTracer                            = I True,
-      dmqcTraceLocalRootPeersTracer                  = I False,
-      dmqcTracePublicRootPeersTracer                 = I False,
-      dmqcTraceLedgerPeersTracer                     = I False,
-      dmqcTracePeerSelectionTracer                   = I True,
-      dmqcTraceChurnCounters                         = I False,
-      dmqcDebugPeerSelectionInitiatorTracer          = I False,
-      dmqcDebugPeerSelectionInitiatorResponderTracer = I False,
-      dmqcTracePeerSelectionCounters                 = I True,
-      dmqcPeerSelectionActionsTracer                 = I False,
-      dmqcConnectionManagerTracer                    = I True,
-      dmqcConnectionManagerTransitionTracer          = I False,
-      dmqcServerTracer                               = I True,
-      dmqcInboundGovernorTracer                      = I True,
-      dmqcInboundGovernorTransitionTracer            = I False,
-      dmqcLocalConnectionManagerTracer               = I False,
-      dmqcLocalServerTracer                          = I False,
-      dmqcLocalInboundGovernorTracer                 = I False,
-      dmqcDnsTracer                                  = I False,
-
-      dmqcSigSubmissionClientProtocolTracer          = I False,
-      dmqcSigSubmissionServerProtocolTracer          = I False,
-      dmqcKeepAliveClientProtocolTracer              = I False,
-      dmqcKeepAliveServerProtocolTracer              = I False,
-      dmqcPeerSharingClientProtocolTracer            = I False,
-      dmqcPeerSharingServerProtocolTracer            = I False,
-      dmqcLocalMsgSubmissionServerProtocolTracer     = I True,
-      dmqcLocalMsgNotificationServerProtocolTracer   = I True,
-
-      dmqcSigSubmissionOutboundTracer                = I False,
-      dmqcSigSubmissionInboundTracer                 = I True,
-      dmqcSigSubmissionLogicTracer                   = I False,
-      dmqcLocalMsgSubmissionServerTracer             = I True,
 
       -- CLI only options
       dmqcVersion                                    = I False
@@ -312,50 +225,6 @@ instance FromJSON PartialConfig where
       dmqcProtocolIdleTimeout <- Last <$> v .:? "ProtocolIdleTimeout"
       dmqcChurnInterval <- Last <$> v .:? "ChurnInterval"
 
-      dmqcPrettyLog <- Last <$> v .:? "PrettyLog"
-
-      dmqcMuxTracer                                  <- Last <$> v .:? "MuxTracer"
-      dmqcChannelTracer                              <- Last <$> v .:? "ChannelTracer"
-      dmqcBearerTracer                               <- Last <$> v .:? "BearerTracer"
-      dmqcHandshakeTracer                            <- Last <$> v .:? "HandshakeTracer"
-      dmqcLocalMuxTracer                             <- Last <$> v .:? "LocalMuxTracer"
-      dmqcLocalChannelTracer                         <- Last <$> v .:? "LocalChannelTracer"
-      dmqcLocalBearerTracer                          <- Last <$> v .:? "LocalBearerTracer"
-      dmqcLocalHandshakeTracer                       <- Last <$> v .:? "LocalHandshakeTracer"
-      dmqcDiffusionTracer                            <- Last <$> v .:? "DiffusionTracer"
-      dmqcTraceLocalRootPeersTracer                  <- Last <$> v .:? "LocalRootPeersTracer"
-      dmqcTracePublicRootPeersTracer                 <- Last <$> v .:? "PublicRootPeersTracer"
-      dmqcTraceLedgerPeersTracer                     <- Last <$> v .:? "LedgerPeersTracer"
-      dmqcTracePeerSelectionTracer                   <- Last <$> v .:? "PeerSelectionTracer"
-      dmqcTraceChurnCounters                         <- Last <$> v .:? "ChurnCounters"
-      dmqcDebugPeerSelectionInitiatorTracer          <- Last <$> v .:? "DebugPeerSelectionInitiatorTracer"
-      dmqcDebugPeerSelectionInitiatorResponderTracer <- Last <$> v .:? "DebugPeerSelectionInitiatorResponderTracer"
-      dmqcTracePeerSelectionCounters                 <- Last <$> v .:? "PeerSelectionCounters"
-      dmqcPeerSelectionActionsTracer                 <- Last <$> v .:? "PeerSelectionActionsTracer"
-      dmqcConnectionManagerTracer                    <- Last <$> v .:? "ConnectionManagerTracer"
-      dmqcConnectionManagerTransitionTracer          <- Last <$> v .:? "ConnectionManagerTransitionTracer"
-      dmqcServerTracer                               <- Last <$> v .:? "ServerTracer"
-      dmqcInboundGovernorTracer                      <- Last <$> v .:? "InboundGovernorTracer"
-      dmqcInboundGovernorTransitionTracer            <- Last <$> v .:? "InboundGovernorTransitionTracer"
-      dmqcLocalConnectionManagerTracer               <- Last <$> v .:? "LocalConnectionManagerTracer"
-      dmqcLocalServerTracer                          <- Last <$> v .:? "LocalServerTracer"
-      dmqcLocalInboundGovernorTracer                 <- Last <$> v .:? "LocalInboundGovernorTracer"
-      dmqcDnsTracer                                  <- Last <$> v .:? "DnsTracer"
-
-      dmqcSigSubmissionClientProtocolTracer          <- Last <$> v .:? "SigSubmissionClientProtocolTracer"
-      dmqcSigSubmissionServerProtocolTracer          <- Last <$> v .:? "SigSubmissionServerProtocolTracer"
-      dmqcKeepAliveClientProtocolTracer              <- Last <$> v .:? "KeepAliveServerProtocolTracer"
-      dmqcKeepAliveServerProtocolTracer              <- Last <$> v .:? "KeepAliveClientProtocolTracer"
-      dmqcPeerSharingClientProtocolTracer            <- Last <$> v .:? "PeerSharingServerProtocolTracer"
-      dmqcPeerSharingServerProtocolTracer            <- Last <$> v .:? "PeerSharingClientProtocolTracer"
-      dmqcLocalMsgSubmissionServerProtocolTracer     <- Last <$> v .:? "LocalMsgSubmissionServerProtocolracer"
-      dmqcLocalMsgNotificationServerProtocolTracer   <- Last <$> v .:? "LocalMsgNotificationServerProtocolracer"
-
-      dmqcSigSubmissionOutboundTracer                <- Last <$> v .:? "SigSubmissionOutboundTracer"
-      dmqcSigSubmissionInboundTracer                 <- Last <$> v .:? "SigSubmissionInboundTracer"
-      dmqcSigSubmissionLogicTracer                   <- Last <$> v .:? "SigSubmissionLogicTracer"
-      dmqcLocalMsgSubmissionServerTracer             <- Last <$> v .:? "LocalMsgSubmissionServerTracer"
-
       pure $
         Configuration
           { dmqcIPv4         = Last dmqcIPv4
@@ -389,45 +258,6 @@ instance ToJSON Configuration where
            , "ChurnInterval"                              .= unI dmqcChurnInterval
            , "PeerSharing"                                .= unI dmqcPeerSharing
            , "NetworkMagic"                               .= unNetworkMagic (unI dmqcNetworkMagic)
-           , "PrettyLog"                                  .= unI dmqcPrettyLog
-           , "MuxTracer"                                  .= unI dmqcMuxTracer
-           , "ChannelTracer"                              .= unI dmqcChannelTracer
-           , "BearerTracer"                               .= unI dmqcBearerTracer
-           , "HandshakeTracer"                            .= unI dmqcHandshakeTracer
-           , "LocalMuxTracer"                             .= unI dmqcLocalMuxTracer
-           , "LocalChannelTracer"                         .= unI dmqcLocalChannelTracer
-           , "LocalBearerTracer"                          .= unI dmqcLocalBearerTracer
-           , "LocalHandshakeTracer"                       .= unI dmqcLocalHandshakeTracer
-           , "DiffusionTracer"                            .= unI dmqcDiffusionTracer
-           , "LocalRootPeersTracer"                       .= unI dmqcTraceLocalRootPeersTracer
-           , "PublicRootPeersTracer"                      .= unI dmqcTracePublicRootPeersTracer
-           , "LedgerPeersTracer"                          .= unI dmqcTraceLedgerPeersTracer
-           , "PeerSelectionTracer"                        .= unI dmqcTracePeerSelectionTracer
-           , "ChurnCounters"                              .= unI dmqcTraceChurnCounters
-           , "DebugPeerSelectionInitiatorTracer"          .= unI dmqcDebugPeerSelectionInitiatorTracer
-           , "DebugPeerSelectionInitiatorResponderTracer" .= unI dmqcDebugPeerSelectionInitiatorResponderTracer
-           , "PeerSelectionCounters"                      .= unI dmqcTracePeerSelectionCounters
-           , "PeerSelectionActionsTracer"                 .= unI dmqcPeerSelectionActionsTracer
-           , "ConnectionManagerTracer"                    .= unI dmqcConnectionManagerTracer
-           , "ConnectionManagerTransitionTracer"          .= unI dmqcConnectionManagerTransitionTracer
-           , "ServerTracer"                               .= unI dmqcServerTracer
-           , "InboundGovernorTracer"                      .= unI dmqcInboundGovernorTracer
-           , "InboundGovernorTransitionTracer"            .= unI dmqcInboundGovernorTransitionTracer
-           , "LocalConnectionManagerTracer"               .= unI dmqcLocalConnectionManagerTracer
-           , "LocalServerTracer"                          .= unI dmqcLocalServerTracer
-           , "LocalInboundGovernorTracer"                 .= unI dmqcLocalInboundGovernorTracer
-           , "DnsTracer"                                  .= unI dmqcDnsTracer
-           , "SigSubmissionClientProtocolTracer"          .= unI dmqcSigSubmissionClientProtocolTracer
-           , "SigSubmissionServerProtocolTracer"          .= unI dmqcSigSubmissionServerProtocolTracer
-           , "KeepAliveClientProtocolTracer"              .= unI dmqcKeepAliveClientProtocolTracer
-           , "KeepAliveServerProtocolTracer"              .= unI dmqcKeepAliveServerProtocolTracer
-           , "PeerSharingClientProtocolTracer"            .= unI dmqcPeerSharingClientProtocolTracer
-           , "PeerSharingServerProtocolTracer"            .= unI dmqcPeerSharingServerProtocolTracer
-           , "LocalMsgSubmissionServerProtocolTracer"     .= unI dmqcLocalMsgSubmissionServerProtocolTracer
-           , "LocalMsgNotificationServerProtocolTracer"   .= unI dmqcLocalMsgNotificationServerProtocolTracer
-           , "SigSubmissionOutboundTracer"                .= unI dmqcSigSubmissionOutboundTracer
-           , "SigSubmissionInboundTracer"                 .= unI dmqcSigSubmissionInboundTracer
-           , "SigSubmissionLogicTracer"                   .= unI dmqcSigSubmissionLogicTracer
            ]
 
 -- | Read the `DMQConfiguration` from the specified file.
@@ -462,7 +292,7 @@ readConfigurationFileOrError
   -> IO PartialConfig
 readConfigurationFileOrError nc =
       readConfigurationFile nc
-  >>= either (\err -> error $ "DMQ.Topology.eeadConfigurationFile: "
+  >>= either (\err -> error $ "DMQ.Topology.readConfigurationFile: "
                            <> Text.unpack err)
              pure