Added WarmValency to local root configuration

Refactor Governor established belowTargetLocal job Refactor progress to established target test
IntersectMBO · May 29, 2023 · 913d184 · 913d184
1 parent fe1479b
commit 913d184
Show file tree

Hide file tree

Showing 13 changed files with 292 additions and 162 deletions.
diff --git a/ouroboros-network/src/Ouroboros/Network/Diffusion/P2P.hs b/ouroboros-network/src/Ouroboros/Network/Diffusion/P2P.hs
@@ -104,6 +104,8 @@ import           Ouroboros.Network.PeerSelection.Governor.Types
                      TracePeerSelection (..), emptyPublicPeerSelectionState)
 import           Ouroboros.Network.PeerSelection.LedgerPeers
                      (UseLedgerAfter (..), withLedgerPeers)
+import           Ouroboros.Network.PeerSelection.LocalRootPeers (HotValency,
+                     WarmValency)
 import           Ouroboros.Network.PeerSelection.PeerMetric (PeerMetrics)
 import           Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing)
 import           Ouroboros.Network.PeerSelection.PeerStateActions
@@ -220,7 +222,8 @@ data ArgumentsExtra m = ArgumentsExtra {
       --
       daPeerSelectionTargets :: PeerSelectionTargets
 
-    , daReadLocalRootPeers  :: STM m [(Int, Map RelayAccessPoint PeerAdvertise)]
+    , daReadLocalRootPeers  :: STM m [( (HotValency, WarmValency)
+                                      , Map RelayAccessPoint PeerAdvertise)]
     , daReadPublicRootPeers :: STM m (Map RelayAccessPoint PeerAdvertise)
     -- | Peer's own PeerSharing value.
     --

diff --git a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/ActivePeers.hs b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/ActivePeers.hs
@@ -26,6 +26,8 @@ import qualified Ouroboros.Network.PeerSelection.EstablishedPeers as Established
 import           Ouroboros.Network.PeerSelection.Governor.Types
 import           Ouroboros.Network.PeerSelection.KnownPeers (setTepidFlag)
 import qualified Ouroboros.Network.PeerSelection.KnownPeers as KnownPeers
+import           Ouroboros.Network.PeerSelection.LocalRootPeers
+                     (HotValency (..))
 import qualified Ouroboros.Network.PeerSelection.LocalRootPeers as LocalRootPeers
 
 
@@ -81,10 +83,10 @@ belowTargetLocal actions
                      Set.\\ inProgressDemoteWarm
                 numPromoteInProgress = Set.size inProgressPromoteWarm
           , not (Set.null availableToPromote)
-          , (target, members, membersActive) <- groupsBelowTarget
+          , (HotValency hotTarget, members, membersActive) <- groupsBelowTarget
           , let membersAvailableToPromote = Set.intersection
                                               members availableToPromote
-                numMembersToPromote       = target
+                numMembersToPromote       = hotTarget
                                           - Set.size membersActive
                                           - numPromoteInProgress
           , not (Set.null membersAvailableToPromote)
@@ -135,10 +137,10 @@ belowTargetLocal actions
   = GuardedSkip Nothing
   where
     groupsBelowTarget =
-      [ (target, members, membersActive)
-      | (target, members) <- LocalRootPeers.toGroupSets localRootPeers
+      [ (hotValency, members, membersActive)
+      | ((hotValency, _), members) <- LocalRootPeers.toGroupSets localRootPeers
       , let membersActive = members `Set.intersection` activePeers
-      , Set.size membersActive < target
+      , Set.size membersActive < getHotValency hotValency
       ]
 
 belowTargetOther :: forall peeraddr peerconn m.
@@ -357,10 +359,10 @@ aboveTargetLocal actions
                  }
     -- Are there any groups of local peers that are below target?
   | let groupsAboveTarget =
-          [ (target, members, membersActive)
-          | (target, members) <- LocalRootPeers.toGroupSets localRootPeers
+          [ (hotValency, members, membersActive)
+          | ((hotValency, _), members) <- LocalRootPeers.toGroupSets localRootPeers
           , let membersActive = members `Set.intersection` activePeers
-          , Set.size membersActive > target
+          , Set.size membersActive > getHotValency hotValency
           ]
   , not (null groupsAboveTarget)
     -- We need this detailed check because it is not enough to check we are
@@ -376,11 +378,11 @@ aboveTargetLocal actions
                                        Set.\\ inProgressDemoteHot
                 numDemoteInProgress = Set.size inProgressDemoteHot
           , not (Set.null availableToDemote)
-          , (target, members, membersActive) <- groupsAboveTarget
+          , (HotValency hotTarget, members, membersActive) <- groupsAboveTarget
           , let membersAvailableToDemote = Set.intersection
                                              members availableToDemote
                 numMembersToDemote       = Set.size membersActive
-                                         - target
+                                         - hotTarget
                                          - numDemoteInProgress
           , not (Set.null membersAvailableToDemote)
           , numMembersToDemote > 0

diff --git a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/EstablishedPeers.hs b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/EstablishedPeers.hs
@@ -23,6 +23,8 @@ import           System.Random (randomR)
 import qualified Ouroboros.Network.PeerSelection.EstablishedPeers as EstablishedPeers
 import           Ouroboros.Network.PeerSelection.Governor.Types
 import qualified Ouroboros.Network.PeerSelection.KnownPeers as KnownPeers
+import           Ouroboros.Network.PeerSelection.LocalRootPeers
+                     (WarmValency (..))
 import qualified Ouroboros.Network.PeerSelection.LocalRootPeers as LocalRootPeers
 
 
@@ -59,8 +61,8 @@ belowTarget :: forall peeraddr peerconn m.
 belowTarget = belowTargetLocal <> belowTargetOther
 
 
--- | For locally configured root peers we have the (implicit) target that they
--- should all be warm peers all the time.
+-- | For locally configured root peers we have the explicit target that comes from local
+-- configuration.
 --
 belowTargetLocal :: forall peeraddr peerconn m.
                    (MonadSTM m, Ord peeraddr)
@@ -74,49 +76,48 @@ belowTargetLocal actions
                    localRootPeers,
                    knownPeers,
                    establishedPeers,
+                   inProgressDemoteWarm,
                    inProgressPromoteCold
                  }
 
-    -- Are we below the target for number of /local/ root peers that are
-    -- established? Our target for established local root peers is all of them!
-    -- However we still don't want to go over the number of established peers
-    -- or we'll end up in a cycle.
-  | numLocalEstablishedPeers + numLocalConnectInProgress
-  < targetNumberOfLocalPeers
-
-    -- Are there any /local/ root peers that are cold we could possibly pick to
-    -- connect to? We can subtract the local 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.
-  , numLocalAvailableToConnect - numLocalEstablishedPeers
-                               - numLocalConnectInProgress > 0
-  --TODO: switch style to checking if the set is empty
+    -- Are there any groups of local peers that are below target?
+  | not (null groupsBelowTarget)
+    -- We need this detailed check because it is not enough to check we are
+    -- below an aggregate target. We can be above target for some groups
+    -- and below for others.
+
+    -- Are there any groups where we can pick members to promote?
+  , let groupsAvailableToPromote =
+          [ (numMembersToPromote, membersAvailableToPromote)
+          | let availableToPromote =
+                  localAvailableToConnect
+                     Set.\\ localEstablishedPeers
+                     Set.\\ localConnectInProgress
+                     Set.\\ localDemoteInProgress
+          , not (Set.null availableToPromote)
+          , (WarmValency warmTarget, members, membersLocalEstablished) <- groupsBelowTarget
+          , let membersAvailableToPromote = Set.intersection members availableToPromote
+                numMembersToPromote       = warmTarget
+                                          - Set.size membersLocalEstablished
+                                          - numLocalConnectInProgress
+          , not (Set.null membersAvailableToPromote)
+          , numMembersToPromote > 0
+          ]
+  , not (null groupsAvailableToPromote)
   = 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 = localAvailableToConnect
-                                 Set.\\ localEstablishedPeers
-                                 Set.\\ localConnectInProgress
+      selectedToPromote <-
+        Set.unions <$> sequence
+          [ pickPeers st
+              policyPickColdPeersToPromote
+              membersAvailableToPromote
+              numMembersToPromote
+          | (numMembersToPromote,
+             membersAvailableToPromote) <- groupsAvailableToPromote ]
 
-          numPeersToPromote  = targetNumberOfLocalPeers
-                             - numLocalEstablishedPeers
-                             - numLocalConnectInProgress
-      selectedToPromote <- pickPeers st
-                             policyPickColdPeersToPromote
-                             availableToPromote
-                             numPeersToPromote
       return $ \_now -> Decision {
         decisionTrace = [TracePromoteColdLocalPeers
-                           targetNumberOfLocalPeers
-                           numLocalEstablishedPeers
+                           [ (target, Set.size membersEstablished)
+                           | (target, _, membersEstablished) <- groupsBelowTarget ]
                            selectedToPromote],
         decisionState = st {
                           inProgressPromoteCold = inProgressPromoteCold
@@ -126,28 +127,35 @@ belowTargetLocal actions
                         | peer <- Set.toList selectedToPromote ]
       }
 
-    -- If we could connect to a local root peer except that there are no local
-    -- root peers currently available then we return the next wakeup time (if any)
-    -- TODO: Note that this may wake up too soon, since it considers non-local
-    -- known peers too for the purpose of the wakeup time.
-  | numLocalEstablishedPeers + numLocalConnectInProgress < targetNumberOfLocalPeers
+    -- If we could promote except that there are no peers currently available
+    -- then we return the next wakeup time (if any)
+  | not (null groupsBelowTarget)
+  , let potentialToPromote =
+          -- These are local peers that are cold but not ready.
+          LocalRootPeers.keysSet localRootPeers
+             Set.\\ localEstablishedPeers
+             Set.\\ KnownPeers.availableToConnect knownPeers
+  , not (Set.null potentialToPromote)
   = GuardedSkip (Min <$> KnownPeers.minConnectTime knownPeers)
 
   | otherwise
   = GuardedSkip Nothing
   where
-    localRootPeersSet          = LocalRootPeers.keysSet localRootPeers
-    targetNumberOfLocalPeers   = LocalRootPeers.size localRootPeers
+    groupsBelowTarget =
+      [ (warmValency, members, membersEstablished)
+      | ((_, warmValency), members) <- LocalRootPeers.toGroupSets localRootPeers
+      , let membersEstablished = members `Set.intersection` EstablishedPeers.toSet establishedPeers
+      , Set.size membersEstablished < getWarmValency warmValency
+      ]
 
+    localRootPeersSet          = LocalRootPeers.keysSet localRootPeers
     localEstablishedPeers      = EstablishedPeers.toSet establishedPeers
-                                  `Set.intersection` localRootPeersSet
     localAvailableToConnect    = KnownPeers.availableToConnect knownPeers
                                   `Set.intersection` localRootPeersSet
     localConnectInProgress     = inProgressPromoteCold
                                   `Set.intersection` localRootPeersSet
-
-    numLocalEstablishedPeers   = Set.size localEstablishedPeers
-    numLocalAvailableToConnect = Set.size localAvailableToConnect
+    localDemoteInProgress      = inProgressDemoteWarm
+                                  `Set.intersection` localRootPeersSet
     numLocalConnectInProgress  = Set.size localConnectInProgress
 
 

diff --git a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/Types.hs b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/Types.hs
@@ -67,7 +67,8 @@ import qualified Ouroboros.Network.PeerSelection.EstablishedPeers as Established
 import           Ouroboros.Network.PeerSelection.KnownPeers (KnownPeers)
 import qualified Ouroboros.Network.PeerSelection.KnownPeers as KnownPeers
 import           Ouroboros.Network.PeerSelection.LedgerPeers (IsLedgerPeer)
-import           Ouroboros.Network.PeerSelection.LocalRootPeers (LocalRootPeers)
+import           Ouroboros.Network.PeerSelection.LocalRootPeers (HotValency,
+                     LocalRootPeers, WarmValency)
 import qualified Ouroboros.Network.PeerSelection.LocalRootPeers as LocalRootPeers
 import           Ouroboros.Network.PeerSelection.PeerAdvertise (PeerAdvertise)
 import           Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing)
