Do not use GetCBOR for LedgerPeerSnapshot

cabal.project

@@ -13,8 +13,8 @@ repository cardano-haskell-packages
 -- See CONTRIBUTING for information about these, including some Nix commands
 -- you need to run if you change them
 index-state:
-  , hackage.haskell.org 2025-06-22T20:18:27Z
-  , cardano-haskell-packages 2025-06-20T09:11:51Z
+  , hackage.haskell.org 2025-07-22T09:13:54Z
+  , cardano-haskell-packages 2025-07-28T14:33:19Z
 
 packages:
     cardano-api
@@ -61,6 +61,50 @@ if impl (ghc >= 9.12)
     -- https://github.com/kapralVV/Unique/issues/11
     , Unique:hashable
 
+source-repository-package
+  type: git
+  location: https://github.com/IntersectMBO/ouroboros-consensus
+  tag: 15fc8c4fee64473350e1904347bfd5852f9cdbfa
+  --sha256: sha256-Tvw0dLGZkBAflpvcEwl7Acnrux9H5UaniW5YwMvIeIs=
+  subdir:
+    ouroboros-consensus
+    ouroboros-consensus-cardano
+    ouroboros-consensus-diffusion
+    ouroboros-consensus-protocol
+    sop-extras
+    strict-sop-core 
+
+source-repository-package
+  type: git
+  location: https://github.com/IntersectMBO/cardano-ledger
+  tag: 20485948f78ab139d246695e540f9ec00963a16e
+  --sha256: sha256-SHnyp+GvNeR82UXoKeDEgsp1AUE2yF5dGL4HIZm0zK8=
+  subdir:
+    eras/allegra/impl
+    eras/alonzo/impl
+    eras/alonzo/test-suite
+    eras/babbage/impl
+    eras/babbage/test-suite
+    eras/byron/chain/executable-spec
+    eras/byron/crypto
+    eras/byron/ledger/executable-spec
+    eras/byron/ledger/impl
+    eras/conway/impl
+    eras/dijkstra
+    eras/mary/impl
+    eras/shelley/impl
+    eras/shelley-ma/test-suite
+    eras/shelley/test-suite
+    libs/cardano-data
+    libs/cardano-ledger-api
+    libs/cardano-ledger-binary
+    libs/cardano-ledger-core
+    libs/cardano-protocol-tpraos
+    libs/non-integral
+    libs/set-algebra
+    libs/small-steps
+    libs/vector-map
+
 -- WASM compilation specific
 
 if arch(wasm32)
@@ -161,3 +205,9 @@ if arch(wasm32)
 -- Do NOT add more source-repository-package stanzas here unless they are strictly
 -- temporary! Please read the section in CONTRIBUTING about updating dependencies.
 
+allow-newer:
+    , cardano-ledger-byron
+    -- https://github.com/phadej/vec/issues/121
+    , ral:QuickCheck
+    , fin:QuickCheck
+    , bin:QuickCheck

cardano-api/cardano-api.cabal

@@ -128,9 +128,10 @@ library
     cardano-ledger-api >=1.11,
     cardano-ledger-babbage >=1.11,
     cardano-ledger-binary >=1.6,
-    cardano-ledger-byron >=1.1,
+    cardano-ledger-byron >=1.2,
     cardano-ledger-conway >=1.19,
     cardano-ledger-core:{cardano-ledger-core, testlib} >=1.17,
+    cardano-ledger-dijkstra >= 0.1,
     cardano-ledger-mary >=1.8,
     cardano-ledger-shelley >=1.16,
     cardano-protocol-tpraos >=1.4,
@@ -168,7 +169,7 @@ library
     ouroboros-network-framework,
     ouroboros-network-protocols >=0.14,
     parsec,
-    plutus-ledger-api:{plutus-ledger-api, plutus-ledger-api-testlib} ^>=1.45,
+    plutus-ledger-api:{plutus-ledger-api, plutus-ledger-api-testlib} ^>=1.50,
     pretty-simple,
     prettyprinter,
     prettyprinter-ansi-terminal,
@@ -186,7 +187,7 @@ library
     time,
     transformers,
     transformers-except ^>=0.1.3,
