Verification of Stake Pool IDs

cabal.project

@@ -18,7 +18,7 @@ index-state:
   , hackage.haskell.org 2025-08-05T15:28:56Z
 
   -- Bump this if you need newer packages from CHaP
-  , cardano-haskell-packages 2025-03-18T17:41:11Z
+  , cardano-haskell-packages 2025-09-10T02:05:10Z
 
 packages: ./cardano-ping
           ./monoidal-synchronisation
@@ -55,10 +55,35 @@ package acts
 
 allow-newer: quickcheck-instances:QuickCheck
 
+constraints:
+  QuickCheck <2.16
+
+-- temp
+source-repository-package
+  type: git
+  location: https://github.com/input-output-hk/typed-protocols
+  tag: e29a21541c4af44a3d586ef0b2a61f8d87cc6bdd
+  --sha256:
+  subdir: typed-protocols
+
+source-repository-package
+  type: git
+  location: https://github.com/IntersectMBO/ouroboros-consensus
+  tag: 30d4260783f1ae20d4e8a4163d68a8d54cf6f33a
+  --sha256:
+  subdir:
+    ouroboros-consensus-cardano
+    ouroboros-consensus-diffusion
+    sop-extras
+    ouroboros-consensus-protocol
+    ouroboros-consensus
+
 -- kes-agent is not yet in CHaP, so we pull it from its GitHub repo
 source-repository-package
   type: git
-  location: https://github.com/input-output-hk/kes-agent
-  tag: 6d0f51fba415d3c641a8a8da37130e7adfc3ea01
-  --sha256: sha256-qM8RgmKOGBMlizPtXw2YOboYIzM6T3kvG9/Rp1F+bYQ=
-  subdir: kes-agent-crypto
+  location: https://github.com/crocodile-dentist/kes-agent
+  tag: c0ef04dde5582a28415ff7c8c1bb197adeec6fc8
+  --sha256:
+  subdir:
+    kes-agent
+    kes-agent-crypto

cardano-diffusion/cardano-diffusion.cabal

@@ -429,11 +429,14 @@ test-suite protocols-bench
     ghc-options: -fproc-alignment=64
 
 library cardano-diffusion-tests-lib
+  mixins:
+    QuickCheck hiding (Test.QuickCheck.Monoids)
+
   import: ghc-options-tests
   visibility: public
   hs-source-dirs: tests/lib
   build-depends:
-    QuickCheck >=2.16,
+    QuickCheck,
     aeson,
     base >=4.14 && <4.22,
     bytestring,

cardano-diffusion/changelog.d/20251016_142053_coot_dmq_signature_validation.md

@@ -0,0 +1,4 @@
+### Non-Breaking
+
+- Addapted tests to changes in the `Ouroboros.Network.TxSubmission.Mempool.Simple` API
+

cardano-diffusion/demo/chain-sync.hs

@@ -75,8 +75,7 @@ import Ouroboros.Network.Protocol.BlockFetch.Type qualified as BlockFetch
 import Ouroboros.Network.BlockFetch
 import Ouroboros.Network.BlockFetch.Client
 import Ouroboros.Network.BlockFetch.ClientRegistry (FetchClientRegistry (..))
-import Ouroboros.Network.BlockFetch.ConsensusInterface (ChainSelStarvation (..),
-           initialWithFingerprint)
+import Ouroboros.Network.BlockFetch.ConsensusInterface (ChainSelStarvation (..))
 import Ouroboros.Network.DeltaQ (defaultGSV)
 
 import Ouroboros.Network.Server.Simple qualified as Server.Simple
@@ -436,10 +435,8 @@ clientBlockFetch sockAddrs maxSlotNo = withIOManager $ \iocp -> do
                   pure $ \p b ->
                     addTestFetchedBlock blockHeap (castPoint p) (blockHeader b),
 
-              readChainComparison    = pure $ initialWithFingerprint ChainComparison {
-                    plausibleCandidateChain,
-                    compareCandidateChains
-                  },
+              plausibleCandidateChain,
+              compareCandidateChains,
 
               blockFetchSize         = \_ -> 1000,
               blockMatchesHeader     = \_ _ -> True,
@@ -453,8 +450,9 @@ clientBlockFetch sockAddrs maxSlotNo = withIOManager $ \iocp -> do
             plausibleCandidateChain cur candidate =
                 AF.headBlockNo candidate > AF.headBlockNo cur
 
