Behind the firewall peers

ouroboros-network/cardano-diffusion/Cardano/Network/Diffusion/Topology.hs

@@ -30,5 +30,6 @@ isValidTrustedPeerConfiguration
               IsTrustable    -> not
                               . null
                               . rootAccessPoints
+                              . rootConfig
                               $ localRoots
           ) lprgs

ouroboros-network/changelog.d/20251001_150554_edgr_follow_back_peers.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
+
+- A bullet item for the Breaking category.
+
+-->
+### Non-Breaking
+
+- Support for marking local root peers as behind a firewall (#4381).
+

ouroboros-network/orphan-instances/Ouroboros/Network/OrphanInstances.hs

@@ -61,7 +61,7 @@ import Ouroboros.Network.DeltaQ (GSV (GSV),
            PeerGSV (PeerGSV, inboundGSV, outboundGSV))
 import Ouroboros.Network.Diffusion.Topology (LocalRootPeersGroup (..),
            LocalRootPeersGroups (..), NetworkTopology (..),
-           PublicRootPeers (..), RootConfig (..))
+           PublicRootPeers (..), LocalRoots (..), RootConfig (..))
 import Ouroboros.Network.Diffusion.Types (DiffusionTracer (..))
 import Ouroboros.Network.Driver.Simple
 import Ouroboros.Network.ExitPolicy (RepromoteDelay (repromoteDelay))
@@ -97,6 +97,21 @@ kindObject k fields = object $ ("kind" .= String k) : fields
 
 -- FromJSON Instances
 
+instance FromJSON LocalRoots where
+  parseJSON = withObject "LocalRoots" $ \o ->
+                LocalRoots
+                  <$> (RootConfig
+                        <$> o .:  "accessPoints"
+                        <*> o .:? "advertise" .!= DoNotAdvertisePeer)
+                  <*> o .:? "behindFirewall" .!= False
+
+instance ToJSON LocalRoots where
+  toJSON ra =
+    object
+      [ "rootConfig"     .= rootConfig ra
+      , "behindFirewall" .= behindFirewall ra
+      ]
+
 instance FromJSON RootConfig where
   parseJSON = withObject "RootConfig" $ \o ->
                 RootConfig
@@ -144,8 +159,8 @@ localRootPeersGroupToJSON :: (extraFlags -> Maybe (Key, Value))
                           -> Value
 localRootPeersGroupToJSON extraFlagsToJSON lrpg =
     Object $
