outbound-governor: light peer sharing using readInboundPeers API

This patch also update `PeerSelection` tests to cover inbound peers.

ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/PeerSelection.hs

@@ -701,7 +701,7 @@ traceNum TraceDemoteWarmBigLedgerPeerDone{}                   = 43
 traceNum TraceDemoteHotBigLedgerPeers{}                       = 44
 traceNum TraceDemoteHotBigLedgerPeerFailed{}                  = 45
 traceNum TraceDemoteHotBigLedgerPeerDone{}                    = 46
-traceNum TraceKnownInboundConnection{}                        = 47
+traceNum TracePickInboundPeers{}                              = 47
 traceNum TraceDemoteBigLedgerPeersAsynchronous{}              = 48
 traceNum TraceLedgerStateJudgementChanged{}                   = 49
 traceNum TraceOnlyBootstrapPeers{}                            = 50
@@ -760,14 +760,15 @@ allTraceNames =
    , (44, "TraceDemoteHotBigLedgerPeers")
    , (45, "TraceDemoteHotBigLedgerPeerFailed")
    , (46, "TraceDemoteHotBigLedgerPeerDone")
-   , (47, "TraceKnownInboundConnection")
+   , (47, "TracePickInboundPeers")
    , (48, "TraceDemoteBigLedgerPeersAsynchronous")
    , (49, "TraceLedgerStateJudgementChanged")
    , (50, "TraceOnlyBootstrapPeers")
    , (51, "TraceBootstrapPeersFlagChangedWhilstInSensitiveState")
    , (52, "TraceUseBootstrapPeersChanged")
    , (53, "TraceOutboundGovernorCriticalFailure")
    , (54, "TraceDebugState")
+   , (55, "TracePickInboundPeers")
    ]
 
 
@@ -3381,6 +3382,7 @@ _governorFindingPublicRoots targetNumberOfRootPeers readDomains readUseBootstrap
                 policyPickWarmPeersToPromote  = \_ _ _ -> pickTrivially,
                 policyPickHotPeersToDemote    = \_ _ _ -> pickTrivially,
                 policyPickWarmPeersToDemote   = \_ _ _ -> pickTrivially,
+                policyPickInboundPeers        = \_ _ _ -> pickTrivially,
                 policyFindPublicRootTimeout   = 5,
                 policyMaxInProgressPeerShareReqs = 0,
                 policyPeerShareRetryTime         = 0, -- seconds
@@ -3425,6 +3427,7 @@ prop_issue_3550 = prop_governor_target_established_below defaultMaxTime $
       pickHotPeersToDemote = Script (PickSome (Set.fromList [PeerAddr 29]) :| []),
       pickWarmPeersToDemote = Script (PickFirst :| []),
       pickColdPeersToForget = Script (PickFirst :| []),
+      pickInboundPeers      = Script (PickFirst :| []),
       peerSharing = PeerSharingEnabled,
       useBootstrapPeers = Script ((DontUseBootstrapPeers, NoDelay) :| []),
       ledgerStateJudgement = Script ((YoungEnough, NoDelay) :| [])
@@ -3461,6 +3464,7 @@ prop_issue_3515 = prop_governor_nolivelock $
       pickHotPeersToDemote = Script (PickFirst :| []),
       pickWarmPeersToDemote = Script (PickFirst :| []),
       pickColdPeersToForget = Script (PickFirst :| []),
+      pickInboundPeers = Script (PickFirst :| []),
       peerSharing = PeerSharingEnabled,
       useBootstrapPeers = Script ((DontUseBootstrapPeers, NoDelay) :| []),
       ledgerStateJudgement = Script ((YoungEnough, NoDelay) :| [])
@@ -3497,6 +3501,7 @@ prop_issue_3494 = prop_governor_nofail $
       pickHotPeersToDemote = Script (PickFirst :| []),
       pickWarmPeersToDemote = Script (PickFirst :| []),
       pickColdPeersToForget = Script (PickFirst :| []),
+      pickInboundPeers = Script (PickFirst :| []),
       peerSharing = PeerSharingEnabled,
       useBootstrapPeers = Script ((DontUseBootstrapPeers, NoDelay) :| []),
       ledgerStateJudgement = Script ((YoungEnough, NoDelay) :| [])
