Merge pull request #4555 from IntersectMBO/bolt12/4530

Bootstrap Peers Implementation

ouroboros-network-api/CHANGELOG.md

@@ -4,6 +4,17 @@
 
 ### Breaking changes
 
+* Changed `LedgerConsensusInterface` type:
+    `LedgerConsensusInterface` now has to fill 3 STM actions:
+        * `lpGetLatestSlot :: STM m SlotNo`
+        * `lpGetLedgerStateJudgment :: STM m LedgerStateJudgement`
+        * `lpGetLedgerPeers :: STM m [(PoolStake, NonEmpty RelayAccessPoint)]`
+
+* Added `PeerTrustable` flag
+* Added `UseBootstrapPeers`, this data type is now a flag
+  to enable/disable bootstrap peers usage.
+* Added `UseLedgerPeers` flag with an indirection layer to `UseLedgerAfter`
+
 ### Non-breaking changes
 
 ## 0.6.3.0 -- 2024-01-22
@@ -27,7 +38,7 @@
 * Fixed handshake codec: disabled `PeerSharing` for `node-to-node` versions 11 and 12.
 * Disable `PeerSharing` with `InitiatorOnly` nodes, since they do not run
   peer sharing server side and can not reply to requests.
-- Fixed `Acceptable` instance of `NodeToNodeVersionData` to only negotiate
+* Fixed `Acceptable` instance of `NodeToNodeVersionData` to only negotiate
   `PeerSharing` if diffusion mode is `InitiatorAndResponder`
 * ghc-9.8 support.
 
@@ -54,7 +65,6 @@
 * Restructured `decodeTerm` to prevent an impossible case and eliminate the
   associated `error`.
 
-
 ## 0.5.1.1 -- 2023-10-26
 
 ### Non-breaking changes

ouroboros-network-api/ouroboros-network-api.cabal

@@ -41,9 +41,11 @@ library
 
                        Ouroboros.Network.Protocol.Limits
 
+                       Ouroboros.Network.PeerSelection.Bootstrap
                        Ouroboros.Network.PeerSelection.LedgerPeers.Type
                        Ouroboros.Network.PeerSelection.PeerMetric.Type
                        Ouroboros.Network.PeerSelection.PeerAdvertise
+                       Ouroboros.Network.PeerSelection.PeerTrustable
                        Ouroboros.Network.PeerSelection.PeerSharing
                        Ouroboros.Network.PeerSelection.PeerSharing.Codec
                        Ouroboros.Network.PeerSelection.RelayAccessPoint

ouroboros-network-api/src/Ouroboros/Network/PeerSelection/Bootstrap.hs

