Skip to content

Commit 84f760f

Browse files
nfrisbynfrisby
committed
leiosdemo202510: enable the Leios TraceSendRecv tracers, except Documentation.hs
1 parent 6119c5c commit 84f760f

File tree

7 files changed

+255
-13
lines changed

7 files changed

+255
-13
lines changed

‎cabal.project‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -103,8 +103,8 @@ constraints:
103103
source-repository-package
104104
type: git
105105
location: https://github.com/IntersectMBO/ouroboros-consensus
106-
tag: 473d06fd7bae208cc5eb9578d442d8c8fdc31b1d
107-
--sha256: sha256-9Y9CRiyMn0AWD+C4aNVMaJgrj3FDAYfCX4VrLvtoMaI=
106+
tag: 68f15b6aae8a7b5b2573abaeb4bb136eb9ec11ab
107+
--sha256: sha256-ZJ1gSGfHzs/jBflZksVG/8dHRd3Fr7QQcvxtu0IpxHU=
108108
subdir:
109109
ouroboros-consensus
110110
ouroboros-consensus-cardano

‎cardano-node/cardano-node.cabal‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -226,6 +226,7 @@ library
226226
, transformers-except
227227
, typed-protocols >= 0.3
228228
, typed-protocols-stateful >= 0.3
229+
, vector
229230
, yaml
230231

231232
executable cardano-node

‎cardano-node/src/Cardano/Node/Tracing/Consistency.hs‎

Lines changed: 17 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -101,6 +101,9 @@ import qualified Data.Text as T
101101
import qualified Network.Mux as Mux
102102
import qualified Network.Socket as Socket
103103

104+
import LeiosDemoTypes (LeiosPoint, LeiosEb, LeiosTx)
105+
import LeiosDemoOnlyTestFetch (LeiosFetch)
106+
import LeiosDemoOnlyTestNotify (LeiosNotify)
104107

105108
-- | Check the configuration in the given file.
106109
-- If there is no configuration in the file check the standard configuration
@@ -263,6 +266,18 @@ getAllNamespaces =
263266
(TraceSendRecv
264267
(TxSubmission2 (GenTxId blk) (GenTx blk))))])
265268

269+
leiosNotifyNS = map (nsGetTuple . nsReplacePrefix ["LeiosNotify", "Remote"])
270+
(allNamespaces :: [Namespace
271+
(BlockFetch.TraceLabelPeer peer
272+
(TraceSendRecv
273+
(LeiosNotify LeiosPoint ())))])
274+
275+
leiosFetchNS = map (nsGetTuple . nsReplacePrefix ["LeiosFetch", "Remote"])
276+
(allNamespaces :: [Namespace
277+
(BlockFetch.TraceLabelPeer peer
278+
(TraceSendRecv
279+
(LeiosFetch LeiosPoint LeiosEb LeiosTx)))])
280+
266281
-- Diffusion
267282

268283
dtMuxNS = map (nsGetTuple . nsReplacePrefix ["Net", "Mux", "Remote"])
@@ -432,6 +447,8 @@ getAllNamespaces =
432447
<> blockFetchNS
433448
<> blockFetchSerialisedNS
434449
<> txSubmission2NS
450+
<> leiosNotifyNS
451+
<> leiosFetchNS
435452
-- Diffusion
436453
<> dtMuxNS
437454
<> dtLocalMuxNS

‎cardano-node/src/Cardano/Node/Tracing/Tracers.hs‎

Lines changed: 12 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -68,7 +68,7 @@ import Ouroboros.Network.NodeToNode (RemoteAddress)
6868

