From 80b704d07442be653a61b17ebda93cc1a8a7586e Mon Sep 17 00:00:00 2001 From: Nicolas Frisby Date: Fri, 24 Oct 2025 15:42:57 -0700 Subject: [PATCH 01/16] leiosdemo202510: half way through adding LeiosNotify tracers --- cardano-node/src/Cardano/Node/Tracing/Tracers.hs | 11 +++++++++-- cardano-node/src/Cardano/Tracing/Config.hs | 10 ++++++++++ 2 files changed, 19 insertions(+), 2 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers.hs index da4c82fd265..91dc7205cca 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers.hs @@ -68,7 +68,7 @@ import Ouroboros.Network.NodeToNode (RemoteAddress) import Codec.CBOR.Read (DeserialiseFailure) import Control.Monad (unless) -import "contra-tracer" Control.Tracer (Tracer (..)) +import "contra-tracer" Control.Tracer (Tracer (..), nullTracer) import Data.Proxy (Proxy (..)) import Network.Mux.Trace (TraceLabelPeer (..)) import Network.Socket (SockAddr) @@ -501,7 +501,12 @@ mkNodeToNodeTracers configReflection trBase trForward mbTrEKG _trDataPoint trCon trBase trForward mbTrEKG ["PeerSharing", "Remote"] configureTracers configReflection trConfig [peerSharingTracer] - +{- + !leiosNotifyTracer <- mkCardanoTracer + trBase trForward mbTrEKG + ["LeiosNotify", "Remote"] + configureTracers configReflection trConfig [leiosNotifyTracer] +-} pure $ NtN.Tracers { NtN.tChainSyncTracer = Tracer $ traceWith chainSyncTracer @@ -517,6 +522,8 @@ mkNodeToNodeTracers configReflection trBase trForward mbTrEKG _trDataPoint trCon traceWith keepAliveTracer , NtN.tPeerSharingTracer = Tracer $ traceWith peerSharingTracer + , NtN.tLeiosNotifyTracer = nullTracer {- Tracer $ + traceWith leiosNotifyTracer -} } mkDiffusionTracers diff --git a/cardano-node/src/Cardano/Tracing/Config.hs b/cardano-node/src/Cardano/Tracing/Config.hs index b71e90f52aa..5ab5ac5c3b0 100644 --- a/cardano-node/src/Cardano/Tracing/Config.hs +++ b/cardano-node/src/Cardano/Tracing/Config.hs @@ -72,6 +72,7 @@ module Cardano.Tracing.Config , TraceTxSubmission2Protocol , TraceKeepAliveProtocol , TracePeerSharingProtocol + , TraceLeiosNotifyProtocol , proxyName ) where @@ -180,6 +181,7 @@ type TraceTxSubmissionProtocol = ("TraceTxSubmissionProtocol" :: Symbol) type TraceTxSubmission2Protocol = ("TraceTxSubmission2Protocol" :: Symbol) type TraceKeepAliveProtocol = ("TraceKeepAliveProtocol" :: Symbol) type TracePeerSharingProtocol = ("TracePeerSharingProtocol" :: Symbol) +type TraceLeiosNotifyProtocol = ("TraceLeiosNotifyProtocol" :: Symbol) type TraceGsm = ("TraceGsm" :: Symbol) type TraceCsj = ("TraceCsj" :: Symbol) type TraceDevotedBlockFetch = ("TraceDevotedBlockFetch" :: Symbol) @@ -256,6 +258,7 @@ data TraceSelection , traceTxSubmission2Protocol :: OnOff TraceTxSubmission2Protocol , traceKeepAliveProtocol :: OnOff TraceKeepAliveProtocol , tracePeerSharingProtocol :: OnOff TracePeerSharingProtocol + , traceLeiosNotifyProtocol :: OnOff TraceLeiosNotifyProtocol , traceGsm :: OnOff TraceGsm , traceCsj :: OnOff TraceCsj , traceDevotedBlockFetch :: OnOff TraceDevotedBlockFetch @@ -326,6 +329,7 @@ data PartialTraceSelection , pTraceTxSubmission2Protocol :: Last (OnOff TraceTxSubmission2Protocol) , pTraceKeepAliveProtocol :: Last (OnOff TraceKeepAliveProtocol) , pTracePeerSharingProtocol :: Last (OnOff TracePeerSharingProtocol) + , pTraceLeiosNotifyProtocol :: Last (OnOff TraceLeiosNotifyProtocol) , pTraceGsm :: Last (OnOff TraceGsm) , pTraceCsj :: Last (OnOff TraceCsj) , pTraceDevotedBlockFetch :: Last (OnOff TraceDevotedBlockFetch) @@ -397,6 +401,7 @@ instance FromJSON PartialTraceSelection where <*> parseTracer (Proxy @TraceTxSubmission2Protocol) v <*> parseTracer (Proxy @TraceKeepAliveProtocol) v <*> parseTracer (Proxy @TracePeerSharingProtocol) v + <*> parseTracer (Proxy @TraceLeiosNotifyProtocol) v <*> parseTracer (Proxy @TraceGsm) v <*> parseTracer (Proxy @TraceCsj) v <*> parseTracer (Proxy @TraceDevotedBlockFetch) v @@ -465,6 +470,7 @@ defaultPartialTraceConfiguration = , pTraceTxSubmission2Protocol = pure $ OnOff False , pTraceKeepAliveProtocol = pure $ OnOff False , pTracePeerSharingProtocol = pure $ OnOff False + , pTraceLeiosNotifyProtocol = pure $ OnOff False , pTraceGsm = pure $ OnOff True , pTraceCsj = pure $ OnOff True , pTraceDevotedBlockFetch = pure $ OnOff True @@ -535,6 +541,7 @@ partialTraceSelectionToEither (Last (Just (PartialTraceDispatcher pTraceSelectio traceTxSubmission2Protocol <- proxyLastToEither (Proxy @TraceTxSubmission2Protocol) pTraceTxSubmission2Protocol traceKeepAliveProtocol <- proxyLastToEither (Proxy @TraceKeepAliveProtocol) pTraceKeepAliveProtocol tracePeerSharingProtocol <- proxyLastToEither (Proxy @TracePeerSharingProtocol) pTracePeerSharingProtocol + traceLeiosNotifyProtocol <- proxyLastToEither (Proxy @TraceLeiosNotifyProtocol) pTraceLeiosNotifyProtocol traceGsm <- proxyLastToEither (Proxy @TraceGsm) pTraceGsm traceCsj <- proxyLastToEither (Proxy @TraceCsj) pTraceCsj traceDevotedBlockFetch <- proxyLastToEither (Proxy @TraceDevotedBlockFetch) pTraceDevotedBlockFetch @@ -598,6 +605,7 @@ partialTraceSelectionToEither (Last (Just (PartialTraceDispatcher pTraceSelectio , traceTxSubmission2Protocol = traceTxSubmission2Protocol , traceKeepAliveProtocol = traceKeepAliveProtocol , tracePeerSharingProtocol = tracePeerSharingProtocol + , traceLeiosNotifyProtocol = traceLeiosNotifyProtocol , traceGsm = traceGsm , traceCsj = traceCsj , traceDevotedBlockFetch = traceDevotedBlockFetch @@ -665,6 +673,7 @@ partialTraceSelectionToEither (Last (Just (PartialTracingOnLegacy pTraceSelectio traceTxSubmission2Protocol <- proxyLastToEither (Proxy @TraceTxSubmission2Protocol) pTraceTxSubmission2Protocol traceKeepAliveProtocol <- proxyLastToEither (Proxy @TraceKeepAliveProtocol) pTraceKeepAliveProtocol tracePeerSharingProtocol <- proxyLastToEither (Proxy @TracePeerSharingProtocol) pTracePeerSharingProtocol + traceLeiosNotifyProtocol <- proxyLastToEither (Proxy @TraceLeiosNotifyProtocol) pTraceLeiosNotifyProtocol traceGsm <- proxyLastToEither (Proxy @TraceGsm) pTraceGsm traceCsj <- proxyLastToEither (Proxy @TraceCsj) pTraceCsj traceDevotedBlockFetch <- proxyLastToEither (Proxy @TraceDevotedBlockFetch) pTraceDevotedBlockFetch @@ -728,6 +737,7 @@ partialTraceSelectionToEither (Last (Just (PartialTracingOnLegacy pTraceSelectio , traceTxSubmission2Protocol = traceTxSubmission2Protocol , traceKeepAliveProtocol = traceKeepAliveProtocol , tracePeerSharingProtocol = tracePeerSharingProtocol + , traceLeiosNotifyProtocol = traceLeiosNotifyProtocol , traceGsm = traceGsm , traceCsj = traceCsj , traceDevotedBlockFetch = traceDevotedBlockFetch From 8123a78e5e08ec6d5819d2b7f330e57d3674ce7e Mon Sep 17 00:00:00 2001 From: Nicolas Frisby Date: Sat, 25 Oct 2025 14:25:13 -0700 Subject: [PATCH 02/16] fixup prev --- cardano-node/src/Cardano/Tracing/Tracers.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/cardano-node/src/Cardano/Tracing/Tracers.hs b/cardano-node/src/Cardano/Tracing/Tracers.hs index 8a8d9bab3f6..55f9ea341ca 100644 --- a/cardano-node/src/Cardano/Tracing/Tracers.hs +++ b/cardano-node/src/Cardano/Tracing/Tracers.hs @@ -571,6 +571,7 @@ mkTracers _ _ _ _ _ enableP2P = , NodeToNode.tTxSubmission2Tracer = nullTracer , NodeToNode.tKeepAliveTracer = nullTracer , NodeToNode.tPeerSharingTracer = nullTracer + , NodeToNode.tLeiosNotifyTracer = nullTracer } , diffusionTracers = Diffusion.nullTracers , diffusionTracersExtra = @@ -1513,6 +1514,9 @@ nodeToNodeTracers' trSel verb tr = , NodeToNode.tPeerSharingTracer = tracerOnOff (tracePeerSharingProtocol trSel) verb "PeerSharingPrototocol" tr + , NodeToNode.tLeiosNotifyTracer = nullTracer {- TODO + tracerOnOff (traceLeiosNotifyProtocol trSel) + verb "LeiosNotifyPrototocol" tr -} } -- TODO @ouroboros-network From 7aebae90b095764969ee8696aa38b9200d5dce20 Mon Sep 17 00:00:00 2001 From: Nicolas Frisby Date: Sat, 25 Oct 2025 14:27:28 -0700 Subject: [PATCH 03/16] leiosdemo202510: half way through adding LeiosFetch tracers --- cardano-node/src/Cardano/Node/Tracing/Tracers.hs | 1 + cardano-node/src/Cardano/Tracing/Config.hs | 10 ++++++++++ cardano-node/src/Cardano/Tracing/Tracers.hs | 4 ++++ 3 files changed, 15 insertions(+) diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers.hs index 91dc7205cca..f4c55fa947d 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers.hs @@ -524,6 +524,7 @@ mkNodeToNodeTracers configReflection trBase trForward mbTrEKG _trDataPoint trCon traceWith peerSharingTracer , NtN.tLeiosNotifyTracer = nullTracer {- Tracer $ traceWith leiosNotifyTracer -} + , NtN.tLeiosFetchTracer = nullTracer } mkDiffusionTracers diff --git a/cardano-node/src/Cardano/Tracing/Config.hs b/cardano-node/src/Cardano/Tracing/Config.hs index 5ab5ac5c3b0..c258022badb 100644 --- a/cardano-node/src/Cardano/Tracing/Config.hs +++ b/cardano-node/src/Cardano/Tracing/Config.hs @@ -73,6 +73,7 @@ module Cardano.Tracing.Config , TraceKeepAliveProtocol , TracePeerSharingProtocol , TraceLeiosNotifyProtocol + , TraceLeiosFetchProtocol , proxyName ) where @@ -182,6 +183,7 @@ type TraceTxSubmission2Protocol = ("TraceTxSubmission2Protocol" :: Symbol) type TraceKeepAliveProtocol = ("TraceKeepAliveProtocol" :: Symbol) type TracePeerSharingProtocol = ("TracePeerSharingProtocol" :: Symbol) type TraceLeiosNotifyProtocol = ("TraceLeiosNotifyProtocol" :: Symbol) +type TraceLeiosFetchProtocol = ("TraceLeiosFetchProtocol" :: Symbol) type TraceGsm = ("TraceGsm" :: Symbol) type TraceCsj = ("TraceCsj" :: Symbol) type TraceDevotedBlockFetch = ("TraceDevotedBlockFetch" :: Symbol) @@ -259,6 +261,7 @@ data TraceSelection , traceKeepAliveProtocol :: OnOff TraceKeepAliveProtocol , tracePeerSharingProtocol :: OnOff TracePeerSharingProtocol , traceLeiosNotifyProtocol :: OnOff TraceLeiosNotifyProtocol + , traceLeiosFetchProtocol :: OnOff TraceLeiosFetchProtocol , traceGsm :: OnOff TraceGsm , traceCsj :: OnOff TraceCsj , traceDevotedBlockFetch :: OnOff TraceDevotedBlockFetch @@ -330,6 +333,7 @@ data PartialTraceSelection , pTraceKeepAliveProtocol :: Last (OnOff TraceKeepAliveProtocol) , pTracePeerSharingProtocol :: Last (OnOff TracePeerSharingProtocol) , pTraceLeiosNotifyProtocol :: Last (OnOff TraceLeiosNotifyProtocol) + , pTraceLeiosFetchProtocol :: Last (OnOff TraceLeiosFetchProtocol) , pTraceGsm :: Last (OnOff TraceGsm) , pTraceCsj :: Last (OnOff TraceCsj) , pTraceDevotedBlockFetch :: Last (OnOff TraceDevotedBlockFetch) @@ -402,6 +406,7 @@ instance FromJSON PartialTraceSelection where <*> parseTracer (Proxy @TraceKeepAliveProtocol) v <*> parseTracer (Proxy @TracePeerSharingProtocol) v <*> parseTracer (Proxy @TraceLeiosNotifyProtocol) v + <*> parseTracer (Proxy @TraceLeiosFetchProtocol) v <*> parseTracer (Proxy @TraceGsm) v <*> parseTracer (Proxy @TraceCsj) v <*> parseTracer (Proxy @TraceDevotedBlockFetch) v @@ -471,6 +476,7 @@ defaultPartialTraceConfiguration = , pTraceKeepAliveProtocol = pure $ OnOff False , pTracePeerSharingProtocol = pure $ OnOff False , pTraceLeiosNotifyProtocol = pure $ OnOff False + , pTraceLeiosFetchProtocol = pure $ OnOff False , pTraceGsm = pure $ OnOff True , pTraceCsj = pure $ OnOff True , pTraceDevotedBlockFetch = pure $ OnOff True @@ -542,6 +548,7 @@ partialTraceSelectionToEither (Last (Just (PartialTraceDispatcher pTraceSelectio traceKeepAliveProtocol <- proxyLastToEither (Proxy @TraceKeepAliveProtocol) pTraceKeepAliveProtocol tracePeerSharingProtocol <- proxyLastToEither (Proxy @TracePeerSharingProtocol) pTracePeerSharingProtocol traceLeiosNotifyProtocol <- proxyLastToEither (Proxy @TraceLeiosNotifyProtocol) pTraceLeiosNotifyProtocol + traceLeiosFetchProtocol <- proxyLastToEither (Proxy @TraceLeiosFetchProtocol) pTraceLeiosFetchProtocol traceGsm <- proxyLastToEither (Proxy @TraceGsm) pTraceGsm traceCsj <- proxyLastToEither (Proxy @TraceCsj) pTraceCsj traceDevotedBlockFetch <- proxyLastToEither (Proxy @TraceDevotedBlockFetch) pTraceDevotedBlockFetch @@ -606,6 +613,7 @@ partialTraceSelectionToEither (Last (Just (PartialTraceDispatcher pTraceSelectio , traceKeepAliveProtocol = traceKeepAliveProtocol , tracePeerSharingProtocol = tracePeerSharingProtocol , traceLeiosNotifyProtocol = traceLeiosNotifyProtocol + , traceLeiosFetchProtocol = traceLeiosFetchProtocol , traceGsm = traceGsm , traceCsj = traceCsj , traceDevotedBlockFetch = traceDevotedBlockFetch @@ -674,6 +682,7 @@ partialTraceSelectionToEither (Last (Just (PartialTracingOnLegacy pTraceSelectio traceKeepAliveProtocol <- proxyLastToEither (Proxy @TraceKeepAliveProtocol) pTraceKeepAliveProtocol tracePeerSharingProtocol <- proxyLastToEither (Proxy @TracePeerSharingProtocol) pTracePeerSharingProtocol traceLeiosNotifyProtocol <- proxyLastToEither (Proxy @TraceLeiosNotifyProtocol) pTraceLeiosNotifyProtocol + traceLeiosFetchProtocol <- proxyLastToEither (Proxy @TraceLeiosFetchProtocol) pTraceLeiosFetchProtocol traceGsm <- proxyLastToEither (Proxy @TraceGsm) pTraceGsm traceCsj <- proxyLastToEither (Proxy @TraceCsj) pTraceCsj traceDevotedBlockFetch <- proxyLastToEither (Proxy @TraceDevotedBlockFetch) pTraceDevotedBlockFetch @@ -738,6 +747,7 @@ partialTraceSelectionToEither (Last (Just (PartialTracingOnLegacy pTraceSelectio , traceKeepAliveProtocol = traceKeepAliveProtocol , tracePeerSharingProtocol = tracePeerSharingProtocol , traceLeiosNotifyProtocol = traceLeiosNotifyProtocol + , traceLeiosFetchProtocol = traceLeiosFetchProtocol , traceGsm = traceGsm , traceCsj = traceCsj , traceDevotedBlockFetch = traceDevotedBlockFetch diff --git a/cardano-node/src/Cardano/Tracing/Tracers.hs b/cardano-node/src/Cardano/Tracing/Tracers.hs index 55f9ea341ca..58af3c0e98a 100644 --- a/cardano-node/src/Cardano/Tracing/Tracers.hs +++ b/cardano-node/src/Cardano/Tracing/Tracers.hs @@ -572,6 +572,7 @@ mkTracers _ _ _ _ _ enableP2P = , NodeToNode.tKeepAliveTracer = nullTracer , NodeToNode.tPeerSharingTracer = nullTracer , NodeToNode.tLeiosNotifyTracer = nullTracer + , NodeToNode.tLeiosFetchTracer = nullTracer } , diffusionTracers = Diffusion.nullTracers , diffusionTracersExtra = @@ -1517,6 +1518,9 @@ nodeToNodeTracers' trSel verb tr = , NodeToNode.tLeiosNotifyTracer = nullTracer {- TODO tracerOnOff (traceLeiosNotifyProtocol trSel) verb "LeiosNotifyPrototocol" tr -} + , NodeToNode.tLeiosFetchTracer = nullTracer {- TODO + tracerOnOff (traceLeiosFetchProtocol trSel) + verb "LeiosFetchPrototocol" tr -} } -- TODO @ouroboros-network From 89628e785e7eebcb012df66176844abaec417489 Mon Sep 17 00:00:00 2001 From: Nicolas Frisby Date: Sun, 26 Oct 2025 13:32:57 -0700 Subject: [PATCH 04/16] leiosdemo202510: plug in demoNewLeiosDbConnectionIO --- cardano-node/src/Cardano/Node/Run.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/cardano-node/src/Cardano/Node/Run.hs b/cardano-node/src/Cardano/Node/Run.hs index a81e778428a..9844d26cd4f 100644 --- a/cardano-node/src/Cardano/Node/Run.hs +++ b/cardano-node/src/Cardano/Node/Run.hs @@ -169,6 +169,8 @@ import Paths_cardano_node (version) import Paths_cardano_node (version) +import LeiosDemoTypes (demoNewLeiosDbConnectionIO) + {- HLINT ignore "Fuse concatMap/map" -} {- HLINT ignore "Redundant <$>" -} {- HLINT ignore "Use fewer imports" -} @@ -520,6 +522,7 @@ handleSimpleNode blockType runP p2pMode tracers nc onKernel = do , rnEnableP2P = p2pMode , rnPeerSharing = ncPeerSharing nc , rnGetUseBootstrapPeers = readTVar useBootstrapVar + , rnNewLeiosDbConnection = demoNewLeiosDbConnectionIO } #ifdef UNIX -- initial `SIGHUP` handler, which only rereads the topology file but @@ -618,6 +621,7 @@ handleSimpleNode blockType runP p2pMode tracers nc onKernel = do , rnEnableP2P = p2pMode , rnPeerSharing = ncPeerSharing nc , rnGetUseBootstrapPeers = pure DontUseBootstrapPeers + , rnNewLeiosDbConnection = demoNewLeiosDbConnectionIO } #ifdef UNIX -- initial `SIGHUP` handler; it only warns that neither updating of From 6119c5cff0007eb2997ea3fe5b1405ec6754d529 Mon Sep 17 00:00:00 2001 From: Nicolas Frisby Date: Mon, 27 Oct 2025 08:01:09 -0700 Subject: [PATCH 05/16] WIP add Leios demo Consensus s-r-p --- cabal.project | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/cabal.project b/cabal.project index 203826e8bed..7a2c0eee684 100644 --- a/cabal.project +++ b/cabal.project @@ -96,3 +96,19 @@ if impl (ghc >= 9.12) constraints: hedgehog-extras == 0.7.0.0 + + + + +source-repository-package + type: git + location: https://github.com/IntersectMBO/ouroboros-consensus + tag: 473d06fd7bae208cc5eb9578d442d8c8fdc31b1d + --sha256: sha256-9Y9CRiyMn0AWD+C4aNVMaJgrj3FDAYfCX4VrLvtoMaI= + subdir: + ouroboros-consensus + ouroboros-consensus-cardano + ouroboros-consensus-protocol + ouroboros-consensus-diffusion + sop-extras + strict-sop-core From 84f760f4ab95d180703180aeff0c6f61914058a5 Mon Sep 17 00:00:00 2001 From: Nicolas Frisby Date: Thu, 30 Oct 2025 07:49:43 -0700 Subject: [PATCH 06/16] leiosdemo202510: enable the Leios TraceSendRecv tracers, except Documentation.hs --- cabal.project | 4 +- cardano-node/cardano-node.cabal | 1 + .../src/Cardano/Node/Tracing/Consistency.hs | 17 +++ .../src/Cardano/Node/Tracing/Tracers.hs | 18 ++- .../Node/Tracing/Tracers/NodeToNode.hs | 127 +++++++++++++++++- .../Tracing/OrphanInstances/Network.hs | 93 +++++++++++++ cardano-node/src/Cardano/Tracing/Tracers.hs | 8 +- 7 files changed, 255 insertions(+), 13 deletions(-) diff --git a/cabal.project b/cabal.project index 7a2c0eee684..b4ad5f7f277 100644 --- a/cabal.project +++ b/cabal.project @@ -103,8 +103,8 @@ constraints: source-repository-package type: git location: https://github.com/IntersectMBO/ouroboros-consensus - tag: 473d06fd7bae208cc5eb9578d442d8c8fdc31b1d - --sha256: sha256-9Y9CRiyMn0AWD+C4aNVMaJgrj3FDAYfCX4VrLvtoMaI= + tag: 68f15b6aae8a7b5b2573abaeb4bb136eb9ec11ab + --sha256: sha256-ZJ1gSGfHzs/jBflZksVG/8dHRd3Fr7QQcvxtu0IpxHU= subdir: ouroboros-consensus ouroboros-consensus-cardano diff --git a/cardano-node/cardano-node.cabal b/cardano-node/cardano-node.cabal index 1624a529e08..da31ad77524 100644 --- a/cardano-node/cardano-node.cabal +++ b/cardano-node/cardano-node.cabal @@ -226,6 +226,7 @@ library , transformers-except , typed-protocols >= 0.3 , typed-protocols-stateful >= 0.3 + , vector , yaml executable cardano-node diff --git a/cardano-node/src/Cardano/Node/Tracing/Consistency.hs b/cardano-node/src/Cardano/Node/Tracing/Consistency.hs index 42732499ae1..339444b00aa 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Consistency.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Consistency.hs @@ -101,6 +101,9 @@ import qualified Data.Text as T import qualified Network.Mux as Mux import qualified Network.Socket as Socket +import LeiosDemoTypes (LeiosPoint, LeiosEb, LeiosTx) +import LeiosDemoOnlyTestFetch (LeiosFetch) +import LeiosDemoOnlyTestNotify (LeiosNotify) -- | Check the configuration in the given file. -- If there is no configuration in the file check the standard configuration @@ -263,6 +266,18 @@ getAllNamespaces = (TraceSendRecv (TxSubmission2 (GenTxId blk) (GenTx blk))))]) + leiosNotifyNS = map (nsGetTuple . nsReplacePrefix ["LeiosNotify", "Remote"]) + (allNamespaces :: [Namespace + (BlockFetch.TraceLabelPeer peer + (TraceSendRecv + (LeiosNotify LeiosPoint ())))]) + + leiosFetchNS = map (nsGetTuple . nsReplacePrefix ["LeiosFetch", "Remote"]) + (allNamespaces :: [Namespace + (BlockFetch.TraceLabelPeer peer + (TraceSendRecv + (LeiosFetch LeiosPoint LeiosEb LeiosTx)))]) + -- Diffusion dtMuxNS = map (nsGetTuple . nsReplacePrefix ["Net", "Mux", "Remote"]) @@ -432,6 +447,8 @@ getAllNamespaces = <> blockFetchNS <> blockFetchSerialisedNS <> txSubmission2NS + <> leiosNotifyNS + <> leiosFetchNS -- Diffusion <> dtMuxNS <> dtLocalMuxNS diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers.hs index f4c55fa947d..6928810bf9e 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers.hs @@ -68,7 +68,7 @@ import Ouroboros.Network.NodeToNode (RemoteAddress) import Codec.CBOR.Read (DeserialiseFailure) import Control.Monad (unless) -import "contra-tracer" Control.Tracer (Tracer (..), nullTracer) +import "contra-tracer" Control.Tracer (Tracer (..)) import Data.Proxy (Proxy (..)) import Network.Mux.Trace (TraceLabelPeer (..)) import Network.Socket (SockAddr) @@ -501,12 +501,17 @@ mkNodeToNodeTracers configReflection trBase trForward mbTrEKG _trDataPoint trCon trBase trForward mbTrEKG ["PeerSharing", "Remote"] configureTracers configReflection trConfig [peerSharingTracer] -{- + !leiosNotifyTracer <- mkCardanoTracer trBase trForward mbTrEKG ["LeiosNotify", "Remote"] configureTracers configReflection trConfig [leiosNotifyTracer] --} + + !leiosFetchTracer <- mkCardanoTracer + trBase trForward mbTrEKG + ["LeiosFetch", "Remote"] + configureTracers configReflection trConfig [leiosFetchTracer] + pure $ NtN.Tracers { NtN.tChainSyncTracer = Tracer $ traceWith chainSyncTracer @@ -522,9 +527,10 @@ mkNodeToNodeTracers configReflection trBase trForward mbTrEKG _trDataPoint trCon traceWith keepAliveTracer , NtN.tPeerSharingTracer = Tracer $ traceWith peerSharingTracer - , NtN.tLeiosNotifyTracer = nullTracer {- Tracer $ - traceWith leiosNotifyTracer -} - , NtN.tLeiosFetchTracer = nullTracer + , NtN.tLeiosNotifyTracer = Tracer $ + traceWith leiosNotifyTracer + , NtN.tLeiosFetchTracer = Tracer $ + traceWith leiosFetchTracer } mkDiffusionTracers diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeToNode.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeToNode.hs index 59adf4bb7b4..da4acd4d472 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeToNode.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeToNode.hs @@ -29,12 +29,18 @@ import qualified Ouroboros.Network.Protocol.PeerSharing.Type as PS import Ouroboros.Network.SizeInBytes (SizeInBytes (..)) import Control.Monad.Class.MonadTime.SI (Time (..)) -import Data.Aeson (ToJSON (..), Value (String), (.=)) +import Data.Aeson (ToJSON (..), Value (Array, Number, String), (.=)) import Data.Proxy (Proxy (..)) import Data.Time (DiffTime) import Data.Text (pack) import Network.TypedProtocol.Codec (AnyMessage (AnyMessageAndAgency)) +import qualified Data.Bits as Bits +import qualified Data.Vector as V +import LeiosDemoTypes (EbHash (..), LeiosEb, LeiosPoint (..), LeiosTx, leiosEbBytesSize, leiosTxBytesSize, prettyBitmap, prettyEbHash) +import qualified LeiosDemoOnlyTestFetch as LF +import qualified LeiosDemoOnlyTestNotify as LN + -------------------------------------------------------------------------------- -- BlockFetch Tracer -------------------------------------------------------------------------------- @@ -466,3 +472,122 @@ instance MetaTrace (TraceKeepAliveClient remotePeer) where documentFor _ = Just "" allNamespaces = [Namespace [] ["KeepAliveClient"]] + +----- + +instance ToJSON EbHash where toJSON = toJSON . prettyEbHash + +instance LogFormatting (AnyMessage (LN.LeiosNotify LeiosPoint ())) where + forHuman = showT + + forMachine _dtal (AnyMessageAndAgency _stok msg) = case msg of + + LN.MsgLeiosNotificationRequestNext -> + mconcat [ "kind" .= String "MsgLeiosNotificationRequestNext" + ] + + LN.MsgLeiosBlockAnnouncement () -> + mconcat [ "kind" .= String "MsgLeiosBlockAnnouncement" + ] + LN.MsgLeiosBlockOffer (MkLeiosPoint ebSlot ebHash) ebBytesSize -> + mconcat [ "kind" .= String "MsgLeiosBlockOffer" + , "ebSlot" .= ebSlot + , "ebHash" .= ebHash + , "ebBytesSize" .= ebBytesSize + ] + LN.MsgLeiosBlockTxsOffer (MkLeiosPoint ebSlot ebHash) -> + mconcat [ "kind" .= String "MsgLeiosBlockTxsOffer" + , "ebSlot" .= ebSlot + , "ebHash" .= ebHash + ] + + LN.MsgDone -> + mconcat [ "kind" .= String "MsgDone" + ] + +instance LogFormatting (AnyMessage (LF.LeiosFetch LeiosPoint LeiosEb LeiosTx)) where + forHuman = showT + + forMachine _dtal (AnyMessageAndAgency _stok msg) = case msg of + + LF.MsgLeiosBlockRequest (MkLeiosPoint ebSlot ebHash) -> + mconcat [ "kind" .= String "MsgLeiosBlockRequest" + , "ebSlot" .= ebSlot + , "ebHash" .= ebHash + ] + + LF.MsgLeiosBlock eb -> + mconcat [ "kind" .= String "MsgLeiosBlock" + , "eb" .= String "" + , "ebBytesSize" .= Number (fromIntegral $ leiosEbBytesSize eb) + ] + + LF.MsgLeiosBlockTxsRequest (MkLeiosPoint ebSlot ebHash) bitmaps -> + mconcat [ "kind" .= String "MsgLeiosBlockTxsRequest" + , "ebSlot" .= ebSlot + , "ebHash" .= ebHash + , "numTxs" .= Number (fromIntegral $ sum $ map (Bits.popCount . snd) bitmaps) + , "bitmaps" .= Array (V.fromList $ map (String . pack . prettyBitmap) bitmaps) + ] + + LF.MsgLeiosBlockTxs txs -> + mconcat [ "kind" .= String "MsgLeiosBlockTxs" + , "numTxs" .= Number (fromIntegral (V.length txs)) + , "txsBytesSize" .= Number (fromIntegral $ V.sum $ V.map leiosTxBytesSize txs) + , "txs" .= String "" + ] + + -- LF.MsgLeiosVotesRequest + -- LF.MsgLeiosVoteDelivery + + -- LF.MsgLeiosBlockRangeRequest + -- LF.MsgLeiosNextBlockAndTxsInRange + -- LF.MsgLeiosLastBlockAndTxsInRange + + LF.MsgDone -> + mconcat [ "kind" .= String "MsgDone" + ] + + where +-- agency :: Aeson.Object +-- agency = "agency" .= show stok + +instance MetaTrace (AnyMessage (LN.LeiosNotify LeiosPoint ())) where + namespaceFor (AnyMessageAndAgency _stok msg) = case msg of + LN.MsgLeiosNotificationRequestNext {} -> Namespace [] ["RequestNext"] + LN.MsgLeiosBlockAnnouncement {} -> Namespace [] ["BlockAnnouncement"] + LN.MsgLeiosBlockOffer {} -> Namespace [] ["BlockOffer"] + LN.MsgLeiosBlockTxsOffer {} -> Namespace [] ["BlockTxsOffer"] + LN.MsgDone -> Namespace [] ["Done"] + + severityFor _ _ = Just Debug + + documentFor _ = Nothing + + allNamespaces = [ + Namespace [] ["RequestNext"] + , Namespace [] ["BlockAnnouncement"] + , Namespace [] ["BlockOffer"] + , Namespace [] ["BlockTxsOffer"] + , Namespace [] ["Done"] + ] + +instance MetaTrace (AnyMessage (LF.LeiosFetch LeiosPoint LeiosEb LeiosTx)) where + namespaceFor (AnyMessageAndAgency _stok msg) = case msg of + LF.MsgLeiosBlockRequest {} -> Namespace [] ["BlockRequest"] + LF.MsgLeiosBlock {} -> Namespace [] ["Block"] + LF.MsgLeiosBlockTxsRequest {} -> Namespace [] ["BlockTxsRequest"] + LF.MsgLeiosBlockTxs {} -> Namespace [] ["BlockTxs"] + LF.MsgDone -> Namespace [] ["Done"] + + severityFor _ _ = Just Debug + + documentFor _ = Nothing + + allNamespaces = [ + Namespace [] ["BlockRequest"] + , Namespace [] ["Block"] + , Namespace [] ["BlockTxsRequest"] + , Namespace [] ["BlockTxs"] + , Namespace [] ["Done"] + ] diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs index 5e3398c9174..60dcad7f243 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs @@ -142,6 +142,12 @@ import qualified Network.TypedProtocol.Stateful.Codec as Stateful {- HLINT ignore "Use record patterns" -} +import qualified Data.Bits as Bits +import qualified Data.Vector as V +import LeiosDemoTypes (EbHash (..), LeiosEb, LeiosPoint (..), LeiosTx, leiosEbBytesSize, leiosTxBytesSize, prettyBitmap, prettyEbHash) +import qualified LeiosDemoOnlyTestFetch as LF +import qualified LeiosDemoOnlyTestNotify as LN + -- -- * instances of @HasPrivacyAnnotation@ and @HasSeverityAnnotation@ -- @@ -2871,3 +2877,90 @@ instance FromJSON PeerTrustable where instance ToJSON PeerTrustable where toJSON IsTrustable = Bool True toJSON IsNotTrustable = Bool False + +----- + +instance ToJSON EbHash where toJSON = toJSON . prettyEbHash + +instance ToObject peer + => Transformable Text IO (TraceLabelPeer peer (NtN.TraceSendRecv (LN.LeiosNotify LeiosPoint ()))) where + trTransformer = trStructured + +instance ToObject (AnyMessage (LN.LeiosNotify LeiosPoint ())) where + toObject _verb (AnyMessageAndAgency _stok msg) = case msg of + + LN.MsgLeiosNotificationRequestNext -> + mconcat [ "kind" .= String "MsgLeiosNotificationRequestNext" + ] + + LN.MsgLeiosBlockAnnouncement () -> + mconcat [ "kind" .= String "MsgLeiosBlockAnnouncement" + ] + LN.MsgLeiosBlockOffer (MkLeiosPoint ebSlot ebHash) ebBytesSize -> + mconcat [ "kind" .= String "MsgLeiosBlockOffer" + , "ebSlot" .= ebSlot + , "ebHash" .= ebHash + , "ebBytesSize" .= ebBytesSize + ] + LN.MsgLeiosBlockTxsOffer (MkLeiosPoint ebSlot ebHash) -> + mconcat [ "kind" .= String "MsgLeiosBlockTxsOffer" + , "ebSlot" .= ebSlot + , "ebHash" .= ebHash + ] + + LN.MsgDone -> + mconcat [ "kind" .= String "MsgDone" + ] + +-- where +-- agency :: Aeson.Object +-- agency = "agency" .= show stok + +instance ToObject peer + => Transformable Text IO (TraceLabelPeer peer (NtN.TraceSendRecv (LF.LeiosFetch LeiosPoint LeiosEb LeiosTx))) where + trTransformer = trStructured + +instance ToObject (AnyMessage (LF.LeiosFetch LeiosPoint LeiosEb LeiosTx)) where + toObject _verb (AnyMessageAndAgency _stok msg) = case msg of + + LF.MsgLeiosBlockRequest (MkLeiosPoint ebSlot ebHash) -> + mconcat [ "kind" .= String "MsgLeiosBlockRequest" + , "ebSlot" .= ebSlot + , "ebHash" .= ebHash + ] + + LF.MsgLeiosBlock eb -> + mconcat [ "kind" .= String "MsgLeiosBlock" + , "eb" .= String "" + , "ebBytesSize" .= Number (fromIntegral $ leiosEbBytesSize eb) + ] + + LF.MsgLeiosBlockTxsRequest (MkLeiosPoint ebSlot ebHash) bitmaps -> + mconcat [ "kind" .= String "MsgLeiosBlockTxsRequest" + , "ebSlot" .= ebSlot + , "ebHash" .= ebHash + , "numTxs" .= Number (fromIntegral $ sum $ map (Bits.popCount . snd) bitmaps) + , "bitmaps" .= Array (V.fromList $ map (String . pack . prettyBitmap) bitmaps) + ] + + LF.MsgLeiosBlockTxs txs -> + mconcat [ "kind" .= String "MsgLeiosBlockTxs" + , "numTxs" .= Number (fromIntegral (V.length txs)) + , "txsBytesSize" .= Number (fromIntegral $ V.sum $ V.map leiosTxBytesSize txs) + , "txs" .= String "" + ] + + -- LF.MsgLeiosVotesRequest + -- LF.MsgLeiosVoteDelivery + + -- LF.MsgLeiosBlockRangeRequest + -- LF.MsgLeiosNextBlockAndTxsInRange + -- LF.MsgLeiosLastBlockAndTxsInRange + + LF.MsgDone -> + mconcat [ "kind" .= String "MsgDone" + ] + + where +-- agency :: Aeson.Object +-- agency = "agency" .= show stok diff --git a/cardano-node/src/Cardano/Tracing/Tracers.hs b/cardano-node/src/Cardano/Tracing/Tracers.hs index 58af3c0e98a..56858b1d66b 100644 --- a/cardano-node/src/Cardano/Tracing/Tracers.hs +++ b/cardano-node/src/Cardano/Tracing/Tracers.hs @@ -1515,12 +1515,12 @@ nodeToNodeTracers' trSel verb tr = , NodeToNode.tPeerSharingTracer = tracerOnOff (tracePeerSharingProtocol trSel) verb "PeerSharingPrototocol" tr - , NodeToNode.tLeiosNotifyTracer = nullTracer {- TODO + , NodeToNode.tLeiosNotifyTracer = tracerOnOff (traceLeiosNotifyProtocol trSel) - verb "LeiosNotifyPrototocol" tr -} - , NodeToNode.tLeiosFetchTracer = nullTracer {- TODO + verb "LeiosNotifyPrototocol" tr + , NodeToNode.tLeiosFetchTracer = tracerOnOff (traceLeiosFetchProtocol trSel) - verb "LeiosFetchPrototocol" tr -} + verb "LeiosFetchPrototocol" tr } -- TODO @ouroboros-network From 95f49601daa43bc14782b8404f1d5caa3868afac Mon Sep 17 00:00:00 2001 From: Nicolas Frisby Date: Thu, 30 Oct 2025 11:23:04 -0700 Subject: [PATCH 07/16] leiosdemo202510: enable the Leios Kernel&Peer tracers --- cabal.project | 4 ++-- .../src/Cardano/Node/Tracing/Consistency.hs | 9 +++++-- .../src/Cardano/Node/Tracing/Tracers.hs | 14 +++++++++++ .../Cardano/Node/Tracing/Tracers/Consensus.hs | 23 ++++++++++++++++++ cardano-node/src/Cardano/Tracing/Config.hs | 18 ++++++++++++++ .../Tracing/OrphanInstances/Network.hs | 24 +++++++++++++++++++ cardano-node/src/Cardano/Tracing/Tracers.hs | 4 ++++ 7 files changed, 92 insertions(+), 4 deletions(-) diff --git a/cabal.project b/cabal.project index b4ad5f7f277..f0fe0c83ebe 100644 --- a/cabal.project +++ b/cabal.project @@ -103,8 +103,8 @@ constraints: source-repository-package type: git location: https://github.com/IntersectMBO/ouroboros-consensus - tag: 68f15b6aae8a7b5b2573abaeb4bb136eb9ec11ab - --sha256: sha256-ZJ1gSGfHzs/jBflZksVG/8dHRd3Fr7QQcvxtu0IpxHU= + tag: 045b3e39458d9ae077d3134858cedac70cfac8ba + --sha256: sha256-+M8WFkZY6qIxCUraqTc/9w+pphYqVOpnjIpXZeEZOpY= subdir: ouroboros-consensus ouroboros-consensus-cardano diff --git a/cardano-node/src/Cardano/Node/Tracing/Consistency.hs b/cardano-node/src/Cardano/Node/Tracing/Consistency.hs index 339444b00aa..b955d6605ce 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Consistency.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Consistency.hs @@ -101,7 +101,7 @@ import qualified Data.Text as T import qualified Network.Mux as Mux import qualified Network.Socket as Socket -import LeiosDemoTypes (LeiosPoint, LeiosEb, LeiosTx) +import LeiosDemoTypes (LeiosPoint, LeiosEb, LeiosTx, TraceLeiosKernel, TraceLeiosPeer) import LeiosDemoOnlyTestFetch (LeiosFetch) import LeiosDemoOnlyTestNotify (LeiosNotify) @@ -210,7 +210,10 @@ getAllNamespaces = (allNamespaces :: [Namespace (Jumping.TraceEventCsj peer blk)]) dbfNS = map (nsGetTuple . nsReplacePrefix ["Consensus", "DevotedBlockFetch"]) (allNamespaces :: [Namespace (Jumping.TraceEventDbf peer)]) - + leiosKernelNS = map (nsGetTuple . nsReplacePrefix ["Consensus", "LeiosKernel"]) + (allNamespaces :: [Namespace TraceLeiosKernel]) + leiosPeerNS = map (nsGetTuple . nsReplacePrefix ["Consensus", "LeiosPeer"]) + (allNamespaces :: [Namespace (BlockFetch.TraceLabelPeer remotePeer TraceLeiosPeer)]) -- Node to client keepAliveClientNS = map (nsGetTuple . nsReplacePrefix ["Net"]) (allNamespaces :: [Namespace (TraceKeepAliveClient peer)]) @@ -435,6 +438,8 @@ getAllNamespaces = <> gsmNS <> csjNS <> dbfNS + <> leiosKernelNS + <> leiosPeerNS -- NodeToClient <> keepAliveClientNS <> chainSyncNS diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers.hs index 6928810bf9e..b9bb87bf7ac 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers.hs @@ -362,6 +362,16 @@ mkConsensusTracers configReflection trBase trForward mbTrEKG _trDataPoint trConf ["Consensus", "DevotedBlockFetch"] configureTracers configReflection trConfig [consensusDbfTr] + !consensusLeiosKernelTr <- mkCardanoTracer + trBase trForward mbTrEKG + ["Consensus", "LeiosKernel"] + configureTracers configReflection trConfig [consensusLeiosKernelTr] + + !consensusLeiosPeerTr <- mkCardanoTracer + trBase trForward mbTrEKG + ["Consensus", "LeiosPeer"] + configureTracers configReflection trConfig [consensusLeiosPeerTr] + pure $ Consensus.Tracers { Consensus.chainSyncClientTracer = Tracer $ traceWith chainSyncClientTr @@ -408,6 +418,10 @@ mkConsensusTracers configReflection trBase trForward mbTrEKG _trDataPoint trConf traceWith consensusCsjTr , Consensus.dbfTracer = Tracer $ traceWith consensusDbfTr + , Consensus.leiosKernelTracer = Tracer $ + traceWith consensusLeiosKernelTr + , Consensus.leiosPeerTracer = Tracer $ + traceWith consensusLeiosPeerTr } mkNodeToClientTracers :: forall blk. diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs index 3daec1eb691..1eaa93077a8 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs @@ -81,6 +81,7 @@ import Data.Time (NominalDiffTime) import Data.Word (Word32, Word64) import Network.TypedProtocol.Core +import LeiosDemoTypes (TraceLeiosKernel, TraceLeiosPeer, traceLeiosKernelToObject, traceLeiosPeerToObject) instance (LogFormatting adr, Show adr) => LogFormatting (ConnectionId adr) where forMachine _dtal (ConnectionId local' remote) = @@ -2267,3 +2268,25 @@ instance ( StandardHash blk ] forHuman = showT + +----- + +instance LogFormatting TraceLeiosKernel where + forHuman = showT + forMachine _dtal = traceLeiosKernelToObject + +instance MetaTrace TraceLeiosKernel where + namespaceFor _ = Namespace [] [] + severityFor _ _ = Just Debug + documentFor _ = Nothing + allNamespaces = [ Namespace [] [] ] + +instance LogFormatting TraceLeiosPeer where + forHuman = showT + forMachine _dtal = traceLeiosPeerToObject + +instance MetaTrace TraceLeiosPeer where + namespaceFor _ = Namespace [] [] + severityFor _ _ = Just Debug + documentFor _ = Nothing + allNamespaces = [ Namespace [] [] ] diff --git a/cardano-node/src/Cardano/Tracing/Config.hs b/cardano-node/src/Cardano/Tracing/Config.hs index c258022badb..158c0a498d6 100644 --- a/cardano-node/src/Cardano/Tracing/Config.hs +++ b/cardano-node/src/Cardano/Tracing/Config.hs @@ -187,6 +187,8 @@ type TraceLeiosFetchProtocol = ("TraceLeiosFetchProtocol" :: Symbol) type TraceGsm = ("TraceGsm" :: Symbol) type TraceCsj = ("TraceCsj" :: Symbol) type TraceDevotedBlockFetch = ("TraceDevotedBlockFetch" :: Symbol) +type TraceLeiosKernel = ("TraceLeiosKernel" :: Symbol) +type TraceLeiosPeer = ("TraceLeiosPeer" :: Symbol) newtype OnOff (name :: Symbol) = OnOff { isOn :: Bool } deriving (Eq, Show) @@ -265,6 +267,8 @@ data TraceSelection , traceGsm :: OnOff TraceGsm , traceCsj :: OnOff TraceCsj , traceDevotedBlockFetch :: OnOff TraceDevotedBlockFetch + , traceLeiosKernel :: OnOff TraceLeiosKernel + , traceLeiosPeer :: OnOff TraceLeiosPeer } deriving (Eq, Show) @@ -337,6 +341,8 @@ data PartialTraceSelection , pTraceGsm :: Last (OnOff TraceGsm) , pTraceCsj :: Last (OnOff TraceCsj) , pTraceDevotedBlockFetch :: Last (OnOff TraceDevotedBlockFetch) + , pTraceLeiosKernel :: Last (OnOff TraceLeiosKernel) + , pTraceLeiosPeer :: Last (OnOff TraceLeiosPeer) } deriving (Eq, Generic, Show) @@ -410,6 +416,8 @@ instance FromJSON PartialTraceSelection where <*> parseTracer (Proxy @TraceGsm) v <*> parseTracer (Proxy @TraceCsj) v <*> parseTracer (Proxy @TraceDevotedBlockFetch) v + <*> parseTracer (Proxy @TraceLeiosKernel) v + <*> parseTracer (Proxy @TraceLeiosPeer) v defaultPartialTraceConfiguration :: PartialTraceSelection @@ -480,6 +488,8 @@ defaultPartialTraceConfiguration = , pTraceGsm = pure $ OnOff True , pTraceCsj = pure $ OnOff True , pTraceDevotedBlockFetch = pure $ OnOff True + , pTraceLeiosKernel = pure $ OnOff True + , pTraceLeiosPeer = pure $ OnOff True } @@ -552,6 +562,8 @@ partialTraceSelectionToEither (Last (Just (PartialTraceDispatcher pTraceSelectio traceGsm <- proxyLastToEither (Proxy @TraceGsm) pTraceGsm traceCsj <- proxyLastToEither (Proxy @TraceCsj) pTraceCsj traceDevotedBlockFetch <- proxyLastToEither (Proxy @TraceDevotedBlockFetch) pTraceDevotedBlockFetch + traceLeiosKernel <- proxyLastToEither (Proxy @TraceLeiosKernel) pTraceLeiosKernel + traceLeiosPeer <- proxyLastToEither (Proxy @TraceLeiosPeer) pTraceLeiosPeer Right $ TraceDispatcher $ TraceSelection { traceVerbosity = traceVerbosity , traceAcceptPolicy = traceAcceptPolicy @@ -617,6 +629,8 @@ partialTraceSelectionToEither (Last (Just (PartialTraceDispatcher pTraceSelectio , traceGsm = traceGsm , traceCsj = traceCsj , traceDevotedBlockFetch = traceDevotedBlockFetch + , traceLeiosKernel = traceLeiosKernel + , traceLeiosPeer = traceLeiosPeer } partialTraceSelectionToEither (Last (Just (PartialTracingOnLegacy pTraceSelection))) = do @@ -686,6 +700,8 @@ partialTraceSelectionToEither (Last (Just (PartialTracingOnLegacy pTraceSelectio traceGsm <- proxyLastToEither (Proxy @TraceGsm) pTraceGsm traceCsj <- proxyLastToEither (Proxy @TraceCsj) pTraceCsj traceDevotedBlockFetch <- proxyLastToEither (Proxy @TraceDevotedBlockFetch) pTraceDevotedBlockFetch + traceLeiosKernel <- proxyLastToEither (Proxy @TraceLeiosKernel) pTraceLeiosKernel + traceLeiosPeer <- proxyLastToEither (Proxy @TraceLeiosPeer) pTraceLeiosPeer Right $ TracingOnLegacy $ TraceSelection { traceVerbosity = traceVerbosity , traceAcceptPolicy = traceAcceptPolicy @@ -751,6 +767,8 @@ partialTraceSelectionToEither (Last (Just (PartialTracingOnLegacy pTraceSelectio , traceGsm = traceGsm , traceCsj = traceCsj , traceDevotedBlockFetch = traceDevotedBlockFetch + , traceLeiosKernel = traceLeiosKernel + , traceLeiosPeer = traceLeiosPeer } proxyLastToEither :: KnownSymbol name => Proxy name -> Last (OnOff name) -> Either Text (OnOff name) diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs index 60dcad7f243..62eed6a670c 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs @@ -145,6 +145,7 @@ import qualified Network.TypedProtocol.Stateful.Codec as Stateful import qualified Data.Bits as Bits import qualified Data.Vector as V import LeiosDemoTypes (EbHash (..), LeiosEb, LeiosPoint (..), LeiosTx, leiosEbBytesSize, leiosTxBytesSize, prettyBitmap, prettyEbHash) +import LeiosDemoTypes (TraceLeiosKernel, TraceLeiosPeer, traceLeiosKernelToObject, traceLeiosPeerToObject) import qualified LeiosDemoOnlyTestFetch as LF import qualified LeiosDemoOnlyTestNotify as LN @@ -2964,3 +2965,26 @@ instance ToObject (AnyMessage (LF.LeiosFetch LeiosPoint LeiosEb LeiosTx)) where where -- agency :: Aeson.Object -- agency = "agency" .= show stok + +instance Transformable Text IO TraceLeiosKernel where + trTransformer = trStructured + +instance ToObject TraceLeiosKernel where + toObject _verb = traceLeiosKernelToObject + +instance HasPrivacyAnnotation TraceLeiosKernel + +instance HasSeverityAnnotation TraceLeiosKernel where + getSeverityAnnotation _ = Debug + +instance ToObject peer + => Transformable Text IO (TraceLabelPeer peer TraceLeiosPeer) where + trTransformer = trStructured + +instance ToObject TraceLeiosPeer where + toObject _verb = traceLeiosPeerToObject + +instance HasPrivacyAnnotation TraceLeiosPeer + +instance HasSeverityAnnotation TraceLeiosPeer where + getSeverityAnnotation _ = Debug diff --git a/cardano-node/src/Cardano/Tracing/Tracers.hs b/cardano-node/src/Cardano/Tracing/Tracers.hs index 56858b1d66b..5154aeb95c4 100644 --- a/cardano-node/src/Cardano/Tracing/Tracers.hs +++ b/cardano-node/src/Cardano/Tracing/Tracers.hs @@ -556,6 +556,8 @@ mkTracers _ _ _ _ _ enableP2P = , Consensus.gsmTracer = nullTracer , Consensus.csjTracer = nullTracer , Consensus.dbfTracer = nullTracer + , Consensus.leiosKernelTracer = nullTracer + , Consensus.leiosPeerTracer = nullTracer } , nodeToClientTracers = NodeToClient.Tracers { NodeToClient.tChainSyncTracer = nullTracer @@ -864,6 +866,8 @@ mkConsensusTracers mbEKGDirect trSel verb tr nodeKern fStats = do , Consensus.gsmTracer = tracerOnOff (traceGsm trSel) verb "GSM" tr , Consensus.csjTracer = tracerOnOff (traceCsj trSel) verb "CSJ" tr , Consensus.dbfTracer = tracerOnOff (traceDevotedBlockFetch trSel) verb "DevotedBlockFetch" tr + , Consensus.leiosKernelTracer = tracerOnOff (traceLeiosKernel trSel) verb "LeiosKernel" tr + , Consensus.leiosPeerTracer = tracerOnOff (traceLeiosPeer trSel) verb "LeiosPeer" tr } where mkForgeTracers :: IO ForgeTracers From 9e457f93aa302674708edb9fd1266ca2d89cbb84 Mon Sep 17 00:00:00 2001 From: Nicolas Frisby Date: Tue, 25 Nov 2025 15:22:23 -0800 Subject: [PATCH 08/16] leiosdemo202511: fixup build for ouroboros-network:runDriver* and TraceSendRecv changes --- .../Node/Tracing/Tracers/NodeToClient.hs | 66 +++++++++---------- .../Tracing/OrphanInstances/Network.hs | 16 ++--- .../Trace/Forward/Run/DataPoint/Acceptor.hs | 1 + .../Trace/Forward/Run/DataPoint/Forwarder.hs | 1 + .../Trace/Forward/Run/TraceObject/Acceptor.hs | 1 + .../Forward/Run/TraceObject/Forwarder.hs | 1 + 6 files changed, 45 insertions(+), 41 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeToClient.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeToClient.hs index a504b19c4a9..4af33840d65 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeToClient.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeToClient.hs @@ -19,7 +19,7 @@ import qualified Ouroboros.Network.Protocol.LocalStateQuery.Type as LSQ import qualified Ouroboros.Network.Protocol.LocalTxMonitor.Type as LTM import qualified Ouroboros.Network.Protocol.LocalTxSubmission.Type as LTS -import Data.Aeson (Value (String), (.=)) +import Data.Aeson (Value (String), (.=), (.?=)) import Data.Text (Text, pack) import qualified Network.TypedProtocol.Codec as Simple import qualified Network.TypedProtocol.Stateful.Codec as Stateful @@ -28,62 +28,62 @@ import qualified Network.TypedProtocol.Stateful.Codec as Stateful instance LogFormatting (Simple.AnyMessage ps) => LogFormatting (Simple.TraceSendRecv ps) where - forMachine dtal (Simple.TraceSendMsg m) = mconcat - [ "kind" .= String "Send" , "msg" .= forMachine dtal m ] - forMachine dtal (Simple.TraceRecvMsg m) = mconcat - [ "kind" .= String "Recv" , "msg" .= forMachine dtal m ] + forMachine dtal (Simple.TraceSendMsg tm m) = mconcat + [ "kind" .= String "Send" , "msg" .= forMachine dtal m, "tm" .= String (pack $ show tm) ] + forMachine dtal (Simple.TraceRecvMsg mbTm m) = mconcat + [ "kind" .= String "Recv" , "msg" .= forMachine dtal m, "tm" .?= fmap (String . pack . show) mbTm ] - forHuman (Simple.TraceSendMsg m) = "Send: " <> forHumanOrMachine m - forHuman (Simple.TraceRecvMsg m) = "Receive: " <> forHumanOrMachine m + forHuman (Simple.TraceSendMsg _tm m) = "Send: " <> forHumanOrMachine m + forHuman (Simple.TraceRecvMsg _mbTm m) = "Receive: " <> forHumanOrMachine m - asMetrics (Simple.TraceSendMsg m) = asMetrics m - asMetrics (Simple.TraceRecvMsg m) = asMetrics m + asMetrics (Simple.TraceSendMsg _tm m) = asMetrics m + asMetrics (Simple.TraceRecvMsg _mbTm m) = asMetrics m instance LogFormatting (Stateful.AnyMessage ps f) => LogFormatting (Stateful.TraceSendRecv ps f) where - forMachine dtal (Stateful.TraceSendMsg m) = mconcat - [ "kind" .= String "Send" , "msg" .= forMachine dtal m ] - forMachine dtal (Stateful.TraceRecvMsg m) = mconcat - [ "kind" .= String "Recv" , "msg" .= forMachine dtal m ] + forMachine dtal (Stateful.TraceSendMsg tm m) = mconcat + [ "kind" .= String "Send" , "msg" .= forMachine dtal m, "tm" .= String (pack $ show tm) ] + forMachine dtal (Stateful.TraceRecvMsg mbTm m) = mconcat + [ "kind" .= String "Recv" , "msg" .= forMachine dtal m, "tm" .?= fmap (String . pack . show) mbTm ] - forHuman (Stateful.TraceSendMsg m) = "Send: " <> forHumanOrMachine m - forHuman (Stateful.TraceRecvMsg m) = "Receive: " <> forHumanOrMachine m + forHuman (Stateful.TraceSendMsg _tm m) = "Send: " <> forHumanOrMachine m + forHuman (Stateful.TraceRecvMsg _mbTm m) = "Receive: " <> forHumanOrMachine m - asMetrics (Stateful.TraceSendMsg m) = asMetrics m - asMetrics (Stateful.TraceRecvMsg m) = asMetrics m + asMetrics (Stateful.TraceSendMsg _tm m) = asMetrics m + asMetrics (Stateful.TraceRecvMsg _mbTm m) = asMetrics m instance MetaTrace (Simple.AnyMessage ps) => MetaTrace (Simple.TraceSendRecv ps) where - namespaceFor (Simple.TraceSendMsg msg) = + namespaceFor (Simple.TraceSendMsg _tm msg) = nsPrependInner "Send" (namespaceFor msg) - namespaceFor (Simple.TraceRecvMsg msg) = + namespaceFor (Simple.TraceRecvMsg _mbTm msg) = nsPrependInner "Receive" (namespaceFor msg) - severityFor (Namespace out ("Send" : tl)) (Just (Simple.TraceSendMsg msg)) = + severityFor (Namespace out ("Send" : tl)) (Just (Simple.TraceSendMsg _tm msg)) = severityFor (Namespace out tl) (Just msg) severityFor (Namespace out ("Send" : tl)) Nothing = severityFor (Namespace out tl :: Namespace (Simple.AnyMessage ps)) Nothing - severityFor (Namespace out ("Receive" : tl)) (Just (Simple.TraceSendMsg msg)) = + severityFor (Namespace out ("Receive" : tl)) (Just (Simple.TraceSendMsg _tm msg)) = severityFor (Namespace out tl) (Just msg) severityFor (Namespace out ("Receive" : tl)) Nothing = severityFor (Namespace out tl :: Namespace (Simple.AnyMessage ps)) Nothing severityFor _ _ = Nothing - privacyFor (Namespace out ("Send" : tl)) (Just (Simple.TraceSendMsg msg)) = + privacyFor (Namespace out ("Send" : tl)) (Just (Simple.TraceSendMsg _tm msg)) = privacyFor (Namespace out tl) (Just msg) privacyFor (Namespace out ("Send" : tl)) Nothing = privacyFor (Namespace out tl :: Namespace (Simple.AnyMessage ps)) Nothing - privacyFor (Namespace out ("Receive" : tl)) (Just (Simple.TraceSendMsg msg)) = + privacyFor (Namespace out ("Receive" : tl)) (Just (Simple.TraceSendMsg _tm msg)) = privacyFor (Namespace out tl) (Just msg) privacyFor (Namespace out ("Receive" : tl)) Nothing = privacyFor (Namespace out tl :: Namespace (Simple.AnyMessage ps)) Nothing privacyFor _ _ = Nothing - detailsFor (Namespace out ("Send" : tl)) (Just (Simple.TraceSendMsg msg)) = + detailsFor (Namespace out ("Send" : tl)) (Just (Simple.TraceSendMsg _tm msg)) = detailsFor (Namespace out tl) (Just msg) detailsFor (Namespace out ("Send" : tl)) Nothing = detailsFor (Namespace out tl :: Namespace (Simple.AnyMessage ps)) Nothing - detailsFor (Namespace out ("Receive" : tl)) (Just (Simple.TraceSendMsg msg)) = + detailsFor (Namespace out ("Receive" : tl)) (Just (Simple.TraceSendMsg _tm msg)) = detailsFor (Namespace out tl) (Just msg) detailsFor (Namespace out ("Receive" : tl)) Nothing = detailsFor (Namespace out tl :: Namespace (Simple.AnyMessage ps)) Nothing @@ -107,36 +107,36 @@ instance MetaTrace (Simple.AnyMessage ps) => instance MetaTrace (Stateful.AnyMessage ps f) => MetaTrace (Stateful.TraceSendRecv ps f) where - namespaceFor (Stateful.TraceSendMsg msg) = + namespaceFor (Stateful.TraceSendMsg _tm msg) = nsPrependInner "Send" (namespaceFor msg) - namespaceFor (Stateful.TraceRecvMsg msg) = + namespaceFor (Stateful.TraceRecvMsg _mbTm msg) = nsPrependInner "Receive" (namespaceFor msg) - severityFor (Namespace out ("Send" : tl)) (Just (Stateful.TraceSendMsg msg)) = + severityFor (Namespace out ("Send" : tl)) (Just (Stateful.TraceSendMsg _tm msg)) = severityFor (Namespace out tl) (Just msg) severityFor (Namespace out ("Send" : tl)) Nothing = severityFor (Namespace out tl :: Namespace (Stateful.AnyMessage ps f)) Nothing - severityFor (Namespace out ("Receive" : tl)) (Just (Stateful.TraceSendMsg msg)) = + severityFor (Namespace out ("Receive" : tl)) (Just (Stateful.TraceSendMsg _tm msg)) = severityFor (Namespace out tl) (Just msg) severityFor (Namespace out ("Receive" : tl)) Nothing = severityFor (Namespace out tl :: Namespace (Stateful.AnyMessage ps f)) Nothing severityFor _ _ = Nothing - privacyFor (Namespace out ("Send" : tl)) (Just (Stateful.TraceSendMsg msg)) = + privacyFor (Namespace out ("Send" : tl)) (Just (Stateful.TraceSendMsg _tm msg)) = privacyFor (Namespace out tl) (Just msg) privacyFor (Namespace out ("Send" : tl)) Nothing = privacyFor (Namespace out tl :: Namespace (Stateful.AnyMessage ps f)) Nothing - privacyFor (Namespace out ("Receive" : tl)) (Just (Stateful.TraceSendMsg msg)) = + privacyFor (Namespace out ("Receive" : tl)) (Just (Stateful.TraceSendMsg _tm msg)) = privacyFor (Namespace out tl) (Just msg) privacyFor (Namespace out ("Receive" : tl)) Nothing = privacyFor (Namespace out tl :: Namespace (Stateful.AnyMessage ps f)) Nothing privacyFor _ _ = Nothing - detailsFor (Namespace out ("Send" : tl)) (Just (Stateful.TraceSendMsg msg)) = + detailsFor (Namespace out ("Send" : tl)) (Just (Stateful.TraceSendMsg _tm msg)) = detailsFor (Namespace out tl) (Just msg) detailsFor (Namespace out ("Send" : tl)) Nothing = detailsFor (Namespace out tl :: Namespace (Stateful.AnyMessage ps f)) Nothing - detailsFor (Namespace out ("Receive" : tl)) (Just (Stateful.TraceSendMsg msg)) = + detailsFor (Namespace out ("Receive" : tl)) (Just (Stateful.TraceSendMsg _tm msg)) = detailsFor (Namespace out tl) (Just msg) detailsFor (Namespace out ("Receive" : tl)) Nothing = detailsFor (Namespace out tl :: Namespace (Stateful.AnyMessage ps f)) Nothing diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs index 62eed6a670c..d546c051154 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs @@ -1444,18 +1444,18 @@ instance (ToJSON peer, ConvertRawHash header) instance ToObject (AnyMessage ps) => ToObject (TraceSendRecv ps) where - toObject verb (TraceSendMsg m) = mconcat - [ "kind" .= String "Send" , "msg" .= toObject verb m ] - toObject verb (TraceRecvMsg m) = mconcat - [ "kind" .= String "Recv" , "msg" .= toObject verb m ] + toObject verb (TraceSendMsg tm m) = mconcat + [ "kind" .= String "Send" , "msg" .= toObject verb m, "tm" .= String (pack $ show tm) ] + toObject verb (TraceRecvMsg mbTm m) = mconcat + [ "kind" .= String "Recv" , "msg" .= toObject verb m, "tm" Aeson..?= fmap (String . pack . show) mbTm ] instance ToObject (Stateful.AnyMessage ps f) => ToObject (Stateful.TraceSendRecv ps f) where - toObject verb (Stateful.TraceSendMsg m) = mconcat - [ "kind" .= String "Send" , "msg" .= toObject verb m ] - toObject verb (Stateful.TraceRecvMsg m) = mconcat - [ "kind" .= String "Recv" , "msg" .= toObject verb m ] + toObject verb (Stateful.TraceSendMsg tm m) = mconcat + [ "kind" .= String "Send" , "msg" .= toObject verb m, "tm" .= String (pack $ show tm) ] + toObject verb (Stateful.TraceRecvMsg mbTm m) = mconcat + [ "kind" .= String "Recv" , "msg" .= toObject verb m, "tm" Aeson..?= fmap (String . pack . show) mbTm ] instance ToObject (TraceTxSubmissionInbound txid tx) where diff --git a/trace-forward/src/Trace/Forward/Run/DataPoint/Acceptor.hs b/trace-forward/src/Trace/Forward/Run/DataPoint/Acceptor.hs index 5131d36efed..e535dc3d305 100644 --- a/trace-forward/src/Trace/Forward/Run/DataPoint/Acceptor.hs +++ b/trace-forward/src/Trace/Forward/Run/DataPoint/Acceptor.hs @@ -54,6 +54,7 @@ runPeerWithRequestor config mkDPRequestor peerErrorHandler = (acceptorTracer config) (Acceptor.codecDataPointForward CBOR.encode CBOR.decode CBOR.encode CBOR.decode) + (fromIntegral . LBS.length) channel (Acceptor.dataPointAcceptorPeer $ acceptorActions config dpRequestor []) `finally` peerErrorHandler ctx diff --git a/trace-forward/src/Trace/Forward/Run/DataPoint/Forwarder.hs b/trace-forward/src/Trace/Forward/Run/DataPoint/Forwarder.hs index 3a8537540f3..554aac56943 100644 --- a/trace-forward/src/Trace/Forward/Run/DataPoint/Forwarder.hs +++ b/trace-forward/src/Trace/Forward/Run/DataPoint/Forwarder.hs @@ -42,5 +42,6 @@ runPeerWithDPStore config dpStore = (forwarderTracer config) (Forwarder.codecDataPointForward CBOR.encode CBOR.decode CBOR.encode CBOR.decode) + (fromIntegral . LBS.length) channel (Forwarder.dataPointForwarderPeer $ readFromStore dpStore) diff --git a/trace-forward/src/Trace/Forward/Run/TraceObject/Acceptor.hs b/trace-forward/src/Trace/Forward/Run/TraceObject/Acceptor.hs index 511fb50e7f8..175506dd981 100644 --- a/trace-forward/src/Trace/Forward/Run/TraceObject/Acceptor.hs +++ b/trace-forward/src/Trace/Forward/Run/TraceObject/Acceptor.hs @@ -68,6 +68,7 @@ runPeerWithHandler config@AcceptorConfiguration{acceptorTracer, shouldWeStop} lo acceptorTracer (Acceptor.codecTraceObjectForward CBOR.encode CBOR.decode CBOR.encode CBOR.decode) + (fromIntegral . LBS.length) channel (Acceptor.traceObjectAcceptorPeer $ acceptorActions config (loHandler ctx)) `finally` peerErrorHandler ctx diff --git a/trace-forward/src/Trace/Forward/Run/TraceObject/Forwarder.hs b/trace-forward/src/Trace/Forward/Run/TraceObject/Forwarder.hs index bd460ba36c7..e01bc8680db 100644 --- a/trace-forward/src/Trace/Forward/Run/TraceObject/Forwarder.hs +++ b/trace-forward/src/Trace/Forward/Run/TraceObject/Forwarder.hs @@ -48,5 +48,6 @@ runPeerWithSink config sink = (forwarderTracer config) (Forwarder.codecTraceObjectForward CBOR.encode CBOR.decode CBOR.encode CBOR.decode) + (fromIntegral . LBS.length) channel (Forwarder.traceObjectForwarderPeer $ readFromSink sink) From 6ac41d4bd3f7ae4700a78699715f00ffbf597838 Mon Sep 17 00:00:00 2001 From: Nicolas Frisby Date: Thu, 27 Nov 2025 11:02:04 -0800 Subject: [PATCH 09/16] leiosdemo202511: hacky special case for mux_tm --- .../Node/Tracing/Tracers/NodeToClient.hs | 12 +++++++---- .../Tracing/OrphanInstances/Network.hs | 10 +++++---- .../src/Cardano/Logging/Formatter.hs | 21 +++++++++++++++++-- 3 files changed, 33 insertions(+), 10 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeToClient.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeToClient.hs index 4af33840d65..e4f9b46d036 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeToClient.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeToClient.hs @@ -19,6 +19,7 @@ import qualified Ouroboros.Network.Protocol.LocalStateQuery.Type as LSQ import qualified Ouroboros.Network.Protocol.LocalTxMonitor.Type as LTM import qualified Ouroboros.Network.Protocol.LocalTxSubmission.Type as LTS +import Control.Monad.Class.MonadTime.SI (Time (..)) import Data.Aeson (Value (String), (.=), (.?=)) import Data.Text (Text, pack) import qualified Network.TypedProtocol.Codec as Simple @@ -26,12 +27,15 @@ import qualified Network.TypedProtocol.Stateful.Codec as Stateful {-# ANN module ("HLint: ignore Redundant bracket" :: Text) #-} +jsonTime :: Time -> Double +jsonTime (Time x) = realToFrac x + instance LogFormatting (Simple.AnyMessage ps) => LogFormatting (Simple.TraceSendRecv ps) where forMachine dtal (Simple.TraceSendMsg tm m) = mconcat - [ "kind" .= String "Send" , "msg" .= forMachine dtal m, "tm" .= String (pack $ show tm) ] + [ "kind" .= String "Send" , "msg" .= forMachine dtal m, "mux_at" .= jsonTime tm ] forMachine dtal (Simple.TraceRecvMsg mbTm m) = mconcat - [ "kind" .= String "Recv" , "msg" .= forMachine dtal m, "tm" .?= fmap (String . pack . show) mbTm ] + [ "kind" .= String "Recv" , "msg" .= forMachine dtal m, "mux_at" .?= fmap jsonTime mbTm ] forHuman (Simple.TraceSendMsg _tm m) = "Send: " <> forHumanOrMachine m forHuman (Simple.TraceRecvMsg _mbTm m) = "Receive: " <> forHumanOrMachine m @@ -42,9 +46,9 @@ instance LogFormatting (Simple.AnyMessage ps) instance LogFormatting (Stateful.AnyMessage ps f) => LogFormatting (Stateful.TraceSendRecv ps f) where forMachine dtal (Stateful.TraceSendMsg tm m) = mconcat - [ "kind" .= String "Send" , "msg" .= forMachine dtal m, "tm" .= String (pack $ show tm) ] + [ "kind" .= String "Send" , "msg" .= forMachine dtal m, "mux_at" .= jsonTime tm ] forMachine dtal (Stateful.TraceRecvMsg mbTm m) = mconcat - [ "kind" .= String "Recv" , "msg" .= forMachine dtal m, "tm" .?= fmap (String . pack . show) mbTm ] + [ "kind" .= String "Recv" , "msg" .= forMachine dtal m, "mux_at" .?= fmap jsonTime mbTm ] forHuman (Stateful.TraceSendMsg _tm m) = "Send: " <> forHumanOrMachine m forHuman (Stateful.TraceRecvMsg _mbTm m) = "Receive: " <> forHumanOrMachine m diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs index d546c051154..87055bddf1d 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs @@ -1445,18 +1445,20 @@ instance (ToJSON peer, ConvertRawHash header) instance ToObject (AnyMessage ps) => ToObject (TraceSendRecv ps) where toObject verb (TraceSendMsg tm m) = mconcat - [ "kind" .= String "Send" , "msg" .= toObject verb m, "tm" .= String (pack $ show tm) ] + [ "kind" .= String "Send" , "msg" .= toObject verb m, "mux_at" .= jsonTime tm ] toObject verb (TraceRecvMsg mbTm m) = mconcat - [ "kind" .= String "Recv" , "msg" .= toObject verb m, "tm" Aeson..?= fmap (String . pack . show) mbTm ] + [ "kind" .= String "Recv" , "msg" .= toObject verb m, "mux_at" Aeson..?= fmap jsonTime mbTm ] instance ToObject (Stateful.AnyMessage ps f) => ToObject (Stateful.TraceSendRecv ps f) where toObject verb (Stateful.TraceSendMsg tm m) = mconcat - [ "kind" .= String "Send" , "msg" .= toObject verb m, "tm" .= String (pack $ show tm) ] + [ "kind" .= String "Send" , "msg" .= toObject verb m, "mux_at" .= jsonTime tm ] toObject verb (Stateful.TraceRecvMsg mbTm m) = mconcat - [ "kind" .= String "Recv" , "msg" .= toObject verb m, "tm" Aeson..?= fmap (String . pack . show) mbTm ] + [ "kind" .= String "Recv" , "msg" .= toObject verb m, "mux_at" Aeson..?= fmap jsonTime mbTm ] +jsonTime :: Time -> Double +jsonTime (Time x) = realToFrac x instance ToObject (TraceTxSubmissionInbound txid tx) where toObject _verb (TraceTxSubmissionCollected count) = diff --git a/trace-dispatcher/src/Cardano/Logging/Formatter.hs b/trace-dispatcher/src/Cardano/Logging/Formatter.hs index 16de345dd87..aa7b0ef04ed 100644 --- a/trace-dispatcher/src/Cardano/Logging/Formatter.hs +++ b/trace-dispatcher/src/Cardano/Logging/Formatter.hs @@ -26,17 +26,22 @@ import qualified Control.Tracer as T import Data.Aeson ((.=)) import qualified Data.Aeson as AE import qualified Data.Aeson.Encoding as AE +import qualified Data.Aeson.KeyMap as AE import Data.Functor.Contravariant import Data.Maybe (fromMaybe) import Data.Text as T (Text, intercalate, null, pack) import Data.Text.Lazy (toStrict) import Data.Text.Lazy.Builder as TB import Data.Text.Lazy.Encoding (decodeUtf8) -import Data.Time (UTCTime, defaultTimeLocale, formatTime, getCurrentTime) +import Data.Time (UTCTime, addUTCTime, defaultTimeLocale, formatTime, getCurrentTime) +import GHC.Clock (getMonotonicTime) import Network.HostName import System.IO.Unsafe (unsafePerformIO) +data I a = I a +instance Functor I where fmap f (I x) = I (f x) + encodingToText :: AE.Encoding -> Text {-# INLINE encodingToText #-} encodingToText = toStrict . decodeUtf8 . AE.encodingToLazyByteString @@ -45,6 +50,10 @@ timeFormatted :: UTCTime -> Text {-# INLINE timeFormatted #-} timeFormatted = pack . formatTime defaultTimeLocale "%F %H:%M:%S%4QZ" +timeFormattedT :: UTCTime -> Text +{-# INLINE timeFormattedT #-} +timeFormattedT = pack . formatTime defaultTimeLocale "%FT%H:%M:%S%8QZ" + -- If the hostname in the logs should be anything different from the system reported hostname, -- a new field would need to be added to PreFormatted to carry a new hostname argument to preFormatted. hostname :: Text @@ -84,13 +93,21 @@ preFormatted withForHuman = flip contramapM (\case (lc, Right msg) -> do + tm <- liftIO getMonotonicTime time <- liftIO getCurrentTime + let tmf tm' = flip addUTCTime time $ fromRational $ tm' - toRational tm threadId <- liftIO myThreadId let ns' = lcNSPrefix lc ++ lcNSInner lc threadTextShortened = T.pack $ drop 9 $ show threadId -- drop "ThreadId " prefix details = fromMaybe DNormal (lcDetails lc) condForHuman = let txt = forHuman msg in if T.null txt then Nothing else Just txt - machineFormatted = AE.toEncoding $ forMachine details msg + obj = forMachine details msg + -- nasty special case for a numeric "mux_tm" field + I obj' = (\f -> AE.alterF f "mux_at" obj) $ \case + Nothing -> I Nothing + Just (AE.Number tm') -> I $ Just $ AE.String $ timeFormattedT $ tmf $ toRational tm' + Just x -> I $ Just x + machineFormatted = AE.toEncoding $ obj' pure (lc, Right (PreFormatted { pfForHuman = if withForHuman then condForHuman else Nothing From 93d2c8481912309faf5a7d9058f9fdeca95710a0 Mon Sep 17 00:00:00 2001 From: Nicolas Frisby Date: Thu, 27 Nov 2025 11:02:11 -0800 Subject: [PATCH 10/16] leiosdemo202511: integrate ouroboros-network BearerBytes --- trace-forward/src/Trace/Forward/Run/DataPoint/Acceptor.hs | 1 - trace-forward/src/Trace/Forward/Run/DataPoint/Forwarder.hs | 1 - trace-forward/src/Trace/Forward/Run/TraceObject/Acceptor.hs | 1 - trace-forward/src/Trace/Forward/Run/TraceObject/Forwarder.hs | 1 - 4 files changed, 4 deletions(-) diff --git a/trace-forward/src/Trace/Forward/Run/DataPoint/Acceptor.hs b/trace-forward/src/Trace/Forward/Run/DataPoint/Acceptor.hs index e535dc3d305..5131d36efed 100644 --- a/trace-forward/src/Trace/Forward/Run/DataPoint/Acceptor.hs +++ b/trace-forward/src/Trace/Forward/Run/DataPoint/Acceptor.hs @@ -54,7 +54,6 @@ runPeerWithRequestor config mkDPRequestor peerErrorHandler = (acceptorTracer config) (Acceptor.codecDataPointForward CBOR.encode CBOR.decode CBOR.encode CBOR.decode) - (fromIntegral . LBS.length) channel (Acceptor.dataPointAcceptorPeer $ acceptorActions config dpRequestor []) `finally` peerErrorHandler ctx diff --git a/trace-forward/src/Trace/Forward/Run/DataPoint/Forwarder.hs b/trace-forward/src/Trace/Forward/Run/DataPoint/Forwarder.hs index 554aac56943..3a8537540f3 100644 --- a/trace-forward/src/Trace/Forward/Run/DataPoint/Forwarder.hs +++ b/trace-forward/src/Trace/Forward/Run/DataPoint/Forwarder.hs @@ -42,6 +42,5 @@ runPeerWithDPStore config dpStore = (forwarderTracer config) (Forwarder.codecDataPointForward CBOR.encode CBOR.decode CBOR.encode CBOR.decode) - (fromIntegral . LBS.length) channel (Forwarder.dataPointForwarderPeer $ readFromStore dpStore) diff --git a/trace-forward/src/Trace/Forward/Run/TraceObject/Acceptor.hs b/trace-forward/src/Trace/Forward/Run/TraceObject/Acceptor.hs index 175506dd981..511fb50e7f8 100644 --- a/trace-forward/src/Trace/Forward/Run/TraceObject/Acceptor.hs +++ b/trace-forward/src/Trace/Forward/Run/TraceObject/Acceptor.hs @@ -68,7 +68,6 @@ runPeerWithHandler config@AcceptorConfiguration{acceptorTracer, shouldWeStop} lo acceptorTracer (Acceptor.codecTraceObjectForward CBOR.encode CBOR.decode CBOR.encode CBOR.decode) - (fromIntegral . LBS.length) channel (Acceptor.traceObjectAcceptorPeer $ acceptorActions config (loHandler ctx)) `finally` peerErrorHandler ctx diff --git a/trace-forward/src/Trace/Forward/Run/TraceObject/Forwarder.hs b/trace-forward/src/Trace/Forward/Run/TraceObject/Forwarder.hs index e01bc8680db..bd460ba36c7 100644 --- a/trace-forward/src/Trace/Forward/Run/TraceObject/Forwarder.hs +++ b/trace-forward/src/Trace/Forward/Run/TraceObject/Forwarder.hs @@ -48,6 +48,5 @@ runPeerWithSink config sink = (forwarderTracer config) (Forwarder.codecTraceObjectForward CBOR.encode CBOR.decode CBOR.encode CBOR.decode) - (fromIntegral . LBS.length) channel (Forwarder.traceObjectForwarderPeer $ readFromSink sink) From b1dc13a8ae782cbe53e28347ccaaf56f39fa296d Mon Sep 17 00:00:00 2001 From: Drazen Popovic Date: Wed, 3 Dec 2025 10:27:23 +0100 Subject: [PATCH 11/16] Add ouroboros-network and ouroboros-consensus SRPs for the Leios 202511 Demo NOTE: - Tests and benchmarks fail to build, and that's ok --- cabal.project | 26 +++++++++++++++++++++----- 1 file changed, 21 insertions(+), 5 deletions(-) diff --git a/cabal.project b/cabal.project index f0fe0c83ebe..df38cebf485 100644 --- a/cabal.project +++ b/cabal.project @@ -97,14 +97,11 @@ if impl (ghc >= 9.12) constraints: hedgehog-extras == 0.7.0.0 - - - source-repository-package type: git location: https://github.com/IntersectMBO/ouroboros-consensus - tag: 045b3e39458d9ae077d3134858cedac70cfac8ba - --sha256: sha256-+M8WFkZY6qIxCUraqTc/9w+pphYqVOpnjIpXZeEZOpY= + tag: fe40068d881db59df3cb4be0cfd5a564a75bfabb + --sha256: sha256-qxj529w4d8dkpS5Kyv8aAAPu+hCQqtFvqpiJJxQ/BFE= subdir: ouroboros-consensus ouroboros-consensus-cardano @@ -112,3 +109,22 @@ source-repository-package ouroboros-consensus-diffusion sop-extras strict-sop-core + +source-repository-package + type: git + location: https://github.com/IntersectMBO/ouroboros-network.git + tag: 7e0069f85d973cfa665e1c3d0963ece269fb68e0 + --sha256: sha256-D85sAsK4Z9yyGll1rGILzuGw/xarzRDxZvOzgeHOjv4= + subdir: + cardano-ping + monoidal-synchronisation + quickcheck-monoids + network-mux + ouroboros-network + ouroboros-network-api + ouroboros-network-framework + ouroboros-network-mock + ouroboros-network-protocols + ouroboros-network-testing + ntp-client + cardano-client From 5c62bb9e4ad701c2de1ecb34815016d1765be953 Mon Sep 17 00:00:00 2001 From: Drazen Popovic Date: Wed, 3 Dec 2025 14:38:35 +0100 Subject: [PATCH 12/16] Updates ouroboros-consensus and ouroboros-network SRPs to latest in Nicks branch --- cabal.project | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/cabal.project b/cabal.project index df38cebf485..3bc1c83c3fa 100644 --- a/cabal.project +++ b/cabal.project @@ -97,11 +97,12 @@ if impl (ghc >= 9.12) constraints: hedgehog-extras == 0.7.0.0 +-- Points to ouroboros-consensus/leios-prototype source-repository-package type: git location: https://github.com/IntersectMBO/ouroboros-consensus - tag: fe40068d881db59df3cb4be0cfd5a564a75bfabb - --sha256: sha256-qxj529w4d8dkpS5Kyv8aAAPu+hCQqtFvqpiJJxQ/BFE= + tag: a2e3c598b96efa1e2add0bc7b893a7a007ace606 + --sha256: sha256-uMImzqUvdDCyuso/fN0BEJuhj1BuT8U1Gafbhz4CBRU= subdir: ouroboros-consensus ouroboros-consensus-cardano @@ -110,11 +111,12 @@ source-repository-package sop-extras strict-sop-core +-- Points to ouroboros-network/nfrisby/leios-202511-demo source-repository-package type: git location: https://github.com/IntersectMBO/ouroboros-network.git - tag: 7e0069f85d973cfa665e1c3d0963ece269fb68e0 - --sha256: sha256-D85sAsK4Z9yyGll1rGILzuGw/xarzRDxZvOzgeHOjv4= + tag: 479f0d0d82413162c8444b912394dd74c052831f + --sha256: sha256-Up+Zh3+nHuwlHmpXgH0nNIvQ/yHm/Hxb9ZYQHibrDLc= subdir: cardano-ping monoidal-synchronisation From 71c79d828acfd7362938b94c7aa1b8e64bcb83b9 Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Mon, 15 Dec 2025 12:24:51 +0100 Subject: [PATCH 13/16] Do not elide eb hash in traces --- cabal.project | 7 ++----- .../src/Cardano/Node/Tracing/Tracers/NodeToNode.hs | 5 +++-- .../src/Cardano/Tracing/OrphanInstances/Network.hs | 5 +++-- 3 files changed, 8 insertions(+), 9 deletions(-) diff --git a/cabal.project b/cabal.project index 3bc1c83c3fa..2b3d57add58 100644 --- a/cabal.project +++ b/cabal.project @@ -101,15 +101,12 @@ constraints: source-repository-package type: git location: https://github.com/IntersectMBO/ouroboros-consensus - tag: a2e3c598b96efa1e2add0bc7b893a7a007ace606 - --sha256: sha256-uMImzqUvdDCyuso/fN0BEJuhj1BuT8U1Gafbhz4CBRU= + tag: e3ffce853e85d6e5e9ff6c7c078816fea689a5b1 + --sha256: sha256-tFUNTbyhnaaNv8AFSCSs+pPhQydGgOuhfJMGv3pvE1M= subdir: ouroboros-consensus ouroboros-consensus-cardano - ouroboros-consensus-protocol ouroboros-consensus-diffusion - sop-extras - strict-sop-core -- Points to ouroboros-network/nfrisby/leios-202511-demo source-repository-package diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeToNode.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeToNode.hs index da4acd4d472..0ffd771c84f 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeToNode.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeToNode.hs @@ -37,7 +37,7 @@ import Network.TypedProtocol.Codec (AnyMessage (AnyMessageAndAgency)) import qualified Data.Bits as Bits import qualified Data.Vector as V -import LeiosDemoTypes (EbHash (..), LeiosEb, LeiosPoint (..), LeiosTx, leiosEbBytesSize, leiosTxBytesSize, prettyBitmap, prettyEbHash) +import LeiosDemoTypes (EbHash (..), LeiosEb, LeiosPoint (..), LeiosTx, leiosEbBytesSize, leiosTxBytesSize, prettyBitmap, prettyEbHash, hashLeiosEb) import qualified LeiosDemoOnlyTestFetch as LF import qualified LeiosDemoOnlyTestNotify as LN @@ -508,6 +508,7 @@ instance LogFormatting (AnyMessage (LN.LeiosNotify LeiosPoint ())) where instance LogFormatting (AnyMessage (LF.LeiosFetch LeiosPoint LeiosEb LeiosTx)) where forHuman = showT + -- FIXME: Duplicated (orphan!) instance with Cardano.Tracing.OrphanInstances.Network forMachine _dtal (AnyMessageAndAgency _stok msg) = case msg of LF.MsgLeiosBlockRequest (MkLeiosPoint ebSlot ebHash) -> @@ -518,7 +519,7 @@ instance LogFormatting (AnyMessage (LF.LeiosFetch LeiosPoint LeiosEb LeiosTx)) w LF.MsgLeiosBlock eb -> mconcat [ "kind" .= String "MsgLeiosBlock" - , "eb" .= String "" + , "eb" .= hashLeiosEb eb , "ebBytesSize" .= Number (fromIntegral $ leiosEbBytesSize eb) ] diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs index 87055bddf1d..2e5f3799ea3 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs @@ -144,7 +144,7 @@ import qualified Network.TypedProtocol.Stateful.Codec as Stateful import qualified Data.Bits as Bits import qualified Data.Vector as V -import LeiosDemoTypes (EbHash (..), LeiosEb, LeiosPoint (..), LeiosTx, leiosEbBytesSize, leiosTxBytesSize, prettyBitmap, prettyEbHash) +import LeiosDemoTypes (EbHash (..), LeiosEb, LeiosPoint (..), LeiosTx, leiosEbBytesSize, leiosTxBytesSize, prettyBitmap, prettyEbHash, hashLeiosEb) import LeiosDemoTypes (TraceLeiosKernel, TraceLeiosPeer, traceLeiosKernelToObject, traceLeiosPeerToObject) import qualified LeiosDemoOnlyTestFetch as LF import qualified LeiosDemoOnlyTestNotify as LN @@ -2924,6 +2924,7 @@ instance ToObject peer trTransformer = trStructured instance ToObject (AnyMessage (LF.LeiosFetch LeiosPoint LeiosEb LeiosTx)) where + -- FIXME: Duplicated (orphan!) instance with Cardano.Node.Tracing.Tracers.NodeToNode toObject _verb (AnyMessageAndAgency _stok msg) = case msg of LF.MsgLeiosBlockRequest (MkLeiosPoint ebSlot ebHash) -> @@ -2934,7 +2935,7 @@ instance ToObject (AnyMessage (LF.LeiosFetch LeiosPoint LeiosEb LeiosTx)) where LF.MsgLeiosBlock eb -> mconcat [ "kind" .= String "MsgLeiosBlock" - , "eb" .= String "" + , "eb" .= hashLeiosEb eb , "ebBytesSize" .= Number (fromIntegral $ leiosEbBytesSize eb) ] From b6a9eb6d692ffbfe412c0dc3377c33a08eb3c55f Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Mon, 15 Dec 2025 15:28:35 +0100 Subject: [PATCH 14/16] Upstream trace conversion into ouroboros-consensus --- cabal.project | 4 +- cardano-node/cardano-node.cabal | 1 - .../Node/Tracing/Tracers/NodeToNode.hs | 57 ++----------- .../Tracing/OrphanInstances/Network.hs | 84 +++++-------------- 4 files changed, 28 insertions(+), 118 deletions(-) diff --git a/cabal.project b/cabal.project index 2b3d57add58..191d2fd6e16 100644 --- a/cabal.project +++ b/cabal.project @@ -101,8 +101,8 @@ constraints: source-repository-package type: git location: https://github.com/IntersectMBO/ouroboros-consensus - tag: e3ffce853e85d6e5e9ff6c7c078816fea689a5b1 - --sha256: sha256-tFUNTbyhnaaNv8AFSCSs+pPhQydGgOuhfJMGv3pvE1M= + tag: ed637941fc1a252ecdf2a1b1600ef95d17b52101 + --sha256: sha256-hvK7R9f28LV9daPn7PFBJZexh2cbsZGDYEGNdvew4nw= subdir: ouroboros-consensus ouroboros-consensus-cardano diff --git a/cardano-node/cardano-node.cabal b/cardano-node/cardano-node.cabal index da31ad77524..1624a529e08 100644 --- a/cardano-node/cardano-node.cabal +++ b/cardano-node/cardano-node.cabal @@ -226,7 +226,6 @@ library , transformers-except , typed-protocols >= 0.3 , typed-protocols-stateful >= 0.3 - , vector , yaml executable cardano-node diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeToNode.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeToNode.hs index 0ffd771c84f..ccddf7ad479 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeToNode.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeToNode.hs @@ -23,23 +23,22 @@ import Ouroboros.Network.Block (Point, Serialised (..), blockHash) import Ouroboros.Network.DeltaQ (GSV (..), PeerGSV (..)) import Ouroboros.Network.KeepAlive (TraceKeepAliveClient (..)) import Ouroboros.Network.Protocol.BlockFetch.Type (BlockFetch (..), Message (..)) -import qualified Ouroboros.Network.Protocol.TxSubmission2.Type as STX import qualified Ouroboros.Network.Protocol.KeepAlive.Type as KA import qualified Ouroboros.Network.Protocol.PeerSharing.Type as PS +import qualified Ouroboros.Network.Protocol.TxSubmission2.Type as STX import Ouroboros.Network.SizeInBytes (SizeInBytes (..)) import Control.Monad.Class.MonadTime.SI (Time (..)) -import Data.Aeson (ToJSON (..), Value (Array, Number, String), (.=)) +import Data.Aeson (ToJSON (..), Value (String), (.=)) import Data.Proxy (Proxy (..)) -import Data.Time (DiffTime) import Data.Text (pack) +import Data.Time (DiffTime) import Network.TypedProtocol.Codec (AnyMessage (AnyMessageAndAgency)) -import qualified Data.Bits as Bits -import qualified Data.Vector as V -import LeiosDemoTypes (EbHash (..), LeiosEb, LeiosPoint (..), LeiosTx, leiosEbBytesSize, leiosTxBytesSize, prettyBitmap, prettyEbHash, hashLeiosEb) import qualified LeiosDemoOnlyTestFetch as LF import qualified LeiosDemoOnlyTestNotify as LN +import LeiosDemoTypes (EbHash (..), LeiosEb, LeiosPoint (..), LeiosTx, + messageLeiosFetchToObject, prettyEbHash) -------------------------------------------------------------------------------- -- BlockFetch Tracer @@ -508,50 +507,8 @@ instance LogFormatting (AnyMessage (LN.LeiosNotify LeiosPoint ())) where instance LogFormatting (AnyMessage (LF.LeiosFetch LeiosPoint LeiosEb LeiosTx)) where forHuman = showT - -- FIXME: Duplicated (orphan!) instance with Cardano.Tracing.OrphanInstances.Network - forMachine _dtal (AnyMessageAndAgency _stok msg) = case msg of - - LF.MsgLeiosBlockRequest (MkLeiosPoint ebSlot ebHash) -> - mconcat [ "kind" .= String "MsgLeiosBlockRequest" - , "ebSlot" .= ebSlot - , "ebHash" .= ebHash - ] - - LF.MsgLeiosBlock eb -> - mconcat [ "kind" .= String "MsgLeiosBlock" - , "eb" .= hashLeiosEb eb - , "ebBytesSize" .= Number (fromIntegral $ leiosEbBytesSize eb) - ] - - LF.MsgLeiosBlockTxsRequest (MkLeiosPoint ebSlot ebHash) bitmaps -> - mconcat [ "kind" .= String "MsgLeiosBlockTxsRequest" - , "ebSlot" .= ebSlot - , "ebHash" .= ebHash - , "numTxs" .= Number (fromIntegral $ sum $ map (Bits.popCount . snd) bitmaps) - , "bitmaps" .= Array (V.fromList $ map (String . pack . prettyBitmap) bitmaps) - ] - - LF.MsgLeiosBlockTxs txs -> - mconcat [ "kind" .= String "MsgLeiosBlockTxs" - , "numTxs" .= Number (fromIntegral (V.length txs)) - , "txsBytesSize" .= Number (fromIntegral $ V.sum $ V.map leiosTxBytesSize txs) - , "txs" .= String "" - ] - - -- LF.MsgLeiosVotesRequest - -- LF.MsgLeiosVoteDelivery - - -- LF.MsgLeiosBlockRangeRequest - -- LF.MsgLeiosNextBlockAndTxsInRange - -- LF.MsgLeiosLastBlockAndTxsInRange - - LF.MsgDone -> - mconcat [ "kind" .= String "MsgDone" - ] - - where --- agency :: Aeson.Object --- agency = "agency" .= show stok + forMachine _dtal (AnyMessageAndAgency _stok msg) = + messageLeiosFetchToObject msg instance MetaTrace (AnyMessage (LN.LeiosNotify LeiosPoint ())) where namespaceFor (AnyMessageAndAgency _stok msg) = case msg of diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs index 2e5f3799ea3..35b4dda95e3 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs @@ -27,20 +27,20 @@ module Cardano.Tracing.OrphanInstances.Network , FetchDecisionToJSON (..) ) where +import Cardano.Network.PeerSelection.Bootstrap (UseBootstrapPeers (..)) +import Cardano.Network.PeerSelection.PeerTrustable (PeerTrustable (..)) +import Cardano.Network.Types (LedgerStateJudgement (..)) import Cardano.Node.Queries (ConvertTxId) import Cardano.Tracing.OrphanInstances.Common import Cardano.Tracing.Render +import qualified Ouroboros.Cardano.Network.PeerSelection.Governor.PeerSelectionState as Cardano +import qualified Ouroboros.Cardano.Network.PeerSelection.Governor.Types as Cardano +import qualified Ouroboros.Cardano.Network.PublicRootPeers as Cardano.PublicRootPeers import Ouroboros.Consensus.Block (ConvertRawHash (..), Header, getHeader) import Ouroboros.Consensus.Ledger.Query (BlockQuery, Query) import Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr, GenTx, GenTxId, HasTxs (..), TxId, txId) import Ouroboros.Consensus.Node.Run (RunNode, estimateBlockSize) -import Cardano.Network.PeerSelection.Bootstrap (UseBootstrapPeers(..)) -import Cardano.Network.PeerSelection.PeerTrustable (PeerTrustable(..)) -import Cardano.Network.Types (LedgerStateJudgement(..)) -import qualified Ouroboros.Cardano.Network.PeerSelection.Governor.PeerSelectionState as Cardano -import qualified Ouroboros.Cardano.Network.PeerSelection.Governor.Types as Cardano -import qualified Ouroboros.Cardano.Network.PublicRootPeers as Cardano.PublicRootPeers import qualified Ouroboros.Network.AnchoredFragment as AF import qualified Ouroboros.Network.AnchoredSeq as AS import Ouroboros.Network.Block @@ -51,15 +51,14 @@ import Ouroboros.Network.BlockFetch.Decision (FetchDecision, FetchDecl import qualified Ouroboros.Network.BlockFetch.Decision.Trace as BlockFetch import Ouroboros.Network.ConnectionHandler (ConnectionHandlerTrace (..)) import Ouroboros.Network.ConnectionId (ConnectionId (..)) -import Ouroboros.Network.ConnectionManager.Core as ConnMgr (Trace (..)) import Ouroboros.Network.ConnectionManager.ConnMap (ConnMap (..), LocalAddr (..)) +import Ouroboros.Network.ConnectionManager.Core as ConnMgr (Trace (..)) import Ouroboros.Network.ConnectionManager.State (ConnStateId (..)) import Ouroboros.Network.ConnectionManager.Types (AbstractState (..), - ConnectionManagerCounters (..), - OperationResult (..)) + ConnectionManagerCounters (..), OperationResult (..)) import qualified Ouroboros.Network.ConnectionManager.Types as ConnMgr -import qualified Ouroboros.Network.Diffusion.Common as Diffusion import Ouroboros.Network.DeltaQ (GSV (..), PeerGSV (..)) +import qualified Ouroboros.Network.Diffusion.Common as Diffusion import Ouroboros.Network.Driver.Limits (ProtocolLimitFailure (..)) import qualified Ouroboros.Network.Driver.Stateful as Stateful import Ouroboros.Network.ExitPolicy (RepromoteDelay (..)) @@ -73,10 +72,10 @@ import qualified Ouroboros.Network.NodeToClient as NtC import Ouroboros.Network.NodeToNode (ErrorPolicyTrace (..), NodeToNodeVersion (..), NodeToNodeVersionData (..), RemoteAddress, TraceSendRecv (..), WithAddr (..)) import qualified Ouroboros.Network.NodeToNode as NtN -import Ouroboros.Network.PeerSelection.Governor (AssociationMode (..), DebugPeerSelection (..), - DebugPeerSelectionState (..), PeerSelectionCounters, PeerSelectionState (..), - PeerSelectionTargets (..), PeerSelectionView (..), TracePeerSelection (..), - peerSelectionStateToCounters) +import Ouroboros.Network.PeerSelection.Governor (AssociationMode (..), + DebugPeerSelection (..), DebugPeerSelectionState (..), PeerSelectionCounters, + PeerSelectionState (..), PeerSelectionTargets (..), PeerSelectionView (..), + TracePeerSelection (..), peerSelectionStateToCounters) import Ouroboros.Network.PeerSelection.LedgerPeers import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing (..)) import Ouroboros.Network.PeerSelection.PeerStateActions (PeerSelectionActionsTrace (..)) @@ -89,7 +88,7 @@ import Ouroboros.Network.PeerSelection.RootPeersDNS.PublicRootPeers import Ouroboros.Network.PeerSelection.State.KnownPeers (KnownPeerInfo (..)) import qualified Ouroboros.Network.PeerSelection.State.KnownPeers as KnownPeers import Ouroboros.Network.PeerSelection.State.LocalRootPeers (HotValency (..), - LocalRootPeers, WarmValency (..), LocalRootConfig (..)) + LocalRootConfig (..), LocalRootPeers, WarmValency (..)) import qualified Ouroboros.Network.PeerSelection.State.LocalRootPeers as LocalRootPeers import Ouroboros.Network.PeerSelection.Types (PeerStatus (..)) import Ouroboros.Network.Protocol.BlockFetch.Type (BlockFetch, Message (..)) @@ -140,14 +139,11 @@ import Network.Socket (SockAddr (..)) import Network.TypedProtocol.Codec (AnyMessage (AnyMessageAndAgency)) import qualified Network.TypedProtocol.Stateful.Codec as Stateful -{- HLINT ignore "Use record patterns" -} - -import qualified Data.Bits as Bits -import qualified Data.Vector as V -import LeiosDemoTypes (EbHash (..), LeiosEb, LeiosPoint (..), LeiosTx, leiosEbBytesSize, leiosTxBytesSize, prettyBitmap, prettyEbHash, hashLeiosEb) -import LeiosDemoTypes (TraceLeiosKernel, TraceLeiosPeer, traceLeiosKernelToObject, traceLeiosPeerToObject) import qualified LeiosDemoOnlyTestFetch as LF import qualified LeiosDemoOnlyTestNotify as LN +import LeiosDemoTypes (EbHash (..), LeiosEb, LeiosPoint (..), LeiosTx, TraceLeiosKernel, + TraceLeiosPeer, messageLeiosFetchToObject, prettyEbHash, + traceLeiosKernelToObject, traceLeiosPeerToObject) -- -- * instances of @HasPrivacyAnnotation@ and @HasSeverityAnnotation@ @@ -2924,50 +2920,8 @@ instance ToObject peer trTransformer = trStructured instance ToObject (AnyMessage (LF.LeiosFetch LeiosPoint LeiosEb LeiosTx)) where - -- FIXME: Duplicated (orphan!) instance with Cardano.Node.Tracing.Tracers.NodeToNode - toObject _verb (AnyMessageAndAgency _stok msg) = case msg of - - LF.MsgLeiosBlockRequest (MkLeiosPoint ebSlot ebHash) -> - mconcat [ "kind" .= String "MsgLeiosBlockRequest" - , "ebSlot" .= ebSlot - , "ebHash" .= ebHash - ] - - LF.MsgLeiosBlock eb -> - mconcat [ "kind" .= String "MsgLeiosBlock" - , "eb" .= hashLeiosEb eb - , "ebBytesSize" .= Number (fromIntegral $ leiosEbBytesSize eb) - ] - - LF.MsgLeiosBlockTxsRequest (MkLeiosPoint ebSlot ebHash) bitmaps -> - mconcat [ "kind" .= String "MsgLeiosBlockTxsRequest" - , "ebSlot" .= ebSlot - , "ebHash" .= ebHash - , "numTxs" .= Number (fromIntegral $ sum $ map (Bits.popCount . snd) bitmaps) - , "bitmaps" .= Array (V.fromList $ map (String . pack . prettyBitmap) bitmaps) - ] - - LF.MsgLeiosBlockTxs txs -> - mconcat [ "kind" .= String "MsgLeiosBlockTxs" - , "numTxs" .= Number (fromIntegral (V.length txs)) - , "txsBytesSize" .= Number (fromIntegral $ V.sum $ V.map leiosTxBytesSize txs) - , "txs" .= String "" - ] - - -- LF.MsgLeiosVotesRequest - -- LF.MsgLeiosVoteDelivery - - -- LF.MsgLeiosBlockRangeRequest - -- LF.MsgLeiosNextBlockAndTxsInRange - -- LF.MsgLeiosLastBlockAndTxsInRange - - LF.MsgDone -> - mconcat [ "kind" .= String "MsgDone" - ] - - where --- agency :: Aeson.Object --- agency = "agency" .= show stok + toObject _verb (AnyMessageAndAgency _stok msg) = + messageLeiosFetchToObject msg instance Transformable Text IO TraceLeiosKernel where trTransformer = trStructured From f0ef9b82b46908d8c3ed7d44aa407056d61cf0c0 Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Thu, 8 Jan 2026 16:29:13 +0100 Subject: [PATCH 15/16] Update ouroboros-consensus srp --- cabal.project | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cabal.project b/cabal.project index 191d2fd6e16..c71c796e058 100644 --- a/cabal.project +++ b/cabal.project @@ -101,8 +101,8 @@ constraints: source-repository-package type: git location: https://github.com/IntersectMBO/ouroboros-consensus - tag: ed637941fc1a252ecdf2a1b1600ef95d17b52101 - --sha256: sha256-hvK7R9f28LV9daPn7PFBJZexh2cbsZGDYEGNdvew4nw= + tag: cdc39a0769ff07166da95712fd7cc559b2a75da8 + --sha256: sha256-KFZsKOQv8iPSfqzZo81Zg3kSYq9MliU0GzVhK5q8Y/4= subdir: ouroboros-consensus ouroboros-consensus-cardano From 9a429a33e8a204fb99a01df5d83b528f12bf4c54 Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Wed, 21 Jan 2026 14:19:29 +0100 Subject: [PATCH 16/16] Bump ouroboros-consensus srp --- cabal.project | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cabal.project b/cabal.project index c71c796e058..b8a7399b94a 100644 --- a/cabal.project +++ b/cabal.project @@ -101,8 +101,8 @@ constraints: source-repository-package type: git location: https://github.com/IntersectMBO/ouroboros-consensus - tag: cdc39a0769ff07166da95712fd7cc559b2a75da8 - --sha256: sha256-KFZsKOQv8iPSfqzZo81Zg3kSYq9MliU0GzVhK5q8Y/4= + tag: a571776defab2aff8e1e0a9e62646494a1a8af08 + --sha256: sha256-eucib6kUGFbiIM09nNHC+XR+gUSjiAtpKxcuKO/Kl1Q= subdir: ouroboros-consensus ouroboros-consensus-cardano