Merge pull request #4810 from IntersectMBO/bolt12/bootstrapPeers-forget

Forget non-established bootstrap peers

ouroboros-network/CHANGELOG.md

@@ -58,6 +58,11 @@
 * Fix `targetPeers` monitoring action to use the correct set of local peers
   when in sensitive mode.
 
+* Forget non-established bootstrap peers when transitioning from
+  `TooOld` state to `YoungEnough`
+
+* Implemented Churn for bootstrap peers
+
 ## 0.11.0.0 -- 2023-01-22
 
 ### Breaking changes

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

@@ -1780,21 +1780,28 @@ prop_governor_target_known_5_no_shrink_below (MaxTime maxTime) env =
           selectGovState (PublicRootPeers.getBigLedgerPeers . Governor.publicRootPeers)
                          events
 
+        bootstrapPeersSig :: Signal (Set PeerAddr)
+        bootstrapPeersSig =
+          selectGovState (PublicRootPeers.getBootstrapPeers . Governor.publicRootPeers)
+                         events
+
         knownPeersShrinksSig :: Signal (Set PeerAddr)
         knownPeersShrinksSig =
             Signal.nub
           . fmap (fromMaybe Set.empty)
           . Signal.difference
               -- We subtract all big ledger peers.  This is because we might
               -- first satisfy the target of known peers, and then learn that
-              -- one of them was a big ledger peers.  This would be a fake
-              -- shrink of known non big ledger peers.
+              -- one of them was a big ledger peers. We also subtract
+              -- bootstrap peers. This would be a fake shrink of known non
+              -- big ledger peers.
               --
               -- By subtracting a sum of `y` and `y'` we also do not account
               -- forgetting big ledger peers.
-              (\(x,y) (x',y') -> x Set.\\ x' Set.\\ y Set.\\ y')
-          $ (,) <$> govKnownPeersSig
-                <*> bigLedgerPeersSig
+              (\(x,y,z) (x',y',z') -> x Set.\\ x' Set.\\ y Set.\\ y' Set.\\ z Set.\\ z')
+          $ (,,) <$> govKnownPeersSig
+                 <*> bigLedgerPeersSig
+                 <*> bootstrapPeersSig
 
         unexpectedShrink :: Signal Bool
         unexpectedShrink =

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

@@ -68,7 +68,7 @@ import Test.Tasty
 import Test.Tasty.QuickCheck (testProperty)
 
 import Control.Exception (AssertionFailed (..), catch, evaluate)
-import Ouroboros.Network.BlockFetch (TraceFetchClientState (..))
+import Ouroboros.Network.BlockFetch (FetchMode (..), TraceFetchClientState (..))
 import Ouroboros.Network.ConnectionManager.Test.Timeouts (AllProperty (..),
            TestProperty (..), classifyActivityType, classifyEffectiveDataFlow,
            classifyNegotiatedDataFlow, classifyPrunings, classifyTermination,
@@ -690,6 +690,7 @@ unit_4177 = prop_inbound_governor_transitions_coverage absNoAttenuation script
               (Script (DNSLookupDelay {getDNSLookupDelay = 0.067} :| [DNSLookupDelay {getDNSLookupDelay = 0.097},DNSLookupDelay {getDNSLookupDelay = 0.101},DNSLookupDelay {getDNSLookupDelay = 0.096},DNSLookupDelay {getDNSLookupDelay = 0.051}]))
               Nothing
               False
+              (Script (FetchModeDeadline :| []))
           , [JoinNetwork 1.742857142857
             ,Reconfigure 6.33333333333 [(1,1,Map.fromList [(RelayAccessDomain "test2" 65535,(DoAdvertisePeer, IsNotTrustable))]),
                                         (1,1,Map.fromList [(RelayAccessAddress "0:6:0:3:0:6:0:5" 65530,(DoAdvertisePeer, IsNotTrustable))
@@ -721,6 +722,7 @@ unit_4177 = prop_inbound_governor_transitions_coverage absNoAttenuation script
                      ]))
              Nothing
              False
+             (Script (FetchModeDeadline :| []))
           , [JoinNetwork 0.183783783783
             ,Reconfigure 4.533333333333 [(1,1,Map.fromList [])]
             ]
@@ -1328,6 +1330,7 @@ unit_4191 = prop_diffusion_dns_can_recover absInfo script
                                                                    ]))
             Nothing
             False
+            (Script (FetchModeDeadline :| []))
             , [ JoinNetwork 6.710144927536
               , Kill 7.454545454545
               , JoinNetwork 10.763157894736
@@ -2338,7 +2341,8 @@ async_demotion_network_script =
                            = Nothing,
         naChainSyncEarlyExit
                            = False,
-        naPeerSharing      = PeerSharingDisabled
+        naPeerSharing      = PeerSharingDisabled,
+        naFetchModeScript  = singletonScript FetchModeDeadline
       }
 
 
