diff --git a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/PeerSelection.hs b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/PeerSelection.hs index 32107ca780..5c9dc32bd6 100644 --- a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/PeerSelection.hs +++ b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/PeerSelection.hs @@ -81,7 +81,8 @@ import Ouroboros.Network.Testing.Data.Script import Ouroboros.Network.Testing.Data.Signal (E (E), Events, Signal, TS (TS), signalProperty) import Ouroboros.Network.Testing.Data.Signal qualified as Signal -import Ouroboros.Network.Testing.Utils (nightlyTest) +import Ouroboros.Network.Testing.Utils (disjointSetsProperty, isSubsetProperty, + nightlyTest) import Test.Ouroboros.Network.PeerSelection.Instances import Test.Ouroboros.Network.PeerSelection.MockEnvironment hiding (tests) import Test.Ouroboros.Network.PeerSelection.PeerGraph @@ -101,7 +102,10 @@ unfHydra = 1 tests :: TestTree tests = testGroup "Ouroboros.Network.PeerSelection" - [ testGroup "basic" + [ testGroup "PeerSelectionView" + [ testProperty "sizes" prop_peerSelectionView_sizes + ] + , testGroup "basic" [ testProperty "has output" prop_governor_hasoutput , testProperty "no failure" prop_governor_nofail , testProperty "no livelock" prop_governor_nolivelock @@ -211,6 +215,158 @@ tests = -- QuickCheck properties -- +prop_peerSelectionView_sizes :: GovernorMockEnvironment -> Property +prop_peerSelectionView_sizes env = + let trace = runGovernorInMockEnvironment env + evs = selectGovernorStateEvents + $ selectPeerSelectionTraceEventsUntil (Time (10 * 3600)) trace + in getAllProperty $ + foldMap (\(_, TraceGovernorState _ _ st) -> + AllProperty $ + let view = peerSelectionStateToView st in + viewInvariant (fst <$> view) + .&&. viewSizeInvariant view) + evs + where + viewInvariant :: PeerSelectionView (Set PeerAddr) + -> Property + viewInvariant PeerSelectionView {..} = + isSubsetProperty "viewActivePeersDemotions" viewActivePeersDemotions viewActivePeers + .&&. isSubsetProperty "viewActivePeers" viewActivePeers viewEstablishedPeers + .&&. isSubsetProperty "viewEstablishedPeers" viewEstablishedPeers viewKnownPeers + .&&. isSubsetProperty "viewColdPeersPromotions" viewColdPeersPromotions viewKnownPeers + .&&. isSubsetProperty "viewAvailableToConnectPeers" viewAvailableToConnectPeers viewKnownPeers + .&&. isSubsetProperty "viewWarmPeersDemotions" viewWarmPeersDemotions (viewEstablishedPeers Set.\\ viewActivePeers) + .&&. isSubsetProperty "viewWarmPeersPromotions" viewWarmPeersPromotions (viewEstablishedPeers Set.\\ viewActivePeers) + + .&&. isSubsetProperty "viewActiveBigLedgerPeersDemotions" viewActiveBigLedgerPeersDemotions viewActiveBigLedgerPeers + .&&. isSubsetProperty "viewActiveBigLedgerPeers" viewActiveBigLedgerPeers viewEstablishedBigLedgerPeers + .&&. isSubsetProperty "viewEstablishedBigLedgerPeers" viewEstablishedBigLedgerPeers viewKnownBigLedgerPeers + .&&. isSubsetProperty "viewColdBigLedgerPeersPromotions" viewColdBigLedgerPeersPromotions viewKnownBigLedgerPeers + .&&. isSubsetProperty "viewAvailableToConnectBigLedgerPeers" viewAvailableToConnectBigLedgerPeers viewKnownBigLedgerPeers + .&&. isSubsetProperty "viewWarmBigLedgerPeersDemotions" viewWarmBigLedgerPeersDemotions (viewEstablishedBigLedgerPeers Set.\\ viewActiveBigLedgerPeers) + .&&. isSubsetProperty "viewWarmBigLedgerPeersPromotions" viewWarmBigLedgerPeersPromotions (viewEstablishedBigLedgerPeers Set.\\ viewActiveBigLedgerPeers) + + .&&. isSubsetProperty "viewActiveLocalRootPeersDemotions" viewActiveLocalRootPeersDemotions viewActiveLocalRootPeers + .&&. isSubsetProperty "viewActiveLocalRootPeers" viewActiveLocalRootPeers viewEstablishedLocalRootPeers + .&&. isSubsetProperty "viewEstablishedLocalRootPeers" viewEstablishedLocalRootPeers viewKnownLocalRootPeers + .&&. isSubsetProperty "viewColdLocalRootPeersPromotions" viewColdLocalRootPeersPromotions viewKnownLocalRootPeers + .&&. isSubsetProperty "viewAvailableToConnectLocalRootPeers" viewAvailableToConnectLocalRootPeers viewKnownLocalRootPeers + .&&. isSubsetProperty "viewWarmLocalRootPeersPromotions" viewWarmLocalRootPeersPromotions (viewEstablishedLocalRootPeers Set.\\ viewActiveLocalRootPeers) + + .&&. isSubsetProperty "viewActiveSharedPeersDemotions" viewActiveSharedPeersDemotions viewActiveSharedPeers + .&&. isSubsetProperty "viewActiveSharedPeers" viewActiveSharedPeers viewEstablishedSharedPeers + .&&. isSubsetProperty "viewEstablishedSharedPeers" viewEstablishedSharedPeers viewKnownSharedPeers + .&&. isSubsetProperty "viewColdSharedPeersPromotions" viewColdSharedPeersPromotions viewKnownSharedPeers + .&&. isSubsetProperty "viewWarmSharedPeersPromotions" viewWarmSharedPeersPromotions (viewEstablishedSharedPeers Set.\\ viewActiveSharedPeers) + .&&. isSubsetProperty "viewWarmSharedPeersDemotions" viewWarmSharedPeersDemotions (viewEstablishedSharedPeers Set.\\ viewActiveSharedPeers) + + .&&. isSubsetProperty "viewActiveBootstrapPeersDemotions" viewActiveBootstrapPeersDemotions viewActiveBootstrapPeers + .&&. isSubsetProperty "viewActiveBootstrapPeers" viewActiveBootstrapPeers viewEstablishedBootstrapPeers + .&&. isSubsetProperty "viewEstablishedBootstrapPeers" viewEstablishedBootstrapPeers viewKnownBootstrapPeers + .&&. isSubsetProperty "viewColdBootstrapPeersPromotions" viewColdBootstrapPeersPromotions viewKnownBootstrapPeers + .&&. isSubsetProperty "viewWarmBootstrapPeersPromotions" viewWarmBootstrapPeersPromotions (viewEstablishedBootstrapPeers Set.\\ viewActiveBootstrapPeers) + .&&. isSubsetProperty "viewWarmBootstrapPeersDemotions" viewWarmBootstrapPeersDemotions (viewEstablishedBootstrapPeers Set.\\ viewActiveBootstrapPeers) + + .&&. disjointSetsProperty "viewKnownPeers viewKnownBigLedgerPeers" viewKnownPeers viewKnownBigLedgerPeers + .&&. isSubsetProperty "viewKnownLocalRootPeers" viewKnownLocalRootPeers viewKnownPeers + .&&. isSubsetProperty "viewKnownSharedPeers" viewKnownSharedPeers viewKnownPeers + .&&. isSubsetProperty "viewKnownBootstrapPeers" viewKnownBootstrapPeers viewKnownPeers + + .&&. disjointSetsProperty "viewKnownLocalRootPeers-viewKnownBigLedgerPeers" viewKnownLocalRootPeers viewKnownBigLedgerPeers + .&&. disjointSetsProperty "viewKnownLocalRootPeers-viewKnownSharedPeers" viewKnownLocalRootPeers viewKnownSharedPeers + .&&. disjointSetsProperty "viewKnownLocalRootPeers-viewKnownBootstrapPeers" viewKnownLocalRootPeers viewKnownBootstrapPeers + + .&&. disjointSetsProperty "viewKnownSharedPeers-viewKnownBigLedgerPeers" viewKnownSharedPeers viewKnownBigLedgerPeers + .&&. disjointSetsProperty "viewKnownBootstrapPeers-viewKnownBigLedgerPeers" viewKnownBootstrapPeers viewKnownBigLedgerPeers + + viewSizeInvariant :: PeerSelectionSetsWithSizes PeerAddr + -> Property + viewSizeInvariant PeerSelectionView {..} = + counterexample "viewRootPeers" + (Set.size (fst viewRootPeers) === snd viewRootPeers) + + .&&. counterexample "viewKnownPeers" + (Set.size (fst viewKnownPeers) === snd viewKnownPeers) + + .&&. counterexample "viewAvailableToConnectPeers" + (Set.size (fst viewAvailableToConnectPeers) === snd viewAvailableToConnectPeers) + .&&. counterexample "viewColdPeersPromotions" + (Set.size (fst viewColdPeersPromotions) === snd viewColdPeersPromotions) + .&&. counterexample "viewEstablishedPeers" + (Set.size (fst viewEstablishedPeers) === snd viewEstablishedPeers) + .&&. counterexample "viewWarmPeersDemotions" + (Set.size (fst viewWarmPeersDemotions) === snd viewWarmPeersDemotions) + .&&. counterexample "viewWarmPeersPromotions" + (Set.size (fst viewWarmPeersPromotions) === snd viewWarmPeersPromotions) + .&&. counterexample "viewActivePeers" + (Set.size (fst viewActivePeers) === snd viewActivePeers) + .&&. counterexample "viewActivePeersDemotions" + (Set.size (fst viewActivePeersDemotions) === snd viewActivePeersDemotions) + + .&&. counterexample "viewKnownBigLedgerPeers" + (Set.size (fst viewKnownBigLedgerPeers) === snd viewKnownBigLedgerPeers) + .&&. counterexample "viewAvailableToConnectBigLedgerPeers" + (Set.size (fst viewAvailableToConnectBigLedgerPeers) === snd viewAvailableToConnectBigLedgerPeers) + .&&. counterexample "viewColdBigLedgerPeersPromotions" + (Set.size (fst viewColdBigLedgerPeersPromotions) === snd viewColdBigLedgerPeersPromotions) + .&&. counterexample "viewEstablishedBigLedgerPeers" + (Set.size (fst viewEstablishedBigLedgerPeers) === snd viewEstablishedBigLedgerPeers) + .&&. counterexample "viewWarmBigLedgerPeersDemotions" + (Set.size (fst viewWarmBigLedgerPeersDemotions) === snd viewWarmBigLedgerPeersDemotions) + .&&. counterexample "viewWarmBigLedgerPeersPromotions" + (Set.size (fst viewWarmBigLedgerPeersPromotions) === snd viewWarmBigLedgerPeersPromotions) + .&&. counterexample "viewActiveBigLedgerPeers" + (Set.size (fst viewActiveBigLedgerPeers) === snd viewActiveBigLedgerPeers) + .&&. counterexample "viewActiveBigLedgerPeersDemotions" + (Set.size (fst viewActiveBigLedgerPeersDemotions) === snd viewActiveBigLedgerPeersDemotions) + + .&&. counterexample "viewKnownLocalRootPeers" + (Set.size (fst viewKnownLocalRootPeers) === snd viewKnownLocalRootPeers) + .&&. counterexample "viewAvailableToConnectLocalRootPeers" + (Set.size (fst viewAvailableToConnectLocalRootPeers) === snd viewAvailableToConnectLocalRootPeers) + .&&. counterexample "viewColdLocalRootPeersPromotions" + (Set.size (fst viewColdLocalRootPeersPromotions) === snd viewColdLocalRootPeersPromotions) + .&&. counterexample "viewEstablishedLocalRootPeers" + (Set.size (fst viewEstablishedLocalRootPeers) === snd viewEstablishedLocalRootPeers) + .&&. counterexample "viewWarmLocalRootPeersPromotions" + (Set.size (fst viewWarmLocalRootPeersPromotions) === snd viewWarmLocalRootPeersPromotions) + .&&. counterexample "viewActiveLocalRootPeers" + (Set.size (fst viewActiveLocalRootPeers) === snd viewActiveLocalRootPeers) + .&&. counterexample "viewActiveLocalRootPeersDemotions" + (Set.size (fst viewActiveLocalRootPeersDemotions) === snd viewActiveLocalRootPeersDemotions) + + .&&. counterexample "viewKnownSharedPeers" + (Set.size (fst viewKnownSharedPeers) === snd viewKnownSharedPeers) + .&&. counterexample "viewColdSharedPeersPromotions" + (Set.size (fst viewColdSharedPeersPromotions) === snd viewColdSharedPeersPromotions) + .&&. counterexample "viewEstablishedSharedPeers" + (Set.size (fst viewEstablishedSharedPeers) === snd viewEstablishedSharedPeers) + .&&. counterexample "viewWarmSharedPeersDemotions" + (Set.size (fst viewWarmSharedPeersDemotions) === snd viewWarmSharedPeersDemotions) + .&&. counterexample "viewWarmSharedPeersPromotions" + (Set.size (fst viewWarmSharedPeersPromotions) === snd viewWarmSharedPeersPromotions) + .&&. counterexample "viewActiveSharedPeers" + (Set.size (fst viewActiveSharedPeers) === snd viewActiveSharedPeers) + .&&. counterexample "viewActiveSharedPeersDemotions" + (Set.size (fst viewActiveSharedPeersDemotions) === snd viewActiveSharedPeersDemotions) + + .&&. counterexample "viewKnownBootstrapPeers" + (Set.size (fst viewKnownBootstrapPeers) === snd viewKnownBootstrapPeers) + .&&. counterexample "viewColdBootstrapPeersPromotions" + (Set.size (fst viewColdBootstrapPeersPromotions) === snd viewColdBootstrapPeersPromotions) + .&&. counterexample "viewEstablishedBootstrapPeers" + (Set.size (fst viewEstablishedBootstrapPeers) === snd viewEstablishedBootstrapPeers) + .&&. counterexample "viewWarmBootstrapPeersDemotions" + (Set.size (fst viewWarmBootstrapPeersDemotions) === snd viewWarmBootstrapPeersDemotions) + .&&. counterexample "viewWarmBootstrapPeersPromotions" + (Set.size (fst viewWarmBootstrapPeersPromotions) === snd viewWarmBootstrapPeersPromotions) + .&&. counterexample "viewActiveBootstrapPeers" + (Set.size (fst viewActiveBootstrapPeers) === snd viewActiveBootstrapPeers) + .&&. counterexample "viewActiveBootstrapPeersDemotions" + (Set.size (fst viewActiveBootstrapPeersDemotions) === snd viewActiveBootstrapPeersDemotions) + + -- We start with basic properties in the style of "never does bad things" -- and progress to properties that check that it "eventually does good things". -- diff --git a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/PeerSelection/MockEnvironment.hs b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/PeerSelection/MockEnvironment.hs index 6dbf7a6c0b..905b58f757 100644 --- a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/PeerSelection/MockEnvironment.hs +++ b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/PeerSelection/MockEnvironment.hs @@ -19,6 +19,7 @@ module Test.Ouroboros.Network.PeerSelection.MockEnvironment , TraceMockEnv (..) , TestTraceEvent (..) , selectGovernorEvents + , selectGovernorStateEvents , selectPeerSelectionTraceEvents , selectPeerSelectionTraceEventsUntil , peerShareReachablePeers @@ -715,6 +716,11 @@ selectGovernorEvents :: [(Time, TestTraceEvent)] -> [(Time, TracePeerSelection PeerAddr)] selectGovernorEvents trace = [ (t, e) | (t, GovernorEvent e) <- trace ] +selectGovernorStateEvents :: [(Time, TestTraceEvent)] + -> [(Time, DebugPeerSelection PeerAddr)] +selectGovernorStateEvents trace = [ (t, e) | (t, GovernorDebug e) <- trace ] + + -- -- QuickCheck instances diff --git a/ouroboros-network/src/Ouroboros/Network/Diffusion/P2P.hs b/ouroboros-network/src/Ouroboros/Network/Diffusion/P2P.hs index 2a513ae06b..e883a7c754 100644 --- a/ouroboros-network/src/Ouroboros/Network/Diffusion/P2P.hs +++ b/ouroboros-network/src/Ouroboros/Network/Diffusion/P2P.hs @@ -102,7 +102,7 @@ import Ouroboros.Network.PeerSelection.Bootstrap (UseBootstrapPeers) import Ouroboros.Network.PeerSelection.Governor qualified as Governor import Ouroboros.Network.PeerSelection.Governor.Types (ChurnMode (ChurnModeNormal), DebugPeerSelection (..), - PeerSelectionActions, PeerSelectionCounters (..), + PeerSelectionActions, PeerSelectionCounters, PeerSelectionPolicy (..), PeerSelectionState, TracePeerSelection (..), emptyPeerSelectionCounters, emptyPeerSelectionState) diff --git a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Churn.hs b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Churn.hs index 38d2356813..7a7bf3c4bd 100644 --- a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Churn.hs +++ b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Churn.hs @@ -1,9 +1,14 @@ {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE ScopedTypeVariables #-} +#if __GLASGOW_HASKELL__ < 904 +{-# OPTIONS_GHC -Wno-name-shadowing #-} +#endif + -- | This subsystem manages the discovery and selection of /upstream/ peers. -- module Ouroboros.Network.PeerSelection.Churn diff --git a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor.hs b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor.hs index 95a19a7da6..62f222cd7e 100644 --- a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor.hs +++ b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor.hs @@ -30,12 +30,15 @@ module Ouroboros.Network.PeerSelection.Governor , PeerSelectionState (..) , PublicPeerSelectionState (..) , makePublicPeerSelectionStateVar - , PeerSelectionCounters (..) + , PeerSelectionView (..) + , PeerSelectionCounters + , PeerSelectionSetsWithSizes , peerSelectionStateToCounters , emptyPeerSelectionCounters , nullPeerSelectionTargets , emptyPeerSelectionState , ChurnMode (..) + , peerSelectionStateToView ) where import Data.Foldable (traverse_) diff --git a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/ActivePeers.hs b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/ActivePeers.hs index 96cd410806..7fb373b4cd 100644 --- a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/ActivePeers.hs +++ b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/ActivePeers.hs @@ -245,7 +245,6 @@ belowTargetOther actions policyPickWarmPeersToPromote } st@PeerSelectionState { - publicRootPeers, localRootPeers, establishedPeers, activePeers, @@ -302,13 +301,13 @@ belowTargetOther actions | otherwise = GuardedSkip Nothing where - PeerSelectionCounters { - numberOfActivePeers = numActivePeers, - numberOfWarmPeersPromotions = numPromoteInProgress + PeerSelectionView { + viewActivePeers = (_, numActivePeers), + viewWarmPeersPromotions = (_, numPromoteInProgress), + viewKnownBigLedgerPeers = (bigLedgerPeersSet, _) } = - peerSelectionStateToCounters st - bigLedgerPeersSet = PublicRootPeers.getBigLedgerPeers publicRootPeers + peerSelectionStateToView st jobPromoteWarmPeer :: forall peeraddr peerconn m. diff --git a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/BigLedgerPeers.hs b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/BigLedgerPeers.hs index 8fecb5eab7..4c4f3154a2 100644 --- a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/BigLedgerPeers.hs +++ b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/BigLedgerPeers.hs @@ -24,7 +24,6 @@ import Ouroboros.Network.PeerSelection.LedgerPeers (LedgerPeersKind (..)) import Ouroboros.Network.PeerSelection.PeerAdvertise (PeerAdvertise (..)) import Ouroboros.Network.PeerSelection.PublicRootPeers (PublicRootPeers) import Ouroboros.Network.PeerSelection.PublicRootPeers qualified as PublicRootPeers -import Ouroboros.Network.PeerSelection.State.EstablishedPeers qualified as EstablishedPeers import Ouroboros.Network.PeerSelection.State.KnownPeers qualified as KnownPeers import Ouroboros.Network.PeerSelection.State.LocalRootPeers qualified as LocalRootPeers @@ -183,7 +182,6 @@ aboveTarget PeerSelectionPolicy {policyPickColdPeersToForget} st@PeerSelectionState { publicRootPeers, knownPeers, - establishedPeers, inProgressPromoteCold, targets = PeerSelectionTargets { targetNumberOfKnownBigLedgerPeers @@ -228,18 +226,9 @@ aboveTarget PeerSelectionPolicy {policyPickColdPeersToForget} where bigLedgerPeersSet = PublicRootPeers.getBigLedgerPeers publicRootPeers - PeerSelectionCounters { - numberOfKnownBigLedgerPeers = numKnownBigLedgerPeers + PeerSelectionView { + viewKnownBigLedgerPeers = (_, numKnownBigLedgerPeers), + viewEstablishedBigLedgerPeers = (establishedBigLedgerPeers, numEstablishedBigLedgerPeers) } = - peerSelectionStateToCounters st - - establishedBigLedgerPeers :: Set peeraddr - establishedBigLedgerPeers = EstablishedPeers.toSet establishedPeers - `Set.intersection` - bigLedgerPeersSet - - -- TODO: we should compute this with `PeerSelectionCounters`, but we also - -- need to return the `establishedBigLedgerPeers` set. - numEstablishedBigLedgerPeers :: Int - numEstablishedBigLedgerPeers = Set.size establishedBigLedgerPeers + peerSelectionStateToView st diff --git a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/EstablishedPeers.hs b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/EstablishedPeers.hs index 707db8446d..a98142dd96 100644 --- a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/EstablishedPeers.hs +++ b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/EstablishedPeers.hs @@ -79,7 +79,6 @@ belowTargetLocal actions } st@PeerSelectionState { localRootPeers, - publicRootPeers, knownPeers, establishedPeers, inProgressPromoteCold, @@ -155,15 +154,13 @@ belowTargetLocal actions , Set.size membersEstablished < getWarmValency warmValency ] - localRootPeersSet = LocalRootPeers.keysSet localRootPeers - bigLedgerPeersSet = PublicRootPeers.getBigLedgerPeers publicRootPeers - localEstablishedPeers = EstablishedPeers.toSet establishedPeers - `Set.intersection` localRootPeersSet - localAvailableToConnect = KnownPeers.availableToConnect knownPeers - `Set.intersection` localRootPeersSet - localConnectInProgress = inProgressPromoteCold - `Set.intersection` localRootPeersSet - numLocalConnectInProgress = Set.size localConnectInProgress + PeerSelectionView { + viewKnownBigLedgerPeers = (bigLedgerPeersSet, _), + viewKnownLocalRootPeers = (localRootPeersSet, _), + viewEstablishedLocalRootPeers = (localEstablishedPeers, _), + viewAvailableToConnectLocalRootPeers = (localAvailableToConnect, _), + viewColdLocalRootPeersPromotions = (localConnectInProgress, numLocalConnectInProgress) + } = peerSelectionStateToView st belowTargetOther :: forall peeraddr peerconn m. @@ -176,7 +173,6 @@ belowTargetOther actions } st@PeerSelectionState { knownPeers, - publicRootPeers, establishedPeers, inProgressPromoteCold, targets = PeerSelectionTargets { @@ -233,17 +229,15 @@ belowTargetOther actions | otherwise = GuardedSkip Nothing where - PeerSelectionCounters { - numberOfEstablishedPeers = numEstablishedPeers, - numberOfColdPeersPromotions = numConnectInProgress + PeerSelectionView { + viewKnownBigLedgerPeers = (bigLedgerPeersSet, _), + + viewAvailableToConnectPeers = (availableToConnect, numAvailableToConnect), + viewEstablishedPeers = (_, numEstablishedPeers), + viewColdPeersPromotions = (_, numConnectInProgress) } = - peerSelectionStateToCounters st - - bigLedgerPeersSet = PublicRootPeers.getBigLedgerPeers publicRootPeers - availableToConnect = KnownPeers.availableToConnect knownPeers - Set.\\ bigLedgerPeersSet - numAvailableToConnect = Set.size availableToConnect + peerSelectionStateToView st -- | @@ -261,7 +255,6 @@ belowTargetBigLedgerPeers actions } st@PeerSelectionState { knownPeers, - publicRootPeers, establishedPeers, inProgressPromoteCold, targets = PeerSelectionTargets { @@ -325,18 +318,14 @@ belowTargetBigLedgerPeers actions | otherwise = GuardedSkip Nothing where - PeerSelectionCounters { - numberOfEstablishedBigLedgerPeers = numEstablishedPeers, - numberOfColdBigLedgerPeersPromotions = numConnectInProgress + PeerSelectionView { + viewKnownBigLedgerPeers = (bigLedgerPeersSet, _), + viewAvailableToConnectBigLedgerPeers = (availableToConnect, numAvailableToConnect), + viewEstablishedBigLedgerPeers = (_, numEstablishedPeers), + viewColdBigLedgerPeersPromotions = (_, numConnectInProgress) } = - peerSelectionStateToCounters st - - bigLedgerPeersSet = PublicRootPeers.getBigLedgerPeers publicRootPeers - availableToConnect = KnownPeers.availableToConnect knownPeers - `Set.intersection` - bigLedgerPeersSet - numAvailableToConnect= Set.size availableToConnect + peerSelectionStateToView st -- | Must be larger than '2' since we add a random value drawn from '(-2, 2)`. @@ -367,7 +356,6 @@ jobPromoteColdPeer PeerSelectionActions { handler e = return $ Completion $ \st@PeerSelectionState { publicRootPeers, - establishedPeers, fuzzRng, targets = PeerSelectionTargets { targetNumberOfEstablishedPeers, @@ -388,29 +376,31 @@ jobPromoteColdPeer PeerSelectionActions { * 2 ^ (pred failCount `min` maxColdPeerRetryBackoff) ) bigLedgerPeersSet = PublicRootPeers.getBigLedgerPeers publicRootPeers + + st' = st { knownPeers = KnownPeers.setConnectTimes + (Map.singleton + peeraddr + (delay `addTime` now)) + knownPeers', + inProgressPromoteCold = Set.delete peeraddr + (inProgressPromoteCold st), + fuzzRng = fuzzRng' + } + cs' = peerSelectionStateToCounters st' in Decision { decisionTrace = if peeraddr `Set.member` bigLedgerPeersSet then [TracePromoteColdBigLedgerPeerFailed targetNumberOfEstablishedBigLedgerPeers - (Set.size $ EstablishedPeers.toSet establishedPeers - `Set.intersection` - bigLedgerPeersSet) + (case cs' of + PeerSelectionCounters { numberOfEstablishedBigLedgerPeers = a } -> a) peeraddr delay e] else [TracePromoteColdFailed targetNumberOfEstablishedPeers - (EstablishedPeers.size establishedPeers) + (case cs' of + PeerSelectionCounters { numberOfEstablishedPeers = a } -> a) peeraddr delay e], - decisionState = st { - knownPeers = KnownPeers.setConnectTimes - (Map.singleton - peeraddr - (delay `addTime` now)) - knownPeers', - inProgressPromoteCold = Set.delete peeraddr - (inProgressPromoteCold st), - fuzzRng = fuzzRng' - }, + decisionState = st', decisionJobs = [] } @@ -458,25 +448,26 @@ jobPromoteColdPeer PeerSelectionActions { knownPeers bigLedgerPeersSet = PublicRootPeers.getBigLedgerPeers publicRootPeers + st' = st { establishedPeers = establishedPeers', + inProgressPromoteCold = Set.delete peeraddr + (inProgressPromoteCold st), + knownPeers = knownPeers' + } + cs' = peerSelectionStateToCounters st' + in Decision { decisionTrace = if peeraddr `Set.member` bigLedgerPeersSet then [TracePromoteColdBigLedgerPeerDone targetNumberOfEstablishedBigLedgerPeers - (Set.size $ EstablishedPeers.toSet establishedPeers' - `Set.intersection` - bigLedgerPeersSet) + (case cs' of + PeerSelectionCounters { numberOfEstablishedBigLedgerPeers = a } -> a) peeraddr] else [TracePromoteColdDone targetNumberOfEstablishedPeers - (Set.size $ EstablishedPeers.toSet establishedPeers' - Set.\\ bigLedgerPeersSet) + (case cs' of + PeerSelectionCounters { numberOfEstablishedPeers = a } -> a) peeraddr], - decisionState = st { - establishedPeers = establishedPeers', - inProgressPromoteCold = Set.delete peeraddr - (inProgressPromoteCold st), - knownPeers = knownPeers' - }, + decisionState = st', decisionJobs = [] } @@ -506,7 +497,6 @@ aboveTargetOther actions } st@PeerSelectionState { localRootPeers, - publicRootPeers, establishedPeers, activePeers, inProgressDemoteWarm, @@ -520,19 +510,20 @@ aboveTargetOther actions -- 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 bigLedgerPeersSet = PublicRootPeers.getBigLedgerPeers publicRootPeers - numActivePeers, numPeersToDemote :: Int - PeerSelectionCounters { - numberOfEstablishedPeers = numEstablishedPeers, - numberOfActivePeers = numActivePeers + | let peerSelectionView = peerSelectionStateToView st + PeerSelectionView { + viewKnownBigLedgerPeers = (bigLedgerPeersSet, _), + viewEstablishedPeers = (_, numEstablishedPeers), + viewActivePeers = (_, numActivePeers) } = - peerSelectionStateToCounters st + peerSelectionView + PeerSelectionCountersHWC { + numberOfWarmLocalRootPeers = numLocalWarmPeers + } + = + snd <$> peerSelectionView - numLocalWarmPeers = Set.size localWarmPeers - localWarmPeers = LocalRootPeers.keysSet localRootPeers - `Set.intersection` EstablishedPeers.toSet establishedPeers - Set.\\ activePeers -- 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 diff --git a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/Monitor.hs b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/Monitor.hs index 2251e51561..b37a159329 100644 --- a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/Monitor.hs +++ b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/Monitor.hs @@ -40,7 +40,7 @@ import Ouroboros.Network.PeerSelection.Bootstrap (isBootstrapPeersEnabled, import Ouroboros.Network.PeerSelection.Governor.ActivePeers (jobDemoteActivePeer) import Ouroboros.Network.PeerSelection.Governor.Types hiding - (PeerSelectionCounters (..)) + (PeerSelectionCounters) import Ouroboros.Network.PeerSelection.LedgerPeers.Type (LedgerStateJudgement (..)) import Ouroboros.Network.PeerSelection.PeerAdvertise (PeerAdvertise (..)) diff --git a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/Types.hs b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/Types.hs index 817941c13a..bd09762a24 100644 --- a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/Types.hs +++ b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/Types.hs @@ -1,4 +1,6 @@ {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} @@ -9,6 +11,12 @@ {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE ViewPatterns #-} +#if __GLASGOW_HASKELL__ < 904 +-- Pattern synonym record fields with GHC-8.10 is issuing the `-Wname-shadowing` +-- warning. +{-# OPTIONS_GHC -Wno-name-shadowing #-} +#endif + module Ouroboros.Network.PeerSelection.Governor.Types ( -- * P2P governor policies PeerSelectionPolicy (..) @@ -37,9 +45,71 @@ module Ouroboros.Network.PeerSelection.Governor.Types , TimedDecision , MkGuardedDecision , Completion (..) - , PeerSelectionCounters (.., PeerSelectionCountersHWC, numberOfColdPeers, numberOfWarmPeers, numberOfHotPeers, numberOfColdBigLedgerPeers, numberOfWarmBigLedgerPeers, numberOfHotBigLedgerPeers, numberOfColdLocalRootPeers, numberOfWarmLocalRootPeers, numberOfHotLocalRootPeers) + , PeerSelectionView + ( .., + PeerSelectionCounters, + numberOfRootPeers, + + numberOfKnownPeers, + numberOfAvailableToConnectPeers, + numberOfColdPeersPromotions, + numberOfEstablishedPeers, + numberOfWarmPeersDemotions, + numberOfWarmPeersPromotions, + numberOfActivePeers, + numberOfActivePeersDemotions, + + numberOfKnownBigLedgerPeers, + numberOfAvailableToConnectBigLedgerPeers, + numberOfColdBigLedgerPeersPromotions, + numberOfEstablishedBigLedgerPeers, + numberOfWarmBigLedgerPeersDemotions, + numberOfWarmBigLedgerPeersPromotions, + numberOfActiveBigLedgerPeers, + numberOfActiveBigLedgerPeersDemotions, + + numberOfKnownLocalRootPeers, + numberOfAvailableToConnectLocalRootPeers, + numberOfColdLocalRootPeersPromotions, + numberOfEstablishedLocalRootPeers, + numberOfWarmLocalRootPeersPromotions, + numberOfActiveLocalRootPeers, + numberOfActiveLocalRootPeersDemotions, + + numberOfKnownSharedPeers, + numberOfColdSharedPeersPromotions, + numberOfEstablishedSharedPeers, + numberOfWarmSharedPeersDemotions, + numberOfWarmSharedPeersPromotions, + numberOfActiveSharedPeers, + numberOfActiveSharedPeersDemotions, + + numberOfKnownBootstrapPeers, + numberOfColdBootstrapPeersPromotions, + numberOfEstablishedBootstrapPeers, + numberOfWarmBootstrapPeersDemotions, + numberOfWarmBootstrapPeersPromotions, + numberOfActiveBootstrapPeers, + numberOfActiveBootstrapPeersDemotions, + + PeerSelectionCountersHWC, + numberOfColdPeers, + numberOfWarmPeers, + numberOfHotPeers, + + numberOfColdBigLedgerPeers, + numberOfWarmBigLedgerPeers, + numberOfHotBigLedgerPeers, + + numberOfColdLocalRootPeers, + numberOfWarmLocalRootPeers, + numberOfHotLocalRootPeers + ) + , PeerSelectionCounters + , PeerSelectionSetsWithSizes , emptyPeerSelectionCounters , peerSelectionStateToCounters + , peerSelectionStateToView -- * Peer Sharing Auxiliary data type , PeerSharingResult (..) -- * Traces @@ -559,31 +629,36 @@ toPublicState PeerSelectionState { knownPeers KnownPeers.getPeerSharingResponsePeers knownPeers } --- Peer selection counters. +-- | Peer selection view. +-- +-- This is a functor which is used to hold computation of various peer sets and +-- their sizes. See `peerSelectionStateToView`, `peerSelectionStateToCounters`. -- -data PeerSelectionCounters = PeerSelectionCounters { - numberOfRootPeers :: Int, +data PeerSelectionView a = PeerSelectionView { + viewRootPeers :: a, -- -- Non Big Ledger Peers -- - numberOfKnownPeers :: Int, + viewKnownPeers :: a, -- ^ number of known peers excluding big ledger peers - numberOfColdPeersPromotions :: Int, + viewAvailableToConnectPeers :: a, + -- ^ number of known peers available to connect + viewColdPeersPromotions :: a, -- ^ number of known peers (excluding big ledger peers) being promoted to -- warm - numberOfEstablishedPeers :: Int, + viewEstablishedPeers :: a, -- ^ number of established peers excluding big ledger peers - numberOfWarmPeersDemotions :: Int, + viewWarmPeersDemotions :: a, -- ^ number of warm peers (excluding big ledger peers) being demoted to -- cold - numberOfWarmPeersPromotions :: Int, + viewWarmPeersPromotions :: a, -- ^ number of warm peers (excluding big ledger peers) being promote to -- hot - numberOfActivePeers :: Int, + viewActivePeers :: a, -- ^ number of active peers excluding big ledger peers - numberOfActivePeersDemotions :: Int, + viewActivePeersDemotions :: a, -- ^ number of active peers (excluding big ledger peers) being demoted to -- warm @@ -591,59 +666,168 @@ data PeerSelectionCounters = PeerSelectionCounters { -- Big Ledger Peers -- - numberOfKnownBigLedgerPeers :: Int, + viewKnownBigLedgerPeers :: a, -- ^ number of known big ledger peers - numberOfColdBigLedgerPeersPromotions :: Int, + viewAvailableToConnectBigLedgerPeers :: a, + -- ^ number of known big ledger peers available to connect + viewColdBigLedgerPeersPromotions :: a, -- ^ number of cold big ledger peers being promoted to warm - numberOfEstablishedBigLedgerPeers :: Int, + viewEstablishedBigLedgerPeers :: a, -- ^ number of established big ledger peers - numberOfWarmBigLedgerPeersDemotions :: Int, + viewWarmBigLedgerPeersDemotions :: a, -- ^ number of warm big ledger peers being demoted to cold - numberOfWarmBigLedgerPeersPromotions :: Int, + viewWarmBigLedgerPeersPromotions :: a, -- ^ number of warm big ledger peers being promote to hot - numberOfActiveBigLedgerPeers :: Int, + viewActiveBigLedgerPeers :: a, -- ^ number of active big ledger peers - numberOfActiveBigLedgerPeersDemotions :: Int, + viewActiveBigLedgerPeersDemotions :: a, -- ^ number of active big ledger peers being demoted to warm -- -- Local Roots -- - numberOfKnownLocalRootPeers :: Int, + viewKnownLocalRootPeers :: a, -- ^ number of known local root peers should always be equal to the sum -- of established & active local roots. - numberOfEstablishedLocalRootPeers :: Int, - numberOfWarmLocalRootPeersPromotions :: Int, - numberOfActiveLocalRootPeers :: Int, - numberOfActiveLocalRootPeersDemotions :: Int, + viewAvailableToConnectLocalRootPeers :: a, + viewColdLocalRootPeersPromotions :: a, + viewEstablishedLocalRootPeers :: a, + viewWarmLocalRootPeersPromotions :: a, + viewActiveLocalRootPeers :: a, + viewActiveLocalRootPeersDemotions :: a, -- -- Share Peers -- (peers received through peer sharing) -- - numberOfKnownSharedPeers :: Int, - numberOfColdSharedPeersPromotions :: Int, - numberOfEstablishedSharedPeers :: Int, - numberOfWarmSharedPeersDemotions :: Int, - numberOfWarmSharedPeersPromotions :: Int, - numberOfActiveSharedPeers :: Int, - numberOfActiveSharedPeersDemotions :: Int, + viewKnownSharedPeers :: a, + viewColdSharedPeersPromotions :: a, + viewEstablishedSharedPeers :: a, + viewWarmSharedPeersDemotions :: a, + viewWarmSharedPeersPromotions :: a, + viewActiveSharedPeers :: a, + viewActiveSharedPeersDemotions :: a, -- -- Bootstrap Peers -- - numberOfKnownBootstrapPeers :: Int, - numberOfColdBootstrapPeersPromotions :: Int, - numberOfEstablishedBootstrapPeers :: Int, - numberOfWarmBootstrapPeersDemotions :: Int, - numberOfWarmBootstrapPeersPromotions :: Int, - numberOfActiveBootstrapPeers :: Int, - numberOfActiveBootstrapPeersDemotions :: Int - } deriving (Eq, Show) + viewKnownBootstrapPeers :: a, + viewColdBootstrapPeersPromotions :: a, + viewEstablishedBootstrapPeers :: a, + viewWarmBootstrapPeersDemotions :: a, + viewWarmBootstrapPeersPromotions :: a, + viewActiveBootstrapPeers :: a, + viewActiveBootstrapPeersDemotions :: a + } deriving (Eq, Functor, Show) + + +type PeerSelectionCounters = PeerSelectionView Int +pattern PeerSelectionCounters + :: Int + -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int + -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int + -> Int -> Int -> Int -> Int -> Int -> Int -> Int + -> Int -> Int -> Int -> Int -> Int -> Int -> Int + -> Int -> Int -> Int -> Int -> Int -> Int -> Int + -> PeerSelectionCounters +pattern PeerSelectionCounters { + numberOfRootPeers, + + numberOfKnownPeers, + numberOfAvailableToConnectPeers, + numberOfColdPeersPromotions, + numberOfEstablishedPeers, + numberOfWarmPeersDemotions, + numberOfWarmPeersPromotions, + numberOfActivePeers, + numberOfActivePeersDemotions, + + numberOfKnownBigLedgerPeers, + numberOfAvailableToConnectBigLedgerPeers, + numberOfColdBigLedgerPeersPromotions, + numberOfEstablishedBigLedgerPeers, + numberOfWarmBigLedgerPeersDemotions, + numberOfWarmBigLedgerPeersPromotions, + numberOfActiveBigLedgerPeers, + numberOfActiveBigLedgerPeersDemotions, + + numberOfKnownLocalRootPeers, + numberOfAvailableToConnectLocalRootPeers, + numberOfColdLocalRootPeersPromotions, + numberOfEstablishedLocalRootPeers, + numberOfWarmLocalRootPeersPromotions, + numberOfActiveLocalRootPeers, + numberOfActiveLocalRootPeersDemotions, + + numberOfKnownSharedPeers, + numberOfColdSharedPeersPromotions, + numberOfEstablishedSharedPeers, + numberOfWarmSharedPeersDemotions, + numberOfWarmSharedPeersPromotions, + numberOfActiveSharedPeers, + numberOfActiveSharedPeersDemotions, + + numberOfKnownBootstrapPeers, + numberOfColdBootstrapPeersPromotions, + numberOfEstablishedBootstrapPeers, + numberOfWarmBootstrapPeersDemotions, + numberOfWarmBootstrapPeersPromotions, + numberOfActiveBootstrapPeers, + numberOfActiveBootstrapPeersDemotions + } + = + PeerSelectionView { + viewRootPeers = numberOfRootPeers, + + viewKnownPeers = numberOfKnownPeers, + viewAvailableToConnectPeers = numberOfAvailableToConnectPeers, + viewColdPeersPromotions = numberOfColdPeersPromotions, + viewEstablishedPeers = numberOfEstablishedPeers, + viewWarmPeersDemotions = numberOfWarmPeersDemotions, + viewWarmPeersPromotions = numberOfWarmPeersPromotions, + viewActivePeers = numberOfActivePeers, + viewActivePeersDemotions = numberOfActivePeersDemotions, + + viewKnownBigLedgerPeers = numberOfKnownBigLedgerPeers, + viewAvailableToConnectBigLedgerPeers = numberOfAvailableToConnectBigLedgerPeers, + viewColdBigLedgerPeersPromotions = numberOfColdBigLedgerPeersPromotions, + viewEstablishedBigLedgerPeers = numberOfEstablishedBigLedgerPeers, + viewWarmBigLedgerPeersDemotions = numberOfWarmBigLedgerPeersDemotions, + viewWarmBigLedgerPeersPromotions = numberOfWarmBigLedgerPeersPromotions, + viewActiveBigLedgerPeers = numberOfActiveBigLedgerPeers, + viewActiveBigLedgerPeersDemotions = numberOfActiveBigLedgerPeersDemotions, + + viewKnownLocalRootPeers = numberOfKnownLocalRootPeers, + viewAvailableToConnectLocalRootPeers = numberOfAvailableToConnectLocalRootPeers, + viewColdLocalRootPeersPromotions = numberOfColdLocalRootPeersPromotions, + viewEstablishedLocalRootPeers = numberOfEstablishedLocalRootPeers, + viewWarmLocalRootPeersPromotions = numberOfWarmLocalRootPeersPromotions, + viewActiveLocalRootPeers = numberOfActiveLocalRootPeers, + viewActiveLocalRootPeersDemotions = numberOfActiveLocalRootPeersDemotions, + + viewKnownSharedPeers = numberOfKnownSharedPeers, + viewColdSharedPeersPromotions = numberOfColdSharedPeersPromotions, + viewEstablishedSharedPeers = numberOfEstablishedSharedPeers, + viewWarmSharedPeersDemotions = numberOfWarmSharedPeersDemotions, + viewWarmSharedPeersPromotions = numberOfWarmSharedPeersPromotions, + viewActiveSharedPeers = numberOfActiveSharedPeers, + viewActiveSharedPeersDemotions = numberOfActiveSharedPeersDemotions, + + viewKnownBootstrapPeers = numberOfKnownBootstrapPeers, + viewColdBootstrapPeersPromotions = numberOfColdBootstrapPeersPromotions, + viewEstablishedBootstrapPeers = numberOfEstablishedBootstrapPeers, + viewWarmBootstrapPeersDemotions = numberOfWarmBootstrapPeersDemotions, + viewWarmBootstrapPeersPromotions = numberOfWarmBootstrapPeersPromotions, + viewActiveBootstrapPeers = numberOfActiveBootstrapPeers, + viewActiveBootstrapPeersDemotions = numberOfActiveBootstrapPeersDemotions + } +{-# COMPLETE PeerSelectionCounters #-} + +type PeerSelectionSetsWithSizes peeraddr = PeerSelectionView (Set peeraddr, Int) -- | A Pattern synonym which computes `hot`, `warm`, `cold` counters from -- `PeerSelectionCounters`. @@ -665,18 +849,18 @@ pattern PeerSelectionCountersHWC { numberOfColdPeers, numberOfHotLocalRootPeers } <- (peerSelectionCountersHWC -> - PeerSelectionCounters { numberOfKnownPeers = numberOfColdPeers, - numberOfEstablishedPeers = numberOfWarmPeers, - numberOfActivePeers = numberOfHotPeers, + PeerSelectionView { viewKnownPeers = numberOfColdPeers, + viewEstablishedPeers = numberOfWarmPeers, + viewActivePeers = numberOfHotPeers, - numberOfKnownBigLedgerPeers = numberOfColdBigLedgerPeers, - numberOfEstablishedBigLedgerPeers = numberOfWarmBigLedgerPeers, - numberOfActiveBigLedgerPeers = numberOfHotBigLedgerPeers, + viewKnownBigLedgerPeers = numberOfColdBigLedgerPeers, + viewEstablishedBigLedgerPeers = numberOfWarmBigLedgerPeers, + viewActiveBigLedgerPeers = numberOfHotBigLedgerPeers, - numberOfKnownLocalRootPeers = numberOfColdLocalRootPeers, - numberOfEstablishedLocalRootPeers = numberOfWarmLocalRootPeers, - numberOfActiveLocalRootPeers = numberOfHotLocalRootPeers - }) + viewKnownLocalRootPeers = numberOfColdLocalRootPeers, + viewEstablishedLocalRootPeers = numberOfWarmLocalRootPeers, + viewActiveLocalRootPeers = numberOfHotLocalRootPeers + }) {-# COMPLETE PeerSelectionCountersHWC #-} @@ -690,6 +874,7 @@ peerSelectionCountersHWC PeerSelectionCounters {..} = numberOfKnownPeers = numberOfKnownPeers - numberOfEstablishedPeers, + numberOfAvailableToConnectPeers, numberOfColdPeersPromotions, numberOfEstablishedPeers = numberOfEstablishedPeers - numberOfActivePeers, @@ -700,6 +885,7 @@ peerSelectionCountersHWC PeerSelectionCounters {..} = numberOfKnownBigLedgerPeers = numberOfKnownBigLedgerPeers - numberOfEstablishedBigLedgerPeers, + numberOfAvailableToConnectBigLedgerPeers, numberOfColdBigLedgerPeersPromotions, numberOfEstablishedBigLedgerPeers = numberOfEstablishedBigLedgerPeers - numberOfActiveBigLedgerPeers, @@ -710,6 +896,8 @@ peerSelectionCountersHWC PeerSelectionCounters {..} = numberOfKnownLocalRootPeers = numberOfKnownLocalRootPeers - numberOfEstablishedLocalRootPeers, + numberOfAvailableToConnectLocalRootPeers, + numberOfColdLocalRootPeersPromotions, numberOfEstablishedLocalRootPeers = numberOfEstablishedLocalRootPeers - numberOfActiveLocalRootPeers, numberOfWarmLocalRootPeersPromotions, @@ -738,8 +926,18 @@ peerSelectionCountersHWC PeerSelectionCounters {..} = } -peerSelectionStateToCounters :: Ord peeraddr => PeerSelectionState peeraddr peerconn -> PeerSelectionCounters -peerSelectionStateToCounters +-- | Compute peer selection sets & their sizes. +-- +-- This function is used internally by the outbound-governor and to compute +-- `PeerSelectionCounters` which are used by churn or are traced (e.g. as EKG +-- metrics). For this reason one has to be very careful when changing the +-- function, as it will affect the outbound governor behaviour. +-- +peerSelectionStateToView + :: Ord peeraddr + => PeerSelectionState peeraddr peerconn + -> PeerSelectionSetsWithSizes peeraddr +peerSelectionStateToView PeerSelectionState { knownPeers, establishedPeers, @@ -752,57 +950,83 @@ peerSelectionStateToCounters inProgressDemoteHot } = - PeerSelectionCounters { - numberOfRootPeers = Set.size rootPeersSet, - - numberOfKnownPeers = Set.size knownPeersSet, - numberOfColdPeersPromotions = Set.size $ inProgressPromoteCold Set.\\ bigLedgerSet, - numberOfEstablishedPeers = Set.size establishedPeersSet, - numberOfWarmPeersDemotions = Set.size $ inProgressDemoteWarm Set.\\ bigLedgerSet, - numberOfWarmPeersPromotions = Set.size $ inProgressPromoteWarm Set.\\ bigLedgerSet, - numberOfActivePeers = Set.size activePeersSet, - numberOfActivePeersDemotions = Set.size $ activePeersSet `Set.intersection` inProgressDemoteHot, - - numberOfKnownBigLedgerPeers = Set.size bigLedgerSet, - numberOfColdBigLedgerPeersPromotions = Set.size $ bigLedgerSet `Set.intersection` inProgressPromoteCold, - numberOfEstablishedBigLedgerPeers = Set.size establishedBigLedgerPeersSet, - numberOfWarmBigLedgerPeersDemotions = Set.size $ inProgressDemoteWarm `Set.intersection` bigLedgerSet, - numberOfWarmBigLedgerPeersPromotions = Set.size $ inProgressPromoteWarm `Set.intersection` bigLedgerSet, - numberOfActiveBigLedgerPeers = Set.size activeBigLedgerPeersSet, - numberOfActiveBigLedgerPeersDemotions = Set.size $ bigLedgerSet `Set.intersection` inProgressDemoteHot, - - - numberOfKnownBootstrapPeers = Set.size knownBootstrapPeersSet, - numberOfColdBootstrapPeersPromotions = Set.size $ knownBootstrapPeersSet `Set.intersection` inProgressPromoteCold, - numberOfEstablishedBootstrapPeers = Set.size establishedBootstrapPeersSet, - numberOfWarmBootstrapPeersDemotions = Set.size $ establishedBootstrapPeersSet `Set.intersection` inProgressDemoteWarm, - numberOfWarmBootstrapPeersPromotions = Set.size $ establishedBootstrapPeersSet `Set.intersection` inProgressPromoteWarm, - numberOfActiveBootstrapPeers = Set.size activeBootstrapPeersSet, - numberOfActiveBootstrapPeersDemotions = Set.size $ activeBootstrapPeersSet `Set.intersection` inProgressDemoteHot, - - numberOfKnownLocalRootPeers = Set.size knownLocalRootPeersSet, - numberOfEstablishedLocalRootPeers = Set.size $ establishedLocalRootsPeersSet, - numberOfWarmLocalRootPeersPromotions = Set.size $ establishedLocalRootsPeersSet `Set.intersection` inProgressPromoteWarm, - numberOfActiveLocalRootPeers = Set.size activeLocalRootsPeersSet, - numberOfActiveLocalRootPeersDemotions = Set.size $ activeLocalRootsPeersSet `Set.intersection` inProgressDemoteHot, - - numberOfKnownSharedPeers = Set.size knownSharedPeersSet, - numberOfColdSharedPeersPromotions = Set.size $ knownSharedPeersSet `Set.intersection` inProgressPromoteCold, - numberOfEstablishedSharedPeers = Set.size establishedSharedPeersSet, - numberOfWarmSharedPeersDemotions = Set.size $ establishedSharedPeersSet `Set.intersection` inProgressDemoteWarm, - numberOfWarmSharedPeersPromotions = Set.size $ establishedSharedPeersSet `Set.intersection` inProgressPromoteWarm, - numberOfActiveSharedPeers = Set.size activeSharedPeersSet, - numberOfActiveSharedPeersDemotions = Set.size $ activeSharedPeersSet `Set.intersection` inProgressDemoteHot + PeerSelectionView { + viewRootPeers = size rootPeersSet, + + viewKnownPeers = size knownPeersSet, + viewAvailableToConnectPeers = size $ availableToConnectSet + Set.\\ bigLedgerSet, + viewColdPeersPromotions = size $ inProgressPromoteCold + Set.\\ bigLedgerSet, + viewEstablishedPeers = size establishedPeersSet, + viewWarmPeersDemotions = size $ inProgressDemoteWarm + Set.\\ bigLedgerSet, + viewWarmPeersPromotions = size $ inProgressPromoteWarm + Set.\\ bigLedgerSet, + viewActivePeers = size $ activePeersSet, + viewActivePeersDemotions = size $ activePeersSet + `Set.intersection` inProgressDemoteHot, + + viewKnownBigLedgerPeers = size bigLedgerSet, + viewAvailableToConnectBigLedgerPeers = size $ availableToConnectSet + `Set.intersection` bigLedgerSet, + viewColdBigLedgerPeersPromotions = size $ bigLedgerSet + `Set.intersection` inProgressPromoteCold, + viewEstablishedBigLedgerPeers = size establishedBigLedgerPeersSet, + viewWarmBigLedgerPeersDemotions = size $ inProgressDemoteWarm + `Set.intersection` bigLedgerSet, + viewWarmBigLedgerPeersPromotions = size $ inProgressPromoteWarm + `Set.intersection` bigLedgerSet, + viewActiveBigLedgerPeers = size activeBigLedgerPeersSet, + viewActiveBigLedgerPeersDemotions = size $ bigLedgerSet + `Set.intersection` inProgressDemoteHot, + + + viewKnownBootstrapPeers = size knownBootstrapPeersSet, + viewColdBootstrapPeersPromotions = size $ knownBootstrapPeersSet + `Set.intersection` inProgressPromoteCold, + viewEstablishedBootstrapPeers = size establishedBootstrapPeersSet, + viewWarmBootstrapPeersDemotions = size $ establishedBootstrapPeersSet + `Set.intersection` inProgressDemoteWarm, + viewWarmBootstrapPeersPromotions = size $ establishedBootstrapPeersSet + `Set.intersection` inProgressPromoteWarm, + viewActiveBootstrapPeers = size activeBootstrapPeersSet, + viewActiveBootstrapPeersDemotions = size $ activeBootstrapPeersSet + `Set.intersection` inProgressDemoteHot, + + viewKnownLocalRootPeers = size knownLocalRootPeersSet, + viewAvailableToConnectLocalRootPeers = size $ availableToConnectSet + `Set.intersection` knownLocalRootPeersSet, + viewColdLocalRootPeersPromotions = size $ inProgressPromoteCold + `Set.intersection` knownLocalRootPeersSet, + + viewEstablishedLocalRootPeers = size $ establishedLocalRootsPeersSet, + viewWarmLocalRootPeersPromotions = size $ establishedLocalRootsPeersSet + `Set.intersection` inProgressPromoteWarm, + viewActiveLocalRootPeers = size activeLocalRootsPeersSet, + viewActiveLocalRootPeersDemotions = size $ activeLocalRootsPeersSet + `Set.intersection` inProgressDemoteHot, + + viewKnownSharedPeers = size knownSharedPeersSet, + viewColdSharedPeersPromotions = size $ knownSharedPeersSet + `Set.intersection` inProgressPromoteCold, + viewEstablishedSharedPeers = size establishedSharedPeersSet, + viewWarmSharedPeersDemotions = size $ establishedSharedPeersSet + `Set.intersection` inProgressDemoteWarm, + viewWarmSharedPeersPromotions = size $ establishedSharedPeersSet + `Set.intersection` inProgressPromoteWarm, + viewActiveSharedPeers = size activeSharedPeersSet, + viewActiveSharedPeersDemotions = size $ activeSharedPeersSet + `Set.intersection` inProgressDemoteHot } where - -- convention: only `{known,established,active}.*PeersSet` and - -- `inProgress{Promote,Demote}{Cold,Warm,Hot}` identifiers are used in the - -- calculations above ↑ + size s = (s, Set.size s) -- common sets knownSet = KnownPeers.toSet knownPeers establishedSet = EstablishedPeers.toSet establishedPeers bigLedgerSet = PublicRootPeers.getBigLedgerPeers publicRootPeers + availableToConnectSet = KnownPeers.availableToConnect knownPeers -- root peers rootPeersSet = PublicRootPeers.toSet publicRootPeers @@ -841,49 +1065,59 @@ peerSelectionStateToCounters activeSharedPeersSet = activePeersSet Set.\\ rootPeersSet +peerSelectionStateToCounters + :: Ord peeraddr + => PeerSelectionState peeraddr peerconn + -> PeerSelectionCounters +peerSelectionStateToCounters = fmap snd . peerSelectionStateToView + emptyPeerSelectionCounters :: PeerSelectionCounters emptyPeerSelectionCounters = PeerSelectionCounters { - numberOfRootPeers = 0, - - numberOfKnownPeers = 0, - numberOfColdPeersPromotions = 0, - numberOfEstablishedPeers = 0, - numberOfWarmPeersDemotions = 0, - numberOfWarmPeersPromotions = 0, - numberOfActivePeers = 0, - numberOfActivePeersDemotions = 0, - - numberOfKnownBigLedgerPeers = 0, - numberOfColdBigLedgerPeersPromotions = 0, - numberOfEstablishedBigLedgerPeers = 0, - numberOfWarmBigLedgerPeersDemotions = 0, - numberOfWarmBigLedgerPeersPromotions = 0, - numberOfActiveBigLedgerPeers = 0, - numberOfActiveBigLedgerPeersDemotions = 0, - - numberOfKnownBootstrapPeers = 0, - numberOfColdBootstrapPeersPromotions = 0, - numberOfEstablishedBootstrapPeers = 0, - numberOfWarmBootstrapPeersDemotions = 0, - numberOfWarmBootstrapPeersPromotions = 0, - numberOfActiveBootstrapPeers = 0, - numberOfActiveBootstrapPeersDemotions = 0, - - numberOfKnownLocalRootPeers = 0, - numberOfEstablishedLocalRootPeers = 0, - numberOfWarmLocalRootPeersPromotions = 0, - numberOfActiveLocalRootPeers = 0, - numberOfActiveLocalRootPeersDemotions = 0, - - numberOfKnownSharedPeers = 0, - numberOfColdSharedPeersPromotions = 0, - numberOfEstablishedSharedPeers = 0, - numberOfWarmSharedPeersDemotions = 0, - numberOfWarmSharedPeersPromotions = 0, - numberOfActiveSharedPeers = 0, - numberOfActiveSharedPeersDemotions = 0 + numberOfRootPeers = 0, + + numberOfKnownPeers = 0, + numberOfAvailableToConnectPeers = 0, + numberOfColdPeersPromotions = 0, + numberOfEstablishedPeers = 0, + numberOfWarmPeersDemotions = 0, + numberOfWarmPeersPromotions = 0, + numberOfActivePeers = 0, + numberOfActivePeersDemotions = 0, + + numberOfKnownBigLedgerPeers = 0, + numberOfAvailableToConnectBigLedgerPeers = 0, + numberOfColdBigLedgerPeersPromotions = 0, + numberOfEstablishedBigLedgerPeers = 0, + numberOfWarmBigLedgerPeersDemotions = 0, + numberOfWarmBigLedgerPeersPromotions = 0, + numberOfActiveBigLedgerPeers = 0, + numberOfActiveBigLedgerPeersDemotions = 0, + + numberOfKnownBootstrapPeers = 0, + numberOfColdBootstrapPeersPromotions = 0, + numberOfEstablishedBootstrapPeers = 0, + numberOfWarmBootstrapPeersDemotions = 0, + numberOfWarmBootstrapPeersPromotions = 0, + numberOfActiveBootstrapPeers = 0, + numberOfActiveBootstrapPeersDemotions = 0, + + numberOfKnownLocalRootPeers = 0, + numberOfAvailableToConnectLocalRootPeers = 0, + numberOfColdLocalRootPeersPromotions = 0, + numberOfEstablishedLocalRootPeers = 0, + numberOfWarmLocalRootPeersPromotions = 0, + numberOfActiveLocalRootPeers = 0, + numberOfActiveLocalRootPeersDemotions = 0, + + numberOfKnownSharedPeers = 0, + numberOfColdSharedPeersPromotions = 0, + numberOfEstablishedSharedPeers = 0, + numberOfWarmSharedPeersDemotions = 0, + numberOfWarmSharedPeersPromotions = 0, + numberOfActiveSharedPeers = 0, + numberOfActiveSharedPeersDemotions = 0 } emptyPeerSelectionState :: StdGen