Add ConnectionMode to AcquireOutboundConnection

the-headless-ghost · the-headless-ghost · commit c2e3eec2f401 · 2025-11-09T13:46:13.000+08:00
diff --git a/cardano-diffusion/changelog.d/20251108_103013_edgr_behind_firewall.md b/cardano-diffusion/changelog.d/20251108_103013_edgr_behind_firewall.md
@@ -0,0 +1,17 @@
+<!--
+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
+
+- Modified `establishPeerConnection` in `Test.Cardano.Network.PeerSelection.MockEnvironment`:
+  - Now only creates a new connection if no inbound connection is found and `ConnectionMode` allows it.
+  - Added tracing for newly created connections.
+
+### Non-Breaking
+
+- Added a new tracer: `TraceEnvNewConnCreated`.
+- Added a property test to verify that the node never connects to peers behind a firewall.
diff --git a/cardano-diffusion/tests/lib/Test/Cardano/Network/PeerSelection.hs b/cardano-diffusion/tests/lib/Test/Cardano/Network/PeerSelection.hs
@@ -154,6 +154,8 @@ tests =
                      prop_governor_target_active_local_below
       , testProperty "progresses towards active target (from above)"
                      prop_governor_target_active_local_above
+      , testProperty "never connect to peers behind a firewall"
+                     prop_governor_never_connect_peer_behind_firewall
       ]
 
     , testGroup "big ledger peers"
@@ -799,6 +801,7 @@ envEventCredits (TraceEnvSetLocalRoots  peers)  = LocalRootPeers.size peers
 envEventCredits (TraceEnvSetPublicRoots peers)  = PublicRootPeers.size Cardano.ExtraPeers.size peers
 envEventCredits  TraceEnvRequestPublicRootPeers = 0
 envEventCredits  TraceEnvRequestBigLedgerPeers  = 0
+envEventCredits  (TraceEnvNewConnCreated _)     = 0
 envEventCredits  TraceEnvPublicRootTTL          = 60
 envEventCredits  TraceEnvBigLedgerPeersTTL      = 60
 
@@ -3206,6 +3209,56 @@ prop_governor_target_established_above (MaxTime maxTime) env =
                      <*> govInProgressIneligibleSig
                      <*> demotionOpportunitiesIgnoredTooLong)
 
+-- |  Avoid connecting to root peers marked as behind a firewall and without inbound connection.
+prop_governor_never_connect_peer_behind_firewall :: MaxTime -> GovernorMockEnvironment -> Property
+prop_governor_never_connect_peer_behind_firewall (MaxTime maxTime) env =
+    let events = Signal.eventsFromListUpToTime maxTime
+               . selectPeerSelectionTraceEvents
+                   @Cardano.ExtraState
+                   @PeerTrustable
+                   @(Cardano.ExtraPeers PeerAddr)
+                   @(Cardano.ExtraPeerSelectionSetsWithSizes PeerAddr)
+                   @Cardano.ExtraTrace
+               . runGovernorInMockEnvironment
+               $ env
+
+        govLocalRootPeersSig :: Signal (LocalRootPeers PeerTrustable PeerAddr)
+        govLocalRootPeersSig =
+          selectGovState Governor.localRootPeers
+                         (Cardano.ExtraState.empty (consensusMode env) (NumberOfBigLedgerPeers 0)) Cardano.ExtraPeers.empty
+                         events
+
+        govUnreachablePeersSig :: Signal (Set PeerAddr)
+        govUnreachablePeersSig =
+          (\local ->
+             let
+               isUnreachablePeer (LocalRootConfig {localRootBehindFirewall}) = localRootBehindFirewall
+
+               unreachablePeers =
+                 Map.keysSet
+                   $ Map.filter isUnreachablePeer
+                   $ LocalRootPeers.toMap local
+             in
+               unreachablePeers
+          ) <$> govLocalRootPeersSig
+
+        newConnectionSig :: Signal (Maybe PeerAddr)
+        newConnectionSig =
+            Signal.fromEvents
+          . Signal.selectEvents
+              (\case TraceEnvNewConnCreated addr -> Just $! addr
+                     _other                       -> Nothing)
+          . selectEnvEvents
+          $ events
+
+     in counterexample
+          "\nSignal key: (local root peers, unreachable local root peers, new connection)" $
+
+        signalProperty 100 show
+          (\(_,unreachablePeers,newConnection) -> maybe True (not . flip Set.member unreachablePeers) newConnection)
+          ((,,) <$> govLocalRootPeersSig
+                <*> govUnreachablePeersSig
+                <*> newConnectionSig)
 
 -- | Like 'prop_governor_target_established_above' but for big ledger peers.
 --
