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: sha256-Kww2GEqi+GbjmKVIhMADazpUddOBuXqQCiR58WkMj10=
+  subdir: typed-protocols
+
 -- 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: sha256-slF7zuBy2DKWKlQfhBPW5FDRhueWrFcJkrHW4jEEELs=
+  subdir:
+    kes-agent
+    kes-agent-crypto
+
+source-repository-package
+  type: git
+  location: https://github.com/IntersectMBO/ouroboros-consensus
+  tag: 97137fb0484454f0cd208c55bfee278f7561e9ed
+  --sha256: sha256-T56Axhx/dk7D9s+LOi+NhY+Tb5n7H99OfUjUE5hPxtQ=
+  subdir:
+    ouroboros-consensus-cardano
+    ouroboros-consensus-diffusion
+    sop-extras
+    ouroboros-consensus-protocol
+    ouroboros-consensus

cardano-diffusion/api/lib/Cardano/Network/NodeToClient/Version.hs

@@ -56,8 +56,13 @@ data NodeToClientVersion
     -- ^ new codecs for @PParams@ and @CompactGenesis@
     | NodeToClientV_22
     -- ^ support SRV records in @GetBigLedgerPeerSnapshot@ query
+    -- TODO: remove CBOR instances from LedgerPeers.Type when V22 support
+    --       is removed, update {To,From}JSON LedgerPeerSnapshot instances
+    --       and update LedgerPeerSnapshot query encoding in consensus.
+    --       marked with TODO's.
     | NodeToClientV_23
     -- ^ added @QueryDRepsDelegations@,
+    -- LedgerPeerSnapshot CBOR encoding contains block hash and NetworkMagic
   deriving (Eq, Ord, Enum, Bounded, Show, Generic, NFData)
 
 -- | We set 16ths bit to distinguish `NodeToNodeVersion` and

cardano-diffusion/cardano-diffusion.cabal

@@ -151,6 +151,7 @@ library
     aeson,
     base >=4.14 && <4.22,
     bytestring,
+    cardano-crypto-class,
     cardano-diffusion:{api, protocols},
     containers,
     contra-tracer,
@@ -430,10 +431,13 @@ test-suite protocols-bench
 
 library cardano-diffusion-tests-lib
   import: ghc-options-tests
+  mixins:
+    QuickCheck hiding (Test.QuickCheck.Monoids)
+
   visibility: public
   hs-source-dirs: tests/lib
   build-depends:
-    QuickCheck >=2.16,
+    QuickCheck,
     aeson,
     base >=4.14 && <4.22,
     bytestring,
@@ -453,6 +457,7 @@ library cardano-diffusion-tests-lib
     pipes,
     pretty-simple,
     psqueues,
+    quickcheck-monoids,
     random,
     serialise,
     tasty,

cardano-diffusion/changelog.d/20251028_162450_crocodile-dentist_ledgerpeersnapshot_hash.md

@@ -0,0 +1,16 @@
+<!--
+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
+
+cardano-diffusion:
+- added `lpGetBlockInfo` to `LedgerPeersConsensusInterface`
+
+### Non-Breaking
+
+cardano-diffusion:
+- moved `jobVerifyPeerSnapshot` from o-n

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/lib/Cardano/Network/LedgerPeerConsensusInterface.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE RankNTypes #-}
+
 module Cardano.Network.LedgerPeerConsensusInterface
   ( LedgerPeersConsensusInterface (..)
     -- * Re-exports
@@ -8,11 +10,14 @@ module Cardano.Network.LedgerPeerConsensusInterface
 
 import Control.Concurrent.Class.MonadSTM (MonadSTM (..))
 
-import Ouroboros.Network.BlockFetch.ConsensusInterface (FetchMode (..))
-
+import Cardano.Crypto.Hash (Blake2b_256, Hash)
 import Cardano.Network.LedgerStateJudgement
 import Cardano.Network.PeerSelection.LocalRootPeers
            (OutboundConnectionsState (..))
+import Ouroboros.Network.Block (SlotNo)
+import Ouroboros.Network.BlockFetch.ConsensusInterface (FetchMode (..))
+import Ouroboros.Network.Point (Block)
+
 
 -- | Cardano Node specific consensus interface actions.
 --
@@ -31,4 +36,6 @@ data LedgerPeersConsensusInterface m =
     -- it only has local peers.
     --
   , updateOutboundConnectionsState :: OutboundConnectionsState -> STM m ()
+
+  , getBlockHash   :: forall a. SlotNo -> STM m (Block SlotNo (Hash Blake2b_256 a))
   }

cardano-diffusion/lib/Cardano/Network/PeerSelection/Governor/Monitor.hs