6969
import Codec.CBOR.Read (DeserialiseFailure)
7070
import Control.Monad (unless)
71-
import "contra-tracer" Control.Tracer (Tracer (..), nullTracer)
71+
import "contra-tracer" Control.Tracer (Tracer (..))
7272
import Data.Proxy (Proxy (..))
7373
import Network.Mux.Trace (TraceLabelPeer (..))
7474
import Network.Socket (SockAddr)
@@ -501,12 +501,17 @@ mkNodeToNodeTracers configReflection trBase trForward mbTrEKG _trDataPoint trCon
501501
trBase trForward mbTrEKG
502502
["PeerSharing", "Remote"]
503503
configureTracers configReflection trConfig [peerSharingTracer]
504-
{-
504+
505505
!leiosNotifyTracer <- mkCardanoTracer
506506
trBase trForward mbTrEKG
507507
["LeiosNotify", "Remote"]
508508
configureTracers configReflection trConfig [leiosNotifyTracer]
509-
-}
509+
510+
!leiosFetchTracer <- mkCardanoTracer
511+
trBase trForward mbTrEKG
512+
["LeiosFetch", "Remote"]
513+
configureTracers configReflection trConfig [leiosFetchTracer]
514+
510515
pure $ NtN.Tracers
511516
{ NtN.tChainSyncTracer = Tracer $
512517
traceWith chainSyncTracer
@@ -522,9 +527,10 @@ mkNodeToNodeTracers configReflection trBase trForward mbTrEKG _trDataPoint trCon
522527
traceWith keepAliveTracer
523528
, NtN.tPeerSharingTracer = Tracer $
524529
traceWith peerSharingTracer
525-
, NtN.tLeiosNotifyTracer = nullTracer {- Tracer $
526-
traceWith leiosNotifyTracer -}
527-
, NtN.tLeiosFetchTracer = nullTracer
530+
, NtN.tLeiosNotifyTracer = Tracer $
531+
traceWith leiosNotifyTracer
532+
, NtN.tLeiosFetchTracer = Tracer $
533+
traceWith leiosFetchTracer
528534
}
529535

530536
mkDiffusionTracers

‎cardano-node/src/Cardano/Node/Tracing/Tracers/NodeToNode.hs‎

Lines changed: 126 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -29,12 +29,18 @@ import qualified Ouroboros.Network.Protocol.PeerSharing.Type as PS
2929
import Ouroboros.Network.SizeInBytes (SizeInBytes (..))
3030

3131
import Control.Monad.Class.MonadTime.SI (Time (..))
32-
import Data.Aeson (ToJSON (..), Value (String), (.=))
32+
import Data.Aeson (ToJSON (..), Value (Array, Number, String), (.=))
3333
import Data.Proxy (Proxy (..))
3434
import Data.Time (DiffTime)
3535
import Data.Text (pack)
3636
import Network.TypedProtocol.Codec (AnyMessage (AnyMessageAndAgency))
3737

38+
import qualified Data.Bits as Bits
39+
import qualified Data.Vector as V
40+
import LeiosDemoTypes (EbHash (..), LeiosEb, LeiosPoint (..), LeiosTx, leiosEbBytesSize, leiosTxBytesSize, prettyBitmap, prettyEbHash)
41+
import qualified LeiosDemoOnlyTestFetch as LF
42+
import qualified LeiosDemoOnlyTestNotify as LN
43+
3844
--------------------------------------------------------------------------------
3945
-- BlockFetch Tracer
4046
--------------------------------------------------------------------------------
@@ -466,3 +472,122 @@ instance MetaTrace (TraceKeepAliveClient remotePeer) where
466472
documentFor _ = Just ""
467473

