p2p-governor: add Tepid flag

Add a tepid flag which tracks if a peer has been hot but was demoted.

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

@@ -72,7 +72,7 @@ simplePeerSelectionPolicy rngVar getChurnMode metrics = PeerSelectionPolicy {
       return available'
 
     hotDemotionPolicy :: PickPolicy SockAddr m
-    hotDemotionPolicy _ _ available pickNum = do
+    hotDemotionPolicy _ _ _ available pickNum = do
         mode <- getChurnMode
         scores <- case mode of
                        ChurnModeNormal ->
@@ -89,7 +89,7 @@ simplePeerSelectionPolicy rngVar getChurnMode metrics = PeerSelectionPolicy {
              $ available'
 
     simplePromotionPolicy :: PickPolicy SockAddr m
-    simplePromotionPolicy _ _ available pickNum = do
+    simplePromotionPolicy _ _ _ available pickNum = do
       available' <- addRand available
       return $ Set.fromList
              . map fst
@@ -99,7 +99,7 @@ simplePeerSelectionPolicy rngVar getChurnMode metrics = PeerSelectionPolicy {
              $ available'
 
     simpleDemotionPolicy :: PickPolicy SockAddr m
-    simpleDemotionPolicy _ _ available pickNum = do
+    simpleDemotionPolicy _ _ _ available pickNum = do
       available' <- addRand available
       return $ Set.fromList
              . map fst

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

@@ -23,6 +23,7 @@ import           System.Random (randomR)
 import qualified Ouroboros.Network.PeerSelection.EstablishedPeers as EstablishedPeers
 import qualified Ouroboros.Network.PeerSelection.KnownPeers as KnownPeers
 import qualified Ouroboros.Network.PeerSelection.LocalRootPeers as LocalRootPeers
+import           Ouroboros.Network.PeerSelection.KnownPeers (setTepidFlag)
 import           Ouroboros.Network.PeerSelection.Governor.Types
 
 
@@ -476,19 +477,22 @@ jobDemoteActivePeer PeerSelectionActions{peerStateActions = PeerStateActions {de
       deactivatePeerConnection peerconn
       return $ Completion $ \st@PeerSelectionState {
                                 activePeers,
+                                knownPeers,
                                 targets = PeerSelectionTargets {
                                             targetNumberOfActivePeers
                                           }
                              }
                              _now ->
         assert (peeraddr `EstablishedPeers.member` establishedPeers st) $
-        let activePeers' = Set.delete peeraddr activePeers in
+        let activePeers' = Set.delete peeraddr activePeers
+            knownPeers'  = setTepidFlag peeraddr knownPeers in
         Decision {
           decisionTrace = TraceDemoteHotDone targetNumberOfActivePeers
                                              (Set.size activePeers')
                                              peeraddr,
           decisionState = st {
                             activePeers         = activePeers',
+                            knownPeers          = knownPeers',
                             inProgressDemoteHot = Set.delete peeraddr
                                                     (inProgressDemoteHot st)
                           },

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

@@ -284,13 +284,19 @@ jobPromoteColdPeer PeerSelectionActions {
       peerconn <- establishPeerConnection peeraddr
       return $ Completion $ \st@PeerSelectionState {
                                establishedPeers,
+                               knownPeers,
                                targets = PeerSelectionTargets {
                                            targetNumberOfEstablishedPeers
                                          }
                              }
                              _now ->
         let establishedPeers' = EstablishedPeers.insert peeraddr peerconn
                                                         establishedPeers
+            knownPeers'       = KnownPeers.clearTepidFlag peeraddr $
+                                    KnownPeers.resetFailCount
+                                        peeraddr
+                                        knownPeers
+
         in Decision {
              decisionTrace = TracePromoteColdDone targetNumberOfEstablishedPeers
                                                   (EstablishedPeers.size establishedPeers')
@@ -299,9 +305,7 @@ jobPromoteColdPeer PeerSelectionActions {
                                establishedPeers      = establishedPeers',
                                inProgressPromoteCold = Set.delete peeraddr
                                                          (inProgressPromoteCold st),
-                               knownPeers            = KnownPeers.resetFailCount
-                                                         peeraddr
-                                                         (knownPeers st)
+                               knownPeers            = knownPeers'
                              },
              decisionJobs  = []
            }

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

@@ -77,6 +77,7 @@ type PickPolicy peeraddr m =
          -- As more attributes are needed, extend this with more such functions.
          (peeraddr -> PeerSource) -- Where the peer is known from
       -> (peeraddr -> Int)        -- Connection failure count
+      -> (peeraddr -> Bool)       -- Found to be tepid flag
       -> Set peeraddr             -- The set to pick from
       -> Int                      -- Max number to choose, fewer is ok.
       -> STM m (Set peeraddr)     -- The set picked.
@@ -432,13 +433,14 @@ pickPeers :: (Ord peeraddr, Functor m)
           => PeerSelectionState peeraddr peerconn
           -> (   (peeraddr -> PeerSource)
               -> (peeraddr -> Int)
+              -> (peeraddr -> Bool)
               -> Set peeraddr -> Int -> m (Set peeraddr))
           -> Set peeraddr -> Int -> m (Set peeraddr)
 pickPeers PeerSelectionState{localRootPeers, publicRootPeers, knownPeers}
           pick available num =
     assert precondition $
     fmap (\picked -> assert (postcondition picked) picked)
-         (pick peerSource peerConnectFailCount
+         (pick peerSource peerConnectFailCount peerTepidFlag
                available numClamped)
   where
     precondition         = not (Set.null available) && num > 0
@@ -457,6 +459,10 @@ pickPeers PeerSelectionState{localRootPeers, publicRootPeers, knownPeers}
         fromMaybe errorUnavailable $
           KnownPeers.lookupFailCount p knownPeers
 
+    peerTepidFlag p  =
+        fromMaybe errorUnavailable $
+          KnownPeers.lookupTepidFlag p knownPeers
+
     errorUnavailable =
         error $ "A pick policy requested an attribute for peer address "
              ++ " which is outside of the set given to pick from"

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

@@ -21,6 +21,9 @@ module Ouroboros.Network.PeerSelection.KnownPeers (
     incrementFailCount,
     resetFailCount,
     lookupFailCount,
+    lookupTepidFlag,
+    setTepidFlag,
+    clearTepidFlag,
 
     -- ** Tracking when we can gossip
     minGossipTime,
@@ -99,7 +102,10 @@ data KnownPeerInfo = KnownPeerInfo {
        -- It is used to implement the exponential backoff strategy and may also
        -- be used by policies to select peers to forget.
        --
-       knownPeerFailCount :: !Int
+       knownPeerFailCount :: !Int,
+
+       -- | Indicates if the peer was hot but then got demoted.
+       knownPeerTepid     :: !Bool
      }
   deriving (Eq, Show)
 
@@ -190,10 +196,12 @@ insert peeraddrs
     newPeerInfo _peeraddr =
       KnownPeerInfo {
         knownPeerFailCount = 0
+      , knownPeerTepid     = False
       }
     mergePeerInfo old _new =
       KnownPeerInfo {
         knownPeerFailCount = knownPeerFailCount old
+      , knownPeerTepid     = knownPeerTepid old
       }
 
 delete :: Ord peeraddr
@@ -307,6 +315,36 @@ lookupFailCount peeraddr KnownPeers{allPeers} =
     knownPeerFailCount <$> Map.lookup peeraddr allPeers
 
 
+lookupTepidFlag :: Ord peeraddr
+                => peeraddr
+                -> KnownPeers peeraddr
+                -> Maybe Bool
+lookupTepidFlag peeraddr KnownPeers{allPeers} =
+    knownPeerTepid <$> Map.lookup peeraddr allPeers
+
+setTepidFlag' :: Ord peeraddr
+             => Bool
+             -> peeraddr
+             -> KnownPeers peeraddr
+             -> KnownPeers peeraddr
+setTepidFlag' val peeraddr knownPeers@KnownPeers{allPeers} =
+    assert (peeraddr `Map.member` allPeers) $
+    knownPeers { allPeers = Map.update (\kpi  -> Just kpi { knownPeerTepid = val })
+                              peeraddr allPeers
+               }
+
+clearTepidFlag :: Ord peeraddr
+             => peeraddr
+             -> KnownPeers peeraddr
+             -> KnownPeers peeraddr
+clearTepidFlag = setTepidFlag' False
+
+setTepidFlag :: Ord peeraddr
+             => peeraddr
+             -> KnownPeers peeraddr
+             -> KnownPeers peeraddr
+setTepidFlag = setTepidFlag' True
+
 -------------------------------
 -- Tracking when we can gossip
 --

ouroboros-network/test/Test/Ouroboros/Network/PeerSelection.hs

@@ -1932,12 +1932,12 @@ _governorFindingPublicRoots targetNumberOfRootPeers readDomains =
 
     policy :: PeerSelectionPolicy SockAddr IO
     policy  = PeerSelectionPolicy {
-                policyPickKnownPeersForGossip = \_ _ -> pickTrivially,
-                policyPickColdPeersToForget   = \_ _ -> pickTrivially,
-                policyPickColdPeersToPromote  = \_ _ -> pickTrivially,
-                policyPickWarmPeersToPromote  = \_ _ -> pickTrivially,
-                policyPickHotPeersToDemote    = \_ _ -> pickTrivially,
-                policyPickWarmPeersToDemote   = \_ _ -> pickTrivially,
+                policyPickKnownPeersForGossip = \_ _ _ -> pickTrivially,
+                policyPickColdPeersToForget   = \_ _ _ -> pickTrivially,
+                policyPickColdPeersToPromote  = \_ _ _ -> pickTrivially,
+                policyPickWarmPeersToPromote  = \_ _ _ -> pickTrivially,
+                policyPickHotPeersToDemote    = \_ _ _ -> pickTrivially,
+                policyPickWarmPeersToDemote   = \_ _ _ -> pickTrivially,
                 policyFindPublicRootTimeout   = 5,
                 policyMaxInProgressGossipReqs = 0,
                 policyGossipRetryTime         = 0, -- seconds

ouroboros-network/test/Test/Ouroboros/Network/PeerSelection/MockEnvironment.hs

@@ -434,12 +434,12 @@ mockPeerSelectionPolicy GovernorMockEnvironment {
     pickWarmPeersToDemoteVar   <- initScript pickWarmPeersToDemote
     pickColdPeersToForgetVar   <- initScript pickColdPeersToForget
     return PeerSelectionPolicy {
-      policyPickKnownPeersForGossip = \_ _ -> interpretPickScript pickKnownPeersForGossipVar,
-      policyPickColdPeersToPromote  = \_ _ -> interpretPickScript pickColdPeersToPromoteVar,
-      policyPickWarmPeersToPromote  = \_ _ -> interpretPickScript pickWarmPeersToPromoteVar,
-      policyPickHotPeersToDemote    = \_ _ -> interpretPickScript pickHotPeersToDemoteVar,
-      policyPickWarmPeersToDemote   = \_ _ -> interpretPickScript pickWarmPeersToDemoteVar,
-      policyPickColdPeersToForget   = \_ _ -> interpretPickScript pickColdPeersToForgetVar,
+      policyPickKnownPeersForGossip = \_ _ _ -> interpretPickScript pickKnownPeersForGossipVar,
+      policyPickColdPeersToPromote  = \_ _ _ -> interpretPickScript pickColdPeersToPromoteVar,
+      policyPickWarmPeersToPromote  = \_ _ _ -> interpretPickScript pickWarmPeersToPromoteVar,
+      policyPickHotPeersToDemote    = \_ _ _ -> interpretPickScript pickHotPeersToDemoteVar,
+      policyPickWarmPeersToDemote   = \_ _ _ -> interpretPickScript pickWarmPeersToDemoteVar,
+      policyPickColdPeersToForget   = \_ _ _ -> interpretPickScript pickColdPeersToForgetVar,
       policyFindPublicRootTimeout   = 5,    -- seconds
       policyMaxInProgressGossipReqs = 2,
       policyGossipRetryTime         = 3600, -- seconds