peer-selection: added publicly visible OutboundConnectionsState

Consensus needs to know if the outbound governor is connected just to
local roots or any external roots.  Diffusion takes a callback
`OutboundConnectionsState -> STM m ()` used by the outbound governor.

Co-authored-by: Armando Santos (@bolt12)
Co-authored-by: Marcin Szamotulski (@coot)

ouroboros-network-api/CHANGELOG.md

@@ -6,6 +6,8 @@
 
 ### Non-Breaking changes
 
+* Added `OutboundConnectionsState` data type
+
 ## 0.7.1.0 -- 2024-03-14
 
 ### Breaking changes

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

@@ -43,6 +43,7 @@ library
 
                        Ouroboros.Network.PeerSelection.Bootstrap
                        Ouroboros.Network.PeerSelection.LedgerPeers.Type
+                       Ouroboros.Network.PeerSelection.LocalRootPeers
                        Ouroboros.Network.PeerSelection.PeerMetric.Type
                        Ouroboros.Network.PeerSelection.PeerAdvertise
                        Ouroboros.Network.PeerSelection.PeerTrustable

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

@@ -0,0 +1,21 @@
+{-# LANGUAGE DeriveGeneric #-}
+
+module Ouroboros.Network.PeerSelection.LocalRootPeers (OutboundConnectionsState (..)) where
+
+import GHC.Generics
+import NoThunks.Class
+
+data OutboundConnectionsState =
+    TrustedStateWithExternalPeers
+    -- ^
+    -- * /in the Praos mode/: connected only to trusted local
+    --   peers and at least one bootstrap peer or public root;
+    -- * /in the Genesis mode/: meeting target of active big ledger peers;
+    -- * or it is in `Unrestricted` mode
+    --   (see `Ouroboros.Network.PeerSelection.Governor.AssociationMode`).
+
+  | UntrustedState
+    -- ^ catch all other cases
+  deriving (Eq, Show, Generic)
+
+instance NoThunks OutboundConnectionsState

ouroboros-network/CHANGELOG.md

@@ -11,6 +11,11 @@
   The counters cover more groups including: all peers, big ledger peers,
   bootstrap peers, local roots and shared peers.
 * `emptyPeerSelectionState` doesn't take targets of local roots.
+* Added `daUpdateOutboundConnectionsState :: OutboundConnectionsState -> STM m ()`
+  to `Diffusion.Common.Applications`. This callback is to be provided by
+  consensus and is propagated all the way to the peer selection governor.
+* Added `AssociationMode` and `LedgerStateJudgement` to `DebugPeerSelectionState`.
+  Both should be exposed through `EKG` counters by the node.
 
 ### Non-Breaking changes
 

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

@@ -94,6 +94,7 @@ import Simulation.Network.Snocket (AddressType (..), FD)
 import Ouroboros.Network.PeerSelection.Bootstrap (UseBootstrapPeers)
 import Ouroboros.Network.PeerSelection.LedgerPeers.Type
            (LedgerPeersConsensusInterface, UseLedgerPeers)
+import Ouroboros.Network.PeerSelection.LocalRootPeers (OutboundConnectionsState)
 import Ouroboros.Network.PeerSelection.PeerAdvertise (PeerAdvertise (..))
 import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing (..))
 import Ouroboros.Network.PeerSelection.PeerTrustable (PeerTrustable)
@@ -124,6 +125,8 @@ data Interfaces m = Interfaces
     , iDomainMap         :: StrictTVar m (Map Domain [(IP, TTL)])
     , iLedgerPeersConsensusInterface
                          :: LedgerPeersConsensusInterface m
+    , iUpdateOutboundConnectionsState
+                         :: OutboundConnectionsState -> STM m ()
     }
 
 type NtNFD m = FD m NtNAddr
@@ -410,6 +413,8 @@ run blockGeneratorArgs limits ni na tracersExtra tracerBlockFetch =
       , Node.aaShouldChainSyncExit      = aShouldChainSyncExit na
       , Node.aaChainSyncEarlyExit       = aChainSyncEarlyExit na
       , Node.aaOwnPeerSharing           = aOwnPeerSharing na
