WIP

Author: Jimbo4350

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
@@ -205,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,
 
@@ -428,7 +429,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/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' -> error "dijkstra"
 
 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

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

@@ -83,6 +83,7 @@ type family ConsensusBlockForEra era where
   ConsensusBlockForEra AlonzoEra = Consensus.StandardAlonzoBlock
   ConsensusBlockForEra BabbageEra = Consensus.StandardBabbageBlock
   ConsensusBlockForEra ConwayEra = Consensus.StandardConwayBlock
+  ConsensusBlockForEra DijkstraEra = Consensus.StandardDijkstraBlock
 
 type family ConsensusCryptoForBlock block where
   ConsensusCryptoForBlock Consensus.ByronBlockHFC = StandardCrypto
@@ -98,6 +99,7 @@ type family ConsensusProtocol era where
   ConsensusProtocol AlonzoEra = Consensus.TPraos StandardCrypto
   ConsensusProtocol BabbageEra = Consensus.Praos StandardCrypto
   ConsensusProtocol ConwayEra = Consensus.Praos StandardCrypto
+  ConsensusProtocol DijkstraEra = Consensus.Praos StandardCrypto
 
 type family ChainDepStateProtocol era where
   ChainDepStateProtocol ShelleyEra = Consensus.TPraosState
@@ -128,6 +130,9 @@ eraIndex5 = eraIndexSucc eraIndex4
 eraIndex6 :: Consensus.EraIndex (x6 : x5 : x4 : x3 : x2 : x1 : x0 : xs)
 eraIndex6 = eraIndexSucc eraIndex5
 
+eraIndex7 :: Consensus.EraIndex (x7 : x6 : x5 : x4 : x3 : x2 : x1 : x0 : xs)
+eraIndex7 = eraIndexSucc eraIndex6
+
 toConsensusEraIndex
   :: ()
   => Consensus.CardanoBlock StandardCrypto ~ Consensus.HardForkBlock xs
@@ -141,6 +146,7 @@ toConsensusEraIndex = \case
   AlonzoEra -> eraIndex4
   BabbageEra -> eraIndex5
   ConwayEra -> eraIndex6
+  DijkstraEra -> eraIndex7
 
 fromConsensusEraIndex
   :: ()
@@ -161,3 +167,4 @@ fromConsensusEraIndex = \case
     AnyCardanoEra BabbageEra
   Consensus.EraIndex (S (S (S (S (S (S (Z (K ())))))))) ->
     AnyCardanoEra ConwayEra
+  Consensus.EraIndex (S (S (S (S (S (S (S _))))))) -> error "Dijkstra"

cardano-api/src/Cardano/Api/Era/Internal/Case.hs

@@ -52,6 +52,7 @@ caseByronOrShelleyBasedEra l r = \case
   AlonzoEra -> r ShelleyBasedEraAlonzo
   BabbageEra -> r ShelleyBasedEraBabbage
   ConwayEra -> r ShelleyBasedEraConway
+  DijkstraEra -> r ShelleyBasedEraDijkstra
 
 -- | @caseByronToAlonzoOrBabbageEraOnwards f g era@ applies @f@ to byron, shelley, allegra, mary, and alonzo;
 -- and @g@ to babbage and later eras.
@@ -69,6 +70,7 @@ caseByronToAlonzoOrBabbageEraOnwards l r = \case
   AlonzoEra -> l ByronToAlonzoEraAlonzo
   BabbageEra -> r BabbageEraOnwardsBabbage
   ConwayEra -> r BabbageEraOnwardsConway
+  DijkstraEra -> r BabbageEraOnwardsDijkstra
 
 -- | @caseShelleyEraOnlyOrAllegraEraOnwards f g era@ applies @f@ to shelley;
 -- and applies @g@ to allegra and later eras.
@@ -85,6 +87,7 @@ caseShelleyEraOnlyOrAllegraEraOnwards l r = \case
   ShelleyBasedEraAlonzo -> r AllegraEraOnwardsAlonzo
   ShelleyBasedEraBabbage -> r AllegraEraOnwardsBabbage
   ShelleyBasedEraConway -> r AllegraEraOnwardsConway