@@ -2823,6 +2827,7 @@ prop_unit_4258 =
              (Script (DNSLookupDelay {getDNSLookupDelay = 0.065} :| []))
              Nothing
              False
+             (Script (FetchModeDeadline :| []))
          , [ JoinNetwork 4.166666666666,
              Kill 0.3,
              JoinNetwork 1.517857142857,
@@ -2862,6 +2867,7 @@ prop_unit_4258 =
                      ]))
              Nothing
              False
+             (Script (FetchModeDeadline :| []))
          , [ JoinNetwork 3.384615384615,
              Reconfigure 3.583333333333 [(1,1,Map.fromList [(RelayAccessAddress "0.0.0.4" 9,(DoNotAdvertisePeer, IsNotTrustable))])],
              Kill 15.55555555555,
@@ -2923,6 +2929,7 @@ prop_unit_reconnect =
               (Script (DNSLookupDelay {getDNSLookupDelay = 0} :| []))
               Nothing
               False
+              (Script (FetchModeDeadline :| []))
           , [ JoinNetwork 0
             ])
           , (NodeArgs
@@ -2949,6 +2956,7 @@ prop_unit_reconnect =
              (Script (DNSLookupDelay {getDNSLookupDelay = 0} :| []))
              Nothing
              False
+             (Script (FetchModeDeadline :| []))
          , [ JoinNetwork 10
            ])
          ]

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

@@ -114,9 +114,11 @@ import Test.Ouroboros.Network.PeerSelection.RootPeersDNS (DNSLookupDelay (..),
 import Test.Ouroboros.Network.PeerSelection.RootPeersDNS qualified as PeerSelection hiding
            (tests)
 
+import Data.Bool (bool)
 import Data.Function (on)
 import Data.Typeable (Typeable)
-import Ouroboros.Network.BlockFetch (TraceFetchClientState, TraceLabelPeer (..))
+import Ouroboros.Network.BlockFetch (FetchMode (..), TraceFetchClientState,
+           TraceLabelPeer (..))
 import Ouroboros.Network.PeerSelection.Bootstrap (UseBootstrapPeers (..))
 import Ouroboros.Network.PeerSelection.PeerAdvertise (PeerAdvertise (..))
 import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing)
@@ -209,13 +211,14 @@ data NodeArgs =
       -- ^ 'Arguments' 'aDNSLookupDelayScript' value
     , naChainSyncExitOnBlockNo :: Maybe BlockNo
     , naChainSyncEarlyExit     :: Bool
+    , naFetchModeScript        :: Script FetchMode
     }
 
 instance Show NodeArgs where
     show NodeArgs { naSeed, naDiffusionMode, naMbTime, naBootstrapPeers, naPublicRoots,
                    naAddr, naPeerSharing, naLocalRootPeers, naLocalSelectionTargets,
                    naDNSTimeoutScript, naDNSLookupDelayScript, naChainSyncExitOnBlockNo,
-                   naChainSyncEarlyExit } =
+                   naChainSyncEarlyExit, naFetchModeScript } =
       unwords [ "NodeArgs"
               , "(" ++ show naSeed ++ ")"
               , show naDiffusionMode
@@ -230,6 +233,7 @@ instance Show NodeArgs where
               , "(" ++ show naDNSLookupDelayScript ++ ")"
               , "(" ++ show naChainSyncExitOnBlockNo ++ ")"
               , show naChainSyncEarlyExit
+              , show naFetchModeScript
               ]
 
 data Command = JoinNetwork DiffTime
@@ -414,6 +418,8 @@ genNodeArgs relays minConnected localRootPeers relay = flip suchThat hasUpstream
   firstLedgerPool <- arbitrary
   let ledgerPeerPoolsScript = Script (firstLedgerPool :| ledgerPeerPools)
 
+  fetchModeScript <- fmap (bool FetchModeBulkSync FetchModeDeadline) <$> arbitrary
+
   firstBootstrapPeer <- maybe DontUseBootstrapPeers UseBootstrapPeers
                       <$> arbitrary
   bootstrapPeers <- listOf (maybe DontUseBootstrapPeers UseBootstrapPeers
@@ -438,6 +444,7 @@ genNodeArgs relays minConnected localRootPeers relay = flip suchThat hasUpstream
       , naChainSyncExitOnBlockNo = chainSyncExitOnBlockNo
       , naChainSyncEarlyExit     = chainSyncEarlyExit
       , naPeerSharing            = peerSharing
+      , naFetchModeScript        = fetchModeScript
       }
   where
     hasActive :: SmallPeerSelectionTargets -> Bool

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