-    typed-protocols ^>=0.3,
+    typed-protocols ^>= 1,
     vector,
     yaml,
 
@@ -295,6 +296,7 @@ library gen
     Test.Gen.Cardano.Api.Era
     Test.Gen.Cardano.Api.Hardcoded
     Test.Gen.Cardano.Api.Metadata
+    Test.Gen.Cardano.Api.Orphans
     Test.Gen.Cardano.Api.ProtocolParameters
     Test.Gen.Cardano.Api.Typed
     Test.Gen.Cardano.Crypto.Seed
@@ -315,9 +317,11 @@ library gen
     cardano-ledger-byron-test >=1.5,
     cardano-ledger-conway:testlib,
     cardano-ledger-core:{cardano-ledger-core, testlib} >=1.14,
+    cardano-ledger-dijkstra >=0.1,
     cardano-ledger-shelley >=1.13,
     containers,
     filepath,
+    generic-random,
     hedgehog >=1.1,
     hedgehog-extras,
     hedgehog-quickcheck,
@@ -428,7 +432,7 @@ test-suite cardano-api-golden
     hedgehog >=1.1,
     hedgehog-extras ^>=0.8,
     microlens,
-    plutus-core ^>=1.45,
+    plutus-core ^>=1.50,
     plutus-ledger-api,
     tasty,
     tasty-discover,

cardano-api/gen/Test/Gen/Cardano/Api/Era.hs

@@ -17,6 +17,8 @@ import Cardano.Ledger.Core qualified as Ledger
 
 import Data.Functor.Identity qualified as Ledger
 
+import Test.Gen.Cardano.Api.Orphans ()
+
 import Test.Cardano.Ledger.Conway.Arbitrary ()
 import Test.Cardano.Ledger.Core.Arbitrary ()
 
@@ -39,6 +41,7 @@ shelleyBasedEraTestConstraints = \case
   ShelleyBasedEraAlonzo -> id
   ShelleyBasedEraBabbage -> id
   ShelleyBasedEraConway -> id
+  ShelleyBasedEraDijkstra -> id
 
 shelleyToBabbageEraTestConstraints
   :: ()
@@ -69,3 +72,4 @@ conwayEraOnwardsTestConstraints
   -> a
 conwayEraOnwardsTestConstraints = \case
   ConwayEraOnwardsConway -> id
+  ConwayEraOnwardsDijkstra -> id

cardano-api/gen/Test/Gen/Cardano/Api/Orphans.hs

@@ -0,0 +1,24 @@
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+module Test.Gen.Cardano.Api.Orphans
+  ( 
+  )
+where
+
+import Cardano.Ledger.BaseTypes (StrictMaybe)
+import Cardano.Ledger.Dijkstra (DijkstraEra)
+import Cardano.Ledger.Dijkstra.PParams (DijkstraPParams)
+
+import Data.Functor.Identity (Identity)
+import Generic.Random (genericArbitraryU)
+import Test.Cardano.Ledger.Common (Arbitrary (..))
+import Test.Cardano.Ledger.Conway.Arbitrary ()
+
+
+instance Arbitrary (DijkstraPParams Identity DijkstraEra) where
+  arbitrary = genericArbitraryU
+
+instance Arbitrary (DijkstraPParams StrictMaybe DijkstraEra) where
+  arbitrary = genericArbitraryU

cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs

@@ -296,6 +296,9 @@ genPlutusScript l =
     PlutusScriptV3 -> do
       PlutusScript _ s <- genPlutusV3Script
       return s
+    PlutusScriptV4 -> do
+      PlutusScript _ s <- genPlutusV4Script
+      return s
 
 genValidPlutusScript :: PlutusScriptVersion lang -> Gen (PlutusScript lang)
 genValidPlutusScript l =
@@ -309,6 +312,9 @@ genValidPlutusScript l =
     PlutusScriptV3 -> do
       PlutusScript _ s <- genValidPlutusV3Script
       return s
+    PlutusScriptV4 -> do
+      PlutusScript _ s <- genValidPlutusV4Script
+      return s
 
 genPlutusV1Script :: Gen (Script PlutusScriptV1)
 genPlutusV1Script = do