-         ("accessPoints"  .?= rootAccessPoints (localRoots lrpg))
-      <> ("advertise"     .?= rootAdvertise (localRoots lrpg))
+         ("accessPoints"  .?= rootAccessPoints (rootConfig . localRoots $ lrpg))
+      <> ("advertise"     .?= rootAdvertise (rootConfig . localRoots  $ lrpg))
       <> ("hotValency"    .?= hotValency lrpg)
       <> ("warmValency"   .?= warmValency lrpg)
       <> (case mv of

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

@@ -34,7 +34,7 @@ newtype LocalRootPeersGroups extraFlags = LocalRootPeersGroups
 -- will attempt to maintain. By default this value will be equal to 'hotValency'.
 --
 data LocalRootPeersGroup extraFlags = LocalRootPeersGroup
-  { localRoots        :: RootConfig
+  { localRoots        :: LocalRoots
   , hotValency        :: HotValency
   , warmValency       :: WarmValency
   , rootDiffusionMode :: DiffusionMode
@@ -46,6 +46,12 @@ newtype PublicRootPeers = PublicRootPeers
   { publicRoots :: RootConfig
   } deriving (Eq, Show)
 
+data LocalRoots = LocalRoots
+  { rootConfig     :: RootConfig
+  , behindFirewall :: Bool
+    -- ^ peer is unreachable and will initiate the connection first
+  } deriving (Eq, Show)
+
 -- | Each root peer consists of a list of access points and a shared
 -- 'PeerAdvertise' field.
 --
@@ -65,9 +71,16 @@ data RootConfig = RootConfig
 rootConfigToRelayAccessPoint
   :: RootConfig
   -> [(RelayAccessPoint, PeerAdvertise)]
-rootConfigToRelayAccessPoint RootConfig { rootAccessPoints, rootAdvertise  } =
+rootConfigToRelayAccessPoint RootConfig { rootAccessPoints, rootAdvertise } =
     [ (ap, rootAdvertise) | ap <- rootAccessPoints ]
 
+localRootsToRelayAccessPoint
+  :: LocalRoots
+  -> [(RelayAccessPoint, PeerAdvertise, Bool)]
+localRootsToRelayAccessPoint LocalRoots {rootConfig, behindFirewall} =
+      (\(accessPoint, advertise) -> (accessPoint, advertise, behindFirewall))
+  <$> rootConfigToRelayAccessPoint rootConfig
+
 producerAddresses
   :: NetworkTopology extraConfig extraFlags
   -> ( [(HotValency, WarmValency, Map RelayAccessPoint (LocalRootConfig extraFlags))]
@@ -80,16 +93,17 @@ producerAddresses NetworkTopology { localRootPeersGroups
   ( map (\lrp -> ( hotValency lrp
                  , warmValency lrp
                  , Map.fromList
-                 . map (\(addr, peerAdvertise) ->
+                 . map (\(addr, peerAdvertise, behindFirewall) ->
                          ( addr
                          , LocalRootConfig {
                              diffusionMode = rootDiffusionMode lrp,
                              peerAdvertise,
+                             behindFirewall,
                              LRP.extraFlags = extraFlags lrp
                            }
                          )
                        )
-                 . rootConfigToRelayAccessPoint
+                 . localRootsToRelayAccessPoint
                  $ localRoots lrp
                  )
         )

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

@@ -708,7 +708,7 @@ peerSelectionGovernorLoop tracer
                                  actions blockedAt inboundPeers policy st
       <> KnownPeers.aboveTarget  actions                        policy st
 
-      <> EstablishedPeers.belowTarget enableProgressMakingActions
+      <> EstablishedPeers.belowTarget enableProgressMakingActions inboundPeers
                                       actions policy st
       <> EstablishedPeers.aboveTarget actions policy st
 

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

@@ -31,7 +31,8 @@ import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing (..))
 import Ouroboros.Network.PeerSelection.PublicRootPeers qualified as PublicRootPeers
 import Ouroboros.Network.PeerSelection.State.EstablishedPeers qualified as EstablishedPeers
 import Ouroboros.Network.PeerSelection.State.KnownPeers qualified as KnownPeers
-import Ouroboros.Network.PeerSelection.State.LocalRootPeers (WarmValency (..))
+import Ouroboros.Network.PeerSelection.State.LocalRootPeers (WarmValency (..),
+           LocalRootConfig (LocalRootConfig, behindFirewall))
 import Ouroboros.Network.PeerSelection.State.LocalRootPeers qualified as LocalRootPeers
 import Ouroboros.Network.PeerSelection.Types (PeerStatus (..),
            PublicExtraPeersAPI (..))
@@ -74,6 +75,8 @@ belowTarget
   -- This might be useful if the user requires its diffusion layer to
   -- stop making progress during a sensitive/vulnerable situation and
   -- quarantine it and make sure it is only connected to trusted peers.
+  -> Map peeraddr PeerSharing
+  -- ^ Inbound peers that have negotiated a duplex connection
   -> PeerSelectionActions
       extraState
       extraFlags
@@ -91,10 +94,10 @@ belowTarget
       peeraddr
       peerconn
       m
-belowTarget enableAction =
+belowTarget enableAction inboundPeers =
      belowTargetBigLedgerPeers enableAction
-  <> belowTargetLocal
-  <> belowTargetOther
+  <> belowTargetLocal inboundPeers
+  <> belowTargetOther inboundPeers
 
 
 -- | For locally configured root peers we have the explicit target that comes from local
@@ -107,7 +110,9 @@ belowTargetLocal
      , Ord peeraddr
      , HasCallStack
      )
-  => PeerSelectionActions
+  => Map peeraddr PeerSharing
+  -- ^ Inbound peers that have negotiated a duplex connection
+  -> PeerSelectionActions
       extraState
       extraFlags
       extraPeers extraAPI extraCounters peeraddr peerconn m
@@ -119,7 +124,8 @@ belowTargetLocal
       peeraddr
       peerconn
       m
-belowTargetLocal actions@PeerSelectionActions {
+belowTargetLocal inboundPeers
+                 actions@PeerSelectionActions {
                    extraPeersAPI = PublicExtraPeersAPI {
                      memberExtraPeers,
                      extraPeersToSet
@@ -149,6 +155,7 @@ belowTargetLocal actions@PeerSelectionActions {
           [ (numMembersToPromote, membersAvailableToPromote)
           | let availableToPromote =
                   localAvailableToConnect
+                     Set.\\ unreachablePeers
                      Set.\\ localEstablishedPeers
                      Set.\\ localConnectInProgress
                      Set.\\ inProgressDemoteToCold
@@ -194,6 +201,7 @@ belowTargetLocal actions@PeerSelectionActions {
   , let potentialToPromote =
           -- These are local peers that are cold but not ready.
           localRootPeersSet
+             Set.\\ unreachablePeers
              Set.\\ localEstablishedPeers
              Set.\\ KnownPeers.availableToConnect knownPeers
   , not (Set.null potentialToPromote)
@@ -202,6 +210,14 @@ belowTargetLocal actions@PeerSelectionActions {
   | otherwise
   = GuardedSkip Nothing
   where
+    isUnreachablePeer addr (LocalRootConfig {behindFirewall}) =
+      behindFirewall && not (Map.member addr inboundPeers)
+
+    unreachablePeers =
+      Map.keysSet
+        $ Map.filterWithKey isUnreachablePeer
+        $ LocalRootPeers.toMap localRootPeers
+
     groupsBelowTarget =
       [ (warmValency, members, membersEstablished)
       | (_, warmValency, members) <- LocalRootPeers.toGroupSets localRootPeers
@@ -225,7 +241,9 @@ belowTargetOther
      , Ord peeraddr
      , HasCallStack
      )
-  => PeerSelectionActions
+  => Map peeraddr PeerSharing
+  -- ^ Inbound peers that have negotiated a duplex connection
+  -> PeerSelectionActions
       extraState
       extraFlags
       extraPeers
@@ -242,7 +260,7 @@ belowTargetOther
       peeraddr
       peerconn
       m
-belowTargetOther actions@PeerSelectionActions {
+belowTargetOther inboundPeers actions@PeerSelectionActions {
                    extraPeersAPI = PublicExtraPeersAPI {
                      memberExtraPeers,
                      extraPeersToSet
@@ -253,6 +271,7 @@ belowTargetOther actions@PeerSelectionActions {
                    policyPickColdPeersToPromote
                  }
                  st@PeerSelectionState {
+                   localRootPeers,
                    knownPeers,
                    establishedPeers,
                    inProgressPromoteCold,
@@ -268,7 +287,7 @@ belowTargetOther actions@PeerSelectionActions {
     -- not cold and our invariant is that they are always in the connect set.
     -- We can also subtract the in progress ones since they are also already
     -- in the connect set and we cannot pick them again.
-  , numAvailableToConnect - numEstablishedPeers - numConnectInProgress > 0
+  , numAvailableToConnect - numUnreachablePeers - numEstablishedPeers - numConnectInProgress > 0
   = Guarded Nothing $ do
       -- The availableToPromote here is non-empty due to the second guard.
       -- The known peers map restricted to the connect set is the same size as
@@ -280,11 +299,13 @@ belowTargetOther actions@PeerSelectionActions {
       --
       let availableToPromote :: Set peeraddr
           availableToPromote = availableToConnect
+                                 Set.\\ unreachablePeers
                                  Set.\\ EstablishedPeers.toSet establishedPeers
                                  Set.\\ inProgressPromoteCold
           numPeersToPromote  = targetNumberOfEstablishedPeers
                              - numEstablishedPeers
                              - numConnectInProgress
+
       selectedToPromote <- pickPeers memberExtraPeers st
                              policyPickColdPeersToPromote
                              availableToPromote
@@ -310,6 +331,16 @@ belowTargetOther actions@PeerSelectionActions {
   | otherwise
   = GuardedSkip Nothing
   where
+    numUnreachablePeers = Set.size unreachablePeers
+
+    isUnreachablePeer addr (LocalRootConfig {behindFirewall}) =
+      behindFirewall && not (Map.member addr inboundPeers)
+
+    unreachablePeers =
+      Map.keysSet
+        $ Map.filterWithKey isUnreachablePeer
+        $ LocalRootPeers.toMap localRootPeers
+
     PeerSelectionView {
         viewKnownBigLedgerPeers     = (bigLedgerPeersSet, _),
 

ouroboros-network/src/Ouroboros/Network/PeerSelection/State/KnownPeers.hs

@@ -79,6 +79,9 @@ data KnownPeers peeraddr = KnownPeers {
        -- establish a connection to now. This is because we have not connected
        -- with them before or because any failure backoff time has expired.
        --
+       -- Note: Some peers may be behind a firewall. Local root peers marked as
+       -- behind a firewall are not excluded from this list.
+       --
        availableToConnect :: !(Set peeraddr),
 
        -- | The subset of known peers that we cannot connect to for the moment.

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

@@ -48,9 +48,10 @@ import Ouroboros.Network.PeerSelection.PeerAdvertise (PeerAdvertise)
 --
 
 data LocalRootConfig extraFlags = LocalRootConfig {
-    peerAdvertise :: !PeerAdvertise,
-    diffusionMode :: !DiffusionMode,
-    extraFlags    :: !extraFlags
+    peerAdvertise  :: !PeerAdvertise,
+    diffusionMode  :: !DiffusionMode,
+    behindFirewall :: !Bool,
+    extraFlags     :: !extraFlags
   }
   deriving (Show, Eq)