From 55da8e99a48a5f44d7761605c4ef7f42c852e090 Mon Sep 17 00:00:00 2001 From: Piotr Paradzinski Date: Wed, 27 May 2026 16:27:34 +0200 Subject: [PATCH 1/3] cardano-diffusion: label ledger peer usage --- ...83_dancewithheart_ledger_peer_usage_label.md | 3 +++ .../Test/Cardano/Network/Diffusion/Testnet.hs | 17 ++++++++++++++++- 2 files changed, 19 insertions(+), 1 deletion(-) create mode 100644 cardano-diffusion/changelog.d/20260527_4683_dancewithheart_ledger_peer_usage_label.md diff --git a/cardano-diffusion/changelog.d/20260527_4683_dancewithheart_ledger_peer_usage_label.md b/cardano-diffusion/changelog.d/20260527_4683_dancewithheart_ledger_peer_usage_label.md new file mode 100644 index 0000000000..792c4c11cd --- /dev/null +++ b/cardano-diffusion/changelog.d/20260527_4683_dancewithheart_ledger_peer_usage_label.md @@ -0,0 +1,3 @@ +### Non-Breaking + +- Add a diffusion test label showing the distribution of ledger peer usage. diff --git a/cardano-diffusion/tests/lib/Test/Cardano/Network/Diffusion/Testnet.hs b/cardano-diffusion/tests/lib/Test/Cardano/Network/Diffusion/Testnet.hs index f7d0044364..734bc0c0b8 100644 --- a/cardano-diffusion/tests/lib/Test/Cardano/Network/Diffusion/Testnet.hs +++ b/cardano-diffusion/tests/lib/Test/Cardano/Network/Diffusion/Testnet.hs @@ -2092,10 +2092,25 @@ prop_peer_selection_trace_coverage defaultBearerInfo diffScript = peerSelectionTraceMap (TraceVerifyPeerSnapshot result) = "TraceVerifyPeerSnapshot " <> show result eventsSeenNames = map peerSelectionTraceMap events + ledgerPeerUsageLabels = + mapMaybe ledgerPeerUsageLabel events + + ledgerPeerUsageLabel + :: TracePeerSelection extraState extraFlags extraPeers peeraddr + -> Maybe String + ledgerPeerUsageLabel = \case + TraceBigLedgerPeersResults peers _ _ -> Just $ "TraceBigLedgerPeersResults " ++ show (Set.size peers) + TraceForgetBigLedgerPeers _ _ peers -> Just $ "TraceForgetBigLedgerPeers " ++ show (Set.size peers) + TracePromoteColdBigLedgerPeers _ _ peers -> Just $ "TracePromoteColdBigLedgerPeers " ++ show (Set.size peers) + TracePromoteWarmBigLedgerPeers _ _ peers -> Just $ "TracePromoteWarmBigLedgerPeers " ++ show (Set.size peers) + TraceDemoteWarmBigLedgerPeers _ _ peers -> Just $ "TraceDemoteWarmBigLedgerPeers " ++ show (Set.size peers) + TraceDemoteHotBigLedgerPeers _ _ peers -> Just $ "TraceDemoteHotBigLedgerPeers " ++ show (Set.size peers) + _ -> Nothing -- TODO: Add checkCoverage here in tabulate "peer selection trace" eventsSeenNames - True + $ tabulate "distribution of used ledger peers" ledgerPeerUsageLabels + True -- | A variant of -- 'Test.Ouroboros.Network.ConnectionHandler.Network.PeerSelection.prop_governor_nolivelock' From c17dc03ee7b7e56227e3f1f623b44bcb3b78eccc Mon Sep 17 00:00:00 2001 From: Piotr Paradzinski Date: Thu, 18 Jun 2026 14:11:27 +0200 Subject: [PATCH 2/3] cardano-diffusion: tabulate ledger peer result and action sizes --- .../Test/Cardano/Network/Diffusion/Testnet.hs | 90 +++++++++++++++++-- 1 file changed, 83 insertions(+), 7 deletions(-) diff --git a/cardano-diffusion/tests/lib/Test/Cardano/Network/Diffusion/Testnet.hs b/cardano-diffusion/tests/lib/Test/Cardano/Network/Diffusion/Testnet.hs index 734bc0c0b8..e15dec7190 100644 --- a/cardano-diffusion/tests/lib/Test/Cardano/Network/Diffusion/Testnet.hs +++ b/cardano-diffusion/tests/lib/Test/Cardano/Network/Diffusion/Testnet.hs @@ -2092,24 +2092,100 @@ prop_peer_selection_trace_coverage defaultBearerInfo diffScript = peerSelectionTraceMap (TraceVerifyPeerSnapshot result) = "TraceVerifyPeerSnapshot " <> show result eventsSeenNames = map peerSelectionTraceMap events - ledgerPeerUsageLabels = - mapMaybe ledgerPeerUsageLabel events - ledgerPeerUsageLabel - :: TracePeerSelection extraState extraFlags extraPeers peeraddr + (ledgerPeerResultLabels, ledgerPeerActionLabels) = ledgerPeerLabelsFromTrace events + + -- Generic peer-selection actions, such as 'TracePromoteWarmPeers', + -- only carry the selected peers. They do not say whether those peers + -- are ledger peers. + -- + -- This is a trace-derived classification: generic peer-action events are + -- classified using the ledger-peer set from the most recent debug-state + -- snapshot in the same ordered trace stream. + -- + -- The first result - ledger-peer result sizes. + -- The second result - how many ledger peers were selected by actions. + ledgerPeerLabelsFromTrace + :: [TracePeerSelection Cardano.ExtraState + PeerTrustable + (ExtraPeers NtNAddr) + NtNAddr] + -> ([String], [String]) + ledgerPeerLabelsFromTrace = + go Set.empty + where + go + :: Set NtNAddr + -- ^ Ledger peers from the most recent 'TraceDebugState'. + -> [TracePeerSelection Cardano.ExtraState + PeerTrustable + (ExtraPeers NtNAddr) + NtNAddr] + -> ([String], [String]) + go _ [] = ([], []) + go _ (TraceDebugState _ st : evs) = + let currentLedgerPeers = PublicRootPeers.getLedgerPeers (dpssPublicRootPeers st) + in go currentLedgerPeers evs + go ledgerPeers (event : evs) = + let (resultLabels, actionLabels) = go ledgerPeers evs + resultLabels' = + case ledgerPeerResultLabel event of + Nothing -> resultLabels + Just rl -> rl : resultLabels + actionLabels' = + case ledgerPeerActionLabel ledgerPeers event of + Nothing -> actionLabels + Just al -> al : actionLabels + in (resultLabels', actionLabels') + + ledgerPeerResultLabel + :: TracePeerSelection extraDebugState extraFlags extraPeers peeraddr -> Maybe String - ledgerPeerUsageLabel = \case - TraceBigLedgerPeersResults peers _ _ -> Just $ "TraceBigLedgerPeersResults " ++ show (Set.size peers) + ledgerPeerResultLabel = \case + TraceBigLedgerPeersResults peers _ _ -> + Just $ "TraceBigLedgerPeersResults " ++ show (Set.size peers) + TracePublicRootsResults publicRootPeers _ _ -> + let ledgerPeers = PublicRootPeers.getLedgerPeers publicRootPeers + in Just $ "TracePublicRootsResults ledger peers " ++ show (Set.size ledgerPeers) + _ -> Nothing + + ledgerPeerActionLabel + :: Ord peeraddr + => Set peeraddr + -> TracePeerSelection extraDebugState extraFlags extraPeers peeraddr + -> Maybe String + ledgerPeerActionLabel ledgerPeers = \case TraceForgetBigLedgerPeers _ _ peers -> Just $ "TraceForgetBigLedgerPeers " ++ show (Set.size peers) TracePromoteColdBigLedgerPeers _ _ peers -> Just $ "TracePromoteColdBigLedgerPeers " ++ show (Set.size peers) TracePromoteWarmBigLedgerPeers _ _ peers -> Just $ "TracePromoteWarmBigLedgerPeers " ++ show (Set.size peers) TraceDemoteWarmBigLedgerPeers _ _ peers -> Just $ "TraceDemoteWarmBigLedgerPeers " ++ show (Set.size peers) TraceDemoteHotBigLedgerPeers _ _ peers -> Just $ "TraceDemoteHotBigLedgerPeers " ++ show (Set.size peers) + TracePromoteColdPeers _ _ peers -> + labelLedgerPeerIntersection "TracePromoteColdPeers ledger peers" ledgerPeers peers + TracePromoteWarmPeers _ _ peers -> + labelLedgerPeerIntersection "TracePromoteWarmPeers ledger peers" ledgerPeers peers + TraceDemoteWarmPeers _ _ peers -> + labelLedgerPeerIntersection "TraceDemoteWarmPeers ledger peers" ledgerPeers peers + TraceDemoteHotPeers _ _ peers -> + labelLedgerPeerIntersection "TraceDemoteHotPeers ledger peers" ledgerPeers peers + TraceForgetColdPeers _ _ peers -> + labelLedgerPeerIntersection "TraceForgetColdPeers ledger peers" ledgerPeers peers _ -> Nothing + labelLedgerPeerIntersection + :: Ord peeraddr + => String + -> Set peeraddr + -> Set peeraddr + -> Maybe String + labelLedgerPeerIntersection name ledgerPeers peers = + let usedLedgerPeers = Set.intersection ledgerPeers peers + in Just $ name ++ " " ++ show (Set.size usedLedgerPeers) + -- TODO: Add checkCoverage here in tabulate "peer selection trace" eventsSeenNames - $ tabulate "distribution of used ledger peers" ledgerPeerUsageLabels + $ tabulate "ledger peer result sizes" ledgerPeerResultLabels + $ tabulate "ledger peers selected by actions" ledgerPeerActionLabels True -- | A variant of From 3619bdc23ad06c8bfcf51423fabc6ec2b171190a Mon Sep 17 00:00:00 2001 From: Piotr Paradzinski Date: Thu, 18 Jun 2026 23:15:22 +0200 Subject: [PATCH 3/3] cardano-diffusion: tabulate ledger peer result and action sizes - sip generic actions before TradeDebugState --- .../Test/Cardano/Network/Diffusion/Testnet.hs | 54 +++++++++---------- 1 file changed, 27 insertions(+), 27 deletions(-) diff --git a/cardano-diffusion/tests/lib/Test/Cardano/Network/Diffusion/Testnet.hs b/cardano-diffusion/tests/lib/Test/Cardano/Network/Diffusion/Testnet.hs index e15dec7190..0645296781 100644 --- a/cardano-diffusion/tests/lib/Test/Cardano/Network/Diffusion/Testnet.hs +++ b/cardano-diffusion/tests/lib/Test/Cardano/Network/Diffusion/Testnet.hs @@ -2096,15 +2096,16 @@ prop_peer_selection_trace_coverage defaultBearerInfo diffScript = (ledgerPeerResultLabels, ledgerPeerActionLabels) = ledgerPeerLabelsFromTrace events -- Generic peer-selection actions, such as 'TracePromoteWarmPeers', - -- only carry the selected peers. They do not say whether those peers + -- only carry the selected peers. They do not say whether those peers -- are ledger peers. -- -- This is a trace-derived classification: generic peer-action events are -- classified using the ledger-peer set from the most recent debug-state - -- snapshot in the same ordered trace stream. + -- snapshot in the same ordered trace stream. Before the first debug + -- snapshot, generic actions are left unclassified. -- - -- The first result - ledger-peer result sizes. - -- The second result - how many ledger peers were selected by actions. + -- The first result list reports ledger-peer result sizes. The second + -- result list reports how many ledger peers were selected by actions. ledgerPeerLabelsFromTrace :: [TracePeerSelection Cardano.ExtraState PeerTrustable @@ -2112,11 +2113,11 @@ prop_peer_selection_trace_coverage defaultBearerInfo diffScript = NtNAddr] -> ([String], [String]) ledgerPeerLabelsFromTrace = - go Set.empty + go Nothing where go - :: Set NtNAddr - -- ^ Ledger peers from the most recent 'TraceDebugState'. + :: Maybe (Set NtNAddr) + -- ^ Ledger peers from the most recent 'TraceDebugState', if any. -> [TracePeerSelection Cardano.ExtraState PeerTrustable (ExtraPeers NtNAddr) @@ -2125,15 +2126,15 @@ prop_peer_selection_trace_coverage defaultBearerInfo diffScript = go _ [] = ([], []) go _ (TraceDebugState _ st : evs) = let currentLedgerPeers = PublicRootPeers.getLedgerPeers (dpssPublicRootPeers st) - in go currentLedgerPeers evs - go ledgerPeers (event : evs) = - let (resultLabels, actionLabels) = go ledgerPeers evs + in go (Just currentLedgerPeers) evs + go mbLedgerPeers (event : evs) = + let (resultLabels, actionLabels) = go mbLedgerPeers evs resultLabels' = case ledgerPeerResultLabel event of Nothing -> resultLabels Just rl -> rl : resultLabels actionLabels' = - case ledgerPeerActionLabel ledgerPeers event of + case ledgerPeerActionLabel mbLedgerPeers event of Nothing -> actionLabels Just al -> al : actionLabels in (resultLabels', actionLabels') @@ -2150,37 +2151,36 @@ prop_peer_selection_trace_coverage defaultBearerInfo diffScript = _ -> Nothing ledgerPeerActionLabel - :: Ord peeraddr - => Set peeraddr - -> TracePeerSelection extraDebugState extraFlags extraPeers peeraddr + :: Maybe (Set NtNAddr) + -> TracePeerSelection Cardano.ExtraState PeerTrustable (ExtraPeers NtNAddr) NtNAddr -> Maybe String - ledgerPeerActionLabel ledgerPeers = \case + ledgerPeerActionLabel mbLedgerPeers = \case TraceForgetBigLedgerPeers _ _ peers -> Just $ "TraceForgetBigLedgerPeers " ++ show (Set.size peers) TracePromoteColdBigLedgerPeers _ _ peers -> Just $ "TracePromoteColdBigLedgerPeers " ++ show (Set.size peers) TracePromoteWarmBigLedgerPeers _ _ peers -> Just $ "TracePromoteWarmBigLedgerPeers " ++ show (Set.size peers) TraceDemoteWarmBigLedgerPeers _ _ peers -> Just $ "TraceDemoteWarmBigLedgerPeers " ++ show (Set.size peers) TraceDemoteHotBigLedgerPeers _ _ peers -> Just $ "TraceDemoteHotBigLedgerPeers " ++ show (Set.size peers) TracePromoteColdPeers _ _ peers -> - labelLedgerPeerIntersection "TracePromoteColdPeers ledger peers" ledgerPeers peers + labelLedgerPeerIntersection "TracePromoteColdPeers ledger peers" mbLedgerPeers peers TracePromoteWarmPeers _ _ peers -> - labelLedgerPeerIntersection "TracePromoteWarmPeers ledger peers" ledgerPeers peers + labelLedgerPeerIntersection "TracePromoteWarmPeers ledger peers" mbLedgerPeers peers TraceDemoteWarmPeers _ _ peers -> - labelLedgerPeerIntersection "TraceDemoteWarmPeers ledger peers" ledgerPeers peers + labelLedgerPeerIntersection "TraceDemoteWarmPeers ledger peers" mbLedgerPeers peers TraceDemoteHotPeers _ _ peers -> - labelLedgerPeerIntersection "TraceDemoteHotPeers ledger peers" ledgerPeers peers + labelLedgerPeerIntersection "TraceDemoteHotPeers ledger peers" mbLedgerPeers peers TraceForgetColdPeers _ _ peers -> - labelLedgerPeerIntersection "TraceForgetColdPeers ledger peers" ledgerPeers peers + labelLedgerPeerIntersection "TraceForgetColdPeers ledger peers" mbLedgerPeers peers _ -> Nothing labelLedgerPeerIntersection - :: Ord peeraddr - => String - -> Set peeraddr - -> Set peeraddr + :: String + -> Maybe (Set NtNAddr) + -> Set NtNAddr -> Maybe String - labelLedgerPeerIntersection name ledgerPeers peers = - let usedLedgerPeers = Set.intersection ledgerPeers peers - in Just $ name ++ " " ++ show (Set.size usedLedgerPeers) + labelLedgerPeerIntersection _ Nothing _ = Nothing + labelLedgerPeerIntersection name (Just ledgerPeers) peers = + let selectedLedgerPeers = Set.intersection ledgerPeers peers + in Just $ name ++ " " ++ show (Set.size selectedLedgerPeers) -- TODO: Add checkCoverage here in tabulate "peer selection trace" eventsSeenNames