outbound-governor: 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,7 @@
+module Ouroboros.Network.PeerSelection.LocalRootPeers
+  ( OutboundConnectionsState (..)
+  ) where
+
+data OutboundConnectionsState = ConnectedToExternalOutboundPeers
+                              | ConnectedToOnlyLocalOutboundPeers
+  deriving (Eq, Show)

ouroboros-network/CHANGELOG.md

@@ -8,6 +8,9 @@
   / known sets, and added `PeerSelectionCountersHWC` which provides sizes of
   hot / warm / cold sets.  The counters cover more groups including: all peers,
   big ledger peers, bootstrap peers, local roots and shared peers.
+* 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.
 
 ### 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

@@ -72,13 +72,15 @@ import Test.Ouroboros.Network.PeerSelection.Instances
 import Test.Ouroboros.Network.PeerSelection.MockEnvironment hiding (tests)
 import Test.Ouroboros.Network.PeerSelection.PeerGraph
 
-import Control.Concurrent.Class.MonadSTM.Strict (newTVarIO)
+import Control.Concurrent.Class.MonadSTM.Strict
+import Control.Monad (when)
 import Control.Monad.Class.MonadTime.SI
 import Control.Monad.IOSim
 import Ouroboros.Network.ExitPolicy (RepromoteDelay (..))
 import Ouroboros.Network.PeerSelection.Bootstrap (UseBootstrapPeers (..),
-           requiresBootstrapPeers)
+         requiresBootstrapPeers)
 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 (..))
@@ -3325,8 +3327,9 @@ _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
     publicRootPeersProvider
       tracer
@@ -3370,8 +3373,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

@@ -45,6 +45,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
@@ -73,10 +74,12 @@ import Test.Ouroboros.Network.PeerSelection.LocalRootPeers as LocalRootPeers hid
            (tests)
 import Test.Ouroboros.Network.PeerSelection.PeerGraph
 
-import Ouroboros.Network.PeerSelection.Bootstrap (UseBootstrapPeers (..),
+import Ouroboros.Network.PeerSelection.Bootstrap
+           (UseBootstrapPeers (..),
            requiresBootstrapPeers)
 import Ouroboros.Network.PeerSelection.LedgerPeers (IsBigLedgerPeer,
            LedgerPeersKind (..))
+import Ouroboros.Network.PeerSelection.LocalRootPeers (OutboundConnectionsState (..))
 import Ouroboros.Network.PeerSelection.LedgerPeers.Type
            (LedgerStateJudgement (..))
 import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing (..))
@@ -300,12 +303,14 @@ mockPeerSelectionActions tracer
                 v (\_ a -> TraceDynamic . TraceEnvPeersStatus
                        <$> snapshotPeersStatus proxy a)
       return v
+
+    onlyLocalOutboundConnsVar <- newTVarIO ConnectedToOnlyLocalOutboundPeers
     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