+      , Node.aaUpdateOutboundConnectionsState =
+          iUpdateOutboundConnectionsState ni
       }
 
 --- Utils

ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Diffusion/Node/MiniProtocols.hs

@@ -88,6 +88,7 @@ import Ouroboros.Network.NodeToNode (blockFetchMiniProtocolNum,
            chainSyncMiniProtocolNum, keepAliveMiniProtocolNum,
            peerSharingMiniProtocolNum)
 import Ouroboros.Network.PeerSelection.LedgerPeers
+import Ouroboros.Network.PeerSelection.LocalRootPeers (OutboundConnectionsState)
 import Ouroboros.Network.PeerSelection.PeerSharing qualified as PSTypes
 import Ouroboros.Network.PeerSharing (PeerSharingAPI, bracketPeerSharingClient,
            peerSharingClient, peerSharingServer)
@@ -205,6 +206,8 @@ data AppArgs header block m = AppArgs
   , aaChainSyncEarlyExit  :: Bool
   , aaOwnPeerSharing
      :: PSTypes.PeerSharing
+  , aaUpdateOutboundConnectionsState
+     :: OutboundConnectionsState -> STM m ()
   }
 
 
@@ -253,6 +256,7 @@ applications debugTracer nodeKernel
                , aaShouldChainSyncExit
                , aaChainSyncEarlyExit
                , aaOwnPeerSharing
+               , aaUpdateOutboundConnectionsState
                }
              toHeader =
     Diff.Applications
@@ -270,6 +274,8 @@ applications debugTracer nodeKernel
                                   localResponderApp
       , Diff.daLedgerPeersCtx =
           aaLedgerPeersConsensusInterface
+      , Diff.daUpdateOutboundConnectionsState =
+          aaUpdateOutboundConnectionsState
       }
   where
     initiatorApp

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

@@ -31,6 +31,7 @@ module Test.Ouroboros.Network.PeerSelection
 
 import Control.Concurrent.Class.MonadSTM.Strict
 import Control.Exception (AssertionFailed (..), catch, evaluate)
+import Control.Monad (when)
 import Control.Monad.Class.MonadTime.SI
 import Control.Monad.Class.MonadTimer.SI
 import Control.Tracer (Tracer (..))
@@ -62,6 +63,7 @@ import Ouroboros.Network.PeerSelection.Governor hiding (PeerSelectionState (..),
            peerSharing)
 import Ouroboros.Network.PeerSelection.Governor qualified as Governor
 import Ouroboros.Network.PeerSelection.LedgerPeers
+import Ouroboros.Network.PeerSelection.LocalRootPeers (OutboundConnectionsState)
 import Ouroboros.Network.PeerSelection.PeerAdvertise
 import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing (..))
 import Ouroboros.Network.PeerSelection.PeerTrustable (PeerTrustable (..))
@@ -3482,9 +3484,13 @@ _governorFindingPublicRoots :: Int
                             -> STM IO UseBootstrapPeers
                             -> STM IO LedgerStateJudgement
                             -> PeerSharing
+                            -> StrictTVar IO OutboundConnectionsState
                             -> IO Void
-_governorFindingPublicRoots targetNumberOfRootPeers readDomains readUseBootstrapPeers readLedgerStateJudgement peerSharing = do
+_governorFindingPublicRoots targetNumberOfRootPeers readDomains readUseBootstrapPeers readLedgerStateJudgement peerSharing olocVar = do
     dnsSemaphore <- newLedgerAndPublicRootDNSSemaphore
+    let interfaces = PeerSelectionInterfaces {
+            readUseLedgerPeers = return DontUseLedgerPeers
+          }
     publicRootPeersProvider
       tracer
       (curry IP.toSockAddr)
@@ -3506,6 +3512,7 @@ _governorFindingPublicRoots targetNumberOfRootPeers readDomains readUseBootstrap
             { requestPublicRootPeers = \_ ->
                 transformPeerSelectionAction requestPublicRootPeers }
           policy
