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-10T20:31:08Z
 
 packages: ./cardano-ping
           ./monoidal-synchronisation
@@ -58,12 +58,35 @@ package ouroboros-network
 package acts
   flags: -finitary
 
-allow-newer: quickcheck-instances:QuickCheck
+source-repository-package
+  type: git
+  location: https://github.com/IntersectMBO/ouroboros-consensus
+  tag: 6b71fb3f32e516613e1a05d402f52d60c2cb188d
+  --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: ebf8c0e480adf7b3ccd68bc7dd5b57f781f369ea
-  --sha256: sha256-QIb6qgcwtO7aB9PUhZTHyKw50GV3ViXOakQvnR3HFIY=
-  subdir: kes-agent-crypto
+  location: https://github.com/coot/kes-agent
+  tag: 2d41b37a9d199b3f987453594182c579977ad69c
+  --sha256:
+  subdir:
+    kes-agent
+    kes-agent-crypto
+
+source-repository-package
+  type: git
+  location: https://github.com/input-output-hk/typed-protocols
+  tag: 326733ac873588f366fa988701c87fc58bad87eb
+  --sha256:
+  subdir:
+    typed-protocols
+
+constraints:
+    QuickCheck < 2.16

dmq-node/app/Main.hs

@@ -1,5 +1,6 @@
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications    #-}
+{-# LANGUAGE DisambiguateRecordFields #-}
+{-# LANGUAGE TypeApplications         #-}
+{-# LANGUAGE TypeOperators            #-}
 
 module Main where
 
@@ -14,25 +15,32 @@ import Options.Applicative
 import System.Random (newStdGen, split)
 
 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.NodeToClient qualified as NtC
 import DMQ.NodeToNode (dmqCodecs, dmqLimitsAndTimeouts, ntnApps)
 import DMQ.Protocol.LocalMsgSubmission.Codec
 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
 
+
 main :: IO ()
 main = void . runDMQ =<< execParser opts
   where
@@ -56,7 +64,8 @@ runDMQ commandLineConfig = do
           dmqcPrettyLog            = I prettyLog,
           dmqcTopologyFile         = I topologyFile,
           dmqcHandshakeTracer      = I handshakeTracer,
-          dmqcLocalHandshakeTracer = I localHandshakeTracer
+          dmqcLocalHandshakeTracer = I localHandshakeTracer,
+          dmqcCardanoNodeSocket    = I snocketPath
         } = config' <> commandLineConfig
             `act`
             defaultConfiguration
@@ -69,48 +78,65 @@ runDMQ commandLineConfig = do
 
     stdGen <- newStdGen
     let (psRng, policyRng) = split stdGen
+        diffusionTracers = dmqDiffusionTracers dmqConfig tracer
+
+    Diffusion.withIOManager \iocp -> do
+      let localSnocket'      = localSnocket iocp
+          mkStakePoolMonitor = connectToCardanoNode tracer localSnocket' snocketPath
+
+      withNodeKernel @StandardCrypto 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)
+                                     (decodeRemoteAddress maxBound))
+                          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 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)
 
-    withNodeKernel @StandardCrypto 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)
-                               (decodeRemoteAddress maxBound))
-                    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 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.run dmqDiffusionArguments
+                      diffusionTracers
+                      dmqDiffusionConfiguration
+                      dmqDiffusionApplications

dmq-node/dmq-node.cabal

@@ -56,6 +56,7 @@ library
     DMQ.NodeToClient
     DMQ.NodeToClient.LocalMsgNotification
     DMQ.NodeToClient.LocalMsgSubmission
+    DMQ.NodeToClient.LocalStateQueryClient
     DMQ.NodeToClient.Version
     DMQ.NodeToNode
     DMQ.NodeToNode.Version
@@ -70,6 +71,7 @@ library
     DMQ.Protocol.LocalMsgSubmission.Type
     DMQ.Protocol.SigSubmission.Codec
     DMQ.Protocol.SigSubmission.Type
+    DMQ.Protocol.SigSubmission.Validate
     DMQ.Tracer
 
   build-depends:
@@ -81,6 +83,11 @@ library
     bytestring >=0.10 && <0.13,
     cardano-binary,
     cardano-crypto-class,
+    cardano-crypto-wrapper,
+    cardano-ledger-byron,
+    cardano-ledger-core,
+    cardano-ledger-shelley,
+    cardano-slotting,
     cborg >=0.2.1 && <0.3,
     containers >=0.5 && <0.8,
     contra-tracer >=0.1 && <0.3,
@@ -96,14 +103,19 @@ library
     network ^>=3.2.7,
     network-mux ^>=0.9.1,
     optparse-applicative ^>=0.18,
-    ouroboros-network:{ouroboros-network, orphan-instances} ^>=0.23,
+    ouroboros-consensus,
+    ouroboros-consensus-cardano,
+    ouroboros-consensus-diffusion,
+    ouroboros-network:{cardano-diffusion, ouroboros-network, orphan-instances} ^>=0.23,
     ouroboros-network-api ^>=0.17,
     ouroboros-network-framework ^>=0.20,
     ouroboros-network-protocols ^>=0.16,
     random ^>=1.2,
     singletons,
     text >=1.2.4 && <2.2,
     time ^>=1.12,
