Expose OutboundConnectionState for consensus

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/LedgerPeers.hs

@@ -86,6 +86,8 @@ instance Arbitrary ArbitraryLedgerStateJudgement where
     shrink (ArbitraryLedgerStateJudgement TooOld)      =
       []
 
+-- TODO: import the `SlotNo` instance from
+-- `Test.Ouroboros.Network.PeerSelection.Instances`
 newtype ArbitrarySlotNo =
   ArbitrarySlotNo {
     getArbitrarySlotNo :: SlotNo

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 (..))
@@ -188,6 +190,7 @@ tests =
       , testProperty "node uses ledger peers in non-sensitive mode"
                      prop_governor_uses_ledger_peers
       ]
+    , testProperty "association mode" prop_governor_association_mode
     ]
   , testGroup "issues"
     [ testProperty "3233" prop_issue_3233
@@ -759,6 +762,7 @@ envEventCredits  TraceEnvActivatePeer {}        = 0
 envEventCredits  TraceEnvDeactivatePeer {}      = 0
 envEventCredits  TraceEnvCloseConn {}           = 0
 
+envEventCredits  TraceEnvUseLedgerPeers {}      = 30
 envEventCredits  TraceEnvSetLedgerStateJudgement {} = 30
 
 envEventCredits  TraceEnvSetUseBootstrapPeers {} = 30
@@ -3424,6 +3428,79 @@ prop_governor_uses_ledger_peers env =
      in counterexample (intercalate "\n" $ map show $ usesLedgerPeers)
       $ all snd usesLedgerPeers
 
+
+prop_governor_association_mode :: GovernorMockEnvironment -> Property
+prop_governor_association_mode env =
+    let events = Signal.eventsFromListUpToTime (Time (10 * 60 * 60))
+               . selectPeerSelectionTraceEvents
+               . runGovernorInMockEnvironment
+               $ env
+
+        counters :: Signal (PeerSelectionSetsWithSizes PeerAddr)
+        counters =
+          selectGovState peerSelectionStateToView events
+
+        -- accumulate local roots
+        localRoots :: Signal (Set PeerAddr)
+        localRoots =
+            Signal.keyedUntil
+              (\case
+                Just (GovernorEvent (TraceLocalRootPeersChanged a _)) -> LocalRootPeers.keysSet a
+                Just (MockEnvEvent (TraceEnvSetLocalRoots a)) -> LocalRootPeers.keysSet a
+                _ -> Set.empty
+              )
+              (\_ -> Set.empty)
+              (\_ -> False)
+          . Signal.fromChangeEvents Nothing
+          . fmap Just
+          $ events
+
+        publicRoots :: Signal (Set PeerAddr)
+        publicRoots =
+            Signal.keyedUntil
+              PublicRootPeers.toSet
+              (\_ -> Set.empty)
+              (\_ -> False)
+          . selectGovState Governor.publicRootPeers
+          $ events
+
+        associationMode :: Signal AssociationMode
+        associationMode =
+            Signal.fromChangeEvents Unrestricted
+          $ selectGovAssociationMode events
+
+    in counterexample (intercalate "\n" $ show <$> Signal.eventsToList events)
+     $ signalProperty 20 show
+        (\(cs, localRootSet, publicRootSet, am) ->
+          case am of
+            LocalRootsOnly ->
+              -- we need to remove local and public roots.  They are changing
+              -- over time, and a node might keep using them, event though the
+              -- node is configured as an `Unrestricted` node.
+              --
+              -- This makes this test only effective if a node starts in
+              -- `LocalRootsOnly` mode, until it is reconfigured.  This can
+              -- discover some bugs in `readAssociationMode` but certainly not
+              -- all.
+              --
+              -- TODO: write a more effective test.
+                 Set.null (fst (viewKnownBootstrapPeers cs)
+                            Set.\\ localRootSet
+                            Set.\\ publicRootSet)
+              && Set.null (fst (viewKnownBigLedgerPeers cs)
+                            Set.\\ localRootSet
+                            Set.\\ publicRootSet)
+              && Set.null (fst (viewKnownNonRootPeers cs)
+                            Set.\\ localRootSet
+                            Set.\\ publicRootSet)
+
+            Unrestricted -> True
+        )
+        ((,,,) <$> counters
+               <*> localRoots
+               <*> publicRoots
+               <*> associationMode)
+
 --
 -- Utils for properties
 --
@@ -3442,6 +3519,18 @@ selectGovEvents = Signal.selectEvents
                     (\case GovernorEvent e -> Just $! e
                            _               -> Nothing)
 
+selectGovCounters :: Events TestTraceEvent
+                  -> Events PeerSelectionCounters
+selectGovCounters = Signal.selectEvents
+                      (\case GovernorCounters e -> Just $! e
+                             _                  -> Nothing)
+
+selectGovAssociationMode :: Events TestTraceEvent
+                         -> Events AssociationMode
+selectGovAssociationMode = Signal.selectEvents
+                             (\case GovernorAssociationMode e -> Just $! e
+                                    _                         -> Nothing)
+
 selectGovState :: Eq a
                => (forall peerconn. Governor.PeerSelectionState PeerAddr peerconn -> a)
                -> Events TestTraceEvent
@@ -3482,30 +3571,35 @@ _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
+    countersVar <- newTVarIO emptyPeerSelectionCounters
+    publicStateVar <- makePublicPeerSelectionStateVar
+    debugStateVar <- newTVarIO $ emptyPeerSelectionState (mkStdGen 42)
     dnsSemaphore <- newLedgerAndPublicRootDNSSemaphore
+    let interfaces = PeerSelectionInterfaces {
+            countersVar,
+            publicStateVar,
+            debugStateVar,
+            readUseLedgerPeers = return DontUseLedgerPeers
+          }
     publicRootPeersProvider
       tracer
       (curry IP.toSockAddr)
       dnsSemaphore
       DNS.defaultResolvConf
       readDomains
       (ioDNSActions LookupReqAAndAAAA) $ \requestPublicRootPeers -> do
-        publicStateVar <- makePublicPeerSelectionStateVar
-        debugVar <- newTVarIO $ emptyPeerSelectionState (mkStdGen 42)
-        countersVar <- newTVarIO emptyPeerSelectionCounters
         peerSelectionGovernor
           tracer tracer tracer
           -- TODO: #3182 Rng seed should come from quickcheck.
           (mkStdGen 42)
-          countersVar
-          publicStateVar
-          debugVar
           actions
             { requestPublicRootPeers = \_ ->
                 transformPeerSelectionAction requestPublicRootPeers }
           policy
+          interfaces
   where
     tracer :: Show a => Tracer IO a
     tracer  = Tracer (BS.putStrLn . BS.pack . show)
@@ -3527,8 +3621,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 {
@@ -3590,6 +3688,7 @@ prop_issue_3550 = prop_governor_target_established_below defaultMaxTime $
       pickColdPeersToForget = Script (PickFirst :| []),
       peerSharingFlag = PeerSharingEnabled,
       useBootstrapPeers = Script ((DontUseBootstrapPeers, NoDelay) :| []),
+      useLedgerPeers = Script ((UseLedgerPeers Always, NoDelay) :| []),
       ledgerStateJudgement = Script ((YoungEnough, NoDelay) :| [])
     }
 
@@ -3626,6 +3725,7 @@ prop_issue_3515 = prop_governor_nolivelock $
       pickColdPeersToForget = Script (PickFirst :| []),
       peerSharingFlag = PeerSharingEnabled,
       useBootstrapPeers = Script ((DontUseBootstrapPeers, NoDelay) :| []),
+      useLedgerPeers = Script ((UseLedgerPeers Always, NoDelay) :| []),
       ledgerStateJudgement = Script ((YoungEnough, NoDelay) :| [])
     }
 
@@ -3662,6 +3762,7 @@ prop_issue_3494 = prop_governor_nofail $
       pickColdPeersToForget = Script (PickFirst :| []),
       peerSharingFlag = PeerSharingEnabled,
       useBootstrapPeers = Script ((DontUseBootstrapPeers, NoDelay) :| []),
+      useLedgerPeers = Script ((UseLedgerPeers Always, NoDelay) :| []),
       ledgerStateJudgement = Script ((YoungEnough, NoDelay) :| [])
     }
 
@@ -3714,6 +3815,7 @@ prop_issue_3233 = prop_governor_nolivelock $
       pickColdPeersToForget = Script (PickFirst :| []),
       peerSharingFlag = PeerSharingEnabled,
       useBootstrapPeers = Script ((DontUseBootstrapPeers, NoDelay) :| []),
+      useLedgerPeers = Script ((UseLedgerPeers Always, NoDelay) :| []),
       ledgerStateJudgement = Script ((YoungEnough, NoDelay) :| [])
     }