Merge #3006

3006: p2p local root peers r=dcoutts a=dcoutts

First parts of integrating the new scheme for local root peers.

This changes to the new representation but does not yet introduce the governor targets of the local root peers being established or active peers. That'll be in follow-up patches (either extending this PR or after).

I have those changes locally, but they need rebasing and tidying up. This is what I have ready to merge so far.

Co-authored-by: Duncan Coutts <duncan@well-typed.com>
Co-authored-by: Armando Santos <armando@well-typed.com>
Co-authored-by: Armando Santos <armandoifsantos@gmail.com>

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