+    transformers,
+    transformers-except,
     typed-protocols:{typed-protocols, cborg} ^>=1.1,
 
   hs-source-dirs: src
@@ -123,12 +135,14 @@ executable dmq-node
     acts,
     aeson,
     base,
+    cardano-ledger-core,
     contra-tracer >=0.1 && <0.3,
     dmq-node,
     kes-agent-crypto,
     optparse-applicative,
     ouroboros-network,
     ouroboros-network-api,
+    ouroboros-network-framework,
     random,
 
   hs-source-dirs: app

dmq-node/src/DMQ/Configuration.hs

@@ -100,6 +100,7 @@ data Configuration' f =
     dmqcChurnInterval                              :: f DiffTime,
     dmqcPeerSharing                                :: f PeerSharing,
     dmqcNetworkMagic                               :: f NetworkMagic,
+    dmqcCardanoNodeSocket                          :: f FilePath,
     dmqcPrettyLog                                  :: f Bool,
 
     dmqcMuxTracer                                  :: f Bool,
@@ -196,6 +197,7 @@ defaultConfiguration = Configuration {
       dmqcTopologyFile                               = I "dmq.topology.json",
       dmqcAcceptedConnectionsLimit                   = I defaultAcceptedConnectionsLimit,
       dmqcDiffusionMode                              = I InitiatorAndResponderDiffusionMode,
+      dmqcCardanoNodeSocket                          = I "cardano-node.socket",
       dmqcTargetOfRootPeers                          = I targetNumberOfRootPeers,
       dmqcTargetOfKnownPeers                         = I targetNumberOfKnownPeers,
       dmqcTargetOfEstablishedPeers                   = I targetNumberOfEstablishedPeers,
@@ -271,6 +273,7 @@ instance FromJSON PartialConfig where
       dmqcNetworkMagic <- Last . fmap NetworkMagic <$> v .:? "NetworkMagic"
       dmqcDiffusionMode <- Last <$> v .:? "DiffusionMode"
       dmqcPeerSharing <- Last <$> v .:? "PeerSharing"
+      dmqcCardanoNodeSocket <- Last <$> v .:? "CardanoNodeSocket"
 
       dmqcTargetOfRootPeers                 <- Last <$> v .:? "TargetNumberOfRootPeers"
       dmqcTargetOfKnownPeers                <- Last <$> v .:? "TargetNumberOfKnownPeers"
@@ -324,6 +327,7 @@ instance FromJSON PartialConfig where
         Configuration
           { dmqcIPv4 = Last dmqcIPv4
           , dmqcIPv6 = Last dmqcIPv6
+          , dmqcCardanoNodeSocket
           , dmqcPortNumber
           , dmqcConfigFile = mempty
           , dmqcTopologyFile = mempty
@@ -384,6 +388,7 @@ instance ToJSON Configuration where
       dmqcIPv6,
       dmqcPortNumber,
       dmqcConfigFile,
+      dmqcCardanoNodeSocket,
       dmqcTopologyFile,
       dmqcAcceptedConnectionsLimit,
       dmqcDiffusionMode,
@@ -438,6 +443,7 @@ instance ToJSON Configuration where
            , "IPv6"                                       .= (show <$> unI dmqcIPv6)
            , "PortNumber"                                 .= unI dmqcPortNumber
            , "ConfigFile"                                 .= unI dmqcConfigFile
+           , "CardanoNodeSocket"                          .= unI dmqcCardanoNodeSocket
            , "TopologyFile"                               .= unI dmqcTopologyFile
            , "AcceptedConnectionsLimit"                   .= unI dmqcAcceptedConnectionsLimit
            , "DiffusionMode"                              .= unI dmqcDiffusionMode

dmq-node/src/DMQ/Configuration/CLIOptions.hs

@@ -46,13 +46,19 @@ parseCLIOptions =
           <> help "Topology file for DMQ Node"
           )
         )
+    <*> optional (
+          strOption
+          (   long "cardano-node-socket"
+          <> metavar "Cardano node socket path"
+          <> help "Used for local connections to Cardano node"
+          )
+        )
   where
-    mkConfiguration ipv4 ipv6 portNumber configFile topologyFile =
+    mkConfiguration ipv4 ipv6 portNumber configFile topologyFile cardanoNodeSocket =
       mempty { dmqcIPv4 = Last (Just <$> ipv4),
                dmqcIPv6 = Last (Just <$> ipv6),
                dmqcPortNumber = Last portNumber,
                dmqcConfigFile = Last configFile,
-               dmqcTopologyFile = Last topologyFile
+               dmqcTopologyFile = Last topologyFile,
+               dmqcCardanoNodeSocket = Last cardanoNodeSocket
              }
-
-