+          interfaces
   where
     tracer :: Show a => Tracer IO a
     tracer  = Tracer (BS.putStrLn . BS.pack . show)
@@ -3527,8 +3534,12 @@ _governorFindingPublicRoots targetNumberOfRootPeers readDomains readUseBootstrap
                   closePeerConnection      = error "closePeerConnection"
                 },
                 readUseBootstrapPeers,
-                readLedgerStateJudgement
-              }
+                readLedgerStateJudgement,
+                updateOutboundConnectionsState = \a -> do
+                  a' <- readTVar olocVar
+                  when (a /= a') $
+                    writeTVar olocVar a
+                              }
 
     targets :: PeerSelectionTargets
     targets = nullPeerSelectionTargets {

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

@@ -46,6 +46,7 @@ import System.Random (mkStdGen)
 import Control.Concurrent.Class.MonadSTM
 import Control.Concurrent.Class.MonadSTM.Strict qualified as StrictTVar
 import Control.Exception (throw)
+import Control.Monad (when)
 import Control.Monad.Class.MonadAsync
 import Control.Monad.Class.MonadFork
 import Control.Monad.Class.MonadSay
@@ -76,10 +77,9 @@ import Test.Ouroboros.Network.PeerSelection.PeerGraph
 
 import Ouroboros.Network.PeerSelection.Bootstrap (UseBootstrapPeers (..),
            requiresBootstrapPeers)
-import Ouroboros.Network.PeerSelection.LedgerPeers (IsBigLedgerPeer,
-           LedgerPeersKind (..))
-import Ouroboros.Network.PeerSelection.LedgerPeers.Type
-           (LedgerStateJudgement (..))
+import Ouroboros.Network.PeerSelection.LedgerPeers
+import Ouroboros.Network.PeerSelection.LocalRootPeers
+           (OutboundConnectionsState (..))
 import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing (..))
 import Ouroboros.Network.PeerSelection.PublicRootPeers (PublicRootPeers (..))
 import Ouroboros.Network.PeerSelection.PublicRootPeers qualified as PublicRootPeers
@@ -215,6 +215,11 @@ governorAction mockEnv = do
     countersVar <- StrictTVar.newTVarIO emptyPeerSelectionCounters
     policy  <- mockPeerSelectionPolicy                mockEnv
     actions <- mockPeerSelectionActions tracerMockEnv mockEnv (readTVar usbVar) (readTVar lsjVar) policy
+    let interfaces = PeerSelectionInterfaces {
+            -- peer selection tests are not relying on `UseLedgerPeers`
+            readUseLedgerPeers = return DontUseLedgerPeers
+          }
+
     exploreRaces      -- explore races within the governor
     _ <- forkIO $ do  -- races with the governor should be explored
       labelThisThread "outbound-governor"
@@ -228,6 +233,7 @@ governorAction mockEnv = do
         debugVar
         actions
         policy
+        interfaces
       atomically retry
     atomically retry  -- block to allow the governor to run
 
@@ -301,12 +307,14 @@ mockPeerSelectionActions tracer
                 v (\_ a -> TraceDynamic . TraceEnvPeersStatus
                        <$> snapshotPeersStatus proxy a)
       return v
+
+    onlyLocalOutboundConnsVar <- newTVarIO UntrustedState
     traceWith tracer (TraceEnvAddPeers peerGraph)
     traceWith tracer (TraceEnvSetLocalRoots localRootPeers)   --TODO: make dynamic
     traceWith tracer (TraceEnvSetPublicRoots publicRootPeers) --TODO: make dynamic
     return $ mockPeerSelectionActions'
                tracer env policy
-               scripts targetsVar readUseBootstrapPeers getLedgerStateJudgement peerConns
+               scripts targetsVar readUseBootstrapPeers getLedgerStateJudgement peerConns onlyLocalOutboundConnsVar
   where
     proxy :: Proxy m
     proxy = Proxy
