connection-manager: updated ouroboros-consensus

ouroboros-consensus-cardano/src/Ouroboros/Consensus/Cardano/Node.hs

@@ -320,6 +320,8 @@ instance CardanoHardForkConstraints c
       , (NodeToNodeV_3, CardanoNodeToNodeVersion2)
       , (NodeToNodeV_4, CardanoNodeToNodeVersion3)
       , (NodeToNodeV_5, CardanoNodeToNodeVersion4)
+      , (NodeToNodeV_6, CardanoNodeToNodeVersion4)
+      , (NodeToNodeV_7, CardanoNodeToNodeVersion4)
       ]
 
   supportedNodeToClientVersions _ = Map.fromList $

ouroboros-consensus/ouroboros-consensus.cabal

@@ -131,7 +131,7 @@ library
                        Ouroboros.Consensus.Node
                        Ouroboros.Consensus.Node.DbLock
                        Ouroboros.Consensus.Node.DbMarker
-                       Ouroboros.Consensus.Node.ErrorPolicy
+                       Ouroboros.Consensus.Node.RethrowPolicy
                        Ouroboros.Consensus.Node.Exit
                        Ouroboros.Consensus.NodeId
                        Ouroboros.Consensus.NodeKernel

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

@@ -27,7 +27,7 @@ module Ouroboros.Consensus.Network.NodeToNode (
   , mkApps
     -- ** Projections
   , initiator
-  , responder
+  , initiatorAndResponder
     -- * Re-exports
   , ChainSyncTimeout (..)
   ) where
@@ -654,7 +654,7 @@ initiator
   :: MiniProtocolParameters
   -> NodeToNodeVersion
   -> Apps m (ConnectionId peer) b b b b b a
-  -> OuroborosApplication 'InitiatorMode peer b m a Void
+  -> OuroborosBundle 'InitiatorMode peer b m a Void
 initiator miniProtocolParameters version Apps {..} =
     nodeToNodeProtocols
       miniProtocolParameters
@@ -678,28 +678,41 @@ initiator miniProtocolParameters version Apps {..} =
         })
       version
 
--- | A projection from 'NetworkApplication' to a server-side
--- 'OuroborosApplication' for the node-to-node protocols.
+-- | A bi-directional network applicaiton.
 --
--- See 'initiatorNetworkApplication' for rationale for the @_version@ arg.
-responder
+-- Implementation note: network currently doesn't enable protocols conditional
+-- on the protocol version, but it eventually may; this is why @_version@ is
+-- currently unused.
+initiatorAndResponder
   :: MiniProtocolParameters
   -> NodeToNodeVersion
   -> Apps m (ConnectionId peer) b b b b b a
-  -> OuroborosApplication 'ResponderMode peer b m Void a
-responder miniProtocolParameters version Apps {..} =
+  -> OuroborosBundle 'InitiatorResponderMode peer b m a a
+initiatorAndResponder miniProtocolParameters version Apps {..} =
     nodeToNodeProtocols
       miniProtocolParameters