@@ -3560,7 +3613,7 @@ prop_governor_target_established_local (MaxTime maxTime) env =
         promotionOpportunitiesIgnoredTooLong :: Signal (Set PeerAddr)
         promotionOpportunitiesIgnoredTooLong =
           Signal.keyedTimeout
-            1 -- seconds
+            2 -- seconds  -- cabal run cardano-diffusion:cardano-diffusion-sim-tests -- --quickcheck-replay="(SMGen 13722084053961804625 14989040016076027617,42)" -p '/local root peers/&&/progresses towards established target/'
             id
             promotionOpportunities
 
diff --git a/cardano-diffusion/tests/lib/Test/Cardano/Network/PeerSelection/MockEnvironment.hs b/cardano-diffusion/tests/lib/Test/Cardano/Network/PeerSelection/MockEnvironment.hs
@@ -48,7 +48,7 @@ import Data.IP (toIPv4w)
 
 import Control.Concurrent.Class.MonadSTM
 import Control.Concurrent.Class.MonadSTM.Strict qualified as StrictTVar
-import Control.Exception (throw)
+import Control.Exception (throw, ErrorCall (..))
 import Control.Monad (forM, when)
 import Control.Monad.Class.MonadAsync
 import Control.Monad.Class.MonadFork
@@ -62,6 +62,7 @@ import Control.Monad.IOSim
 import Control.Tracer (Tracer (..), contramap, traceWith)
 
 import Ouroboros.Network.BlockFetch (FetchMode (..), PraosFetchMode (..))
+import Ouroboros.Network.ConnectionManager.Types (ConnectionMode (..))
 import Ouroboros.Network.DiffusionMode
 import Ouroboros.Network.ExitPolicy
 import Ouroboros.Network.PeerSelection hiding (requestPublicRootPeers)
@@ -330,6 +331,7 @@ data TraceMockEnv = TraceEnvAddPeers       !PeerGraph
                   | TraceEnvSetTargets     !PeerSelectionTargets
                   | TraceEnvPeersDemote    !AsyncDemotion !PeerAddr
                   | TraceEnvEstablishConn  !PeerAddr
+                  | TraceEnvNewConnCreated !PeerAddr
                   | TraceEnvActivatePeer   !PeerAddr
                   | TraceEnvDeactivatePeer !PeerAddr
                   | TraceEnvCloseConn      !PeerAddr
@@ -549,20 +551,34 @@ mockPeerSelectionActions' tracer
           threadDelay (interpretPeerShareTime time)
           traceWith tracer (TraceEnvPeerShareResult addr peeraddrs)
           return (PeerSharingResult peeraddrs)
-
-    establishPeerConnection :: IsBigLedgerPeer -> DiffusionMode -> PeerAddr -> m (PeerConn m)
-    establishPeerConnection _ _ peeraddr = do
+    establishPeerConnection :: IsBigLedgerPeer -> DiffusionMode -> PeerAddr -> ConnectionMode -> m (PeerConn m)
+    establishPeerConnection _ _ peeraddr connMode = do
       --TODO: add support for variable delays and synchronous failure
       traceWith tracer (TraceEnvEstablishConn peeraddr)
       threadDelay 1
       let Just (_, peerSharingScript, connectScript) = Map.lookup peeraddr scripts
-      conn@(PeerConn _ _ v) <- atomically $ do
-        conn  <- newTVar PeerWarm
+      (conn@(PeerConn _ _ v), newConnCreated) <- atomically $ do
         conns <- readTVar connsVar
