Behind the firewall peers

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

@@ -102,6 +102,7 @@ instance FromJSON RootConfig where
                 RootConfig
                   <$> o .:  "accessPoints"
                   <*> o .:? "advertise" .!= DoNotAdvertisePeer
+                  <*> o .:  "behindFirewall"
 
 instance ToJSON RootConfig where
   toJSON ra = object

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

@@ -56,6 +56,8 @@ data RootConfig = RootConfig
   , rootAdvertise    :: PeerAdvertise
     -- ^ 'advertise' configures whether the root should be advertised through
     -- peer sharing.
+  , behindFirewall   :: Bool
+    -- ^ peer is unreachable and will initiate the connection first
   } deriving (Eq, Show)
 
 
@@ -64,9 +66,9 @@ data RootConfig = RootConfig
 --
 rootConfigToRelayAccessPoint
   :: RootConfig
-  -> [(RelayAccessPoint, PeerAdvertise)]
-rootConfigToRelayAccessPoint RootConfig { rootAccessPoints, rootAdvertise  } =
-    [ (ap, rootAdvertise) | ap <- rootAccessPoints ]
+  -> [(RelayAccessPoint, PeerAdvertise, Bool)]
+rootConfigToRelayAccessPoint RootConfig { rootAccessPoints, rootAdvertise, behindFirewall } =
+    [ (ap, rootAdvertise, behindFirewall) | ap <- rootAccessPoints ]
 
 producerAddresses
   :: NetworkTopology extraConfig extraFlags
@@ -80,11 +82,12 @@ 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
                            }
                          )
@@ -95,6 +98,7 @@ producerAddresses NetworkTopology { localRootPeersGroups
         )
         (groups localRootPeersGroups)
   , foldMap ( Map.fromList
+            . fmap (\(a, b, _) -> (a, b))
             . rootConfigToRelayAccessPoint
             . publicRoots
             ) publicRootPeers

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)