@@ -202,7 +203,8 @@ data PeerSelectionActions peeraddr peerconn m = PeerSelectionActions {
        -- It is structured as a collection of (non-overlapping) groups of peers
        -- where we are supposed to select n from each group.
        --
-       readLocalRootPeers       :: STM m [(Int, Map peeraddr PeerAdvertise)],
+       readLocalRootPeers       :: STM m [( (HotValency, WarmValency)
+                                          , Map peeraddr PeerAdvertise)],
 
        -- | Read the current Peer Sharing willingness value
        --
@@ -375,7 +377,7 @@ data PeerSelectionCounters = PeerSelectionCounters {
       coldPeers  :: Int,
       warmPeers  :: Int,
       hotPeers   :: Int,
-      localRoots :: [(Int, Int)]
+      localRoots :: [((HotValency, WarmValency), Int)]
     } deriving (Eq, Show)
 
 peerStateToCounters :: Ord peeraddr => PeerSelectionState peeraddr peerconn -> PeerSelectionCounters
@@ -393,7 +395,7 @@ peerStateToCounters st = PeerSelectionCounters { coldPeers, warmPeers, hotPeers,
       ]
 
 emptyPeerSelectionState :: StdGen
-                        -> [(Int, Int)]
+                        -> [((HotValency, WarmValency), Int)]
                         -> PeerSelectionState peeraddr peerconn
 emptyPeerSelectionState rng localRoots =
     PeerSelectionState {
@@ -659,8 +661,7 @@ data TracePeerSelection peeraddr =
      -- | target established, actual established, selected peers
      | TracePromoteColdPeers   Int Int (Set peeraddr)
      -- | target local established, actual local established, selected peers
-     | TracePromoteColdLocalPeers Int Int (Set peeraddr)
-     -- | target established, actual established, peer, delay until next
+     | TracePromoteColdLocalPeers [(WarmValency, Int)] (Set peeraddr)
      -- promotion, reason
      | TracePromoteColdFailed  Int Int peeraddr DiffTime SomeException
      -- | target established, actual established, peer
@@ -669,8 +670,9 @@ data TracePeerSelection peeraddr =
      | TracePromoteWarmPeers   Int Int (Set peeraddr)
      -- | Promote local peers to warm
      | TracePromoteWarmLocalPeers
-         [(Int, Int)]   -- ^ local per-group `(target active, actual active)`,
-                        -- only limited to groups which are below their target.
+         [(HotValency, Int)]
+         -- ^ local per-group `(target active, actual active)`,
+         -- only limited to groups which are below their target.
          (Set peeraddr) -- ^ selected peers
      -- | target active, actual active, peer, reason
      | TracePromoteWarmFailed  Int Int peeraddr SomeException
@@ -690,7 +692,7 @@ data TracePeerSelection peeraddr =
      -- | target active, actual active, selected peers
      | TraceDemoteHotPeers     Int Int (Set peeraddr)
      -- | local per-group (target active, actual active), selected peers
-     | TraceDemoteLocalHotPeers [(Int, Int)] (Set peeraddr)
+     | TraceDemoteLocalHotPeers [(HotValency, Int)] (Set peeraddr)
      -- | target active, actual active, peer, reason
      | TraceDemoteHotFailed    Int Int peeraddr SomeException
      -- | target active, actual active, peer