Update LedgerPeerSnapshot to contain block hash and network magic

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,

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/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 (Hash, Blake2b_256)
 import Cardano.Network.LedgerStateJudgement
 import Cardano.Network.PeerSelection.LocalRootPeers
            (OutboundConnectionsState (..))
+import Ouroboros.Network.BlockFetch.ConsensusInterface (FetchMode (..))
+import Ouroboros.Network.Block (SlotNo)
+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,20 @@ 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, pattern BlockPoint, SlotNo, atSlot, 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 (..))
+           (LedgerPeersConsensusInterface (..), LedgerPeerSnapshot (..), 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 +500,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 +528,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 +681,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/Simulation.hs

@@ -1244,6 +1244,7 @@ diffusionSimulation
                     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
@@ -4382,6 +4383,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`

cardano-ping/src/Cardano/Network/Ping.hs

@@ -154,6 +154,7 @@ supportedNodeToClientVersions magic =
   , NodeToClientVersionV20 magic
   , NodeToClientVersionV21 magic
   , NodeToClientVersionV22 magic
+  , NodeToClientVersionV23 magic
   ]
 
 data InitiatorOnly = InitiatorOnly | InitiatorAndResponder
@@ -193,6 +194,7 @@ data NodeVersion
   | NodeToClientVersionV20 Word32
   | NodeToClientVersionV21 Word32
   | NodeToClientVersionV22 Word32
+  | NodeToClientVersionV23 Word32
   | NodeToNodeVersionV1    Word32
   | NodeToNodeVersionV2    Word32
   | NodeToNodeVersionV3    Word32
@@ -226,6 +228,7 @@ instance ToJSON NodeVersion where
       NodeToClientVersionV20 m -> go2 "NodeToClientVersionV20" m
       NodeToClientVersionV21 m -> go2 "NodeToClientVersionV21" m
       NodeToClientVersionV22 m -> go2 "NodeToClientVersionV22" m
+      NodeToClientVersionV23 m -> go2 "NodeToClientVersionV23" m
       NodeToNodeVersionV1    m -> go2 "NodeToNodeVersionV1" m
       NodeToNodeVersionV2    m -> go2 "NodeToNodeVersionV2" m
       NodeToNodeVersionV3    m -> go2 "NodeToNodeVersionV3" m
@@ -377,6 +380,9 @@ handshakeReqEnc versions query =
     encodeVersion (NodeToClientVersionV22 magic) =
           CBOR.encodeWord (22 `setBit` nodeToClientVersionBit)
       <>  nodeToClientDataWithQuery magic
+    encodeVersion (NodeToClientVersionV23 magic) =
+          CBOR.encodeWord (23 `setBit` nodeToClientVersionBit)
+      <>  nodeToClientDataWithQuery magic
 
     -- node-to-node
     encodeVersion (NodeToNodeVersionV1 magic) =
@@ -528,6 +534,7 @@ handshakeDec = do
         (20, True)  -> Right . NodeToClientVersionV20 <$> (CBOR.decodeListLen *> CBOR.decodeWord32 <* (modeFromBool <$> CBOR.decodeBool))
         (21, True)  -> Right . NodeToClientVersionV21 <$> (CBOR.decodeListLen *> CBOR.decodeWord32 <* (modeFromBool <$> CBOR.decodeBool))
         (22, True)  -> Right . NodeToClientVersionV22 <$> (CBOR.decodeListLen *> CBOR.decodeWord32 <* (modeFromBool <$> CBOR.decodeBool))
+        (23, True)  -> Right . NodeToClientVersionV23 <$> (CBOR.decodeListLen *> CBOR.decodeWord32 <* (modeFromBool <$> CBOR.decodeBool))
         _           -> return $ Left $ UnknownVersionInRsp version
 
     decodeWithMode :: (Word32 -> InitiatorOnly -> NodeVersion) -> CBOR.Decoder s (Either HandshakeFailure NodeVersion)
@@ -853,6 +860,7 @@ isSameVersionAndMagic v1 v2 = extract v1 == extract v2
         extract (NodeToClientVersionV20 m) = (-20, m)
         extract (NodeToClientVersionV21 m) = (-21, m)
         extract (NodeToClientVersionV22 m) = (-22, m)
+        extract (NodeToClientVersionV23 m) = (-23, m)
         extract (NodeToNodeVersionV1 m)    = (1, m)
         extract (NodeToNodeVersionV2 m)    = (2, m)
         extract (NodeToNodeVersionV3 m)    = (3, m)

dmq-node/changelog.d/20251030_162643_crocodile-dentist_ledgerpeersnapshot_hash.md

@@ -0,0 +1,17 @@
+<!--
+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
+
+- A bullet item for the Breaking category.
+
+-->
+
+### Non-Breaking
+
+- update to new LedgerPeerSnapshot definition

dmq-node/src/DMQ/Configuration.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds                  #-}
 {-# LANGUAGE DeriveGeneric              #-}
 {-# LANGUAGE DerivingVia                #-}
 {-# LANGUAGE FlexibleContexts           #-}
@@ -69,7 +70,7 @@ import Ouroboros.Network.OrphanInstances ()
 import Ouroboros.Network.PeerSelection.Governor.Types
            (PeerSelectionTargets (..), makePublicPeerSelectionStateVar)
 import Ouroboros.Network.PeerSelection.LedgerPeers.Type
-           (LedgerPeerSnapshot (..))
+           (LedgerPeerSnapshot (..), LedgerPeersKind (..))
 import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing (..))
 import Ouroboros.Network.Server.RateLimiting (AcceptedConnectionsLimit (..))
 import Ouroboros.Network.Snocket (LocalAddress (..), RemoteAddress)
@@ -569,8 +570,8 @@ mkDiffusionConfiguration
     updateLedgerPeerSnapshot :: HasCallStack
                              => FilePath
                              -> STM IO (Maybe FilePath)
-                             -> (Maybe LedgerPeerSnapshot -> STM IO ())
-                             -> IO (Maybe LedgerPeerSnapshot)
+                             -> (Maybe (LedgerPeerSnapshot BigLedgerPeers) -> STM IO ())
+                             -> IO (Maybe (LedgerPeerSnapshot BigLedgerPeers))
     updateLedgerPeerSnapshot topologyDir readLedgerPeerPath writeVar = do
       mPeerSnapshotFile <- atomically readLedgerPeerPath
       mLedgerPeerSnapshot <- case mPeerSnapshotFile of
@@ -604,5 +605,3 @@ data ConfigurationError =
 
 instance Exception ConfigurationError where
   displayException NoAddressInformation = "no ipv4 or ipv6 address specified, use --host-addr or --host-ipv6-addr"
-
-

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

@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds         #-}
 {-# LANGUAGE DeriveGeneric     #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE NamedFieldPuns    #-}
@@ -16,7 +17,7 @@ import Data.Text qualified as Text
 import Ouroboros.Network.Diffusion.Topology (NetworkTopology (..))
 import Ouroboros.Network.OrphanInstances (localRootPeersGroupsFromJSON,
            networkTopologyFromJSON, networkTopologyToJSON)
-import Ouroboros.Network.PeerSelection.LedgerPeers.Type (LedgerPeerSnapshot)
+import Ouroboros.Network.PeerSelection.LedgerPeers.Type (LedgerPeerSnapshot, LedgerPeersKind (..))
 import System.Exit (die)
 
 data NoExtraConfig = NoExtraConfig
@@ -69,7 +70,7 @@ readTopologyFileOrError nc =
   >>= either (die . Text.unpack)
              pure
 
-readPeerSnapshotFile :: FilePath -> IO (Either Text LedgerPeerSnapshot)
+readPeerSnapshotFile :: FilePath -> IO (Either Text (LedgerPeerSnapshot BigLedgerPeers))
 readPeerSnapshotFile psf = do
   eBs <- try $ BS.readFile psf
   case eBs of
@@ -89,7 +90,7 @@ readPeerSnapshotFile psf = do
       , Text.pack err
       ]
 
-readPeerSnapshotFileOrError :: FilePath -> IO LedgerPeerSnapshot
+readPeerSnapshotFileOrError :: FilePath -> IO (LedgerPeerSnapshot BigLedgerPeers)
 readPeerSnapshotFileOrError psf =
       readPeerSnapshotFile psf
   >>= either (die . Text.unpack)

ouroboros-network/api/lib/Ouroboros/Network/Block.hs

@@ -79,6 +79,7 @@ import Codec.CBOR.Read qualified as Read
 import Codec.CBOR.Write qualified as Write
 import Codec.Serialise (Serialise (..))
 import Control.Monad (when)
+import Data.Aeson (FromJSON, ToJSON)
 import Data.ByteString.Base16.Lazy qualified as B16
 import Data.ByteString.Lazy qualified as Lazy
 import Data.ByteString.Lazy.Char8 qualified as BSC
@@ -216,6 +217,8 @@ deriving newtype instance StandardHash block => Ord      (Point block)
 deriving via (Quiet (Point block))
                  instance StandardHash block => Show     (Point block)
 deriving newtype instance StandardHash block => NoThunks (Point block)
+deriving newtype instance ToJSON (Point.Block SlotNo (HeaderHash block)) => ToJSON (Point block)
+deriving newtype instance FromJSON (Point.Block SlotNo (HeaderHash block)) => FromJSON (Point block)
 
 instance ShowProxy block => ShowProxy (Point block) where
     showProxy _ = "Point " ++ showProxy (Proxy :: Proxy block)