Integrate ouroboros-network (#1314)

# Description

Integrate `ouroboros-network` in preparation for `cardano-node-10.2.0`
release

See IntersectMBO/cardano-node#6040 for overall progress

cabal.project

@@ -16,7 +16,7 @@ index-state:
   -- Bump this if you need newer packages from Hackage
   , hackage.haskell.org 2024-12-10T16:20:07Z
   -- Bump this if you need newer packages from CHaP
-  , cardano-haskell-packages 2024-12-18T14:29:04Z
+  , cardano-haskell-packages 2025-01-04T13:50:25Z
 
 packages:
   ouroboros-consensus
@@ -47,13 +47,3 @@ if(os(windows))
 
 -- https://github.com/ulidtko/cabal-doctest/issues/85
 constraints: Cabal < 3.13
-
-source-repository-package
-  type: git
-  location: https://github.com/IntersectMBO/ouroboros-network
-  tag: bb0a7d0ff41e265a8ec47bc94377cb4d65e0b498
-  --sha256: sha256-P7m+nsjtogNQsdpXQnaH1kWxYibEWa0UC6iNGg0+bH4=
-  subdir:
-    ouroboros-network
-    ouroboros-network-api
-    ouroboros-network-protocols

ouroboros-consensus-cardano/changelog.d/js-versions.md

@@ -0,0 +1,7 @@
+### Breaking
+
+- Remove versions before `NodeToClientV_16` from the `supportedNodeToClientVersions`.
+
+### Non-Breaking
+
+- Depend on `network-mux` and use its types.

ouroboros-consensus-cardano/ouroboros-consensus-cardano.cabal

@@ -159,7 +159,7 @@ library
     nothunks,
     ouroboros-consensus ^>=0.21,
     ouroboros-consensus-protocol ^>=0.9,
-    ouroboros-network-api ^>=0.11,
+    ouroboros-network-api ^>=0.12,
     serialise ^>=0.2,
     small-steps,
     sop-core ^>=0.5,
@@ -549,6 +549,7 @@ library unstable-cardano-tools
     microlens,
     mtl,
     network,
+    network-mux,
     nothunks,
     ouroboros-consensus ^>=0.21,
     ouroboros-consensus-cardano,
@@ -557,7 +558,7 @@ library unstable-cardano-tools
     ouroboros-consensus-protocol ^>=0.9,
     ouroboros-network,
     ouroboros-network-api,
-    ouroboros-network-framework ^>=0.14,
+    ouroboros-network-framework ^>=0.15,
     ouroboros-network-protocols,
     resource-registry,
     serialise ^>=0.2,

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

@@ -519,14 +519,7 @@ instance CardanoHardForkConstraints c
       ]
 
   supportedNodeToClientVersions _ = Map.fromList $