@@ -0,0 +1,44 @@
+{-# LANGUAGE DeriveGeneric     #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Ouroboros.Network.PeerSelection.Bootstrap
+  ( UseBootstrapPeers (..)
+  , isBootstrapPeersEnabled
+  , requiresBootstrapPeers
+  , isNodeAbleToMakeProgress
+  ) where
+
+import           GHC.Generics (Generic)
+import           Ouroboros.Network.PeerSelection.LedgerPeers.Type
+                     (LedgerStateJudgement (..))
+import           Ouroboros.Network.PeerSelection.RelayAccessPoint
+                     (RelayAccessPoint)
+
+data UseBootstrapPeers = DontUseBootstrapPeers
+                       | UseBootstrapPeers [RelayAccessPoint]
+  deriving (Eq, Show, Ord, Generic)
+
+isBootstrapPeersEnabled :: UseBootstrapPeers -> Bool
+isBootstrapPeersEnabled DontUseBootstrapPeers = False
+isBootstrapPeersEnabled _                     = True
+
+-- | Determines if the system is in a sensitive state based on bootstrap peer
+-- usage and ledger state.
+--
+-- * When bootstrap peers are not in use, the system is considered to never be
+-- in a sensitive state.
+-- * When bootstrap peers are in use and the ledger is in 'YoungEnough' state,
+-- the system is not in a sensitive state.
+-- * When bootstrap peers are in use and the ledger is in 'TooOld' state,
+-- the system is considered to be in a sensitive state.
+requiresBootstrapPeers :: UseBootstrapPeers -> LedgerStateJudgement -> Bool
+requiresBootstrapPeers ubp lsj =
+  isBootstrapPeersEnabled ubp && lsj == TooOld
+
+-- | A node is able to make progress either if it isn't in a sensitive state
+-- _or_ if it is in a sensitive state and has reached a clean state from which
+-- it now only uses trustable peers
+--
+isNodeAbleToMakeProgress :: UseBootstrapPeers -> LedgerStateJudgement -> Bool -> Bool
+isNodeAbleToMakeProgress ubp lsj hasOnlyBootstrapPeers =
+    not (requiresBootstrapPeers ubp lsj) || hasOnlyBootstrapPeers

ouroboros-network-api/src/Ouroboros/Network/PeerSelection/LedgerPeers/Type.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE DeriveAnyClass             #-}
+{-# LANGUAGE DeriveGeneric              #-}
 {-# LANGUAGE DerivingStrategies         #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 
@@ -8,25 +10,50 @@ module Ouroboros.Network.PeerSelection.LedgerPeers.Type
   ( PoolStake (..)
   , AccPoolStake (..)
   , IsBigLedgerPeer (..)
+  , LedgerStateJudgement (..)
+  , LedgerPeersConsensusInterface (..)
+  , UseLedgerPeers (..)
+  , AfterSlot (..)
+  , isLedgerPeersEnabled
   ) where
 
+import           Cardano.Slotting.Slot (SlotNo (..))
+import           Control.Concurrent.Class.MonadSTM
 import           Control.DeepSeq (NFData (..))
+import           Data.List.NonEmpty (NonEmpty)
+import           GHC.Generics
+import           NoThunks.Class
+import           Ouroboros.Network.PeerSelection.RelayAccessPoint
+                     (RelayAccessPoint)
 
+-- | Only use the ledger after the given slot number.
+data UseLedgerPeers = DontUseLedgerPeers
+                    | UseLedgerPeers AfterSlot
+                    deriving (Eq, Show, Generic, NoThunks)
+
+-- | Only use the ledger after the given slot number.
+data AfterSlot = Always
+               | After SlotNo
+               deriving (Eq, Show, Generic)
+               deriving anyclass NoThunks
+
+isLedgerPeersEnabled :: UseLedgerPeers -> Bool
+isLedgerPeersEnabled DontUseLedgerPeers = False
+isLedgerPeersEnabled UseLedgerPeers {}  = True
 
 -- | The relative stake of a stakepool in relation to the total amount staked.
 -- A value in the [0, 1] range.
 --
 newtype PoolStake = PoolStake { unPoolStake :: Rational }
-  deriving (Eq, Fractional, Num, Ord, Show)
-  deriving newtype NFData
-
+  deriving (Eq, Ord, Show)
+  deriving newtype (Fractional, Num, NFData)
 
 -- | The accumulated relative stake of a stake pool, like PoolStake but it also includes the
 -- relative stake of all preceding pools. A value in the range [0, 1].
 --
 newtype AccPoolStake = AccPoolStake { unAccPoolStake :: Rational }
-    deriving (Eq, Fractional, Num, Ord, Show)
-
+    deriving (Eq, Ord, Show)
+    deriving newtype (Fractional, Num)
 
 -- | A boolean like type.  Big ledger peers are the largest SPOs which control
 -- 90% of staked stake.
@@ -41,3 +68,15 @@ data IsBigLedgerPeer
    = IsBigLedgerPeer
    | IsNotBigLedgerPeer
   deriving Eq
+
+-- | Wether the node is caught up or fell too far behind the chain
+data LedgerStateJudgement = YoungEnough | TooOld
+  deriving (Eq, Show, Generic, NoThunks)
+
+-- | Return ledger state information and ledger peers.
+--
+data LedgerPeersConsensusInterface m = LedgerPeersConsensusInterface {
+    lpGetLatestSlot           :: STM m SlotNo,
+    lpGetLedgerStateJudgement :: STM m LedgerStateJudgement,
+    lpGetLedgerPeers          :: STM m [(PoolStake, NonEmpty RelayAccessPoint)]
+  }

ouroboros-network-api/src/Ouroboros/Network/PeerSelection/PeerTrustable.hs

@@ -0,0 +1,15 @@
+{-# LANGUAGE DeriveGeneric #-}
+
+module Ouroboros.Network.PeerSelection.PeerTrustable (PeerTrustable (..)) where
+
+import           GHC.Generics (Generic)
+
+-- | Is this Peer trustable as a bootstrap peer?
+--
+-- This trustability flag is used on local root peers (pre-genesis) to
+-- distinguish which locally configured peer is considered safe to trust for
+-- bootstrap purposes
+--
+data PeerTrustable = IsTrustable
+                   | IsNotTrustable
+  deriving (Eq, Show, Ord, Generic)

ouroboros-network-framework/CHANGELOG.md

@@ -6,6 +6,8 @@
 
 ### Non-breaking changes
 
+* Fixed correct transition tracing in the case of self connect
+
 ## 0.11.0.0 -- 2024-01-22
 
 ### Breaking changes

ouroboros-network-framework/src/Ouroboros/Network/ConnectionManager/Core.hs

@@ -876,7 +876,7 @@ withConnectionManager ConnectionManagerArguments {
                 Left mbTransition -> do
                   traverse_ (traceWith trTracer) mbTransition
                   close cmSnocket socket
-                  return ( Map.delete peerAddr state
+                  return ( state
                          , Left ()
                          )
                 Right transition -> do
@@ -887,13 +887,23 @@ withConnectionManager ConnectionManagerArguments {
 
             case eTransition of
               Left () -> do
-                traceWith trTracer
-                          (TransitionTrace
-                            peerAddr
-                            Transition
-                               { fromState = Known (TerminatedState Nothing)
-                               , toState   = Unknown
-                               })
+
+                let transition =
+                      TransitionTrace
+                        peerAddr
+                        Transition
+                           { fromState = Known (TerminatedState Nothing)
+                           , toState   = Unknown
+                           }
+                mbTransition <- modifyTMVar stateVar $ \state ->
+                  case Map.lookup peerAddr state of
+                    Nothing -> pure (state, Nothing)
+                    Just v  ->
+                      if mutableConnState == v
+                         then pure (Map.delete peerAddr state , Just transition)
+                         else pure (state                     , Nothing)
+
+                traverse_ (traceWith trTracer) mbTransition
                 traceCounters stateVar
               Right transition ->
                 do traceWith tracer (TrConnectionTimeWait connId)

ouroboros-network-testing/CHANGELOG.md

@@ -4,6 +4,9 @@
 
 ### Breaking changes
 
+* Fixed Script strict API functions. Now functions with an apostrophe `'` are
+  properly strict variants of the non-apostrophe functions.
+
 ### Non-breaking changes
 
 ## 0.5.0.0 -- 2024-01-22

ouroboros-network-testing/ouroboros-network-testing.cabal

@@ -65,6 +65,7 @@ library
                        io-classes       ^>=1.3.1,
                        io-sim,
                        pretty-simple,
+                       strict-stm,
                        psqueues          >=0.2.3 && <0.3,
                        si-timers,
                        tasty,

ouroboros-network-testing/src/Ouroboros/Network/Testing/Data/Script.hs

@@ -37,7 +37,9 @@ import qualified Data.List.NonEmpty as NonEmpty
 import           Data.Set (Set)
 import qualified Data.Set as Set
 
-import           Control.Concurrent.Class.MonadSTM as LazySTM
+import           Control.Concurrent.Class.MonadSTM.Strict
+import           Control.Concurrent.Class.MonadSTM (TVar)
+import qualified Control.Concurrent.Class.MonadSTM as LazySTM
 import           Control.Monad.Class.MonadAsync
 import           Control.Monad.Class.MonadFork
 import           Control.Monad.Class.MonadTimer.SI
@@ -68,8 +70,8 @@ arbitraryScriptOf maxSz a =
 
 initScript :: MonadSTM m
             => Script a
-            -> STM m (TVar m (Script a))
-initScript = LazySTM.newTVar
+            -> m (TVar m (Script a))
+initScript = LazySTM.newTVarIO
 
 stepScript :: MonadSTM m => TVar m (Script a) -> m a
 stepScript scriptVar = atomically (stepScriptSTM scriptVar)
@@ -93,16 +95,16 @@ stepScriptOrFinishSTM scriptVar = do
     Script (x :| xs) <- LazySTM.readTVar scriptVar
     case xs of
       []     -> return (Left x)
-      x':xs' -> writeTVar scriptVar (Script (x' :| xs'))
+      x':xs' -> LazySTM.writeTVar scriptVar (Script (x' :| xs'))
              $> Right x
 
-initScript' :: MonadSTM m => Script a -> m (TVar m (Script a))
+initScript' :: MonadSTM m => Script a -> m (StrictTVar m (Script a))
 initScript' = newTVarIO
 
-stepScript' :: MonadSTM m => TVar m (Script a) -> m a
-stepScript' scriptVar = atomically (stepScriptSTM scriptVar)
+stepScript' :: MonadSTM m => StrictTVar m (Script a) -> m a
+stepScript' scriptVar = atomically (stepScriptSTM' scriptVar)
 
-stepScriptSTM' :: MonadSTM m => TVar m (Script a) -> STM m a
+stepScriptSTM' :: MonadSTM m => StrictTVar m (Script a) -> STM m a
 stepScriptSTM' scriptVar = do
     Script (x :| xs) <- readTVar scriptVar
     case xs of
@@ -153,12 +155,12 @@ instance Arbitrary ScriptDelay where
 playTimedScript :: (MonadAsync m, MonadDelay m)
                 => Tracer m a -> TimedScript a -> m (TVar m a)
 playTimedScript tracer (Script ((x0,d0) :| script)) = do
-    v <- newTVarIO x0
+    v <- LazySTM.newTVarIO x0
     traceWith tracer x0
     _ <- async $ do
            labelThisThread "timed-script"
            threadDelay (interpretScriptDelay d0)
-           sequence_ [ do atomically (writeTVar v x)
+           sequence_ [ do atomically (LazySTM.writeTVar v x)
                           traceWith tracer x
                           threadDelay (interpretScriptDelay d)
                      | (x,d) <- script ]
@@ -211,7 +213,7 @@ arbitraryPickScript pickSome =
       arbitraryScriptOf sz (arbitraryPickMembers pickSome)
 
 interpretPickScript :: (MonadSTM m, Ord peeraddr)
-                    => TVar m (PickScript peeraddr)
+                    => StrictTVar m (PickScript peeraddr)
                     -> Set peeraddr
                     -> Int
                     -> STM m (Set peeraddr)
@@ -222,13 +224,15 @@ interpretPickScript scriptVar available pickNum
   = error "interpretPickScript: given invalid pickNum"
 
   | otherwise
-  = do pickmembers <- stepScriptSTM scriptVar
+  = do pickmembers <- stepScriptSTM' scriptVar
        return (interpretPickMembers pickmembers available pickNum)
 
 interpretPickMembers :: Ord peeraddr
                      => PickMembers peeraddr
                      -> Set peeraddr -> Int -> Set peeraddr
-interpretPickMembers PickFirst     ps _ = Set.singleton (Set.elemAt 0 ps)
+interpretPickMembers PickFirst     ps _
+  | Set.null ps = ps
+  | otherwise   = Set.singleton (Set.elemAt 0 ps)
 interpretPickMembers PickAll       ps n = Set.take n ps
 interpretPickMembers (PickSome as) ps n
   | Set.null ps' = Set.singleton (Set.elemAt 0 ps)

ouroboros-network/CHANGELOG.md

@@ -4,9 +4,42 @@
 
 ### Breaking changes
 
+* Moved `LedgerConsensusInterface` type to `ouroboros-network-api`.
+* Preserved `PeerAdvertise` information when connecting to peers.
+* Added `daReadUseBootstrapPeers` to `ArgumentsExtra`.
+
+* Added `PeerTrustable` to Local Root Peers
+
+* Added new trace constructors for `TracePeerSelection`
+* Updated type of constructor in `TraceLedgerPeers`
+* Updated type of constructor in `TraceLocalRootPeers`
+
 ### Non-breaking changes
 
 * Limit the rate at which one can discover peers through peersharing.
+* Created `PublicRootPeers` and adds `BootstrapPeers` and big ledger peers to
+  `PublicRootPeers` abstraction.
+
+* Adjusted `PeerSelectionActions` `requestPublicRootPeers` function to
+  provide either only ledger peers or bootstrap peers according to the
+  current ledger state. The same for `requestBigLedgerPeers`.
+
+* Added `readLedgerStateJudgement` to `PeerSelectionActions`
+* Added `ledgerStateJudgement` to `PeerSelectionState`
+* Added `bootstrapPeersFlag` to `PeerSelectionState`
+* Added `hasOnlyBootstrapPeers` to `PeerSelectionState`
+
+* Simplified `KnownPeerInfo` by removing `IsLedgerPeer`, `PeerTrustable` and
+  `IsBootstrapPeer`
+
+* Preserved `PeerAdvertise` information when connecting to peers.
+
+* Added new monitoring tasks to monitor the bootstrap peers flag, the ledger
+  state judgement value and act accordingly (`monitorBootstrapPeersFlag`,
+  `monitorLedgerStateJudgement` and `waitForOnlyBootstrapPeers`) .
+
+* Updated other monitoring tasks to consider a possible sensitive state that
+  involves the bootstrap peers flag and the ledger state judgement value.
 
 ## 0.11.0.0 -- 2023-01-22
 

ouroboros-network/ouroboros-network.cabal

@@ -47,6 +47,7 @@ library
                        Ouroboros.Network.Tracers
                        Ouroboros.Network.PeerSelection.Types
                        Ouroboros.Network.PeerSelection.LedgerPeers
+                       Ouroboros.Network.PeerSelection.PublicRootPeers
                        Ouroboros.Network.PeerSelection.PeerMetric
                        Ouroboros.Network.PeerSelection.PeerSelectionActions
                        Ouroboros.Network.PeerSelection.PeerStateActions
@@ -225,6 +226,7 @@ library sim-tests-lib
                        Test.Ouroboros.Network.PeerSelection.PeerGraph
                        Test.Ouroboros.Network.PeerSelection.PeerMetric
                        Test.Ouroboros.Network.PeerSelection.RootPeersDNS
+                       Test.Ouroboros.Network.PeerSelection.PublicRootPeers
                        Test.Ouroboros.Network.PeerState
                        Test.Ouroboros.Network.Testnet
                        Test.Ouroboros.Network.Testnet.Simulation.Node