-            headerForgeUTCTime =
-                convertSlotToTimeForTestsAssumingNoHardFork . headerSlot
+            headerForgeUTCTime (FromConsensus hdr) =
+                pure $
+                convertSlotToTimeForTestsAssumingNoHardFork (headerSlot hdr)
 
         compareCandidateChains c1 c2 =
           AF.headBlockNo c1 `compare` AF.headBlockNo c2

cardano-diffusion/tests/lib/Test/Cardano/Network/Diffusion/Testnet.hs

@@ -3,6 +3,7 @@
 {-# LANGUAGE NamedFieldPuns      #-}
 {-# LANGUAGE NumericUnderscores  #-}
 {-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE PackageImports      #-}
 {-# LANGUAGE RankNTypes          #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications    #-}
@@ -104,6 +105,9 @@ import Test.Ouroboros.Network.TxSubmission.Types (Tx (..), TxId)
 import Test.Ouroboros.Network.Utils hiding (SmallDelay, debugTracer)
 
 import Test.QuickCheck
+#if !MIN_VERSION_QuickCheck(2,16,0)
+import "quickcheck-monoids" Test.QuickCheck.Monoids
+#endif
 import Test.Tasty
 import Test.Tasty.QuickCheck (testProperty)
 

cardano-diffusion/tests/lib/Test/Cardano/Network/Diffusion/Testnet/MiniProtocols.hs

@@ -682,7 +682,7 @@ applications debugTracer txSubmissionInboundTracer txSubmissionInboundDebug node
 
     txSubmissionInitiator
       :: TxDecisionPolicy
-      -> Mempool m (Tx TxId)
+      -> Mempool m TxId (Tx TxId)
       -> MiniProtocolCb (ExpandedInitiatorContext NtNAddr m) ByteString m ()
     txSubmissionInitiator txDecisionPolicy mempool =
       MiniProtocolCb $
@@ -709,7 +709,7 @@ applications debugTracer txSubmissionInboundTracer txSubmissionInboundDebug node
             (txSubmissionClientPeer client)
 
     txSubmissionResponder
-      :: Mempool m (Tx TxId)
+      :: Mempool m TxId (Tx TxId)
       -> TxChannelsVar m NtNAddr Int (Tx Int)
       -> TxMempoolSem m
       -> SharedTxStateVar m NtNAddr Int (Tx Int)

cardano-diffusion/tests/lib/Test/Cardano/Network/PeerSelection.hs

@@ -93,6 +93,7 @@ import Cardano.Network.PeerSelection.Governor.Types qualified as Cardano.ExtraSi
 import Cardano.Network.PeerSelection.State.LocalRootPeers qualified as LocalRootPeers
 import Ouroboros.Network.BlockFetch (FetchMode (..), PraosFetchMode (..))
 import Test.QuickCheck
+import Test.QuickCheck.Monoids
 import Test.Tasty
 import Test.Tasty.QuickCheck
 import Text.Pretty.Simple

dmq-node/app/Main.hs

@@ -1,11 +1,14 @@
-{-# LANGUAGE MultiWayIf          #-}
-{-# LANGUAGE OverloadedStrings   #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TemplateHaskell     #-}
-{-# LANGUAGE TypeApplications    #-}
+{-# LANGUAGE DisambiguateRecordFields #-}
+{-# LANGUAGE MultiWayIf               #-}
+{-# LANGUAGE OverloadedStrings        #-}
+{-# LANGUAGE ScopedTypeVariables      #-}
+{-# LANGUAGE TemplateHaskell          #-}
+{-# LANGUAGE TypeApplications         #-}
+{-# LANGUAGE TypeOperators            #-}
 
 module Main where
 
+import Control.Exception (throwIO)
 import Control.Monad (void, when)
 import Control.Tracer (Tracer (..), nullTracer, traceWith)
 
@@ -22,14 +25,17 @@ import System.Exit (exitSuccess)
 import System.Random (newStdGen, split)
 
 import Cardano.Git.Rev (gitRev)
+import Cardano.KESAgent.KES.Evolution qualified as KES
 import Cardano.KESAgent.Protocols.StandardCrypto (StandardCrypto)
+import Cardano.Ledger.Keys (VKey (..))
+import Cardano.Ledger.Hashes (hashKey)
 
 import DMQ.Configuration
 import DMQ.Configuration.CLIOptions (parseCLIOptions)
 import DMQ.Configuration.Topology (readTopologyFileOrError)
 import DMQ.Diffusion.Applications (diffusionApplications)
 import DMQ.Diffusion.Arguments
-import DMQ.Diffusion.NodeKernel (mempool, withNodeKernel)
+import DMQ.Diffusion.NodeKernel
 import DMQ.Handlers.TopLevel (toplevelExceptionHandler)
 import DMQ.NodeToClient qualified as NtC
 import DMQ.NodeToNode (NodeToNodeVersion, dmqCodecs, dmqLimitsAndTimeouts,
@@ -39,9 +45,13 @@ import DMQ.Protocol.SigSubmission.Type (Sig (..))
 import DMQ.Tracer
 
 import DMQ.Diffusion.PeerSelection (policy)
+import DMQ.NodeToClient.LocalStateQueryClient
+import DMQ.Protocol.SigSubmission.Validate
 import Ouroboros.Network.Diffusion qualified as Diffusion
 import Ouroboros.Network.PeerSelection.PeerSharing.Codec (decodeRemoteAddress,
            encodeRemoteAddress)
+import Ouroboros.Network.SizeInBytes
+import Ouroboros.Network.Snocket
 import Ouroboros.Network.TxSubmission.Mempool.Simple qualified as Mempool
 
 import Paths_dmq_node qualified as Meta
@@ -68,8 +78,10 @@ runDMQ commandLineConfig = do
     let dmqConfig@Configuration {
           dmqcPrettyLog            = I prettyLog,
           dmqcTopologyFile         = I topologyFile,
+          dmqcShelleyGenesisFile   = I genesisFile,
           dmqcHandshakeTracer      = I handshakeTracer,
           dmqcLocalHandshakeTracer = I localHandshakeTracer,
+          dmqcCardanoNodeSocket    = I snocketPath,
           dmqcVersion              = I version
         } = config' <> commandLineConfig
             `act`
@@ -95,55 +107,82 @@ runDMQ commandLineConfig = do
         ]
       exitSuccess
 
+    res <- KES.evolutionConfigFromGenesisFile genesisFile
+    evolutionConfig <- case res of
+      Left err -> traceWith tracer (WithEventType "ShelleyGenesisFile" err)
+               >> throwIO (userError $ err)
+      Right ev -> return ev
+
     traceWith tracer (WithEventType "Configuration" dmqConfig)
     nt <- readTopologyFileOrError topologyFile
     traceWith tracer (WithEventType "NetworkTopology" nt)
 
     stdGen <- newStdGen
     let (psRng, policyRng) = split stdGen
 
-    withNodeKernel @StandardCrypto tracer dmqConfig psRng $ \nodeKernel -> do
-      dmqDiffusionConfiguration <- mkDiffusionConfiguration dmqConfig nt
-
-      let dmqNtNApps =
-            ntnApps tracer
-                    dmqConfig
-                    nodeKernel
-                    (dmqCodecs
-                              -- TODO: `maxBound :: Cardano.Network.NodeToNode.NodeToNodeVersion`
-                              -- is unsafe here!
-                                (encodeRemoteAddress (maxBound :: NodeToNodeVersion))
-                                (decodeRemoteAddress (maxBound :: NodeToNodeVersion)))
-                    dmqLimitsAndTimeouts
-                    defaultSigDecisionPolicy
-          dmqNtCApps =
-            let sigSize _ = 0 -- TODO
-                maxMsgs = 1000 -- TODO: make this dynamic?
-                mempoolReader = Mempool.getReader sigId sigSize (mempool nodeKernel)
-                mempoolWriter = Mempool.getWriter sigId (pure ())
-                                                        (\_ _ -> Right () :: Either Void ())
-                                                        (\_ -> True)
-                                                        (mempool nodeKernel)
-             in NtC.ntcApps tracer dmqConfig
-                            mempoolReader mempoolWriter maxMsgs
-                            (NtC.dmqCodecs encodeReject decodeReject)
-          dmqDiffusionArguments =
-            diffusionArguments (if handshakeTracer
-                                  then WithEventType "Handshake" >$< tracer
-                                  else nullTracer)
-                               (if localHandshakeTracer
-                                  then WithEventType "Handshake" >$< tracer
-                                  else nullTracer)
-          dmqDiffusionApplications =
-            diffusionApplications nodeKernel
-                                  dmqConfig
-                                  dmqDiffusionConfiguration
-                                  dmqLimitsAndTimeouts
-                                  dmqNtNApps
-                                  dmqNtCApps
-                                  (policy policyRng)
-
-      Diffusion.run dmqDiffusionArguments
-                    (dmqDiffusionTracers dmqConfig tracer)
-                    dmqDiffusionConfiguration
-                    dmqDiffusionApplications
+    Diffusion.withIOManager \iocp -> do
+      let localSnocket'      = localSnocket iocp
+          mkStakePoolMonitor = connectToCardanoNode tracer localSnocket' snocketPath
+
+      withNodeKernel @StandardCrypto
+                     tracer
+                     dmqConfig
+                     evolutionConfig
+                     psRng
+                     mkStakePoolMonitor $ \nodeKernel -> do
+        dmqDiffusionConfiguration <- mkDiffusionConfiguration dmqConfig nt
+
+        let sigSize :: Sig StandardCrypto -> SizeInBytes
+            sigSize _ = 0 -- TODO
+            mempoolReader = Mempool.getReader sigId sigSize (mempool nodeKernel)
+            dmqNtNApps =
+              let ntnMempoolWriter = Mempool.writerAdapter $
+                    Mempool.getWriter sigId
+                                      (poolValidationCtx $ stakePools nodeKernel)
+                                      (validateSig FailDefault (hashKey . VKey))
+                                      SigDuplicate
+                                      (mempool nodeKernel)
+               in ntnApps tracer
+                          dmqConfig
+                          mempoolReader
+                          ntnMempoolWriter
+                          sigSize
+                          nodeKernel
+                          (dmqCodecs
+                                   -- TODO: `maxBound :: Cardano.Network.NodeToNode.NodeToNodeVersion`
+                                   -- is unsafe here!
+                                   (encodeRemoteAddress (maxBound @NodeToNodeVersion))
+                                   (decodeRemoteAddress (maxBound @NodeToNodeVersion)))
+                          dmqLimitsAndTimeouts
+                          defaultSigDecisionPolicy
+            dmqNtCApps =
+              let maxMsgs = 1000 -- TODO: make this negotiated in the handshake?
+                  ntcMempoolWriter =
+                    Mempool.getWriter sigId
+                                      (poolValidationCtx $ stakePools nodeKernel)
+                                      (validateSig FailSoft (hashKey . VKey))
+                                      SigDuplicate
+                                      (mempool nodeKernel)
+               in NtC.ntcApps tracer dmqConfig
+                              mempoolReader ntcMempoolWriter maxMsgs
+                              (NtC.dmqCodecs encodeReject decodeReject)
+            dmqDiffusionArguments =
+              diffusionArguments (if handshakeTracer
+                                    then WithEventType "Handshake" >$< tracer
+                                    else nullTracer)
+                                 (if localHandshakeTracer
+                                    then WithEventType "Handshake" >$< tracer
+                                    else nullTracer)
+            dmqDiffusionApplications =
+              diffusionApplications nodeKernel
+                                    dmqConfig
+                                    dmqDiffusionConfiguration
+                                    dmqLimitsAndTimeouts
+                                    dmqNtNApps
+                                    dmqNtCApps
+                                    (policy policyRng)
+
+        Diffusion.run dmqDiffusionArguments
+                      (dmqDiffusionTracers dmqConfig tracer)
+                      dmqDiffusionConfiguration
+                      dmqDiffusionApplications

dmq-node/cddl/specs/sig.cddl

@@ -13,7 +13,7 @@ messagePayload = [
 
 messageId    = bstr
 messageBody  = bstr
-kesSignature = bstr
+kesSignature = bstr .size 448
 kesPeriod    = word64
 operationalCertificate = [ bstr .size 32, word64, word64, bstr .size 64 ]
 coldVerificationKey = bstr .size 32

dmq-node/changelog.d/20251016_142205_coot_dmq_signature_validation.md

@@ -0,0 +1,20 @@
+<!--
+A new scriv changelog fragment.
+
+Uncomment the section that is right (remove the HTML comment wrapper).
+For top level release notes, leave all the headers commented out.
+-->
+
+### Breaking
+
+- Using `KESPeriod` from `Cardano.Crypto.KES` instead of `SigKESPeriod`
+  newtype.  `KESPeriod` is used by `SigRaw` data type.
+- `SigKESSignature` holds `SigKES (KES crypto)` instead of a `ByteString`.
+- `SigColdKey` holds `VerKeyDSIGN` instead of a `ByteString`.
+- `ntnApps` constraints changed in order to use `sigValidate` function.
+
+### Non-Breaking
+
+- `Sig` codec decodes KES signatures, and the cold key.
+- Added `DMQ.SigSubmission.Type.validateSig` and `SigValidationError`.
+