@@ -341,13 +347,29 @@ genPlutusV3Script = do
   let v3ScriptBytes = Base16.decodeLenient v3AlwaysSucceedsPlutusScriptHex
   return . PlutusScript PlutusScriptV3 . PlutusScriptSerialised $ SBS.toShort v3ScriptBytes
 
+-- TODO: This is not generating v4 scripts.
+genPlutusV4Script :: Gen (Script PlutusScriptV4)
+genPlutusV4Script = do
+  v3AlwaysSucceedsPlutusScriptHex <-
+    Gen.element [v3AlwaysSucceedsPlutusScriptDoubleEncoded, v3AlwaysSucceedsPlutusScript]
+  let v3ScriptBytes = Base16.decodeLenient v3AlwaysSucceedsPlutusScriptHex
+  return . PlutusScript PlutusScriptV4 . PlutusScriptSerialised $ SBS.toShort v3ScriptBytes
+
 genValidPlutusV3Script :: Gen (Script PlutusScriptV3)
 genValidPlutusV3Script = do
   v3AlwaysSucceedsPlutusScriptHex <-
     Gen.element [v3AlwaysSucceedsPlutusScript]
   let v3ScriptBytes = Base16.decodeLenient v3AlwaysSucceedsPlutusScriptHex
   return . PlutusScript PlutusScriptV3 . PlutusScriptSerialised $ SBS.toShort v3ScriptBytes
 
+-- TODO: This is not generating v4 scripts.
+genValidPlutusV4Script :: Gen (Script PlutusScriptV4)
+genValidPlutusV4Script = do
+  v3AlwaysSucceedsPlutusScriptHex <-
+    Gen.element [v3AlwaysSucceedsPlutusScript]
+  let v3ScriptBytes = Base16.decodeLenient v3AlwaysSucceedsPlutusScriptHex
+  return . PlutusScript PlutusScriptV4 . PlutusScriptSerialised $ SBS.toShort v3ScriptBytes
+
 genScriptDataSchema :: Gen ScriptDataJsonSchema
 genScriptDataSchema = Gen.element [ScriptDataJsonNoSchema, ScriptDataJsonDetailedSchema]
 
@@ -1327,6 +1349,13 @@ genTxOutDatumHashTxContext era = case era of
       , TxOutSupplementalDatum AlonzoEraOnwardsConway <$> genHashableScriptData
       , TxOutDatumInline BabbageEraOnwardsConway <$> genHashableScriptData
       ]
+  ShelleyBasedEraDijkstra ->
+    Gen.choice
+      [ pure TxOutDatumNone
+      , TxOutDatumHash AlonzoEraOnwardsDijkstra <$> genHashScriptData
+      , TxOutSupplementalDatum AlonzoEraOnwardsDijkstra <$> genHashableScriptData
+      , TxOutDatumInline BabbageEraOnwardsDijkstra <$> genHashableScriptData
+      ]
 
 genTxOutDatumHashUTxOContext :: ShelleyBasedEra era -> Gen (TxOutDatum CtxUTxO era)
 genTxOutDatumHashUTxOContext era = case era of
@@ -1350,6 +1379,12 @@ genTxOutDatumHashUTxOContext era = case era of
       , TxOutDatumHash AlonzoEraOnwardsConway <$> genHashScriptData
       , TxOutDatumInline BabbageEraOnwardsConway <$> genHashableScriptData
       ]
+  ShelleyBasedEraDijkstra ->
+    Gen.choice
+      [ pure TxOutDatumNone
+      , TxOutDatumHash AlonzoEraOnwardsDijkstra <$> genHashScriptData
+      , TxOutDatumInline BabbageEraOnwardsDijkstra <$> genHashableScriptData
+      ]
 
 mkDummyHash :: forall h a. CRYPTO.HashAlgorithm h => Int -> CRYPTO.Hash h a
 mkDummyHash = coerce . CRYPTO.hashWithSerialiser @h CBOR.toCBOR

cardano-api/src/Cardano/Api/Block.hs

@@ -72,7 +72,6 @@ import Ouroboros.Consensus.Byron.Ledger qualified as Consensus
 import Ouroboros.Consensus.Cardano.Block qualified as Consensus
 import Ouroboros.Consensus.HardFork.Combinator qualified as Consensus
 import Ouroboros.Consensus.Shelley.Ledger qualified as Consensus