@@ -1023,6 +1023,7 @@ runM Interfaces
                                  daBlockFetchMode
                                  daPeerSelectionTargets
                                  peerSelectionTargetsVar
+                                 daReadUseBootstrapPeers
 
       --
       -- Two functions only used in InitiatorAndResponder mode

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

@@ -16,6 +16,7 @@ import System.Random
 
 import Ouroboros.Network.BlockFetch (FetchMode (..))
 import Ouroboros.Network.Diffusion.Policies (closeConnectionTimeout)
+import Ouroboros.Network.PeerSelection.Bootstrap (UseBootstrapPeers (..))
 import Ouroboros.Network.PeerSelection.Governor.Types hiding (targets)
 import Ouroboros.Network.PeerSelection.PeerMetric
 
@@ -45,18 +46,23 @@ peerChurnGovernor :: forall m peeraddr.
                   -> STM m FetchMode
                   -> PeerSelectionTargets
                   -> StrictTVar m PeerSelectionTargets
+                  -> STM m UseBootstrapPeers
                   -> m Void
 peerChurnGovernor tracer deadlineChurnInterval bulkChurnInterval psOverallTimeout
-                  _metrics churnModeVar inRng getFetchMode base peerSelectionVar = do
+                  _metrics churnModeVar inRng getFetchMode base peerSelectionVar
+                  getUseBootstrapPeers = do
   -- Wait a while so that not only the closest peers have had the time
   -- to become warm.
   startTs0 <- getMonotonicTime
   -- TODO: revisit the policy once we have local root peers in the governor.
   -- The intention is to give local root peers give head start and avoid
   -- giving advantage to hostile and quick root peers.
   threadDelay 3
-  mode <- atomically updateChurnMode
-  atomically $ increaseActivePeers mode
+  (mode, ubp) <- atomically ((,) <$> updateChurnMode
+                                 <*> getUseBootstrapPeers)
+  atomically $ do
+    increaseActivePeers mode
+    increaseEstablishedPeers mode ubp
   endTs0 <- getMonotonicTime
   fuzzyDelay inRng (endTs0 `diffTime` startTs0) >>= go
 
@@ -73,7 +79,7 @@ peerChurnGovernor tracer deadlineChurnInterval bulkChurnInterval psOverallTimeou
 
     -- TODO: #3396 revisit the policy for genesis
     increaseActivePeers :: ChurnMode -> STM m ()
-    increaseActivePeers mode =  do
+    increaseActivePeers mode =
         modifyTVar peerSelectionVar (\targets -> targets {
           targetNumberOfActivePeers =
               case mode of
@@ -84,7 +90,7 @@ peerChurnGovernor tracer deadlineChurnInterval bulkChurnInterval psOverallTimeou
         })
 
     decreaseActivePeers :: ChurnMode -> STM m ()
-    decreaseActivePeers mode =  do
+    decreaseActivePeers mode =
         modifyTVar peerSelectionVar (\targets -> targets {
           targetNumberOfActivePeers =
               case mode of
@@ -94,8 +100,30 @@ peerChurnGovernor tracer deadlineChurnInterval bulkChurnInterval psOverallTimeou
                        min 1 (targetNumberOfActivePeers base - 1)
         })
 
+    increaseEstablishedPeers :: ChurnMode -> UseBootstrapPeers -> STM m ()
+    increaseEstablishedPeers mode ubp =
+        modifyTVar peerSelectionVar (\targets -> targets {
+          targetNumberOfEstablishedPeers =
+              case (mode, ubp) of
+                   (ChurnModeBulkSync, UseBootstrapPeers _) ->
+                       min (targetNumberOfActivePeers targets + 1)
+                           (targetNumberOfEstablishedPeers base)
+                   _  -> targetNumberOfEstablishedPeers base
+        })
+
+    decreaseEstablished :: ChurnMode -> UseBootstrapPeers -> STM m ()
+    decreaseEstablished mode ubp =
+        modifyTVar peerSelectionVar (\targets -> targets {
+          targetNumberOfEstablishedPeers =
+              case (mode, ubp) of
+                   (ChurnModeBulkSync, UseBootstrapPeers _) ->
+                       min (targetNumberOfActivePeers targets) (targetNumberOfEstablishedPeers base - 1)
+                   _ -> decrease (targetNumberOfEstablishedPeers base - targetNumberOfActivePeers base)
+                          + targetNumberOfActivePeers base
+        })
+
     increaseActiveBigLedgerPeers :: ChurnMode -> STM m ()