@@ -3549,6 +3554,7 @@ prop_issue_3233 = prop_governor_nolivelock $
       pickHotPeersToDemote = Script (PickFirst :| []),
       pickWarmPeersToDemote = Script (PickFirst :| []),
       pickColdPeersToForget = Script (PickFirst :| []),
+      pickInboundPeers = Script (PickFirst :| []),
       peerSharing = PeerSharingEnabled,
       useBootstrapPeers = Script ((DontUseBootstrapPeers, NoDelay) :| []),
       ledgerStateJudgement = Script ((YoungEnough, NoDelay) :| [])

ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/PeerSelection/MockEnvironment.hs

@@ -135,6 +135,7 @@ data GovernorMockEnvironment = GovernorMockEnvironment {
        pickHotPeersToDemote       :: !(PickScript PeerAddr),
        pickWarmPeersToDemote      :: !(PickScript PeerAddr),
        pickColdPeersToForget      :: !(PickScript PeerAddr),
+       pickInboundPeers           :: !(PickScript PeerAddr),
        peerSharing                :: !PeerSharing,
        useBootstrapPeers          :: !(TimedScript UseBootstrapPeers),
        ledgerStateJudgement       :: !(TimedScript LedgerStateJudgement)
@@ -554,21 +555,24 @@ mockPeerSelectionPolicy GovernorMockEnvironment {
                           pickWarmPeersToPromote,
                           pickHotPeersToDemote,
                           pickWarmPeersToDemote,
-                          pickColdPeersToForget
+                          pickColdPeersToForget,
+                          pickInboundPeers
                         } = do
     pickKnownPeersForPeerShareVar <- initScript' pickKnownPeersForPeerShare
     pickColdPeersToPromoteVar  <- initScript' pickColdPeersToPromote
     pickWarmPeersToPromoteVar  <- initScript' pickWarmPeersToPromote
     pickHotPeersToDemoteVar    <- initScript' pickHotPeersToDemote
     pickWarmPeersToDemoteVar   <- initScript' pickWarmPeersToDemote
     pickColdPeersToForgetVar   <- initScript' pickColdPeersToForget
+    pickInboundPeersVar        <- initScript' pickInboundPeers
     return PeerSelectionPolicy {
       policyPickKnownPeersForPeerShare = \_ _ _ -> interpretPickScript pickKnownPeersForPeerShareVar,
       policyPickColdPeersToPromote  = \_ _ _ -> interpretPickScript pickColdPeersToPromoteVar,
       policyPickWarmPeersToPromote  = \_ _ _ -> interpretPickScript pickWarmPeersToPromoteVar,
       policyPickHotPeersToDemote    = \_ _ _ -> interpretPickScript pickHotPeersToDemoteVar,
       policyPickWarmPeersToDemote   = \_ _ _ -> interpretPickScript pickWarmPeersToDemoteVar,
       policyPickColdPeersToForget   = \_ _ _ -> interpretPickScript pickColdPeersToForgetVar,
+      policyPickInboundPeers        = \_ _ _ -> interpretPickScript pickInboundPeersVar,
       policyFindPublicRootTimeout   = 5,    -- seconds
       policyMaxInProgressPeerShareReqs = 2,
       policyPeerShareRetryTime         = 3600, -- seconds
@@ -610,10 +614,10 @@ tracerTracePeerSelection = contramap f tracerTestTraceEvent
     f a@(TraceBigLedgerPeersResults !_ !_ !_)                = GovernorEvent a
     f a@(TraceBigLedgerPeersFailure !_ !_ !_)                = GovernorEvent a
     f a@(TraceForgetBigLedgerPeers !_ !_ !_)                 = GovernorEvent a
+    f a@(TracePickInboundPeers !_ !_ !_ !_)                  = GovernorEvent a
     f a@(TracePeerShareRequests !_ !_ !_ !_ !_)              = GovernorEvent a
     f a@(TracePeerShareResults !_)                           = GovernorEvent a
     f a@(TracePeerShareResultsFiltered !_)                   = GovernorEvent a
-    f a@(TraceKnownInboundConnection !_ !_)                  = GovernorEvent a
     f a@(TracePromoteColdPeers !_ !_ !_)                     = GovernorEvent a
     f a@(TracePromoteColdLocalPeers !_ !_)                   = GovernorEvent a
     f a@(TracePromoteColdFailed !_ !_ !_ !_ !_)              = GovernorEvent a
@@ -734,6 +738,7 @@ instance Arbitrary GovernorMockEnvironment where
       pickHotPeersToDemote    <- arbitraryPickScript arbitrarySubsetOfPeers
       pickWarmPeersToDemote   <- arbitraryPickScript arbitrarySubsetOfPeers
       pickColdPeersToForget   <- arbitraryPickScript arbitrarySubsetOfPeers
+      pickInboundPeers        <- arbitraryPickScript arbitrarySubsetOfPeers
       peerSharing             <- arbitrary
       useBootstrapPeers       <- arbitrary
       ledgerStateJudgementList <- fmap getArbitraryLedgerStateJudgement <$> arbitrary
@@ -815,6 +820,7 @@ instance Arbitrary GovernorMockEnvironment where
            pickHotPeersToDemote,
            pickWarmPeersToDemote,
            pickColdPeersToForget,
+           pickInboundPeers,
            peerSharing,
            useBootstrapPeers,
            ledgerStateJudgement
@@ -840,10 +846,12 @@ instance Arbitrary GovernorMockEnvironment where
           pickHotPeersToDemote    = pickHotPeersToDemote',
           pickWarmPeersToDemote   = pickWarmPeersToDemote',
           pickColdPeersToForget   = pickColdPeersToForget',
+          pickInboundPeers        = pickInboundPeers',
           peerSharing,
           useBootstrapPeers       = useBootstrapPeers',
           ledgerStateJudgement    = fmap (first getArbitraryLedgerStateJudgement)
                                          ledgerStateJudgement'
+
         }
       | (targets',
          pickKnownPeersForPeerShare',
@@ -852,6 +860,7 @@ instance Arbitrary GovernorMockEnvironment where
          pickHotPeersToDemote',
          pickWarmPeersToDemote',
          pickColdPeersToForget',
+         pickInboundPeers',
          ledgerStateJudgement',
          useBootstrapPeers'
         )
@@ -862,6 +871,7 @@ instance Arbitrary GovernorMockEnvironment where
                      pickHotPeersToDemote,
                      pickWarmPeersToDemote,
                      pickColdPeersToForget,
+                     pickInboundPeers,
                      fmap (first ArbitraryLedgerStateJudgement) ledgerStateJudgement,
                      useBootstrapPeers
                     ),

ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Testnet.hs

