From a2cb7a18909992b02b04c2c3794345c37d345afe Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Mon, 19 Jan 2026 17:30:32 +0100 Subject: [PATCH 1/8] Improved PeerSelectionPolicy The peer selection policy is based on `simplePeerSelectionPolicy` with two exceptions: * it doesn't take into account `PeerMetric`, since it's not available * it doesn't forget known local root peers The latter is important, since at least now there no other peers in the network. --- dmq-node/app/Main.hs | 3 +- dmq-node/src/DMQ/Diffusion/PeerSelection.hs | 140 +++++++++++++++----- 2 files changed, 111 insertions(+), 32 deletions(-) diff --git a/dmq-node/app/Main.hs b/dmq-node/app/Main.hs index c3d322f..4bab9cf 100644 --- a/dmq-node/app/Main.hs +++ b/dmq-node/app/Main.hs @@ -119,6 +119,7 @@ runDMQ commandLineConfig = do stdGen <- newStdGen let (psRng, policyRng) = split stdGen + policyRngVar <- newTVarIO policyRng -- TODO: this might not work, since `ouroboros-network` creates its own IO Completion Port. withIOManager \iocp -> do @@ -212,7 +213,7 @@ runDMQ commandLineConfig = do dmqLimitsAndTimeouts dmqNtNApps dmqNtCApps - (policy policyRng) + (policy policyRngVar) Diffusion.run dmqDiffusionArguments (dmqDiffusionTracers dmqConfig tracer) diff --git a/dmq-node/src/DMQ/Diffusion/PeerSelection.hs b/dmq-node/src/DMQ/Diffusion/PeerSelection.hs index 13add1d..b17bbaa 100644 --- a/dmq-node/src/DMQ/Diffusion/PeerSelection.hs +++ b/dmq-node/src/DMQ/Diffusion/PeerSelection.hs @@ -1,40 +1,118 @@ module DMQ.Diffusion.PeerSelection where -import Data.Set (Set) +import Control.Concurrent.Class.MonadSTM.Strict +import Data.List (sortOn, unfoldr) +import Data.Map.Strict qualified as Map import Data.Set qualified as Set -import Network.Socket (SockAddr) -import Ouroboros.Network.PeerSelection.Governor.Types -import System.Random (Random (..), StdGen) +import Data.Word (Word32) +import Ouroboros.Network.PeerSelection +import System.Random (Random (..), StdGen, split) -- | Trivial peer selection policy used as dummy value -- -policy :: StdGen -> PeerSelectionPolicy SockAddr IO -policy gen = +policy :: forall peerAddr m. + ( MonadSTM m + , Ord peerAddr + ) + => StrictTVar m StdGen + -> PeerSelectionPolicy peerAddr m +policy rngVar = PeerSelectionPolicy { - policyPickKnownPeersForPeerShare = \_ _ _ -> pickTrivially - , policyPickColdPeersToForget = \_ _ _ -> pickTrivially - , policyPickColdPeersToPromote = \_ _ _ -> pickTrivially - , policyPickWarmPeersToPromote = \_ _ _ -> pickTrivially - , policyPickHotPeersToDemote = \_ _ _ -> pickTrivially - , policyPickWarmPeersToDemote = \_ _ _ -> pickTrivially - , policyPickInboundPeers = \_ _ _ -> pickTrivially - , policyFindPublicRootTimeout = 5 - , policyMaxInProgressPeerShareReqs = 0 - , policyPeerShareRetryTime = 0 -- seconds - , policyPeerShareBatchWaitTime = 0 -- seconds - , policyPeerShareOverallTimeout = 0 -- seconds - , policyPeerShareActivationDelay = 2 -- seconds + policyPickKnownPeersForPeerShare = simplePromotionPolicy, + policyPickColdPeersToPromote = simplePromotionPolicy, + policyPickWarmPeersToPromote = simplePromotionPolicy, + policyPickInboundPeers = simplePromotionPolicy, + + policyPickHotPeersToDemote = hotDemotionPolicy, + policyPickWarmPeersToDemote = warmDemotionPolicy, + policyPickColdPeersToForget = coldForgetPolicy, + + policyFindPublicRootTimeout = 5, + policyMaxInProgressPeerShareReqs = 0, + policyPeerShareRetryTime = 0, -- seconds + policyPeerShareBatchWaitTime = 0, -- seconds + policyPeerShareOverallTimeout = 0, -- seconds + policyPeerShareActivationDelay = 2 -- seconds } where - pickTrivially :: Applicative m => Set SockAddr -> Int -> m (Set SockAddr) - pickTrivially set n = pure - . fst - $ go gen (Set.toList set) n [] - where - go g _ 0 acc = (Set.fromList acc, g) - go g [] _ acc = (Set.fromList acc, g) - go g xs k acc = - let (idx, g') = randomR (0, length xs - 1) g - picked = xs !! idx - xs' = take idx xs ++ drop (idx + 1) xs - in go g' xs' (k - 1) (picked : acc) + hotDemotionPolicy :: PickPolicy peerAddr (STM m) + hotDemotionPolicy _ _ _ available pickNum = do + available' <- addRand rngVar available (,) + return $ Set.fromList + . map fst + . take pickNum + . sortOn snd + . Map.assocs + $ available' + + -- Randomly pick peers to demote, peers with knownPeerTepid set are twice + -- as likely to be demoted. + warmDemotionPolicy :: PickPolicy peerAddr (STM m) + warmDemotionPolicy _ _ isTepid available pickNum = do + available' <- addRand rngVar available (tepidWeight isTepid) + return $ Set.fromList + . map fst + . take pickNum + . sortOn snd + . Map.assocs + $ available' + + simplePromotionPolicy :: PickPolicy peerAddr (STM m) + simplePromotionPolicy _ _ _ available pickNum = do + available' <- addRand rngVar available (,) + return $ Set.fromList + . map fst + . take pickNum + . sortOn snd + . Map.assocs + $ available' + + -- Randomly pick peers to forget, peers with failures are more likely to + -- be forgotten. + coldForgetPolicy :: PickPolicy peerAddr (STM m) + coldForgetPolicy source failCnt _ available pickNum = do + available' <- addRand rngVar available (failWeight failCnt) + return $ Set.fromList + . map fst + . take pickNum + . sortOn snd + . Map.assocs + -- avoid demoting local root peers + . Map.filterWithKey (\peer _ -> source peer /= PeerSourceLocalRoot) + $ available' + + -- Failures lowers r + failWeight :: (peerAddr -> Int) + -> peerAddr + -> Word32 + -> (peerAddr, Word32) + failWeight failCnt peer r = + (peer, r `div` fromIntegral (failCnt peer + 1)) + + -- Tepid flag cuts r in half + tepidWeight :: (peerAddr -> Bool) + -> peerAddr + -> Word32 + -> (peerAddr, Word32) + tepidWeight isTepid peer r = + if isTepid peer then (peer, r `div` 2) + else (peer, r) + + + -- Add scaled random number in order to prevent ordering based on SockAddr +addRand :: ( MonadSTM m + , Ord peerAddr + ) + => StrictTVar m StdGen + -> Set.Set peerAddr + -> (peerAddr -> Word32 -> (peerAddr, Word32)) + -> STM m (Map.Map peerAddr Word32) +addRand rngVar available scaleFn = do + inRng <- readTVar rngVar + + let (rng, rng') = split inRng + rns = take (Set.size available) $ unfoldr (Just . random) rng :: [Word32] + available' = Map.fromList $ zipWith scaleFn (Set.toList available) rns + writeTVar rngVar rng' + return available' + From b786785010584cb9858eef7032328a8adb475217 Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Wed, 21 Jan 2026 15:51:55 +0100 Subject: [PATCH 2/8] Updated `ouroboros-network` dependency Included https://github.com/IntersectMBO/ouroboros-network/pull/5289 to `coot/dmq-related-changes` --- cabal.project | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/cabal.project b/cabal.project index caee395..6c28a7b 100644 --- a/cabal.project +++ b/cabal.project @@ -58,8 +58,9 @@ source-repository-package source-repository-package type: git location: https://github.com/IntersectMBO/ouroboros-network - tag: 3c4433d05ec012af6d1a26e6b5e86665627c08c4 - --sha256: sha256-Jemp6PlzISA+l1wdXV6MrIxaBpAxdrLLAlbkB7ZqF2Y= + -- from coot/dmq-related-changes + tag: adc2fa928d1856a8f0069190b7f698d2218f2110 + --sha256: sha256-z1ftTOd3/EO6kjbIqLuRBtaGtkB1kNrpPOrF/q6oigM= subdir: acts-generic cardano-diffusion From 5915a859a7a5c910bb536fb1b6d113bf4591c1df Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Wed, 21 Jan 2026 16:50:47 +0100 Subject: [PATCH 3/8] tracer: use a lock to avoid concurrent writes --- dmq-node/app/Main.hs | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/dmq-node/app/Main.hs b/dmq-node/app/Main.hs index 4bab9cf..d9113aa 100644 --- a/dmq-node/app/Main.hs +++ b/dmq-node/app/Main.hs @@ -11,6 +11,7 @@ module Main where import Control.Concurrent.Class.MonadSTM.Strict +import Control.Concurrent.Class.MonadMVar import Control.Monad (void, when) import Control.Monad.Class.MonadThrow import Control.Tracer (Tracer (..), nullTracer, traceWith) @@ -93,8 +94,13 @@ runDMQ commandLineConfig = do } = config' <> commandLineConfig `act` defaultConfiguration - let tracer :: ToJSON ev => Tracer IO (WithEventType ev) - tracer = dmqTracer prettyLog + + lock <- newMVar () + let tracer', tracer :: ToJSON ev => Tracer IO (WithEventType ev) + tracer' = dmqTracer prettyLog + -- use a lock to prevent writing two lines at the same time + -- TODO: this won't be needed with `cardano-tracer` integration + tracer = Tracer $ \a -> withMVar lock $ \_ -> traceWith tracer' a when version $ do let gitrev = $(gitRev) From 5a763e1b8049cc02365d5bf978cf08177fff87b0 Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Thu, 22 Jan 2026 14:34:35 +0100 Subject: [PATCH 4/8] validation: moved cryptographic checks Cryptographic checks are the most computationally complex, so it makes sense to run them last. Added comments. --- .../DMQ/Protocol/SigSubmission/Validate.hs | 37 ++++++++++++++----- 1 file changed, 27 insertions(+), 10 deletions(-) diff --git a/dmq-node/src/DMQ/Protocol/SigSubmission/Validate.hs b/dmq-node/src/DMQ/Protocol/SigSubmission/Validate.hs index 02e239e..2f41120 100644 --- a/dmq-node/src/DMQ/Protocol/SigSubmission/Validate.hs +++ b/dmq-node/src/DMQ/Protocol/SigSubmission/Validate.hs @@ -150,9 +150,17 @@ validateSig verKeyHashingFn now sigs ctx0 = } = do ctx@PoolValidationCtx { vctxEpoch, vctxStakeMap, vctxOcertMap } <- State.get + -- + -- verify KES period + -- + sigKESPeriod < endKESPeriod ?! KESAfterEndOCERT endKESPeriod sigKESPeriod sigKESPeriod >= startKESPeriod ?! KESBeforeStartOCERT startKESPeriod sigKESPeriod + -- + -- verify that the pool is registered and eligible to mint blocks + -- + let -- `vctxEpoch` and `vctxStakeMap` are initialized in one STM -- transaction, which guarantees that fromJust will not fail nextEpoch = fromJust vctxEpoch @@ -161,6 +169,7 @@ validateSig verKeyHashingFn now sigs ctx0 = -> left NotInitialized | otherwise -> left UnrecognizedPool + Just ss@NotZeroSetSnapshot -> if | now <= addUTCTime c_MAX_CLOCK_SKEW_SEC nextEpoch -> return () @@ -189,16 +198,9 @@ validateSig verKeyHashingFn now sigs ctx0 = -- pool unregistered and is ineligible to mint blocks Just ZeroSetSnapshot -> left SigExpired - -- validate OCert, which includes verifying its signature - validateOCert coldKey ocertVkHot ocert - ?!: InvalidSignatureOCERT ocertN sigKESPeriod - - -- validate KES signature of the payload - verifyKES () ocertVkHot - (unKESPeriod sigKESPeriod - unKESPeriod startKESPeriod) - (LBS.toStrict signedBytes) - kesSig - ?!: InvalidKESSignature ocertKESPeriod sigKESPeriod + -- + -- verify that our observations of ocertN are strictly monotonic + -- case Map.alterF (\a -> (a, Just ocertN)) (verKeyHashingFn coldKey) @@ -215,6 +217,21 @@ validateSig verKeyHashingFn now sigs ctx0 = | otherwise -> left (InvalidOCertCounter prevOcertN ocertN) + -- + -- Cryptographic checks + -- + + -- validate OCert, which includes verifying its signature + validateOCert coldKey ocertVkHot ocert + ?!: InvalidSignatureOCERT ocertN sigKESPeriod + + -- validate KES signature of the payload + verifyKES () ocertVkHot + (unKESPeriod sigKESPeriod - unKESPeriod startKESPeriod) + (LBS.toStrict signedBytes) + kesSig + ?!: InvalidKESSignature ocertKESPeriod sigKESPeriod + return sig where startKESPeriod, endKESPeriod :: KESPeriod From d9f326755226c11eba7cfd11d1cb56b490e71376 Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Thu, 22 Jan 2026 15:26:34 +0100 Subject: [PATCH 5/8] validation: removed the hash function from argumentsm It's enough for us to add `DSIGN crypto ~ Ledger.DSIGN` constraint to hash they key. --- dmq-node/app/Main.hs | 6 ++---- dmq-node/dmq-node.cabal | 1 - .../src/DMQ/Protocol/SigSubmission/Validate.hs | 14 ++++++-------- dmq-node/test/DMQ/Protocol/SigSubmission/Test.hs | 2 +- 4 files changed, 9 insertions(+), 14 deletions(-) diff --git a/dmq-node/app/Main.hs b/dmq-node/app/Main.hs index d9113aa..714d7b7 100644 --- a/dmq-node/app/Main.hs +++ b/dmq-node/app/Main.hs @@ -34,8 +34,6 @@ import System.IOManager (withIOManager) import Cardano.Git.Rev (gitRev) import Cardano.KESAgent.Protocols.StandardCrypto (StandardCrypto) -import Cardano.Ledger.Keys (VKey (..)) -import Cardano.Ledger.Hashes (hashKey) import DMQ.Configuration import DMQ.Configuration.CLIOptions (parseCLIOptions) @@ -156,7 +154,7 @@ runDMQ commandLineConfig = do Mempool.getWriter SigDuplicate sigId (\now sigs -> - withPoolValidationCtx (stakePools nodeKernel) (validateSig (hashKey . VKey) now sigs) + withPoolValidationCtx (stakePools nodeKernel) (validateSig now sigs) ) (traverse_ $ \(sigid, reason) -> do traceWith ntnValidationTracer $ InvalidSignature sigid reason @@ -190,7 +188,7 @@ runDMQ commandLineConfig = do Mempool.getWriter SigDuplicate sigId (\now sigs -> - withPoolValidationCtx (stakePools nodeKernel) (validateSig (hashKey . VKey) now sigs) + withPoolValidationCtx (stakePools nodeKernel) (validateSig now sigs) ) (traverse_ $ \(sigid, reason) -> traceWith ntcValidationTracer $ InvalidSignature sigid reason diff --git a/dmq-node/dmq-node.cabal b/dmq-node/dmq-node.cabal index bf79b45..0d1e735 100644 --- a/dmq-node/dmq-node.cabal +++ b/dmq-node/dmq-node.cabal @@ -148,7 +148,6 @@ executable dmq-node base, bytestring, cardano-git-rev, - cardano-ledger-core, contra-tracer >=0.1 && <0.3, dmq-node, io-classes:{io-classes, strict-stm}, diff --git a/dmq-node/src/DMQ/Protocol/SigSubmission/Validate.hs b/dmq-node/src/DMQ/Protocol/SigSubmission/Validate.hs index 2f41120..0fe3770 100644 --- a/dmq-node/src/DMQ/Protocol/SigSubmission/Validate.hs +++ b/dmq-node/src/DMQ/Protocol/SigSubmission/Validate.hs @@ -30,13 +30,12 @@ import Data.Text (Text) import Data.Typeable import Data.Word -import Cardano.Crypto.DSIGN.Class (ContextDSIGN) import Cardano.Crypto.DSIGN.Class qualified as DSIGN import Cardano.Crypto.KES.Class (KESAlgorithm (..)) import Cardano.KESAgent.KES.Crypto as KES import Cardano.KESAgent.KES.OCert (OCert (..), OCertSignable, validateOCert) import Cardano.Ledger.BaseTypes.NonZero -import Cardano.Ledger.Hashes +import Cardano.Ledger.Keys qualified as Ledger import DMQ.Diffusion.NodeKernel (PoolValidationCtx (..)) import DMQ.Protocol.SigSubmission.Type @@ -113,17 +112,16 @@ pattern ZeroSetSnapshot <- (isZero . ssSetPool -> True) validateSig :: forall crypto. ( Crypto crypto - , ContextDSIGN (KES.DSIGN crypto) ~ () + , DSIGN crypto ~ Ledger.DSIGN , DSIGN.Signable (DSIGN crypto) (OCertSignable crypto) , ContextKES (KES crypto) ~ () , Signable (KES crypto) ByteString ) - => (DSIGN.VerKeyDSIGN (DSIGN crypto) -> KeyHash StakePool) - -> UTCTime + => UTCTime -> [Sig crypto] -> PoolValidationCtx -> ([Either (SigId, SigValidationError) (Sig crypto)], PoolValidationCtx) -validateSig verKeyHashingFn now sigs ctx0 = +validateSig now sigs ctx0 = State.runState (traverse (exceptions . validate) sigs) ctx0 where exceptions :: StateT s (Except e) a @@ -164,7 +162,7 @@ validateSig verKeyHashingFn now sigs ctx0 = let -- `vctxEpoch` and `vctxStakeMap` are initialized in one STM -- transaction, which guarantees that fromJust will not fail nextEpoch = fromJust vctxEpoch - case Map.lookup (verKeyHashingFn coldKey) vctxStakeMap of + case Map.lookup (Ledger.hashKey (Ledger.VKey coldKey)) vctxStakeMap of Nothing | isNothing vctxEpoch -> left NotInitialized | otherwise @@ -203,7 +201,7 @@ validateSig verKeyHashingFn now sigs ctx0 = -- case Map.alterF (\a -> (a, Just ocertN)) - (verKeyHashingFn coldKey) + (Ledger.hashKey (Ledger.VKey coldKey)) vctxOcertMap of (Nothing, ocertCounters') -- there is no ocert in the map, e.g. we're validating a signature diff --git a/dmq-node/test/DMQ/Protocol/SigSubmission/Test.hs b/dmq-node/test/DMQ/Protocol/SigSubmission/Test.hs index 260fefd..6d0720f 100644 --- a/dmq-node/test/DMQ/Protocol/SigSubmission/Test.hs +++ b/dmq-node/test/DMQ/Protocol/SigSubmission/Test.hs @@ -989,7 +989,7 @@ prop_validateSig constr validity = ioProperty do . counterexample ("KES seed: " ++ show (ctx constr)) . counterexample ("KES vk key: " ++ show (ocertVkHot . getSigOpCertificate . sigOpCertificate $ sig)) . counterexample (show sig) - $ case (validity, fst $ validateSig (hashKey . VKey) now [sig] validationCtx) of + $ case (validity, fst $ validateSig now [sig] validationCtx) of (Valid {}, Left (_, err) : _) -> counterexample (show err) False (Valid {}, Right _ : _) -> property True From 041c257fbef9c54101bd1b718496847aeeb54a6d Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Thu, 22 Jan 2026 15:33:45 +0100 Subject: [PATCH 6/8] validation: qualified imports from cardano-ledger --- dmq-node/src/DMQ/Protocol/SigSubmission/Validate.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/dmq-node/src/DMQ/Protocol/SigSubmission/Validate.hs b/dmq-node/src/DMQ/Protocol/SigSubmission/Validate.hs index 0fe3770..6fc1143 100644 --- a/dmq-node/src/DMQ/Protocol/SigSubmission/Validate.hs +++ b/dmq-node/src/DMQ/Protocol/SigSubmission/Validate.hs @@ -34,7 +34,7 @@ import Cardano.Crypto.DSIGN.Class qualified as DSIGN import Cardano.Crypto.KES.Class (KESAlgorithm (..)) import Cardano.KESAgent.KES.Crypto as KES import Cardano.KESAgent.KES.OCert (OCert (..), OCertSignable, validateOCert) -import Cardano.Ledger.BaseTypes.NonZero +import Cardano.Ledger.BaseTypes.NonZero qualified as Ledger import Cardano.Ledger.Keys qualified as Ledger import DMQ.Diffusion.NodeKernel (PoolValidationCtx (..)) @@ -99,13 +99,13 @@ c_MAX_CLOCK_SKEW_SEC :: NominalDiffTime c_MAX_CLOCK_SKEW_SEC = 5 pattern NotZeroSetSnapshot :: StakeSnapshot -pattern NotZeroSetSnapshot <- (isZero . ssSetPool -> False) +pattern NotZeroSetSnapshot <- (Ledger.isZero . ssSetPool -> False) pattern NotZeroMarkSnapshot :: StakeSnapshot -pattern NotZeroMarkSnapshot <- (isZero . ssMarkPool -> False) +pattern NotZeroMarkSnapshot <- (Ledger.isZero . ssMarkPool -> False) pattern ZeroSetSnapshot :: StakeSnapshot -pattern ZeroSetSnapshot <- (isZero . ssSetPool -> True) +pattern ZeroSetSnapshot <- (Ledger.isZero . ssSetPool -> True) {-# COMPLETE NotZeroSetSnapshot, NotZeroMarkSnapshot, ZeroSetSnapshot #-} @@ -173,7 +173,7 @@ validateSig now sigs ctx0 = -> return () -- local-state-query is late, but the pool is about to expire - | isZero (ssMarkPool ss) + | Ledger.isZero (ssMarkPool ss) -> left SigExpired | otherwise From 938ce5512e0926e04fd644900b21fa52f1532860 Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Thu, 22 Jan 2026 15:40:55 +0100 Subject: [PATCH 7/8] More qualified imports from ledger & consensus --- dmq-node/src/DMQ/Diffusion/NodeKernel.hs | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/dmq-node/src/DMQ/Diffusion/NodeKernel.hs b/dmq-node/src/DMQ/Diffusion/NodeKernel.hs index fc71b48..2c7a484 100644 --- a/dmq-node/src/DMQ/Diffusion/NodeKernel.hs +++ b/dmq-node/src/DMQ/Diffusion/NodeKernel.hs @@ -6,6 +6,7 @@ module DMQ.Diffusion.NodeKernel , withNodeKernel , PoolValidationCtx (..) , StakePools (..) + , PoolId ) where import Control.Concurrent.Class.MonadMVar @@ -33,8 +34,8 @@ import Data.Word import System.Random (StdGen) import System.Random qualified as Random -import Cardano.Ledger.Shelley.API hiding (I) -import Ouroboros.Consensus.Shelley.Ledger.Query +import Cardano.Ledger.Shelley.API qualified as Ledger +import Ouroboros.Consensus.Shelley.Ledger.Query qualified as LedgerQuery import Ouroboros.Network.BlockFetch (FetchClientRegistry, newFetchClientRegistry) @@ -76,13 +77,13 @@ data NodeKernel crypto ntnAddr m = -- | Cardano pool id's are hashes of the cold verification key -- -type PoolId = KeyHash StakePool +type PoolId = Ledger.KeyHash Ledger.StakePool data StakePools m = StakePools { -- | contains map of cardano pool stake snapshot obtained -- via local state query client stakePoolsVar - :: !(StrictTVar m (Map PoolId StakeSnapshot)) + :: !(StrictTVar m (Map PoolId LedgerQuery.StakeSnapshot)) -- | Acquire and update validation context for signature validation , withPoolValidationCtx :: forall a. (PoolValidationCtx -> (a, PoolValidationCtx)) -> STM m a @@ -99,7 +100,7 @@ data PoolValidationCtx = PoolValidationCtx { vctxEpoch :: !(Maybe UTCTime) -- ^ UTC time of next epoch boundary for handling clock skew - , vctxStakeMap :: !(Map PoolId StakeSnapshot) + , vctxStakeMap :: !(Map PoolId LedgerQuery.StakeSnapshot) -- ^ for signature validation , vctxOcertMap :: !(Map PoolId Word64) -- ^ ocert counters to check monotonicity From 936eee7d04c85dcb362ac2179d07cf2e2e362c19 Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Thu, 22 Jan 2026 16:23:58 +0100 Subject: [PATCH 8/8] Added changelog.d entry --- .../20260122_162026_coot_peer_selection_policy.md | 9 +++++++++ 1 file changed, 9 insertions(+) create mode 100644 dmq-node/changelog.d/20260122_162026_coot_peer_selection_policy.md diff --git a/dmq-node/changelog.d/20260122_162026_coot_peer_selection_policy.md b/dmq-node/changelog.d/20260122_162026_coot_peer_selection_policy.md new file mode 100644 index 0000000..e88ba9a --- /dev/null +++ b/dmq-node/changelog.d/20260122_162026_coot_peer_selection_policy.md @@ -0,0 +1,9 @@ +### Breaking + +- `validateSig`: removed the hashing function for cold key from arguments, added required constraints ledger's `hashKey . VKey` usage instead + +### Non-Breaking + +- Added a lock to avoid race conditions between trace events. +- Improved peer selection policy. +