Dijkstra integration

.github/workflows/haskell-wasm.yml

@@ -114,8 +114,8 @@ jobs:
 
     - name: Restore cached deps
       run: |
-        wget "https://agrius.feralhosting.com/palas/wasm-cache/4c200033737be4736cd2a363d64c49a385937d5ea57d8e52773f65d08bbd1342.tar.bz2"
-        tar -jxf 4c200033737be4736cd2a363d64c49a385937d5ea57d8e52773f65d08bbd1342.tar.bz2
+        wget "https://agrius.feralhosting.com/palas/wasm-cache/c98ffd34ef84bbd524f7c750e96452c13063b960c05cb2d3361e343377978cc8.tar.xz"
+        tar -xf c98ffd34ef84bbd524f7c750e96452c13063b960c05cb2d3361e343377978cc8.tar.xz
         rm -fr ~/.ghc-wasm/.cabal/store/
         mv store ~/.ghc-wasm/.cabal/
 

.github/workflows/hls.yml

@@ -14,7 +14,7 @@ jobs:
   test-hls-works:
     env:
       # Modify this value to "invalidate" the cache.
-      HLS_CACHE_VERSION: "2025-06-11"
+      HLS_CACHE_VERSION: "2025-08-12"
 
     runs-on: ubuntu-latest
     timeout-minutes: 60

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,18 +61,62 @@ 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: 5aac28bec41b7709f75a5c9f20e2431259cf237f
+  --sha256: sha256-PXnD7mAIZgnodqbMU3ImCb/uoat61vLsqnc6dUyTRIw=
+  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)
   source-repository-package
     type: git
-    location: https://github.com/amesgen/plutus.git
-    tag: dc1edea4458d6fb794b245a26c730620265645f3
+    location: https://github.com/intersectmbo/plutus.git
+    tag: 210c8375cd82eb2670b703b0975c26589dd40b2f
     subdir:
       plutus-core
       plutus-ledger-api
       plutus-tx
-    --sha256: sha256-QBtLmoS54b5QMAKIDOJIM6lmRC+1leBpuGKaFc7QQos=
+    --sha256: sha256-icAg87JKdCkeuNZvVwNlT0v1/O0wOYwIQ6LzXj9iTYM=
 
   package plutus-core
     flags: +do-not-build-plutus-exec
@@ -86,11 +130,11 @@ if arch(wasm32)
   source-repository-package
     type: git
     location: https://github.com/palas/ouroboros-network.git
-    tag: ef3e30603e4e45dac336a085114ee22b7aa8c9ed
+    tag: bbc8bd70386a951e8633e4966e661df079cdc103
     subdir:
       ouroboros-network
       ouroboros-network-framework
-    --sha256: sha256-+IdAmWJqzRy+erKONywtk+5YLrm63q942nZavoEA4E4=
+    --sha256: sha256-7m9lMZlQzjbfaGpWA5ipDGloQ2uhIQmFRoUFQ7GCDl8=
 
   source-repository-package
     type: git
@@ -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

@@ -125,12 +125,13 @@ library
     cardano-data >=1.0,
     cardano-ledger-allegra >=1.7,
     cardano-ledger-alonzo >=1.13,
-    cardano-ledger-api >=1.11,
+    cardano-ledger-api:{cardano-ledger-api, testlib} >=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,
 
@@ -341,7 +342,6 @@ test-suite cardano-api-test
     cardano-binary,
     cardano-crypto,
     cardano-crypto-class ^>=2.2.1,
-    cardano-crypto-test ^>=1.6,
     cardano-crypto-tests ^>=2.2,
     cardano-ledger-alonzo,
     cardano-ledger-api >=1.9,
@@ -428,7 +428,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

@@ -39,6 +39,7 @@ shelleyBasedEraTestConstraints = \case
   ShelleyBasedEraAlonzo -> id
   ShelleyBasedEraBabbage -> id
   ShelleyBasedEraConway -> id
+  ShelleyBasedEraDijkstra -> id
 
 shelleyToBabbageEraTestConstraints
   :: ()
@@ -69,3 +70,4 @@ conwayEraOnwardsTestConstraints
   -> a
 conwayEraOnwardsTestConstraints = \case
   ConwayEraOnwardsConway -> id
+  ConwayEraOnwardsDijkstra -> id

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