@@ -331,6 +339,7 @@ mockPeerSelectionActions' :: forall m.
                           -> STM m UseBootstrapPeers
                           -> STM m LedgerStateJudgement
                           -> TVar m (Map PeerAddr (TVar m PeerStatus))
+                          -> TVar m OutboundConnectionsState
                           -> PeerSelectionActions PeerAddr (PeerConn m) m
 mockPeerSelectionActions' tracer
                           GovernorMockEnvironment {
@@ -343,7 +352,8 @@ mockPeerSelectionActions' tracer
                           targetsVar
                           readUseBootstrapPeers
                           readLedgerStateJudgement
-                          connsVar =
+                          connsVar
+                          outboundConnectionsStateVar =
     PeerSelectionActions {
       readLocalRootPeers       = return (LocalRootPeers.toGroups localRootPeers),
       peerSharing              = peerSharingFlag,
@@ -360,7 +370,11 @@ mockPeerSelectionActions' tracer
           closePeerConnection
         },
       readUseBootstrapPeers,
-      readLedgerStateJudgement
+      readLedgerStateJudgement,
+      updateOutboundConnectionsState = \a -> do
+        a' <- readTVar outboundConnectionsStateVar
+        when (a /= a') $
+          writeTVar outboundConnectionsStateVar a
     }
   where
     -- TODO: make this dynamic

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

@@ -34,7 +34,7 @@ module Test.Ouroboros.Network.Testnet.Simulation.Node
 import Control.Applicative (Alternative)
 import Control.Concurrent.Class.MonadMVar (MonadMVar)
 import Control.Concurrent.Class.MonadSTM.Strict
-import Control.Monad (forM)
+import Control.Monad (forM, when)
 import Control.Monad.Class.MonadAsync
 import Control.Monad.Class.MonadFork
 import Control.Monad.Class.MonadSay
@@ -120,6 +120,8 @@ import Data.Typeable (Typeable)
 import Ouroboros.Network.BlockFetch (FetchMode (..), TraceFetchClientState,
            TraceLabelPeer (..))
 import Ouroboros.Network.PeerSelection.Bootstrap (UseBootstrapPeers (..))
+import Ouroboros.Network.PeerSelection.LocalRootPeers
+           (OutboundConnectionsState (..))
 import Ouroboros.Network.PeerSelection.PeerAdvertise (PeerAdvertise (..))
 import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing)
 import Ouroboros.Network.PeerSelection.PeerTrustable (PeerTrustable)
@@ -1066,6 +1068,7 @@ diffusionSimulation
             dMapVar = do
       chainSyncExitVar <- newTVarIO chainSyncExitOnBlockNo
       ledgerPeersVar <- initScript' ledgerPeers
+      onlyOutboundConnectionsStateVar <- newTVarIO UntrustedState
       let (bgaRng, rng) = Random.split $ mkStdGen seed
           acceptedConnectionsLimit =
             AcceptedConnectionsLimit maxBound maxBound 0
@@ -1147,6 +1150,11 @@ diffusionSimulation
                              $ accPoolStake
                              $ getLedgerPools
                              $ ledgerPools)
+              , NodeKernel.iUpdateOutboundConnectionsState =
+                  \a -> do
+                    a' <- readTVar onlyOutboundConnectionsStateVar
+                    when (a /= a') $
+                      writeTVar onlyOutboundConnectionsStateVar a
               }
 
           shouldChainSyncExit :: StrictTVar m (Maybe BlockNo) -> BlockHeader -> m Bool

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

@@ -34,6 +34,7 @@ import Ouroboros.Network.NodeToNode qualified as NodeToNode
 import Ouroboros.Network.PeerSelection.Governor.Types (PublicPeerSelectionState)
 import Ouroboros.Network.PeerSelection.LedgerPeers.Type
            (LedgerPeersConsensusInterface)
+import Ouroboros.Network.PeerSelection.LocalRootPeers (OutboundConnectionsState)
 import Ouroboros.Network.Snocket (FileDescriptor)
 import Ouroboros.Network.Socket (SystemdSocketTracer)
 