-import Ouroboros.Consensus.Shelley.Protocol.Abstract qualified as Consensus
 import Ouroboros.Network.Block qualified as Consensus
 
 import Data.Aeson (FromJSON (..), ToJSON (..), Value (..), object, withObject, (.:), (.=))
@@ -153,6 +152,12 @@ instance Show (Block era) where
       ( showString "ShelleyBlock ShelleyBasedEraConway "
           . showsPrec 11 block
       )
+  showsPrec p (ShelleyBlock ShelleyBasedEraDijkstra block) =
+    showParen
+      (p >= 11)
+      ( showString "ShelleyBlock ShelleyBasedEraDijkstra "
+          . showsPrec 11 block
+      )
 
 getBlockTxs :: forall era. Block era -> [Tx era]
 getBlockTxs = \case
@@ -167,7 +172,6 @@ getShelleyBlockTxs
   :: forall era ledgerera blockheader
    . ShelleyLedgerEra era ~ ledgerera
   => Consensus.ShelleyCompatible (ConsensusProtocol era) ledgerera
-  => Consensus.ShelleyProtocolHeader (ConsensusProtocol era) ~ blockheader
   => ShelleyBasedEra era
   -> Ledger.Block blockheader ledgerera
   -> [Tx era]
@@ -203,6 +207,7 @@ fromConsensusBlock = \case
   Consensus.BlockAlonzo b' -> BlockInMode cardanoEra $ ShelleyBlock ShelleyBasedEraAlonzo b'
   Consensus.BlockBabbage b' -> BlockInMode cardanoEra $ ShelleyBlock ShelleyBasedEraBabbage b'
   Consensus.BlockConway b' -> BlockInMode cardanoEra $ ShelleyBlock ShelleyBasedEraConway b'
+  Consensus.BlockDijkstra b' -> BlockInMode cardanoEra $ ShelleyBlock ShelleyBasedEraDijkstra b'
 
 toConsensusBlock
   :: ()