-        let !conns' = Map.insert peeraddr conn conns
+        (conn, conns', newConnCreated) <- maybe
+          ( case connMode of
+              CreateNewIfNoInbound -> do
+                conn <- newTVar PeerWarm
+                pure (conn, conns, True)
+              RequireInbound -> do
+                throwSTM (ErrorCall "No inbound connection found.")
+          )
+          (\conn -> do
+              pure (conn, Map.insert peeraddr conn conns, False)
+          )
+          (Map.lookup peeraddr conns)
+
         writeTVar connsVar conns'
         remotePeerSharing <- stepScriptSTM peerSharingScript
-        return (PeerConn peeraddr (peerSharingFlag <> remotePeerSharing) conn)
+        return (PeerConn peeraddr (peerSharingFlag <> remotePeerSharing) conn, newConnCreated)
+
+      when newConnCreated $
+        traceWith tracer (TraceEnvNewConnCreated peeraddr)
+
       _ <- async $
         -- monitoring loop which does asynchronous demotions. It will terminate
         -- as soon as either of the events:
diff --git a/ouroboros-network/changelog.d/20251108_101451_edgr_behind_firewall.md b/ouroboros-network/changelog.d/20251108_101451_edgr_behind_firewall.md
@@ -0,0 +1,22 @@
+<!--
+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
+
+- Changed the type of `localRoots` to `LocalRoots`.
+- Modified `AcquireOutboundConnection` to include an additional parameter: `ConnectionMode`.
+- `acquireOutboundConnectionImpl` only creates a new connection if the `ConnectionMode` function permits it.
+- `jobPromoteColdPeer` only creates a new connection if no inbound connection is found and the peer is not behind a firewall.
+
+### Non-Breaking
+
+- Added `LocalRoots` type in `Ouroboros.Network.PeerSelection.State.LocalRootPeers` with the following fields:
+  - `rootConfig` of type `RootConfig`
+  - `behindFirewall` of type `Bool`
+- Added `localRootBehindFirewall` field to `LocalRootConfig`.
+- Added a new sum type: `ConnectionMode`.
+- Added a new constructor `InboundConnectionNotFound` for `ConnectionManagerError`.
diff --git a/ouroboros-network/demo/connection-manager.hs b/ouroboros-network/demo/connection-manager.hs
@@ -569,9 +569,9 @@ bidirectionalExperiment
                             (HandlerError
                               UnversionedProtocol))
     connect n cm | n <= 1 =
-      acquireOutboundConnection cm InitiatorAndResponderDiffusionMode remoteAddr
+      acquireOutboundConnection cm InitiatorAndResponderDiffusionMode remoteAddr CreateNewIfNoInbound
     connect n cm =
-      acquireOutboundConnection cm InitiatorAndResponderDiffusionMode remoteAddr
+      acquireOutboundConnection cm InitiatorAndResponderDiffusionMode remoteAddr CreateNewIfNoInbound
         `catch` \(_ :: IOException) -> threadDelay 1
                                     >> connect (pred n) cm
         `catch` \(_ :: Mux.Error)   -> threadDelay 1