@@ -330,6 +335,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 {
@@ -342,7 +348,8 @@ mockPeerSelectionActions' tracer
                           targetsVar
                           readUseBootstrapPeers
                           readLedgerStateJudgement
-                          connsVar =
+                          connsVar
+                          outboundConnectionsStateVar =
     PeerSelectionActions {
       readLocalRootPeers       = return (LocalRootPeers.toGroups localRootPeers),
       peerSharing              = peerSharing,
@@ -359,7 +366,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,7 @@ 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 +1067,7 @@ diffusionSimulation
             dMapVar = do
       chainSyncExitVar <- newTVarIO chainSyncExitOnBlockNo
       ledgerPeersVar <- initScript' ledgerPeers
+      onlyOutboundConnectionsStateVar <- newTVarIO ConnectedToOnlyLocalOutboundPeers
       let (bgaRng, rng) = Random.split $ mkStdGen seed
           acceptedConnectionsLimit =
             AcceptedConnectionsLimit maxBound maxBound 0
@@ -1147,6 +1149,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

@@ -24,6 +24,7 @@ import Control.Tracer (Tracer, nullTracer)
 
 import Network.Mux (MuxMode (..), MuxTrace, WithMuxBearer)
 
+import Control.Concurrent.Class.MonadSTM
 import Ouroboros.Network.Mux (OuroborosApplicationWithMinimalCtx,
            OuroborosBundleWithExpandedCtx)
 import Ouroboros.Network.NodeToClient (Versions)
@@ -34,6 +35,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 +195,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

@@ -641,6 +641,7 @@ runM Interfaces
        , daLedgerPeersCtx =
           daLedgerPeersCtx@LedgerPeersConsensusInterface
             { lpGetLedgerStateJudgement }
+       , daUpdateOutboundConnectionsState
        }
      ApplicationsExtra
        { daRethrowPolicy
@@ -978,7 +979,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,

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

@@ -39,6 +39,7 @@ import Data.Cache
 import Data.Foldable (traverse_)
 import Data.Hashable
 import Data.Void (Void)
+import Data.Set qualified as Set
 
 import Control.Applicative (Alternative ((<|>)))
 import Control.Concurrent.Class.MonadSTM.Strict
@@ -51,6 +52,8 @@ import Control.Monad.Class.MonadTimer.SI
 import Control.Tracer (Tracer (..), traceWith)
 import System.Random
 
+import Ouroboros.Network.PeerSelection.LocalRootPeers
+           (OutboundConnectionsState (..))
 import Ouroboros.Network.PeerSelection.Churn (peerChurnGovernor)
 import Ouroboros.Network.PeerSelection.Governor.ActivePeers qualified as ActivePeers
 import Ouroboros.Network.PeerSelection.Governor.BigLedgerPeers qualified as BigLedgerPeers
@@ -59,6 +62,7 @@ import Ouroboros.Network.PeerSelection.Governor.KnownPeers qualified as KnownPee
 import Ouroboros.Network.PeerSelection.Governor.Monitor qualified as Monitor
 import Ouroboros.Network.PeerSelection.Governor.RootPeers qualified as RootPeers
 import Ouroboros.Network.PeerSelection.Governor.Types
+import Ouroboros.Network.PeerSelection.State.LocalRootPeers qualified as LocalRootPeers
 import Ouroboros.Network.PeerSelection.State.EstablishedPeers qualified as EstablishedPeers
 import Ouroboros.Network.PeerSelection.State.KnownPeers qualified as KnownPeers
 
@@ -554,11 +558,22 @@ peerSelectionGovernorLoop tracer
       -- get the current time after the governor returned from the blocking
       -- 'evalGuardedDecisions' call.
       now <- getMonotonicTime
+
       let Decision { decisionTrace, decisionJobs, decisionState } =
             timedDecision now
           !newCounters = peerStateToCounters decisionState
 
+          !outboundConnectionsState =
+            if activePeers st
+               `Set.isSubsetOf`
+               LocalRootPeers.keysSet (localRootPeers st)
+            then ConnectedToOnlyLocalOutboundPeers
+            else ConnectedToExternalOutboundPeers
+
       atomically $ do
+        -- Update consensus callback
+        updateOutboundConnectionsState actions outboundConnectionsState
+
         -- Update Counters TVar
         withCacheA (countersCache decisionState)
                    newCounters

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

@@ -89,6 +89,7 @@ import Ouroboros.Network.ExitPolicy
 import Ouroboros.Network.PeerSelection.Bootstrap (UseBootstrapPeers (..))
 import Ouroboros.Network.PeerSelection.LedgerPeers (IsBigLedgerPeer,
            LedgerPeersKind)
+import Ouroboros.Network.PeerSelection.LocalRootPeers (OutboundConnectionsState)
 import Ouroboros.Network.PeerSelection.LedgerPeers.Type
            (LedgerStateJudgement (..))
 import Ouroboros.Network.PeerSelection.PeerAdvertise (PeerAdvertise)
@@ -333,7 +334,17 @@ data PeerSelectionActions peeraddr peerconn m = PeerSelectionActions {
 
        -- | Read the current ledger state judgement
        --
-       readLedgerStateJudgement :: STM m LedgerStateJudgement
+       readLedgerStateJudgement :: STM m LedgerStateJudgement,
+
+       -- | 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.
+       --
+       updateOutboundConnectionsState :: OutboundConnectionsState -> STM m ()
+
      }
 
 -- | Callbacks which are performed to change peer state.
@@ -574,8 +585,7 @@ makePublicPeerSelectionStateVar = newTVarIO emptyPublicPeerSelectionState
 --
 toPublicState :: PeerSelectionState peeraddr peerconn
               -> PublicPeerSelectionState peeraddr
-toPublicState PeerSelectionState { knownPeers
-                                 } =
+toPublicState PeerSelectionState { knownPeers } =
    PublicPeerSelectionState {
      availableToShare =
        KnownPeers.getPeerSharingResponsePeers knownPeers