@@ -193,4 +194,13 @@ data Applications ntnAddr ntnVersion ntnVersionData
       --
       -- TODO: it should be in 'InterfaceExtra'
     , daLedgerPeersCtx :: LedgerPeersConsensusInterface m
+
+      -- | Callback provided by consensus to inform it if the node is
+      -- connected to only local roots or also some external peers.
+      --
+      -- This is useful in order for the Bootstrap State Machine to
+      -- simply refuse to transition from TooOld to YoungEnough while
+      -- it only has local peers.
+      --
+    , daUpdateOutboundConnectionsState :: OutboundConnectionsState -> STM m ()
   }

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

@@ -103,9 +103,9 @@ import Ouroboros.Network.PeerSelection.Governor qualified as Governor
 import Ouroboros.Network.PeerSelection.Governor.Types
            (ChurnMode (ChurnModeNormal), DebugPeerSelection (..),
            PeerSelectionActions, PeerSelectionCounters,
-           PeerSelectionPolicy (..), PeerSelectionState,
-           TracePeerSelection (..), emptyPeerSelectionCounters,
-           emptyPeerSelectionState)
+           PeerSelectionInterfaces (..), PeerSelectionPolicy (..),
+           PeerSelectionState, TracePeerSelection (..),
+           emptyPeerSelectionCounters, emptyPeerSelectionState)
 #ifdef POSIX
 import Ouroboros.Network.PeerSelection.Governor.Types
            (makeDebugPeerSelectionState)
@@ -646,6 +646,7 @@ runM Interfaces
        , daLedgerPeersCtx =
           daLedgerPeersCtx@LedgerPeersConsensusInterface
             { lpGetLedgerStateJudgement }
+       , daUpdateOutboundConnectionsState
        }
      ApplicationsExtra
        { daRethrowPolicy
@@ -983,7 +984,8 @@ runM Interfaces
                                          psReadUseBootstrapPeers = daReadUseBootstrapPeers,
                                          psPeerSharing = daOwnPeerSharing,
                                          psPeerConnToPeerSharing = pchPeerSharing diNtnPeerSharing,
-                                         psReadPeerSharingController = readTVar (getPeerSharingRegistry daPeerSharingRegistry) }
+                                         psReadPeerSharingController = readTVar (getPeerSharingRegistry daPeerSharingRegistry),
+                                         psUpdateOutboundConnectionsState = daUpdateOutboundConnectionsState }
                                        WithLedgerPeersArgs {
                                          wlpRng = ledgerPeersRng,
                                          wlpConsensusInterface = daLedgerPeersCtx,
@@ -1009,6 +1011,10 @@ runM Interfaces
               dbgVar
               peerSelectionActions
               peerSelectionPolicy
+              PeerSelectionInterfaces {
+                readUseLedgerPeers = daReadUseLedgerPeers
+              }
+
 
       --
       -- The peer churn governor:
@@ -1194,9 +1200,15 @@ run tracers tracersExtra args argsExtra apps appsExtra = do
                                      (TrState state)
                            ps <- readTVarIO dbgStateVar
                            now <- getMonotonicTime
-                           (up, bp) <- atomically $ (,) <$> upstreamyness metrics
+                           (up, bp, lsj, am) <- atomically $
+                                                  (,,,) <$> upstreamyness metrics
                                                         <*> fetchynessBlocks metrics
-                           let dbgState = makeDebugPeerSelectionState ps up bp
+                                                        <*> lpGetLedgerStateJudgement (daLedgerPeersCtx apps)
+                                                        <*> Governor.readAssociationMode
+                                                              (daReadUseLedgerPeers argsExtra)
+                                                              (daOwnPeerSharing argsExtra)
+                                                              (Governor.bootstrapPeersFlag ps)
+                           let dbgState = makeDebugPeerSelectionState ps up bp lsj am
                            traceWith (dtTracePeerSelectionTracer tracersExtra)
                                      (TraceDebugState now dbgState)
                        )