Merge pull request #5258 from IntersectMBO/mw/bootstrap-timeout

Respect bootstrap peers timeout

Author: crocodile-dentist

cardano-diffusion/changelog.d/20251208_170159_crocodile-dentist.md

@@ -0,0 +1,19 @@
+<!--
+A new scriv changelog fragment.
+
+Uncomment the section that is right (remove the HTML comment wrapper).
+For top level release notes, leave all the headers commented out.
+-->
+
+<!--
+### Breaking
+
+- A bullet item for the Breaking category.
+
+-->
+
+### Non-Breaking
+
+- Ensure timeout to enter sensitive state when bootstrap peers
+  are enabled is always respected.
+- Added test for timeout

cardano-diffusion/lib/Cardano/Network/PeerSelection/Governor/Monitor.hs

@@ -636,6 +636,7 @@ waitForSystemToQuiesce st@PeerSelectionState{
                           , extraState = cpst@Cardano.ExtraState {
                               Cardano.ledgerStateJudgement
                             , Cardano.bootstrapPeersFlag
+                            , Cardano.bootstrapPeersTimeout
                             , Cardano.hasOnlyBootstrapPeers
                             }
                           }
@@ -672,7 +673,13 @@ waitForSystemToQuiesce st@PeerSelectionState{
                                         }
                                       }
         }
-  | otherwise = GuardedSkip Nothing
+  -- We install this timeout here for the corner case where following all hold:
+  -- a) The timeout expires
+  -- b) There is nothing else that the governor needs to wake up for to handle
+  -- This is necessary since this timeout is a pure value which is handled in the
+  -- governor loop, and otherwise it is inert and its expiration cannot cause
+  -- an iteration of the loop by itself.
+  | otherwise = GuardedSkip bootstrapPeersTimeout
 
 
 -- | Extra trace points for `TracePeerSelection`.

cardano-diffusion/tests/lib/Test/Cardano/Network/Diffusion/Testnet.hs

@@ -26,7 +26,7 @@ import Control.Monad.Class.MonadTime.SI
 import Control.Monad.IOSim
 
 import Data.Bifoldable (bifoldMap)
