Merge pull request #58 from IntersectMBO/coot/ouroboros-network-update

Updated ouroboros-network version, signature validation simplification

Author: coot

cabal.project

@@ -15,10 +15,10 @@ repository cardano-haskell-packages
 -- repeat the index-state for hackage to work around haskell.nix parsing limitation
 index-state:
   -- Bump this if you need newer packages from Hackage
-  , hackage.haskell.org 2026-02-17T10:15:41Z
+  , hackage.haskell.org 2026-05-13T07:31:22Z
 
   -- Bump this if you need newer packages from CHaP
-  , cardano-haskell-packages 2026-04-07T08:02:00Z
+  , cardano-haskell-packages 2026-05-11T20:15:43Z
 
 active-repositories:
   , :rest
@@ -44,11 +44,31 @@ if impl(ghc >= 9.12.0)
 -- rejecting: cardano-crypto-class-2.3.1.0 (conflict: cardano-crypto-tests => cardano-crypto-class>=2.2.2 && <2.2.4)
 -- allow-newer: cardano-crypto-tests:cardano-crypto-class
 
+-- ouroboros-network with PR#5376, but without contra-tracer-0.2.1.0 (PR#5368)
 source-repository-package
   type: git
   location: https://github.com/IntersectMBO/ouroboros-network
-  tag: f2d88695147d9f236669caa214e11dba6b75eadc
-  --sha256: sha256-mRP9WxZ4xPOus/nFzSOMXCYopBGZcERDk+QqOD1LmQc=
-  subdir: ouroboros-network
+  tag: 5a80699bca834a4de47aca4fe4d322832309e374
+  --sha256: sha256-FXp0gIfsUDVEE4ZuEM5y55qx0I7d5+/wQ7AjUz6UDcE=
+  subdir: network-mux
+          cardano-diffusion
+          ouroboros-network
+
+source-repository-package
+  type: git
+  location: https://github.com/IntersectMBO/ouroboros-consensus
+  tag: ec9df6ee1d7ab918e75219107fc17e1b2cf1a0e9
+  --sha256: sha256-c+yGPftvlas2CcnFLUPPqjnitz5yTu/Qud5LaSMyY34=
+
+-- https://github.com/bgamari/monoidal-containers/pull/112
+source-repository-package
+  type: git
+  location: https://github.com/coot/monoidal-containers
+  tag: 8319c34e260c7b44adaf0ac04074b3e37e510cea
+  --sha256: sha256-HkQC2Hb1OAyN8mI2BPcIylcUYF0Mts4DrffJ7Fkkh6Q=
+
+constraints: semialign >= 1.4,
+             validation < 1.2
+allow-newer: hedgehog-quickcheck:QuickCheck,
+             monoidal-containers:semialign
 
-allow-newer: ouroboros-network:trace-dispatcher

dmq-node/CHANGELOG.md

@@ -2,6 +2,33 @@
 
 <!-- scriv-insert-here -->
 
+<a id='changelog-0.6.0.0'></a>
+## 0.6.0.0 -- 2026-06-04
+
+### Breaking
+
+- Default network magic used by dmq-node is the mainnet network magic for mithril network.
+- Tighter sig-submission codec size limits (derived from `maxSigsInflight` and `maxSigSize`).
+- Using `KeepAliveRegistry` instead of `FetchClientRegistry` introduced in
+  a recent `ouroboros-network` PR. The `fetchClientRegistry` field of
+  `NodeKernel` was replaced with `keepAliveRegistry` field.
+- Using set snapshot in the pool eligibility (signature validation).
+- Added `dmqcShelleyGenesisFile` and `dmqcShelleyGenesisHash` fields to
+  `Configuration`.  The default value are `genesis-shelley.json` and
+  `Nothing` (e.g. hash is not verified against expected value).
+- Signature validation is using maximum KES evolutions from the genesis file.
+- Signature validation changed, we're no longer using the `mark set`, pools
+  with no stake will be able to mint signatures as long as they have non zero
+  stake in the `set set`.
+
+### Non-Breaking
+
+- Added `PrettyShow` instances for
+  - `NodeToNodeVersion`
+  - `NodeToNodeVersionData`
+  - `NodeToClientVersion`
+  - `NodeToClientVersionData`
+
 <a id='changelog-0.5.0.0'></a>
 ## 0.5.0.0 -- 2026-05-19
 