-    increaseActiveBigLedgerPeers mode =  do
+    increaseActiveBigLedgerPeers mode =
         modifyTVar peerSelectionVar (\targets -> targets {
           -- TODO: when chain-skipping will be implemented and chain-sync client
           -- will take into account big ledger peers, we don't need pattern
@@ -110,7 +138,7 @@ peerChurnGovernor tracer deadlineChurnInterval bulkChurnInterval psOverallTimeou
         })
 
     decreaseActiveBigLedgerPeers :: ChurnMode -> STM m ()
-    decreaseActiveBigLedgerPeers mode =  do
+    decreaseActiveBigLedgerPeers mode =
         modifyTVar peerSelectionVar (\targets -> targets {
           targetNumberOfActiveBigLedgerPeers =
               case mode of
@@ -125,11 +153,13 @@ peerChurnGovernor tracer deadlineChurnInterval bulkChurnInterval psOverallTimeou
     go !rng = do
       startTs <- getMonotonicTime
 
-      churnMode <- atomically updateChurnMode
+      (churnMode, ubp) <- atomically ((,) <$> updateChurnMode
+                                          <*> getUseBootstrapPeers)
       traceWith tracer $ TraceChurnMode churnMode
 
-      -- Purge the worst active peer(s).
-      atomically $ decreaseActivePeers churnMode
+      atomically $ do
+        -- Purge the worst active peer(s).
+        decreaseActivePeers churnMode
 
       -- Short delay, we may have no active peers right now
       threadDelay 1
@@ -151,25 +181,24 @@ peerChurnGovernor tracer deadlineChurnInterval bulkChurnInterval psOverallTimeou
       threadDelay 1
 
       -- Forget the worst performing non-active peers.
-      atomically $ modifyTVar peerSelectionVar (\targets -> targets {
-          targetNumberOfRootPeers =
-            decrease (targetNumberOfRootPeers base - targetNumberOfEstablishedPeers base)
-            + targetNumberOfEstablishedPeers base
-        , targetNumberOfKnownPeers =
-            decrease (targetNumberOfKnownPeers base - targetNumberOfEstablishedPeers base)
-            + targetNumberOfEstablishedPeers base
-        , targetNumberOfEstablishedPeers =
-            decrease (targetNumberOfEstablishedPeers base - targetNumberOfActivePeers base)
-            + targetNumberOfActivePeers base
-        , targetNumberOfKnownBigLedgerPeers =
-            decrease (targetNumberOfKnownBigLedgerPeers base -
-                      targetNumberOfEstablishedBigLedgerPeers base)
-            + targetNumberOfEstablishedBigLedgerPeers base
-        , targetNumberOfEstablishedBigLedgerPeers =
-            decrease (targetNumberOfEstablishedBigLedgerPeers base -
-                      targetNumberOfActiveBigLedgerPeers base)
-            + targetNumberOfActiveBigLedgerPeers base
-        })
+      atomically $ do
+        decreaseEstablished churnMode ubp
+        modifyTVar peerSelectionVar (\targets -> targets {
+            targetNumberOfRootPeers =
+              decrease (targetNumberOfRootPeers base - targetNumberOfEstablishedPeers base)
+              + targetNumberOfEstablishedPeers base
+          , targetNumberOfKnownPeers =
+              decrease (targetNumberOfKnownPeers base - targetNumberOfEstablishedPeers base)
+              + targetNumberOfEstablishedPeers base
+          , targetNumberOfKnownBigLedgerPeers =
+              decrease (targetNumberOfKnownBigLedgerPeers base -
+                        targetNumberOfEstablishedBigLedgerPeers base)
+              + targetNumberOfEstablishedBigLedgerPeers base
+          , targetNumberOfEstablishedBigLedgerPeers =
+              decrease (targetNumberOfEstablishedBigLedgerPeers base -
+                        targetNumberOfActiveBigLedgerPeers base)
+              + targetNumberOfActiveBigLedgerPeers base
+          })
 
       -- Give the governor time to properly demote them.
       threadDelay $ 1 + closeConnectionTimeout
@@ -185,9 +214,10 @@ peerChurnGovernor tracer deadlineChurnInterval bulkChurnInterval psOverallTimeou
       threadDelay $ 1 + psOverallTimeout
 
       -- Pick new non-active peers
-      atomically $ modifyTVar peerSelectionVar (\targets -> targets {
-          targetNumberOfEstablishedPeers = targetNumberOfEstablishedPeers base
-        , targetNumberOfEstablishedBigLedgerPeers = targetNumberOfEstablishedBigLedgerPeers base
+      atomically $ do
+        increaseEstablishedPeers churnMode ubp
+        modifyTVar peerSelectionVar (\targets -> targets {
+          targetNumberOfEstablishedBigLedgerPeers = targetNumberOfEstablishedBigLedgerPeers base
         })
       endTs <- getMonotonicTime