p2p local root peers

ouroboros-network/ouroboros-network.cabal

@@ -67,6 +67,7 @@ library
                        Ouroboros.Network.PeerSelection.EstablishedPeers
                        Ouroboros.Network.PeerSelection.KnownPeers
                        Ouroboros.Network.PeerSelection.LedgerPeers
+                       Ouroboros.Network.PeerSelection.LocalRootPeers
                        Ouroboros.Network.PeerSelection.RootPeersDNS
                        Ouroboros.Network.PeerSelection.Governor
                        Ouroboros.Network.Protocol.ChainSync.Client
@@ -252,9 +253,6 @@ test-suite test
   main-is:             Main.hs
   other-modules:       Ouroboros.Network.BlockFetch.Examples
                        Ouroboros.Network.MockNode
-                       Ouroboros.Network.PeerSelection.Test
-                       Ouroboros.Network.NodeToNode.Version.Test
-                       Ouroboros.Network.NodeToClient.Version.Test
 
                        Test.AnchoredFragment
                        Test.Chain
@@ -263,6 +261,14 @@ test-suite test
                        Test.Ouroboros.Network.KeepAlive
                        Test.Ouroboros.Network.MockNode
                        Test.Ouroboros.Network.TxSubmission
+                       Test.Ouroboros.Network.PeerSelection
+                       Test.Ouroboros.Network.PeerSelection.Instances
+                       Test.Ouroboros.Network.PeerSelection.LocalRootPeers
+                       Test.Ouroboros.Network.PeerSelection.MockEnvironment
+                       Test.Ouroboros.Network.PeerSelection.PeerGraph
+                       Test.Ouroboros.Network.PeerSelection.Script
+                       Test.Ouroboros.Network.NodeToNode.Version
+                       Test.Ouroboros.Network.NodeToClient.Version
                        Test.Mux
                        Test.Pipe
                        Test.Socket

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

@@ -54,7 +54,7 @@ belowTarget actions
     -- 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.
-  , Set.size availableToConnect - numEstablishedPeers - numConnectInProgress > 0
+  , numAvailableToConnect - numEstablishedPeers - numConnectInProgress > 0
   = 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
@@ -100,6 +100,7 @@ belowTarget actions
     numEstablishedPeers  = EstablishedPeers.size establishedPeers
     numConnectInProgress = Set.size inProgressPromoteCold
     availableToConnect   = KnownPeers.availableToConnect knownPeers
+    numAvailableToConnect= Set.size availableToConnect
 
 
 baseColdPeerRetryDiffTime :: Int
@@ -114,7 +115,9 @@ jobPromoteColdPeer :: forall peeraddr peerconn m.
                    => PeerSelectionActions peeraddr peerconn m
                    -> peeraddr
                    -> Job m (Completion m peeraddr peerconn)
-jobPromoteColdPeer PeerSelectionActions{peerStateActions = PeerStateActions {establishPeerConnection}} peeraddr =
+jobPromoteColdPeer PeerSelectionActions {
+                     peerStateActions = PeerStateActions {establishPeerConnection}
+                   } peeraddr =
     Job job handler "promoteColdPeer"
   where
     handler :: SomeException -> Completion m peeraddr peerconn