468474
allNamespaces = [Namespace [] ["KeepAliveClient"]]
475+
476+
-----
477+
478+
instance ToJSON EbHash where toJSON = toJSON . prettyEbHash
479+
480+
instance LogFormatting (AnyMessage (LN.LeiosNotify LeiosPoint ())) where
481+
forHuman = showT
482+
483+
forMachine _dtal (AnyMessageAndAgency _stok msg) = case msg of
484+
485+
LN.MsgLeiosNotificationRequestNext ->
486+
mconcat [ "kind" .= String "MsgLeiosNotificationRequestNext"
487+
]
488+
489+
LN.MsgLeiosBlockAnnouncement () ->
490+
mconcat [ "kind" .= String "MsgLeiosBlockAnnouncement"
491+
]
492+
LN.MsgLeiosBlockOffer (MkLeiosPoint ebSlot ebHash) ebBytesSize ->
493+
mconcat [ "kind" .= String "MsgLeiosBlockOffer"
494+
, "ebSlot" .= ebSlot
495+
, "ebHash" .= ebHash
496+
, "ebBytesSize" .= ebBytesSize
497+
]
498+
LN.MsgLeiosBlockTxsOffer (MkLeiosPoint ebSlot ebHash) ->
499+
mconcat [ "kind" .= String "MsgLeiosBlockTxsOffer"
500+
, "ebSlot" .= ebSlot
501+
, "ebHash" .= ebHash
502+
]
503+
504+
LN.MsgDone ->
505+
mconcat [ "kind" .= String "MsgDone"
506+
]
507+
508+
instance LogFormatting (AnyMessage (LF.LeiosFetch LeiosPoint LeiosEb LeiosTx)) where
509+
forHuman = showT
510+
511+
forMachine _dtal (AnyMessageAndAgency _stok msg) = case msg of
512+
513+
LF.MsgLeiosBlockRequest (MkLeiosPoint ebSlot ebHash) ->
514+
mconcat [ "kind" .= String "MsgLeiosBlockRequest"
515+
, "ebSlot" .= ebSlot
516+
, "ebHash" .= ebHash
517+
]
518+
519+
LF.MsgLeiosBlock eb ->
520+
mconcat [ "kind" .= String "MsgLeiosBlock"
521+
, "eb" .= String "<elided>"
522+
, "ebBytesSize" .= Number (fromIntegral $ leiosEbBytesSize eb)
523+
]
524+
525+
LF.MsgLeiosBlockTxsRequest (MkLeiosPoint ebSlot ebHash) bitmaps ->
526+
mconcat [ "kind" .= String "MsgLeiosBlockTxsRequest"
527+
, "ebSlot" .= ebSlot
528+
, "ebHash" .= ebHash
529+
, "numTxs" .= Number (fromIntegral $ sum $ map (Bits.popCount . snd) bitmaps)
530+
, "bitmaps" .= Array (V.fromList $ map (String . pack . prettyBitmap) bitmaps)
531+
]
532+
533+
LF.MsgLeiosBlockTxs txs ->
534+
mconcat [ "kind" .= String "MsgLeiosBlockTxs"
535+
, "numTxs" .= Number (fromIntegral (V.length txs))
536+
, "txsBytesSize" .= Number (fromIntegral $ V.sum $ V.map leiosTxBytesSize txs)
537+
, "txs" .= String "<elided>"
538+
]
539+
540+
-- LF.MsgLeiosVotesRequest
541+
-- LF.MsgLeiosVoteDelivery
542+
543+
-- LF.MsgLeiosBlockRangeRequest
544+
-- LF.MsgLeiosNextBlockAndTxsInRange
545+
-- LF.MsgLeiosLastBlockAndTxsInRange
546+
547+
LF.MsgDone ->
548+
mconcat [ "kind" .= String "MsgDone"
549+
]
550+
551+
where
552+
-- agency :: Aeson.Object
553+
-- agency = "agency" .= show stok
554+
555+
instance MetaTrace (AnyMessage (LN.LeiosNotify LeiosPoint ())) where
556+
namespaceFor (AnyMessageAndAgency _stok msg) = case msg of
557+
LN.MsgLeiosNotificationRequestNext {} -> Namespace [] ["RequestNext"]
558+
LN.MsgLeiosBlockAnnouncement {} -> Namespace [] ["BlockAnnouncement"]
559+
LN.MsgLeiosBlockOffer {} -> Namespace [] ["BlockOffer"]
560+
LN.MsgLeiosBlockTxsOffer {} -> Namespace [] ["BlockTxsOffer"]
561+
LN.MsgDone -> Namespace [] ["Done"]
562+
563+
severityFor _ _ = Just Debug
564+
565+
documentFor _ = Nothing
566+
567+
allNamespaces = [
568+
Namespace [] ["RequestNext"]
569+
, Namespace [] ["BlockAnnouncement"]
570+
, Namespace [] ["BlockOffer"]
571+
, Namespace [] ["BlockTxsOffer"]
572+
, Namespace [] ["Done"]
573+
]
574+
575+
instance MetaTrace (AnyMessage (LF.LeiosFetch LeiosPoint LeiosEb LeiosTx)) where
576+
namespaceFor (AnyMessageAndAgency _stok msg) = case msg of
577+
LF.MsgLeiosBlockRequest {} -> Namespace [] ["BlockRequest"]
578+
LF.MsgLeiosBlock {} -> Namespace [] ["Block"]
579+
LF.MsgLeiosBlockTxsRequest {} -> Namespace [] ["BlockTxsRequest"]
580+
LF.MsgLeiosBlockTxs {} -> Namespace [] ["BlockTxs"]
581+
LF.MsgDone -> Namespace [] ["Done"]
582+
583+
severityFor _ _ = Just Debug
584+
585+
documentFor _ = Nothing
586+
587+
allNamespaces = [
588+
Namespace [] ["BlockRequest"]
589+
, Namespace [] ["Block"]
590+
, Namespace [] ["BlockTxsRequest"]
591+
, Namespace [] ["BlockTxs"]
592+
, Namespace [] ["Done"]
593+
]

