From 593e520cc929ff6b6491fe33c2940c7e220d5d1e Mon Sep 17 00:00:00 2001 From: Federico Mastellone Date: Tue, 27 Jan 2026 13:24:23 +0000 Subject: [PATCH 1/5] typo --- dmq-node/src/DMQ/Configuration.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/dmq-node/src/DMQ/Configuration.hs b/dmq-node/src/DMQ/Configuration.hs index fc0b1ec..d0032cc 100644 --- a/dmq-node/src/DMQ/Configuration.hs +++ b/dmq-node/src/DMQ/Configuration.hs @@ -513,7 +513,7 @@ readConfigurationFileOrError -> IO PartialConfig readConfigurationFileOrError nc = readConfigurationFile nc - >>= either (\err -> error $ "DMQ.Topology.eeadConfigurationFile: " + >>= either (\err -> error $ "DMQ.Topology.readConfigurationFile: " <> Text.unpack err) pure From a700c7e1f666367e85cb737e0c0131921271cf80 Mon Sep 17 00:00:00 2001 From: Federico Mastellone Date: Tue, 27 Jan 2026 13:28:57 +0000 Subject: [PATCH 2/5] Configure cabal for trace-dispatcher --- dmq-node/dmq-node.cabal | 1 + 1 file changed, 1 insertion(+) diff --git a/dmq-node/dmq-node.cabal b/dmq-node/dmq-node.cabal index 0d1e735..c8d8da8 100644 --- a/dmq-node/dmq-node.cabal +++ b/dmq-node/dmq-node.cabal @@ -123,6 +123,7 @@ library singletons, text >=1.2.4 && <2.2, time >=1.12 && <1.15, + trace-dispatcher ^>= 2.10.0, transformers, typed-protocols:{typed-protocols, cborg} ^>=1.1, From 3c74e1f5aeaf4ca37d64b40fa1486ca35020987c Mon Sep 17 00:00:00 2001 From: Federico Mastellone Date: Tue, 27 Jan 2026 15:33:37 +0000 Subject: [PATCH 3/5] Minimun complete ? --- dmq-node/app/Main.hs | 49 +-- dmq-node/dmq-node.cabal | 1 - dmq-node/src/DMQ/Configuration.hs | 182 +------- dmq-node/src/DMQ/Diffusion/Arguments.hs | 3 +- dmq-node/src/DMQ/Diffusion/NodeKernel.hs | 17 +- dmq-node/src/DMQ/NodeToClient.hs | 28 +- .../DMQ/NodeToClient/LocalMsgNotification.hs | 3 +- .../DMQ/NodeToClient/LocalMsgSubmission.hs | 3 +- .../DMQ/NodeToClient/LocalStateQueryClient.hs | 3 +- dmq-node/src/DMQ/NodeToNode.hs | 56 +-- dmq-node/src/DMQ/Tracer.hs | 400 ++++++++++++------ 11 files changed, 333 insertions(+), 412 deletions(-) diff --git a/dmq-node/app/Main.hs b/dmq-node/app/Main.hs index 714d7b7..ad6df08 100644 --- a/dmq-node/app/Main.hs +++ b/dmq-node/app/Main.hs @@ -3,6 +3,7 @@ {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PackageImports #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} @@ -11,13 +12,11 @@ module Main where import Control.Concurrent.Class.MonadSTM.Strict -import Control.Concurrent.Class.MonadMVar import Control.Monad (void, when) import Control.Monad.Class.MonadThrow -import Control.Tracer (Tracer (..), nullTracer, traceWith) +import "contra-tracer" Control.Tracer (traceWith) import Data.Act -import Data.Aeson (ToJSON) import Data.ByteString.Lazy qualified as BSL import Data.Functor.Contravariant ((>$<)) import Data.Foldable (traverse_) @@ -47,7 +46,9 @@ import DMQ.NodeToNode (NodeToNodeVersion, dmqCodecs, dmqLimitsAndTimeouts, ntnApps) import DMQ.Protocol.SigSubmission.Type (Sig (..)) import DMQ.Tracer - + ( mkCardanoTracer + , WithEventType (WithEventType), EventType (DMQ) + ) import DMQ.Diffusion.PeerSelection (policy) import DMQ.NodeToClient.LocalStateQueryClient import DMQ.Protocol.SigSubmission.Validate @@ -81,24 +82,14 @@ runDMQ commandLineConfig = do -- combine default configuration, configuration file and command line -- options let dmqConfig@Configuration { - dmqcPrettyLog = I prettyLog, dmqcTopologyFile = I topologyFile, - dmqcHandshakeTracer = I handshakeTracer, - dmqcValidationTracer = I validationTracer, - dmqcLocalHandshakeTracer = I localHandshakeTracer, dmqcCardanoNodeSocket = I snocketPath, - dmqcVersion = I version, - dmqcLocalStateQueryTracer = I localStateQueryTracer + dmqcVersion = I version } = config' <> commandLineConfig `act` defaultConfiguration - lock <- newMVar () - let tracer', tracer :: ToJSON ev => Tracer IO (WithEventType ev) - tracer' = dmqTracer prettyLog - -- use a lock to prevent writing two lines at the same time - -- TODO: this won't be needed with `cardano-tracer` integration - tracer = Tracer $ \a -> withMVar lock $ \_ -> traceWith tracer' a + (tracer, dmqDiffusionTracers) <- mkCardanoTracer configFilePath when version $ do let gitrev = $(gitRev) @@ -117,9 +108,9 @@ 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 @@ -129,9 +120,7 @@ runDMQ commandLineConfig = do withIOManager \iocp -> do let localSnocket' = localSnocket iocp mkStakePoolMonitor = connectToCardanoNode - (if localStateQueryTracer - then WithEventType "LocalStateQuery" >$< tracer - else nullTracer) + (WithEventType (DMQ "LocalStateQuery") >$< tracer) localSnocket' snocketPath @@ -146,9 +135,7 @@ runDMQ commandLineConfig = do let sigSize :: Sig StandardCrypto -> SizeInBytes sigSize = fromIntegral . BSL.length . sigRawBytes mempoolReader = Mempool.getReader sigId sigSize (mempool nodeKernel) - ntnValidationTracer = if validationTracer - then WithEventType "NtN Validation" >$< tracer - else nullTracer + ntnValidationTracer = (WithEventType (DMQ "NtC Validation") >$< tracer) dmqNtNApps = let ntnMempoolWriter = Mempool.getWriter SigDuplicate @@ -180,9 +167,7 @@ runDMQ commandLineConfig = do (decodeRemoteAddress (maxBound @NodeToNodeVersion))) dmqLimitsAndTimeouts defaultSigDecisionPolicy - ntcValidationTracer = if validationTracer - then WithEventType "NtC Validation" >$< tracer - else nullTracer + ntcValidationTracer = (WithEventType (DMQ "NtC Validation") >$< tracer) dmqNtCApps = let ntcMempoolWriter = Mempool.getWriter SigDuplicate @@ -198,12 +183,8 @@ runDMQ commandLineConfig = do mempoolReader ntcMempoolWriter NtC.dmqCodecs 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) $ maybe [] out <$> tryReadTMVar nodeKernel.stakePools.ledgerPeersVar where out :: LedgerPeerSnapshot AllLedgerPeers @@ -220,6 +201,6 @@ runDMQ commandLineConfig = do (policy policyRngVar) Diffusion.run dmqDiffusionArguments - (dmqDiffusionTracers dmqConfig tracer) + dmqDiffusionTracers dmqDiffusionConfiguration dmqDiffusionApplications diff --git a/dmq-node/dmq-node.cabal b/dmq-node/dmq-node.cabal index c8d8da8..b8c1b40 100644 --- a/dmq-node/dmq-node.cabal +++ b/dmq-node/dmq-node.cabal @@ -145,7 +145,6 @@ executable dmq-node build-depends: Win32-network, acts, - aeson, base, bytestring, cardano-git-rev, diff --git a/dmq-node/src/DMQ/Configuration.hs b/dmq-node/src/DMQ/Configuration.hs index d0032cc..3b05631 100644 --- a/dmq-node/src/DMQ/Configuration.hs +++ b/dmq-node/src/DMQ/Configuration.hs @@ -128,61 +128,14 @@ data Configuration' f = dmqcTargetOfEstablishedBigLedgerPeers :: f Int, dmqcTargetOfActiveBigLedgerPeers :: f Int, - -- - -- Tracers & logging - -- - 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, +{-- TODO: New config options after moving to new repo! dmqcValidationTracer :: 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, - -- -- Application tracers -- - - dmqcSigSubmissionLogicTracer :: f Bool, - dmqcSigSubmissionOutboundTracer :: f Bool, - dmqcSigSubmissionInboundTracer :: f Bool, - dmqcLocalMsgSubmissionServerTracer :: f Bool, dmqcLocalMsgNotificationServerTracer :: f Bool, dmqcLocalStateQueryTracer :: f Bool, +--} -- | CLI only option to show version and exit. dmqcVersion :: f Bool @@ -261,51 +214,12 @@ defaultConfiguration = Configuration { dmqcProtocolIdleTimeout = I defaultProtocolIdleTimeout, dmqcChurnInterval = I defaultDeadlineChurnInterval, dmqcPeerSharing = I PeerSharingEnabled, - dmqcPrettyLog = I False, - dmqcMuxTracer = I True, - 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 True, - 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 True, - dmqcLocalServerTracer = I False, - dmqcLocalInboundGovernorTracer = I False, - dmqcDnsTracer = I False, - dmqcValidationTracer = I True, - 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 True, - dmqcLocalMsgSubmissionServerTracer = I True, +{-- TODO: New config options after moving to new repo! + dmqcValidationTracer = I True, dmqcLocalMsgNotificationServerTracer = I False, dmqcLocalStateQueryTracer = I True, +--} -- CLI only options dmqcVersion = I False @@ -356,52 +270,11 @@ 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" +{-- TODO: New config options after moving to new repo! dmqcValidationTracer <- Last <$> v .:? "ValidationTracer" - - 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" dmqcLocalMsgNotificationServerTracer <- Last <$> v .:? "LocalMsgNotificationServerTracer" dmqcLocalStateQueryTracer <- Last <$> v .:? "LocalStateQueryTracer" +--} pure $ Configuration @@ -438,47 +311,10 @@ instance ToJSON Configuration where , "PeerSharing" .= unI dmqcPeerSharing , "NetworkMagic" .= unNetworkMagic (unI dmqcNetworkMagic) , "CardanoNetworkMagic" .= unNetworkMagic (unI dmqcCardanoNetworkMagic) - , "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 +{-- TODO: New config options after moving to new repo! , "ValidationTracer" .= unI dmqcValidationTracer - , "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 , "LocalStateQueryTracer" .= unI dmqcLocalStateQueryTracer +--} ] -- | Read the `DMQConfiguration` from the specified file. diff --git a/dmq-node/src/DMQ/Diffusion/Arguments.hs b/dmq-node/src/DMQ/Diffusion/Arguments.hs index a00ea72..3eff917 100644 --- a/dmq-node/src/DMQ/Diffusion/Arguments.hs +++ b/dmq-node/src/DMQ/Diffusion/Arguments.hs @@ -2,6 +2,7 @@ {-# LANGUAGE KindSignatures #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PackageImports #-} module DMQ.Diffusion.Arguments ( diffusionArguments @@ -21,7 +22,7 @@ import Control.Exception (IOException) import Control.Monad.Class.MonadST (MonadST) import Control.Monad.Class.MonadThrow (MonadCatch) import Control.Monad.Class.MonadTimer.SI (MonadDelay, MonadTimer) -import Control.Tracer (Tracer) +import "contra-tracer" Control.Tracer (Tracer) import Data.List.NonEmpty (NonEmpty) import Network.DNS (Resolver) import Network.Socket (Socket) diff --git a/dmq-node/src/DMQ/Diffusion/NodeKernel.hs b/dmq-node/src/DMQ/Diffusion/NodeKernel.hs index 2c7a484..49026cb 100644 --- a/dmq-node/src/DMQ/Diffusion/NodeKernel.hs +++ b/dmq-node/src/DMQ/Diffusion/NodeKernel.hs @@ -1,5 +1,6 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PackageImports #-} +{-# LANGUAGE RankNTypes #-} module DMQ.Diffusion.NodeKernel ( NodeKernel (..) @@ -15,9 +16,8 @@ import Control.Monad.Class.MonadAsync import Control.Monad.Class.MonadThrow import Control.Monad.Class.MonadTime.SI import Control.Monad.Class.MonadTimer.SI -import Control.Tracer (Tracer, nullTracer) +import "contra-tracer" Control.Tracer (Tracer, nullTracer) -import Data.Aeson qualified as Aeson import Data.Function (on) import Data.Functor.Contravariant ((>$<)) import Data.Hashable @@ -180,7 +180,7 @@ withNodeKernel :: forall crypto ntnAddr m a. , Show ntnAddr , Hashable ntnAddr ) - => (forall ev. Aeson.ToJSON ev => Tracer m (WithEventType ev)) + => Tracer m WithEventType -> Configuration -> StdGen -> (NetworkMagic -> NodeKernel crypto ntnAddr m -> m (Either SomeException Void)) @@ -190,8 +190,7 @@ withNodeKernel :: forall crypto ntnAddr m a. -> m a withNodeKernel tracer Configuration { - dmqcSigSubmissionLogicTracer = I sigSubmissionLogicTracer, - dmqcCardanoNetworkMagic = I networkMagic + dmqcCardanoNetworkMagic = I networkMagic } rng mkStakePoolMonitor k = do @@ -203,9 +202,7 @@ withNodeKernel tracer withAsync (mempoolWorker mempool) $ \mempoolThread -> withAsync (decisionLogicThreads - (if sigSubmissionLogicTracer - then WithEventType "SigSubmission.Logic" >$< tracer - else nullTracer) + (WithEventType (DMQ "SigSubmission.Logic") >$< tracer) nullTracer defaultSigDecisionPolicy sigChannelVar diff --git a/dmq-node/src/DMQ/NodeToClient.hs b/dmq-node/src/DMQ/NodeToClient.hs index e2291bd..378666e 100644 --- a/dmq-node/src/DMQ/NodeToClient.hs +++ b/dmq-node/src/DMQ/NodeToClient.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE PackageImports #-} {-# LANGUAGE RankNTypes #-} module DMQ.NodeToClient @@ -24,7 +25,7 @@ import Control.Concurrent.Class.MonadSTM import Control.Monad.Class.MonadFork import Control.Monad.Class.MonadST (MonadST) import Control.Monad.Class.MonadThrow -import Control.Tracer (Tracer, nullTracer) +import "contra-tracer" Control.Tracer (Tracer, nullTracer) import Codec.CBOR.Term qualified as CBOR @@ -141,18 +142,14 @@ ntcApps , Aeson.ToJSON ntcAddr , ShowProxy (Sig crypto) ) - => (forall ev. Aeson.ToJSON ev => Tracer m (WithEventType ev)) + => (Tracer m WithEventType) -> Configuration -> TxSubmissionMempoolReader SigId (Sig crypto) idx m -> TxSubmissionMempoolWriter SigId (Sig crypto) idx m SigValidationError -> Codecs crypto m -> Apps ntcAddr m () ntcApps tracer - Configuration { dmqcLocalMsgSubmissionServerProtocolTracer = I localMsgSubmissionServerProtocolTracer, - dmqcLocalMsgNotificationServerProtocolTracer = I localMsgNotificationServerProtocolTracer, - dmqcLocalMsgSubmissionServerTracer = I localMsgSubmissionServerTracer, - dmqcLocalMsgNotificationServerTracer = I localMsgNotificationServerTracer - } + _ mempoolReader TxSubmissionMempoolWriter { mempoolAddTxs } Codecs { msgSubmissionCodec, msgNotificationCodec } = @@ -164,17 +161,13 @@ ntcApps tracer aLocalMsgSubmission _version ResponderContext { rcConnectionId = connId } channel = do labelThisThread "LocalMsgSubmission.Server" runAnnotatedPeer - (if localMsgSubmissionServerProtocolTracer - then WithEventType "LocalMsgSubmission.Protocol.Server" . Mx.WithBearer connId >$< tracer - else nullTracer) + (WithEventType (DMQ "LocalMsgSubmission.Protocol.Server") . Mx.WithBearer connId >$< tracer) msgSubmissionCodec channel (localMsgSubmissionServerPeer $ localMsgSubmissionServer sigId - (if localMsgSubmissionServerTracer - then WithEventType "LocalMsgSubmission.Server" . Mx.WithBearer connId >$< tracer - else nullTracer) + (WithEventType (DMQ "LocalMsgSubmission.Server") . Mx.WithBearer connId >$< tracer) (\sig -> mempoolAddTxs [sig] <&> \case (sigId:_, _) -> Right sigId (_, (sigId, err):_) -> Left (sigId, err) @@ -185,18 +178,13 @@ ntcApps tracer aLocalMsgNotification _version ResponderContext { rcConnectionId = connId } channel = do labelThisThread "LocalMsgNotification.Server" runAnnotatedPeer - (if localMsgNotificationServerProtocolTracer - then WithEventType "LocalMsgNotification.Protocol.Server" . Mx.WithBearer connId >$< tracer - else nullTracer) + (WithEventType (DMQ "LocalMsgNotification.Protocol.Server") . Mx.WithBearer connId >$< tracer) msgNotificationCodec channel (localMsgNotificationServerPeer $ localMsgNotificationServer sigId - (if localMsgNotificationServerTracer - then WithEventType "LocalMsgNotification.Server" . Mx.WithBearer connId >$< tracer - else nullTracer - ) + (WithEventType (DMQ "LocalMsgNotification.Server") . Mx.WithBearer connId >$< tracer) (pure ()) _ntc_MAX_SIGS_TO_ACK mempoolReader) diff --git a/dmq-node/src/DMQ/NodeToClient/LocalMsgNotification.hs b/dmq-node/src/DMQ/NodeToClient/LocalMsgNotification.hs index 7be1efd..4924a54 100644 --- a/dmq-node/src/DMQ/NodeToClient/LocalMsgNotification.hs +++ b/dmq-node/src/DMQ/NodeToClient/LocalMsgNotification.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PackageImports #-} module DMQ.NodeToClient.LocalMsgNotification ( localMsgNotificationServer @@ -7,7 +8,7 @@ module DMQ.NodeToClient.LocalMsgNotification import Control.Concurrent.Class.MonadSTM import Control.Monad.Class.MonadThrow -import Control.Tracer +import "contra-tracer" Control.Tracer (Tracer, traceWith) import Data.Aeson ((.=)) import Data.Aeson qualified as Aeson import Data.List.NonEmpty qualified as NonEmpty diff --git a/dmq-node/src/DMQ/NodeToClient/LocalMsgSubmission.hs b/dmq-node/src/DMQ/NodeToClient/LocalMsgSubmission.hs index 8552946..30e8d4f 100644 --- a/dmq-node/src/DMQ/NodeToClient/LocalMsgSubmission.hs +++ b/dmq-node/src/DMQ/NodeToClient/LocalMsgSubmission.hs @@ -1,5 +1,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PackageImports #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE UndecidableInstances #-} @@ -7,7 +8,7 @@ module DMQ.NodeToClient.LocalMsgSubmission where import Control.Monad.Class.MonadThrow -import Control.Tracer +import "contra-tracer" Control.Tracer (Tracer, traceWith) import Data.Aeson (ToJSON (..), object, (.=)) import Data.Aeson qualified as Aeson import Data.Typeable diff --git a/dmq-node/src/DMQ/NodeToClient/LocalStateQueryClient.hs b/dmq-node/src/DMQ/NodeToClient/LocalStateQueryClient.hs index c9f7265..74a4620 100644 --- a/dmq-node/src/DMQ/NodeToClient/LocalStateQueryClient.hs +++ b/dmq-node/src/DMQ/NodeToClient/LocalStateQueryClient.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DisambiguateRecordFields #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE PackageImports #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeOperators #-} @@ -14,7 +15,7 @@ import Control.Monad.Class.MonadThrow import Control.Monad.Class.MonadTime.SI import Control.Monad.Class.MonadTimer.SI import Control.Monad.Trans.Except -import Control.Tracer (Tracer (..), nullTracer, traceWith) +import "contra-tracer" Control.Tracer (Tracer, traceWith, nullTracer) import Data.Aeson (ToJSON (..), object, (.=)) import Data.Aeson qualified as Aeson import Data.Map.Strict qualified as Map diff --git a/dmq-node/src/DMQ/NodeToNode.hs b/dmq-node/src/DMQ/NodeToNode.hs index a489f08..3a31386 100644 --- a/dmq-node/src/DMQ/NodeToNode.hs +++ b/dmq-node/src/DMQ/NodeToNode.hs @@ -2,6 +2,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PackageImports #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -33,7 +34,7 @@ import Control.Monad.Class.MonadFork import Control.Monad.Class.MonadST import Control.Monad.Class.MonadThrow import Control.Monad.Class.MonadTimer.SI -import Control.Tracer (Tracer, nullTracer) +import "contra-tracer" Control.Tracer (Tracer, nullTracer) import Codec.CBOR.Decoding qualified as CBOR import Codec.CBOR.Encoding qualified as CBOR @@ -54,7 +55,7 @@ import Network.TypedProtocol.Codec (AnnotatedCodec, Codec) import Cardano.KESAgent.KES.Crypto (Crypto (..)) -import DMQ.Configuration (Configuration, Configuration' (..), I (..)) +import DMQ.Configuration (Configuration) import DMQ.Diffusion.NodeKernel (NodeKernel (..)) import DMQ.NodeToNode.Version import DMQ.Protocol.SigSubmission.Codec @@ -163,7 +164,7 @@ ntnApps , Hashable addr , Aeson.ToJSON addr ) - => (forall ev. Aeson.ToJSON ev => Tracer m (WithEventType ev)) + => (Tracer m WithEventType) -> Configuration -> TxSubmissionMempoolReader SigId (Sig crypto) idx m -> TxSubmissionMempoolWriter SigId (Sig crypto) idx m SigValidationError @@ -175,18 +176,7 @@ ntnApps -> Apps addr m () () ntnApps tracer - Configuration { - dmqcSigSubmissionClientProtocolTracer = I sigSubmissionClientProtocolTracer - , dmqcSigSubmissionServerProtocolTracer = I sigSubmissionServerProtocolTracer - , dmqcKeepAliveClientProtocolTracer = I keepAliveClientProtocolTracer - , dmqcKeepAliveServerProtocolTracer = I keepAliveServerProtocolTracer - , dmqcPeerSharingClientProtocolTracer = I peerSharingClientProtocolTracer - , dmqcPeerSharingServerProtocolTracer = I peerSharingServerProtocolTracer - - , dmqcSigSubmissionOutboundTracer = I sigSubmissionOutboundTracer - , dmqcSigSubmissionInboundTracer = I sigSubmissionInboundTracer - , dmqcSigSubmissionLogicTracer = I sigSubmissionLogicTracer - } + _ mempoolReader mempoolWriter sigSize @@ -234,18 +224,14 @@ ntnApps eicControlMessage = controlMessage } channel = runAnnotatedPeerWithLimits - (if sigSubmissionClientProtocolTracer - then WithEventType "SigSubmission.Protocol.Client" . Mx.WithBearer connId >$< tracer - else nullTracer) + (WithEventType (DMQ "SigSubmission.Protocol.Client") . Mx.WithBearer connId >$< tracer) sigSubmissionCodec sigSubmissionSizeLimits sigSubmissionTimeLimits channel $ txSubmissionClientPeer $ txSubmissionOutbound - (if sigSubmissionOutboundTracer - then WithEventType "SigSubmission.Outbound" . Mx.WithBearer connId >$< tracer - else nullTracer) + (WithEventType (DMQ "SigSubmission.Outbound") . Mx.WithBearer connId >$< tracer) _MAX_SIGS_TO_ACK mempoolReader version @@ -259,9 +245,7 @@ ntnApps -> m ((), Maybe BL.ByteString) aSigSubmissionServer _version ResponderContext { rcConnectionId = connId } channel = SigSubmission.withPeer - (if sigSubmissionLogicTracer - then WithEventType "SigSubmission.Logic" . Mx.WithBearer connId >$< tracer - else nullTracer) + (WithEventType (DMQ "SigSubmission.Logic") . Mx.WithBearer connId >$< tracer) sigChannelVar sigMempoolSem sigDecisionPolicy @@ -272,18 +256,14 @@ ntnApps (remoteAddress connId) $ \(peerSigAPI :: PeerTxAPI m SigId (Sig crypto)) -> runPipelinedAnnotatedPeerWithLimits - (if sigSubmissionServerProtocolTracer - then WithEventType "SigSubmission.Protocol.Server" . Mx.WithBearer connId >$< tracer - else nullTracer) + (WithEventType (DMQ "SigSubmission.Protocol.Server") . Mx.WithBearer connId >$< tracer) sigSubmissionCodec sigSubmissionSizeLimits sigSubmissionTimeLimits channel $ txSubmissionServerPeerPipelined $ txSubmissionInboundV2 - (if sigSubmissionInboundTracer - then WithEventType "SigSubmission.Inbound" . Mx.WithBearer connId >$< tracer - else nullTracer) + (WithEventType (DMQ "SigSubmission.Inbound") . Mx.WithBearer connId >$< tracer) _SIG_SUBMISSION_INIT_DELAY mempoolWriter peerSigAPI @@ -303,9 +283,7 @@ ntnApps labelThisThread "KeepAlive.Client" let kacApp dqCtx = runPeerWithLimits - (if keepAliveClientProtocolTracer - then WithEventType "KeepAlive.Protocol.Client" . Mx.WithBearer connId >$< tracer - else nullTracer) + (WithEventType (DMQ "KeepAlive.Protocol.Client") . Mx.WithBearer connId >$< tracer) keepAliveCodec keepAliveSizeLimits keepAliveTimeLimits @@ -333,9 +311,7 @@ ntnApps channel = do labelThisThread "KeepAlive.Server" runPeerWithLimits - (if keepAliveServerProtocolTracer - then WithEventType "KeepAlive.Protocol.Server" . Mx.WithBearer connId >$< tracer - else nullTracer) + (WithEventType (DMQ "KeepAlive.Protocol.Server") . Mx.WithBearer connId >$< tracer) keepAliveCodec keepAliveSizeLimits keepAliveTimeLimits @@ -359,9 +335,7 @@ ntnApps $ \controller -> do psClient <- peerSharingClient controlMessageSTM controller ((), trailing) <- runPeerWithLimits - (if peerSharingClientProtocolTracer - then WithEventType "PeerSharing.Protocol.Client" . Mx.WithBearer connId >$< tracer - else nullTracer) + (WithEventType (DMQ "PeerSharing.Protocol.Client") . Mx.WithBearer connId >$< tracer) peerSharingCodec peerSharingSizeLimits peerSharingTimeLimits @@ -381,9 +355,7 @@ ntnApps channel = do labelThisThread "PeerSharing.Server" runPeerWithLimits - (if peerSharingServerProtocolTracer - then WithEventType "PeerSharing.Protocol.Server" . Mx.WithBearer connId >$< tracer - else nullTracer) + (WithEventType (DMQ "PeerSharing.Protocol.Server") . Mx.WithBearer connId >$< tracer) peerSharingCodec peerSharingSizeLimits peerSharingTimeLimits diff --git a/dmq-node/src/DMQ/Tracer.hs b/dmq-node/src/DMQ/Tracer.hs index 9643f81..fcd3b52 100644 --- a/dmq-node/src/DMQ/Tracer.hs +++ b/dmq-node/src/DMQ/Tracer.hs @@ -1,6 +1,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PackageImports #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -8,8 +9,8 @@ {-# OPTIONS_GHC -Wno-orphans #-} module DMQ.Tracer - ( dmqTracer - , dmqDiffusionTracers + ( mkCardanoTracer + , EventType (..) , WithEventType (..) , NoExtraPeers (..) , NoExtraState (..) @@ -23,16 +24,16 @@ module DMQ.Tracer ) where import Codec.CBOR.Term (Term) -import Control.Monad.Class.MonadTime -import Control.Tracer +import "contra-tracer" Control.Tracer import Data.Aeson import Data.Aeson.Encode.Pretty (encodePretty) -import Data.Bool (bool) -import Data.ByteString.Lazy.Char8 qualified as LBS.Char8 +import Data.Aeson.KeyMap (fromList) import Data.Functor.Contravariant ((>$<)) import Data.Set qualified as Set import Data.Text qualified as Text +import Data.Text.Lazy (toStrict) +import Data.Text.Lazy.Encoding (decodeUtf8) import Ouroboros.Network.Diffusion qualified as Diffusion import Ouroboros.Network.OrphanInstances () @@ -42,38 +43,245 @@ import Ouroboros.Network.PeerSelection.PublicRootPeers (PublicRootPeers) import Ouroboros.Network.PeerSelection.PublicRootPeers qualified as PublicRootPeers import Ouroboros.Network.Snocket (RemoteAddress) +import qualified Cardano.Logging as Logging + import DMQ.Configuration import DMQ.NodeToClient.Version import DMQ.NodeToNode.Version -data TraceEvent ev = TraceEvent - { time :: UTCTime - , eventType :: String - , event :: ev - } +data EventType = + -- From `Tracers` in "Ouroboros.Network.Diffusion.Types" + Mux + | Channel + | Bearer + | Handshake + | LocalMux + | LocalChannel + | LocalBearer + | LocalHandshake + | Diffusion + | LocalRootPeers + | PublicRootPeers + | LedgerPeers + | PeerSelection + | DebugPeerSelectionInitiator + | DebugPeerSelectionInitiatorResponder + | PeerSelectionCounters + | ChurnCounters + | PeerSelectionActions + | ConnectionManager + | ConnectionManagerTransition + | Server + | InboundGovernor + | InboundGovernorTransition + | Dns + | LocalConnectionManager + | LocalServer + | LocalInboundGovernor + -- Plus custom DMQ tracers. + | DMQ String + deriving (Eq, Show) -instance ToJSON ev => ToJSON (TraceEvent ev) where - toJSON TraceEvent {time, eventType, event} = - object [ "time" .= time - , "type" .= eventType - , "event" .= event - ] +data WithEventType = forall a. ToJSON a => WithEventType EventType a + +instance Logging.LogFormatting WithEventType where + -- Machine readable representation with varying details based on the detail level. + -- forMachine :: DetailLevel -> a -> Aeson.Object + forMachine _ (WithEventType _ event) = fromList [ ("data", toJSON event) ] + -- Human readable representation. + -- forHuman :: a -> Text + forHuman (WithEventType _ event) = toStrict $ decodeUtf8 $ encodePretty event + -- Metrics representation. + -- asMetrics :: a -> [Metric] + asMetrics _ = [] -data WithEventType a = WithEventType String a - deriving Show -instance ToJSON a => ToJSON (WithEventType a) where - toJSON (WithEventType eventType a) = toJSON (eventType, a) +instance Logging.MetaTrace WithEventType where + -- allNamespaces :: [Namespace a] + allNamespaces = [ + -- Diffusion traces. + -------------------- + Logging.Namespace [] ["Mux"] + , Logging.Namespace [] ["Channel"] + , Logging.Namespace [] ["Bearer"] + , Logging.Namespace [] ["Handshake"] + , Logging.Namespace [] ["LocalMux"] + , Logging.Namespace [] ["LocalChannel"] + , Logging.Namespace [] ["LocalBearer"] + , Logging.Namespace [] ["LocalHandshake"] + , Logging.Namespace [] ["Diffusion"] + , Logging.Namespace [] ["LocalRootPeers"] + , Logging.Namespace [] ["PublicRootPeers"] + , Logging.Namespace [] ["LedgerPeers"] + , Logging.Namespace [] ["PeerSelection"] + , Logging.Namespace [] ["DebugPeerSelectionInitiator"] + , Logging.Namespace [] ["DebugPeerSelectionInitiatorResponder"] + , Logging.Namespace [] ["PeerSelectionCounters"] + , Logging.Namespace [] ["ChurnCounters"] + , Logging.Namespace [] ["PeerSelectionActions"] + , Logging.Namespace [] ["ConnectionManager"] + , Logging.Namespace [] ["ConnectionManagerTransition"] + , Logging.Namespace [] ["Server"] + , Logging.Namespace [] ["InboundGovernor"] + , Logging.Namespace [] ["InboundGovernorTransition"] + , Logging.Namespace [] ["DnsTracer"] + , Logging.Namespace [] ["LocalConnectionManager"] + , Logging.Namespace [] ["LocalServer"] + , Logging.Namespace [] ["LocalInboundGovernor"] + -- DMQ-Node only traces. + ------------------------ + -- Main. + , Logging.Namespace [] ["Configuration"] + , Logging.Namespace [] ["NetworkTopology"] + , Logging.Namespace [] ["LocalStateQuery"] + , Logging.Namespace [] ["NtC Validation"] + -- Diffusion.NodeKernel + , Logging.Namespace [] ["SigSubmission.Logic"] + -- NodeToClient. + , Logging.Namespace [] ["LocalMsgNotification.Protocol.Server"] + , Logging.Namespace [] ["LocalMsgNotification.Server"] + , Logging.Namespace [] ["LocalMsgSubmission.Protocol.Server"] + , Logging.Namespace [] ["LocalMsgSubmission.Server"] + -- NodeToNode. + , Logging.Namespace [] ["KeepAlive.Protocol.Client"] + , Logging.Namespace [] ["KeepAlive.Protocol.Server"] + , Logging.Namespace [] ["PeerSharing.Protocol.Client"] + , Logging.Namespace [] ["PeerSharing.Protocol.Server"] + , Logging.Namespace [] ["SigSubmission.Inbound"] + , Logging.Namespace [] ["SigSubmission.Logic"] + , Logging.Namespace [] ["SigSubmission.Outbound"] + , Logging.Namespace [] ["SigSubmission.Protocol.Client"] + , Logging.Namespace [] ["SigSubmission.Protocol.Server"] + ] + namespaceFor (WithEventType (DMQ str) _) = Logging.Namespace [] [(Text.pack str)] + namespaceFor (WithEventType et _) = Logging.Namespace [] [(Text.pack $ show et)] + severityFor (Logging.Namespace [] ["Mux"]) _ = Just Logging.Info + severityFor (Logging.Namespace [] ["Channel"]) _ = Just Logging.Info + severityFor (Logging.Namespace [] ["Bearer"]) _ = Just Logging.Info + severityFor (Logging.Namespace [] ["Handshake"]) _ = Just Logging.Info + severityFor (Logging.Namespace [] ["LocalMux"]) _ = Just Logging.Info + severityFor (Logging.Namespace [] ["LocalChannel"]) _ = Just Logging.Info + severityFor (Logging.Namespace [] ["LocalBearer"]) _ = Just Logging.Info + severityFor (Logging.Namespace [] ["LocalHandshake"]) _ = Just Logging.Info + severityFor (Logging.Namespace [] ["Diffusion"]) _ = Just Logging.Info + severityFor (Logging.Namespace [] ["LocalRootPeers"]) _ = Just Logging.Info + severityFor (Logging.Namespace [] ["PublicRootPeers"]) _ = Just Logging.Info + severityFor (Logging.Namespace [] ["LedgerPeers"]) _ = Just Logging.Info + severityFor (Logging.Namespace [] ["PeerSelection"]) _ = Just Logging.Info + severityFor (Logging.Namespace [] ["DebugPeerSelectionInitiator"]) _ = Just Logging.Info + severityFor (Logging.Namespace [] ["DebugPeerSelectionInitiatorResponder"]) _ = Just Logging.Info + severityFor (Logging.Namespace [] ["PeerSelectionCounters"]) _ = Just Logging.Info + severityFor (Logging.Namespace [] ["ChurnCounters"]) _ = Just Logging.Info + severityFor (Logging.Namespace [] ["PeerSelectionActions"]) _ = Just Logging.Info + severityFor (Logging.Namespace [] ["ConnectionManager"]) _ = Just Logging.Info + severityFor (Logging.Namespace [] ["ConnectionManagerTransition"]) _ = Just Logging.Info + severityFor (Logging.Namespace [] ["Server"]) _ = Just Logging.Info + severityFor (Logging.Namespace [] ["InboundGovernor"]) _ = Just Logging.Info + severityFor (Logging.Namespace [] ["InboundGovernorTransition"]) _ = Just Logging.Info + severityFor (Logging.Namespace [] ["Dns"]) _ = Just Logging.Info + severityFor (Logging.Namespace [] ["LocalConnectionManager"]) _ = Just Logging.Info + severityFor (Logging.Namespace [] ["LocalServerTracer"]) _ = Just Logging.Info + severityFor (Logging.Namespace [] ["LocalInboundGovernor"]) _ = Just Logging.Info + severityFor _ _ = Just Logging.Info + privacyFor _ _ = Just Logging.Public + detailsFor (Logging.Namespace [] ["Mux"]) _ = Just Logging.DNormal + detailsFor (Logging.Namespace [] ["Channel"]) _ = Just Logging.DNormal + detailsFor (Logging.Namespace [] ["Bearer"]) _ = Just Logging.DNormal + detailsFor (Logging.Namespace [] ["Handshake"]) _ = Just Logging.DNormal + detailsFor (Logging.Namespace [] ["LocalMux"]) _ = Just Logging.DNormal + detailsFor (Logging.Namespace [] ["LocalChannel"]) _ = Just Logging.DNormal + detailsFor (Logging.Namespace [] ["LocalBearer"]) _ = Just Logging.DNormal + detailsFor (Logging.Namespace [] ["LocalHandshake"]) _ = Just Logging.DNormal + detailsFor (Logging.Namespace [] ["Diffusion"]) _ = Just Logging.DNormal + detailsFor (Logging.Namespace [] ["LocalRootPeers"]) _ = Just Logging.DNormal + detailsFor (Logging.Namespace [] ["PublicRootPeers"]) _ = Just Logging.DNormal + detailsFor (Logging.Namespace [] ["LedgerPeers"]) _ = Just Logging.DNormal + detailsFor (Logging.Namespace [] ["PeerSelection"]) _ = Just Logging.DNormal + detailsFor (Logging.Namespace [] ["DebugPeerSelectionInitiator"]) _ = Just Logging.DNormal + detailsFor (Logging.Namespace [] ["DebugPeerSelectionInitiatorResponder"]) _ = Just Logging.DNormal + detailsFor (Logging.Namespace [] ["PeerSelectionCounters"]) _ = Just Logging.DNormal + detailsFor (Logging.Namespace [] ["ChurnCounters"]) _ = Just Logging.DNormal + detailsFor (Logging.Namespace [] ["PeerSelectionActions"]) _ = Just Logging.DNormal + detailsFor (Logging.Namespace [] ["ConnectionManager"]) _ = Just Logging.DNormal + detailsFor (Logging.Namespace [] ["ConnectionManagerTransition"]) _ = Just Logging.DNormal + detailsFor (Logging.Namespace [] ["Server"]) _ = Just Logging.DNormal + detailsFor (Logging.Namespace [] ["InboundGovernor"]) _ = Just Logging.DNormal + detailsFor (Logging.Namespace [] ["InboundGovernorTransition"]) _ = Just Logging.DNormal + detailsFor (Logging.Namespace [] ["Dns"]) _ = Just Logging.DNormal + detailsFor (Logging.Namespace [] ["LocalConnectionManager"]) _ = Just Logging.DNormal + detailsFor (Logging.Namespace [] ["LocalServer"]) _ = Just Logging.DNormal + detailsFor (Logging.Namespace [] ["LocalInboundGovernor"]) _ = Just Logging.DNormal + detailsFor _ _ = Just Logging.DNormal + documentFor _ = Nothing + metricsDocFor _ = [] --- | DMQ tracer -dmqTracer :: ToJSON ev - => Bool - -> Tracer IO (WithEventType ev) -dmqTracer pretty = contramapM - (\(WithEventType eventType event) -> do - time <- getCurrentTime - return $ bool encode encodePretty pretty TraceEvent { time, eventType, event } - ) - $ Tracer LBS.Char8.putStrLn +mkCardanoTracer :: FilePath + -> IO ( + Tracer IO WithEventType + , Diffusion.Tracers + RemoteAddress + NodeToNodeVersion + NodeToNodeVersionData + LocalAddress + NodeToClientVersion + NodeToClientVersionData + NoExtraState + NoExtraDebugState + NoExtraFlags + NoExtraPeers + NoExtraCounters + NoExtraTracer + IO + ) +mkCardanoTracer dmqConfigFilePath = do + traceConfig <- Logging.readConfiguration dmqConfigFilePath + emptyConfigReflection <- Logging.emptyConfigReflection + stdoutTrace <- Logging.standardTracer + {-- From: Cardano.Logging.Tracer.Composed + -- | Construct a tracer according to the requirements for cardano node. + -- The tracer gets a 'name', which is appended to its namespace. + -- The tracer has to be an instance of LogFormatting for the display of + -- messages and an instance of MetaTrace for meta information such as + -- severity, privacy, details and backends'. + -- The tracer gets the backends': 'trStdout', 'trForward' and 'mbTrEkg' + -- as arguments. + -- The returned tracer needs to be configured with a configuration + -- before it is used. + mkCardanoTracer :: forall evt. ( LogFormatting evt , MetaTrace evt) + => Trace IO FormattedMessage + -> Trace IO FormattedMessage + -> Maybe (Trace IO FormattedMessage) + -> [Text] + -> IO (Trace IO evt) + --} + -- This is a `Logging.Trace IO WithEventType`. + cardanoTracer <- Logging.mkCardanoTracer + stdoutTrace + mempty + Nothing + [] -- ["DMQ"] + {-- From: Cardano.Logging.Configuration + -- | Call this function at initialisation, and later for reconfiguration. + -- Config reflection is used to optimise the tracers and has to collect + -- information about the tracers. Although it is possible to give more + -- then one tracer of the same time, it is not a common case to do this. + configureTracers :: forall a m. (MetaTrace a , MonadIO m) + => ConfigReflection + -> TraceConfig + -> [Trace m a] + -> m () + --} + Logging.configureTracers + emptyConfigReflection + traceConfig + [cardanoTracer] + -- Make it a "contra-tracer" tracer for backward compatibility. + -- This is a `Tracer IO WithEventType`. + let dmqTracer = contramapM + (\wet@(WithEventType _ _) -> do + Logging.traceWith cardanoTracer wet + ) + $ Tracer (\_ -> return ()) + return (dmqTracer, dmqDiffusionTracers dmqTracer) -- An orphan instance needed for `Handshake versionNumber Term` instance ToJSON Term where @@ -158,10 +366,7 @@ instance ToJSON (DebugPeerSelection NoExtraState NoExtraFlags NoExtraPeers Remot ] dmqDiffusionTracers - :: forall m. - Applicative m - => Configuration - -> (forall ev. ToJSON ev => Tracer m (WithEventType ev)) + :: (Tracer IO WithEventType) -> Diffusion.Tracers RemoteAddress NodeToNodeVersion NodeToNodeVersionData LocalAddress NodeToClientVersion NodeToClientVersionData NoExtraState @@ -170,96 +375,35 @@ dmqDiffusionTracers NoExtraPeers NoExtraCounters NoExtraTracer - m -dmqDiffusionTracers - Configuration { - dmqcMuxTracer = I muxTracer, - dmqcChannelTracer = I channelTracer, - dmqcBearerTracer = I bearerTracer, - dmqcHandshakeTracer = I handshakeTracer, - dmqcLocalMuxTracer = I localMuxTracer, - dmqcLocalChannelTracer = I localChannelTracer, - dmqcLocalBearerTracer = I localBearerTracer, - dmqcLocalHandshakeTracer = I localHandshakeTracer, - dmqcDiffusionTracer = I diffusionTracer, - dmqcTraceLocalRootPeersTracer = I traceLocalRootPeersTracer, - dmqcTracePublicRootPeersTracer = I tracePublicRootPeersTracer, - dmqcTraceLedgerPeersTracer = I traceLedgerPeersTracer, - dmqcTracePeerSelectionTracer = I tracePeerSelectionTracer, - dmqcTraceChurnCounters = I traceChurnCounters, - dmqcDebugPeerSelectionInitiatorTracer = I debugPeerSelectionInitiatorTracer, - dmqcDebugPeerSelectionInitiatorResponderTracer = I debugPeerSelectionInitiatorResponderTracer, - dmqcTracePeerSelectionCounters = I tracePeerSelectionCounters, - dmqcPeerSelectionActionsTracer = I peerSelectionActionsTracer, - dmqcConnectionManagerTracer = I connectionManagerTracer, - dmqcConnectionManagerTransitionTracer = I connectionManagerTransitionTracer, - dmqcServerTracer = I serverTracer, - dmqcInboundGovernorTracer = I inboundGovernorTracer, - dmqcInboundGovernorTransitionTracer = I inboundGovernorTransitionTracer, - dmqcLocalConnectionManagerTracer = I localConnectionManagerTracer, - dmqcLocalServerTracer = I localServerTracer, - dmqcLocalInboundGovernorTracer = I localInboundGovernorTracer, - dmqcDnsTracer = I dnsTracer - } - tracer - = Diffusion.Tracers { - Diffusion.dtMuxTracer = muxTracer - .- WithEventType "Mux" >$< tracer, - Diffusion.dtChannelTracer = channelTracer - .- WithEventType "Channel" >$< tracer, - Diffusion.dtBearerTracer = bearerTracer - .- WithEventType "Bearer" >$< tracer, - Diffusion.dtHandshakeTracer = handshakeTracer - .- WithEventType "Handshake" >$< tracer, - Diffusion.dtLocalMuxTracer = localMuxTracer - .- WithEventType "LocalMux" >$< tracer, - Diffusion.dtLocalChannelTracer = localChannelTracer - .- WithEventType "LocalChannel" >$< tracer, - Diffusion.dtLocalBearerTracer = localBearerTracer - .- WithEventType "LocalBearer" >$< tracer, - Diffusion.dtLocalHandshakeTracer = localHandshakeTracer - .- WithEventType "LocalHandshake" >$< tracer, - Diffusion.dtDiffusionTracer = diffusionTracer - .- WithEventType "Diffusion" >$< tracer, - Diffusion.dtTraceLocalRootPeersTracer = traceLocalRootPeersTracer - .- WithEventType "LocalRootPeers" >$< tracer, - Diffusion.dtTracePublicRootPeersTracer = tracePublicRootPeersTracer - .- WithEventType "PublicRootPeers" >$< tracer, - Diffusion.dtTraceLedgerPeersTracer = traceLedgerPeersTracer - .- WithEventType "LedgerPeers" >$< tracer, - Diffusion.dtTracePeerSelectionTracer = tracePeerSelectionTracer - .- WithEventType "PeerSelection" >$< tracer, - Diffusion.dtDebugPeerSelectionInitiatorTracer = debugPeerSelectionInitiatorTracer - .- WithEventType "DebugPeerSelectionInitiator" >$< tracer, - Diffusion.dtDebugPeerSelectionInitiatorResponderTracer = debugPeerSelectionInitiatorResponderTracer - .- WithEventType "DebugPeerSelectionInitiatorResponder" >$< tracer, - Diffusion.dtTracePeerSelectionCounters = tracePeerSelectionCounters - .- WithEventType "PeerSelectionCounters" >$< tracer, - Diffusion.dtTraceChurnCounters = traceChurnCounters - .- WithEventType "ChurnCounters" >$< tracer, - Diffusion.dtPeerSelectionActionsTracer = peerSelectionActionsTracer - .- WithEventType "PeerSelectionActions" >$< tracer, - Diffusion.dtConnectionManagerTracer = connectionManagerTracer - .- WithEventType "ConnectionManager" >$< tracer, - Diffusion.dtConnectionManagerTransitionTracer = connectionManagerTransitionTracer - .- WithEventType "ConnectionManagerTransition" >$< tracer, - Diffusion.dtServerTracer = serverTracer - .- WithEventType "Server" >$< tracer, - Diffusion.dtInboundGovernorTracer = inboundGovernorTracer - .- WithEventType "InboundGovernor" >$< tracer, - Diffusion.dtInboundGovernorTransitionTracer = inboundGovernorTransitionTracer - .- WithEventType "InboundGovernorTransition" >$< tracer, - Diffusion.dtDnsTracer = dnsTracer - .- WithEventType "dtDnsTracer" >$< tracer, - Diffusion.dtLocalConnectionManagerTracer = localConnectionManagerTracer - .- WithEventType "dtLocalConnectionManagerTracer" >$< tracer, - Diffusion.dtLocalServerTracer = localServerTracer - .- WithEventType "dtLocalServerTracer" >$< tracer, - Diffusion.dtLocalInboundGovernorTracer = localInboundGovernorTracer - .- WithEventType "dtLocalInboundGovernorTracer" >$< tracer - } - where - (.-) :: Bool -> Tracer m a -> Tracer m a - True .- a = a - False .- _ = nullTracer - infixl 3 .- + IO +dmqDiffusionTracers tracer = + Diffusion.Tracers { + Diffusion.dtMuxTracer = WithEventType Mux >$< tracer, + Diffusion.dtChannelTracer = WithEventType Channel >$< tracer, + Diffusion.dtBearerTracer = WithEventType Bearer >$< tracer, + Diffusion.dtHandshakeTracer = WithEventType Handshake >$< tracer, + Diffusion.dtLocalMuxTracer = WithEventType LocalMux >$< tracer, + Diffusion.dtLocalChannelTracer = WithEventType LocalChannel >$< tracer, + Diffusion.dtLocalBearerTracer = WithEventType LocalBearer >$< tracer, + Diffusion.dtLocalHandshakeTracer = WithEventType LocalHandshake >$< tracer, + Diffusion.dtDiffusionTracer = WithEventType Diffusion >$< tracer, + Diffusion.dtTraceLocalRootPeersTracer = WithEventType LocalRootPeers >$< tracer, + Diffusion.dtTracePublicRootPeersTracer = WithEventType PublicRootPeers >$< tracer, + Diffusion.dtTraceLedgerPeersTracer = WithEventType LedgerPeers >$< tracer, + Diffusion.dtTracePeerSelectionTracer = WithEventType PeerSelection >$< tracer, + Diffusion.dtTraceChurnCounters = WithEventType ChurnCounters >$< tracer, + Diffusion.dtDebugPeerSelectionInitiatorTracer = WithEventType DebugPeerSelectionInitiator >$< tracer, + Diffusion.dtDebugPeerSelectionInitiatorResponderTracer = WithEventType DebugPeerSelectionInitiatorResponder >$< tracer, + Diffusion.dtTracePeerSelectionCounters = WithEventType PeerSelectionCounters >$< tracer, + Diffusion.dtPeerSelectionActionsTracer = WithEventType PeerSelectionActions >$< tracer, + Diffusion.dtConnectionManagerTracer = WithEventType ConnectionManager >$< tracer, + Diffusion.dtConnectionManagerTransitionTracer = WithEventType ConnectionManagerTransition >$< tracer, + Diffusion.dtServerTracer = WithEventType Server >$< tracer, + Diffusion.dtInboundGovernorTracer = WithEventType InboundGovernor >$< tracer, + Diffusion.dtInboundGovernorTransitionTracer = WithEventType InboundGovernorTransition >$< tracer, + Diffusion.dtLocalConnectionManagerTracer = WithEventType LocalConnectionManager >$< tracer, + Diffusion.dtLocalServerTracer = WithEventType LocalServer >$< tracer, + Diffusion.dtLocalInboundGovernorTracer = WithEventType LocalInboundGovernor >$< tracer, + Diffusion.dtDnsTracer = WithEventType Dns >$< tracer + } + From ea58f49e5c3a2ad0a83230e8d5efb46d490c1e5e Mon Sep 17 00:00:00 2001 From: Federico Mastellone Date: Tue, 27 Jan 2026 19:16:36 +0000 Subject: [PATCH 4/5] Test --- dmq-node/config.json | 44 ++++++++++++++++++++++++++++++++++++++++++ dmq-node/topology.json | 2 +- 2 files changed, 45 insertions(+), 1 deletion(-) diff --git a/dmq-node/config.json b/dmq-node/config.json index dc0d24b..cb2cea2 100644 --- a/dmq-node/config.json +++ b/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" + } + } } diff --git a/dmq-node/topology.json b/dmq-node/topology.json index 9b5f80c..8a59a98 100644 --- a/dmq-node/topology.json +++ b/dmq-node/topology.json @@ -14,7 +14,7 @@ } ], "useLedgerAfterSlot": 128908821, - "peerSnapshotFile": "decentralized-message-queue/peer-snapshot.json", + "peerSnapshotFile": null, "extraConfig": {} } From b65e776bc43b9131bea9a1ffe73790a93b759a22 Mon Sep 17 00:00:00 2001 From: Federico Mastellone Date: Thu, 29 Jan 2026 01:06:20 +0000 Subject: [PATCH 5/5] WIP --- cabal.project | 6 +- dmq-node/dmq-node.cabal | 5 +- dmq-node/src/DMQ/Tracer.hs | 319 ++++++++++++++++++------------------- 3 files changed, 165 insertions(+), 165 deletions(-) diff --git a/cabal.project b/cabal.project index 5e1d695..e949327 100644 --- a/cabal.project +++ b/cabal.project @@ -58,9 +58,9 @@ source-repository-package source-repository-package type: git location: https://github.com/IntersectMBO/ouroboros-network - -- from coot/dmq-related-changes - tag: 625296c92363b8c5e77cddee40de4525421d2660 - --sha256: sha256-WRbKqNimAsYtgj/r3SJ0IT6z7+Q3XZf3p89BM9w6bF8= + -- from fmaste/cardano-logging that is on top of coot/dmq-related-changes + tag: 2d1984996cdad1565fbaa29ae3f10e1fd3f84240 + --sha256: sha256-alRm44wPMwVxJTlEBiKfThdEIvmN1EOA2eLlacv4Fw0= subdir: acts-generic cardano-diffusion diff --git a/dmq-node/dmq-node.cabal b/dmq-node/dmq-node.cabal index b8c1b40..23b9ca2 100644 --- a/dmq-node/dmq-node.cabal +++ b/dmq-node/dmq-node.cabal @@ -114,16 +114,19 @@ library mtl, network ^>=3.2.7, network-mux ^>=0.9.1, + network-mux:cardano-logging, optparse-applicative >=0.18 && <0.20, ouroboros-consensus, ouroboros-consensus-cardano, ouroboros-consensus-diffusion, ouroboros-network:{ouroboros-network, api, framework, orphan-instances, protocols} ^>=0.23, + ouroboros-network:cardano-logging, + ouroboros-network:framework-cardano-logging, random ^>=1.2, singletons, text >=1.2.4 && <2.2, time >=1.12 && <1.15, - trace-dispatcher ^>= 2.10.0, + trace-dispatcher ^>= 2.11.0, transformers, typed-protocols:{typed-protocols, cborg} ^>=1.1, diff --git a/dmq-node/src/DMQ/Tracer.hs b/dmq-node/src/DMQ/Tracer.hs index fcd3b52..ad9b41f 100644 --- a/dmq-node/src/DMQ/Tracer.hs +++ b/dmq-node/src/DMQ/Tracer.hs @@ -29,12 +29,15 @@ import "contra-tracer" Control.Tracer import Data.Aeson import Data.Aeson.Encode.Pretty (encodePretty) import Data.Aeson.KeyMap (fromList) -import Data.Functor.Contravariant ((>$<)) import Data.Set qualified as Set import Data.Text qualified as Text import Data.Text.Lazy (toStrict) import Data.Text.Lazy.Encoding (decodeUtf8) +import Network.Mux.Logging () +import Ouroboros.Network.Logging () +import Ouroboros.Network.Logging.Framework () + import Ouroboros.Network.Diffusion qualified as Diffusion import Ouroboros.Network.OrphanInstances () import Ouroboros.Network.PeerSelection (DebugPeerSelection (..)) @@ -49,38 +52,7 @@ import DMQ.Configuration import DMQ.NodeToClient.Version import DMQ.NodeToNode.Version -data EventType = - -- From `Tracers` in "Ouroboros.Network.Diffusion.Types" - Mux - | Channel - | Bearer - | Handshake - | LocalMux - | LocalChannel - | LocalBearer - | LocalHandshake - | Diffusion - | LocalRootPeers - | PublicRootPeers - | LedgerPeers - | PeerSelection - | DebugPeerSelectionInitiator - | DebugPeerSelectionInitiatorResponder - | PeerSelectionCounters - | ChurnCounters - | PeerSelectionActions - | ConnectionManager - | ConnectionManagerTransition - | Server - | InboundGovernor - | InboundGovernorTransition - | Dns - | LocalConnectionManager - | LocalServer - | LocalInboundGovernor - -- Plus custom DMQ tracers. - | DMQ String - deriving (Eq, Show) +data EventType = DMQ String data WithEventType = forall a. ToJSON a => WithEventType EventType a @@ -98,39 +70,10 @@ instance Logging.LogFormatting WithEventType where instance Logging.MetaTrace WithEventType where -- allNamespaces :: [Namespace a] allNamespaces = [ - -- Diffusion traces. - -------------------- - Logging.Namespace [] ["Mux"] - , Logging.Namespace [] ["Channel"] - , Logging.Namespace [] ["Bearer"] - , Logging.Namespace [] ["Handshake"] - , Logging.Namespace [] ["LocalMux"] - , Logging.Namespace [] ["LocalChannel"] - , Logging.Namespace [] ["LocalBearer"] - , Logging.Namespace [] ["LocalHandshake"] - , Logging.Namespace [] ["Diffusion"] - , Logging.Namespace [] ["LocalRootPeers"] - , Logging.Namespace [] ["PublicRootPeers"] - , Logging.Namespace [] ["LedgerPeers"] - , Logging.Namespace [] ["PeerSelection"] - , Logging.Namespace [] ["DebugPeerSelectionInitiator"] - , Logging.Namespace [] ["DebugPeerSelectionInitiatorResponder"] - , Logging.Namespace [] ["PeerSelectionCounters"] - , Logging.Namespace [] ["ChurnCounters"] - , Logging.Namespace [] ["PeerSelectionActions"] - , Logging.Namespace [] ["ConnectionManager"] - , Logging.Namespace [] ["ConnectionManagerTransition"] - , Logging.Namespace [] ["Server"] - , Logging.Namespace [] ["InboundGovernor"] - , Logging.Namespace [] ["InboundGovernorTransition"] - , Logging.Namespace [] ["DnsTracer"] - , Logging.Namespace [] ["LocalConnectionManager"] - , Logging.Namespace [] ["LocalServer"] - , Logging.Namespace [] ["LocalInboundGovernor"] -- DMQ-Node only traces. ------------------------ -- Main. - , Logging.Namespace [] ["Configuration"] + Logging.Namespace [] ["Configuration"] , Logging.Namespace [] ["NetworkTopology"] , Logging.Namespace [] ["LocalStateQuery"] , Logging.Namespace [] ["NtC Validation"] @@ -153,63 +96,8 @@ instance Logging.MetaTrace WithEventType where , Logging.Namespace [] ["SigSubmission.Protocol.Server"] ] namespaceFor (WithEventType (DMQ str) _) = Logging.Namespace [] [(Text.pack str)] - namespaceFor (WithEventType et _) = Logging.Namespace [] [(Text.pack $ show et)] - severityFor (Logging.Namespace [] ["Mux"]) _ = Just Logging.Info - severityFor (Logging.Namespace [] ["Channel"]) _ = Just Logging.Info - severityFor (Logging.Namespace [] ["Bearer"]) _ = Just Logging.Info - severityFor (Logging.Namespace [] ["Handshake"]) _ = Just Logging.Info - severityFor (Logging.Namespace [] ["LocalMux"]) _ = Just Logging.Info - severityFor (Logging.Namespace [] ["LocalChannel"]) _ = Just Logging.Info - severityFor (Logging.Namespace [] ["LocalBearer"]) _ = Just Logging.Info - severityFor (Logging.Namespace [] ["LocalHandshake"]) _ = Just Logging.Info - severityFor (Logging.Namespace [] ["Diffusion"]) _ = Just Logging.Info - severityFor (Logging.Namespace [] ["LocalRootPeers"]) _ = Just Logging.Info - severityFor (Logging.Namespace [] ["PublicRootPeers"]) _ = Just Logging.Info - severityFor (Logging.Namespace [] ["LedgerPeers"]) _ = Just Logging.Info - severityFor (Logging.Namespace [] ["PeerSelection"]) _ = Just Logging.Info - severityFor (Logging.Namespace [] ["DebugPeerSelectionInitiator"]) _ = Just Logging.Info - severityFor (Logging.Namespace [] ["DebugPeerSelectionInitiatorResponder"]) _ = Just Logging.Info - severityFor (Logging.Namespace [] ["PeerSelectionCounters"]) _ = Just Logging.Info - severityFor (Logging.Namespace [] ["ChurnCounters"]) _ = Just Logging.Info - severityFor (Logging.Namespace [] ["PeerSelectionActions"]) _ = Just Logging.Info - severityFor (Logging.Namespace [] ["ConnectionManager"]) _ = Just Logging.Info - severityFor (Logging.Namespace [] ["ConnectionManagerTransition"]) _ = Just Logging.Info - severityFor (Logging.Namespace [] ["Server"]) _ = Just Logging.Info - severityFor (Logging.Namespace [] ["InboundGovernor"]) _ = Just Logging.Info - severityFor (Logging.Namespace [] ["InboundGovernorTransition"]) _ = Just Logging.Info - severityFor (Logging.Namespace [] ["Dns"]) _ = Just Logging.Info - severityFor (Logging.Namespace [] ["LocalConnectionManager"]) _ = Just Logging.Info - severityFor (Logging.Namespace [] ["LocalServerTracer"]) _ = Just Logging.Info - severityFor (Logging.Namespace [] ["LocalInboundGovernor"]) _ = Just Logging.Info severityFor _ _ = Just Logging.Info privacyFor _ _ = Just Logging.Public - detailsFor (Logging.Namespace [] ["Mux"]) _ = Just Logging.DNormal - detailsFor (Logging.Namespace [] ["Channel"]) _ = Just Logging.DNormal - detailsFor (Logging.Namespace [] ["Bearer"]) _ = Just Logging.DNormal - detailsFor (Logging.Namespace [] ["Handshake"]) _ = Just Logging.DNormal - detailsFor (Logging.Namespace [] ["LocalMux"]) _ = Just Logging.DNormal - detailsFor (Logging.Namespace [] ["LocalChannel"]) _ = Just Logging.DNormal - detailsFor (Logging.Namespace [] ["LocalBearer"]) _ = Just Logging.DNormal - detailsFor (Logging.Namespace [] ["LocalHandshake"]) _ = Just Logging.DNormal - detailsFor (Logging.Namespace [] ["Diffusion"]) _ = Just Logging.DNormal - detailsFor (Logging.Namespace [] ["LocalRootPeers"]) _ = Just Logging.DNormal - detailsFor (Logging.Namespace [] ["PublicRootPeers"]) _ = Just Logging.DNormal - detailsFor (Logging.Namespace [] ["LedgerPeers"]) _ = Just Logging.DNormal - detailsFor (Logging.Namespace [] ["PeerSelection"]) _ = Just Logging.DNormal - detailsFor (Logging.Namespace [] ["DebugPeerSelectionInitiator"]) _ = Just Logging.DNormal - detailsFor (Logging.Namespace [] ["DebugPeerSelectionInitiatorResponder"]) _ = Just Logging.DNormal - detailsFor (Logging.Namespace [] ["PeerSelectionCounters"]) _ = Just Logging.DNormal - detailsFor (Logging.Namespace [] ["ChurnCounters"]) _ = Just Logging.DNormal - detailsFor (Logging.Namespace [] ["PeerSelectionActions"]) _ = Just Logging.DNormal - detailsFor (Logging.Namespace [] ["ConnectionManager"]) _ = Just Logging.DNormal - detailsFor (Logging.Namespace [] ["ConnectionManagerTransition"]) _ = Just Logging.DNormal - detailsFor (Logging.Namespace [] ["Server"]) _ = Just Logging.DNormal - detailsFor (Logging.Namespace [] ["InboundGovernor"]) _ = Just Logging.DNormal - detailsFor (Logging.Namespace [] ["InboundGovernorTransition"]) _ = Just Logging.DNormal - detailsFor (Logging.Namespace [] ["Dns"]) _ = Just Logging.DNormal - detailsFor (Logging.Namespace [] ["LocalConnectionManager"]) _ = Just Logging.DNormal - detailsFor (Logging.Namespace [] ["LocalServer"]) _ = Just Logging.DNormal - detailsFor (Logging.Namespace [] ["LocalInboundGovernor"]) _ = Just Logging.DNormal detailsFor _ _ = Just Logging.DNormal documentFor _ = Nothing metricsDocFor _ = [] @@ -236,6 +124,8 @@ mkCardanoTracer dmqConfigFilePath = do traceConfig <- Logging.readConfiguration dmqConfigFilePath emptyConfigReflection <- Logging.emptyConfigReflection stdoutTrace <- Logging.standardTracer + let trForward = mempty + let mbTrEkg = Nothing {-- From: Cardano.Logging.Tracer.Composed -- | Construct a tracer according to the requirements for cardano node. -- The tracer gets a 'name', which is appended to its namespace. @@ -281,13 +171,156 @@ mkCardanoTracer dmqConfigFilePath = do Logging.traceWith cardanoTracer wet ) $ Tracer (\_ -> return ()) - return (dmqTracer, dmqDiffusionTracers dmqTracer) + !dtMuxTracer <- Logging.mkCardanoTracer + stdoutTrace trForward mbTrEkg + ["Net", "Mux", "Remote"] + Logging.configureTracers emptyConfigReflection traceConfig [dtMuxTracer] + !dtChannelTracer <- Logging.mkCardanoTracer + stdoutTrace trForward mbTrEkg + ["Net", "Mux", "Remote", "Channel"] + Logging.configureTracers emptyConfigReflection traceConfig [dtChannelTracer] + !dtBearerTracer <- Logging.mkCardanoTracer + stdoutTrace trForward mbTrEkg + ["Net", "Mux", "Remote", "Bearer"] + Logging.configureTracers emptyConfigReflection traceConfig [dtBearerTracer] + !dtHandshakeTracer <- Logging.mkCardanoTracer + stdoutTrace trForward mbTrEkg + ["Net", "Handshake", "Remote"] + Logging.configureTracers emptyConfigReflection traceConfig [dtHandshakeTracer] + !dtLocalMuxTracer <- Logging.mkCardanoTracer + stdoutTrace trForward mbTrEkg + ["Net", "Mux", "Local"] + Logging.configureTracers emptyConfigReflection traceConfig [dtLocalMuxTracer] + !dtLocalChannelTracer <- Logging.mkCardanoTracer + stdoutTrace trForward mbTrEkg + ["Net", "Mux", "Local", "Channel"] + Logging.configureTracers emptyConfigReflection traceConfig [dtLocalChannelTracer] + !dtLocalBearerTracer <- Logging.mkCardanoTracer + stdoutTrace trForward mbTrEkg + ["Net", "Mux", "Local", "Bearer"] + Logging.configureTracers emptyConfigReflection traceConfig [dtLocalBearerTracer] + !dtLocalHandshakeTracer <- Logging.mkCardanoTracer + stdoutTrace trForward mbTrEkg + ["Net", "Handshake", "Local"] + Logging.configureTracers emptyConfigReflection traceConfig [dtLocalHandshakeTracer] + !dtDiffusionTracer <- Logging.mkCardanoTracer + stdoutTrace trForward mbTrEkg + ["Startup", "DiffusionInit"] + Logging.configureTracers emptyConfigReflection traceConfig [dtDiffusionTracer] + !dtTraceLocalRootPeersTracer <- Logging.mkCardanoTracer + stdoutTrace trForward mbTrEkg + ["Net", "Peers", "LocalRoot"] + Logging.configureTracers emptyConfigReflection traceConfig [dtTraceLocalRootPeersTracer] + !dtTracePublicRootPeersTracer <- Logging.mkCardanoTracer + stdoutTrace trForward mbTrEkg + ["Net", "Peers", "PublicRoot"] + Logging.configureTracers emptyConfigReflection traceConfig [dtTracePublicRootPeersTracer] + !dtTraceLedgerPeersTracer <- Logging.mkCardanoTracer + stdoutTrace trForward mbTrEkg + ["Net", "Peers", "Ledger"] + Logging.configureTracers emptyConfigReflection traceConfig [dtTraceLedgerPeersTracer] + !dtTracePeerSelectionTracer <- Logging.mkCardanoTracer + stdoutTrace trForward mbTrEkg + ["Net", "PeerSelection", "Selection"] + Logging.configureTracers emptyConfigReflection traceConfig [dtTracePeerSelectionTracer] + !dtDebugPeerSelectionInitiatorTracer <- Logging.mkCardanoTracer + stdoutTrace trForward mbTrEkg + ["Net", "PeerSelection", "Initiator"] + Logging.configureTracers emptyConfigReflection traceConfig [dtDebugPeerSelectionInitiatorTracer] + !dtDebugPeerSelectionInitiatorResponderTracer <- Logging.mkCardanoTracer + stdoutTrace trForward mbTrEkg + ["Net", "PeerSelection", "Responder"] + Logging.configureTracers emptyConfigReflection traceConfig [dtDebugPeerSelectionInitiatorResponderTracer] + !dtTraceChurnCounters <- Logging.mkCardanoTracer + stdoutTrace trForward mbTrEkg + ["Net", "Churn"] + Logging.configureTracers emptyConfigReflection traceConfig [dtTraceChurnCounters] + !dtTracePeerSelectionCounters <- Logging.mkCardanoTracer + stdoutTrace trForward mbTrEkg + ["Net", "PeerSelection"] + Logging.configureTracers emptyConfigReflection traceConfig [dtTracePeerSelectionCounters] + !dtPeerSelectionActionsTracer <- Logging.mkCardanoTracer + stdoutTrace trForward mbTrEkg + ["Net", "PeerSelection", "Actions"] + Logging.configureTracers emptyConfigReflection traceConfig [dtPeerSelectionActionsTracer] + !dtConnectionManagerTracer <- Logging.mkCardanoTracer + stdoutTrace trForward mbTrEkg + ["Net", "ConnectionManager", "Remote"] + Logging.configureTracers emptyConfigReflection traceConfig [dtConnectionManagerTracer] + !dtConnectionManagerTransitionTracer <- Logging.mkCardanoTracer + stdoutTrace trForward mbTrEkg + ["Net", "ConnectionManager", "Transition"] + Logging.configureTracers emptyConfigReflection traceConfig [dtConnectionManagerTransitionTracer] + !dtServerTracer <- Logging.mkCardanoTracer + stdoutTrace trForward mbTrEkg + ["Net", "Server", "Local"] + Logging.configureTracers emptyConfigReflection traceConfig [dtServerTracer] + !dtInboundGovernorTracer <- Logging.mkCardanoTracer + stdoutTrace trForward mbTrEkg + ["Net", "InboundGovernor", "Remote"] + Logging.configureTracers emptyConfigReflection traceConfig [dtInboundGovernorTracer] + !dtInboundGovernorTransitionTracer <- Logging.mkCardanoTracer + stdoutTrace trForward mbTrEkg + ["Net", "InboundGovernor", "Transition"] + Logging.configureTracers emptyConfigReflection traceConfig [dtInboundGovernorTransitionTracer] + !dtLocalConnectionManagerTracer <- Logging.mkCardanoTracer + stdoutTrace trForward Nothing -- never conflate metrics of the same name with those originating from `connectionManagerTr` + ["Net", "ConnectionManager", "Local"] + Logging.configureTracers emptyConfigReflection traceConfig [dtLocalConnectionManagerTracer] + !dtLocalServerTracer <- Logging.mkCardanoTracer + stdoutTrace trForward mbTrEkg + ["Net", "Server", "Local"] + Logging.configureTracers emptyConfigReflection traceConfig [dtLocalServerTracer] + !dtLocalInboundGovernorTracer <- Logging.mkCardanoTracer + stdoutTrace trForward mbTrEkg + ["Net", "InboundGovernor", "Local"] + Logging.configureTracers emptyConfigReflection traceConfig [dtLocalInboundGovernorTracer] + !dtDnsTracer <- Logging.mkCardanoTracer + stdoutTrace trForward mbTrEkg + ["Net", "DNS"] + Logging.configureTracers emptyConfigReflection traceConfig [dtDnsTracer] + let dmqDifussionTracers = + -- From `Cardano.Node.Tracing.Tracers` + -- Branch "ana/10.6-final-integration-mix" + Diffusion.Tracers { + Diffusion.dtMuxTracer = Tracer $ Logging.traceWith dtMuxTracer, + Diffusion.dtChannelTracer = Tracer $ Logging.traceWith dtChannelTracer, + Diffusion.dtBearerTracer = Tracer $ Logging.traceWith dtBearerTracer, + Diffusion.dtHandshakeTracer = Tracer $ Logging.traceWith dtHandshakeTracer, + Diffusion.dtLocalMuxTracer = Tracer $ Logging.traceWith dtLocalMuxTracer, + Diffusion.dtLocalChannelTracer = Tracer $ Logging.traceWith dtLocalChannelTracer, + Diffusion.dtLocalBearerTracer = Tracer $ Logging.traceWith dtLocalBearerTracer, + Diffusion.dtLocalHandshakeTracer = Tracer $ Logging.traceWith dtLocalHandshakeTracer, + Diffusion.dtDiffusionTracer = Tracer $ Logging.traceWith dtDiffusionTracer, + Diffusion.dtTraceLocalRootPeersTracer = Tracer $ Logging.traceWith dtTraceLocalRootPeersTracer, + Diffusion.dtTracePublicRootPeersTracer = Tracer $ Logging.traceWith dtTracePublicRootPeersTracer, + Diffusion.dtTraceLedgerPeersTracer = Tracer $ Logging.traceWith dtTraceLedgerPeersTracer, + Diffusion.dtTracePeerSelectionTracer = Tracer $ Logging.traceWith dtTracePeerSelectionTracer, + Diffusion.dtDebugPeerSelectionInitiatorTracer = Tracer $ Logging.traceWith dtDebugPeerSelectionInitiatorTracer, + Diffusion.dtDebugPeerSelectionInitiatorResponderTracer = Tracer $ Logging.traceWith dtDebugPeerSelectionInitiatorResponderTracer, + Diffusion.dtTraceChurnCounters = Tracer $ Logging.traceWith dtTraceChurnCounters, + Diffusion.dtTracePeerSelectionCounters = Tracer $ Logging.traceWith dtTracePeerSelectionCounters, + Diffusion.dtPeerSelectionActionsTracer = Tracer $ Logging.traceWith dtPeerSelectionActionsTracer, + Diffusion.dtConnectionManagerTracer = Tracer $ Logging.traceWith dtConnectionManagerTracer, + Diffusion.dtConnectionManagerTransitionTracer = Tracer $ Logging.traceWith dtConnectionManagerTransitionTracer, + Diffusion.dtServerTracer = Tracer $ Logging.traceWith dtServerTracer, + Diffusion.dtInboundGovernorTracer = Tracer $ Logging.traceWith dtInboundGovernorTracer, + Diffusion.dtInboundGovernorTransitionTracer = Tracer $ Logging.traceWith dtInboundGovernorTransitionTracer, + Diffusion.dtLocalConnectionManagerTracer = Tracer $ Logging.traceWith dtLocalConnectionManagerTracer, + Diffusion.dtLocalServerTracer = Tracer $ Logging.traceWith dtLocalServerTracer, + Diffusion.dtLocalInboundGovernorTracer = Tracer $ Logging.traceWith dtLocalInboundGovernorTracer, + Diffusion.dtDnsTracer = Tracer $ Logging.traceWith dtDnsTracer + } + + return (dmqTracer, dmqDifussionTracers) -- An orphan instance needed for `Handshake versionNumber Term` instance ToJSON Term where toJSON term = String (Text.pack . show $ term) data NoExtraPeers = NoExtraPeers +instance Show NoExtraPeers where + show _ = "" instance Semigroup NoExtraPeers where _ <> _ = NoExtraPeers instance Monoid NoExtraPeers where @@ -313,6 +346,12 @@ instance ToJSON NoExtraDebugState where data NoExtraChurnArgs = NoExtraChurnArgs data NoExtraAPI = NoExtraAPI data NoExtraTracer = NoExtraTracer +instance Show NoExtraState where + show _ = "" +instance Show NoExtraDebugState where + show _ = "" +instance Show NoExtraTracer where + show _ = "" instance ToJSON NoExtraTracer where toJSON _ = Null omitField _ = True @@ -365,45 +404,3 @@ instance ToJSON (DebugPeerSelection NoExtraState NoExtraFlags NoExtraPeers Remot st ] -dmqDiffusionTracers - :: (Tracer IO WithEventType) - -> Diffusion.Tracers RemoteAddress NodeToNodeVersion NodeToNodeVersionData - LocalAddress NodeToClientVersion NodeToClientVersionData - NoExtraState - NoExtraDebugState - NoExtraFlags - NoExtraPeers - NoExtraCounters - NoExtraTracer - IO -dmqDiffusionTracers tracer = - Diffusion.Tracers { - Diffusion.dtMuxTracer = WithEventType Mux >$< tracer, - Diffusion.dtChannelTracer = WithEventType Channel >$< tracer, - Diffusion.dtBearerTracer = WithEventType Bearer >$< tracer, - Diffusion.dtHandshakeTracer = WithEventType Handshake >$< tracer, - Diffusion.dtLocalMuxTracer = WithEventType LocalMux >$< tracer, - Diffusion.dtLocalChannelTracer = WithEventType LocalChannel >$< tracer, - Diffusion.dtLocalBearerTracer = WithEventType LocalBearer >$< tracer, - Diffusion.dtLocalHandshakeTracer = WithEventType LocalHandshake >$< tracer, - Diffusion.dtDiffusionTracer = WithEventType Diffusion >$< tracer, - Diffusion.dtTraceLocalRootPeersTracer = WithEventType LocalRootPeers >$< tracer, - Diffusion.dtTracePublicRootPeersTracer = WithEventType PublicRootPeers >$< tracer, - Diffusion.dtTraceLedgerPeersTracer = WithEventType LedgerPeers >$< tracer, - Diffusion.dtTracePeerSelectionTracer = WithEventType PeerSelection >$< tracer, - Diffusion.dtTraceChurnCounters = WithEventType ChurnCounters >$< tracer, - Diffusion.dtDebugPeerSelectionInitiatorTracer = WithEventType DebugPeerSelectionInitiator >$< tracer, - Diffusion.dtDebugPeerSelectionInitiatorResponderTracer = WithEventType DebugPeerSelectionInitiatorResponder >$< tracer, - Diffusion.dtTracePeerSelectionCounters = WithEventType PeerSelectionCounters >$< tracer, - Diffusion.dtPeerSelectionActionsTracer = WithEventType PeerSelectionActions >$< tracer, - Diffusion.dtConnectionManagerTracer = WithEventType ConnectionManager >$< tracer, - Diffusion.dtConnectionManagerTransitionTracer = WithEventType ConnectionManagerTransition >$< tracer, - Diffusion.dtServerTracer = WithEventType Server >$< tracer, - Diffusion.dtInboundGovernorTracer = WithEventType InboundGovernor >$< tracer, - Diffusion.dtInboundGovernorTransitionTracer = WithEventType InboundGovernorTransition >$< tracer, - Diffusion.dtLocalConnectionManagerTracer = WithEventType LocalConnectionManager >$< tracer, - Diffusion.dtLocalServerTracer = WithEventType LocalServer >$< tracer, - Diffusion.dtLocalInboundGovernorTracer = WithEventType LocalInboundGovernor >$< tracer, - Diffusion.dtDnsTracer = WithEventType Dns >$< tracer - } -