From 678ac673f13cd0b9b3bbe0b26092bcb047e1bf23 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marcin=20W=C3=B3jtowicz?= Date: Wed, 8 Oct 2025 20:52:36 +0200 Subject: [PATCH 01/12] peer-selection: bugfix established and active demotion Changes address the issue of peer selection not taking the opportunity to demote peers, or demoting too many under specific conditions. --- .../PeerSelection/Governor/ActivePeers.hs | 30 +++++++----- .../Governor/EstablishedPeers.hs | 49 ++++++++++--------- .../Network/PeerSelection/Governor/Types.hs | 2 + 3 files changed, 46 insertions(+), 35 deletions(-) diff --git a/ouroboros-network/lib/Ouroboros/Network/PeerSelection/Governor/ActivePeers.hs b/ouroboros-network/lib/Ouroboros/Network/PeerSelection/Governor/ActivePeers.hs index e68f397bbb0..115edb5098d 100644 --- a/ouroboros-network/lib/Ouroboros/Network/PeerSelection/Governor/ActivePeers.hs +++ b/ouroboros-network/lib/Ouroboros/Network/PeerSelection/Governor/ActivePeers.hs @@ -686,11 +686,17 @@ aboveTargetBigLedgerPeers actions@PeerSelectionActions { } -- Are we above the general target for number of active peers? | numActiveBigLedgerPeers > targetNumberOfActiveBigLedgerPeers - - -- Would we demote any if we could? - , let numPeersToDemote = numActiveBigLedgerPeers + , let activeBigLedger = activePeers + `Set.intersection` bigLedgerPeersSet + -- Would we demote any if we could? + numPeersToDemote = numActiveBigLedgerPeers - targetNumberOfActiveBigLedgerPeers - numDemoteInProgressBigLedgerPeers + -- don't drop too many and don't fail to take an opportunity + -- if there are warm peers which are async demoted + - Set.size (Set.intersection + inProgressDemoteToCold + activeBigLedger) , numPeersToDemote > 0 -- Are there any hot peers we actually can pick to demote? @@ -698,8 +704,7 @@ aboveTargetBigLedgerPeers actions@PeerSelectionActions { -- TODO: review this decision. If we want to be able to demote local root -- peers, e.g. for churn and improved selection, then we'll need an extra -- mechanism to avoid promotion/demotion loops for local peers. - , let availableToDemote = activePeers - `Set.intersection` bigLedgerPeersSet + , let availableToDemote = activeBigLedger Set.\\ inProgressDemoteHot Set.\\ inProgressDemoteToCold Set.\\ LocalRootPeers.keysSet localRootPeers @@ -890,12 +895,16 @@ aboveTargetOther actions@PeerSelectionActions { } -- Are we above the general target for number of active peers? | numActivePeers > targetNumberOfActivePeers - - -- Would we demote any if we could? - , let numPeersToDemote = numActivePeers + , let activeNonBig = activePeers Set.\\ bigLedgerPeersSet + -- Would we demote any if we could? + numPeersToDemote = numActivePeers - targetNumberOfActivePeers - numDemoteInProgress - - (Set.size inProgressDemoteToCold) + -- don't drop too many and don't fail to take an opportunity + -- if there are warm peers which are async demoted + - Set.size (Set.intersection + inProgressDemoteToCold + activeNonBig) , numPeersToDemote > 0 -- Are there any hot peers we actually can pick to demote? @@ -903,10 +912,9 @@ aboveTargetOther actions@PeerSelectionActions { -- TODO: review this decision. If we want to be able to demote local root -- peers, e.g. for churn and improved selection, then we'll need an extra -- mechanism to avoid promotion/demotion loops for local peers. - , let availableToDemote = activePeers + , let availableToDemote = activeNonBig Set.\\ inProgressDemoteHot Set.\\ LocalRootPeers.keysSet localRootPeers - Set.\\ bigLedgerPeersSet Set.\\ inProgressDemoteToCold , not (Set.null availableToDemote) = Guarded Nothing $ do diff --git a/ouroboros-network/lib/Ouroboros/Network/PeerSelection/Governor/EstablishedPeers.hs b/ouroboros-network/lib/Ouroboros/Network/PeerSelection/Governor/EstablishedPeers.hs index a457c429335..20aa2af84ea 100644 --- a/ouroboros-network/lib/Ouroboros/Network/PeerSelection/Governor/EstablishedPeers.hs +++ b/ouroboros-network/lib/Ouroboros/Network/PeerSelection/Governor/EstablishedPeers.hs @@ -698,20 +698,21 @@ aboveTargetOther actions@PeerSelectionActions { -- Or more precisely, how many established peers could we demote? -- We only want to pick established peers that are not active, since for -- active one we need to demote them first. - | let peerSelectionView = peerSelectionStateToView extraPeersToSet extraStateToExtraCounters st - PeerSelectionView { + | let peerSelectionView@PeerSelectionView { viewKnownBigLedgerPeers = (bigLedgerPeersSet, _), - viewEstablishedPeers = (_, numEstablishedPeers), + viewEstablishedPeers = (establishedPeersSet, numEstablishedPeers), viewActivePeers = (_, numActivePeers) } - = - peerSelectionView + = peerSelectionStateToView extraPeersToSet extraStateToExtraCounters st PeerSelectionCountersHWC { numberOfWarmLocalRootPeers = numLocalWarmPeers } = snd <$> peerSelectionView - + warmPeers = + establishedPeersSet + Set.\\ activePeers + Set.\\ LocalRootPeers.keysSet localRootPeers -- One constraint on how many to demote is the difference in the -- number we have now vs the target. The other constraint is that -- we pick established peers that are not also active. These @@ -725,16 +726,14 @@ aboveTargetOther actions@PeerSelectionActions { - numActivePeers) - Set.size (inProgressDemoteWarm Set.\\ bigLedgerPeersSet) - Set.size (inProgressPromoteWarm Set.\\ bigLedgerPeersSet) + - Set.size (Set.intersection warmPeers inProgressDemoteToCold) + , numPeersToDemote > 0 - availableToDemote :: Set peeraddr - availableToDemote = EstablishedPeers.toSet establishedPeers - Set.\\ activePeers - Set.\\ LocalRootPeers.keysSet localRootPeers - Set.\\ bigLedgerPeersSet + , let availableToDemote :: Set peeraddr + availableToDemote = warmPeers Set.\\ inProgressDemoteWarm Set.\\ inProgressPromoteWarm Set.\\ inProgressDemoteToCold - , numPeersToDemote > 0 , not (Set.null availableToDemote) = Guarded Nothing $ do selectedToDemote <- pickPeers memberExtraPeers st @@ -814,6 +813,9 @@ aboveTargetBigLedgerPeers actions@PeerSelectionActions { -- We only want to pick established peers that are not active, since for -- active one we need to demote them first. | let bigLedgerPeersSet = PublicRootPeers.getBigLedgerPeers publicRootPeers + warmBigLedgerPeers = EstablishedPeers.toSet establishedPeers + `Set.intersection` bigLedgerPeersSet + Set.\\ activePeers PeerSelectionCounters { numberOfEstablishedBigLedgerPeers = numEstablishedBigLedgerPeers, numberOfActiveBigLedgerPeers = numActiveBigLedgerPeers @@ -822,28 +824,27 @@ aboveTargetBigLedgerPeers actions@PeerSelectionActions { peerSelectionStateToCounters extraPeersToSet extraStateToExtraCounters st -- We want to demote big ledger peers towards the target but we avoid to - -- pick active peer. The `min` is taken so that `pickPeers` is given + -- pick active peer. We also want to subtract the number of warm big ledger + -- peers being async demoted to cold so as to not demote too many. + -- The `min` is taken so that `pickPeers` is given -- consistent number of peers with the set of peers available to demote, -- i.e. `availableToDemote`. - numBigLedgerPeersToDemote = min ( numEstablishedBigLedgerPeers - - targetNumberOfEstablishedBigLedgerPeers) - ( numEstablishedBigLedgerPeers - - numActiveBigLedgerPeers) - - Set.size inProgressDemoteWarm - - Set.size inProgressPromoteWarm + numBigLedgerPeersToDemote = + min (numEstablishedBigLedgerPeers - targetNumberOfEstablishedBigLedgerPeers) + (numEstablishedBigLedgerPeers - numActiveBigLedgerPeers) + - Set.size inProgressDemoteWarm + - Set.size inProgressPromoteWarm + - Set.size (Set.intersection warmBigLedgerPeers inProgressDemoteToCold) availableToDemote :: Set peeraddr - availableToDemote = EstablishedPeers.toSet establishedPeers - `Set.intersection` bigLedgerPeersSet - Set.\\ activePeers + availableToDemote = warmBigLedgerPeers Set.\\ inProgressDemoteWarm Set.\\ inProgressPromoteWarm Set.\\ inProgressDemoteToCold , numBigLedgerPeersToDemote > 0 - , not (Set.null availableToDemote) + , assert (not $ Set.null availableToDemote) not (Set.null availableToDemote) = Guarded Nothing $ do - selectedToDemote <- pickPeers memberExtraPeers st policyPickWarmPeersToDemote availableToDemote diff --git a/ouroboros-network/lib/Ouroboros/Network/PeerSelection/Governor/Types.hs b/ouroboros-network/lib/Ouroboros/Network/PeerSelection/Governor/Types.hs index f220dddaf77..30edf06971c 100644 --- a/ouroboros-network/lib/Ouroboros/Network/PeerSelection/Governor/Types.hs +++ b/ouroboros-network/lib/Ouroboros/Network/PeerSelection/Governor/Types.hs @@ -1179,6 +1179,8 @@ peerSelectionStateToView inProgressDemoteHot } = + -- TODO: investigate whether the demotion sets can include the async demotions + -- as well PeerSelectionView { viewRootPeers = size rootPeersSet, From e956bb80a4298c29abb6bc5c3831d6c27f5f4e08 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marcin=20W=C3=B3jtowicz?= Date: Thu, 16 Oct 2025 14:48:00 +0200 Subject: [PATCH 02/12] peer-selection: bugfix EstablishedPeers.belowTargetLocal The patch addresses an issue where a promotion opportunity may be missed. --- .../PeerSelection/Governor/EstablishedPeers.hs | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/ouroboros-network/lib/Ouroboros/Network/PeerSelection/Governor/EstablishedPeers.hs b/ouroboros-network/lib/Ouroboros/Network/PeerSelection/Governor/EstablishedPeers.hs index 20aa2af84ea..7e4300e2d0d 100644 --- a/ouroboros-network/lib/Ouroboros/Network/PeerSelection/Governor/EstablishedPeers.hs +++ b/ouroboros-network/lib/Ouroboros/Network/PeerSelection/Governor/EstablishedPeers.hs @@ -134,7 +134,6 @@ belowTargetLocal actions@PeerSelectionActions { st@PeerSelectionState { localRootPeers, knownPeers, - establishedPeers, inProgressPromoteCold, inProgressDemoteToCold } @@ -159,7 +158,8 @@ belowTargetLocal actions@PeerSelectionActions { , let membersAvailableToPromote = Set.intersection members availableToPromote numMembersToPromote = warmTarget - Set.size membersEstablished - - numLocalConnectInProgress + - Set.size (Set.intersection + localConnectInProgress members) , not (Set.null membersAvailableToPromote) , numMembersToPromote > 0 ] @@ -199,7 +199,7 @@ belowTargetLocal actions@PeerSelectionActions { Set.\\ localEstablishedPeers Set.\\ KnownPeers.availableToConnect knownPeers , not (Set.null potentialToPromote) - = GuardedSkip (KnownPeers.minConnectTime knownPeers (`Set.notMember` bigLedgerPeersSet)) + = GuardedSkip (KnownPeers.minConnectTime knownPeers (`Set.notMember` minConnectExcludeSet)) | otherwise = GuardedSkip Nothing @@ -207,16 +207,20 @@ belowTargetLocal actions@PeerSelectionActions { groupsBelowTarget = [ (warmValency, members, membersEstablished) | (_, warmValency, members) <- LocalRootPeers.toGroupSets localRootPeers - , let membersEstablished = members `Set.intersection` EstablishedPeers.toSet establishedPeers + , let membersEstablished = members `Set.intersection` establishedPeers , Set.size membersEstablished < getWarmValency warmValency ] + minConnectExcludeSet = + bigLedgerPeersSet `Set.union` Set.difference establishedPeers localEstablishedPeers + PeerSelectionView { viewKnownBigLedgerPeers = (bigLedgerPeersSet, _), viewKnownLocalRootPeers = (localRootPeersSet, _), + viewEstablishedPeers = (establishedPeers, _), viewEstablishedLocalRootPeers = (localEstablishedPeers, _), viewAvailableToConnectLocalRootPeers = (localAvailableToConnect, _), - viewColdLocalRootPeersPromotions = (localConnectInProgress, numLocalConnectInProgress) + viewColdLocalRootPeersPromotions = (localConnectInProgress, _) } = peerSelectionStateToView extraPeersToSet extraStateToExtraCounters st From 4150a2e49696f54608f22a0b3b270b458a6b4c46 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marcin=20W=C3=B3jtowicz?= Date: Thu, 16 Oct 2025 15:14:04 +0200 Subject: [PATCH 03/12] peer-selection: bugfix ActivePeers.belowTargetLocal The patch addresses an issue where a promotion opportunity may be missed. --- .../Ouroboros/Network/PeerSelection/Governor/ActivePeers.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/ouroboros-network/lib/Ouroboros/Network/PeerSelection/Governor/ActivePeers.hs b/ouroboros-network/lib/Ouroboros/Network/PeerSelection/Governor/ActivePeers.hs index 115edb5098d..831a70f7189 100644 --- a/ouroboros-network/lib/Ouroboros/Network/PeerSelection/Governor/ActivePeers.hs +++ b/ouroboros-network/lib/Ouroboros/Network/PeerSelection/Governor/ActivePeers.hs @@ -259,11 +259,12 @@ belowTargetLocal actions@PeerSelectionActions { Set.\\ inProgressPromoteWarm Set.\\ inProgressDemoteWarm Set.\\ inProgressDemoteToCold - numPromoteInProgress = Set.size inProgressPromoteWarm , not (Set.null availableToPromote) , (HotValency hotTarget, members, membersActive) <- groupsBelowTarget , let membersAvailableToPromote = Set.intersection members availableToPromote + numPromoteInProgress = Set.size (Set.intersection + inProgressPromoteWarm members) numMembersToPromote = hotTarget - Set.size membersActive - numPromoteInProgress From e9ca2ab7424e0049c188640f85febafb8eb3a487 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marcin=20W=C3=B3jtowicz?= Date: Fri, 17 Oct 2025 12:14:29 +0200 Subject: [PATCH 04/12] peer-selection: bugfix EstablishedPeers.belowTargetOther Don't promote local root peers here, there is `belowTargetLocal` for that which properly accounts for valencies from topology file. --- .../Governor/EstablishedPeers.hs | 48 ++++++++----------- 1 file changed, 19 insertions(+), 29 deletions(-) diff --git a/ouroboros-network/lib/Ouroboros/Network/PeerSelection/Governor/EstablishedPeers.hs b/ouroboros-network/lib/Ouroboros/Network/PeerSelection/Governor/EstablishedPeers.hs index 7e4300e2d0d..42d88838886 100644 --- a/ouroboros-network/lib/Ouroboros/Network/PeerSelection/Governor/EstablishedPeers.hs +++ b/ouroboros-network/lib/Ouroboros/Network/PeerSelection/Governor/EstablishedPeers.hs @@ -261,37 +261,14 @@ belowTargetOther actions@PeerSelectionActions { } st@PeerSelectionState { knownPeers, - establishedPeers, inProgressPromoteCold, targets = PeerSelectionTargets { targetNumberOfEstablishedPeers } } - -- Are we below the target for number of established peers? - | numEstablishedPeers + numConnectInProgress < targetNumberOfEstablishedPeers - - -- Are there any cold peers we could possibly pick to connect to? - -- We can subtract the established ones because by definition they are - -- not cold and our invariant is that they are always in the connect set. - -- We can also subtract the in progress ones since they are also already - -- in the connect set and we cannot pick them again. - , numAvailableToConnect - numEstablishedPeers - numConnectInProgress > 0 + | numPeersToPromote > 0 + , Set.size availableToPromote > 0 = Guarded Nothing $ do - -- The availableToPromote here is non-empty due to the second guard. - -- The known peers map restricted to the connect set is the same size as - -- the connect set (because it is a subset). The establishedPeers is a - -- subset of the connect set and we also know that there is no overlap - -- between inProgressPromoteCold and establishedPeers. QED. - -- - -- The numPeersToPromote is positive based on the first guard. - -- - let availableToPromote :: Set peeraddr - availableToPromote = availableToConnect - Set.\\ EstablishedPeers.toSet establishedPeers - Set.\\ inProgressPromoteCold - numPeersToPromote = targetNumberOfEstablishedPeers - - numEstablishedPeers - - numConnectInProgress selectedToPromote <- pickPeers memberExtraPeers st policyPickColdPeersToPromote availableToPromote @@ -311,17 +288,30 @@ belowTargetOther actions@PeerSelectionActions { -- If we could connect except that there are no peers currently available -- then we return the next wakeup time (if any) - | numEstablishedPeers + numConnectInProgress < targetNumberOfEstablishedPeers - = GuardedSkip (KnownPeers.minConnectTime knownPeers (`Set.notMember` bigLedgerPeersSet)) + | numPeersToPromote > 0 + = GuardedSkip (KnownPeers.minConnectTime knownPeers (`Set.notMember` rootSet)) | otherwise = GuardedSkip Nothing where + -- we compute the available set because there isn't a direct + -- way with simple arithmetic to distinguish local and established + -- local root peers which would be double counted. + availableToPromote = availableToConnect + Set.\\ establishedPeers + Set.\\ inProgressPromoteCold + Set.\\ localRootSet + numPeersToPromote = + targetNumberOfEstablishedPeers + - numEstablishedPeers + - numConnectInProgress + rootSet = Set.union bigLedgerPeersSet localRootSet PeerSelectionView { viewKnownBigLedgerPeers = (bigLedgerPeersSet, _), - viewAvailableToConnectPeers = (availableToConnect, numAvailableToConnect), - viewEstablishedPeers = (_, numEstablishedPeers), + viewAvailableToConnectPeers = (availableToConnect, _), + viewKnownLocalRootPeers = (localRootSet, _), + viewEstablishedPeers = (establishedPeers, numEstablishedPeers), viewColdPeersPromotions = (_, numConnectInProgress) } = From 62be20bb67a104933f6d8da3d604a71a8a2e1b85 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marcin=20W=C3=B3jtowicz?= Date: Mon, 20 Oct 2025 10:30:41 +0200 Subject: [PATCH 05/12] peer-selection: EstablishedPeers.belowTargetBigLedgerPeers --- .../PeerSelection/Governor/EstablishedPeers.hs | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/ouroboros-network/lib/Ouroboros/Network/PeerSelection/Governor/EstablishedPeers.hs b/ouroboros-network/lib/Ouroboros/Network/PeerSelection/Governor/EstablishedPeers.hs index 42d88838886..e33c3748856 100644 --- a/ouroboros-network/lib/Ouroboros/Network/PeerSelection/Governor/EstablishedPeers.hs +++ b/ouroboros-network/lib/Ouroboros/Network/PeerSelection/Governor/EstablishedPeers.hs @@ -377,8 +377,7 @@ belowTargetBigLedgerPeers enableAction extraState } -- Are we below the target for number of established peers? - | numEstablishedPeers + numConnectInProgress - < targetNumberOfEstablishedBigLedgerPeers + | numPeersToPromote > 0 -- Are there any cold peers we could possibly pick to connect to? -- We can subtract the established ones because by definition they are @@ -401,9 +400,6 @@ belowTargetBigLedgerPeers enableAction availableToPromote = availableToConnect Set.\\ EstablishedPeers.toSet establishedPeers Set.\\ inProgressPromoteCold - numPeersToPromote = targetNumberOfEstablishedBigLedgerPeers - - numEstablishedPeers - - numConnectInProgress selectedToPromote <- pickPeers memberExtraPeers st policyPickColdPeersToPromote availableToPromote @@ -423,13 +419,17 @@ belowTargetBigLedgerPeers enableAction -- If we could connect except that there are no peers currently available -- then we return the next wakeup time (if any) - | numEstablishedPeers + numConnectInProgress - < targetNumberOfEstablishedBigLedgerPeers + | numPeersToPromote > 0 = GuardedSkip (KnownPeers.minConnectTime knownPeers (`Set.member` bigLedgerPeersSet)) | otherwise = GuardedSkip Nothing where + numPeersToPromote = + targetNumberOfEstablishedBigLedgerPeers + - numEstablishedPeers + - numConnectInProgress + PeerSelectionView { viewKnownBigLedgerPeers = (bigLedgerPeersSet, _), viewAvailableToConnectBigLedgerPeers = (availableToConnect, numAvailableToConnect), From b4eeb8f4812207c7b7c10128074e388ff90b7fca Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marcin=20W=C3=B3jtowicz?= Date: Mon, 13 Oct 2025 11:56:08 +0200 Subject: [PATCH 06/12] testing-utils: Update Signal module --- .../lib/Test/Ouroboros/Network/Data/Signal.hs | 39 +++++++++++++------ 1 file changed, 28 insertions(+), 11 deletions(-) diff --git a/ouroboros-network/tests-lib/lib/Test/Ouroboros/Network/Data/Signal.hs b/ouroboros-network/tests-lib/lib/Test/Ouroboros/Network/Data/Signal.hs index 7b731853489..ce96e7bdcd0 100644 --- a/ouroboros-network/tests-lib/lib/Test/Ouroboros/Network/Data/Signal.hs +++ b/ouroboros-network/tests-lib/lib/Test/Ouroboros/Network/Data/Signal.hs @@ -41,6 +41,7 @@ module Test.Ouroboros.Network.Data.Signal , scanl , always , eventually + , latch -- * Set-based temporal operations , keyedTimeout , keyedLinger @@ -53,7 +54,7 @@ import Prelude hiding (scanl, until) import Data.Bool (bool) import Data.Foldable qualified as Deque (toList) import Data.List (groupBy) -import Data.Maybe (maybeToList) +import Data.Maybe (fromMaybe, maybeToList) import Data.OrdPSQ (OrdPSQ) import Data.OrdPSQ qualified as PSQ import Data.Set (Set) @@ -262,12 +263,13 @@ nubBy eq (Signal x0 xs0) = -- signal is @True@. -- linger :: DiffTime - -> (a -> Bool) + -> (a -> Maybe Bool) + -- ^ Nothing to stop tracking -> Signal a -> Signal Bool linger d arm = fmap (not . Set.null) - . keyedLinger d (bool Set.empty (Set.singleton ()) . arm) + . keyedLinger d (fmap (bool Set.empty (Set.singleton ())) . arm) -- | Make a timeout signal, based on observing an underlying signal. @@ -303,6 +305,17 @@ until start stop = (bool Set.empty (Set.singleton ()) . stop) (const False) +-- | The signal is scrutinised with a function and if it returns Nothing, +-- then the previous Signal output is maintained, otherwise the new +-- signal value is provided. +-- +latch :: (a -> Maybe b) + -> b + -> Signal a + -> Signal b +latch f = scanl f' + where + f' z' e = fromMaybe z' (f e) -- | Make a signal that keeps track of recent activity, based on observing an -- underlying signal. @@ -311,10 +324,11 @@ until start stop = -- keyedLinger :: forall a b. Ord b => DiffTime - -> (a -> Set b) -- ^ The activity set signal + -> (a -> Maybe (Set b)) + -- ^ The activity set signal, Nothing to stop -> Signal a -> Signal (Set b) -keyedLinger d arm = keyedLinger' (fmap (\x -> (x, d)) arm) +keyedLinger d arm = keyedLinger' (fmap (\x -> (x, d)) <$> arm) -- | Make a signal that keeps track of recent activity, based on observing an -- underlying signal. @@ -336,7 +350,11 @@ keyedLinger d arm = keyedLinger' (fmap (\x -> (x, d)) arm) -- those. This allow us to correctly identify valid promotion opportunities. -- keyedLinger' :: forall a b. Ord b - => (a -> (Set b, DiffTime)) -- ^ The activity set signal + => (a -> Maybe (Set b, DiffTime)) + -- ^ The activity set signal. The returned signal will be raised + -- for the given amount of time with a set which might be a super + -- set of the given keys (due to accumulation). On `Nothing` the + -- returned signal is reset. -> Signal a -> Signal (Set b) keyedLinger' arm = @@ -347,11 +365,12 @@ keyedLinger' arm = where go :: Set b -> OrdPSQ b Time () - -> [E (Set b, DiffTime)] + -> [E (Maybe (Set b, DiffTime))] -> [E (Set b)] go !_ !_ [] = [] - go !lingerSet !lingerPSQ (E ts@(TS t _) xs : txs) + go !_ !_ (E _ts Nothing : txs) = go Set.empty PSQ.empty txs + go !lingerSet !lingerPSQ (E ts@(TS t _) xs@Just{} : txs) | Just (y, t', _, lingerPSQ') <- PSQ.minView lingerPSQ , t' < t , (ys, lingerPSQ'') <- PSQ.atMostView t' lingerPSQ' @@ -359,7 +378,7 @@ keyedLinger' arm = lingerSet' = Set.difference lingerSet armed = E (TS t' 0) lingerSet' : go lingerSet' lingerPSQ'' (E ts xs : txs) - go !lingerSet !lingerPSQ (E ts@(TS t _) x : txs) = + go !lingerSet !lingerPSQ (E ts@(TS t _) (Just x) : txs) = let lingerSet' = lingerSet <> fst x t' = addTime (snd x) t lingerPSQ' = Set.foldl' (\s y -> PSQ.insert y t' () s) lingerPSQ (fst x) @@ -552,5 +571,3 @@ mergeBy cmp = merge data MergeResult a b = OnlyInLeft a | InBoth a b | OnlyInRight b deriving (Eq, Show) - - From 2476ff4da6ff562f4b78a97cb3d4a7e341dde8f0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marcin=20W=C3=B3jtowicz?= Date: Wed, 8 Oct 2025 20:56:01 +0200 Subject: [PATCH 07/12] testnet: IOSIm target active below false positive --- .../Test/Cardano/Network/Diffusion/Testnet.hs | 97 +++++++++---------- 1 file changed, 44 insertions(+), 53 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 f936c2855e6..89e7126b622 100644 --- a/cardano-diffusion/tests/lib/Test/Cardano/Network/Diffusion/Testnet.hs +++ b/cardano-diffusion/tests/lib/Test/Cardano/Network/Diffusion/Testnet.hs @@ -17,6 +17,7 @@ module Test.Cardano.Network.Diffusion.Testnet (tests) where +import Control.Arrow ((&&&)) import Control.Exception (AssertionFailed (..), catch, displayException, evaluate, fromException) import Control.Monad.Class.MonadFork @@ -2907,71 +2908,52 @@ prop_diffusion_target_active_below ioSimTrace traceNumber = events govActiveFailuresSig :: Signal (Set NtNAddr) - govActiveFailuresSig = + govActiveFailuresSig = holdUntilNextWakeup govAnythingSig $ Signal.keyedLinger - 180 -- 3 minutes -- TODO: too eager to reconnect? - (fromMaybe Set.empty) + 162 -- 5 * 2^5 + fuzz(-2,2) + -- arm `Nothing` from the underlying signal with an empty set, + -- we don't want to reset the lingered state too soon. + (Just . fromMaybe Set.empty) . Signal.fromEvents . Signal.selectEvents (\case TracePromoteWarmFailed _ _ peer _ -> - --TODO: the environment does not yet cause this to happen - -- it requires synchronous failure in the establish - -- action Just (Set.singleton peer) - --TODO TraceDemoteAsynchronous status | Set.null failures -> Nothing | otherwise -> Just failures where - failures = Map.keysSet (Map.filter (==PeerWarm) . fmap fst $ status) + failures = Map.keysSet status TraceDemoteLocalAsynchronous status | Set.null failures -> Nothing | otherwise -> Just failures where - failures = Map.keysSet (Map.filter (==PeerWarm) . fmap fst $ status) + failures = Map.keysSet status TracePromoteWarmBigLedgerPeerFailed _ _ peer _ -> Just (Set.singleton peer) TraceDemoteBigLedgerPeersAsynchronous status | Set.null failures -> Nothing | otherwise -> Just failures where - failures = Map.keysSet (Map.filter ((==PeerCooling) . fst) status) + failures = Map.keysSet status _ -> Nothing ) . selectDiffusionPeerSelectionEvents $ events - govInProgressPromoteWarmSig :: Signal (Set NtNAddr) - govInProgressPromoteWarmSig = - selectDiffusionPeerSelectionState Governor.inProgressPromoteWarm events - - trJoinKillSig :: Signal JoinedOrKilled - trJoinKillSig = - Signal.fromChangeEvents Terminated -- Default to TrKillingNode - . Signal.selectEvents - (\case TrJoiningNetwork -> Just Joined - TrTerminated -> Just Terminated - _ -> Nothing - ) - . selectDiffusionSimulationTrace + govInProgressIneligibleSig :: Signal (Set NtNAddr) + govInProgressIneligibleSig = + selectDiffusionPeerSelectionState + (uncurry Set.union . ( Governor.inProgressPromoteWarm + &&& Governor.inProgressDemoteWarm)) + events + + govAnythingSig :: Signal (Maybe ()) + govAnythingSig = + Signal.fromEvents + . void + . selectDiffusionPeerSelectionEvents $ events - -- Signal.keyedUntil receives 2 functions one that sets start of the - -- set signal, one that ends it and another that stops all. - -- - -- In this particular case we want a signal that is keyed beginning - -- on a TrJoiningNetwork and ends on TrKillingNode, giving us a Signal - -- with the periods when a node was alive. - trIsNodeAlive :: Signal Bool - trIsNodeAlive = - not . Set.null - <$> Signal.keyedUntil (fromJoinedOrTerminated (Set.singleton ()) - Set.empty) - (fromJoinedOrTerminated Set.empty - (Set.singleton ())) - (const False) - trJoinKillSig - -- There are no opportunities if we're at or above target. -- -- We define local root peers not to be promotion opportunities for @@ -2983,14 +2965,14 @@ prop_diffusion_target_active_below ioSimTrace traceNumber = -- want to promote any, since we'd then be above target for the local -- root peer group. -- - promotionOpportunity target local established active recentFailures isAlive - inProgressDemoteToCold inProgressPromoteWarm - | isAlive && Set.size active < target + promotionOpportunity target local established active recentFailures + inProgressDemoteToCold inProgressIneligible + | Set.size active < target = established Set.\\ active Set.\\ LocalRootPeers.keysSet local Set.\\ recentFailures Set.\\ inProgressDemoteToCold - Set.\\ inProgressPromoteWarm + Set.\\ inProgressIneligible | otherwise = Set.empty @@ -3003,31 +2985,26 @@ prop_diffusion_target_active_below ioSimTrace traceNumber = <*> govEstablishedPeersSig <*> govActivePeersSig <*> govActiveFailuresSig - <*> trIsNodeAlive <*> govInProgressDemoteToColdSig - <*> govInProgressPromoteWarmSig + <*> govInProgressIneligibleSig promotionOpportunitiesIgnoredTooLong :: Signal (Set NtNAddr) promotionOpportunitiesIgnoredTooLong = Signal.keyedTimeout - 10 -- seconds + 1 -- seconds id promotionOpportunities in counterexample ("\nSignal key: (local, established peers, active peers, " ++ "recent failures, opportunities, is node running, ignored too long)") $ - counterexample - (List.intercalate "\n" $ map show $ Signal.eventsToList events) $ - signalProperty 20 show - (\(_, _, _, _, _, _, toolong) -> Set.null toolong) - ((,,,,,,) <$> govLocalRootPeersSig + (\(_, _, _, _, _, toolong) -> Set.null toolong) + ((,,,,,) <$> govLocalRootPeersSig <*> govEstablishedPeersSig <*> govActivePeersSig <*> govActiveFailuresSig - <*> govInProgressPromoteWarmSig - <*> trIsNodeAlive + <*> govInProgressIneligibleSig <*> promotionOpportunitiesIgnoredTooLong ) @@ -5051,6 +5028,20 @@ fromJoinedOrTerminated :: c -> c -> JoinedOrKilled -> c fromJoinedOrTerminated j _ Joined = j fromJoinedOrTerminated _ k Terminated = k +-- We maintain and update the baseSignal and only publish +-- it when we receive a Just () in the arm signal. Some tests +-- appear to fail due to our signal timeouts, but of which the +-- governor is not aware while it is dormant/blocked. The test +-- is allowed to pass unless when/if the governor wakes up, it does +-- take the action we need it to take. +holdUntilNextWakeup :: Signal (Maybe ()) -> Signal (Set a) -> Signal (Set a) +holdUntilNextWakeup armSignal baseSignal = + Signal.latch f Set.empty ((,) <$> armSignal + <*> baseSignal) + where + f (Just (), collected) = Just collected + f (Nothing, _collected) = Nothing + getTime :: (Time, ThreadId (IOSim s), Maybe ThreadLabel, SimEventType) -> Time getTime (t, _, _, _) = t From c765aa8d968d2d8221cf9e892119ff9361147f6f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marcin=20W=C3=B3jtowicz?= Date: Mon, 13 Oct 2025 16:07:33 +0200 Subject: [PATCH 08/12] testnet: update iosim governor tests --- .../Test/Cardano/Network/Diffusion/Testnet.hs | 452 +++++++++--------- 1 file changed, 217 insertions(+), 235 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 89e7126b622..2b55260551e 100644 --- a/cardano-diffusion/tests/lib/Test/Cardano/Network/Diffusion/Testnet.hs +++ b/cardano-diffusion/tests/lib/Test/Cardano/Network/Diffusion/Testnet.hs @@ -30,6 +30,7 @@ import Data.Bifunctor (bimap, first) import Data.Char (ord) import Data.Dynamic (fromDynamic) import Data.Foldable (fold, foldr') +import Data.Functor (void) import Data.IP qualified as IP import Data.List (intercalate, sort) import Data.List qualified as List @@ -1419,63 +1420,72 @@ prop_track_coolingToCold_demotions ioSimTracer traceNumber = Governor.inProgressDemoteToCold events - - trJoinKillSig :: Signal JoinedOrKilled - trJoinKillSig = - Signal.fromChangeEvents Terminated -- Default to TrKillingNode - . Signal.selectEvents - (\case TrJoiningNetwork -> Just Joined - TrTerminated -> Just Terminated - _ -> Nothing - ) - . selectDiffusionSimulationTrace - $ events - - -- Signal.keyedUntil receives 2 functions one that sets start of the - -- set signal, one that ends it and another that stops all. - -- - -- In this particular case we want a signal that is keyed beginning - -- on a TrJoiningNetwork and ends on TrKillingNode, giving us a Signal - -- with the periods when a node was alive. - trIsNodeAlive :: Signal Bool - trIsNodeAlive = - not . Set.null - <$> Signal.keyedUntil (fromJoinedOrTerminated (Set.singleton ()) - Set.empty) - (fromJoinedOrTerminated Set.empty - (Set.singleton ())) - (const False) - trJoinKillSig - - govInProgressDemoteToColdWhileAlive :: Signal (Maybe (Set NtNAddr)) - govInProgressDemoteToColdWhileAlive = - (\isAlive inProgressDemoteToCold -> - if isAlive then Just inProgressDemoteToCold - else Nothing - ) <$> trIsNodeAlive - <*> govInProgressDemoteToCold - allInProgressDemoteToCold :: [NtNAddr] allInProgressDemoteToCold = Set.toList . Set.unions - . mapMaybe snd + . map snd . Signal.eventsToList . Signal.toChangeEvents - $ govInProgressDemoteToColdWhileAlive + $ govInProgressDemoteToCold + + + cmTimeWaitDoneSig :: Signal (Maybe TimeWaitPeer) + cmTimeWaitDoneSig = + Signal.fromEvents + . Signal.selectEvents + (\case (Left (CM.TrConnectionTimeWait peer)) + -> Just $ TimeWaitEntered (remoteAddress peer) + (Left (CM.TrConnectionTimeWaitDone peer)) + -> Just $ TimeWaitDone (remoteAddress peer) + (Right _) -> Just ResetAll + _otherwise -> Nothing) + . Signal.selectEvents + (\case DiffusionConnectionManagerTrace tr -> Just $ Left tr + -- reset CM signal state + DiffusionSimulationTrace TrKillingNode -> Just $ Right () + _ -> Nothing) + $ events + + cmTimeWaitDoneKeyedSig :: Signal (Set NtNAddr) + cmTimeWaitDoneKeyedSig = + Signal.keyedUntil + (\case Just (TimeWaitEntered peer) -> Set.singleton peer + _otherwise -> Set.empty) + (\case Just (TimeWaitDone peer) -> Set.singleton peer + _otherwise -> Set.empty) + (\case Just ResetAll -> True + _otherwise -> False) + cmTimeWaitDoneSig + + cmTimeWaitDoneLinger :: Signal (Set NtNAddr) + cmTimeWaitDoneLinger = + Signal.keyedLinger' + (\case Just (TimeWaitEntered peer) -> Just (Set.singleton peer, 30) + Just ResetAll -> Nothing + _otherwise -> Just (Set.empty, 0)) + cmTimeWaitDoneSig notInProgressDemoteToColdForTooLong = map (\addr -> Signal.keyedTimeout - 120 + 1 (\case - Just s | Set.member addr s -> Set.singleton addr - _ -> Set.empty + (inProgress, waitDoneKeyed, waitDoneLinger) + | Set.member addr inProgress + , Set.member addr waitDoneKeyed -> + if Set.member addr waitDoneLinger + then Set.empty else Set.singleton addr + | Set.member addr inProgress + , Set.notMember addr waitDoneKeyed -> Set.singleton addr + | otherwise -> Set.empty ) - govInProgressDemoteToColdWhileAlive + ((,,) <$> govInProgressDemoteToCold + <*> cmTimeWaitDoneKeyedSig + <*> cmTimeWaitDoneLinger) ) allInProgressDemoteToCold - in conjoin + in collect (length allInProgressDemoteToCold) $ conjoin $ map (signalProperty 20 show Set.null) notInProgressDemoteToColdForTooLong prop_track_coolingToCold_demotions_iosimpor @@ -2711,123 +2721,115 @@ prop_diffusion_target_established_local ioSimTrace traceNumber = Governor.inProgressPromoteCold events - govInProgressDemoteToColdSig :: Signal (Set NtNAddr) - govInProgressDemoteToColdSig = - selectDiffusionPeerSelectionState - Governor.inProgressDemoteToCold - events - govEstablishedPeersSig :: Signal (Set NtNAddr) govEstablishedPeersSig = selectDiffusionPeerSelectionState - ( EstablishedPeers.toSet - . Governor.establishedPeers) + (EstablishedPeers.toSet . Governor.establishedPeers) events govEstablishedFailuresSig :: Signal (Set NtNAddr) - govEstablishedFailuresSig = + govEstablishedFailuresSig = holdUntilNextWakeup govAnythingSig $ Signal.keyedLinger - 180 -- 3 minutes -- TODO: too eager to reconnect? - (fromMaybe Set.empty) + 162 -- 5 * 2^5 + fuzz(-2,2) + -- arm `Nothing` from the underlying signal with an empty set, + -- we don't want to reset the lingered state too soon. + (Just . fromMaybe Set.empty) . Signal.fromEvents . Signal.selectEvents (\case TracePromoteColdFailed _ _ peer _ _ -> Just (Set.singleton peer) - --TODO: what about TraceDemoteWarmDone ? - -- these are also not immediate candidates - -- why does the property not fail for not tracking these? + TracePromoteColdBigLedgerPeerFailed _ _ peer _ _ -> + Just (Set.singleton peer) + TraceDemoteBigLedgerPeersAsynchronous status + | Set.null failures -> Nothing + | otherwise -> Just failures + where + failures = + Map.keysSet status TraceDemoteAsynchronous status | Set.null failures -> Nothing | otherwise -> Just failures where failures = - Map.keysSet (Map.filter (==PeerCooling) . fmap fst $ status) + Map.keysSet status TraceDemoteLocalAsynchronous status | Set.null failures -> Nothing | otherwise -> Just failures where failures = - Map.keysSet (Map.filter (==PeerCooling) . fmap fst $ status) - TracePromoteWarmFailed _ _ peer _ -> - Just (Set.singleton peer) + Map.keysSet status _ -> Nothing ) . selectDiffusionPeerSelectionEvents $ events - trJoinKillSig :: Signal JoinedOrKilled - trJoinKillSig = - Signal.fromChangeEvents Terminated -- Default to TrKillingNode - . Signal.selectEvents - (\case TrJoiningNetwork -> Just Joined - TrKillingNode -> Just Terminated - _ -> Nothing - ) - . selectDiffusionSimulationTrace + govAnythingSig :: Signal (Maybe ()) + govAnythingSig = + Signal.fromEvents + . void + . selectDiffusionPeerSelectionEvents $ events - -- Signal.keyedUntil receives 2 functions one that sets start of the - -- set signal, one that ends it and another that stops all. - -- - -- In this particular case we want a signal that is keyed beginning - -- on a TrJoiningNetwork and ends on TrKillingNode, giving us a Signal - -- with the periods when a node was alive. - trIsNodeAlive :: Signal Bool - trIsNodeAlive = - not . Set.null - <$> Signal.keyedUntil (fromJoinedOrTerminated (Set.singleton ()) - Set.empty) - (fromJoinedOrTerminated Set.empty - (Set.singleton ())) - (const False) - trJoinKillSig + govUseBootstrapPeersSig :: Signal Bool + govUseBootstrapPeersSig = + selectDiffusionPeerSelectionState + (\psState -> + let bpf = Cardano.ExtraState.bootstrapPeersFlag $ Governor.extraState psState + lsj = Cardano.ExtraState.ledgerStateJudgement $ Governor.extraState psState + in case (bpf, lsj) of + (UseBootstrapPeers{}, TooOld) -> True + _otherwise -> False + ) + events promotionOpportunities :: Signal (Set NtNAddr) promotionOpportunities = - (\local established recentFailures inProgressPromoteCold isAlive inProgressDemoteToCold -> - if isAlive then + (\local established recentFailures inProgressPromoteCold useBootstrapPeers -> Set.unions - [ -- There are no opportunities if we're at or above target - if Set.size groupEstablished >= warmTarget - then Set.empty - else groupEstablished Set.\\ established - Set.\\ recentFailures - Set.\\ inProgressPromoteCold - Set.\\ inProgressDemoteToCold - | (_, WarmValency warmTarget, group) <- LocalRootPeers.toGroupSets local - , let groupEstablished = group `Set.intersection` established + [opportunity + | let local' = + if useBootstrapPeers + then LocalRootPeers.clampToTrustable local + else local + , (_, WarmValency warmTarget, group) <- LocalRootPeers.toGroupSets local' + , let opportunity + | Set.size (Set.intersection + group established) + + Set.size (Set.intersection + inProgressPromoteCold group) + >= warmTarget + = Set.empty + | otherwise = group ] - else Set.empty + Set.\\ Set.unions [established, recentFailures, inProgressPromoteCold] ) <$> govLocalRootPeersSig <*> govEstablishedPeersSig <*> govEstablishedFailuresSig <*> govInProgressPromoteColdSig - <*> trIsNodeAlive - <*> govInProgressDemoteToColdSig + <*> govUseBootstrapPeersSig promotionOpportunitiesIgnoredTooLong :: Signal (Set NtNAddr) promotionOpportunitiesIgnoredTooLong = Signal.keyedTimeout - 15 -- seconds + 1 id promotionOpportunities in counterexample - ("\nSignal key: (local root peers, established peers, " ++ - "recent failures, is alive, opportunities, ignored too long)\n" ++ - List.intercalate "\n" (map show $ eventsToList events) + ("\nSignal key: (local root peers, est. local peers, in progress promotions, " ++ + "recent failures, opportunities, ignored too long)\n" ) $ signalProperty 20 show - (\(_,_,_,_,_,_, tooLong) -> Set.null tooLong) - ((,,,,,,) <$> govLocalRootPeersSig - <*> govEstablishedPeersSig - <*> govEstablishedFailuresSig - <*> govInProgressPromoteColdSig - <*> trIsNodeAlive - <*> promotionOpportunities - <*> promotionOpportunitiesIgnoredTooLong + (\(_,_,_,_,_, tooLong) -> Set.null tooLong) + ((,,,,,) <$> (LocalRootPeers.toGroupSets <$> govLocalRootPeersSig) + <*> govEstablishedPeersSig + <*> govInProgressPromoteColdSig + <*> govEstablishedFailuresSig + <*> promotionOpportunities + <*> promotionOpportunitiesIgnoredTooLong ) + prop_diffusion_target_established_local_iosimpor :: AbsBearerInfo -> DiffusionScript -> Property prop_diffusion_target_established_local_iosimpor @@ -3062,59 +3064,38 @@ prop_diffusion_target_active_local_below ioSimTrace traceNumber = (EstablishedPeers.toSet . Governor.establishedPeers) events - govInProgressDemoteToColdSig :: Signal (Set NtNAddr) - govInProgressDemoteToColdSig = + govActivePeersSig :: Signal (Set NtNAddr) + govActivePeersSig = + selectDiffusionPeerSelectionState Governor.activePeers events + + govInProgressIneligibleSig :: Signal (Set NtNAddr) + govInProgressIneligibleSig = selectDiffusionPeerSelectionState - Governor.inProgressDemoteToCold + (\psState -> Set.unions [ Governor.inProgressPromoteWarm psState + , Governor.inProgressDemoteWarm psState + , Governor.inProgressDemoteToCold psState + ]) events - govInProgressPromoteWarmSig :: Signal (Set NtNAddr) - govInProgressPromoteWarmSig = - selectDiffusionPeerSelectionState Governor.inProgressPromoteWarm events - - trJoinKillSig :: Signal JoinedOrKilled - trJoinKillSig = - Signal.fromChangeEvents Terminated -- Default to TrKillingNode - . Signal.selectEvents - (\case DiffusionSimulationTrace TrJoiningNetwork - -> Just Joined - DiffusionSimulationTrace TrTerminated - -> Just Terminated - DiffusionConnectionManagerTrace CM.TrShutdown - -> Just Terminated - _ -> Nothing - ) + govAnythingSig :: Signal (Maybe ()) + govAnythingSig = + Signal.fromEvents + . void + . selectDiffusionPeerSelectionEvents $ events - -- Signal.keyedUntil receives 2 functions one that sets start of the - -- set signal, one that ends it and another that stops all. - -- - -- In this particular case we want a signal that is keyed beginning - -- on a TrJoiningNetwork and ends on TrKillingNode, giving us a Signal - -- with the periods when a node was alive. - trIsNodeAlive :: Signal Bool - trIsNodeAlive = - not . Set.null - <$> Signal.keyedUntil (fromJoinedOrTerminated (Set.singleton ()) - Set.empty) - (fromJoinedOrTerminated Set.empty - (Set.singleton ())) - (const False) - trJoinKillSig - - govActivePeersSig :: Signal (Set NtNAddr) - govActivePeersSig = - selectDiffusionPeerSelectionState Governor.activePeers events - govActiveFailuresSig :: Signal (Set NtNAddr) - govActiveFailuresSig = + govActiveFailuresSig = holdUntilNextWakeup govAnythingSig $ Signal.keyedLinger - 180 -- 3 minutes -- TODO: too eager to reconnect? - (fromMaybe Set.empty) + 162 -- max $ 5*2^5 + fuzz(-2,2) + -- arm `Nothing` from the underlying signal with an empty set, + -- we don't want to reset the lingered state too soon. + (Just . fromMaybe Set.empty) . Signal.fromEvents . Signal.selectEvents (\case TracePromoteWarmFailed _ _ peer _ -> - --TODO: the simulation does not yet cause this to happen + Just (Set.singleton peer) + TracePromoteWarmBigLedgerPeerFailed _ _ peer _ -> Just (Set.singleton peer) TraceDemoteAsynchronous status | Set.null failures -> Nothing @@ -3130,58 +3111,75 @@ prop_diffusion_target_active_local_below ioSimTrace traceNumber = -- unlike in the governor case we take into account -- all asynchronous demotions failures = Map.keysSet status + TraceDemoteBigLedgerPeersAsynchronous status + | Set.null failures -> Nothing + | otherwise -> Just failures + where + failures = + Map.keysSet status _ -> Nothing ) . selectDiffusionPeerSelectionEvents $ events + govUseBootstrapPeersSig :: Signal Bool + govUseBootstrapPeersSig = + selectDiffusionPeerSelectionState + (\psState -> + let bpf = Cardano.ExtraState.bootstrapPeersFlag $ Governor.extraState psState + lsj = Cardano.ExtraState.ledgerStateJudgement $ Governor.extraState psState + in case (bpf, lsj) of + (UseBootstrapPeers{}, TooOld) -> True + _otherwise -> False + ) + events + promotionOpportunities :: Signal (Set NtNAddr) promotionOpportunities = - (\local established active recentFailures isAlive inProgressDemoteToCold inProgressPromoteWarm -> - if isAlive then + (\local established active recentFailures inProgressIneligible useBootstrapPeers -> Set.unions - [ -- There are no opportunities if we're at or above target - if Set.size groupActive >= hotTarget - then Set.empty - else groupEstablished Set.\\ active - Set.\\ recentFailures - Set.\\ inProgressDemoteToCold - Set.\\ inProgressPromoteWarm - | (HotValency hotTarget, _, group) <- LocalRootPeers.toGroupSets local - , let groupActive = group `Set.intersection` active - groupEstablished = group `Set.intersection` established + [opportunity + | let local' = + if useBootstrapPeers + then LocalRootPeers.clampToTrustable local + else local + , (HotValency hotTarget, _, group) <- LocalRootPeers.toGroupSets local' + , let opportunity + | Set.size (Set.intersection + group active) + >= hotTarget + = Set.empty + | otherwise = group `Set.intersection` established ] - else - Set.empty + Set.\\ Set.unions [active, recentFailures, inProgressIneligible] ) <$> govLocalRootPeersSig <*> govEstablishedPeersSig <*> govActivePeersSig <*> govActiveFailuresSig - <*> trIsNodeAlive - <*> govInProgressDemoteToColdSig - <*> govInProgressPromoteWarmSig + <*> govInProgressIneligibleSig + <*> govUseBootstrapPeersSig promotionOpportunitiesIgnoredTooLong :: Signal (Set NtNAddr) promotionOpportunitiesIgnoredTooLong = Signal.keyedTimeout - 10 -- seconds + 1 -- seconds id promotionOpportunities in counterexample ("\nSignal key: (local, established peers, active peers, " ++ "recent failures, opportunities, ignored too long)") $ - counterexample - (List.intercalate "\n" $ map show $ Signal.eventsToList events) $ + -- counterexample + -- (List.intercalate "\n" $ map show $ Signal.eventsToList events) $ signalProperty 20 show (\(_,_,_,_,_,toolong) -> Set.null toolong) ((,,,,,) <$> (LocalRootPeers.toGroupSets <$> govLocalRootPeersSig) - <*> govEstablishedPeersSig - <*> govActivePeersSig - <*> govActiveFailuresSig - <*> promotionOpportunities - <*> promotionOpportunitiesIgnoredTooLong) + <*> govEstablishedPeersSig + <*> govActivePeersSig + <*> govActiveFailuresSig + <*> promotionOpportunities + <*> promotionOpportunitiesIgnoredTooLong) prop_diffusion_target_active_local_below_iosimpor :: AbsBearerInfo -> DiffusionScript -> Property @@ -3502,73 +3500,49 @@ prop_diffusion_target_active_local_above ioSimTrace traceNumber = govActivePeersSig = selectDiffusionPeerSelectionState Governor.activePeers events - govInProgressDemoteToColdSig :: Signal (Set NtNAddr) - govInProgressDemoteToColdSig = - selectDiffusionPeerSelectionState Governor.inProgressDemoteToCold events - - trJoinKillSig :: Signal JoinedOrKilled - trJoinKillSig = - Signal.fromChangeEvents Terminated -- Default to TrKillingNode - . Signal.selectEvents - (\case TrJoiningNetwork -> Just Joined - TrTerminated -> Just Terminated - _ -> Nothing - ) - . selectDiffusionSimulationTrace - $ events + govActiveBigPeersSig :: Signal (Set NtNAddr) + govActiveBigPeersSig = + selectDiffusionPeerSelectionState (dropBigLedgerPeers Governor.activePeers) events - -- Signal.keyedUntil receives 2 functions one that sets start of the - -- set signal, one that ends it and another that stops all. - -- - -- In this particular case we want a signal that is keyed beginning - -- on a TrJoiningNetwork and ends on TrKillingNode, giving us a Signal - -- with the periods when a node was alive. - trIsNodeAlive :: Signal Bool - trIsNodeAlive = - not . Set.null - <$> Signal.keyedUntil (fromJoinedOrTerminated (Set.singleton ()) - Set.empty) - (fromJoinedOrTerminated Set.empty - (Set.singleton ())) - (const False) - trJoinKillSig + govInProgressIneligibleSig :: Signal (Set NtNAddr) + govInProgressIneligibleSig = + selectDiffusionPeerSelectionState + (uncurry Set.union . ( Governor.inProgressDemoteToCold + &&& Governor.inProgressDemoteHot)) + events demotionOpportunities :: Signal (Set NtNAddr) demotionOpportunities = - (\local active isAlive inProgressDemoteToCold -> - if isAlive - then Set.unions - [ -- There are no opportunities if we're at or below target - if Set.size groupActive <= hotTarget - then Set.empty - else groupActive - Set.\\ inProgressDemoteToCold - | (HotValency hotTarget, _, group) <- LocalRootPeers.toGroupSets local - , let groupActive = group `Set.intersection` active - ] - else Set.empty + (\local active bigActive inProgressIneligible -> + Set.unions + [opportunity + | (HotValency hotTarget, _, group) <- LocalRootPeers.toGroupSets local + , let groupActive = group `Set.intersection` active + opportunity + | Set.size groupActive <= hotTarget = Set.empty + | otherwise = groupActive + ] Set.\\ Set.union inProgressIneligible bigActive ) <$> govLocalRootPeersSig <*> govActivePeersSig - <*> trIsNodeAlive - <*> govInProgressDemoteToColdSig + <*> govActiveBigPeersSig + <*> govInProgressIneligibleSig demotionOpportunitiesIgnoredTooLong :: Signal (Set NtNAddr) demotionOpportunitiesIgnoredTooLong = Signal.keyedTimeout - 100 -- seconds + 1 -- seconds id demotionOpportunities in counterexample - ("\nSignal key: (local peers, active peers, is alive " ++ + ("\nSignal key: (local peers, active peers, " ++ "demotion opportunities, ignored too long)") $ - counterexample (List.intercalate "\n" $ map show $ Signal.eventsToList events) $ + --counterexample (List.intercalate "\n" $ map show $ Signal.eventsToList events) $ signalProperty 20 show - (\(_,_,_,_,toolong) -> Set.null toolong) - ((,,,,) <$> (LocalRootPeers.toGroupSets <$> govLocalRootPeersSig) + (\(_,_,_,toolong) -> Set.null toolong) + ((,,,) <$> (LocalRootPeers.toGroupSets <$> govLocalRootPeersSig) <*> govActivePeersSig - <*> trIsNodeAlive <*> demotionOpportunities <*> demotionOpportunitiesIgnoredTooLong) @@ -4500,8 +4474,8 @@ prop_churn_notimeouts ioSimTrace traceNumber = isGovernorStuck = fmap (not . Set.null) . keyedLinger' (\d -> if d > 0 - then (Set.singleton (), d) - else (Set.empty, d) + then Just (Set.singleton (), d) + else Just (Set.empty, d) ) . Signal.fromChangeEvents 0 . Signal.selectEvents @@ -5020,6 +4994,11 @@ prop_no_peershare_unwilling_iosim -- Utils -- +data TimeWaitPeer = TimeWaitEntered NtNAddr + | TimeWaitDone NtNAddr + | ResetAll + + data JoinedOrKilled = Joined | Terminated deriving (Eq, Show) @@ -5124,15 +5103,18 @@ selectDiffusionPeerSelectionState' :: (forall peerconn. Governor.PeerSelectionSt -> Signal a selectDiffusionPeerSelectionState' f = -- TODO: #3182 Rng seed should come from quickcheck. - Signal.fromChangeEvents - (f $ Governor.emptyPeerSelectionState - (mkStdGen 42) - (Cardano.ExtraState.empty PraosMode (NumberOfBigLedgerPeers 0)) - Cardano.ExtraPeers.empty) + Signal.fromChangeEvents initial . Signal.selectEvents (\case DiffusionDebugPeerSelectionTrace (TraceGovernorState _ _ st) -> Just (f st) + -- don't let old state linger around when a node is restarted + DiffusionSimulationTrace TrKillingNode -> Just initial _ -> Nothing) + where + initial = f $ Governor.emptyPeerSelectionState + (mkStdGen 42) + (Cardano.ExtraState.empty PraosMode (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty selectDiffusionConnectionManagerEvents :: Trace () DiffusionTestTrace From 656f1e30a7ee5f396beaa9f85061d02c26827155 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marcin=20W=C3=B3jtowicz?= Date: Wed, 8 Oct 2025 20:52:14 +0200 Subject: [PATCH 09/12] testing: adapt similar changes to PeerSelection tests --- .../lib/Test/Cardano/Network/PeerSelection.hs | 414 +++++++++++------- .../Network/PeerSelection/MockEnvironment.hs | 5 +- .../Governor/EstablishedPeers.hs | 1 + 3 files changed, 250 insertions(+), 170 deletions(-) diff --git a/cardano-diffusion/tests/lib/Test/Cardano/Network/PeerSelection.hs b/cardano-diffusion/tests/lib/Test/Cardano/Network/PeerSelection.hs index 646a4713039..e385986f9b4 100644 --- a/cardano-diffusion/tests/lib/Test/Cardano/Network/PeerSelection.hs +++ b/cardano-diffusion/tests/lib/Test/Cardano/Network/PeerSelection.hs @@ -28,6 +28,7 @@ -- `ouroboros-network` too, them some of these tests might not be needed. module Test.Cardano.Network.PeerSelection (tests) where +import Control.Arrow ((&&&)) import Control.Concurrent.Class.MonadSTM.Strict import Control.Exception (AssertionFailed (..), catch, evaluate) import Control.Monad (when) @@ -1736,7 +1737,7 @@ prop_governor_target_known_2_opportunity_taken (MaxTime maxTime) env = -- peers are unavailable for peer sharing for at least an -- hour after each peer sharing interaction (60 * 60) - (maybe Set.empty Set.singleton) + (Just . maybe Set.empty Set.singleton) envPeerSharesEventsAsSig govLedgerStateJudgementSig :: Signal LedgerStateJudgement @@ -2348,11 +2349,17 @@ prop_governor_target_known_above (MaxTime maxTime) env = (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty events + govInProgressIneligibleSig :: Signal (Set PeerAddr) + govInProgressIneligibleSig = + selectGovState Governor.inProgressPromoteCold + (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + events + -- There are no demotion opportunities if we're at or below target. -- Otherwise, the opportunities for demotion are known peers that -- are not currently established and are not local. -- - demotionOpportunity targets local public known established + demotionOpportunity targets local public known established ineligible | Set.size known <= targetNumberOfKnownPeers targets = Set.empty @@ -2360,6 +2367,7 @@ prop_governor_target_known_above (MaxTime maxTime) env = = known Set.\\ established Set.\\ local Set.\\ publicProtected + Set.\\ ineligible where -- Furthermore, public roots are protected from demotion if we are -- at or below target for roots peers. @@ -2379,11 +2387,12 @@ prop_governor_target_known_above (MaxTime maxTime) env = <*> govPublicRootPeersSig <*> govKnownPeersSig <*> govEstablishedPeersSig + <*> govInProgressIneligibleSig demotionOpportunitiesIgnoredTooLong :: Signal (Set PeerAddr) demotionOpportunitiesIgnoredTooLong = Signal.keyedTimeout - 10 -- seconds + 1 -- seconds id demotionOpportunities @@ -2438,16 +2447,23 @@ prop_governor_target_known_big_ledger_peers_above (MaxTime maxTime) env = (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty events + govInProgressIneligibleSig :: Signal (Set PeerAddr) + govInProgressIneligibleSig = + selectGovState Governor.inProgressPromoteCold + (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + events + -- There are no demotion opportunities if we're at or below target. -- Otherwise, the opportunities for demotion are known peers that -- are not currently established and are not local. -- - demotionOpportunity targets known established + demotionOpportunity targets known established ineligible | Set.size known <= targetNumberOfKnownBigLedgerPeers targets = Set.empty | otherwise = known Set.\\ established + Set.\\ ineligible demotionOpportunities :: Signal (Set PeerAddr) demotionOpportunities = @@ -2455,11 +2471,12 @@ prop_governor_target_known_big_ledger_peers_above (MaxTime maxTime) env = <$> govTargetsSig <*> govKnownPeersSig <*> govEstablishedPeersSig + <*> govInProgressIneligibleSig demotionOpportunitiesIgnoredTooLong :: Signal (Set PeerAddr) demotionOpportunitiesIgnoredTooLong = Signal.keyedTimeout - 10 -- seconds + 1 id demotionOpportunities @@ -2523,6 +2540,12 @@ prop_governor_target_established_below (MaxTime maxTime) env = (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty events + govLocalRootPeersSig :: Signal (LocalRootPeers.LocalRootPeers PeerTrustable PeerAddr) + govLocalRootPeersSig = + selectGovState Governor.localRootPeers + (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + events + govKnownPeersSig :: Signal (Set PeerAddr) govKnownPeersSig = selectGovState (dropBigLedgerPeers $ @@ -2533,40 +2556,36 @@ prop_governor_target_established_below (MaxTime maxTime) env = govEstablishedPeersSig :: Signal (Set PeerAddr) govEstablishedPeersSig = selectGovState - (EstablishedPeers.toSet . Governor.establishedPeers) + (dropBigLedgerPeers $ + EstablishedPeers.toSet . Governor.establishedPeers) (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty events + govInProgressPromoteColdSig :: Signal (Set PeerAddr) + govInProgressPromoteColdSig = + selectGovState (dropBigLedgerPeers Governor.inProgressPromoteCold) + (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + events + govEstablishedFailuresSig :: Signal (Set PeerAddr) govEstablishedFailuresSig = Signal.keyedLinger - 180 -- 3 minutes -- TODO: too eager to reconnect? - (fromMaybe Set.empty) + 162 -- 5*2^5 + fuzz(-2,2) + (Just . fromMaybe Set.empty) . Signal.fromEvents . Signal.selectEvents (\case TracePromoteColdFailed _ _ peer _ _ -> - --TODO: the environment does not yet cause this to happen - -- it requires synchronous failure in the establish action Just $! Set.singleton peer - --TODO: what about TraceDemoteWarmDone ? - -- these are also not immediate candidates - -- why does the property not fail for not tracking these? - TraceDemoteAsynchronous status + TraceDemoteLocalAsynchronous status | Set.null failures -> Nothing | otherwise -> Just failures where - !failures = Map.keysSet (Map.filter (==PeerCooling) . fmap fst $ status) - TraceDemoteLocalAsynchronous status + !failures = Map.keysSet status + TraceDemoteAsynchronous status | Set.null failures -> Nothing | otherwise -> Just failures where - !failures = Map.keysSet (Map.filter (==PeerCooling) . fmap fst $ status) - TracePromoteWarmFailed _ _ peer _ -> - Just $! Set.singleton peer - TraceDemoteWarmFailed _ _ peer _ -> - Just $! Set.singleton peer - TraceDemoteHotFailed _ _ peer _ -> - Just $! Set.singleton peer + !failures = Map.keysSet status _ -> Nothing ) . selectGovEvents @@ -2574,41 +2593,46 @@ prop_governor_target_established_below (MaxTime maxTime) env = -- There are no opportunities if we're at or above target -- - promotionOpportunity target known established recentFailures - | Set.size established >= target + promotionOpportunity target known local established recentFailures inProgressCold + | Set.size established + Set.size inProgressCold >= target = Set.empty | otherwise = known Set.\\ established + Set.\\ LocalRootPeers.keysSet local Set.\\ recentFailures + Set.\\ inProgressCold promotionOpportunities :: Signal (Set PeerAddr) promotionOpportunities = promotionOpportunity <$> govTargetsSig <*> govKnownPeersSig + <*> govLocalRootPeersSig <*> govEstablishedPeersSig <*> govEstablishedFailuresSig + <*> govInProgressPromoteColdSig promotionOpportunitiesIgnoredTooLong :: Signal (Set PeerAddr) promotionOpportunitiesIgnoredTooLong = Signal.keyedTimeout - (repromoteDelay config_REPROMOTE_DELAY + 20) -- seconds + 1 id promotionOpportunities in counterexample ("\nSignal key: (target, known peers, established peers, recent failures, " ++ - "opportunities, ignored too long)") $ - - signalProperty 20 show - (\(_,_,_,_,_,toolong) -> Set.null toolong) - ((,,,,,) <$> govTargetsSig - <*> govKnownPeersSig - <*> govEstablishedPeersSig - <*> govEstablishedFailuresSig - <*> promotionOpportunities - <*> promotionOpportunitiesIgnoredTooLong) + "in progress, opportunities, ignored too long)") + + $ signalProperty 20 show + (\(_,_,_,_,_,_,toolong) -> Set.null toolong) + ((,,,,,,) <$> govTargetsSig + <*> govKnownPeersSig + <*> govEstablishedPeersSig + <*> govEstablishedFailuresSig + <*> govInProgressPromoteColdSig + <*> promotionOpportunities + <*> promotionOpportunitiesIgnoredTooLong) -- | A version of the `prop_governor_target_established_below` for big ledger -- peers. @@ -2651,48 +2675,44 @@ prop_governor_target_established_big_ledger_peers_below (MaxTime maxTime) env = govEstablishedFailuresSig = Signal.keyedLinger 180 -- 3 minutes -- TODO: too eager to reconnect? - (fromMaybe Set.empty) + (Just . fromMaybe Set.empty) . Signal.fromEvents . Signal.selectEvents (\case TracePromoteColdBigLedgerPeerFailed _ _ peer _ _ -> --TODO: the environment does not yet cause this to happen -- it requires synchronous failure in the establish action Just (Set.singleton peer) - TracePromoteWarmBigLedgerPeerFailed _ _ peer _ -> - Just (Set.singleton peer) - --TODO: what about TraceDemoteWarmDone ? - -- these are also not immediate candidates - -- why does the property not fail for not tracking these? TraceDemoteBigLedgerPeersAsynchronous status | Set.null failures -> Nothing | otherwise -> Just failures where - failures = Map.keysSet (Map.filter (==PeerCooling) . fmap fst $ status) + !failures = Map.keysSet status TraceDemoteLocalAsynchronous status | Set.null failures -> Nothing | otherwise -> Just failures where - failures = Map.keysSet (Map.filter (==PeerCooling) . fmap fst $ status) - TracePromoteWarmFailed _ _ peer _ -> - Just (Set.singleton peer) - TraceDemoteWarmBigLedgerPeerFailed _ _ peer _ -> - Just (Set.singleton peer) - TraceDemoteHotBigLedgerPeerFailed _ _ peer _ -> - Just (Set.singleton peer) + !failures = Map.keysSet status _ -> Nothing ) . selectGovEvents $ events + govInProgressIneligibleSig :: Signal (Set PeerAddr) + govInProgressIneligibleSig = + selectGovState (takeBigLedgerPeers Governor.inProgressPromoteCold) + (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + events + -- There are no opportunities if we're at or above target -- - promotionOpportunity target known established recentFailures - | Set.size established >= target + promotionOpportunity target known established recentFailures ineligible + | Set.size established + Set.size ineligible >= target = Set.empty | otherwise = known Set.\\ established Set.\\ recentFailures + Set.\\ ineligible promotionOpportunities :: Signal (Set PeerAddr) promotionOpportunities = @@ -2701,11 +2721,12 @@ prop_governor_target_established_big_ledger_peers_below (MaxTime maxTime) env = <*> govKnownPeersSig <*> govEstablishedPeersSig <*> govEstablishedFailuresSig + <*> govInProgressIneligibleSig promotionOpportunitiesIgnoredTooLong :: Signal (Set PeerAddr) promotionOpportunitiesIgnoredTooLong = Signal.keyedTimeout - (repromoteDelay config_REPROMOTE_DELAY + 20) -- seconds + (repromoteDelay config_REPROMOTE_DELAY + 1) -- seconds id promotionOpportunities @@ -2749,9 +2770,12 @@ prop_governor_target_active_below (MaxTime maxTime) env = (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty events - govInProgressDemoteToColdSig :: Signal (Set PeerAddr) - govInProgressDemoteToColdSig = - selectGovState Governor.inProgressDemoteToCold + govInProgressIneligibleSig :: Signal (Set PeerAddr) + govInProgressIneligibleSig = + selectGovState (\psState -> Set.unions [ Governor.inProgressDemoteToCold psState + , Governor.inProgressPromoteWarm psState + , Governor.inProgressDemoteWarm psState + ]) (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty events @@ -2765,7 +2789,7 @@ prop_governor_target_active_below (MaxTime maxTime) env = govActivePeersSig :: Signal (Set PeerAddr) govActivePeersSig = - selectGovState (dropBigLedgerPeers Governor.activePeers) + selectGovState Governor.activePeers (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty events @@ -2773,28 +2797,23 @@ prop_governor_target_active_below (MaxTime maxTime) env = govActiveFailuresSig = Signal.keyedLinger 180 -- 3 minutes -- TODO: too eager to reconnect? - (fromMaybe Set.empty) + (Just . fromMaybe Set.empty) . Signal.fromEvents . Signal.selectEvents (\case TracePromoteWarmFailed _ _ peer _ -> --TODO: the environment does not yet cause this to happen -- it requires synchronous failure in the establish action Just $! Set.singleton peer - TraceDemoteWarmFailed _ _ peer _ -> - Just $! Set.singleton peer - TraceDemoteHotFailed _ _ peer _ -> - Just $! Set.singleton peer - --TODO TraceDemoteAsynchronous status | Set.null failures -> Nothing | otherwise -> Just failures where - !failures = Map.keysSet (Map.filter (==PeerWarm) . fmap fst $ status) + !failures = Map.keysSet status TraceDemoteLocalAsynchronous status | Set.null failures -> Nothing | otherwise -> Just failures where - !failures = Map.keysSet (Map.filter (==PeerWarm) . fmap fst $ status) + !failures = Map.keysSet status _ -> Nothing ) . selectGovEvents @@ -2811,7 +2830,7 @@ prop_governor_target_active_below (MaxTime maxTime) env = -- want to promote any, since we'd then be above target for the local -- root peer group. -- - promotionOpportunity target local established active recentFailures inProgressDemoteToCold + promotionOpportunity target local established active recentFailures inProgressIneligible | Set.size active >= target = Set.empty @@ -2819,7 +2838,7 @@ prop_governor_target_active_below (MaxTime maxTime) env = = established Set.\\ active Set.\\ LocalRootPeers.keysSet local Set.\\ recentFailures - Set.\\ inProgressDemoteToCold + Set.\\ inProgressIneligible promotionOpportunities :: Signal (Set PeerAddr) promotionOpportunities = @@ -2829,12 +2848,14 @@ prop_governor_target_active_below (MaxTime maxTime) env = <*> govEstablishedPeersSig <*> govActivePeersSig <*> govActiveFailuresSig - <*> govInProgressDemoteToColdSig + <*> govInProgressIneligibleSig promotionOpportunitiesIgnoredTooLong :: Signal (Set PeerAddr) promotionOpportunitiesIgnoredTooLong = Signal.keyedTimeout - 15 -- seconds + -- TODO this test fails even the timeout is too aggressive, + -- unlike other tests, and the shrinker also appears to not terminate + 10 -- seconds id promotionOpportunities @@ -2882,9 +2903,12 @@ prop_governor_target_active_big_ledger_peers_below (MaxTime maxTime) env = (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty events - govInProgressDemoteToColdSig :: Signal (Set PeerAddr) - govInProgressDemoteToColdSig = - selectGovState Governor.inProgressDemoteToCold + govInProgressIneligibleSig :: Signal (Set PeerAddr) + govInProgressIneligibleSig = + selectGovState (\psState -> Set.unions [ Governor.inProgressDemoteToCold psState + , Governor.inProgressPromoteWarm psState + , Governor.inProgressDemoteWarm psState + ]) (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty events @@ -2898,10 +2922,10 @@ prop_governor_target_active_big_ledger_peers_below (MaxTime maxTime) env = govActiveFailuresSig = Signal.keyedLinger 180 -- 3 minutes -- TODO: too eager to reconnect? - (fromMaybe Set.empty) + (Just . fromMaybe Set.empty) . Signal.fromEvents . Signal.selectEvents - (\case TracePromoteWarmFailed _ _ peer _ -> + (\case TracePromoteWarmBigLedgerPeerFailed _ _ peer _ -> --TODO: the environment does not yet cause this to happen -- it requires synchronous failure in the establish action Just (Set.singleton peer) @@ -2909,7 +2933,12 @@ prop_governor_target_active_big_ledger_peers_below (MaxTime maxTime) env = | Set.null failures -> Nothing | otherwise -> Just failures where - failures = Map.keysSet (Map.filter (==PeerWarm) . fmap fst $ status) + !failures = Map.keysSet status + TraceDemoteLocalAsynchronous status + | Set.null failures -> Nothing + | otherwise -> Just failures + where + !failures = Map.keysSet status _ -> Nothing ) . selectGovEvents @@ -2917,14 +2946,14 @@ prop_governor_target_active_big_ledger_peers_below (MaxTime maxTime) env = -- There are no opportunities if we're at or above target. -- - promotionOpportunity target established active recentFailures inProgressDemoteToCold + promotionOpportunity target established active recentFailures inProgressIneligible | Set.size active >= target = Set.empty | otherwise = established Set.\\ active Set.\\ recentFailures - Set.\\ inProgressDemoteToCold + Set.\\ inProgressIneligible promotionOpportunities :: Signal (Set PeerAddr) promotionOpportunities = @@ -2933,12 +2962,12 @@ prop_governor_target_active_big_ledger_peers_below (MaxTime maxTime) env = <*> govEstablishedPeersSig <*> govActivePeersSig <*> govActiveFailuresSig - <*> govInProgressDemoteToColdSig + <*> govInProgressIneligibleSig promotionOpportunitiesIgnoredTooLong :: Signal (Set PeerAddr) promotionOpportunitiesIgnoredTooLong = Signal.keyedTimeout - (repromoteDelay config_REPROMOTE_DELAY + 20) -- seconds + (repromoteDelay config_REPROMOTE_DELAY + 1) -- seconds id promotionOpportunities @@ -2974,9 +3003,12 @@ prop_governor_target_established_above (MaxTime maxTime) env = (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty events - govInProgressDemoteToColdSig :: Signal (Set PeerAddr) - govInProgressDemoteToColdSig = - selectGovState Governor.inProgressDemoteToCold + govInProgressIneligibleSig :: Signal (Set PeerAddr) + govInProgressIneligibleSig = + selectGovState (\psState -> Set.unions [ Governor.inProgressDemoteToCold psState + , Governor.inProgressPromoteWarm psState + , Governor.inProgressDemoteWarm psState + ]) (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty events @@ -3004,14 +3036,15 @@ prop_governor_target_established_above (MaxTime maxTime) env = -- Otherwise the demotion opportunities are the established peers that -- are not active and not local root peers. -- - demotionOpportunity target local established active inProgressDemoteToCold + demotionOpportunity target local established active inProgressIneligible | Set.size established <= target = Set.empty | otherwise = established Set.\\ active Set.\\ LocalRootPeers.keysSet local - Set.\\ inProgressDemoteToCold + Set.\\ inProgressIneligible + demotionOpportunities :: Signal (Set PeerAddr) demotionOpportunities = demotionOpportunity @@ -3019,12 +3052,12 @@ prop_governor_target_established_above (MaxTime maxTime) env = <*> govLocalRootPeersSig <*> govEstablishedPeersSig <*> govActivePeersSig - <*> govInProgressDemoteToColdSig + <*> govInProgressIneligibleSig demotionOpportunitiesIgnoredTooLong :: Signal (Set PeerAddr) demotionOpportunitiesIgnoredTooLong = Signal.keyedTimeout - 10 -- seconds + 1 id demotionOpportunities @@ -3039,7 +3072,7 @@ prop_governor_target_established_above (MaxTime maxTime) env = <*> govEstablishedPeersSig <*> govActivePeersSig <*> demotionOpportunities - <*> govInProgressDemoteToColdSig + <*> govInProgressIneligibleSig <*> demotionOpportunitiesIgnoredTooLong) @@ -3072,9 +3105,12 @@ prop_governor_target_established_big_ledger_peers_above (MaxTime maxTime) env = (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty events - govInProgressDemoteToColdSig :: Signal (Set PeerAddr) - govInProgressDemoteToColdSig = - selectGovState Governor.inProgressDemoteToCold + govInProgressIneligibleSig :: Signal (Set PeerAddr) + govInProgressIneligibleSig = + selectGovState (\psState -> Set.unions [ Governor.inProgressDemoteToCold psState + , Governor.inProgressDemoteWarm psState + , Governor.inProgressPromoteWarm psState + ]) (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty events @@ -3088,25 +3124,26 @@ prop_governor_target_established_big_ledger_peers_above (MaxTime maxTime) env = -- Otherwise the demotion opportunities are the established peers that -- are not active and not local root peers. -- - demotionOpportunity target established active inProgressDemoteToCold + demotionOpportunity target established active inProgressIneligible | Set.size established <= target = Set.empty | otherwise = established Set.\\ active - Set.\\ inProgressDemoteToCold + Set.\\ inProgressIneligible + demotionOpportunities :: Signal (Set PeerAddr) demotionOpportunities = demotionOpportunity <$> govTargetsSig <*> govEstablishedPeersSig <*> govActivePeersSig - <*> govInProgressDemoteToColdSig + <*> govInProgressIneligibleSig demotionOpportunitiesIgnoredTooLong :: Signal (Set PeerAddr) demotionOpportunitiesIgnoredTooLong = Signal.keyedTimeout - 10 -- seconds + 1 id demotionOpportunities @@ -3153,19 +3190,20 @@ prop_governor_target_active_above (MaxTime maxTime) env = (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty events - govInProgressDemoteToColdSig :: Signal (Set PeerAddr) - govInProgressDemoteToColdSig = - selectGovState Governor.inProgressDemoteToCold + govInProgressIneligibleSig :: Signal (Set PeerAddr) + govInProgressIneligibleSig = + selectGovState (\psState -> Set.union (Governor.inProgressDemoteToCold psState) + (Governor.inProgressDemoteHot psState)) (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty events - demotionOpportunity target local active inProgressDemoteToCold - | (Set.size active - Set.size inProgressDemoteToCold) <= target + demotionOpportunity target local active inProgressIneligible + | Set.size active <= target = Set.empty | otherwise = active Set.\\ LocalRootPeers.keysSet local - Set.\\ inProgressDemoteToCold + Set.\\ inProgressIneligible demotionOpportunities :: Signal (Set PeerAddr) demotionOpportunities = @@ -3173,12 +3211,12 @@ prop_governor_target_active_above (MaxTime maxTime) env = <$> govTargetsSig <*> govLocalRootPeersSig <*> govActivePeersSig - <*> govInProgressDemoteToColdSig + <*> govInProgressIneligibleSig demotionOpportunitiesIgnoredTooLong :: Signal (Set PeerAddr) demotionOpportunitiesIgnoredTooLong = Signal.keyedTimeout - 15 -- seconds + 1 id demotionOpportunities @@ -3222,23 +3260,31 @@ prop_governor_target_active_big_ledger_peers_above (MaxTime maxTime) env = (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty events - demotionOpportunity target active + govInProgressIneligibleSig :: Signal (Set PeerAddr) + govInProgressIneligibleSig = + selectGovState (\psState -> Set.union (Governor.inProgressDemoteToCold psState) + (Governor.inProgressDemoteHot psState)) + (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + events + + demotionOpportunity target active inProgressIneligible | Set.size active <= target = Set.empty | otherwise - = active + = active Set.\\ inProgressIneligible demotionOpportunities :: Signal (Set PeerAddr) demotionOpportunities = demotionOpportunity <$> govTargetsSig <*> govActivePeersSig + <*> govInProgressIneligibleSig demotionOpportunitiesIgnoredTooLong :: Signal (Set PeerAddr) demotionOpportunitiesIgnoredTooLong = Signal.keyedTimeout - 10 -- seconds + 1 id demotionOpportunities @@ -3281,7 +3327,14 @@ prop_governor_target_established_local (MaxTime maxTime) env = govEstablishedPeersSig :: Signal (Set PeerAddr) govEstablishedPeersSig = selectGovState - (EstablishedPeers.toSet . Governor.establishedPeers) + (dropBigLedgerPeers $ EstablishedPeers.toSet . Governor.establishedPeers) + (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + events + + govEstablishedBigPeersSig :: Signal (Set PeerAddr) + govEstablishedBigPeersSig = + selectGovState + (takeBigLedgerPeers $ EstablishedPeers.toSet . Governor.establishedPeers) (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty events @@ -3296,28 +3349,30 @@ prop_governor_target_established_local (MaxTime maxTime) env = govEstablishedFailuresSig = Signal.keyedLinger 180 -- 3 minutes -- TODO: too eager to reconnect? - (fromMaybe Set.empty) + (Just . fromMaybe Set.empty) . Signal.fromEvents . Signal.selectEvents (\case TracePromoteColdFailed _ _ peer _ _ -> --TODO: the environment does not yet cause this to happen -- it requires synchronous failure in the establish action Just (Set.singleton peer) - --TODO: what about TraceDemoteWarmDone ? - -- these are also not immediate candidates - -- why does the property not fail for not tracking these? - TraceDemoteAsynchronous status + TracePromoteColdBigLedgerPeerFailed _ _ peer _ _ -> + Just (Set.singleton peer) + TraceDemoteLocalAsynchronous status | Set.null failures -> Nothing | otherwise -> Just failures where - failures = Map.keysSet (Map.filter (==PeerCooling) . fmap fst $ status) - TraceDemoteLocalAsynchronous status + !failures = Map.keysSet status + TraceDemoteBigLedgerPeersAsynchronous status | Set.null failures -> Nothing | otherwise -> Just failures where - failures = Map.keysSet (Map.filter (==PeerCooling) . fmap fst $ status) - TracePromoteWarmFailed _ _ peer _ -> - Just (Set.singleton peer) + !failures = Map.keysSet status + TraceDemoteAsynchronous status + | Set.null failures -> Nothing + | otherwise -> Just failures + where + !failures = Map.keysSet status _ -> Nothing ) . selectGovEvents @@ -3325,26 +3380,26 @@ prop_governor_target_established_local (MaxTime maxTime) env = promotionOpportunities :: Signal (Set PeerAddr) promotionOpportunities = - (\local established recentFailures inProgressPromoteCold -> - Set.unions - [ -- There are no opportunities if we're at or above target - if Set.size groupEstablished >= warmTarget' - then Set.empty - else group Set.\\ established - Set.\\ recentFailures - Set.\\ inProgressPromoteCold - | (_, WarmValency warmTarget', group) <- LocalRootPeers.toGroupSets local - , let groupEstablished = group `Set.intersection` established - ] + (\local established estBig recentFailures promoteCold -> + Set.unions + [opportunity + | (_, WarmValency warmTarget, group) <- LocalRootPeers.toGroupSets local + , let opportunity + | Set.size (Set.intersection + group (established `Set.union` estBig)) >= warmTarget = Set.empty + | otherwise = group + ] + Set.\\ Set.unions [established, estBig, recentFailures, promoteCold] ) <$> govLocalRootPeersSig <*> govEstablishedPeersSig + <*> govEstablishedBigPeersSig <*> govEstablishedFailuresSig <*> govInProgressPromoteColdSig promotionOpportunitiesIgnoredTooLong :: Signal (Set PeerAddr) promotionOpportunitiesIgnoredTooLong = Signal.keyedTimeout - 15 -- seconds + 1 -- seconds id promotionOpportunities @@ -3401,38 +3456,57 @@ prop_governor_target_active_local_below (MaxTime maxTime) env = govActivePeersSig :: Signal (Set PeerAddr) govActivePeersSig = - selectGovState Governor.activePeers + selectGovState (dropBigLedgerPeers Governor.activePeers) + (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + events + + govActiveBigPeersSig :: Signal (Set PeerAddr) + govActiveBigPeersSig = + selectGovState (takeBigLedgerPeers Governor.activePeers) (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty events - govInProgressDemoteToColdSig :: Signal (Set PeerAddr) - govInProgressDemoteToColdSig = - selectGovState Governor.inProgressDemoteToCold - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty - events + govInProgressIneligibleSig :: Signal (Set PeerAddr) + govInProgressIneligibleSig = + selectGovState (uncurry Set.union . ( Governor.inProgressDemoteToCold + &&& Governor.inProgressDemoteWarm)) + (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + events + + govInProgressPromoteWarmSig :: Signal (Set PeerAddr) + govInProgressPromoteWarmSig = + selectGovState Governor.inProgressPromoteWarm + (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + events govActiveFailuresSig :: Signal (Set PeerAddr) govActiveFailuresSig = Signal.keyedLinger 180 -- 3 minutes -- TODO: too eager to reconnect? - (fromMaybe Set.empty) + (Just . fromMaybe Set.empty) . Signal.fromEvents . Signal.selectEvents (\case TracePromoteWarmFailed _ _ peer _ -> --TODO: the environment does not yet cause this to happen -- it requires synchronous failure in the establish action Just (Set.singleton peer) - --TODO - TraceDemoteAsynchronous status + TracePromoteWarmBigLedgerPeerFailed _ _ peer _ -> + Just (Set.singleton peer) + TraceDemoteLocalAsynchronous status | Set.null failures -> Nothing | otherwise -> Just failures where - failures = Map.keysSet (Map.filter (==PeerWarm) . fmap fst $ status) - TraceDemoteLocalAsynchronous status + !failures = Map.keysSet status + TraceDemoteBigLedgerPeersAsynchronous status | Set.null failures -> Nothing | otherwise -> Just failures where - failures = Map.keysSet (Map.filter (==PeerWarm) . fmap fst $ status) + !failures = Map.keysSet status + TraceDemoteAsynchronous status + | Set.null failures -> Nothing + | otherwise -> Just failures + where + !failures = Map.keysSet status _ -> Nothing ) . selectGovEvents @@ -3440,28 +3514,28 @@ prop_governor_target_active_local_below (MaxTime maxTime) env = promotionOpportunities :: Signal (Set PeerAddr) promotionOpportunities = - (\local established active recentFailures inProgressDemoteToCold -> - Set.unions - [ -- There are no opportunities if we're at or above target - if Set.size groupActive >= hotTarget' - then Set.empty - else groupEstablished Set.\\ active - Set.\\ recentFailures - Set.\\ inProgressDemoteToCold - | (HotValency hotTarget', _, group) <- LocalRootPeers.toGroupSets local - , let groupActive = group `Set.intersection` active - groupEstablished = group `Set.intersection` established - ] + (\local established active actBig + recentFailures promoteWarm inProgressIneligible -> + Set.unions + [opportunity + | (HotValency hotTarget, _, group) <- LocalRootPeers.toGroupSets local + , let opportunity + | Set.size (group `Set.intersection` (active `Set.union` actBig)) >= hotTarget = Set.empty + | otherwise = group `Set.intersection` established + ] + Set.\\ Set.unions [active, actBig, recentFailures, promoteWarm, inProgressIneligible] ) <$> govLocalRootPeersSig <*> govEstablishedPeersSig <*> govActivePeersSig + <*> govActiveBigPeersSig <*> govActiveFailuresSig - <*> govInProgressDemoteToColdSig + <*> govInProgressPromoteWarmSig + <*> govInProgressIneligibleSig promotionOpportunitiesIgnoredTooLong :: Signal (Set PeerAddr) promotionOpportunitiesIgnoredTooLong = Signal.keyedTimeout - (repromoteDelay config_REPROMOTE_DELAY + 20) -- seconds + (repromoteDelay config_REPROMOTE_DELAY + 1) -- seconds id promotionOpportunities @@ -3502,26 +3576,34 @@ prop_governor_target_active_local_above (MaxTime maxTime) env = (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty events - deomotionOpportunities :: Signal (Set PeerAddr) - deomotionOpportunities = - (\local active -> + govInProgressIneligibleSig :: Signal (Set PeerAddr) + govInProgressIneligibleSig = + selectGovState (uncurry Set.union . ( Governor.inProgressDemoteToCold + &&& Governor.inProgressDemoteHot)) + (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + events + + demotionOpportunities :: Signal (Set PeerAddr) + demotionOpportunities = + (\local active inProgressIneligible -> Set.unions - [ -- There are no opportunities if we're at or below target - if Set.size groupActive <= hotTarget' - then Set.empty - else groupActive - | (HotValency hotTarget', _, group) <- LocalRootPeers.toGroupSets local + [opportunity + | (HotValency hotTarget, _, group) <- LocalRootPeers.toGroupSets local , let groupActive = group `Set.intersection` active - ] + opportunity + | Set.size groupActive <= hotTarget = Set.empty + | otherwise = groupActive + ] Set.\\ inProgressIneligible ) <$> govLocalRootPeersSig <*> govActivePeersSig + <*> govInProgressIneligibleSig demotionOpportunitiesIgnoredTooLong :: Signal (Set PeerAddr) demotionOpportunitiesIgnoredTooLong = Signal.keyedTimeout - 10 -- seconds + 1 id - deomotionOpportunities + demotionOpportunities in counterexample ("\nSignal key: (local peers, active peers, " ++ @@ -3531,7 +3613,7 @@ prop_governor_target_active_local_above (MaxTime maxTime) env = (\(_,_,_,toolong) -> Set.null toolong) ((,,,) <$> (LocalRootPeers.toGroupSets <$> govLocalRootPeersSig) <*> govActivePeersSig - <*> deomotionOpportunities + <*> demotionOpportunities <*> demotionOpportunitiesIgnoredTooLong) -- | When in 'TooOld' state make sure we don't stay connected to non trustable diff --git a/cardano-diffusion/tests/lib/Test/Cardano/Network/PeerSelection/MockEnvironment.hs b/cardano-diffusion/tests/lib/Test/Cardano/Network/PeerSelection/MockEnvironment.hs index f8f30cd19ae..dfe7d0e344b 100644 --- a/cardano-diffusion/tests/lib/Test/Cardano/Network/PeerSelection/MockEnvironment.hs +++ b/cardano-diffusion/tests/lib/Test/Cardano/Network/PeerSelection/MockEnvironment.hs @@ -529,10 +529,7 @@ mockPeerSelectionActions' tracer Cardano.PublicRootPeers.fromPublicRootPeers publicConfigPeers | otherwise -> PublicRootPeers.fromLedgerPeers ledgerPeers - BigLedgerPeers - | Set.null ledgerPeers -> - Cardano.PublicRootPeers.fromPublicRootPeers publicConfigPeers - | otherwise -> + BigLedgerPeers -> PublicRootPeers.fromBigLedgerPeers bigLedgerPeers traceWith tracer (TraceEnvRootsResult (Set.toList (PublicRootPeers.toSet Cardano.ExtraPeers.toSet result))) diff --git a/ouroboros-network/lib/Ouroboros/Network/PeerSelection/Governor/EstablishedPeers.hs b/ouroboros-network/lib/Ouroboros/Network/PeerSelection/Governor/EstablishedPeers.hs index e33c3748856..ea15d647baf 100644 --- a/ouroboros-network/lib/Ouroboros/Network/PeerSelection/Governor/EstablishedPeers.hs +++ b/ouroboros-network/lib/Ouroboros/Network/PeerSelection/Governor/EstablishedPeers.hs @@ -501,6 +501,7 @@ jobPromoteColdPeer PeerSelectionActions { (fuzz, stdGen') = randomR (-2, 2 :: Double) stdGen -- exponential backoff: 5s, 10s, 20s, 40s, 80s, 160s. + -- Don't forget to change in diffusion tests if changed here delay :: DiffTime delay = realToFrac fuzz + fromIntegral From f31aa8a9b1385062c9222ec0698fdb0a57b7af1b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marcin=20W=C3=B3jtowicz?= Date: Mon, 20 Oct 2025 10:14:09 +0200 Subject: [PATCH 10/12] peer-selection: bugfix repromote fuzz delay and improve readyPeers --- .../Ouroboros/Network/PeerSelection/Governor/Monitor.hs | 7 ++++--- .../Network/PeerSelection/State/EstablishedPeers.hs | 5 +---- 2 files changed, 5 insertions(+), 7 deletions(-) diff --git a/ouroboros-network/lib/Ouroboros/Network/PeerSelection/Governor/Monitor.hs b/ouroboros-network/lib/Ouroboros/Network/PeerSelection/Governor/Monitor.hs index 652c5b7df07..875cfef0128 100644 --- a/ouroboros-network/lib/Ouroboros/Network/PeerSelection/Governor/Monitor.hs +++ b/ouroboros-network/lib/Ouroboros/Network/PeerSelection/Governor/Monitor.hs @@ -140,9 +140,7 @@ connections PeerSelectionActions{ (EstablishedPeers.toMap establishedPeers) let demotions = asynchronousDemotions monitorStatus check (not (Map.null demotions)) - let (demotedToWarm, demotedToCoolingOrCold) = Map.partition ((==PeerWarm) . fst) demotions - (demotedToCold, demotedToCooling) = Map.partition ((==PeerCold) . fst) demotedToCoolingOrCold - -- fuzz reconnect delays + let -- fuzz reconnect delays (aFuzz, stdGen') = randomR (0.1, 10 :: Double) stdGen (rFuzz, stdGen'') = randomR (0.1, 4 :: Double) stdGen' demotions' = (\a@(peerState, repromoteDelay) -> case peerState of @@ -157,6 +155,9 @@ connections PeerSelectionActions{ , (\x -> (x + realToFrac rFuzz) `max` 0) <$> repromoteDelay ) ) <$> demotions + (demotedToWarm, demotedToCoolingOrCold) = Map.partition ((==PeerWarm) . fst) demotions' + (demotedToCold, demotedToCooling) = Map.partition ((==PeerCold) . fst) demotedToCoolingOrCold + return $ \now -> let -- Remove all asynchronous demotions from 'activePeers' activePeers' = activePeers Set.\\ Map.keysSet demotions' diff --git a/ouroboros-network/lib/Ouroboros/Network/PeerSelection/State/EstablishedPeers.hs b/ouroboros-network/lib/Ouroboros/Network/PeerSelection/State/EstablishedPeers.hs index 1fd96c5f7e6..d4de078a7d9 100644 --- a/ouroboros-network/lib/Ouroboros/Network/PeerSelection/State/EstablishedPeers.hs +++ b/ouroboros-network/lib/Ouroboros/Network/PeerSelection/State/EstablishedPeers.hs @@ -132,10 +132,7 @@ readyPeers :: Ord peeraddr => EstablishedPeers peeraddr peerconn -> Set peeraddr readyPeers EstablishedPeers { allPeers, nextActivateTimes } = - PSQ.fold' - (\peeraddr _ _ -> Set.delete peeraddr) - (Map.keysSet allPeers) - nextActivateTimes + Map.keysSet allPeers `Set.difference` Set.fromList (PSQ.keys nextActivateTimes) -- | The number of established peers. The size of 'allPeers' From abe1c923e87907a8ea0f1cb4290ad2ae97fd09e4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marcin=20W=C3=B3jtowicz?= Date: Wed, 22 Oct 2025 12:49:59 +0200 Subject: [PATCH 11/12] testing: peerselection formatting --- .../lib/Test/Cardano/Network/PeerSelection.hs | 435 +++++++++++++----- 1 file changed, 326 insertions(+), 109 deletions(-) diff --git a/cardano-diffusion/tests/lib/Test/Cardano/Network/PeerSelection.hs b/cardano-diffusion/tests/lib/Test/Cardano/Network/PeerSelection.hs index e385986f9b4..1c9b9a67410 100644 --- a/cardano-diffusion/tests/lib/Test/Cardano/Network/PeerSelection.hs +++ b/cardano-diffusion/tests/lib/Test/Cardano/Network/PeerSelection.hs @@ -1201,19 +1201,25 @@ prop_governor_target_root_below env = govTargetsSig :: Signal Int govTargetsSig = selectGovState (targetNumberOfRootPeers . Governor.targets) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govLocalRootPeersSig :: Signal (Set PeerAddr) govLocalRootPeersSig = selectGovState (LocalRootPeers.keysSet . Governor.localRootPeers) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govPublicRootPeersSig :: Signal (Set PeerAddr) govPublicRootPeersSig = selectGovState (PublicRootPeers.toSet Cardano.ExtraPeers.toSet . Governor.publicRootPeers) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govRootPeersSig :: Signal (Set PeerAddr) @@ -1276,21 +1282,27 @@ prop_governor_target_established_public (MaxTime maxTime) env = govPublicRootPeersSig :: Signal (Set PeerAddr) govPublicRootPeersSig = selectGovState (PublicRootPeers.toSet Cardano.ExtraPeers.toSet . Governor.publicRootPeers) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govEstablishedPeersSig :: Signal (Set PeerAddr) govEstablishedPeersSig = selectGovState (EstablishedPeers.toSet . Governor.establishedPeers) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govInProgressPromoteColdSig :: Signal (Set PeerAddr) govInProgressPromoteColdSig = selectGovState Governor.inProgressPromoteCold - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events publicInEstablished :: Signal Bool @@ -1342,27 +1354,35 @@ prop_governor_target_established_big_ledger_peers (MaxTime maxTime) env = govBigLedgerPeersSig :: Signal (Set PeerAddr) govBigLedgerPeersSig = selectGovState (PublicRootPeers.getBigLedgerPeers . Governor.publicRootPeers) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govLedgerStateJudgement :: Signal LedgerStateJudgement govLedgerStateJudgement = selectGovState (Cardano.ledgerStateJudgement . Governor.extraState) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govEstablishedPeersSig :: Signal (Set PeerAddr) govEstablishedPeersSig = selectGovState (EstablishedPeers.toSet . Governor.establishedPeers) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govInProgressPromoteColdSig :: Signal (Set PeerAddr) govInProgressPromoteColdSig = selectGovState Governor.inProgressPromoteCold - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events bigLedgerPeersInEstablished :: Signal Bool @@ -1415,13 +1435,17 @@ prop_governor_target_active_public (MaxTime maxTime) env = govPublicRootPeersSig :: Signal (Set PeerAddr) govPublicRootPeersSig = selectGovState (PublicRootPeers.toSet Cardano.ExtraPeers.toSet . Governor.publicRootPeers) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govActivePeersSig :: Signal (Set PeerAddr) govActivePeersSig = selectGovState Governor.activePeers - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events publicInActive :: Signal Bool @@ -1636,7 +1660,9 @@ prop_governor_target_known_1_valid_subset (MaxTime maxTime) env = govKnownPeersSig :: Signal (Set PeerAddr) govKnownPeersSig = selectGovState (KnownPeers.toSet . Governor.knownPeers) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events validState :: Set PeerAddr -> Set PeerAddr -> Bool @@ -1697,13 +1723,17 @@ prop_governor_target_known_2_opportunity_taken (MaxTime maxTime) env = govTargetsSig :: Signal Int govTargetsSig = selectGovState (targetNumberOfKnownPeers . Governor.targets) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govKnownPeersSig :: Signal (Set PeerAddr) govKnownPeersSig = selectGovState (KnownPeers.toSet . Governor.knownPeers) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events -- Available Established Peers are those who have correct PeerSharing @@ -1717,7 +1747,9 @@ prop_governor_target_known_2_opportunity_taken (MaxTime maxTime) env = (Governor.establishedPeers x) Set.\\ (Governor.inProgressDemoteToCold x)) (Governor.knownPeers x)) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events -- Note that we only require that the governor try to peer share, it does @@ -1743,13 +1775,17 @@ prop_governor_target_known_2_opportunity_taken (MaxTime maxTime) env = govLedgerStateJudgementSig :: Signal LedgerStateJudgement govLedgerStateJudgementSig = selectGovState (Cardano.ExtraState.ledgerStateJudgement . Governor.extraState) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govUseBootstrapPeersSig :: Signal UseBootstrapPeers govUseBootstrapPeersSig = selectGovState (Cardano.ExtraState.bootstrapPeersFlag . Governor.extraState) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events -- We define the governor's peer sharing opportunities at any point in time @@ -2070,13 +2106,17 @@ prop_governor_target_known_4_results_used (MaxTime maxTime) env = govTargetsSig :: Signal Int govTargetsSig = selectGovState (targetNumberOfKnownPeers . Governor.targets) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govKnownPeersSig :: Signal (Set PeerAddr) govKnownPeersSig = selectGovState (KnownPeers.toSet . Governor.knownPeers) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events envPeerShareResultsSig :: Signal (Set PeerAddr) @@ -2153,25 +2193,33 @@ prop_governor_target_known_5_no_shrink_below (MaxTime maxTime) env = govTargetsSig :: Signal Int govTargetsSig = selectGovState (targetNumberOfKnownPeers . Governor.targets) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govKnownPeersSig :: Signal (Set PeerAddr) govKnownPeersSig = selectGovState (KnownPeers.toSet . Governor.knownPeers) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events bigLedgerPeersSig :: Signal (Set PeerAddr) bigLedgerPeersSig = selectGovState (PublicRootPeers.getBigLedgerPeers . Governor.publicRootPeers) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events bootstrapPeersSig :: Signal (Set PeerAddr) bootstrapPeersSig = selectGovState (Cardano.PublicRootPeers.getBootstrapPeers . Governor.publicRootPeers) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events knownPeersShrinksSig :: Signal (Set PeerAddr) @@ -2236,14 +2284,18 @@ prop_governor_target_known_5_no_shrink_big_ledger_peers_below (MaxTime maxTime) govTargetsSig :: Signal Int govTargetsSig = selectGovState (targetNumberOfKnownBigLedgerPeers . Governor.targets) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govKnownPeersSig :: Signal (Set PeerAddr) govKnownPeersSig = selectGovState (takeBigLedgerPeers $ KnownPeers.toSet . Governor.knownPeers) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events knownPeersShrinksSig :: Signal (Set PeerAddr) @@ -2320,39 +2372,51 @@ prop_governor_target_known_above (MaxTime maxTime) env = govTargetsSig :: Signal PeerSelectionTargets govTargetsSig = selectGovState Governor.targets - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govLocalRootPeersSig :: Signal (Set PeerAddr) govLocalRootPeersSig = selectGovState (LocalRootPeers.keysSet . Governor.localRootPeers) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govPublicRootPeersSig :: Signal (Set PeerAddr) govPublicRootPeersSig = selectGovState (PublicRootPeers.toSet Cardano.ExtraPeers.toSet . Governor.publicRootPeers) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govKnownPeersSig :: Signal (Set PeerAddr) govKnownPeersSig = selectGovState (dropBigLedgerPeers $ KnownPeers.toSet . Governor.knownPeers) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govEstablishedPeersSig :: Signal (Set PeerAddr) govEstablishedPeersSig = selectGovState (dropBigLedgerPeers $ EstablishedPeers.toSet . Governor.establishedPeers) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govInProgressIneligibleSig :: Signal (Set PeerAddr) govInProgressIneligibleSig = selectGovState Governor.inProgressPromoteCold - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events -- There are no demotion opportunities if we're at or below target. @@ -2430,27 +2494,35 @@ prop_governor_target_known_big_ledger_peers_above (MaxTime maxTime) env = govTargetsSig :: Signal PeerSelectionTargets govTargetsSig = selectGovState Governor.targets - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govKnownPeersSig :: Signal (Set PeerAddr) govKnownPeersSig = selectGovState (takeBigLedgerPeers $ KnownPeers.toSet . Governor.knownPeers) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govEstablishedPeersSig :: Signal (Set PeerAddr) govEstablishedPeersSig = selectGovState (takeBigLedgerPeers $ EstablishedPeers.toSet . Governor.establishedPeers) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govInProgressIneligibleSig :: Signal (Set PeerAddr) govInProgressIneligibleSig = selectGovState Governor.inProgressPromoteCold - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events -- There are no demotion opportunities if we're at or below target. @@ -2537,20 +2609,26 @@ prop_governor_target_established_below (MaxTime maxTime) env = govTargetsSig :: Signal Int govTargetsSig = selectGovState (targetNumberOfEstablishedPeers . Governor.targets) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govLocalRootPeersSig :: Signal (LocalRootPeers.LocalRootPeers PeerTrustable PeerAddr) govLocalRootPeersSig = selectGovState Governor.localRootPeers - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govKnownPeersSig :: Signal (Set PeerAddr) govKnownPeersSig = selectGovState (dropBigLedgerPeers $ KnownPeers.toSet . Governor.knownPeers) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govEstablishedPeersSig :: Signal (Set PeerAddr) @@ -2558,13 +2636,17 @@ prop_governor_target_established_below (MaxTime maxTime) env = selectGovState (dropBigLedgerPeers $ EstablishedPeers.toSet . Governor.establishedPeers) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govInProgressPromoteColdSig :: Signal (Set PeerAddr) govInProgressPromoteColdSig = selectGovState (dropBigLedgerPeers Governor.inProgressPromoteCold) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govEstablishedFailuresSig :: Signal (Set PeerAddr) @@ -2653,14 +2735,18 @@ prop_governor_target_established_big_ledger_peers_below (MaxTime maxTime) env = govTargetsSig :: Signal Int govTargetsSig = selectGovState (targetNumberOfEstablishedBigLedgerPeers . Governor.targets) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govKnownPeersSig :: Signal (Set PeerAddr) govKnownPeersSig = selectGovState (takeBigLedgerPeers $ KnownPeers.toSet . Governor.knownPeers) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govEstablishedPeersSig :: Signal (Set PeerAddr) @@ -2668,7 +2754,9 @@ prop_governor_target_established_big_ledger_peers_below (MaxTime maxTime) env = selectGovState (takeBigLedgerPeers $ EstablishedPeers.toSet . Governor.establishedPeers) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govEstablishedFailuresSig :: Signal (Set PeerAddr) @@ -2700,7 +2788,9 @@ prop_governor_target_established_big_ledger_peers_below (MaxTime maxTime) env = govInProgressIneligibleSig :: Signal (Set PeerAddr) govInProgressIneligibleSig = selectGovState (takeBigLedgerPeers Governor.inProgressPromoteCold) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events -- There are no opportunities if we're at or above target @@ -2761,13 +2851,17 @@ prop_governor_target_active_below (MaxTime maxTime) env = govTargetsSig :: Signal Int govTargetsSig = selectGovState (targetNumberOfActivePeers . Governor.targets) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govLocalRootPeersSig :: Signal (LocalRootPeers.LocalRootPeers PeerTrustable PeerAddr) govLocalRootPeersSig = selectGovState Governor.localRootPeers - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govInProgressIneligibleSig :: Signal (Set PeerAddr) @@ -2776,7 +2870,9 @@ prop_governor_target_active_below (MaxTime maxTime) env = , Governor.inProgressPromoteWarm psState , Governor.inProgressDemoteWarm psState ]) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govEstablishedPeersSig :: Signal (Set PeerAddr) @@ -2784,13 +2880,17 @@ prop_governor_target_active_below (MaxTime maxTime) env = selectGovState (dropBigLedgerPeers $ EstablishedPeers.toSet . Governor.establishedPeers) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govActivePeersSig :: Signal (Set PeerAddr) govActivePeersSig = selectGovState Governor.activePeers - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govActiveFailuresSig :: Signal (Set PeerAddr) @@ -2892,7 +2992,9 @@ prop_governor_target_active_big_ledger_peers_below (MaxTime maxTime) env = govTargetsSig :: Signal Int govTargetsSig = selectGovState (targetNumberOfActiveBigLedgerPeers . Governor.targets) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govEstablishedPeersSig :: Signal (Set PeerAddr) @@ -2900,7 +3002,9 @@ prop_governor_target_active_big_ledger_peers_below (MaxTime maxTime) env = selectGovState (takeBigLedgerPeers $ EstablishedPeers.toSet . Governor.establishedPeers) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govInProgressIneligibleSig :: Signal (Set PeerAddr) @@ -2909,13 +3013,17 @@ prop_governor_target_active_big_ledger_peers_below (MaxTime maxTime) env = , Governor.inProgressPromoteWarm psState , Governor.inProgressDemoteWarm psState ]) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govActivePeersSig :: Signal (Set PeerAddr) govActivePeersSig = selectGovState (takeBigLedgerPeers Governor.activePeers) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govActiveFailuresSig :: Signal (Set PeerAddr) @@ -3000,7 +3108,9 @@ prop_governor_target_established_above (MaxTime maxTime) env = govTargetsSig :: Signal Int govTargetsSig = selectGovState (targetNumberOfEstablishedPeers . Governor.targets) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govInProgressIneligibleSig :: Signal (Set PeerAddr) @@ -3009,13 +3119,17 @@ prop_governor_target_established_above (MaxTime maxTime) env = , Governor.inProgressPromoteWarm psState , Governor.inProgressDemoteWarm psState ]) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govLocalRootPeersSig :: Signal (LocalRootPeers.LocalRootPeers PeerTrustable PeerAddr) govLocalRootPeersSig = selectGovState Governor.localRootPeers - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govEstablishedPeersSig :: Signal (Set PeerAddr) @@ -3023,13 +3137,17 @@ prop_governor_target_established_above (MaxTime maxTime) env = selectGovState (dropBigLedgerPeers $ EstablishedPeers.toSet . Governor.establishedPeers) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govActivePeersSig :: Signal (Set PeerAddr) govActivePeersSig = selectGovState (dropBigLedgerPeers Governor.activePeers) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events -- There are no demotion opportunities if we're at or below target. @@ -3094,7 +3212,9 @@ prop_governor_target_established_big_ledger_peers_above (MaxTime maxTime) env = govTargetsSig :: Signal Int govTargetsSig = selectGovState (targetNumberOfEstablishedBigLedgerPeers . Governor.targets) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govEstablishedPeersSig :: Signal (Set PeerAddr) @@ -3102,7 +3222,9 @@ prop_governor_target_established_big_ledger_peers_above (MaxTime maxTime) env = selectGovState (takeBigLedgerPeers $ EstablishedPeers.toSet . Governor.establishedPeers) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govInProgressIneligibleSig :: Signal (Set PeerAddr) @@ -3111,13 +3233,17 @@ prop_governor_target_established_big_ledger_peers_above (MaxTime maxTime) env = , Governor.inProgressDemoteWarm psState , Governor.inProgressPromoteWarm psState ]) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govActivePeersSig :: Signal (Set PeerAddr) govActivePeersSig = selectGovState (takeBigLedgerPeers Governor.activePeers) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events -- There are no demotion opportunities if we're at or below target. @@ -3175,26 +3301,34 @@ prop_governor_target_active_above (MaxTime maxTime) env = govTargetsSig :: Signal Int govTargetsSig = selectGovState (targetNumberOfActivePeers . Governor.targets) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govLocalRootPeersSig :: Signal (LocalRootPeers.LocalRootPeers PeerTrustable PeerAddr) govLocalRootPeersSig = selectGovState Governor.localRootPeers - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govActivePeersSig :: Signal (Set PeerAddr) govActivePeersSig = selectGovState (dropBigLedgerPeers Governor.activePeers) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govInProgressIneligibleSig :: Signal (Set PeerAddr) govInProgressIneligibleSig = selectGovState (\psState -> Set.union (Governor.inProgressDemoteToCold psState) (Governor.inProgressDemoteHot psState)) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events demotionOpportunity target local active inProgressIneligible @@ -3251,20 +3385,26 @@ prop_governor_target_active_big_ledger_peers_above (MaxTime maxTime) env = govTargetsSig :: Signal Int govTargetsSig = selectGovState (targetNumberOfActiveBigLedgerPeers . Governor.targets) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govActivePeersSig :: Signal (Set PeerAddr) govActivePeersSig = selectGovState (takeBigLedgerPeers Governor.activePeers) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govInProgressIneligibleSig :: Signal (Set PeerAddr) govInProgressIneligibleSig = selectGovState (\psState -> Set.union (Governor.inProgressDemoteToCold psState) (Governor.inProgressDemoteHot psState)) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events demotionOpportunity target active inProgressIneligible @@ -3321,28 +3461,36 @@ prop_governor_target_established_local (MaxTime maxTime) env = govLocalRootPeersSig :: Signal (LocalRootPeers PeerTrustable PeerAddr) govLocalRootPeersSig = selectGovState Governor.localRootPeers - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govEstablishedPeersSig :: Signal (Set PeerAddr) govEstablishedPeersSig = selectGovState (dropBigLedgerPeers $ EstablishedPeers.toSet . Governor.establishedPeers) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govEstablishedBigPeersSig :: Signal (Set PeerAddr) govEstablishedBigPeersSig = selectGovState (takeBigLedgerPeers $ EstablishedPeers.toSet . Governor.establishedPeers) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govInProgressPromoteColdSig :: Signal (Set PeerAddr) govInProgressPromoteColdSig = selectGovState Governor.inProgressPromoteCold - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govEstablishedFailuresSig :: Signal (Set PeerAddr) @@ -3444,39 +3592,51 @@ prop_governor_target_active_local_below (MaxTime maxTime) env = govLocalRootPeersSig :: Signal (LocalRootPeers.LocalRootPeers PeerTrustable PeerAddr) govLocalRootPeersSig = selectGovState Governor.localRootPeers - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govEstablishedPeersSig :: Signal (Set PeerAddr) govEstablishedPeersSig = selectGovState (EstablishedPeers.toSet . Governor.establishedPeers) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govActivePeersSig :: Signal (Set PeerAddr) govActivePeersSig = selectGovState (dropBigLedgerPeers Governor.activePeers) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govActiveBigPeersSig :: Signal (Set PeerAddr) govActiveBigPeersSig = selectGovState (takeBigLedgerPeers Governor.activePeers) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govInProgressIneligibleSig :: Signal (Set PeerAddr) govInProgressIneligibleSig = selectGovState (uncurry Set.union . ( Governor.inProgressDemoteToCold &&& Governor.inProgressDemoteWarm)) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govInProgressPromoteWarmSig :: Signal (Set PeerAddr) govInProgressPromoteWarmSig = selectGovState Governor.inProgressPromoteWarm - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govActiveFailuresSig :: Signal (Set PeerAddr) @@ -3567,20 +3727,26 @@ prop_governor_target_active_local_above (MaxTime maxTime) env = govLocalRootPeersSig :: Signal (LocalRootPeers.LocalRootPeers PeerTrustable PeerAddr) govLocalRootPeersSig = selectGovState Governor.localRootPeers - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govActivePeersSig :: Signal (Set PeerAddr) govActivePeersSig = selectGovState Governor.activePeers - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govInProgressIneligibleSig :: Signal (Set PeerAddr) govInProgressIneligibleSig = selectGovState (uncurry Set.union . ( Governor.inProgressDemoteToCold &&& Governor.inProgressDemoteHot)) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events demotionOpportunities :: Signal (Set PeerAddr) @@ -3632,19 +3798,25 @@ prop_governor_only_bootstrap_peers_in_fallback_state env = govUseBootstrapPeers :: Signal UseBootstrapPeers govUseBootstrapPeers = selectGovState (Cardano.ExtraState.bootstrapPeersFlag . Governor.extraState) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govLedgerStateJudgement :: Signal LedgerStateJudgement govLedgerStateJudgement = selectGovState (Cardano.ExtraState.ledgerStateJudgement . Governor.extraState) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govKnownPeers :: Signal (Set PeerAddr) govKnownPeers = selectGovState (KnownPeers.toSet . Governor.knownPeers) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govTrustedPeers :: Signal (Set PeerAddr) @@ -3653,7 +3825,9 @@ prop_governor_only_bootstrap_peers_in_fallback_state env = (\st -> LocalRootPeers.keysSet (LocalRootPeers.clampToTrustable (Governor.localRootPeers st)) <> Cardano.PublicRootPeers.getBootstrapPeers (Governor.publicRootPeers st) ) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events keepNonTrustablePeersTooLong :: Signal (Set PeerAddr) @@ -3691,19 +3865,25 @@ prop_governor_no_non_trustable_peers_before_caught_up_state env = govUseBootstrapPeers :: Signal UseBootstrapPeers govUseBootstrapPeers = selectGovState (Cardano.ExtraState.bootstrapPeersFlag . Governor.extraState) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govLedgerStateJudgement :: Signal LedgerStateJudgement govLedgerStateJudgement = selectGovState (Cardano.ExtraState.ledgerStateJudgement . Governor.extraState) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govKnownPeers :: Signal (Set PeerAddr) govKnownPeers = selectGovState (KnownPeers.toSet . Governor.knownPeers) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govTrustedPeers :: Signal (Set PeerAddr) @@ -3712,13 +3892,17 @@ prop_governor_no_non_trustable_peers_before_caught_up_state env = (\st -> LocalRootPeers.keysSet (LocalRootPeers.clampToTrustable (Governor.localRootPeers st)) <> Cardano.PublicRootPeers.getBootstrapPeers (Governor.publicRootPeers st) ) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govHasOnlyBootstrapPeers :: Signal Bool govHasOnlyBootstrapPeers = selectGovState (Cardano.ExtraState.hasOnlyBootstrapPeers . Governor.extraState) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events keepNonTrustablePeersTooLong :: Signal (Set PeerAddr) @@ -3759,13 +3943,17 @@ prop_governor_only_bootstrap_peers_in_clean_state env = govUseBootstrapPeers :: Signal UseBootstrapPeers govUseBootstrapPeers = selectGovState (Cardano.ExtraState.bootstrapPeersFlag . Governor.extraState) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govLedgerStateJudgement :: Signal LedgerStateJudgement govLedgerStateJudgement = selectGovState (Cardano.ExtraState.ledgerStateJudgement . Governor.extraState) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govKnownAndTrustedPeers :: Signal (Set PeerAddr, Set PeerAddr) @@ -3778,7 +3966,9 @@ prop_governor_only_bootstrap_peers_in_clean_state env = <> Cardano.PublicRootPeers.getBootstrapPeers (Governor.publicRootPeers st) ) ) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events configTrustedLocalRoots :: Signal (Set PeerAddr) @@ -3799,7 +3989,9 @@ prop_governor_only_bootstrap_peers_in_clean_state env = govHasOnlyBootstrapPeers :: Signal Bool govHasOnlyBootstrapPeers = selectGovState (Cardano.hasOnlyBootstrapPeers . Governor.extraState) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events isInCleanState :: Signal Bool @@ -3863,25 +4055,33 @@ prop_governor_stops_using_bootstrap_peers env = govUseBootstrapPeers :: Signal UseBootstrapPeers govUseBootstrapPeers = selectGovState (Cardano.bootstrapPeersFlag . Governor.extraState) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govLedgerStateJudgement :: Signal LedgerStateJudgement govLedgerStateJudgement = selectGovState (Cardano.ledgerStateJudgement . Governor.extraState) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govKnownPeers :: Signal (Set PeerAddr) govKnownPeers = selectGovState (KnownPeers.toSet . Governor.knownPeers) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govBootstrapPeers :: Signal (Set PeerAddr) govBootstrapPeers = selectGovState (Cardano.PublicRootPeers.getBootstrapPeers . Governor.publicRootPeers) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govTrustableLocalRootPeers :: Signal (Set PeerAddr) @@ -3889,7 +4089,9 @@ prop_governor_stops_using_bootstrap_peers env = selectGovState (\st -> LocalRootPeers.keysSet (LocalRootPeers.clampToTrustable (Governor.localRootPeers st)) ) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events keepBootstrapPeersTooLong :: Signal (Set ()) @@ -3933,13 +4135,17 @@ prop_governor_uses_ledger_peers env = govUseBootstrapPeers :: Signal UseBootstrapPeers govUseBootstrapPeers = selectGovState (Cardano.bootstrapPeersFlag . Governor.extraState) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govLedgerStateJudgement :: Signal LedgerStateJudgement govLedgerStateJudgement = selectGovState (Cardano.ledgerStateJudgement . Governor.extraState) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events govPublicRootPeersResultsSig :: Signal (PublicRootPeers (Cardano.ExtraPeers PeerAddr) PeerAddr) @@ -3981,10 +4187,15 @@ prop_governor_association_mode env = . runGovernorInMockEnvironment $ env - counters :: Signal (PeerSelectionSetsWithSizes (Cardano.ExtraPeerSelectionSetsWithSizes PeerAddr) PeerAddr) + counters + :: Signal (PeerSelectionSetsWithSizes + (Cardano.ExtraPeerSelectionSetsWithSizes PeerAddr) PeerAddr) counters = - selectGovState (peerSelectionStateToView Cardano.ExtraPeers.toSet Cardano.ExtraSizes.cardanoPeerSelectionStatetoCounters) - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + selectGovState (peerSelectionStateToView Cardano.ExtraPeers.toSet + Cardano.ExtraSizes.cardanoPeerSelectionStatetoCounters) + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty events -- accumulate local roots @@ -4009,7 +4220,9 @@ prop_governor_association_mode env = (\_ -> Set.empty) (\_ -> False) . selectGovState Governor.publicRootPeers - (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + (Cardano.ExtraState.empty (consensusMode env) + (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty $ events associationMode :: Signal AssociationMode @@ -4067,10 +4280,14 @@ _governorFindingPublicRoots :: Int -> StrictTVar IO OutboundConnectionsState -> ConsensusMode -> IO Void -_governorFindingPublicRoots targetNumberOfRootPeers readDomains readUseBootstrapPeers readLedgerStateJudgement peerSharing olocVar consensusMode = do +_governorFindingPublicRoots targetNumberOfRootPeers readDomains readUseBootstrapPeers + readLedgerStateJudgement peerSharing olocVar consensusMode = do countersVar <- newTVarIO (emptyPeerSelectionCounters Cardano.ExtraSizes.empty) publicStateVar <- makePublicPeerSelectionStateVar - debugStateVar <- newTVarIO $ emptyPeerSelectionState (mkStdGen 42) (Cardano.ExtraState.empty consensusMode (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty + debugStateVar <- newTVarIO $ + emptyPeerSelectionState (mkStdGen 42) + (Cardano.ExtraState.empty consensusMode (NumberOfBigLedgerPeers 0)) + Cardano.ExtraPeers.empty dnsSemaphore <- newLedgerAndPublicRootDNSSemaphore let interfaces = PeerSelectionInterfaces { countersVar, From 0ddc581944f3e627a264e7bc1b7f0924997dc6a3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marcin=20W=C3=B3jtowicz?= Date: Wed, 8 Oct 2025 20:56:36 +0200 Subject: [PATCH 12/12] scriv --- ...0_crocodile-dentist_test_false_positive.md | 16 ++++++++++++ ...6_crocodile-dentist_test_false_positive.md | 25 +++++++++++++++++++ 2 files changed, 41 insertions(+) create mode 100644 cardano-diffusion/changelog.d/20251013_152200_crocodile-dentist_test_false_positive.md create mode 100644 ouroboros-network/changelog.d/20251004_134906_crocodile-dentist_test_false_positive.md diff --git a/cardano-diffusion/changelog.d/20251013_152200_crocodile-dentist_test_false_positive.md b/cardano-diffusion/changelog.d/20251013_152200_crocodile-dentist_test_false_positive.md new file mode 100644 index 00000000000..ea4bf9a51a9 --- /dev/null +++ b/cardano-diffusion/changelog.d/20251013_152200_crocodile-dentist_test_false_positive.md @@ -0,0 +1,16 @@ + + + + +### Non-Breaking + +- fixed false positive in `prop_diffusion_target_active_below` testnet test +- improved approach in general to target-chasing tests in diffusion testnet + and PeerSelection mock environment tests. diff --git a/ouroboros-network/changelog.d/20251004_134906_crocodile-dentist_test_false_positive.md b/ouroboros-network/changelog.d/20251004_134906_crocodile-dentist_test_false_positive.md new file mode 100644 index 00000000000..df4f486d4d7 --- /dev/null +++ b/ouroboros-network/changelog.d/20251004_134906_crocodile-dentist_test_false_positive.md @@ -0,0 +1,25 @@ + + +### Breaking + +- `linger` function's arm callback now returns a `Maybe Bool` +- `keyedLinger'`s arm callback now returns a `Maybe (Set b)` +- `keyedLinger'`'s arm callback now returns a `Maybe (Set b, DiffTime))` +- The above changes allow those functions to reset signal state on `Nothing` + +### Non-Breaking + +- Added latch function to `Signal` +- bugfix missed promotion/demotion opportunities in: + - `ActivePeers.aboveTargetBigLedgerPeers` + - `ActivePeers.aboveTargetOther` + - `EstablishedPeers.aboveTargetOther` + - `EstablishedPeers.aboveTargetBigLedgerPeers` + - `EstablishedPeers.belowTargetLocal` + - `EstablishedPeers.belowTargetOther` + - `ActivePeers.belowTargetLocal`