dmq-node/app/Main.hs

@@ -17,6 +17,7 @@ import Control.Monad (unless, void, when)
 import Control.Monad.Class.MonadAsync
 import Control.Monad.Class.MonadThrow
 import Control.Monad.Class.MonadTimer.SI
+import Control.Monad.Trans.Except (runExceptT)
 import "contra-tracer" Control.Tracer (nullTracer, traceWith)
 
 import Data.Act
@@ -48,6 +49,7 @@ import DMQ.Diffusion.Applications (diffusionApplications)
 import DMQ.Diffusion.Arguments
 import DMQ.Diffusion.NodeKernel as NodeKernel
 import DMQ.Diffusion.PeerSelectionPolicy (policy)
+import DMQ.Genesis
 import DMQ.Handlers.TopLevel (toplevelExceptionHandler)
 import DMQ.NodeToClient qualified as NtC
 import DMQ.NodeToClient.LocalStateQueryClient
@@ -57,6 +59,7 @@ import DMQ.Policy qualified as Policy
 import DMQ.Protocol.SigSubmission.Type (Sig (..))
 import DMQ.Protocol.SigSubmission.Validate
 import DMQ.Tracer (DMQStartupTrace (..), DMQTracers (..), mkDMQTracers)
+
 import Ouroboros.Network.Diffusion qualified as Diffusion
 import Ouroboros.Network.PeerSelection.LedgerPeers.Type
 import Ouroboros.Network.PeerSelection.PeerSharing.Codec (decodeRemoteAddress,
@@ -94,7 +97,10 @@ runDMQ commandLineConfig = do
           dmqcTopologyFile          = I topologyFile,
           dmqcCardanoNodeSocket     = I socketPath,
           dmqcVersion               = I version,
-          dmqcLedgerPeers           = I ledgerPeers
+          dmqcLedgerPeers           = I ledgerPeers,
+          dmqcShelleyGenesisFile    = I genesisFile,
+          dmqcShelleyGenesisHash    = I genesisHash
+
         } =     fromRight mempty config'
              <> commandLineConfig
             `act`
@@ -168,6 +174,9 @@ runDMQ commandLineConfig = do
     let (psRng, policyRng) = Random.splitGen stdGen
     policyRngVar <- newTVarIO policyRng
 
+    (shelleyGenesis, _) <-
+      runExceptT (readGenesis genesisFile genesisHash) >>= either throwIO pure
+
     -- TODO: this might not work, since `ouroboros-network` creates its own IO Completion Port.
     withIOManager \iocp -> do
       let localSnocket'      = localSnocket iocp
@@ -180,6 +189,7 @@ runDMQ commandLineConfig = do
       withNodeKernel @StandardCrypto
                      dmqTracers
                      dmqConfig
+                     shelleyGenesis
                      psRng
                      mkStakePoolMonitor $ \nodeKernel -> do
         dmqDiffusionConfiguration <-
