Store NodeToNodeVersion in NodeKernelPeerState components

Author: agustinmista

ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Network/NodeToNode.hs

@@ -869,6 +869,7 @@ mkApps kernel rng Tracers{..} mkCodecs ByteLimits{..} chainSyncTimeouts lopBucke
     channel = do
       labelThisThread "PerasCertDiffusionClient"
       bracketObjectDiffusionInbound
+        version
         (getPerasCertDiffusionHandles kernel)
         them
         $ \state -> do

ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/NodeKernel.hs

@@ -32,7 +32,7 @@ module Ouroboros.Consensus.NodeKernel
   , toConsensusMode
   ) where
 
-import Cardano.Base.FeatureFlags (CardanoFeatureFlag)
+import Cardano.Base.FeatureFlags (CardanoFeatureFlag (..))
 import Cardano.Network.ConsensusMode (ConsensusMode (..))
 import Cardano.Network.PeerSelection.Bootstrap (UseBootstrapPeers)
 import Cardano.Network.PeerSelection.LocalRootPeers

ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Genesis/Tests/DensityDisconnect.hs

@@ -192,6 +192,7 @@ prop_densityDisconnectStatic =
       { csCandidate = frag
       , csLatestSlot = SJust (AF.headSlot frag)
       , csIdling = False
+      , csNodeToNodeVersion = maxBound
       }
   gen = do
     gt <- genChains (QC.choose (1, 4))
@@ -431,6 +432,7 @@ evolveBranches EvolvingPeers{k, sgen, peers = initialPeers, fullTree} =
             { csCandidate = attachTimeUsingTestConfig csCandidate
             , csIdling = False
             , csLatestSlot = SJust (AF.headSlot csCandidate)
+            , csNodeToNodeVersion = maxBound
             }
       -- Run GDD.
       (loeFrag, suffixes) =

ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Genesis/Tests/LoE/CaughtUp.hs

@@ -142,16 +142,15 @@ run = withRegistry \registry -> do
 
     -- Then, send C.
     atomically $ modifyTVar (cschState hdl) $ \s ->
-      ChainSyncState
+      s
         { csCandidate = csCandidate s AF.:> attachSlotTime cfg (getHeader blkC)
         , csLatestSlot = pure $ NotOrigin $ blockSlot blkC
-        , csIdling = csIdling s
         }
     addBlk blkC
 
     -- Finally, roll back to the initial fragment and idle.