@@ -1,6 +1,10 @@
-{-# LANGUAGE LambdaCase          #-}
-{-# LANGUAGE NamedFieldPuns      #-}
-{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE DataKinds                #-}
+{-# LANGUAGE DisambiguateRecordFields #-}
+{-# LANGUAGE GADTs                    #-}
+{-# LANGUAGE LambdaCase               #-}
+{-# LANGUAGE NamedFieldPuns           #-}
+{-# LANGUAGE PatternSynonyms          #-}
+{-# LANGUAGE ScopedTypeVariables      #-}
 
 -- | This module contains governor decisions for monitoring tasks:
 --
@@ -18,14 +22,18 @@ module Cardano.Network.PeerSelection.Governor.Monitor
   , ExtraTrace (..)
   ) where
 
-import Data.Set qualified as Set
-
+import Control.Concurrent.JobPool (Job (..))
+import Control.Exception (assert)
 import Control.Monad.Class.MonadSTM
 import Control.Monad.Class.MonadTime.SI
 import Control.Monad.Class.MonadTimer.SI
+import Data.Map.Strict (Map)
+import Data.Map.Strict qualified as Map
+import Data.Set (Set)
+import Data.Set qualified as Set
 
+import Cardano.Crypto.Hash as Crypto (castHash)
 import Cardano.Network.ConsensusMode
-import Cardano.Network.Diffusion.Configuration qualified as Cardano (srvPrefix)
 import Cardano.Network.LedgerPeerConsensusInterface qualified as Cardano
 import Cardano.Network.LedgerStateJudgement
 import Cardano.Network.PeerSelection.Bootstrap (UseBootstrapPeers (..),
@@ -37,23 +45,22 @@ import Cardano.Network.PeerSelection.Governor.PeerSelectionState qualified as Ca
 import Cardano.Network.PeerSelection.PeerTrustable (PeerTrustable (..))
 import Cardano.Network.PeerSelection.PublicRootPeers qualified as Cardano.PublicRootPeers
 import Cardano.Network.PeerSelection.State.LocalRootPeers qualified as LocalRootPeers
-import Control.Exception (assert)
-import Data.Map.Strict (Map)
-import Data.Map.Strict qualified as Map
-import Data.Set (Set)
+import Ouroboros.Network.Block (HeaderHash, SlotNo, atSlot, pattern BlockPoint,
+           withHash)
 import Ouroboros.Network.PeerSelection.Governor.ActivePeers
            (jobDemoteActivePeer)
-import Ouroboros.Network.PeerSelection.Governor.Monitor (jobVerifyPeerSnapshot)
 import Ouroboros.Network.PeerSelection.Governor.Types hiding
            (PeerSelectionCounters)
 import Ouroboros.Network.PeerSelection.LedgerPeers.Type
-           (LedgerPeersConsensusInterface (..))
+           (LedgerPeerSnapshot (..), LedgerPeersConsensusInterface (..),
+           LedgerPeersKind (..))
 import Ouroboros.Network.PeerSelection.PublicRootPeers qualified as PublicRootPeers
 import Ouroboros.Network.PeerSelection.State.EstablishedPeers qualified as EstablishedPeers
 import Ouroboros.Network.PeerSelection.State.KnownPeers qualified as KnownPeers
 import Ouroboros.Network.PeerSelection.State.LocalRootPeers
            (LocalRootConfig (..))
 import Ouroboros.Network.PeerSelection.Types
+import Ouroboros.Network.Point (Block (..))
 
 
 -- | Used to set 'bootstrapPeersTimeout' for crashing the node in a critical
@@ -495,8 +502,8 @@ monitorLedgerStateJudgement
             (TimedDecision m Cardano.ExtraState extraDebugState extraFlags
                              (Cardano.ExtraPeers peeraddr) ExtraTrace peeraddr peerconn)
 monitorLedgerStateJudgement PeerSelectionActions{
-                              getLedgerStateCtx = ledgerCtx@LedgerPeersConsensusInterface {
-                                lpExtraAPI = Cardano.LedgerPeersConsensusInterface {
+                              getLedgerStateCtx = LedgerPeersConsensusInterface {
+                                lpExtraAPI = lpExtraAPI@Cardano.LedgerPeersConsensusInterface {
                                   Cardano.getLedgerStateJudgement = readLedgerStateJudgement
                                 }
                               }
@@ -523,8 +530,9 @@ monitorLedgerStateJudgement PeerSelectionActions{
         Decision {
           decisionTrace = [ExtraTrace (TraceLedgerStateJudgementChanged lsj)],
           decisionJobs = case (lsj, ledgerPeerSnapshot) of
-                           (TooOld, Just ledgerPeerSnapshot') ->
-                             [jobVerifyPeerSnapshot Cardano.srvPrefix ledgerPeerSnapshot' ledgerCtx]
+                           (TooOld, Just (LedgerBigPeerSnapshotV23 point _magic _pools))
+                             | BlockPoint { atSlot, withHash } <- point ->
+                                 [jobVerifyPeerSnapshot (atSlot, withHash) lpExtraAPI]
                            _otherwise -> [],
           decisionState = st {
             extraState = cpst {
@@ -675,6 +683,35 @@ waitForSystemToQuiesce st@PeerSelectionState{
   | otherwise = GuardedSkip Nothing
 
 
+-- |This job, which is initiated by monitorLedgerStateJudgement job,
+-- verifies whether the provided big ledger pools match up with the
+-- ledger state once the node catches up to the slot at which the
+-- snapshot was ostensibly taken
+--
+jobVerifyPeerSnapshot :: (MonadSTM m)
+                      => (SlotNo, HeaderHash (LedgerPeerSnapshot BigLedgerPeers))
+                      -> Cardano.LedgerPeersConsensusInterface m
+                      -> Job () m (Completion m extraState extraDebugState extraFlags extraPeers extraTrace peeraddr peerconn)
+jobVerifyPeerSnapshot (slotNo, theHash)
+                      Cardano.LedgerPeersConsensusInterface { getBlockHash }
+  = Job job (const (completion False)) () "jobVerifyPeerSnapshot"
+  where
+    completion result = return . Completion $ \st _now ->
+      Decision {
+        decisionTrace = [TraceVerifyPeerSnapshot result],
+        decisionState = st,
+        decisionJobs  = [] }
+
+    job = do
+      Block { blockPointHash } <- atomically $ getBlockHash slotNo
+      let result = theHash == Crypto.castHash blockPointHash
+      return . Completion $ \st _now ->
+            Decision {
+              decisionTrace = [TraceVerifyPeerSnapshot result],
+              decisionState = st,
+              decisionJobs  = [] }
+
+
 -- | Extra trace points for `TracePeerSelection`.
 --
 -- TODO: it ought to be moved to `Types`, but that introduces a circular

cardano-diffusion/protocols/cddl/specs/handshake-node-to-client.cddl

@@ -19,7 +19,7 @@ versionTable = { * versionNumber => nodeToClientVersionData }
 
 
 ; as of version 2 (which is no longer supported) we set 16th bit to 1
-;               16    / 17    / 18    / 19    / 20    / 21    / 22     / 23
+;               16    / 17    / 18    / 19    / 20    / 21    / 22    / 23
 versionNumber = 32784 / 32785 / 32786 / 32787 / 32788 / 32789 / 32790 / 32791
 
 ; As of version 15 and higher

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    #-}
@@ -106,6 +107,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/Simulation.hs

@@ -1245,6 +1245,7 @@ diffusionSimulationM
                     Cardano.LedgerPeersConsensusInterface {
                       Cardano.readFetchMode = pure (PraosFetchMode FetchModeDeadline)
                     , Cardano.getLedgerStateJudgement = pure TooOld
+                    , Cardano.getBlockHash = const retry
                     , Cardano.updateOutboundConnectionsState =
                         \a -> do
                           a' <- readTVar onlyOutboundConnectionsStateVar

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

@@ -69,6 +69,7 @@ import Ouroboros.Network.PeerSelection.State.KnownPeers qualified as KnownPeers
 import Ouroboros.Network.PeerSelection.State.LocalRootPeers
            (LocalRootPeers (..))
 import Ouroboros.Network.Point
+import Ouroboros.Network.Socket ()
 
 import Test.Cardano.Network.PeerSelection.MockEnvironment hiding (tests)
 import Test.Cardano.Network.PeerSelection.Utils
@@ -93,6 +94,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
@@ -4382,6 +4384,7 @@ _governorFindingPublicRoots targetNumberOfRootPeers readDomains readUseBootstrap
                     lpExtraAPI = Cardano.LedgerPeersConsensusInterface {
                       readFetchMode = pure (PraosFetchMode FetchModeDeadline),
                       getLedgerStateJudgement = readLedgerStateJudgement,
+                      getBlockHash = const retry,
                       updateOutboundConnectionsState = \a -> do
                         a' <- readTVar olocVar
                         when (a /= a') $

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

@@ -485,6 +485,7 @@ mockPeerSelectionActions' tracer
           lpExtraAPI = Cardano.LedgerPeersConsensusInterface {
             readFetchMode = pure (PraosFetchMode FetchModeDeadline),
             getLedgerStateJudgement = readLedgerStateJudgement,
+            getBlockHash = const retry,
             updateOutboundConnectionsState = \a -> do
               a' <- readTVar outboundConnectionsStateVar
               when (a /= a') $

cardano-ping/changelog.d/20251028_162800_crocodile-dentist_ledgerpeersnapshot_hash.md

@@ -0,0 +1,11 @@
+<!--
+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
+
+- Added `NodeToClientVersionV23`