-      [ (NodeToClientV_9 , CardanoNodeToClientVersion7)
-      , (NodeToClientV_10, CardanoNodeToClientVersion7)
-      , (NodeToClientV_11, CardanoNodeToClientVersion8)
-      , (NodeToClientV_12, CardanoNodeToClientVersion8)
-      , (NodeToClientV_13, CardanoNodeToClientVersion9)
-      , (NodeToClientV_14, CardanoNodeToClientVersion10)
-      , (NodeToClientV_15, CardanoNodeToClientVersion11)
-      , (NodeToClientV_16, CardanoNodeToClientVersion12)
+      [ (NodeToClientV_16, CardanoNodeToClientVersion12)
       , (NodeToClientV_17, CardanoNodeToClientVersion13)
       , (NodeToClientV_18, CardanoNodeToClientVersion14)
       , (NodeToClientV_19, CardanoNodeToClientVersion15)

ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/NetworkProtocolVersion.hs

@@ -59,14 +59,7 @@ instance SupportedNetworkProtocolVersion (ShelleyBlock proto era) where
       , (NodeToNodeV_14, ShelleyNodeToNodeVersion1)
       ]
   supportedNodeToClientVersions _ = Map.fromList [
-        (NodeToClientV_9,  ShelleyNodeToClientVersion5)
-      , (NodeToClientV_10, ShelleyNodeToClientVersion5)
-      , (NodeToClientV_11, ShelleyNodeToClientVersion5)
-      , (NodeToClientV_12, ShelleyNodeToClientVersion5)
-      , (NodeToClientV_13, ShelleyNodeToClientVersion5)
-      , (NodeToClientV_14, ShelleyNodeToClientVersion6)
-      , (NodeToClientV_15, ShelleyNodeToClientVersion7)
-      , (NodeToClientV_16, ShelleyNodeToClientVersion8)
+        (NodeToClientV_16, ShelleyNodeToClientVersion8)
       , (NodeToClientV_17, ShelleyNodeToClientVersion9)
       , (NodeToClientV_18, ShelleyNodeToClientVersion10)
       , (NodeToClientV_19, ShelleyNodeToClientVersion11)

ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/ImmDBServer/Diffusion.hs

@@ -11,6 +11,7 @@ import           Control.Tracer
 import qualified Data.ByteString.Lazy as BL
 import           Data.Functor.Contravariant ((>$<))
 import           Data.Void (Void)
+import qualified Network.Mux as Mux
 import           Network.Socket (SockAddr (..))
 import           Ouroboros.Consensus.Block
 import           Ouroboros.Consensus.Config
@@ -40,7 +41,7 @@ import           System.FS.IO (ioHasFS)
 serve ::
      SockAddr
   -> N2N.Versions N2N.NodeToNodeVersion N2N.NodeToNodeVersionData
-       (OuroborosApplicationWithMinimalCtx 'ResponderMode SockAddr BL.ByteString IO Void ())
+       (OuroborosApplicationWithMinimalCtx 'Mux.ResponderMode SockAddr BL.ByteString IO Void ())
   -> IO Void
 serve sockAddr application = withIOManager \iocp -> do
     let sn     = Snocket.socketSnocket iocp

ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/ImmDBServer/MiniProtocols.hs

@@ -26,6 +26,7 @@ import qualified Data.Map.Strict as Map
 import           Data.Typeable (Typeable)
 import           Data.Void (Void)
 import           GHC.Generics (Generic)
+import qualified Network.Mux as Mux
 import           Ouroboros.Consensus.Block
 import           Ouroboros.Consensus.MiniProtocol.BlockFetch.Server
                      (blockFetchServer')
@@ -48,7 +49,7 @@ import           Ouroboros.Network.Driver (runPeer)
 import           Ouroboros.Network.KeepAlive (keepAliveServer)
 import           Ouroboros.Network.Magic (NetworkMagic)
 import           Ouroboros.Network.Mux (MiniProtocol (..), MiniProtocolCb (..),
-                     MuxMode (..), OuroborosApplication (..),
+                     OuroborosApplication (..),
                      OuroborosApplicationWithMinimalCtx, RunMiniProtocol (..))
 import           Ouroboros.Network.NodeToNode (NodeToNodeVersionData (..),
                      Versions (..))
@@ -74,7 +75,7 @@ immDBServer ::
   -> ImmutableDB m blk
   -> NetworkMagic
   -> Versions NodeToNodeVersion NodeToNodeVersionData
-       (OuroborosApplicationWithMinimalCtx 'ResponderMode addr BL.ByteString m Void ())
+       (OuroborosApplicationWithMinimalCtx 'Mux.ResponderMode addr BL.ByteString m Void ())
 immDBServer codecCfg encAddr decAddr immDB networkMagic = do
     forAllVersions application
   where
@@ -98,7 +99,7 @@ immDBServer codecCfg encAddr decAddr immDB networkMagic = do
     application ::
          NodeToNodeVersion
       -> BlockNodeToNodeVersion blk
-      -> OuroborosApplicationWithMinimalCtx 'ResponderMode addr BL.ByteString m Void ()
+      -> OuroborosApplicationWithMinimalCtx 'Mux.ResponderMode addr BL.ByteString m Void ()
     application version blockVersion =
         OuroborosApplication miniprotocols
       where

ouroboros-consensus-diffusion/changelog.d/20241120_160052_neilmayhew_release_srp.md

@@ -0,0 +1,3 @@
+### Patch
+
+- Depend on `network-mux` from `ouroboros-network` and use its types.

ouroboros-consensus-diffusion/ouroboros-consensus-diffusion.cabal

@@ -89,11 +89,12 @@ library
     hashable,
     io-classes ^>=1.5,
     mtl,
+    network-mux ^>=0.6,
     ouroboros-consensus ^>=0.21,
-    ouroboros-network ^>=0.18,
-    ouroboros-network-api ^>=0.11,
-    ouroboros-network-framework ^>=0.14,
-    ouroboros-network-protocols ^>=0.12,
+    ouroboros-network ^>=0.19,
+    ouroboros-network-api ^>=0.12,
+    ouroboros-network-framework ^>=0.15,
+    ouroboros-network-protocols ^>=0.13,
     random,
     resource-registry ^>=0.1,
     safe-wild-cards ^>=1.0,

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

@@ -42,6 +42,7 @@ import           Control.ResourceRegistry
 import           Control.Tracer
 import           Data.ByteString.Lazy (ByteString)
 import           Data.Void (Void)
+import qualified Network.Mux as Mux
 import           Network.TypedProtocol.Codec
 import qualified Network.TypedProtocol.Stateful.Codec as Stateful
 import           Ouroboros.Consensus.Block
@@ -465,7 +466,7 @@ mkApps kernel Tracers {..} Codecs {..} Handlers {..} =
 responder ::
      N.NodeToClientVersion
   -> Apps m (ConnectionId peer) b b b b a
-  -> OuroborosApplicationWithMinimalCtx 'ResponderMode peer b m Void a
+  -> OuroborosApplicationWithMinimalCtx 'Mux.ResponderMode peer b m Void a
 responder version Apps {..} =
     nodeToClientProtocols
       (NodeToClientProtocols {

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

@@ -52,6 +52,7 @@ import           Data.Hashable (Hashable)
 import           Data.Int (Int64)
 import           Data.Map.Strict (Map)
 import           Data.Void (Void)
+import qualified Network.Mux as Mux
 import           Network.TypedProtocol.Codec
 import           Ouroboros.Consensus.Block
 import           Ouroboros.Consensus.Config (DiffusionPipeliningSupport (..))
@@ -810,7 +811,7 @@ initiator ::
   -> NodeToNodeVersion
   -> PSTypes.PeerSharing
   -> Apps m addr b b b b b a c
-  -> OuroborosBundleWithExpandedCtx 'InitiatorMode addr b m a Void
+  -> OuroborosBundleWithExpandedCtx 'Mux.InitiatorMode addr b m a Void
 initiator miniProtocolParameters version ownPeerSharing Apps {..} =
     nodeToNodeProtocols
       miniProtocolParameters
@@ -845,7 +846,7 @@ initiatorAndResponder ::
   -> NodeToNodeVersion
   -> PSTypes.PeerSharing
   -> Apps m addr b b b b b a c
-  -> OuroborosBundleWithExpandedCtx 'InitiatorResponderMode addr b m a c
+  -> OuroborosBundleWithExpandedCtx 'Mux.InitiatorResponderMode addr b m a c
 initiatorAndResponder miniProtocolParameters version ownPeerSharing Apps {..} =
     nodeToNodeProtocols
       miniProtocolParameters

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

@@ -4,8 +4,8 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE NumericUnderscores #-}
-{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 
 module Ouroboros.Consensus.Node.Genesis (
     -- * 'GenesisConfig'
@@ -69,10 +69,10 @@ data GenesisConfigFlags = GenesisConfigFlags
   { gcfEnableCSJ             :: Bool
   , gcfEnableLoEAndGDD       :: Bool
   , gcfEnableLoP             :: Bool
-  , gcfBlockFetchGracePeriod :: Maybe Integer
+  , gcfBlockFetchGracePeriod :: Maybe DiffTime
   , gcfBucketCapacity        :: Maybe Integer
   , gcfBucketRate            :: Maybe Integer
-  , gcfCSJJumpSize           :: Maybe Integer
+  , gcfCSJJumpSize           :: Maybe SlotNo
   , gcfGDDRateLimit          :: Maybe DiffTime
   } deriving stock (Eq, Generic, Show)
 
@@ -106,7 +106,7 @@ mkGenesisConfig Nothing = -- disable Genesis
     , gcLoEAndGDDConfig          = LoEAndGDDDisabled
     , gcHistoricityCutoff        = Nothing
     }
-mkGenesisConfig (Just GenesisConfigFlags{..}) =
+mkGenesisConfig (Just cfg) =
   GenesisConfig
     { gcBlockFetchConfig = GenesisBlockFetchConfiguration
         { gbfcGracePeriod
@@ -131,6 +131,17 @@ mkGenesisConfig (Just GenesisConfigFlags{..}) =
       gcHistoricityCutoff = Just $ HistoricityCutoff $ 3 * 2160 * 20 + 3600
     }
   where
+    GenesisConfigFlags {
+        gcfEnableLoP
+      , gcfEnableCSJ
+      , gcfEnableLoEAndGDD
+      , gcfBlockFetchGracePeriod
+      , gcfBucketCapacity
+      , gcfBucketRate
+      , gcfCSJJumpSize
+      , gcfGDDRateLimit
+      } = cfg
+
     -- The minimum amount of time during which the Genesis BlockFetch logic will
     -- download blocks from a specific peer (even if it is not performing well
     -- during that period).
@@ -153,10 +164,10 @@ mkGenesisConfig (Just GenesisConfigFlags{..}) =
     -- Limiting the performance impact of the GDD.
     defaultGDDRateLimit        = 1.0 -- seconds
 
-    gbfcGracePeriod = fromInteger $ fromMaybe defaultBlockFetchGracePeriod gcfBlockFetchGracePeriod
-    csbcCapacity    = fromInteger $ fromMaybe defaultCapacity gcfBucketCapacity
-    csbcRate        = fromInteger $ fromMaybe defaultRate gcfBucketRate
-    csjcJumpSize    = fromInteger $ fromMaybe defaultCSJJumpSize gcfCSJJumpSize
+    gbfcGracePeriod = fromMaybe defaultBlockFetchGracePeriod gcfBlockFetchGracePeriod
+    csbcCapacity    = fromMaybe defaultCapacity gcfBucketCapacity
+    csbcRate        = maybe defaultRate (fromInteger @Rational) gcfBucketRate
+    csjcJumpSize    = fromMaybe defaultCSJJumpSize gcfCSJJumpSize
     lgpGDDRateLimit = fromMaybe defaultGDDRateLimit gcfGDDRateLimit
 
 newtype LoEAndGDDParams = LoEAndGDDParams

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

@@ -19,11 +19,11 @@ module Test.Consensus.Genesis.Tests.Uniform (
 import           Cardano.Slotting.Slot (SlotNo (SlotNo), WithOrigin (..))
 import           Control.Monad (replicateM)
 import           Control.Monad.Class.MonadTime.SI (Time (..), addTime)
+import qualified Data.IntSet as IntSet
 import           Data.List (intercalate, sort, uncons)
 import qualified Data.List.NonEmpty as NE
 import qualified Data.Map.Strict as Map
 import           Data.Maybe (fromMaybe, mapMaybe)
-import qualified Data.Set as Set
 import           Data.Word (Word64)
 import           GHC.Stack (HasCallStack)
 import           Ouroboros.Consensus.Block.Abstract (WithOrigin (NotOrigin))
@@ -248,8 +248,8 @@ dropRandomPoints ps = do
   where
     dropElemsAt :: [a] -> [Int] -> [a]
     dropElemsAt xs is' =
-      let is = Set.fromList is'
-      in map fst $ filter (\(_, i) -> not $ i `Set.member` is) (zip xs [0..])
+      let is = IntSet.fromList is'
+      in [x | (x, i) <- zip xs [0..], i `IntSet.notMember` is]
 
 -- | Test that the leashing attacks do not delay the immutable tip after. The
 -- immutable tip needs to be advanced enough when the honest peer has offered

ouroboros-consensus/changelog.d/20241120_160044_neilmayhew_release_srp.md

@@ -0,0 +1,3 @@
+### Breaking
+
+- Drop NodeToClient versions < 16.

ouroboros-consensus/ouroboros-consensus.cabal

@@ -294,9 +294,9 @@ library
     mtl,
     multiset ^>=0.3,
     nothunks ^>=0.2,
-    ouroboros-network-api ^>=0.11,
+    ouroboros-network-api ^>=0.12,
     ouroboros-network-mock ^>=0.1,
-    ouroboros-network-protocols ^>=0.12,
+    ouroboros-network-protocols ^>=0.13,
     primitive,
     psqueues ^>=0.2.3,
     quiet ^>=0.2,

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Query/Version.hs

@@ -20,13 +20,6 @@ data QueryVersion
 -- | Get the @QueryVersion@ supported by this @NodeToClientVersion@.
 nodeToClientVersionToQueryVersion :: NodeToClientVersion -> QueryVersion
 nodeToClientVersionToQueryVersion x = case x of
-  NodeToClientV_9  -> QueryVersion1
-  NodeToClientV_10 -> QueryVersion2
-  NodeToClientV_11 -> QueryVersion2
-  NodeToClientV_12 -> QueryVersion2
-  NodeToClientV_13 -> QueryVersion2
-  NodeToClientV_14 -> QueryVersion2
-  NodeToClientV_15 -> QueryVersion2
   NodeToClientV_16 -> QueryVersion2
   NodeToClientV_17 -> QueryVersion2
   NodeToClientV_18 -> QueryVersion2

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/BlockFetch/ClientInterface.hs

@@ -347,7 +347,6 @@ mkBlockFetchConsensusInterface
     compareCandidateChains = compareAnchoredFragments bcfg
 
     headerForgeUTCTime = slotForgeTime . headerRealPoint . unFromConsensus
-    blockForgeUTCTime  = slotForgeTime . blockRealPoint  . unFromConsensus
 
     readChainSelStarvation = getChainSelStarvation chainDB