Forget about non established bootstrap peers

IntersectMBO · Feb 20, 2024 · 58a4f3b · 58a4f3b
1 parent 8ab4448
commit 58a4f3b
Show file tree

Hide file tree

Showing 2 changed files with 60 additions and 9 deletions.
diff --git a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/PeerSelection.hs b/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 =

diff --git a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/Monitor.hs b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/Monitor.hs
@@ -554,15 +554,29 @@ localRoots actions@PeerSelectionActions{ readLocalRootPeers
 --  peer connect to non-trusted peers, so just updating the boostrap peers
 --  flag will enable the previously disabled monitoring actions.
 --
-monitorBootstrapPeersFlag :: MonadSTM m
+monitorBootstrapPeersFlag :: ( MonadSTM m
+                             , Ord peeraddr
+                             )
                          => PeerSelectionActions peeraddr peerconn m
                          -> PeerSelectionState peeraddr peerconn
                          -> Guarded (STM m) (TimedDecision m peeraddr peerconn)
 monitorBootstrapPeersFlag PeerSelectionActions { readUseBootstrapPeers }
-                          st@PeerSelectionState { bootstrapPeersFlag } =
+                          st@PeerSelectionState { bootstrapPeersFlag
+                                                , knownPeers
+                                                , establishedPeers
+                                                , publicRootPeers
+                                                , inProgressPromoteCold
+                                                , inProgressPromoteWarm
+                                                } =
   Guarded Nothing $ do
     ubp <- readUseBootstrapPeers
     check (ubp /= bootstrapPeersFlag)
+    let nonEstablishedBootstrapPeers =
+          PublicRootPeers.getBootstrapPeers publicRootPeers
+          `Set.difference`
+          EstablishedPeers.toSet establishedPeers
+          `Set.difference`
+          (inProgressPromoteCold <> inProgressPromoteWarm)
     return $ \_now ->
       Decision {
         decisionTrace = [TraceUseBootstrapPeersChanged ubp],
@@ -572,6 +586,14 @@ monitorBootstrapPeersFlag PeerSelectionActions { readUseBootstrapPeers }
              , ledgerStateJudgement  = YoungEnough
              , hasOnlyBootstrapPeers = False
              , bootstrapPeersTimeout = Nothing
+             , knownPeers =
+                 KnownPeers.delete
+                   nonEstablishedBootstrapPeers
+                   knownPeers
+             , publicRootPeers =
+                 PublicRootPeers.difference
+                   publicRootPeers
+                   nonEstablishedBootstrapPeers
              }
       }
 
@@ -589,13 +611,21 @@ monitorBootstrapPeersFlag PeerSelectionActions { readUseBootstrapPeers }
 -- It should also be noted that churning is ignored until the node converges
 -- to a clean state. I.e., it will disconnect from the targets source of truth.
 --
-monitorLedgerStateJudgement :: MonadSTM m
+monitorLedgerStateJudgement :: ( MonadSTM m
+                               , Ord peeraddr
+                               )
                             => PeerSelectionActions peeraddr peerconn m
                             -> PeerSelectionState peeraddr peerconn
                             -> Guarded (STM m) (TimedDecision m peeraddr peerconn)
 monitorLedgerStateJudgement PeerSelectionActions{ readLedgerStateJudgement }
                             st@PeerSelectionState{ bootstrapPeersFlag,
-                                                   ledgerStateJudgement }
+                                                   publicRootPeers,
+                                                   knownPeers,
+                                                   establishedPeers,
+                                                   inProgressPromoteCold,
+                                                   inProgressPromoteWarm,
+                                                   ledgerStateJudgement
+                                                 }
   | isBootstrapPeersEnabled bootstrapPeersFlag =
     Guarded Nothing $ do
       lsj <- readLedgerStateJudgement
@@ -622,10 +652,24 @@ monitorLedgerStateJudgement PeerSelectionActions{ readLedgerStateJudgement }
             , bootstrapPeersTimeout = Just (addTime governor_BOOTSTRAP_PEERS_TIMEOUT now)
             })
         YoungEnough -> do
+          let nonEstablishedBootstrapPeers =
+                PublicRootPeers.getBootstrapPeers publicRootPeers
+                `Set.difference`
+                EstablishedPeers.toSet establishedPeers
+                `Set.difference`
+                (inProgressPromoteCold <> inProgressPromoteWarm)
           return (\_ -> st
             { ledgerStateJudgement  = lsj
             , hasOnlyBootstrapPeers = False
             , bootstrapPeersTimeout = Nothing
+            , knownPeers =
+                KnownPeers.delete
+                  nonEstablishedBootstrapPeers
+                  knownPeers
+            , publicRootPeers =
+                PublicRootPeers.difference
+                  publicRootPeers
+                  nonEstablishedBootstrapPeers
             })
       return $ \now ->
         Decision {