‎cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs‎

Lines changed: 93 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -142,6 +142,12 @@ import qualified Network.TypedProtocol.Stateful.Codec as Stateful
142142

143143
{- HLINT ignore "Use record patterns" -}
144144

145+
import qualified Data.Bits as Bits
146+
import qualified Data.Vector as V
147+
import LeiosDemoTypes (EbHash (..), LeiosEb, LeiosPoint (..), LeiosTx, leiosEbBytesSize, leiosTxBytesSize, prettyBitmap, prettyEbHash)
148+
import qualified LeiosDemoOnlyTestFetch as LF
149+
import qualified LeiosDemoOnlyTestNotify as LN
150+
145151
--
146152
-- * instances of @HasPrivacyAnnotation@ and @HasSeverityAnnotation@
147153
--
@@ -2871,3 +2877,90 @@ instance FromJSON PeerTrustable where
28712877
instance ToJSON PeerTrustable where
28722878
toJSON IsTrustable = Bool True
28732879
toJSON IsNotTrustable = Bool False
2880+
2881+
-----
2882+
2883+
instance ToJSON EbHash where toJSON = toJSON . prettyEbHash
2884+
2885+
instance ToObject peer
2886+
=> Transformable Text IO (TraceLabelPeer peer (NtN.TraceSendRecv (LN.LeiosNotify LeiosPoint ()))) where
2887+
trTransformer = trStructured
2888+
2889+
instance ToObject (AnyMessage (LN.LeiosNotify LeiosPoint ())) where
2890+
toObject _verb (AnyMessageAndAgency _stok msg) = case msg of
2891+
2892+
LN.MsgLeiosNotificationRequestNext ->
2893+
mconcat [ "kind" .= String "MsgLeiosNotificationRequestNext"
2894+
]
2895+
2896+
LN.MsgLeiosBlockAnnouncement () ->
2897+
mconcat [ "kind" .= String "MsgLeiosBlockAnnouncement"
2898+
]
2899+
LN.MsgLeiosBlockOffer (MkLeiosPoint ebSlot ebHash) ebBytesSize ->
2900+
mconcat [ "kind" .= String "MsgLeiosBlockOffer"
2901+
, "ebSlot" .= ebSlot
2902+
, "ebHash" .= ebHash
2903+
, "ebBytesSize" .= ebBytesSize
2904+
]
2905+
LN.MsgLeiosBlockTxsOffer (MkLeiosPoint ebSlot ebHash) ->
2906+
mconcat [ "kind" .= String "MsgLeiosBlockTxsOffer"
2907+
, "ebSlot" .= ebSlot
2908+
, "ebHash" .= ebHash
2909+
]
2910+
2911+
LN.MsgDone ->
2912+
mconcat [ "kind" .= String "MsgDone"
2913+
]
2914+
2915+
-- where
2916+
-- agency :: Aeson.Object
2917+
-- agency = "agency" .= show stok
2918+
2919+
instance ToObject peer
2920+
=> Transformable Text IO (TraceLabelPeer peer (NtN.TraceSendRecv (LF.LeiosFetch LeiosPoint LeiosEb LeiosTx))) where
2921+
trTransformer = trStructured
2922+
2923+
instance ToObject (AnyMessage (LF.LeiosFetch LeiosPoint LeiosEb LeiosTx)) where
2924+
toObject _verb (AnyMessageAndAgency _stok msg) = case msg of
2925+
2926+
LF.MsgLeiosBlockRequest (MkLeiosPoint ebSlot ebHash) ->
2927+
mconcat [ "kind" .= String "MsgLeiosBlockRequest"
2928+
, "ebSlot" .= ebSlot
2929+
, "ebHash" .= ebHash
2930+
]
2931+
2932+
LF.MsgLeiosBlock eb ->
2933+
mconcat [ "kind" .= String "MsgLeiosBlock"
2934+
, "eb" .= String "<elided>"
2935+
, "ebBytesSize" .= Number (fromIntegral $ leiosEbBytesSize eb)
2936+
]
2937+
2938+
LF.MsgLeiosBlockTxsRequest (MkLeiosPoint ebSlot ebHash) bitmaps ->
2939+
mconcat [ "kind" .= String "MsgLeiosBlockTxsRequest"
2940+
, "ebSlot" .= ebSlot
2941+
, "ebHash" .= ebHash
2942+
, "numTxs" .= Number (fromIntegral $ sum $ map (Bits.popCount . snd) bitmaps)
2943+
, "bitmaps" .= Array (V.fromList $ map (String . pack . prettyBitmap) bitmaps)
2944+
]
2945+
2946+
LF.MsgLeiosBlockTxs txs ->
2947+
mconcat [ "kind" .= String "MsgLeiosBlockTxs"
2948+
, "numTxs" .= Number (fromIntegral (V.length txs))
2949+
, "txsBytesSize" .= Number (fromIntegral $ V.sum $ V.map leiosTxBytesSize txs)
2950+
, "txs" .= String "<elided>"
2951+
]
2952+
2953+
-- LF.MsgLeiosVotesRequest
2954+
-- LF.MsgLeiosVoteDelivery
2955+
2956+
-- LF.MsgLeiosBlockRangeRequest
2957+
-- LF.MsgLeiosNextBlockAndTxsInRange
2958+
-- LF.MsgLeiosLastBlockAndTxsInRange
2959+
2960+
LF.MsgDone ->
2961+
mconcat [ "kind" .= String "MsgDone"
2962+
]
2963+
2964+
where
2965+
-- agency :: Aeson.Object
2966+
-- agency = "agency" .= show stok

‎cardano-node/src/Cardano/Tracing/Tracers.hs‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -1515,12 +1515,12 @@ nodeToNodeTracers' trSel verb tr =
15151515
, NodeToNode.tPeerSharingTracer =
15161516
tracerOnOff (tracePeerSharingProtocol trSel)
15171517
verb "PeerSharingPrototocol" tr
1518-
, NodeToNode.tLeiosNotifyTracer = nullTracer {- TODO
1518+
, NodeToNode.tLeiosNotifyTracer =
15191519
tracerOnOff (traceLeiosNotifyProtocol trSel)
1520-
verb "LeiosNotifyPrototocol" tr -}
1521-
, NodeToNode.tLeiosFetchTracer = nullTracer {- TODO
1520+
verb "LeiosNotifyPrototocol" tr
1521+
, NodeToNode.tLeiosFetchTracer =
15221522
tracerOnOff (traceLeiosFetchProtocol trSel)
1523-
verb "LeiosFetchPrototocol" tr -}
1523+
verb "LeiosFetchPrototocol" tr
15241524
}
15251525

15261526
-- TODO @ouroboros-network

0 commit comments

Comments
 (0)