-    atomically $ modifyTVar (cschState hdl) $ \_s ->
-      ChainSyncState
+    atomically $ modifyTVar (cschState hdl) $ \s ->
+      s
         { csCandidate = initialFrag
         , csLatestSlot = pure $ AF.headSlot initialFrag
         , csIdling = True
@@ -169,7 +168,7 @@ run = withRegistry \registry -> do
 
     -- Finally, idle.
     atomically $ modifyTVar (cschState hdl) $ \s ->
-      ChainSyncState
+      s
         { csCandidate = csCandidate s
         , csLatestSlot = csLatestSlot s
         , csIdling = True
@@ -223,6 +222,7 @@ mkTestChainSyncClientHandle frag = do
         { csCandidate = frag
         , csIdling = False
         , csLatestSlot = pure $ AF.headSlot frag
+        , csNodeToNodeVersion = maxBound
         }
   varJumping <- newTVar $ Disengaged DisengagedDone
   varJumpInfo <- newTVar Nothing

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/ChainSync/Client.hs

@@ -385,6 +385,7 @@ bracketChainSyncClient
           { csCandidate = AF.Empty AF.AnchorGenesis
           , csLatestSlot = SNothing
           , csIdling = False
+          , csNodeToNodeVersion = version
           }
 
     withCSJCallbacks ::

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/ChainSync/Client/State.hs

@@ -37,6 +37,7 @@ import Ouroboros.Consensus.Ledger.SupportsProtocol
   ( LedgerSupportsProtocol
   )
 import Ouroboros.Consensus.Node.GsmState (GsmState)
+import Ouroboros.Consensus.Node.NetworkProtocolVersion (NodeToNodeVersion)
 import Ouroboros.Consensus.Util.IOLike
   ( IOLike
   , NoThunks (..)
@@ -74,6 +75,11 @@ data ChainSyncState blk = ChainSyncState
   -- processing it further, and the latest slot may refer to a header beyond
   -- the forecast horizon while the candidate fragment isn't extended yet, to
   -- signal to GDD that the density is known up to this slot.
+  , csNodeToNodeVersion :: !NodeToNodeVersion
+  -- ^ Negotiated version of the protocol with the peer.
+  --
+  -- This is used to determine later on whether other mini-protocols are
+  -- expected to run in parallel with this one.
   }
   deriving stock Generic
 

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/ObjectDiffusion/Inbound/State.hs

@@ -24,6 +24,7 @@ import GHC.Generics (Generic)
 import NoThunks.Class (NoThunks)
 import Ouroboros.Consensus.Block (BlockSupportsProtocol, HasHeader, Header)
 import Ouroboros.Consensus.MiniProtocol.Util.Idling (Idling (..))
+import Ouroboros.Consensus.Node.NetworkProtocolVersion (NodeToNodeVersion)
 import Ouroboros.Consensus.Util.IOLike
   ( IOLike (..)
   , MonadSTM (..)
@@ -39,7 +40,12 @@ import Ouroboros.Consensus.Util.IOLike
 -- NOTE: 'blk' is not needed for now, but we keep it for future use.
 data ObjectDiffusionInboundState blk = ObjectDiffusionInboundState
   { odisIdling :: !Bool
-  -- ^ Whether we have received all objects from a peer
+  -- ^ Whether the client is currently idling
+  , odisNodeToNodeVersion :: !NodeToNodeVersion
+  -- ^ Negotiated version of the protocol with the peer.
+  --
+  -- This is used to determine later on whether other mini-protocols are
+  -- expected to run in parallel with this one.
   }
   deriving stock Generic
 
@@ -49,8 +55,12 @@ deriving anyclass instance
   ) =>
   NoThunks (ObjectDiffusionInboundState blk)
 
-initObjectDiffusionInboundState :: ObjectDiffusionInboundState blk
-initObjectDiffusionInboundState = ObjectDiffusionInboundState{odisIdling = True}
+initObjectDiffusionInboundState :: NodeToNodeVersion -> ObjectDiffusionInboundState blk
+initObjectDiffusionInboundState version =
+  ObjectDiffusionInboundState
+    { odisIdling = True
+    , odisNodeToNodeVersion = version
+    }
 
 -- | An interface to an ObjectDiffusion inbound client that's used by other components.
 data ObjectDiffusionInboundHandle m blk = ObjectDiffusionInboundHandle
@@ -101,12 +111,13 @@ data ObjectDiffusionInboundStateView m = ObjectDiffusionInboundStateView
 bracketObjectDiffusionInbound ::
   forall m peer blk a.
   (IOLike m, HasHeader blk, NoThunks (Header blk)) =>
+  NodeToNodeVersion ->
   ObjectDiffusionInboundHandleCollection peer m blk ->
   peer ->
   (ObjectDiffusionInboundStateView m -> m a) ->
   m a
-bracketObjectDiffusionInbound handles peer body = do
-  odiState <- newTVarIO initObjectDiffusionInboundState
+bracketObjectDiffusionInbound version handles peer body = do
+  odiState <- newTVarIO (initObjectDiffusionInboundState version)
   bracket (acquireContext odiState) releaseContext body
  where
   acquireContext odiState = atomically $ do

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Util/Orphans.hs

@@ -31,6 +31,7 @@ import NoThunks.Class
   , OnlyCheckWhnfNamed (..)
   , allNoThunks
   )
+import Ouroboros.Consensus.Node.NetworkProtocolVersion (NodeToNodeVersion)
 import Ouroboros.Network.Util.ShowProxy
 import System.FS.API (SomeHasFS)
 import System.FS.API.Types (FsPath, Handle)
@@ -85,6 +86,8 @@ instance NoThunks a => NoThunks (MultiSet a) where
   showTypeOf _ = "MultiSet"
   wNoThunks ctxt = wNoThunks ctxt . MultiSet.toMap
 
+instance NoThunks NodeToNodeVersion
+
 {-------------------------------------------------------------------------------
   fs-api
 -------------------------------------------------------------------------------}