diff --git a/ouroboros-network/framework/lib/Ouroboros/Network/ConnectionManager/Core.hs b/ouroboros-network/framework/lib/Ouroboros/Network/ConnectionManager/Core.hs
@@ -1338,8 +1338,9 @@ with args@Arguments {
         -> ConnectionHandlerFn handlerTrace socket peerAddr handle handleError version versionData m
         -> DiffusionMode
         -> peerAddr
+        -> ConnectionMode
         -> m (Connected peerAddr handle handleError)
-    acquireOutboundConnectionImpl stateVar stdGenVar handler diffusionMode peerAddr = do
+    acquireOutboundConnectionImpl stateVar stdGenVar handler diffusionMode peerAddr connectionMode = do
         let provenance = Outbound
         traceWith tracer (TrIncludeConnection provenance peerAddr)
         (trace, mutableConnState@MutableConnState { connVar, connStateId }
@@ -1486,6 +1487,10 @@ with args@Arguments {
 
           -- connection manager does not have a connection with @peerAddr@.
           Right Nowhere -> do
+            -- Only proceed if creating a new connection is allowed
+            when (inboundRequired connectionMode)  $
+              throwIO (withCallStack $ InboundConnectionNotFound peerAddr)
+
             (reader, writer) <- newEmptyPromiseIO
 
             (connId, connThread) <-
diff --git a/ouroboros-network/framework/lib/Ouroboros/Network/ConnectionManager/Types.hs b/ouroboros-network/framework/lib/Ouroboros/Network/ConnectionManager/Types.hs
@@ -114,6 +114,8 @@ module Ouroboros.Network.ConnectionManager.Types
   , resultInState
   , DemotedToColdRemoteTr (..)
   , AcquireOutboundConnection
+  , ConnectionMode (..)
+  , inboundRequired
   , IncludeInboundConnection
     -- *** Outbound side
   , acquireOutboundConnection
@@ -497,9 +499,23 @@ data Connected peerAddr handle handleError =
     --
   | Disconnected !(ConnectionId peerAddr) !(DisconnectionException handleError)
 
+-- | Describes the behavior for handling connections when no inbound connection
+-- is found.
+--  - 'CreateNewIfNoInbound': If no inbound connection exists, create a new
+-- conection.
+--  - 'RequireInbound': Strictly require an inbound connection; fail if none
+-- exists.
+data ConnectionMode
+    = CreateNewIfNoInbound
+    | RequireInbound
+
+inboundRequired :: ConnectionMode -> Bool
+inboundRequired RequireInbound = True
+inboundRequired _other         = False
 
 type AcquireOutboundConnection peerAddr handle handleError m
-    = DiffusionMode -> peerAddr -> m (Connected peerAddr handle handleError)
+    = DiffusionMode -> peerAddr -> ConnectionMode -> m (Connected peerAddr handle handleError)
+
 type IncludeInboundConnection socket peerAddr handle handleError m
     = Word32
     -- ^ inbound connections hard limit.
@@ -723,6 +739,11 @@ data ConnectionManagerError peerAddr
     --
     | ForbiddenConnection   !(ConnectionId peerAddr) !CallStack
 
+    -- | No matching inbound connection found and creating new connection is
+    -- not allowed.
+    --
+    | InboundConnectionNotFound !peerAddr !CallStack
+
     -- | Connections that would be forbidden by the kernel (@TCP@ semantics).
     --
     | ImpossibleConnection  !(ConnectionId peerAddr) !CallStack
@@ -774,6 +795,12 @@ instance ( Show peerAddr
              , "\n"
              , prettyCallStack cs
              ]
+    displayException (InboundConnectionNotFound peerAddr cs) =
+      concat [ "No matching inbound connection found and creating new connection is not allowed with peer "
+             , show peerAddr
+             , "\n"
+             , prettyCallStack cs
+             ]
     displayException (ConnectionTerminating connId cs) =
       concat [ "Connection terminating "
              , show connId
diff --git a/ouroboros-network/framework/sim-tests/Test/Ouroboros/Network/ConnectionManager.hs b/ouroboros-network/framework/sim-tests/Test/Ouroboros/Network/ConnectionManager.hs
@@ -817,7 +817,7 @@ prop_valid_transitions (Fixed rnd) (SkewedBool bindToLocalAddress) scheduleMap =
                                 -- handshake negotiation.
                                 timeout (1 + 5 + testTimeWaitTimeout)
                                   (acquireOutboundConnection
-                                    connectionManager InitiatorAndResponderDiffusionMode addr))
+                                    connectionManager InitiatorAndResponderDiffusionMode addr CreateNewIfNoInbound))
                             `catches`
                               [ Handler $ \(e :: IOException) -> return (Left (toException e))
                               , Handler $ \(e :: SomeConnectionManagerError) ->
@@ -983,10 +983,11 @@ prop_valid_transitions (Fixed rnd) (SkewedBool bindToLocalAddress) scheduleMap =
         Just (SomeConnectionManagerError e@UnknownPeer {})          -> throwIO e
 
         -- If 'ForbiddenConnection' is thrown we let the test continue.
-        Just (SomeConnectionManagerError ForbiddenConnection {})    -> pure ()
-        Just (SomeConnectionManagerError ConnectionExists {})       -> pure ()
-        Just (SomeConnectionManagerError ConnectionTerminating {})  -> pure ()
-        Just (SomeConnectionManagerError ConnectionTerminated {})   -> pure ()
+        Just (SomeConnectionManagerError ForbiddenConnection {})       -> pure ()
+        Just (SomeConnectionManagerError ConnectionExists {})          -> pure ()
+        Just (SomeConnectionManagerError ConnectionTerminating {})     -> pure ()
+        Just (SomeConnectionManagerError ConnectionTerminated {})      -> pure ()
+        Just (SomeConnectionManagerError InboundConnectionNotFound {}) -> pure ()
 
 
 -- | This includes the @Overwritten@ transition.
diff --git a/ouroboros-network/framework/sim-tests/Test/Ouroboros/Network/Server/Sim.hs b/ouroboros-network/framework/sim-tests/Test/Ouroboros/Network/Server/Sim.hs
@@ -879,7 +879,7 @@ multinodeExperiment inboundTrTracer trTracer inboundTracer debugTracer cmTracer
                                        case fromException e of
                                          Just SomeAsyncException {} -> Nothing
                                          _                          -> Just e)
-                          $ acquireOutboundConnection cm InitiatorAndResponderDiffusionMode remoteAddr
+                          $ acquireOutboundConnection cm InitiatorAndResponderDiffusionMode remoteAddr CreateNewIfNoInbound
             case connHandle of
               Left _ ->
                 go connMap
diff --git a/ouroboros-network/framework/tests-lib/Test/Ouroboros/Network/ConnectionManager/Experiments.hs b/ouroboros-network/framework/tests-lib/Test/Ouroboros/Network/ConnectionManager/Experiments.hs
@@ -770,7 +770,7 @@ unidirectionalExperiment stdGen timeouts snocket makeBearer confSock socket clie
                 replicateM
                   (numberOfRounds clientAndServerData)
                   (bracket
-                     (acquireOutboundConnection connectionManager InitiatorOnlyDiffusionMode serverAddr)
+                     (acquireOutboundConnection connectionManager InitiatorOnlyDiffusionMode serverAddr CreateNewIfNoInbound)
                      (\case
                         Connected connId _ _ -> releaseOutboundConnection connectionManager connId
                         Disconnected {} -> error "unidirectionalExperiment: impossible happened")
@@ -876,7 +876,8 @@ bidirectionalExperiment
                       (acquireOutboundConnection
                         connectionManager0
                         InitiatorAndResponderDiffusionMode
-                        localAddr1))
+                        localAddr1
+                        CreateNewIfNoInbound))
                     (\case
                       Connected connId _ _ ->
                         releaseOutboundConnection
@@ -902,7 +903,8 @@ bidirectionalExperiment
                       (acquireOutboundConnection
                         connectionManager1
                         InitiatorAndResponderDiffusionMode
-                        localAddr0))
+                        localAddr0
+                        CreateNewIfNoInbound))
                     (\case
                       Connected connId _ _ ->
                         releaseOutboundConnection
diff --git a/ouroboros-network/lib/Ouroboros/Network/PeerSelection/Governor/EstablishedPeers.hs b/ouroboros-network/lib/Ouroboros/Network/PeerSelection/Governor/EstablishedPeers.hs
diff --git a/ouroboros-network/lib/Ouroboros/Network/PeerSelection/Governor/Types.hs b/ouroboros-network/lib/Ouroboros/Network/PeerSelection/Governor/Types.hs
diff --git a/ouroboros-network/lib/Ouroboros/Network/PeerSelection/PeerStateActions.hs b/ouroboros-network/lib/Ouroboros/Network/PeerSelection/PeerStateActions.hs