-import Data.Bifunctor (bimap, first)
+import Data.Bifunctor (bimap, first, second)
 import Data.Char (ord)
 import Data.Dynamic (fromDynamic)
 import Data.Foldable (fold, foldr')
@@ -77,6 +77,7 @@ import Ouroboros.Network.InboundGovernor qualified as IG
 import Ouroboros.Network.Mock.ConcreteBlock (BlockHeader)
 import Ouroboros.Network.PeerSelection
 import Ouroboros.Network.PeerSelection.Governor qualified as Governor
+import Ouroboros.Network.PeerSelection.Governor.Types
 import Ouroboros.Network.PeerSelection.PublicRootPeers qualified as PublicRootPeers
 import Ouroboros.Network.PeerSelection.RootPeersDNS (DNSorIOError (DNSError))
 import Ouroboros.Network.PeerSelection.State.EstablishedPeers qualified as EstablishedPeers
@@ -234,6 +235,8 @@ tests =
                    prop_accept_failure
     , testProperty "only bootstrap peers in fallback state"
                    prop_only_bootstrap_peers_in_fallback_state_iosim
+    , testProperty "bootstrap peers timeout"
+                   prop_bootstrap_timeout_iosim
     , testGroup "local root diffusion mode"
         [ testProperty "InitiatorOnly"
           (unit_local_root_diffusion_mode InitiatorOnlyDiffusionMode)
@@ -1223,9 +1226,9 @@ prop_only_bootstrap_peers_in_fallback_state ioSimTrace traceNumber =
           trJoinKillSig =
               Signal.fromChangeEvents Terminated -- Default to TrKillingNode
             . Signal.selectEvents
-                (\case TrJoiningNetwork -> Just Joined
-                       TrTerminated     -> Just Terminated
-                       _                -> Nothing
+                (\case TrJoiningNetwork{} -> Just Joined
+                       TrTerminated       -> Just Terminated
+                       _                  -> Nothing
                 )
             . selectDiffusionSimulationTrace
             $ events
@@ -1301,6 +1304,107 @@ prop_only_bootstrap_peers_in_fallback_state_iosim
 prop_only_bootstrap_peers_in_fallback_state_iosim
   = testWithIOSim prop_only_bootstrap_peers_in_fallback_state long_trace
 
+prop_bootstrap_timeout_iosim
+  :: AbsBearerInfo -> DiffusionScript -> Property
+prop_bootstrap_timeout_iosim = testWithIOSim prop long_trace
+  where
+    prop ioSimTrace traceNumber =
+      let events :: [Events DiffusionTestTrace]
+          events = Trace.toList
+                 . fmap ( Signal.eventsFromList
+                        . fmap (\(WithName _ (WithTime t b)) -> (t, b))
+                        )
+                 . splitWithNameTrace
+                 . fmap (\(WithTime t (WithName name b)) -> WithName name (WithTime t b))
+                 . withTimeNameTraceEvents
+                    @DiffusionTestTrace
+                    @NtNAddr
+                 . Trace.take traceNumber
+                 $ ioSimTrace
+
+         in conjoin
+          $ (\ev ->
+            let evsList = eventsToList ev
+                lastTime = fst
+                         . last
+                         $ evsList
+             in classifySimulatedTime lastTime
+              $ classifyNumberOfEvents (length evsList)
+              $ timeout_enforced ev
+            )
+          <$> events
+
+    timeout_enforced evs =
+      let govUseBootstrapPeers :: Signal UseBootstrapPeers
+          govUseBootstrapPeers =
+            selectDiffusionPeerSelectionState
+              (Cardano.ExtraState.bootstrapPeersFlag . Governor.extraState)
+              evs
+
+          govLedgerStateJudgement :: Signal LedgerStateJudgement
+          govLedgerStateJudgement =
+            selectDiffusionPeerSelectionState
+              (Cardano.ExtraState.ledgerStateJudgement . Governor.extraState)
+              evs
+
+          sigPeerSelection
+            :: Signal
+                 (Maybe (Governor.TracePeerSelection Cardano.ExtraState PeerTrustable
+                                                    (Cardano.ExtraPeers NtNAddr)
+                                                    Cardano.ExtraTrace NtNAddr))
+          sigPeerSelection = Signal.fromEvents $ selectDiffusionPeerSelectionEvents evs
+
+          sigDiffusionSimulation :: Signal (Maybe DiffusionSimulationTrace)
+          sigDiffusionSimulation = Signal.fromEvents $ selectDiffusionSimulationTrace evs
+
+          govBootstrapTimeout :: Signal (Maybe Time)
+          govBootstrapTimeout =
+            selectDiffusionPeerSelectionState
+              (Cardano.ExtraState.bootstrapPeersTimeout . Governor.extraState)
+              evs
+
+          criticalTimeoutError :: [Governor.TracePeerSelection Cardano.ExtraState PeerTrustable
+                                                    (Cardano.ExtraPeers NtNAddr)
+                                                    Cardano.ExtraTrace NtNAddr]
+          criticalTimeoutError =
+               filter (\case
+                         TraceOutboundGovernorCriticalFailure reason
+                           | Just BootstrapPeersCriticalTimeoutError <- fromException reason
+                                    -> True
+                         _otherwise -> False)
+            . mapMaybe snd
+            . Signal.eventsToList
+            . Signal.toChangeEvents
+            $ sigPeerSelection
+
+          timeoutExceeded :: Signal Bool
+          timeoutExceeded =
+            not . Set.null <$> keyedTimeout' (15*60+1)
+              (\case
+                (_, Just (TrErrored{}), _) -> Nothing
+                (True, _, e)
+                  | Just (TraceOutboundGovernorCriticalFailure e') <- e
+                  , Just BootstrapPeersCriticalTimeoutError <- fromException e'
+                     -> Nothing
+                  | otherwise -> Just (Set.singleton ())
+                (False, _, _)              -> Nothing
+                )
+              ((,,) . isJust <$> govBootstrapTimeout <*> sigDiffusionSimulation <*> sigPeerSelection)
+
+          -- Node exiting with a critical timeout error makes this test succeed because
+          -- the point here is that the node should always be able to exit one way or another
+          -- but that indicates a problem elsewhere.
+      in  classify (not . null $ criticalTimeoutError) "Passed with BootstrapPeersCriticalTimeoutError"
+        . counterexample
+            "\nSignal key: (ledger state judgement, use bootstrap peers, timeout at, exceeded?)\n"
+        $ signalProperty 20 show
+              (\(_, _, _, timedOut) -> not timedOut)
+              ((,,,) <$> govLedgerStateJudgement
+                     <*> govUseBootstrapPeers
+                     <*> govBootstrapTimeout
+                     <*> timeoutExceeded
+              )
+
 
 -- | Unit test which covers issue #4177
 --
@@ -4008,7 +4112,7 @@ prop_unit_reconnect =
     verify_consistency events =
       let govEstablishedPeersSig :: Signal (Set NtNAddr)
           govEstablishedPeersSig =
-            selectDiffusionPeerSelectionState'
+            selectDiffusionPeerSelectionState
               (EstablishedPeers.toSet . Governor.establishedPeers)
               (wnEvent <$> events)
 
@@ -5071,58 +5175,44 @@ selectDiffusionSimulationTrace :: Events DiffusionTestTrace
                                -> Events DiffusionSimulationTrace
 selectDiffusionSimulationTrace = Signal.selectEvents
                     (\case DiffusionSimulationTrace e -> Just e
-                           _                                   -> Nothing)
-
-selectDiffusionPeerSelectionState :: Eq a
-                                  => (forall peerconn.
-                                        Governor.PeerSelectionState Cardano.ExtraState
-                                                                    PeerTrustable
-                                                                    (Cardano.ExtraPeers NtNAddr)
-                                                                    NtNAddr peerconn
-                                        -> a)
-                                  -> Events DiffusionTestTrace
-                                  -> Signal a
+                           _                          -> Nothing)
+
+selectDiffusionPeerSelectionState
+  :: Eq a
+  => (forall peerconn.
+         Governor.PeerSelectionState Cardano.ExtraState PeerTrustable
+                                     (Cardano.ExtraPeers NtNAddr) NtNAddr peerconn
+      -> a)
+  -> Events DiffusionTestTrace
+  -> Signal a
 selectDiffusionPeerSelectionState f =
     Signal.nub
   -- TODO: #3182 Rng seed should come from quickcheck.
   . (\evs ->
        let evsList = Signal.eventsToList evs
-       in
-         case evsList of
-           [] -> Signal.fromChangeEvents (initialState PraosMode) (snd <$> evs)
-           (_, (consensusMode, _)):_ ->
-             Signal.fromChangeEvents (initialState consensusMode) (snd <$> evs)
+       in case evsList of
+            [] -> Signal.fromChangeEvents (initial PraosMode) mempty
+            ((_, Just govState0):rest) ->
+              Signal.fromChangeEvents
+                govState0
+                (Signal.eventsFromList $ second (fromMaybe govState0) <$> rest)
+            _otherwise -> error "impossible"
     )
-  . Signal.selectEvents
-      (\case
-        DiffusionDebugPeerSelectionTrace (TraceGovernorState _ _ st) ->
-          Just (Cardano.ExtraState.consensusMode (Governor.extraState st), f st)
-        _                                                            ->
-          Nothing)
-  where
-    initialState consensusMode =
-      f $ Governor.emptyPeerSelectionState
-            (mkStdGen 42)
-            (Cardano.ExtraState.empty consensusMode (NumberOfBigLedgerPeers 0)) -- ^ todo: fix
-            Cardano.ExtraPeers.empty
-
-selectDiffusionPeerSelectionState' :: (forall peerconn. Governor.PeerSelectionState Cardano.ExtraState PeerTrustable (Cardano.ExtraPeers NtNAddr) NtNAddr peerconn -> a)
-                                  -> Events DiffusionTestTrace
-                                  -> Signal a
-selectDiffusionPeerSelectionState' f =
-  -- TODO: #3182 Rng seed should come from quickcheck.
-    Signal.fromChangeEvents initial
-  . Signal.selectEvents
-      (\case
-        DiffusionDebugPeerSelectionTrace (TraceGovernorState _ _ st) -> Just (f st)
-        -- don't let old state linger around when a node is restarted
-        DiffusionSimulationTrace         TrKillingNode               -> Just initial
-        _                                                            -> Nothing)
+  . Signal.selectEvents (\case
+      DiffusionDebugPeerSelectionTrace (TraceGovernorState _ _ st) ->
+        Just . Just $! f st
+      -- don't let old state linger around when a node is restarted
+      DiffusionSimulationTrace TrKillingNode ->
+        Just Nothing
+      DiffusionSimulationTrace (TrJoiningNetwork consensusMode) ->
+        Just . Just $! initial consensusMode
+      _                                                         -> Nothing)
   where
-    initial = f $ Governor.emptyPeerSelectionState
-                    (mkStdGen 42)
-                    (Cardano.ExtraState.empty PraosMode (NumberOfBigLedgerPeers 0))
-                    Cardano.ExtraPeers.empty
+    initial consensusMode =
+      f $! Governor.emptyPeerSelectionState
+                      (mkStdGen 42)
+                      (Cardano.ExtraState.empty consensusMode (NumberOfBigLedgerPeers 0))
+                      Cardano.ExtraPeers.empty
 
 selectDiffusionConnectionManagerEvents
   :: Trace () DiffusionTestTrace

cardano-diffusion/tests/lib/Test/Cardano/Network/Diffusion/Testnet/Simulation.hs

@@ -932,7 +932,7 @@ prop_diffusionScript_commandScript_valid (DiffusionScript sa dnsMap ((_, cmds):
 -- running
 --
 data DiffusionSimulationTrace
-  = TrJoiningNetwork
+  = TrJoiningNetwork ConsensusMode
   | TrKillingNode
   | TrReconfiguringNode
   | TrUpdatingDNS
@@ -1080,7 +1080,7 @@ diffusionSimulationM
          -- TVar.
       -> [Command] -- ^ List of commands/actions to perform for a single node
       -> m Void
-    runCommand ntnSocket ntcSocket dnsMapVar sArgs nArgs@NodeArgs { naAddr }
+    runCommand ntnSocket ntcSocket dnsMapVar sArgs nArgs@NodeArgs { naAddr, naConsensusMode }
                connStateIdSupply nodeId hostAndLRP cmds = do
       traceWith (diffSimTracer naAddr) . TrSay $ show nodeId ++ " @ " ++ ppNtNAddr naAddr
       runCommand' hostAndLRP cmds
@@ -1099,7 +1099,7 @@ diffusionSimulationM
         runCommand' Nothing
                    (JoinNetwork delay :cs) = do
           threadDelay delay
-          traceWith (diffSimTracer naAddr) TrJoiningNetwork
+          traceWith (diffSimTracer naAddr) (TrJoiningNetwork naConsensusMode)
           lrpVar <- newTVarIO $ naLocalRootPeers nArgs
           withAsync (runNode sArgs nArgs ntnSocket ntcSocket connStateIdSupply lrpVar dnsMapVar nodeId) $ \nodeAsync ->
             runCommand' (Just (nodeAsync, lrpVar)) cs

ouroboros-network/changelog.d/20251208_170146_crocodile-dentist.md

@@ -0,0 +1,18 @@
+<!--
+A new scriv changelog fragment.
+
+Uncomment the section that is right (remove the HTML comment wrapper).
+For top level release notes, leave all the headers commented out.
+-->
+
+<!--
+### Breaking
+
+- A bullet item for the Breaking category.
+
+-->
+
+### Non-Breaking
+
+- Added keyedTimeout', which allows to reset the timeouts
+  when an arbitrary condition is met

ouroboros-network/lib/Ouroboros/Network/PeerSelection/Governor/Types.hs

@@ -464,7 +464,7 @@ data ExtraGuardedDecisions extraState extraDebugState extraFlags
       :: MonitoringAction extraState extraDebugState extraFlags
                           extraPeers extraAPI extraCounters extraTrace peeraddr peerconn m
 
-    -- | This guarded decision will come before all default non-blocking
+    -- | This guarded decision follows all default non-blocking
     -- decisions. The order matters; first decisions have priority over
     -- the later ones.
     --