@@ -193,7 +203,7 @@ runDMQ commandLineConfig = do
                     Mempool.getWriter SigDuplicate
                                       sigId
                                       (\now sigs ->
-                                        withPoolValidationCtx (stakePools nodeKernel) (validateSig now sigs)
+                                        withPoolValidationCtx (stakePools nodeKernel) now (validateSig sigs)
                                       )
                                       (traverse_ $ \(sigid, reason) -> do
                                         traceWith sigValidationTracer $ InvalidSignature sigid reason
@@ -222,7 +232,7 @@ runDMQ commandLineConfig = do
                     Mempool.getWriter SigDuplicate
                                       sigId
                                       (\now sigs ->
-                                        withPoolValidationCtx (stakePools nodeKernel) (validateSig now sigs)
+                                        withPoolValidationCtx (stakePools nodeKernel) now (validateSig sigs)
                                       )
                                       (traverse_ $ \(sigid, reason) ->
                                          traceWith localSigValidationTracer $ InvalidSignature sigid reason

dmq-node/dmq-node.cabal

@@ -1,6 +1,6 @@
 cabal-version: 3.4
 name: dmq-node
-version: 0.5.0.0
+version: 0.6.0.0
 synopsis: Decentralised Message Queue Node
 description:
   Decentralised Message Queue Node based on Cardano Diffusion
@@ -66,6 +66,7 @@ library
     DMQ.Diffusion.NodeKernel.Types
     DMQ.Diffusion.PeerSelection.PeerMetric
     DMQ.Diffusion.PeerSelectionPolicy
+    DMQ.Genesis
     DMQ.Handlers.TopLevel
     DMQ.NodeToClient
     DMQ.NodeToClient.LocalMsgNotification
@@ -125,13 +126,14 @@ library
     io-classes:{io-classes, si-timers, strict-mvar, strict-stm} ^>=1.8.0.1,
     iproute ^>=1.7.15,
     kes-agent-crypto ^>=1.1.0.0,
+    mmap,
     mtl,
     network ^>=3.2.7,
     network-mux ^>=0.10,
     nothunks,
     optparse-applicative >=0.18 && <0.20,
     ouroboros-consensus:{ouroboros-consensus, cardano, diffusion},
-    ouroboros-network:{ouroboros-network, api, framework, framework-tracing, orphan-instances, protocols, tracing} ^>=1.1.0.0,
+    ouroboros-network:{ouroboros-network, api, framework, orphan-instances, protocols, tracing} ^>=1.1.0.0,
     psqueues,
     quiet,
     random ^>=1.3,
@@ -140,6 +142,7 @@ library
     time >=1.12 && <1.15,
     trace-dispatcher ^>=2.12.1,
     transformers,
+    transformers-except,
     typed-protocols:{typed-protocols, cborg} ^>=1.2,
 
   hs-source-dirs: src
@@ -174,6 +177,7 @@ executable dmq-node
     random,
     text,
     trace-dispatcher,
+    transformers,
 
   hs-source-dirs: app
   default-language: Haskell2010

dmq-node/src/DMQ/Configuration.hs

@@ -75,6 +75,7 @@ import Ouroboros.Network.Server.RateLimiting (AcceptedConnectionsLimit (..))
 import Ouroboros.Network.Snocket (LocalAddress (..), RemoteAddress)
 
 import DMQ.Configuration.Topology (NoExtraConfig (..), NoExtraFlags (..))
+import DMQ.Genesis
 
 -- | Configuration comes in two flavours depending on the `f` functor:
 -- `PartialConfig` is using `Last` and `Configuration` is using an identity
@@ -91,6 +92,12 @@ data Configuration' f =
     dmqcNetworkMagic                      :: f NetworkMagic,
     -- | Network magic for local connections to a cardano-node
     dmqcCardanoNetworkMagic               :: f NetworkMagic,
+    -- | shelley genesis file, e.g.
+    -- `/configuration/cardano/mainnet-shelley-genesis.json` in `cardano-node`
+    -- repo.
+    dmqcShelleyGenesisFile                :: f GenesisFile,
+    -- | Hash of the genesis file.
+    dmqcShelleyGenesisHash                :: f (Maybe GenesisHash),
 
     -- | IPv4 address to bind to for `node-to-node` communication.
     dmqcIPv4                              :: f (Maybe IPv4),
@@ -187,12 +194,15 @@ defaultConfiguration = Configuration {
       dmqcIPv4                              = I Nothing,
       dmqcIPv6                              = I Nothing,
       dmqcLocalAddress                      = I (LocalAddress "dmq-node.socket"),
-      dmqcNetworkMagic                      = I NetworkMagic { unNetworkMagic = 3_141_592 },
+      -- mainnet dmq protocol magic according to CIP#137
+      dmqcNetworkMagic                      = I NetworkMagic { unNetworkMagic = 2_912_307_721 },
       dmqcCardanoNetworkMagic               =
         I (NetworkMagic . unProtocolMagicId $ mainnetProtocolMagicId),
       dmqcPortNumber                        = I 3_141,
       dmqcConfigFile                        = I "dmq.config.json",
       dmqcTopologyFile                      = I "dmq.topology.json",
+      dmqcShelleyGenesisFile                = I (GenesisFile "mainnet-shelley-genesis.json"),
+      dmqcShelleyGenesisHash                = I Nothing,
       dmqcAcceptedConnectionsLimit          = I defaultAcceptedConnectionsLimit,
       dmqcDiffusionMode                     = I InitiatorAndResponderDiffusionMode,
       dmqcCardanoNodeSocket                 = I "cardano-node.socket",
@@ -246,6 +256,9 @@ instance FromJSON PartialConfig where
       dmqcPeerSharing <- Last <$> v .:? "PeerSharing"
       dmqcCardanoNodeSocket <- Last <$> v .:? "CardanoNodeSocket"
 
+      dmqcShelleyGenesisFile <- Last . fmap GenesisFile <$> v .:? "ShelleyGenesisFile"
+      dmqcShelleyGenesisHash <- Last <$> v .:? "ShelleyGenesisHash"
+
       dmqcTargetOfRootPeers                 <- Last <$> v .:? "TargetNumberOfRootPeers"
       dmqcTargetOfKnownPeers                <- Last <$> v .:? "TargetNumberOfKnownPeers"
       dmqcTargetOfEstablishedPeers          <- Last <$> v .:? "TargetNumberOfEstablishedPeers"
@@ -279,6 +292,8 @@ instance ToJSON Configuration where
            , "ConfigFile"                        .= unI dmqcConfigFile
            , "CardanoNodeSocket"                 .= unI dmqcCardanoNodeSocket
            , "TopologyFile"                      .= unI dmqcTopologyFile
+           , "ShelleyGenesisFile"                .= unGenesisFile (unI dmqcShelleyGenesisFile)
+           , "ShelleyGenesisHash"                .= unI dmqcShelleyGenesisHash
            , "AcceptedConnectionsLimit"          .= unI dmqcAcceptedConnectionsLimit
            , "DiffusionMode"                     .= unI dmqcDiffusionMode
            , "TargetOfRootPeers"                 .= unI dmqcTargetOfRootPeers

dmq-node/src/DMQ/Diffusion/NodeKernel.hs

@@ -28,7 +28,7 @@ import Data.Void (Void)
 import System.Random (StdGen)
 import System.Random qualified as Random
 
-import Ouroboros.Network.BlockFetch (newFetchClientRegistry)
+import Ouroboros.Network.KeepAlive (newKeepAliveRegistry)
 import Ouroboros.Network.Magic (NetworkMagic (..))
 import Ouroboros.Network.PeerSelection.Governor.Types
            (makePublicPeerSelectionStateVar)
@@ -42,6 +42,7 @@ import Ouroboros.Network.TxSubmission.Mempool.Simple qualified as Mempool
 import DMQ.Configuration
 import DMQ.Diffusion.NodeKernel.Types
 import DMQ.Diffusion.PeerSelection.PeerMetric (mkPeerMetric)
+import DMQ.Genesis
 import DMQ.Policy qualified as Policy
 import DMQ.Protocol.SigSubmission.Type (Sig (sigExpiresAt, sigId), SigId)
 import DMQ.Tracer
@@ -52,31 +53,34 @@ newNodeKernel :: forall crypto ntnAddr m.
                  , Ord ntnAddr
                  )
               => StdGen
+              -> ShelleyGenesis
               -> m (NodeKernel crypto ntnAddr m)
-newNodeKernel rng = do
+newNodeKernel rng ShelleyGenesis {sgMaxKESEvolutions} = do
   publicPeerSelectionStateVar <- makePublicPeerSelectionStateVar
 
-  fetchClientRegistry <- newFetchClientRegistry
+  keepAliveRegistry <- newKeepAliveRegistry
   peerSharingRegistry <- newPeerSharingRegistry
 
   mempool <- Mempool.empty
   sigChannelVar <- newTxChannelsVar
   sigMempoolSem <- newTxMempoolSem
   let (rng', rng'') = Random.splitGen rng
   sigSharedTxStateVar <- newSharedTxStateVar rng'
-  (nextEpochVar, ocertCountersVar, stakePoolsVar, ledgerBigPeersVar, ledgerPeersVar) <- atomically $
-    (,,,,) <$> newTVar Nothing
+  (readinessVar, ocertCountersVar, stakePoolsVar, ledgerBigPeersVar, ledgerPeersVar) <- atomically $
+    (,,,,) <$> newTVar NotReady
            <*> newTVar Map.empty
            <*> newTVar Map.empty
            <*> newTVar Nothing
            <*> newEmptyTMVar
 
   let withPoolValidationCtx
-        :: forall a. (PoolValidationCtx -> (a, PoolValidationCtx)) -> STM m a
-      withPoolValidationCtx f = do
-        ctx <- PoolValidationCtx <$> readTVar nextEpochVar
-                                 <*> readTVar stakePoolsVar
-                                 <*> readTVar ocertCountersVar
+        :: forall a. UTCTime -> (PoolValidationCtx -> (a, PoolValidationCtx)) -> STM m a
+      withPoolValidationCtx now f = do
+        ctx <- PoolValidationCtx now
+                <$> readTVar readinessVar
+                <*> readTVar stakePoolsVar
+                <*> readTVar ocertCountersVar
+                <*> pure sgMaxKESEvolutions
         let (a, PoolValidationCtx {vctxOcertMap}) = f ctx
         writeTVar ocertCountersVar vctxOcertMap
         return a
@@ -97,14 +101,14 @@ newNodeKernel rng = do
 
   peerMetric <- mkPeerMetric
 
-  pure NodeKernel { fetchClientRegistry
+  pure NodeKernel { keepAliveRegistry
                   , peerSharingRegistry
                   , peerSharingAPI
                   , mempool
                   , sigChannelVar
                   , sigMempoolSem
                   , sigSharedTxStateVar
-                  , nextEpochVar
+                  , readinessVar
                   , stakePools
                   , peerMetric
                   }
@@ -123,6 +127,7 @@ withNodeKernel :: forall crypto ntnAddr ntcAddr m a.
                   )
                => DMQTracers crypto ntnAddr ntcAddr m
                -> Configuration
+               -> ShelleyGenesis
                -> StdGen
                -> (NetworkMagic -> NodeKernel crypto ntnAddr m -> m (Either SomeException Void))
                -> (NodeKernel crypto ntnAddr m -> m a)
@@ -133,13 +138,14 @@ withNodeKernel DMQTracers { sigSubmissionLogicTracer }
                Configuration {
                  dmqcCardanoNetworkMagic = I networkMagic
                }
+               shelleyGenesis
                rng
                mkStakePoolMonitor k = do
   nodeKernel@NodeKernel { mempool,
                           sigChannelVar,
                           sigSharedTxStateVar
                         }
-    <- newNodeKernel rng
+    <- newNodeKernel rng shelleyGenesis
   withAsync (mempoolWorker mempool)
           $ \mempoolThread ->
     withAsync (decisionLogicThreads