@@ -217,6 +222,7 @@ toConsensusBlock = \case
   BlockInMode _ (ShelleyBlock ShelleyBasedEraAlonzo b') -> Consensus.BlockAlonzo b'
   BlockInMode _ (ShelleyBlock ShelleyBasedEraBabbage b') -> Consensus.BlockBabbage b'
   BlockInMode _ (ShelleyBlock ShelleyBasedEraConway b') -> Consensus.BlockConway b'
+  BlockInMode _ (ShelleyBlock ShelleyBasedEraDijkstra b') -> Consensus.BlockDijkstra b'
 
 -- ----------------------------------------------------------------------------
 -- Block headers

cardano-api/src/Cardano/Api/Certificate/Internal.hs

@@ -234,6 +234,7 @@ certificateToTxCert c =
     ConwayCertificate eon cert ->
       case eon of
         ConwayEraOnwardsConway -> cert
+        ConwayEraOnwardsDijkstra -> cert
 
 -- ----------------------------------------------------------------------------
 -- Stake pool parameters
@@ -576,6 +577,7 @@ filterUnRegCreds =
         Ledger.RetirePoolTxCert _ _ -> Nothing
         Ledger.MirTxCert _ -> Nothing
         Ledger.GenesisDelegTxCert{} -> Nothing
+        _ -> error "dijkstra"
     ConwayCertificate cEra conwayCert -> conwayEraOnwardsConstraints cEra $
       case conwayCert of
         Ledger.RegPoolTxCert _ -> Nothing
@@ -593,6 +595,7 @@ filterUnRegCreds =
         Ledger.RegTxCert _ -> Nothing
         -- stake cred deregistration w/o deposit
         Ledger.UnRegTxCert cred -> Just cred
+        _ -> error "dijkstra"
 
 filterUnRegDRepCreds
   :: Certificate era -> Maybe (Ledger.Credential Ledger.DRepRole)
@@ -615,6 +618,7 @@ filterUnRegDRepCreds = \case
       Ledger.RegTxCert _ -> Nothing
       -- stake cred deregistration w/o deposit
       Ledger.UnRegTxCert _ -> Nothing
+      _ -> error "dijkstra"
 
 -- ----------------------------------------------------------------------------
 -- Internal conversion functions
@@ -803,6 +807,7 @@ getAnchorDataFromCertificate c =
           Ledger.RetirePoolTxCert _ _ -> return Nothing
           Ledger.GenesisDelegTxCert{} -> return Nothing
           Ledger.MirTxCert _ -> return Nothing
+          _ -> error "dijkstra"
     ConwayCertificate ceo ccert ->
       conwayEraOnwardsConstraints ceo $
         case ccert of
@@ -819,6 +824,7 @@ getAnchorDataFromCertificate c =
           Ledger.UpdateDRepTxCert _ mAnchor -> return $ Ledger.strictMaybeToMaybe mAnchor
           Ledger.AuthCommitteeHotKeyTxCert _ _ -> return Nothing
           Ledger.ResignCommitteeColdTxCert _ mAnchor -> return $ Ledger.strictMaybeToMaybe mAnchor
+          _ -> error "dijkstra"
  where
   anchorDataFromPoolMetadata
     :: MonadError AnchorDataFromCertificateError m

cardano-api/src/Cardano/Api/Consensus/Internal/InMode.hs

@@ -100,6 +100,9 @@ fromConsensusGenTx = \case
   Consensus.HardForkGenTx (Consensus.OneEraGenTx (S (S (S (S (S (S (Z tx')))))))) ->
     let Consensus.ShelleyTx _txid shelleyEraTx = tx'
      in TxInMode ShelleyBasedEraConway (ShelleyTx ShelleyBasedEraConway shelleyEraTx)
+  Consensus.HardForkGenTx (Consensus.OneEraGenTx (S (S (S (S (S (S (S (Z tx'))))))))) ->
+    let Consensus.ShelleyTx _txid shelleyEraTx = tx'
+     in TxInMode ShelleyBasedEraDijkstra (ShelleyTx ShelleyBasedEraDijkstra shelleyEraTx)
 
 toConsensusGenTx
   :: ()
@@ -132,6 +135,10 @@ toConsensusGenTx (TxInMode ShelleyBasedEraConway (ShelleyTx _ tx)) =
   Consensus.HardForkGenTx (Consensus.OneEraGenTx (S (S (S (S (S (S (Z tx'))))))))
  where
   tx' = Consensus.mkShelleyTx tx
+toConsensusGenTx (TxInMode ShelleyBasedEraDijkstra (ShelleyTx _ tx)) =
+  Consensus.HardForkGenTx (Consensus.OneEraGenTx (S (S (S (S (S (S (S (Z tx')))))))))
+ where
+  tx' = Consensus.mkShelleyTx tx
 
 -- ----------------------------------------------------------------------------
 -- Transaction ids in the context of a consensus mode
@@ -193,6 +200,12 @@ toConsensusTxId (TxIdInMode ConwayEra txid) =
  where
   txid' :: Consensus.TxId (Consensus.GenTx Consensus.StandardConwayBlock)
   txid' = Consensus.ShelleyTxId $ toShelleyTxId txid
+toConsensusTxId (TxIdInMode DijkstraEra txid) =
+  Consensus.HardForkGenTxId
+    (Consensus.OneEraGenTxId (S (S (S (S (S (S (S (Z (Consensus.WrapGenTxId txid'))))))))))
+ where
+  txid' :: Consensus.TxId (Consensus.GenTx Consensus.StandardDijkstraBlock)
+  txid' = Consensus.ShelleyTxId $ toShelleyTxId txid
 
 -- ----------------------------------------------------------------------------
 -- Transaction validation errors in the context of eras and consensus modes
@@ -300,5 +313,7 @@ fromConsensusApplyTxErr = \case
     TxValidationErrorInCardanoMode $ ShelleyTxValidationError ShelleyBasedEraBabbage err
   Consensus.ApplyTxErrConway err ->
     TxValidationErrorInCardanoMode $ ShelleyTxValidationError ShelleyBasedEraConway err
+  Consensus.ApplyTxErrDijkstra err ->
+    TxValidationErrorInCardanoMode $ ShelleyTxValidationError ShelleyBasedEraDijkstra err
   Consensus.ApplyTxErrWrongEra err ->
     TxValidationEraMismatch err