@@ -971,8 +971,8 @@ prop_peer_selection_trace_coverage defaultBearerInfo diffScript =
         "TracePeerShareResults"
       peerSelectionTraceMap TracePeerShareResultsFiltered {}         =
         "TracePeerShareResultsFiltered"
-      peerSelectionTraceMap (TraceKnownInboundConnection addr ps) =
-        "TraceKnownInboundConnection " ++ show addr ++ " " ++ show ps
+      peerSelectionTraceMap TracePickInboundPeers {}                 =
+        "TracePickInboundInboundPeers"
       peerSelectionTraceMap TraceForgetColdPeers {}                  =
         "TraceForgetColdPeers"
       peerSelectionTraceMap TracePromoteColdPeers {}                 =

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

@@ -59,6 +59,12 @@ inboundPeerDelay :: DiffTime
 inboundPeerDelay = -15 * 60
 
 
+-- | Maximal number of light peers included at once.
+--
+maxInboundLightPeers :: Int
+maxInboundLightPeers = 10
+
+
 -- | Merge two dictionaries where values of the first one are obligatory, while
 -- the second one are optional.
 --
@@ -87,6 +93,7 @@ simplePeerSelectionPolicy rngVar getChurnMode metrics errorDelay = PeerSelection
       policyPickKnownPeersForPeerShare = simplePromotionPolicy,
       policyPickColdPeersToPromote     = simplePromotionPolicy,
       policyPickWarmPeersToPromote     = simplePromotionPolicy,
