GSM: use diffusion layer info for HAA

IntersectMBO · Apr 29, 2024 · c133df7 · c133df7
1 parent f25ea0b
commit c133df7
Show file tree

Hide file tree

Showing 3 changed files with 28 additions and 4 deletions.
diff --git a/...s-consensus-diffusion/changelog.d/20240429_143457_alexander.esgen_gsm_remote.md b/...s-consensus-diffusion/changelog.d/20240429_143457_alexander.esgen_gsm_remote.md
@@ -0,0 +1,5 @@
+### Non-Breaking
+
+- Implemented the Honest Availability Assumption properly (both for
+  Praos/"Genesis Lite" and Genesis) based on newly exposed state by the
+  diffusion layer.
diff --git a/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node.hs b/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node.hs
@@ -60,6 +60,7 @@ import qualified Codec.CBOR.Encoding as CBOR
 import           Codec.Serialise (DeserialiseFailure)
 import qualified Control.Concurrent.Class.MonadSTM.Strict as StrictSTM
 import           Control.DeepSeq (NFData)
+import           Control.Monad (when)
 import           Control.Monad.Class.MonadTime.SI (MonadTime)
 import           Control.Monad.Class.MonadTimer.SI (MonadTimer)
 import           Control.Tracer (Tracer, contramap, traceWith)
@@ -626,7 +627,11 @@ runWith RunNodeArgs{..} encAddrNtN decAddrNtN LowLevelRunNodeArgs{..} =
                   lpGetLatestSlot = getImmTipSlot kernel,
                   lpGetLedgerPeers = fromMaybe [] <$> getPeersFromCurrentLedger kernel (const True),
                   lpGetLedgerStateJudgement = getLedgerStateJudgement kernel
-                }
+                },
+            Diffusion.daUpdateOutboundConnectionsState =
+              let varOcs = getOutboundConnectionsState kernel in \newOcs -> do
+                oldOcs <- readTVar varOcs
+                when (newOcs /= oldOcs) $ writeTVar varOcs newOcs
           }
 
         localRethrowPolicy :: RethrowPolicy

diff --git a/...s-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/NodeKernel.hs b/...s-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/NodeKernel.hs
@@ -94,6 +94,8 @@ import           Ouroboros.Network.NodeToNode (ConnectionId,
 import           Ouroboros.Network.PeerSelection.Bootstrap (UseBootstrapPeers)
 import           Ouroboros.Network.PeerSelection.LedgerPeers.Type
                      (LedgerStateJudgement (..))
+import           Ouroboros.Network.PeerSelection.LocalRootPeers
+                     (OutboundConnectionsState (..))
 import           Ouroboros.Network.PeerSharing (PeerSharingAPI,
                      PeerSharingRegistry, newPeerSharingAPI,
                      newPeerSharingRegistry, ps_POLICY_PEER_SHARE_MAX_PEERS,
@@ -149,6 +151,11 @@ data NodeKernel m addrNTN addrNTC blk = NodeKernel {
     , setBlockForging        :: [BlockForging m blk] -> m ()
 
     , getPeerSharingAPI      :: PeerSharingAPI addrNTN StdGen m
+
+      -- | Whether we are or will ever be connected to remote/external
+      -- (bootstrap) peers.
+    , getOutboundConnectionsState
+                             :: StrictTVar m OutboundConnectionsState
     }
 
 -- | Arguments required when initializing a node
@@ -204,6 +211,8 @@ initNodeKernel args@NodeKernelArgs { registry, cfg, tracers
           , varLedgerJudgement
           } = st
 
+    varPeerConnectivity <- newTVarIO UntrustedState
+
     do  let GsmNodeKernelArgs {..} = gsmArgs
             gsmTracerArgs          =
               ( castTip . either AF.anchorToTip tipFromHeader . AF.head . fst
@@ -239,9 +248,12 @@ initNodeKernel args@NodeKernelArgs { registry, cfg, tracers
                     gsmMarkerFileView
               , GSM.writeGsmState = \x -> atomically $ do
                   writeTVar varLedgerJudgement $ GSM.gsmStateToLedgerJudgement x
-              , -- In the context of bootstrap peers, it is fine to always
-                -- return 'True' as all peers are trusted during syncing.
-                GSM.isHaaSatisfied            = pure True
+              , GSM.isHaaSatisfied            = do
+                  readTVar varPeerConnectivity <&> \case
+                    -- See the upstream Haddocks for when the diffusion layer is
+                    -- in this state.
+                    TrustedStateWithExternalPeers -> True
+                    UntrustedState                -> False
               }
         judgment <- readTVarIO varLedgerJudgement
         void $ forkLinkedThread registry "NodeKernel.GSM" $ case judgment of
@@ -278,6 +290,8 @@ initNodeKernel args@NodeKernelArgs { registry, cfg, tracers
       , getTracers              = tracers
       , setBlockForging         = \a -> atomically . LazySTM.putTMVar blockForgingVar $! a
       , getPeerSharingAPI       = peerSharingAPI
+      , getOutboundConnectionsState
+                                = varPeerConnectivity
       }
   where
     blockForgingController :: InternalState m remotePeer localPeer blk