@@ -133,7 +136,8 @@ jobPromoteColdPeer PeerSelectionActions{peerStateActions = PeerStateActions {est
             -- exponential backoff: 5s, 10s, 20s, 40s, 80s, 160s.
             delay :: DiffTime
             delay = fromIntegral $
-              2 ^ (pred failCount `min` maxColdPeerRetryBackoff) * baseColdPeerRetryDiffTime
+                baseColdPeerRetryDiffTime
+              * 2 ^ (pred failCount `min` maxColdPeerRetryBackoff)
         in
           Decision {
             decisionTrace = TracePromoteColdFailed targetNumberOfEstablishedPeers

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

@@ -10,7 +10,6 @@ module Ouroboros.Network.PeerSelection.Governor.KnownPeers
 
 import           Data.Maybe (fromMaybe)
 import           Data.Semigroup (Min(..))
-import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
 
 import           Control.Concurrent.JobPool (Job(..))
@@ -22,6 +21,7 @@ import           Control.Exception (Exception(..), SomeException, assert)
 
 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.Governor.Types
 
 
@@ -267,10 +267,10 @@ aboveTarget PeerSelectionPolicy {
     -- We also need to avoid picking public root peers if that would put us
     -- below the target for root peers.
     --
-  , let numRootPeersCanForget = Map.size localRootPeers
+  , let numRootPeersCanForget = LocalRootPeers.size localRootPeers
                               + Set.size publicRootPeers
                               - targetNumberOfRootPeers
-        protectedRootPeers    = Map.keysSet localRootPeers
+        protectedRootPeers    = LocalRootPeers.keysSet localRootPeers
                              <> Set.drop numRootPeersCanForget publicRootPeers
         availableToForget     = KnownPeers.toSet knownPeers
                                   Set.\\ EstablishedPeers.toSet establishedPeers

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

@@ -3,8 +3,9 @@
 
 -- | This module contains governor decisions for monitoring tasks:
 --
--- * monitoring target peer changes
--- * monitoring results governor's job results
+-- * monitoring local root peer config changes
+-- * monitoring changes to the peer target numbers
+-- * monitoring the completion of asynchronous governor job
 -- * monitoring connections
 --
 module Ouroboros.Network.PeerSelection.Governor.Monitor
@@ -27,6 +28,7 @@ import           Control.Exception (assert)
 
 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.Types
 import           Ouroboros.Network.PeerSelection.Governor.Types
 import           Ouroboros.Network.PeerSelection.Governor.ActivePeers (jobDemoteActivePeer)
@@ -36,7 +38,7 @@ import           Ouroboros.Network.PeerSelection.Governor.ActivePeers (jobDemote
 -- 'PeerSelectionState', since we return it in a 'Decision' action it will be
 -- picked by the governor's 'peerSelectionGovernorLoop'.
 --
-targetPeers :: MonadSTM m
+targetPeers :: (MonadSTM m, Ord peeraddr)
             => PeerSelectionActions peeraddr peerconn m
             -> PeerSelectionState peeraddr peerconn
             -> Guarded (STM m) (TimedDecision m peeraddr peerconn)
@@ -47,19 +49,21 @@ targetPeers PeerSelectionActions{readPeerSelectionTargets}
             } =
     Guarded Nothing $ do
       targets' <- readPeerSelectionTargets
-      check (targets' /= targets)
+      check (targets' /= targets && sanePeerSelectionTargets targets')
+      -- We simply ignore target updates that are not "sane".
 
       -- We have to enforce the invariant that the number of root peers is
       -- not more than the target number of known peers. It's unlikely in
-      -- practice so it's ok to resolve it arbitrarily using Map.take.
-      let localRootPeers' = Map.take (targetNumberOfKnownPeers targets')
-                                     localRootPeers
+      -- practice so it's ok to resolve it arbitrarily using clampToLimit.
+      let localRootPeers' = LocalRootPeers.clampToLimit
+                              (targetNumberOfKnownPeers targets')
+                              localRootPeers
+      --TODO: trace when the clamping kicks in, and warn operators
 
       return $ \_now -> Decision {
         decisionTrace = TraceTargetsChanged targets targets',
         decisionJobs  = [],
-        decisionState = assert (sanePeerSelectionTargets targets')
-                        st {
+        decisionState = st {
                           targets        = targets',
                           localRootPeers = localRootPeers'
                         }
@@ -200,8 +204,8 @@ connections PeerSelectionActions{
     asyncDemotion _        _                          = Nothing
 
 
---------------------------------
--- Local root peers below target
+-----------------------------------------------
+-- Monitoring changes to the local root peers
 --
 
 
@@ -226,11 +230,18 @@ localRoots actions@PeerSelectionActions{readLocalRootPeers}
       -- We have to enforce the invariant that the number of root peers is
       -- not more than the target number of known peers. It's unlikely in
       -- practice so it's ok to resolve it arbitrarily using Map.take.
-      localRootPeers' <- Map.take targetNumberOfKnownPeers <$> readLocalRootPeers
+      localRootPeersRaw <- readLocalRootPeers
+      let localRootPeers' = LocalRootPeers.clampToLimit
+                              targetNumberOfKnownPeers
+                          . LocalRootPeers.fromGroups
+                          $ localRootPeersRaw
       check (localRootPeers' /= localRootPeers)
+      --TODO: trace when the clamping kicks in, and warn operators
 
-      let added       = localRootPeers' Map.\\ localRootPeers
-          removed     = localRootPeers  Map.\\ localRootPeers'
+      let added       = LocalRootPeers.toMap localRootPeers' Map.\\
+                        LocalRootPeers.toMap localRootPeers
+          removed     = LocalRootPeers.toMap localRootPeers  Map.\\
+                        LocalRootPeers.toMap localRootPeers'
           addedSet    = Map.keysSet added
           removedSet  = Map.keysSet removed
           knownPeers' = KnownPeers.insert addedSet
@@ -241,7 +252,8 @@ localRoots actions@PeerSelectionActions{readLocalRootPeers}
 
           -- We have to adjust the publicRootPeers to maintain the invariant
           -- that the local and public sets are non-overlapping.
-          publicRootPeers' = publicRootPeers Set.\\ Map.keysSet localRootPeers'
+          publicRootPeers' = publicRootPeers Set.\\
+                             LocalRootPeers.keysSet localRootPeers'
 
           -- If we are removing local roots and we have active connections to
           -- them then things are a little more complicated. We would typically
@@ -263,7 +275,7 @@ localRoots actions@PeerSelectionActions{readLocalRootPeers}
                     publicRootPeers'
                    (KnownPeers.toSet knownPeers'))
         . assert (Set.isSubsetOf
-                   (Map.keysSet localRootPeers')
+                   (LocalRootPeers.keysSet localRootPeers')
                    (KnownPeers.toSet knownPeers'))
 
         $ Decision {

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

@@ -6,7 +6,6 @@ module Ouroboros.Network.PeerSelection.Governor.RootPeers
   ) where
 
 import           Data.Semigroup (Min(..))
-import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
 
 import           Control.Concurrent.JobPool (Job(..))
@@ -15,6 +14,7 @@ import           Control.Monad.Class.MonadTime
 import           Control.Exception (SomeException, assert)
 
 import qualified Ouroboros.Network.PeerSelection.KnownPeers as KnownPeers
+import qualified Ouroboros.Network.PeerSelection.LocalRootPeers as LocalRootPeers
 import           Ouroboros.Network.PeerSelection.Governor.Types
 
 
@@ -64,7 +64,8 @@ belowTarget actions
   | otherwise
   = GuardedSkip Nothing
   where
-    numRootPeers      = Map.size localRootPeers + Set.size publicRootPeers
+    numRootPeers      = LocalRootPeers.size localRootPeers
+                      + Set.size publicRootPeers
     maxExtraRootPeers = targetNumberOfRootPeers - numRootPeers
 
 
@@ -109,7 +110,7 @@ jobReqPublicRootPeers PeerSelectionActions{requestPublicRootPeers}
     job = do
       (results, ttl) <- requestPublicRootPeers numExtraAllowed
       return $ Completion $ \st now ->
-        let newPeers         = results Set.\\ Map.keysSet (localRootPeers st)
+        let newPeers         = results Set.\\ LocalRootPeers.keysSet (localRootPeers st)
                                        Set.\\ publicRootPeers st
             publicRootPeers' = publicRootPeers st <> newPeers
             knownPeers'      = KnownPeers.insert