-      (\them _controlMessageSTM -> NodeToNodeProtocols {
+      (\them controlMessageSTM -> NodeToNodeProtocols {
           chainSyncProtocol =
-            (ResponderProtocolOnly (MuxPeerRaw (aChainSyncServer version them))),
+            (InitiatorAndResponderProtocol
+              (MuxPeerRaw (aChainSyncClient version controlMessageSTM them))
+              (MuxPeerRaw (aChainSyncServer version                   them))),
           blockFetchProtocol =
-            (ResponderProtocolOnly (MuxPeerRaw (aBlockFetchServer version them))),
+            (InitiatorAndResponderProtocol
+              (MuxPeerRaw (aBlockFetchClient version controlMessageSTM them))
+              (MuxPeerRaw (aBlockFetchServer version                   them))),
           txSubmissionProtocol =
             if version >= NodeToNodeV_6
-              then ResponderProtocolOnly (MuxPeerRaw (aTxSubmission2Server version them))
-              else ResponderProtocolOnly (MuxPeerRaw (aTxSubmissionServer  version them)),
+              then
+                (InitiatorAndResponderProtocol
+                  (MuxPeerRaw (aTxSubmission2Client version controlMessageSTM them))
+                  (MuxPeerRaw (aTxSubmission2Server version                   them)))
+              else
+                (InitiatorAndResponderProtocol
+                  (MuxPeerRaw (aTxSubmissionClient version controlMessageSTM them))
+                  (MuxPeerRaw (aTxSubmissionServer version                   them))),
           keepAliveProtocol =
-            (ResponderProtocolOnly (MuxPeerRaw (aKeepAliveServer version them)))
+            (InitiatorAndResponderProtocol
+              (MuxPeerRaw (aKeepAliveClient version controlMessageSTM them))
+              (MuxPeerRaw (aKeepAliveServer version                   them)))
         })
       version

ouroboros-consensus/src/Ouroboros/Consensus/Node.hs

@@ -40,8 +40,6 @@ module Ouroboros.Consensus.Node
   , NodeKernel (..)
   , MaxTxCapacityOverride (..)
   , MempoolCapacityBytesOverride (..)
-  , IPSubscriptionTarget (..)
-  , DnsSubscriptionTarget (..)
   , ConnectionId (..)
   , ChainDB.RelativeMountPoint (..)
     -- * Internal helpers
@@ -59,6 +57,7 @@ import           Data.Hashable (Hashable)
 import           Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
 import           Data.Typeable (Typeable)
+import           Data.Void (Void)
 import           System.FilePath ((</>))
 import           System.Random (StdGen, newStdGen, randomIO, randomRIO)
 
@@ -88,11 +87,11 @@ import qualified Ouroboros.Consensus.Network.NodeToClient as NTC
 import qualified Ouroboros.Consensus.Network.NodeToNode as NTN
 import           Ouroboros.Consensus.Node.DbLock
 import           Ouroboros.Consensus.Node.DbMarker
-import           Ouroboros.Consensus.Node.ErrorPolicy
 import           Ouroboros.Consensus.Node.InitStorage
 import           Ouroboros.Consensus.Node.NetworkProtocolVersion
 import           Ouroboros.Consensus.Node.ProtocolInfo
 import           Ouroboros.Consensus.Node.Recovery
+import           Ouroboros.Consensus.Node.RethrowPolicy
 import           Ouroboros.Consensus.Node.Run
 import           Ouroboros.Consensus.Node.Tracers
 import           Ouroboros.Consensus.NodeKernel
@@ -183,7 +182,7 @@ data LowLevelRunNodeArgs m addrNTN addrNTC versionDataNTN versionDataNTC blk = L
              addrNTN        addrNTC
              versionDataNTN versionDataNTC
              m
-        -> m ()
+        -> m Void
 
     , llrnVersionDataNTC :: versionDataNTC
 
@@ -204,7 +203,7 @@ run :: forall blk.
      RunNode blk
   => RunNodeArgs IO RemoteAddress LocalAddress blk
   -> StdRunNodeArgs IO blk
-  -> IO ()
+  -> IO Void
 run args stdArgs = stdLowLevelRunNodeArgsIO args stdArgs >>= runWith args
 
 -- | Start a node.
@@ -220,7 +219,7 @@ runWith :: forall m addrNTN addrNTC versionDataNTN versionDataNTC blk.
      )
   => RunNodeArgs m addrNTN addrNTC blk
   -> LowLevelRunNodeArgs m addrNTN addrNTC versionDataNTN versionDataNTC blk
-  -> m ()
+  -> m Void
 runWith RunNodeArgs{..} LowLevelRunNodeArgs{..} =
 
     llrnWithCheckedDB $ \(LastShutDownWasClean lastShutDownWasClean) ->
@@ -296,7 +295,6 @@ runWith RunNodeArgs{..} LowLevelRunNodeArgs{..} =
                                     (miniProtocolParameters nodeKernelArgs)
                                     ntnApps
                                     ntcApps
-                                    nodeKernel
 
       llrnRunDataDiffusion registry diffusionApplications
   where
@@ -344,36 +342,36 @@ runWith RunNodeArgs{..} LowLevelRunNodeArgs{..} =
           -> NodeToClientVersion
           -> NTC.Apps m (ConnectionId addrNTC) ByteString ByteString ByteString ()
          )
-      -> NodeKernel m (ConnectionId addrNTN) (ConnectionId addrNTC) blk
       -> DiffusionApplications
            addrNTN addrNTC
            versionDataNTN versionDataNTC
            m
-    mkDiffusionApplications miniProtocolParams ntnApps ntcApps kernel =
+    mkDiffusionApplications miniProtocolParams ntnApps ntcApps =
       DiffusionApplications {
-          daResponderApplication = combineVersions [
-              simpleSingletonVersions
-                version
-                llrnVersionDataNTN
-                (NTN.responder miniProtocolParams version $ ntnApps blockVersion)
-            | (version, blockVersion) <- Map.toList llrnNodeToNodeVersions
-            ]
-        , daInitiatorApplication = combineVersions [
-              simpleSingletonVersions
-                version
-                llrnVersionDataNTN
-                (NTN.initiator miniProtocolParams version $ ntnApps blockVersion)
-            | (version, blockVersion) <- Map.toList llrnNodeToNodeVersions
-            ]
+          daApplicationInitiatorMode = combineVersions
+             [ simpleSingletonVersions
+                 version
+                 llrnVersionDataNTN
+                 (NTN.initiator miniProtocolParams version $ ntnApps blockVersion)
+             | (version, blockVersion) <- Map.toList llrnNodeToNodeVersions
+             ]
+        , daApplicationInitiatorResponderMode = combineVersions
+             [ simpleSingletonVersions
+                 version
+                 llrnVersionDataNTN
+                 (NTN.initiatorAndResponder miniProtocolParams version $ ntnApps blockVersion)
+             | (version, blockVersion) <- Map.toList llrnNodeToNodeVersions
+             ]
         , daLocalResponderApplication = combineVersions [
               simpleSingletonVersions
                 version
                 llrnVersionDataNTC
                 (NTC.responder version $ ntcApps blockVersion version)
             | (version, blockVersion) <- Map.toList llrnNodeToClientVersions
             ]
-        , daErrorPolicies = consensusErrorPolicy (Proxy @blk)
-        , daLedgerPeersCtx = LedgerPeersConsensusInterface (getPeersFromCurrentLedgerAfterSlot kernel)
+        , daMiniProtocolParameters = miniProtocolParams
+        , daRethrowPolicy = consensusRethrowPolicy (Proxy @blk)
+        , daLocalRethrowPolicy = mempty
         }
 
 -- | Did the ChainDB already have existing clean-shutdown marker on disk?
@@ -603,7 +601,7 @@ stdRunDataDiffusion ::
        RemoteAddress LocalAddress
        NodeToNodeVersionData NodeToClientVersionData
        IO
-  -> IO ()
+  -> IO Void
 stdRunDataDiffusion = runDataDiffusion
 
 -- | Arguments needed even from a standard non-testing invocation.