+      policyPickInboundPeers           = simplePromotionPolicy,
 
       policyPickHotPeersToDemote  = hotDemotionPolicy,
       policyPickWarmPeersToDemote = warmDemotionPolicy,

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

@@ -37,6 +37,7 @@ module Ouroboros.Network.PeerSelection.Governor
 import Data.Cache
 import Data.Foldable (traverse_)
 import Data.Hashable
+import Data.Map.Strict (Map)
 import Data.Void (Void)
 
 import Control.Applicative (Alternative ((<|>)))
@@ -58,6 +59,7 @@ import Ouroboros.Network.PeerSelection.Governor.KnownPeers qualified as KnownPee
 import Ouroboros.Network.PeerSelection.Governor.Monitor qualified as Monitor
 import Ouroboros.Network.PeerSelection.Governor.RootPeers qualified as RootPeers
 import Ouroboros.Network.PeerSelection.Governor.Types
+import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing)
 import Ouroboros.Network.PeerSelection.State.EstablishedPeers qualified as EstablishedPeers
 import Ouroboros.Network.PeerSelection.State.KnownPeers qualified as KnownPeers
 
@@ -563,8 +565,9 @@ peerSelectionGovernorLoop tracer
     evalGuardedDecisions :: Time
                          -> PeerSelectionState peeraddr peerconn
                          -> m (TimedDecision m peeraddr peerconn)
-    evalGuardedDecisions blockedAt st =
-      case guardedDecisions blockedAt st of
+    evalGuardedDecisions blockedAt st = do
+      inboundPeers <- readInboundPeers actions
+      case guardedDecisions blockedAt st inboundPeers of
         GuardedSkip _ ->
           -- impossible since guardedDecisions always has something to wait for
           error "peerSelectionGovernorLoop: impossible: nothing to do"
@@ -585,8 +588,9 @@ peerSelectionGovernorLoop tracer
 
     guardedDecisions :: Time
                      -> PeerSelectionState peeraddr peerconn
+                     -> Map peeraddr PeerSharing
                      -> Guarded (STM m) (TimedDecision m peeraddr peerconn)
-    guardedDecisions blockedAt st =
+    guardedDecisions blockedAt st inboundPeers =
       -- All the alternative potentially-blocking decisions.
 
       -- The Governor needs to react to changes in the bootstrap peer flag,
@@ -612,13 +616,13 @@ peerSelectionGovernorLoop tracer
       <> BigLedgerPeers.aboveTarget                     policy st
 
       -- All the alternative non-blocking internal decisions.
-      <> RootPeers.belowTarget        actions blockedAt         st
-      <> KnownPeers.belowTarget       actions             policy st
-      <> KnownPeers.aboveTarget                           policy st
-      <> EstablishedPeers.belowTarget actions             policy st
-      <> EstablishedPeers.aboveTarget actions             policy st
-      <> ActivePeers.belowTarget      actions             policy st
-      <> ActivePeers.aboveTarget      actions             policy st
+      <> RootPeers.belowTarget        actions blockedAt           st
+      <> KnownPeers.belowTarget       actions inboundPeers policy st
+      <> KnownPeers.aboveTarget                            policy st
+      <> EstablishedPeers.belowTarget actions              policy st
+      <> EstablishedPeers.aboveTarget actions              policy st
+      <> ActivePeers.belowTarget      actions              policy st
+      <> ActivePeers.aboveTarget      actions              policy st
 
       -- There is no rootPeersAboveTarget since the roots target is one sided.
 

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

@@ -451,7 +451,7 @@ jobPromoteColdPeer PeerSelectionActions {
                                         x
                                   )
                                   (Set.singleton peeraddr)
-                              $ KnownPeers.setSuccessfulConnectionFlag peeraddr
+                              $ KnownPeers.setSuccessfulConnectionFlag (Set.singleton peeraddr)
                               $ KnownPeers.clearTepidFlag peeraddr $
                                     KnownPeers.resetFailCount
                                         peeraddr