Added WarmValency to local root configuration

ouroboros-network/CHANGELOG.md

@@ -9,6 +9,7 @@
   * Added `readNewInboundConnection` field to `PeerSelectionActions` record.
 * The constructor `FetchDeclineChainNoIntersection` was renamed to
   `FetchDeclineChainIntersectionTooDeep` (#4541)
+- Include Warm Valency for Local Root Peers
 
 ### Non-breaking changes
 

ouroboros-network/src/Ouroboros/Network/Diffusion/P2P.hs

@@ -108,6 +108,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
@@ -226,7 +228,7 @@ 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.
     --

ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor.hs

@@ -454,7 +454,7 @@ peerSelectionGovernor :: ( Alternative (STM m)
                       -> m Void
 peerSelectionGovernor tracer debugTracer countersTracer fuzzRng stateVar actions policy =
     JobPool.withJobPool $ \jobPool -> do
-      localPeers <- map (\(target, _) -> (target, 0))
+      localPeers <- map (\(h, w, _) -> (h, w, 0))
                 <$> atomically (readLocalRootPeers actions)
       peerSelectionGovernorLoop
         tracer

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

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)
@@ -77,46 +79,44 @@ belowTargetLocal actions
                    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. We need to take into account peers which are being
+    -- promoted to Warm, and peers which are being demoted to Cold.
+
+    -- Are there any groups where we can pick members to promote?
+  , let groupsAvailableToPromote =
+          [ (numMembersToPromote, membersAvailableToPromote)
+          | let availableToPromote =
+                  localAvailableToConnect
+                     Set.\\ localEstablishedPeers
+                     Set.\\ localConnectInProgress
+          , not (Set.null availableToPromote)
+          , (WarmValency warmTarget, members, membersEstablished) <- groupsBelowTarget
+          , let membersAvailableToPromote = Set.intersection members availableToPromote
+                numMembersToPromote       = warmTarget
+                                          - Set.size membersEstablished
+                                          - 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 +126,34 @@ 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.
+          localRootPeersSet
+             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
     numLocalConnectInProgress  = Set.size localConnectInProgress
 
 

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,9 @@ 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)],
 
        readNewInboundConnection :: STM m (peeraddr, PeerSharing),
 
@@ -377,7 +380,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
@@ -389,13 +392,13 @@ peerStateToCounters st = PeerSelectionCounters { coldPeers, warmPeers, hotPeers,
     warmPeers  = Set.size $ establishedPeersSet Set.\\ activePeers st
     hotPeers   = Set.size $ activePeers st
     localRoots =
-      [ (target, active)
-      | (target, members) <- LocalRootPeers.toGroupSets (localRootPeers st)
+      [ (h, w, active)
+      | (h, w, members) <- LocalRootPeers.toGroupSets (localRootPeers st)
       , let active = Set.size (members `Set.intersection` activePeers st)
       ]
 
 emptyPeerSelectionState :: StdGen
-                        -> [(Int, Int)]
+                        -> [(HotValency, WarmValency, Int)]
                         -> PeerSelectionState peeraddr peerconn
 emptyPeerSelectionState rng localRoots =
     PeerSelectionState {
@@ -662,8 +665,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
@@ -672,8 +674,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
@@ -693,7 +696,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