+  ShelleyBasedEraDijkstra -> r AllegraEraOnwardsDijkstra
 
 -- | @caseShelleyToAllegraOrMaryEraOnwards f g era@ applies @f@ to shelley and allegra;
 -- and applies @g@ to mary and later eras.
@@ -101,6 +104,7 @@ caseShelleyToAllegraOrMaryEraOnwards l r = \case
   ShelleyBasedEraAlonzo -> r MaryEraOnwardsAlonzo
   ShelleyBasedEraBabbage -> r MaryEraOnwardsBabbage
   ShelleyBasedEraConway -> r MaryEraOnwardsConway
+  ShelleyBasedEraDijkstra -> r MaryEraOnwardsDijkstra
 
 -- | @caseShelleyToMaryOrAlonzoEraOnwards f g era@ applies @f@ to shelley, allegra, and mary;
 -- and applies @g@ to alonzo and later eras.
@@ -117,6 +121,7 @@ caseShelleyToMaryOrAlonzoEraOnwards l r = \case
   ShelleyBasedEraAlonzo -> r AlonzoEraOnwardsAlonzo
   ShelleyBasedEraBabbage -> r AlonzoEraOnwardsBabbage
   ShelleyBasedEraConway -> r AlonzoEraOnwardsConway
+  ShelleyBasedEraDijkstra -> r AlonzoEraOnwardsDijkstra
 
 -- | @caseShelleyToAlonzoOrBabbageEraOnwards f g era@ applies @f@ to shelley, allegra, mary, and alonzo;
 -- and applies @g@ to babbage and later eras.
@@ -133,6 +138,7 @@ caseShelleyToAlonzoOrBabbageEraOnwards l r = \case
   ShelleyBasedEraAlonzo -> l ShelleyToAlonzoEraAlonzo
   ShelleyBasedEraBabbage -> r BabbageEraOnwardsBabbage
   ShelleyBasedEraConway -> r BabbageEraOnwardsConway
+  ShelleyBasedEraDijkstra -> r BabbageEraOnwardsDijkstra
 
 -- | @caseShelleyToBabbageOrConwayEraOnwards f g era@ applies @f@ to eras before conway;
 -- and applies @g@ to conway and later eras.
@@ -149,6 +155,7 @@ caseShelleyToBabbageOrConwayEraOnwards l r = \case
   ShelleyBasedEraAlonzo -> l ShelleyToBabbageEraAlonzo
   ShelleyBasedEraBabbage -> l ShelleyToBabbageEraBabbage
   ShelleyBasedEraConway -> r ConwayEraOnwardsConway
+  ShelleyBasedEraDijkstra -> r ConwayEraOnwardsDijkstra
 
 {-# DEPRECATED shelleyToAlonzoEraToShelleyToBabbageEra "Use convert instead" #-}
 shelleyToAlonzoEraToShelleyToBabbageEra
@@ -170,6 +177,7 @@ alonzoEraOnwardsToMaryEraOnwards = \case
   AlonzoEraOnwardsAlonzo -> MaryEraOnwardsAlonzo
   AlonzoEraOnwardsBabbage -> MaryEraOnwardsBabbage
   AlonzoEraOnwardsConway -> MaryEraOnwardsConway
+  AlonzoEraOnwardsDijkstra -> MaryEraOnwardsDijkstra
 
 {-# DEPRECATED babbageEraOnwardsToMaryEraOnwards "Use convert instead" #-}
 babbageEraOnwardsToMaryEraOnwards
@@ -179,6 +187,7 @@ babbageEraOnwardsToMaryEraOnwards
 babbageEraOnwardsToMaryEraOnwards = \case
   BabbageEraOnwardsBabbage -> MaryEraOnwardsBabbage
   BabbageEraOnwardsConway -> MaryEraOnwardsConway
+  BabbageEraOnwardsDijkstra -> MaryEraOnwardsDijkstra
 
 {-# DEPRECATED babbageEraOnwardsToAlonzoEraOnwards "Use convert instead" #-}
 babbageEraOnwardsToAlonzoEraOnwards
@@ -188,3 +197,4 @@ babbageEraOnwardsToAlonzoEraOnwards
 babbageEraOnwardsToAlonzoEraOnwards = \case
   BabbageEraOnwardsBabbage -> AlonzoEraOnwardsBabbage
   BabbageEraOnwardsConway -> AlonzoEraOnwardsConway
+  BabbageEraOnwardsDijkstra -> AlonzoEraOnwardsDijkstra

cardano-api/src/Cardano/Api/Era/Internal/Core.hs

@@ -19,6 +19,7 @@ module Cardano.Api.Era.Internal.Core
   , AlonzoEra
   , BabbageEra
   , ConwayEra
+  , DijkstraEra
 
     -- * CardanoEra
   , CardanoEra (..)
@@ -87,6 +88,9 @@ data BabbageEra
 -- | A type used as a tag to distinguish the Conway era.
 data ConwayEra
 
+-- | A type used as a tag to distinguish the DijkstraEra era.
+data DijkstraEra
+
 instance HasTypeProxy ByronEra where
   data AsType ByronEra = AsByronEra
   proxyToAsType _ = AsByronEra
@@ -115,6 +119,10 @@ instance HasTypeProxy ConwayEra where
   data AsType ConwayEra = AsConwayEra
   proxyToAsType _ = AsConwayEra
 
+instance HasTypeProxy DijkstraEra where
+  data AsType DijkstraEra = AsDijkstraEra
+  proxyToAsType _ = AsDijkstraEra
+
 -- ----------------------------------------------------------------------------
 -- Eon
 
@@ -263,6 +271,7 @@ data CardanoEra era where
   AlonzoEra :: CardanoEra AlonzoEra
   BabbageEra :: CardanoEra BabbageEra
   ConwayEra :: CardanoEra ConwayEra
+  DijkstraEra :: CardanoEra DijkstraEra
 
 -- when you add era here, change `instance Bounded AnyCardanoEra`
 
@@ -321,6 +330,9 @@ instance IsCardanoEra BabbageEra where
 instance IsCardanoEra ConwayEra where
   cardanoEra = ConwayEra
 
+instance IsCardanoEra DijkstraEra where
+  cardanoEra = DijkstraEra
+
 type CardanoEraConstraints era =
   ( Typeable era
   , IsCardanoEra era
@@ -339,6 +351,7 @@ cardanoEraConstraints = \case
   AlonzoEra -> id
   BabbageEra -> id
   ConwayEra -> id
+  DijkstraEra -> id
 
 data AnyCardanoEra where
   AnyCardanoEra
@@ -372,6 +385,7 @@ instance Enum AnyCardanoEra where
     AnyCardanoEra AlonzoEra -> 4
     AnyCardanoEra BabbageEra -> 5
     AnyCardanoEra ConwayEra -> 6
+    AnyCardanoEra DijkstraEra -> 7
 
   toEnum = \case
     0 -> AnyCardanoEra ByronEra
@@ -409,6 +423,7 @@ cardanoEraToStringLike = \case
   AlonzoEra -> "Alonzo"
   BabbageEra -> "Babbage"
   ConwayEra -> "Conway"
+  DijkstraEra -> "Dijkstra"
 
 anyCardanoEraFromStringLike :: (IsString a, Eq a) => a -> Either a AnyCardanoEra
 {-# INLINE anyCardanoEraFromStringLike #-}
@@ -433,6 +448,7 @@ anyCardanoEra = \case
   AlonzoEra -> AnyCardanoEra AlonzoEra
   BabbageEra -> AnyCardanoEra BabbageEra
   ConwayEra -> AnyCardanoEra ConwayEra
+  DijkstraEra -> AnyCardanoEra DijkstraEra
 
 -- | This pairs up some era-dependent type with a 'CardanoEra' value that tells
 -- us what era it is, but hides the era type. This is useful when the era is