From 56252330813ce1f99fcb1164b55d88407090c968 Mon Sep 17 00:00:00 2001 From: Fraser Murray Date: Wed, 25 Jun 2025 01:42:42 +0100 Subject: [PATCH 01/42] wip: cardano-api with kes-agent support --- cabal.project | 76 ++++++++++++++++++- cardano-api/cardano-api.cabal | 14 ++-- cardano-api/src/Cardano/Api/Block.hs | 3 +- .../src/Cardano/Api/Certificate/Internal.hs | 5 ++ .../Cardano/Api/Consensus/Internal/InMode.hs | 2 + .../Cardano/Api/Consensus/Internal/Mode.hs | 2 + .../Api/Consensus/Internal/Protocol.hs | 15 +++- .../Plutus/Internal/ScriptWitness.hs | 1 + .../src/Cardano/Api/Experimental/Tx.hs | 1 - .../Experimental/Tx/Internal/AnyWitness.hs | 3 + .../Experimental/Tx/Internal/Certificate.hs | 1 + .../Internal/Action/ProposalProcedure.hs | 10 +-- .../Cardano/Api/Ledger/Internal/Reexport.hs | 6 +- cardano-api/src/Cardano/Api/LedgerState.hs | 9 ++- .../src/Cardano/Api/Network/IPC/Internal.hs | 2 +- .../src/Cardano/Api/Plutus/Internal/Script.hs | 2 + .../src/Cardano/Api/ProtocolParameters.hs | 1 + .../Cardano/Api/Query/Internal/Convenience.hs | 8 +- .../src/Cardano/Api/Query/Internal/Expr.hs | 5 +- .../Api/Query/Internal/Type/QueryInMode.hs | 40 +++++----- .../src/Cardano/Api/Tx/Internal/Body.hs | 1 - .../src/Cardano/Api/Tx/Internal/Body/Lens.hs | 1 - .../src/Cardano/Api/Tx/Internal/Sign.hs | 4 +- 23 files changed, 155 insertions(+), 57 deletions(-) diff --git a/cabal.project b/cabal.project index a5de8a9c8e..07c1012e92 100644 --- a/cabal.project +++ b/cabal.project @@ -14,7 +14,7 @@ repository cardano-haskell-packages -- 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 + , cardano-haskell-packages 2025-07-22T10:42:20Z packages: cardano-api @@ -61,6 +61,7 @@ if impl (ghc >= 9.12) -- https://github.com/kapralVV/Unique/issues/11 , Unique:hashable + -- WASM compilation specific if arch(wasm32) @@ -156,3 +157,76 @@ 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-core + , cardano-ledger-byron + , serdoc-core:tasty-quickcheck + + , kes-agent:containers + -- , hedgehog-quickcheck:QuickCheck + , *:QuickCheck + +source-repository-package + type: git + location: https://github.com/input-output-hk/kes-agent + tag: 60acf5d1c949695dc7822945b18fc916e7ef4391 + --sha256: sha256-oTsxaFAs1c/H0oYLhiivO5mr48oHNsPi5k2XyXxwCJg= + subdir: + kes-agent + +source-repository-package + type: git + location: https://github.com/IntersectMBO/ouroboros-network + tag: 253316ae1c5ec0eaf79f306eac1986969b7842a4 + --sha256: sha256-0HZ49kIgCrv/H9I/aUb+wFfRiVuZMrUofJFdgWPG17o= + subdir: ouroboros-network-api + ouroboros-network + ouroboros-network-framework + ouroboros-network-protocols + +source-repository-package + type: git + location: https://github.com/IntersectMBO/cardano-ledger + tag: ca8d451bbce11dde3b68e99782c79f9b4c1dfca5 + --sha256: sha256-YHIscWnp9GrFn0EYGM7xd8Ds8x0O00FWBAIZX22bWpA= + 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/conway/test-suite + 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-ledger-test + libs/cardano-protocol-tpraos + libs/constrained-generators + libs/non-integral + libs/set-algebra + libs/small-steps + libs/vector-map + +source-repository-package + type: git + location: https://github.com/IntersectMBO/ouroboros-consensus + tag: 26c831eb40bd15750ef8243285466fe9bd582cf7 + --sha256: sha256-oTsxaFAs1c/H0oYLhiivO5mr48oHNsPi5k2XyXxwCJg= + subdir: + ouroboros-consensus + ouroboros-consensus-cardano + ouroboros-consensus-diffusion + ouroboros-consensus-protocol + sop-extras + strict-sop-core diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index 31f195933b..3c7ed7ea4b 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -130,7 +130,7 @@ library cardano-ledger-binary >=1.6, cardano-ledger-byron >=1.1, cardano-ledger-conway >=1.19, - cardano-ledger-core:{cardano-ledger-core, testlib} >=1.17, + cardano-ledger-core:{cardano-ledger-core, testlib} >=1.17 && <1.19, cardano-ledger-mary >=1.8, cardano-ledger-shelley >=1.16, cardano-protocol-tpraos >=1.4, @@ -164,11 +164,11 @@ library ouroboros-consensus-diffusion ^>=0.23, ouroboros-consensus-protocol ^>=0.12, ouroboros-network, - ouroboros-network-api >=0.14, + ouroboros-network-api >=0.15, ouroboros-network-framework, - ouroboros-network-protocols >=0.14, + ouroboros-network-protocols >=0.15, 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 +186,7 @@ library time, transformers, transformers-except ^>=0.1.3, - typed-protocols ^>=0.3, + typed-protocols ^>=1.0, vector, yaml, @@ -312,7 +312,7 @@ library gen cardano-crypto-class ^>=2.2.1, cardano-crypto-test ^>=1.6, cardano-ledger-alonzo:{cardano-ledger-alonzo, testlib} >=1.8.1, - cardano-ledger-byron-test >=1.5, + cardano-ledger-byron:{testlib} >=1.1, cardano-ledger-conway:testlib, cardano-ledger-core:{cardano-ledger-core, testlib} >=1.14, cardano-ledger-shelley >=1.13, @@ -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, diff --git a/cardano-api/src/Cardano/Api/Block.hs b/cardano-api/src/Cardano/Api/Block.hs index 8760593873..17df6b652a 100644 --- a/cardano-api/src/Cardano/Api/Block.hs +++ b/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, (.:), (.=)) @@ -167,7 +166,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 +201,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' + _ -> undefined toConsensusBlock :: () diff --git a/cardano-api/src/Cardano/Api/Certificate/Internal.hs b/cardano-api/src/Cardano/Api/Certificate/Internal.hs index 24d91fd65c..3270237bfc 100644 --- a/cardano-api/src/Cardano/Api/Certificate/Internal.hs +++ b/cardano-api/src/Cardano/Api/Certificate/Internal.hs @@ -576,6 +576,7 @@ filterUnRegCreds = Ledger.RetirePoolTxCert _ _ -> Nothing Ledger.MirTxCert _ -> Nothing Ledger.GenesisDelegTxCert{} -> Nothing + _ -> undefined ConwayCertificate cEra conwayCert -> conwayEraOnwardsConstraints cEra $ case conwayCert of Ledger.RegPoolTxCert _ -> Nothing @@ -593,6 +594,7 @@ filterUnRegCreds = Ledger.RegTxCert _ -> Nothing -- stake cred deregistration w/o deposit Ledger.UnRegTxCert cred -> Just cred + _ -> undefined filterUnRegDRepCreds :: Certificate era -> Maybe (Ledger.Credential Ledger.DRepRole) @@ -615,6 +617,7 @@ filterUnRegDRepCreds = \case Ledger.RegTxCert _ -> Nothing -- stake cred deregistration w/o deposit Ledger.UnRegTxCert _ -> Nothing + _ -> undefined -- ---------------------------------------------------------------------------- -- Internal conversion functions @@ -803,6 +806,7 @@ getAnchorDataFromCertificate c = Ledger.RetirePoolTxCert _ _ -> return Nothing Ledger.GenesisDelegTxCert{} -> return Nothing Ledger.MirTxCert _ -> return Nothing + _ -> undefined ConwayCertificate ceo ccert -> conwayEraOnwardsConstraints ceo $ case ccert of @@ -819,6 +823,7 @@ getAnchorDataFromCertificate c = Ledger.UpdateDRepTxCert _ mAnchor -> return $ Ledger.strictMaybeToMaybe mAnchor Ledger.AuthCommitteeHotKeyTxCert _ _ -> return Nothing Ledger.ResignCommitteeColdTxCert _ mAnchor -> return $ Ledger.strictMaybeToMaybe mAnchor + _ -> undefined where anchorDataFromPoolMetadata :: MonadError AnchorDataFromCertificateError m diff --git a/cardano-api/src/Cardano/Api/Consensus/Internal/InMode.hs b/cardano-api/src/Cardano/Api/Consensus/Internal/InMode.hs index ca10b1abd5..abb76f5410 100644 --- a/cardano-api/src/Cardano/Api/Consensus/Internal/InMode.hs +++ b/cardano-api/src/Cardano/Api/Consensus/Internal/InMode.hs @@ -100,6 +100,7 @@ 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) + _ -> undefined toConsensusGenTx :: () @@ -302,3 +303,4 @@ fromConsensusApplyTxErr = \case TxValidationErrorInCardanoMode $ ShelleyTxValidationError ShelleyBasedEraConway err Consensus.ApplyTxErrWrongEra err -> TxValidationEraMismatch err + _ -> undefined diff --git a/cardano-api/src/Cardano/Api/Consensus/Internal/Mode.hs b/cardano-api/src/Cardano/Api/Consensus/Internal/Mode.hs index c4e4100c16..2b8aa671b2 100644 --- a/cardano-api/src/Cardano/Api/Consensus/Internal/Mode.hs +++ b/cardano-api/src/Cardano/Api/Consensus/Internal/Mode.hs @@ -161,3 +161,5 @@ 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 (Z (K ()))))))))) -> + AnyCardanoEra ConwayEra diff --git a/cardano-api/src/Cardano/Api/Consensus/Internal/Protocol.hs b/cardano-api/src/Cardano/Api/Consensus/Internal/Protocol.hs index d58167c5e9..eec7c1e72e 100644 --- a/cardano-api/src/Cardano/Api/Consensus/Internal/Protocol.hs +++ b/cardano-api/src/Cardano/Api/Consensus/Internal/Protocol.hs @@ -22,6 +22,7 @@ where import Cardano.Api.Consensus.Internal.Mode +import qualified Control.Tracer as Tracer import Ouroboros.Consensus.Block.Forging (BlockForging) import Ouroboros.Consensus.Byron.ByronHFC (ByronBlockHFC) import Ouroboros.Consensus.Cardano @@ -31,6 +32,7 @@ import Ouroboros.Consensus.HardFork.Combinator.Embed.Unary import Ouroboros.Consensus.Ledger.SupportsProtocol qualified as Consensus (LedgerSupportsProtocol) import Ouroboros.Consensus.Node.ProtocolInfo (ProtocolClientInfo (..), ProtocolInfo (..)) import Ouroboros.Consensus.Node.Run (RunNode) +import Ouroboros.Consensus.Protocol.Praos.AgentClient import Ouroboros.Consensus.Protocol.TPraos qualified as Consensus import Ouroboros.Consensus.Shelley.Eras qualified as Consensus (ShelleyEra) import Ouroboros.Consensus.Shelley.Ledger.Block qualified as Consensus (ShelleyBlock) @@ -44,7 +46,11 @@ import Type.Reflection ((:~:) (..)) class (RunNode blk, IOLike m) => Protocol m blk where data ProtocolInfoArgs blk - protocolInfo :: ProtocolInfoArgs blk -> (ProtocolInfo blk, m [BlockForging m blk]) + protocolInfo + :: ProtocolInfoArgs blk + -> ( ProtocolInfo blk + , Tracer.Tracer m KESAgentClientTrace -> m [BlockForging m blk] + ) -- | Node client support for each consensus protocol. -- @@ -59,10 +65,10 @@ instance IOLike m => Protocol m ByronBlockHFC where data ProtocolInfoArgs ByronBlockHFC = ProtocolInfoArgsByron ProtocolParamsByron protocolInfo (ProtocolInfoArgsByron params) = ( inject $ protocolInfoByron params - , pure . map inject $ blockForgingByron params + , \_ -> pure . map inject $ blockForgingByron params ) -instance (CardanoHardForkConstraints StandardCrypto, IOLike m) => Protocol m (CardanoBlock StandardCrypto) where +instance (CardanoHardForkConstraints StandardCrypto, IOLike m, MonadKESAgent m) => Protocol m (CardanoBlock StandardCrypto) where data ProtocolInfoArgs (CardanoBlock StandardCrypto) = ProtocolInfoArgsCardano (CardanoProtocolParams StandardCrypto) @@ -89,6 +95,7 @@ instance (Consensus.TPraos StandardCrypto) ShelleyEra ) + , MonadKESAgent m ) => Protocol m (ShelleyBlockHFC (Consensus.TPraos StandardCrypto) ShelleyEra) where @@ -98,7 +105,7 @@ instance (ProtocolParamsShelleyBased StandardCrypto) ProtVer protocolInfo (ProtocolInfoArgsShelley genesis paramsShelleyBased_ paramsShelley_) = - bimap inject (fmap $ map inject) $ + bimap inject (fmap $ fmap $ map inject) $ protocolInfoShelley genesis paramsShelleyBased_ paramsShelley_ instance diff --git a/cardano-api/src/Cardano/Api/Experimental/Plutus/Internal/ScriptWitness.hs b/cardano-api/src/Cardano/Api/Experimental/Plutus/Internal/ScriptWitness.hs index 77fce5c280..e101428637 100644 --- a/cardano-api/src/Cardano/Api/Experimental/Plutus/Internal/ScriptWitness.hs +++ b/cardano-api/src/Cardano/Api/Experimental/Plutus/Internal/ScriptWitness.hs @@ -74,6 +74,7 @@ getPlutusScriptWitnessLanguage (PlutusScriptWitness l _ _ _ _) = L.SPlutusV1 -> L.plutusLanguage l L.SPlutusV2 -> L.plutusLanguage l L.SPlutusV3 -> L.plutusLanguage l + _ -> undefined -- | Every Plutus script has a purpose that indicates -- what that script is witnessing. diff --git a/cardano-api/src/Cardano/Api/Experimental/Tx.hs b/cardano-api/src/Cardano/Api/Experimental/Tx.hs index eb42aa7ba6..164540a341 100644 --- a/cardano-api/src/Cardano/Api/Experimental/Tx.hs +++ b/cardano-api/src/Cardano/Api/Experimental/Tx.hs @@ -167,7 +167,6 @@ import Cardano.Crypto.Hash qualified as Hash import Cardano.Ledger.Alonzo.TxBody qualified as L import Cardano.Ledger.Api qualified as L import Cardano.Ledger.Binary qualified as Ledger -import Cardano.Ledger.Conway.TxBody qualified as L import Cardano.Ledger.Core qualified as Ledger import Cardano.Ledger.Hashes qualified as L hiding (Hash) diff --git a/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/AnyWitness.hs b/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/AnyWitness.hs index 24536ba065..67215bce9c 100644 --- a/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/AnyWitness.hs +++ b/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/AnyWitness.hs @@ -143,6 +143,7 @@ fromPlutusRunnable L.SPlutusV3 eon runnable = AlonzoEraOnwardsConway -> let plutusScript = L.plutusFromRunnable runnable in Just $ L.ConwayPlutusV3 plutusScript +fromPlutusRunnable _ _ _ = undefined toAlonzoDatum :: AlonzoEraOnwards era @@ -162,3 +163,5 @@ getPlutusDatum L.SPlutusV2 (SpendingScriptDatum d) = Just d getPlutusDatum L.SPlutusV3 (SpendingScriptDatum d) = d getPlutusDatum _ InlineDatum = Nothing getPlutusDatum _ NoScriptDatum = Nothing +getPlutusDatum _ _ = undefined + diff --git a/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/Certificate.hs b/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/Certificate.hs index 90e9a7ec9d..7924bffa82 100644 --- a/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/Certificate.hs +++ b/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/Certificate.hs @@ -127,6 +127,7 @@ newToOldPlutusCertificateScriptWitness ConwayEra (Exp.PlutusScriptWitness Plutus Api.NoScriptDatumForStake redeemer execUnits +newToOldPlutusCertificateScriptWitness _ _ = undefined newToOldPlutusScriptOrReferenceInput :: Era era diff --git a/cardano-api/src/Cardano/Api/Governance/Internal/Action/ProposalProcedure.hs b/cardano-api/src/Cardano/Api/Governance/Internal/Action/ProposalProcedure.hs index f1b6002bb4..6ca5b03cfb 100644 --- a/cardano-api/src/Cardano/Api/Governance/Internal/Action/ProposalProcedure.hs +++ b/cardano-api/src/Cardano/Api/Governance/Internal/Action/ProposalProcedure.hs @@ -44,13 +44,13 @@ data AnyGovernanceAction = forall era. AnyGovernanceAction (Gov.GovAction era) -- TODO: Conway - Transitiion to Ledger.GovAction data GovernanceAction era = MotionOfNoConfidence - (StrictMaybe (Ledger.GovPurposeId Ledger.CommitteePurpose (ShelleyLedgerEra era))) + (StrictMaybe (Ledger.GovPurposeId Ledger.CommitteePurpose)) | ProposeNewConstitution - (StrictMaybe (Ledger.GovPurposeId Ledger.ConstitutionPurpose (ShelleyLedgerEra era))) + (StrictMaybe (Ledger.GovPurposeId Ledger.ConstitutionPurpose)) Ledger.Anchor (StrictMaybe Shelley.ScriptHash) | ProposeNewCommittee - (StrictMaybe (Ledger.GovPurposeId Ledger.CommitteePurpose (ShelleyLedgerEra era))) + (StrictMaybe (Ledger.GovPurposeId Ledger.CommitteePurpose)) [L.Credential ColdCommitteeRole] -- ^ Old constitutional committee (Map (L.Credential ColdCommitteeRole) EpochNo) @@ -63,11 +63,11 @@ data GovernanceAction era [(Network, StakeCredential, L.Coin)] !(StrictMaybe Shelley.ScriptHash) | InitiateHardfork - (StrictMaybe (Ledger.GovPurposeId Ledger.HardForkPurpose (ShelleyLedgerEra era))) + (StrictMaybe (Ledger.GovPurposeId Ledger.HardForkPurpose)) ProtVer | -- | Governance policy UpdatePParams - (StrictMaybe (Ledger.GovPurposeId Ledger.PParamUpdatePurpose (ShelleyLedgerEra era))) + (StrictMaybe (Ledger.GovPurposeId Ledger.PParamUpdatePurpose)) (Ledger.PParamsUpdate (ShelleyLedgerEra era)) !(StrictMaybe Shelley.ScriptHash) diff --git a/cardano-api/src/Cardano/Api/Ledger/Internal/Reexport.hs b/cardano-api/src/Cardano/Api/Ledger/Internal/Reexport.hs index 2f9e04bbaf..d4b222bd2d 100644 --- a/cardano-api/src/Cardano/Api/Ledger/Internal/Reexport.hs +++ b/cardano-api/src/Cardano/Api/Ledger/Internal/Reexport.hs @@ -112,7 +112,7 @@ module Cardano.Api.Ledger.Internal.Reexport , toPlainDecoder -- Shelley , secondsToNominalDiffTimeMicro - , AccountState (..) + , ChainAccountState (..) , NewEpochState (..) , ShelleyGenesisStaking (..) -- Babbage @@ -266,7 +266,7 @@ import Cardano.Ledger.Binary , toPlainDecoder ) import Cardano.Ledger.Binary.Plain (Decoder, serializeAsHexText) -import Cardano.Ledger.CertState (DRepState (..), csCommitteeCredsL) +import Cardano.Ledger.Conway.State (DRepState (..), csCommitteeCredsL) import Cardano.Ledger.Coin (Coin (..), addDeltaCoin, toDeltaCoin) import Cardano.Ledger.Conway.Core ( DRepVotingThresholds (..) @@ -336,7 +336,7 @@ import Cardano.Ledger.Plutus.Data (Data (..), unData) import Cardano.Ledger.Plutus.Language (Language, Plutus, languageToText, plutusBinary) import Cardano.Ledger.PoolParams (PoolMetadata (..), PoolParams (..), StakePoolRelay (..)) import Cardano.Ledger.Shelley.API - ( AccountState (..) + ( ChainAccountState (..) , GenDelegPair (..) , NewEpochState (..) , StakeReference (..) diff --git a/cardano-api/src/Cardano/Api/LedgerState.hs b/cardano-api/src/Cardano/Api/LedgerState.hs index 382da1e351..ae767325b4 100644 --- a/cardano-api/src/Cardano/Api/LedgerState.hs +++ b/cardano-api/src/Cardano/Api/LedgerState.hs @@ -193,6 +193,7 @@ import Ouroboros.Consensus.Ledger.Tables.Utils qualified as Ledger import Ouroboros.Consensus.Node.ProtocolInfo qualified as Consensus import Ouroboros.Consensus.Protocol.Abstract (ChainDepState, ConsensusProtocol (..)) import Ouroboros.Consensus.Protocol.Praos qualified as Praos +import Ouroboros.Consensus.Protocol.Praos.AgentClient import Ouroboros.Consensus.Protocol.Praos.Common qualified as Consensus import Ouroboros.Consensus.Protocol.Praos.VRF (mkInputVRF, vrfLeaderValue) import Ouroboros.Consensus.Protocol.TPraos qualified as TPraos @@ -214,6 +215,7 @@ import Control.Error.Util (note) import Control.Exception.Safe import Control.Monad import Control.Monad.State.Strict +import qualified Control.Tracer as Tracer import Data.Aeson as Aeson ( FromJSON (parseJSON) , Object @@ -1147,6 +1149,7 @@ instance FromJSON NodeConfig where <*> parseAlonzoHardForkEpoch o <*> parseBabbageHardForkEpoch o <*> parseConwayHardForkEpoch o + <*> undefined parseShelleyHardForkEpoch :: Object -> Parser (Consensus.CardanoHardForkTrigger blk) parseShelleyHardForkEpoch o = @@ -1363,7 +1366,7 @@ encodeLedgerState (LedgerState hst@(HFC.HardForkLedgerState st) tbs) = mconcat [ CBOR.encodeListLen 2 , HFC.encodeTelescope - (byron :* shelley :* allegra :* mary :* alonzo :* babbage :* conway :* Nil) + (byron :* shelley :* allegra :* mary :* alonzo :* babbage :* conway :* undefined :* Nil) st , Ledger.valuesMKEncoder hst tbs ] @@ -1381,7 +1384,7 @@ decodeLedgerState = do 2 <- CBOR.decodeListLen hst <- HFC.HardForkLedgerState - <$> HFC.decodeTelescope (byron :* shelley :* allegra :* mary :* alonzo :* babbage :* conway :* Nil) + <$> HFC.decodeTelescope (byron :* shelley :* allegra :* mary :* alonzo :* babbage :* conway :* undefined :* Nil) tbs <- Ledger.valuesMKDecoder hst pure (LedgerState hst tbs) where @@ -1434,7 +1437,7 @@ mkProtocolInfoCardano :: GenesisConfig -> ( Consensus.ProtocolInfo (Consensus.CardanoBlock Consensus.StandardCrypto) - , IO [BlockForging IO (Consensus.CardanoBlock Consensus.StandardCrypto)] + , Tracer.Tracer IO KESAgentClientTrace -> IO [BlockForging IO (Consensus.CardanoBlock Consensus.StandardCrypto)] ) mkProtocolInfoCardano (GenesisCardano dnc byronGenesis shelleyGenesisHash transCfg) = Consensus.protocolInfoCardano diff --git a/cardano-api/src/Cardano/Api/Network/IPC/Internal.hs b/cardano-api/src/Cardano/Api/Network/IPC/Internal.hs index 1b095bb73a..946865ecd1 100644 --- a/cardano-api/src/Cardano/Api/Network/IPC/Internal.hs +++ b/cardano-api/src/Cardano/Api/Network/IPC/Internal.hs @@ -211,7 +211,7 @@ connectToLocalNodeWithVersion Net.connectTo (Net.localSnocket iomgr) Net.NetworkConnectTracers - { Net.nctMuxTracer = nullTracer + { Net.nctMuxTracers = undefined , Net.nctHandshakeTracer = nullTracer } versionedProtocls diff --git a/cardano-api/src/Cardano/Api/Plutus/Internal/Script.hs b/cardano-api/src/Cardano/Api/Plutus/Internal/Script.hs index 34e236ca71..b7609b5c8b 100644 --- a/cardano-api/src/Cardano/Api/Plutus/Internal/Script.hs +++ b/cardano-api/src/Cardano/Api/Plutus/Internal/Script.hs @@ -368,6 +368,7 @@ fromAlonzoLanguage :: Plutus.Language -> AnyPlutusScriptVersion fromAlonzoLanguage Plutus.PlutusV1 = AnyPlutusScriptVersion PlutusScriptV1 fromAlonzoLanguage Plutus.PlutusV2 = AnyPlutusScriptVersion PlutusScriptV2 fromAlonzoLanguage Plutus.PlutusV3 = AnyPlutusScriptVersion PlutusScriptV3 +fromAlonzoLanguage _ = undefined class HasTypeProxy lang => IsScriptLanguage lang where scriptLanguage :: ScriptLanguage lang @@ -1334,6 +1335,7 @@ fromAllegraTimelock = go go (Shelley.RequireAllOf s) = RequireAllOf (map go (toList s)) go (Shelley.RequireAnyOf s) = RequireAnyOf (map go (toList s)) go (Shelley.RequireMOf i s) = RequireMOf i (map go (toList s)) + go _ = undefined type family ToLedgerPlutusLanguage lang where ToLedgerPlutusLanguage PlutusScriptV1 = Plutus.PlutusV1 diff --git a/cardano-api/src/Cardano/Api/ProtocolParameters.hs b/cardano-api/src/Cardano/Api/ProtocolParameters.hs index 12df9d4206..56b969b56d 100644 --- a/cardano-api/src/Cardano/Api/ProtocolParameters.hs +++ b/cardano-api/src/Cardano/Api/ProtocolParameters.hs @@ -1029,6 +1029,7 @@ fromAlonzoScriptLanguage :: Plutus.Language -> AnyPlutusScriptVersion fromAlonzoScriptLanguage Plutus.PlutusV1 = AnyPlutusScriptVersion PlutusScriptV1 fromAlonzoScriptLanguage Plutus.PlutusV2 = AnyPlutusScriptVersion PlutusScriptV2 fromAlonzoScriptLanguage Plutus.PlutusV3 = AnyPlutusScriptVersion PlutusScriptV3 +fromAlonzoScriptLanguage _ = undefined toAlonzoCostModel :: CostModel -> Plutus.Language -> Either ProtocolParametersConversionError Alonzo.CostModel diff --git a/cardano-api/src/Cardano/Api/Query/Internal/Convenience.hs b/cardano-api/src/Cardano/Api/Query/Internal/Convenience.hs index b85c89e1f4..53c44b6e08 100644 --- a/cardano-api/src/Cardano/Api/Query/Internal/Convenience.hs +++ b/cardano-api/src/Cardano/Api/Query/Internal/Convenience.hs @@ -36,11 +36,11 @@ import Cardano.Api.Query.Internal.Type.QueryInMode import Cardano.Api.Tx.Internal.Body import Cardano.Api.UTxO (UTxO (..)) -import Cardano.Ledger.CertState (DRepState (..)) +import Cardano.Ledger.State (DRepState (..)) import Cardano.Ledger.Coin qualified as L import Cardano.Ledger.Credential qualified as L import Cardano.Ledger.Keys qualified as L -import Cardano.Ledger.Shelley.LedgerState qualified as L +import Cardano.Ledger.State (ChainAccountState(..)) import Ouroboros.Consensus.HardFork.Combinator.AcrossEras (EraMismatch (..)) import Ouroboros.Network.Protocol.LocalStateQuery.Type (Target (..)) @@ -168,11 +168,11 @@ queryStateForBalancedTx era allTxIns certs = runExceptT $ do caseShelleyToBabbageOrConwayEraOnwards (const $ pure Nothing) ( \cOnwards -> do - L.AccountState{L.asTreasury} <- + ChainAccountState{casTreasury} <- lift (queryAccountState cOnwards) & onLeft (left . QceUnsupportedNtcVersion) & onLeft (left . QueryEraMismatch) - let txCurrentTreasuryValue = TxCurrentTreasuryValue asTreasury + let txCurrentTreasuryValue = TxCurrentTreasuryValue casTreasury return $ Just $ Featured cOnwards txCurrentTreasuryValue ) sbe diff --git a/cardano-api/src/Cardano/Api/Query/Internal/Expr.hs b/cardano-api/src/Cardano/Api/Query/Internal/Expr.hs index 46f0b305dd..8a1df4c5ef 100644 --- a/cardano-api/src/Cardano/Api/Query/Internal/Expr.hs +++ b/cardano-api/src/Cardano/Api/Query/Internal/Expr.hs @@ -59,12 +59,11 @@ import Cardano.Api.UTxO import Cardano.Ledger.Api qualified as L import Cardano.Ledger.Api.State.Query qualified as L -import Cardano.Ledger.CertState qualified as L +import Cardano.Ledger.State qualified as L import Cardano.Ledger.Coin qualified as L import Cardano.Ledger.Credential qualified as L import Cardano.Ledger.Hashes hiding (Hash) import Cardano.Ledger.Keys qualified as L -import Cardano.Ledger.Shelley.LedgerState qualified as L import Cardano.Slotting.Slot import Ouroboros.Consensus.Cardano.Block qualified as Consensus import Ouroboros.Consensus.HardFork.Combinator.AcrossEras as Consensus @@ -484,7 +483,7 @@ queryAccountState QueryInMode r IO - (Either UnsupportedNtcVersionError (Either EraMismatch L.AccountState)) + (Either UnsupportedNtcVersionError (Either EraMismatch L.ChainAccountState)) queryAccountState eon = querySbe eon QueryAccountState queryProposals diff --git a/cardano-api/src/Cardano/Api/Query/Internal/Type/QueryInMode.hs b/cardano-api/src/Cardano/Api/Query/Internal/Type/QueryInMode.hs index e9b7913450..1e44b6bd98 100644 --- a/cardano-api/src/Cardano/Api/Query/Internal/Type/QueryInMode.hs +++ b/cardano-api/src/Cardano/Api/Query/Internal/Type/QueryInMode.hs @@ -93,12 +93,12 @@ import Cardano.Ledger.Api qualified as L import Cardano.Ledger.Api.State.Query qualified as L import Cardano.Ledger.Binary import Cardano.Ledger.Binary.Plain qualified as Plain -import Cardano.Ledger.CertState qualified as L +import Cardano.Ledger.State qualified as L import Cardano.Ledger.Coin qualified as L import Cardano.Ledger.Credential qualified as Shelley import Cardano.Ledger.Shelley.API qualified as Shelley import Cardano.Ledger.Shelley.Core qualified as Core -import Cardano.Ledger.Shelley.LedgerState qualified as L +-- import Cardano.Ledger.Shelley.LedgerState qualified as L import Cardano.Slotting.EpochInfo (hoistEpochInfo) import Cardano.Slotting.Slot (WithOrigin (..)) import Cardano.Slotting.Time (SystemStart (..)) @@ -116,7 +116,6 @@ import Ouroboros.Consensus.Ledger.Query qualified as Consensus import Ouroboros.Consensus.Protocol.Abstract qualified as Consensus import Ouroboros.Consensus.Shelley.Ledger qualified as Consensus import Ouroboros.Consensus.Shelley.Ledger.Query.Types qualified as Consensus -import Ouroboros.Consensus.Shelley.Protocol.Abstract (ProtoCrypto) import Ouroboros.Network.Block (Serialised (..)) import Ouroboros.Network.PeerSelection.LedgerPeers.Type (LedgerPeerSnapshot) import Ouroboros.Network.Protocol.LocalStateQuery.Client (Some (..)) @@ -140,6 +139,7 @@ import Data.Text qualified as Text import Data.Word (Word64) import GHC.Exts (IsList (..)) import GHC.Stack +import Data.Coerce (coerce) -- ---------------------------------------------------------------------------- -- Queries @@ -286,7 +286,7 @@ data QueryInShelleyBasedEra era result where :: Set StakeCredential -> QueryInShelleyBasedEra era (Map StakeCredential L.Coin) QueryAccountState - :: QueryInShelleyBasedEra era L.AccountState + :: QueryInShelleyBasedEra era L.ChainAccountState QueryConstitution :: QueryInShelleyBasedEra era (L.Constitution (ShelleyLedgerEra era)) QueryGovState @@ -435,7 +435,7 @@ decodeStakeSnapshot (SerialisedStakeSnapshots (Serialised ls)) = StakeSnapshot < decodeBigLedgerPeerSnapshot :: Serialised LedgerPeerSnapshot -> Either (LBS.ByteString, DecoderError) LedgerPeerSnapshot -decodeBigLedgerPeerSnapshot (Serialised lps) = first (lps,) (Plain.decodeFull lps) +decodeBigLedgerPeerSnapshot (Serialised lps) = first (lps,) (undefined lps) toShelleyAddrSet :: CardanoEra era @@ -477,7 +477,7 @@ fromLedgerUTxO sbe (Shelley.UTxO utxo) = $ utxo fromShelleyPoolDistr - :: Consensus.PoolDistr StandardCrypto + :: L.PoolDistr -> Map (Hash StakePoolKey) Rational fromShelleyPoolDistr = -- TODO: write an appropriate property to show it is safe to use @@ -486,6 +486,7 @@ fromShelleyPoolDistr = . map (bimap StakePoolKeyHash Consensus.individualPoolStake) . toList . Consensus.unPoolDistr + . Consensus.fromLedgerPoolDistr fromShelleyDelegations :: Map @@ -564,7 +565,7 @@ toConsensusQueryShelleyBased sbe = \case QueryProtocolParameters -> Some (consensusQueryInEraInMode era Consensus.GetCurrentPParams) QueryStakeDistribution -> - Some (consensusQueryInEraInMode era Consensus.GetStakeDistribution) + Some (consensusQueryInEraInMode era Consensus.GetStakeDistribution2) QueryUTxO QueryUTxOWhole -> Some (consensusQueryInEraInMode era Consensus.GetUTxOWhole) QueryUTxO (QueryUTxOByAddress addrs) -> @@ -613,7 +614,7 @@ toConsensusQueryShelleyBased sbe = \case ) QueryPoolDistribution poolIds -> Some - (consensusQueryInEraInMode era (Consensus.GetCBOR (Consensus.GetPoolDistr (getPoolIds <$> poolIds)))) + (consensusQueryInEraInMode era (Consensus.GetCBOR (Consensus.GetPoolDistr2 (getPoolIds <$> poolIds)))) where getPoolIds :: Set PoolId -> Set (Shelley.KeyHash Shelley.StakePool) getPoolIds = Set.map (\(StakePoolKeyHash kh) -> kh) @@ -637,10 +638,11 @@ toConsensusQueryShelleyBased sbe = \case ) (const $ Some (consensusQueryInEraInMode era Consensus.GetFuturePParams)) sbe - QueryDRepState creds -> + QueryDRepState _creds -> caseShelleyToBabbageOrConwayEraOnwards (const $ error "toConsensusQueryShelleyBased: QueryDRepState is only available in the Conway era") - (const $ Some (consensusQueryInEraInMode era (Consensus.GetDRepState creds))) + undefined + -- (const $ Some $ consensusQueryInEraInMode era (Consensus.GetDRepState creds)) sbe QueryDRepStakeDistr dreps -> caseShelleyToBabbageOrConwayEraOnwards @@ -656,15 +658,16 @@ toConsensusQueryShelleyBased sbe = \case ) (const $ Some (consensusQueryInEraInMode era (Consensus.GetSPOStakeDistr spos))) sbe - QueryCommitteeMembersState coldCreds hotCreds statuses -> + QueryCommitteeMembersState _coldCreds _hotCreds _statuses -> caseShelleyToBabbageOrConwayEraOnwards ( const $ error "toConsensusQueryShelleyBased: QueryCommitteeMembersState is only available in the Conway era" ) - ( const $ - Some - (consensusQueryInEraInMode era (Consensus.GetCommitteeMembersState coldCreds hotCreds statuses)) - ) + undefined + -- ( const $ + -- Some + -- (consensusQueryInEraInMode era (Consensus.GetCommitteeMembersState coldCreds hotCreds statuses)) + -- ) sbe QueryStakeVoteDelegatees creds -> caseShelleyToBabbageOrConwayEraOnwards @@ -858,7 +861,6 @@ fromConsensusQueryResultShelleyBased . HasCallStack => ShelleyLedgerEra era ~ ledgerera => ConsensusProtocol era ~ protocol - => ProtoCrypto protocol ~ StandardCrypto => ShelleyBasedEra era -> QueryInShelleyBasedEra era result -> Consensus.BlockQuery (Consensus.ShelleyBlock protocol ledgerera) fp result' @@ -884,7 +886,7 @@ fromConsensusQueryResultShelleyBased sbe sbeQuery q' r' = _ -> fromConsensusQueryResultMismatch QueryStakeDistribution -> case q' of - Consensus.GetStakeDistribution -> fromShelleyPoolDistr r' + Consensus.GetStakeDistribution2 -> fromShelleyPoolDistr r' _ -> fromConsensusQueryResultMismatch QueryUTxO QueryUTxOWhole -> case q' of @@ -939,8 +941,8 @@ fromConsensusQueryResultShelleyBased sbe sbeQuery q' r' = _ -> fromConsensusQueryResultMismatch QueryPoolDistribution{} -> case q' of - Consensus.GetCBOR Consensus.GetPoolDistr{} -> - SerialisedPoolDistribution r' + Consensus.GetCBOR Consensus.GetPoolDistr2{} -> + SerialisedPoolDistribution (coerce r') _ -> fromConsensusQueryResultMismatch QueryStakeSnapshot{} -> case q' of diff --git a/cardano-api/src/Cardano/Api/Tx/Internal/Body.hs b/cardano-api/src/Cardano/Api/Tx/Internal/Body.hs index 61dff7f7ad..3c6f2e6f56 100644 --- a/cardano-api/src/Cardano/Api/Tx/Internal/Body.hs +++ b/cardano-api/src/Cardano/Api/Tx/Internal/Body.hs @@ -280,7 +280,6 @@ import Cardano.Ledger.BaseTypes (StrictMaybe (..)) import Cardano.Ledger.Binary (Annotated (..)) import Cardano.Ledger.Binary qualified as CBOR import Cardano.Ledger.Coin qualified as L -import Cardano.Ledger.Conway.Core qualified as L import Cardano.Ledger.Core () import Cardano.Ledger.Core qualified as Ledger import Cardano.Ledger.Credential qualified as Shelley diff --git a/cardano-api/src/Cardano/Api/Tx/Internal/Body/Lens.hs b/cardano-api/src/Cardano/Api/Tx/Internal/Body/Lens.hs index 3565f8f272..cbaaa9d0c4 100644 --- a/cardano-api/src/Cardano/Api/Tx/Internal/Body/Lens.hs +++ b/cardano-api/src/Cardano/Api/Tx/Internal/Body/Lens.hs @@ -58,7 +58,6 @@ import Cardano.Ledger.Alonzo.Core qualified as L import Cardano.Ledger.Api qualified as L import Cardano.Ledger.BaseTypes (SlotNo, StrictMaybe (..)) import Cardano.Ledger.Coin qualified as L -import Cardano.Ledger.Conway.Core qualified as L import Cardano.Ledger.Mary.Value qualified as L import Cardano.Ledger.Shelley.PParams qualified as L import Cardano.Ledger.TxIn qualified as L diff --git a/cardano-api/src/Cardano/Api/Tx/Internal/Sign.hs b/cardano-api/src/Cardano/Api/Tx/Internal/Sign.hs index 1f2c8df849..78cab6acf8 100644 --- a/cardano-api/src/Cardano/Api/Tx/Internal/Sign.hs +++ b/cardano-api/src/Cardano/Api/Tx/Internal/Sign.hs @@ -531,7 +531,7 @@ selectTxDatums :: TxBodyScriptData era -> Map L.DataHash (L.Data (ShelleyLedgerEra era)) selectTxDatums TxBodyNoScriptData = Map.empty -selectTxDatums (TxBodyScriptData _ (Alonzo.TxDats' datums) _) = datums +selectTxDatums (TxBodyScriptData _ (Alonzo.TxDats datums) _) = datums -- | Indicates whether a script is expected to fail or pass validation. data ScriptValidity @@ -1025,7 +1025,7 @@ makeShelleyBasedBootstrapWitness sbe nwOrAddr txbody (ByronSigningKey sk) = -- Byron era witnesses were weird. This reveals all that weirdness. Shelley.BootstrapWitness { Shelley.bwKey = vk - , Shelley.bwSig = signature + , Shelley.bwSignature = signature , Shelley.bwChainCode = chainCode , Shelley.bwAttributes = attributes } From 156d1190a1826b762befbf969ee38d3eae1ebef2 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Wed, 30 Jul 2025 08:33:13 -0400 Subject: [PATCH 02/42] Add `DijkstraEra era` to `CardanoEra era` --- cardano-api/src/Cardano/Api/Era/Internal/Core.hs | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/cardano-api/src/Cardano/Api/Era/Internal/Core.hs b/cardano-api/src/Cardano/Api/Era/Internal/Core.hs index bc6dadeca4..1594f882c4 100644 --- a/cardano-api/src/Cardano/Api/Era/Internal/Core.hs +++ b/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 From 2872eda49e0e84018cf64a9fa62cd4a980bf06f1 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Wed, 30 Jul 2025 08:34:25 -0400 Subject: [PATCH 03/42] Add `ShelleyBasedEraDijkstra` to `ShelleyBasedEra era` --- .../Cardano/Api/Era/Internal/Eon/ShelleyBasedEra.hs | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyBasedEra.hs b/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyBasedEra.hs index 92e25e505c..1b12a17d70 100644 --- a/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyBasedEra.hs +++ b/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyBasedEra.hs @@ -128,6 +128,7 @@ data ShelleyBasedEra era where ShelleyBasedEraAlonzo :: ShelleyBasedEra AlonzoEra ShelleyBasedEraBabbage :: ShelleyBasedEra BabbageEra ShelleyBasedEraConway :: ShelleyBasedEra ConwayEra + ShelleyBasedEraDijkstra :: ShelleyBasedEra DijkstraEra instance NFData (ShelleyBasedEra era) where rnf = \case @@ -137,6 +138,7 @@ instance NFData (ShelleyBasedEra era) where ShelleyBasedEraAlonzo -> () ShelleyBasedEraBabbage -> () ShelleyBasedEraConway -> () + ShelleyBasedEraDijkstra -> () deriving instance Eq (ShelleyBasedEra era) @@ -168,6 +170,7 @@ instance Eon ShelleyBasedEra where AlonzoEra -> yes ShelleyBasedEraAlonzo BabbageEra -> yes ShelleyBasedEraBabbage ConwayEra -> yes ShelleyBasedEraConway + DijkstraEra -> yes ShelleyBasedEraDijkstra instance ToCardanoEra ShelleyBasedEra where toCardanoEra = \case @@ -177,6 +180,7 @@ instance ToCardanoEra ShelleyBasedEra where ShelleyBasedEraAlonzo -> AlonzoEra ShelleyBasedEraBabbage -> BabbageEra ShelleyBasedEraConway -> ConwayEra + ShelleyBasedEraDijkstra -> DijkstraEra instance Convert ShelleyBasedEra CardanoEra where convert = toCardanoEra @@ -205,6 +209,9 @@ instance IsShelleyBasedEra BabbageEra where instance IsShelleyBasedEra ConwayEra where shelleyBasedEra = ShelleyBasedEraConway +instance IsShelleyBasedEra DijkstraEra where + shelleyBasedEra = ShelleyBasedEraDijkstra + type ShelleyBasedEraConstraints era = ( C.HashAlgorithm L.HASH , C.Signable (L.VRF L.StandardCrypto) L.Seed @@ -245,6 +252,7 @@ shelleyBasedEraConstraints = \case ShelleyBasedEraAlonzo -> id ShelleyBasedEraBabbage -> id ShelleyBasedEraConway -> id + ShelleyBasedEraDijkstra -> id data AnyShelleyBasedEra where AnyShelleyBasedEra @@ -274,6 +282,7 @@ instance Enum AnyShelleyBasedEra where AnyShelleyBasedEra ShelleyBasedEraAlonzo -> 4 AnyShelleyBasedEra ShelleyBasedEraBabbage -> 5 AnyShelleyBasedEra ShelleyBasedEraConway -> 6 + AnyShelleyBasedEra ShelleyBasedEraDijkstra -> 7 toEnum = \case 1 -> AnyShelleyBasedEra ShelleyBasedEraShelley @@ -337,6 +346,7 @@ type family ShelleyLedgerEra era = ledgerera | ledgerera -> era where ShelleyLedgerEra AlonzoEra = L.AlonzoEra ShelleyLedgerEra BabbageEra = L.BabbageEra ShelleyLedgerEra ConwayEra = L.ConwayEra + ShelleyLedgerEra DijkstraEra = L.DijkstraEra -- | Lookup the lower major protocol version for the shelley based era. In other words -- this is the major protocol version that the era has started in. @@ -348,6 +358,7 @@ eraProtVerLow = \case ShelleyBasedEraAlonzo -> L.eraProtVerLow @L.AlonzoEra ShelleyBasedEraBabbage -> L.eraProtVerLow @L.BabbageEra ShelleyBasedEraConway -> L.eraProtVerLow @L.ConwayEra + ShelleyBasedEraDijkstra -> L.eraProtVerLow @L.DijkstraEra requireShelleyBasedEra :: () From dda8797462bf790bcfef5aa845fc35cc42a0af13 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Wed, 30 Jul 2025 08:35:30 -0400 Subject: [PATCH 04/42] Add Dijkstra era to eons --- cardano-api/src/Cardano/Api/Era/Internal/Case.hs | 10 ++++++++++ .../Api/Era/Internal/Eon/AllegraEraOnwards.hs | 5 +++++ .../Cardano/Api/Era/Internal/Eon/AlonzoEraOnwards.hs | 5 +++++ .../Api/Era/Internal/Eon/BabbageEraOnwards.hs | 7 +++++++ .../Cardano/Api/Era/Internal/Eon/ByronToAlonzoEra.hs | 1 + .../Cardano/Api/Era/Internal/Eon/ConwayEraOnwards.hs | 12 ++++++++++-- .../Cardano/Api/Era/Internal/Eon/MaryEraOnwards.hs | 5 +++++ .../Cardano/Api/Era/Internal/Eon/ShelleyEraOnly.hs | 1 + .../Api/Era/Internal/Eon/ShelleyToAllegraEra.hs | 1 + .../Api/Era/Internal/Eon/ShelleyToAlonzoEra.hs | 1 + .../Api/Era/Internal/Eon/ShelleyToBabbageEra.hs | 1 + .../Cardano/Api/Era/Internal/Eon/ShelleyToMaryEra.hs | 1 + 12 files changed, 48 insertions(+), 2 deletions(-) diff --git a/cardano-api/src/Cardano/Api/Era/Internal/Case.hs b/cardano-api/src/Cardano/Api/Era/Internal/Case.hs index a7049a6d6e..d78672ee55 100644 --- a/cardano-api/src/Cardano/Api/Era/Internal/Case.hs +++ b/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 diff --git a/cardano-api/src/Cardano/Api/Era/Internal/Eon/AllegraEraOnwards.hs b/cardano-api/src/Cardano/Api/Era/Internal/Eon/AllegraEraOnwards.hs index 709c3fee0a..a59a731a3e 100644 --- a/cardano-api/src/Cardano/Api/Era/Internal/Eon/AllegraEraOnwards.hs +++ b/cardano-api/src/Cardano/Api/Era/Internal/Eon/AllegraEraOnwards.hs @@ -46,6 +46,7 @@ data AllegraEraOnwards era where AllegraEraOnwardsAlonzo :: AllegraEraOnwards AlonzoEra AllegraEraOnwardsBabbage :: AllegraEraOnwards BabbageEra AllegraEraOnwardsConway :: AllegraEraOnwards ConwayEra + AllegraEraOnwardsDijkstra :: AllegraEraOnwards DijkstraEra deriving instance Show (AllegraEraOnwards era) @@ -60,6 +61,7 @@ instance Eon AllegraEraOnwards where AlonzoEra -> yes AllegraEraOnwardsAlonzo BabbageEra -> yes AllegraEraOnwardsBabbage ConwayEra -> yes AllegraEraOnwardsConway + DijkstraEra -> yes AllegraEraOnwardsDijkstra instance ToCardanoEra AllegraEraOnwards where toCardanoEra = \case @@ -68,6 +70,7 @@ instance ToCardanoEra AllegraEraOnwards where AllegraEraOnwardsAlonzo -> AlonzoEra AllegraEraOnwardsBabbage -> BabbageEra AllegraEraOnwardsConway -> ConwayEra + AllegraEraOnwardsDijkstra -> DijkstraEra instance Convert AllegraEraOnwards CardanoEra where convert = toCardanoEra @@ -79,6 +82,7 @@ instance Convert AllegraEraOnwards ShelleyBasedEra where AllegraEraOnwardsAlonzo -> ShelleyBasedEraAlonzo AllegraEraOnwardsBabbage -> ShelleyBasedEraBabbage AllegraEraOnwardsConway -> ShelleyBasedEraConway + AllegraEraOnwardsDijkstra -> ShelleyBasedEraDijkstra type AllegraEraOnwardsConstraints era = ( C.HashAlgorithm L.HASH @@ -116,6 +120,7 @@ allegraEraOnwardsConstraints = \case AllegraEraOnwardsAlonzo -> id AllegraEraOnwardsBabbage -> id AllegraEraOnwardsConway -> id + AllegraEraOnwardsDijkstra -> id {-# DEPRECATED allegraEraOnwardsToShelleyBasedEra "Use 'convert' instead." #-} allegraEraOnwardsToShelleyBasedEra :: AllegraEraOnwards era -> ShelleyBasedEra era diff --git a/cardano-api/src/Cardano/Api/Era/Internal/Eon/AlonzoEraOnwards.hs b/cardano-api/src/Cardano/Api/Era/Internal/Eon/AlonzoEraOnwards.hs index 5c688eeac0..ac9ba0de4f 100644 --- a/cardano-api/src/Cardano/Api/Era/Internal/Eon/AlonzoEraOnwards.hs +++ b/cardano-api/src/Cardano/Api/Era/Internal/Eon/AlonzoEraOnwards.hs @@ -53,6 +53,7 @@ data AlonzoEraOnwards era where AlonzoEraOnwardsAlonzo :: AlonzoEraOnwards AlonzoEra AlonzoEraOnwardsBabbage :: AlonzoEraOnwards BabbageEra AlonzoEraOnwardsConway :: AlonzoEraOnwards ConwayEra + AlonzoEraOnwardsDijkstra :: AlonzoEraOnwards DijkstraEra deriving instance Show (AlonzoEraOnwards era) @@ -67,12 +68,14 @@ instance Eon AlonzoEraOnwards where AlonzoEra -> yes AlonzoEraOnwardsAlonzo BabbageEra -> yes AlonzoEraOnwardsBabbage ConwayEra -> yes AlonzoEraOnwardsConway + DijkstraEra -> yes AlonzoEraOnwardsDijkstra instance ToCardanoEra AlonzoEraOnwards where toCardanoEra = \case AlonzoEraOnwardsAlonzo -> AlonzoEra AlonzoEraOnwardsBabbage -> BabbageEra AlonzoEraOnwardsConway -> ConwayEra + AlonzoEraOnwardsDijkstra -> DijkstraEra instance Convert AlonzoEraOnwards CardanoEra where convert = toCardanoEra @@ -82,6 +85,7 @@ instance Convert AlonzoEraOnwards ShelleyBasedEra where AlonzoEraOnwardsAlonzo -> ShelleyBasedEraAlonzo AlonzoEraOnwardsBabbage -> ShelleyBasedEraBabbage AlonzoEraOnwardsConway -> ShelleyBasedEraConway + AlonzoEraOnwardsDijkstra -> ShelleyBasedEraDijkstra type AlonzoEraOnwardsConstraints era = ( C.HashAlgorithm L.HASH @@ -127,6 +131,7 @@ alonzoEraOnwardsConstraints = \case AlonzoEraOnwardsAlonzo -> id AlonzoEraOnwardsBabbage -> id AlonzoEraOnwardsConway -> id + AlonzoEraOnwardsDijkstra -> id {-# DEPRECATED alonzoEraOnwardsToShelleyBasedEra "Use 'convert' instead." #-} alonzoEraOnwardsToShelleyBasedEra :: AlonzoEraOnwards era -> ShelleyBasedEra era diff --git a/cardano-api/src/Cardano/Api/Era/Internal/Eon/BabbageEraOnwards.hs b/cardano-api/src/Cardano/Api/Era/Internal/Eon/BabbageEraOnwards.hs index de9d823caa..4be939edf0 100644 --- a/cardano-api/src/Cardano/Api/Era/Internal/Eon/BabbageEraOnwards.hs +++ b/cardano-api/src/Cardano/Api/Era/Internal/Eon/BabbageEraOnwards.hs @@ -51,6 +51,7 @@ import Data.Typeable (Typeable) data BabbageEraOnwards era where BabbageEraOnwardsBabbage :: BabbageEraOnwards BabbageEra BabbageEraOnwardsConway :: BabbageEraOnwards ConwayEra + BabbageEraOnwardsDijkstra :: BabbageEraOnwards DijkstraEra deriving instance Show (BabbageEraOnwards era) @@ -65,11 +66,13 @@ instance Eon BabbageEraOnwards where AlonzoEra -> no BabbageEra -> yes BabbageEraOnwardsBabbage ConwayEra -> yes BabbageEraOnwardsConway + DijkstraEra -> yes BabbageEraOnwardsDijkstra instance ToCardanoEra BabbageEraOnwards where toCardanoEra = \case BabbageEraOnwardsBabbage -> BabbageEra BabbageEraOnwardsConway -> ConwayEra + BabbageEraOnwardsDijkstra -> DijkstraEra instance Convert BabbageEraOnwards CardanoEra where convert = toCardanoEra @@ -78,16 +81,19 @@ instance Convert BabbageEraOnwards ShelleyBasedEra where convert = \case BabbageEraOnwardsBabbage -> ShelleyBasedEraBabbage BabbageEraOnwardsConway -> ShelleyBasedEraConway + BabbageEraOnwardsDijkstra -> ShelleyBasedEraDijkstra instance Convert BabbageEraOnwards MaryEraOnwards where convert = \case BabbageEraOnwardsBabbage -> MaryEraOnwardsBabbage BabbageEraOnwardsConway -> MaryEraOnwardsConway + BabbageEraOnwardsDijkstra -> MaryEraOnwardsDijkstra instance Convert BabbageEraOnwards AlonzoEraOnwards where convert = \case BabbageEraOnwardsBabbage -> AlonzoEraOnwardsBabbage BabbageEraOnwardsConway -> AlonzoEraOnwardsConway + BabbageEraOnwardsDijkstra -> AlonzoEraOnwardsDijkstra type BabbageEraOnwardsConstraints era = ( C.HashAlgorithm L.HASH @@ -131,6 +137,7 @@ babbageEraOnwardsConstraints babbageEraOnwardsConstraints = \case BabbageEraOnwardsBabbage -> id BabbageEraOnwardsConway -> id + BabbageEraOnwardsDijkstra -> id {-# DEPRECATED babbageEraOnwardsToShelleyBasedEra "Use 'convert' instead." #-} babbageEraOnwardsToShelleyBasedEra :: BabbageEraOnwards era -> ShelleyBasedEra era diff --git a/cardano-api/src/Cardano/Api/Era/Internal/Eon/ByronToAlonzoEra.hs b/cardano-api/src/Cardano/Api/Era/Internal/Eon/ByronToAlonzoEra.hs index e5b31553cb..318ea303df 100644 --- a/cardano-api/src/Cardano/Api/Era/Internal/Eon/ByronToAlonzoEra.hs +++ b/cardano-api/src/Cardano/Api/Era/Internal/Eon/ByronToAlonzoEra.hs @@ -40,6 +40,7 @@ instance Eon ByronToAlonzoEra where AlonzoEra -> yes ByronToAlonzoEraAlonzo BabbageEra -> no ConwayEra -> no + DijkstraEra -> no instance ToCardanoEra ByronToAlonzoEra where toCardanoEra = \case diff --git a/cardano-api/src/Cardano/Api/Era/Internal/Eon/ConwayEraOnwards.hs b/cardano-api/src/Cardano/Api/Era/Internal/Eon/ConwayEraOnwards.hs index cb698488ea..da2e2a9f5b 100644 --- a/cardano-api/src/Cardano/Api/Era/Internal/Eon/ConwayEraOnwards.hs +++ b/cardano-api/src/Cardano/Api/Era/Internal/Eon/ConwayEraOnwards.hs @@ -37,9 +37,9 @@ import Cardano.Ledger.Api qualified as L import Cardano.Ledger.BaseTypes qualified as L import Cardano.Ledger.Conway.Core qualified as L import Cardano.Ledger.Conway.Governance qualified as L +import Cardano.Ledger.Conway.State qualified as L import Cardano.Ledger.Conway.TxCert qualified as L import Cardano.Ledger.Mary.Value qualified as L -import Cardano.Ledger.State qualified as L import Cardano.Protocol.Crypto qualified as L import Ouroboros.Consensus.Protocol.Abstract qualified as Consensus import Ouroboros.Consensus.Protocol.Praos.Common qualified as Consensus @@ -51,6 +51,7 @@ import Data.Typeable (Typeable) data ConwayEraOnwards era where ConwayEraOnwardsConway :: ConwayEraOnwards ConwayEra + ConwayEraOnwardsDijkstra :: ConwayEraOnwards DijkstraEra deriving instance Show (ConwayEraOnwards era) @@ -67,10 +68,12 @@ instance Eon ConwayEraOnwards where AlonzoEra -> no BabbageEra -> no ConwayEra -> yes ConwayEraOnwardsConway + DijkstraEra -> yes ConwayEraOnwardsDijkstra instance ToCardanoEra ConwayEraOnwards where toCardanoEra = \case ConwayEraOnwardsConway -> ConwayEra + ConwayEraOnwardsDijkstra -> DijkstraEra instance Convert ConwayEraOnwards CardanoEra where convert = toCardanoEra @@ -78,17 +81,21 @@ instance Convert ConwayEraOnwards CardanoEra where instance Convert ConwayEraOnwards ShelleyBasedEra where convert = \case ConwayEraOnwardsConway -> ShelleyBasedEraConway + ConwayEraOnwardsDijkstra -> ShelleyBasedEraDijkstra instance Convert ConwayEraOnwards AllegraEraOnwards where convert = \case ConwayEraOnwardsConway -> AllegraEraOnwardsConway + ConwayEraOnwardsDijkstra -> AllegraEraOnwardsDijkstra instance Convert ConwayEraOnwards BabbageEraOnwards where convert = \case ConwayEraOnwardsConway -> BabbageEraOnwardsConway + ConwayEraOnwardsDijkstra -> BabbageEraOnwardsDijkstra type ConwayEraOnwardsConstraints era = - ( C.HashAlgorithm L.HASH + ( L.ConwayEraCertState (ShelleyLedgerEra era) + , C.HashAlgorithm L.HASH , C.Signable (L.VRF L.StandardCrypto) L.Seed , Consensus.PraosProtocolSupportsNode (ConsensusProtocol era) , Consensus.ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era) ~ ConsensusBlockForEra era @@ -133,6 +140,7 @@ conwayEraOnwardsConstraints -> a conwayEraOnwardsConstraints = \case ConwayEraOnwardsConway -> id + ConwayEraOnwardsDijkstra -> id {-# DEPRECATED conwayEraOnwardsToShelleyBasedEra "Use 'convert' instead." #-} conwayEraOnwardsToShelleyBasedEra :: ConwayEraOnwards era -> ShelleyBasedEra era diff --git a/cardano-api/src/Cardano/Api/Era/Internal/Eon/MaryEraOnwards.hs b/cardano-api/src/Cardano/Api/Era/Internal/Eon/MaryEraOnwards.hs index 2e93bca9fe..5be4ebe10d 100644 --- a/cardano-api/src/Cardano/Api/Era/Internal/Eon/MaryEraOnwards.hs +++ b/cardano-api/src/Cardano/Api/Era/Internal/Eon/MaryEraOnwards.hs @@ -48,6 +48,7 @@ data MaryEraOnwards era where MaryEraOnwardsAlonzo :: MaryEraOnwards AlonzoEra MaryEraOnwardsBabbage :: MaryEraOnwards BabbageEra MaryEraOnwardsConway :: MaryEraOnwards ConwayEra + MaryEraOnwardsDijkstra :: MaryEraOnwards DijkstraEra deriving instance Show (MaryEraOnwards era) @@ -62,6 +63,7 @@ instance Eon MaryEraOnwards where AlonzoEra -> yes MaryEraOnwardsAlonzo BabbageEra -> yes MaryEraOnwardsBabbage ConwayEra -> yes MaryEraOnwardsConway + DijkstraEra -> yes MaryEraOnwardsDijkstra instance ToCardanoEra MaryEraOnwards where toCardanoEra = \case @@ -69,6 +71,7 @@ instance ToCardanoEra MaryEraOnwards where MaryEraOnwardsAlonzo -> AlonzoEra MaryEraOnwardsBabbage -> BabbageEra MaryEraOnwardsConway -> ConwayEra + MaryEraOnwardsDijkstra -> DijkstraEra instance Convert MaryEraOnwards CardanoEra where convert = toCardanoEra @@ -79,6 +82,7 @@ instance Convert MaryEraOnwards ShelleyBasedEra where MaryEraOnwardsAlonzo -> ShelleyBasedEraAlonzo MaryEraOnwardsBabbage -> ShelleyBasedEraBabbage MaryEraOnwardsConway -> ShelleyBasedEraConway + MaryEraOnwardsDijkstra -> ShelleyBasedEraDijkstra type MaryEraOnwardsConstraints era = ( C.HashAlgorithm L.HASH @@ -117,6 +121,7 @@ maryEraOnwardsConstraints = \case MaryEraOnwardsAlonzo -> id MaryEraOnwardsBabbage -> id MaryEraOnwardsConway -> id + MaryEraOnwardsDijkstra -> id {-# DEPRECATED maryEraOnwardsToShelleyBasedEra "Use 'convert' instead." #-} maryEraOnwardsToShelleyBasedEra :: MaryEraOnwards era -> ShelleyBasedEra era diff --git a/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyEraOnly.hs b/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyEraOnly.hs index cdbc90c9db..8e5d76de09 100644 --- a/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyEraOnly.hs +++ b/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyEraOnly.hs @@ -57,6 +57,7 @@ instance Eon ShelleyEraOnly where AlonzoEra -> no BabbageEra -> no ConwayEra -> no + DijkstraEra -> no instance ToCardanoEra ShelleyEraOnly where toCardanoEra = \case diff --git a/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyToAllegraEra.hs b/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyToAllegraEra.hs index 73ebb6fb06..529487624c 100644 --- a/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyToAllegraEra.hs +++ b/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyToAllegraEra.hs @@ -59,6 +59,7 @@ instance Eon ShelleyToAllegraEra where AlonzoEra -> no BabbageEra -> no ConwayEra -> no + DijkstraEra -> no instance ToCardanoEra ShelleyToAllegraEra where toCardanoEra = \case diff --git a/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyToAlonzoEra.hs b/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyToAlonzoEra.hs index 9d7c425cb2..8c38e43e91 100644 --- a/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyToAlonzoEra.hs +++ b/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyToAlonzoEra.hs @@ -59,6 +59,7 @@ instance Eon ShelleyToAlonzoEra where AlonzoEra -> yes ShelleyToAlonzoEraAlonzo BabbageEra -> no ConwayEra -> no + DijkstraEra -> no instance ToCardanoEra ShelleyToAlonzoEra where toCardanoEra = \case diff --git a/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyToBabbageEra.hs b/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyToBabbageEra.hs index f40f67799b..0eede2a88d 100644 --- a/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyToBabbageEra.hs +++ b/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyToBabbageEra.hs @@ -62,6 +62,7 @@ instance Eon ShelleyToBabbageEra where AlonzoEra -> yes ShelleyToBabbageEraAlonzo BabbageEra -> yes ShelleyToBabbageEraBabbage ConwayEra -> no + DijkstraEra -> no instance ToCardanoEra ShelleyToBabbageEra where toCardanoEra = \case diff --git a/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyToMaryEra.hs b/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyToMaryEra.hs index ed504a4783..c8219bdd5a 100644 --- a/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyToMaryEra.hs +++ b/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyToMaryEra.hs @@ -59,6 +59,7 @@ instance Eon ShelleyToMaryEra where AlonzoEra -> no BabbageEra -> no ConwayEra -> no + DijkstraEra -> no instance ToCardanoEra ShelleyToMaryEra where toCardanoEra = \case From 704d11d77c118d4bd535b7a5a6c2748eae86247d Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Wed, 30 Jul 2025 08:42:06 -0400 Subject: [PATCH 05/42] Add `DijkstraEra` to `Era era` --- .../src/Cardano/Api/Experimental/Era.hs | 22 ++++++++++++++++++- 1 file changed, 21 insertions(+), 1 deletion(-) diff --git a/cardano-api/src/Cardano/Api/Experimental/Era.hs b/cardano-api/src/Cardano/Api/Experimental/Era.hs index 8c1c87fe32..0e0051a0bb 100644 --- a/cardano-api/src/Cardano/Api/Experimental/Era.hs +++ b/cardano-api/src/Cardano/Api/Experimental/Era.hs @@ -34,7 +34,7 @@ where import Cardano.Api.Consensus import Cardano.Api.Era qualified as Api -import Cardano.Api.Era.Internal.Core (BabbageEra, ConwayEra, Eon (..)) +import Cardano.Api.Era.Internal.Core (BabbageEra, ConwayEra, DijkstraEra, Eon (..)) import Cardano.Api.Era.Internal.Eon.AlonzoEraOnwards import Cardano.Api.Era.Internal.Eon.BabbageEraOnwards import Cardano.Api.Era.Internal.Eon.Convert @@ -70,6 +70,7 @@ import Prettyprinter -- and the next (upcoming) era. type family LedgerEra era = (r :: Type) | r -> era where LedgerEra ConwayEra = Ledger.ConwayEra + LedgerEra DijkstraEra = L.DijkstraEra -- | An existential wrapper for types of kind @k -> Type@. It can hold any -- era, for example, @Some Era@. The era witness can be brought back into scope, @@ -98,6 +99,7 @@ data Some (f :: k -> Type) where data Era era where -- | The currently active era on the Cardano mainnet. ConwayEra :: Era ConwayEra + DijkstraEra :: Era DijkstraEra deriving instance Show (Era era) @@ -108,6 +110,8 @@ instance Pretty (Era era) where instance TestEquality Era where testEquality ConwayEra ConwayEra = Just Refl + testEquality DijkstraEra DijkstraEra = Just Refl + testEquality _ _ = Nothing instance ToJSON (Era era) where toJSON = eraToStringLike @@ -126,6 +130,7 @@ instance Enum (Some Era) where toEnum 0 = Some ConwayEra toEnum i = error $ "Enum.toEnum: invalid argument " <> show i <> " - does not correspond to any era" fromEnum (Some ConwayEra) = 0 + fromEnum (Some DijkstraEra) = 1 instance Ord (Some Era) where compare e1 e2 = compare (fromEnum e1) (fromEnum e2) @@ -155,16 +160,19 @@ instance Eon Era where instance Api.ToCardanoEra Era where toCardanoEra = \case ConwayEra -> Api.ConwayEra + DijkstraEra -> Api.DijkstraEra eraToStringLike :: IsString a => Era era -> a {-# INLINE eraToStringLike #-} eraToStringLike = \case ConwayEra -> "Conway" + DijkstraEra -> "Dijkstra" eraFromStringLike :: (IsString a, Eq a) => a -> Either a (Some Era) {-# INLINE eraFromStringLike #-} eraFromStringLike = \case "Conway" -> pure $ Some ConwayEra + "Dijkstra" -> pure $ Some DijkstraEra wrong -> Left wrong -- | How to deprecate an era: @@ -205,30 +213,37 @@ eraToSbe = convert instance Convert Era Api.CardanoEra where convert = \case ConwayEra -> Api.ConwayEra + DijkstraEra -> Api.DijkstraEra instance Convert Era ShelleyBasedEra where convert = \case ConwayEra -> ShelleyBasedEraConway + DijkstraEra -> ShelleyBasedEraDijkstra instance Convert Era AlonzoEraOnwards where convert = \case ConwayEra -> AlonzoEraOnwardsConway + DijkstraEra -> AlonzoEraOnwardsDijkstra instance Convert Era BabbageEraOnwards where convert = \case ConwayEra -> BabbageEraOnwardsConway + DijkstraEra -> BabbageEraOnwardsDijkstra instance Convert Era MaryEraOnwards where convert = \case ConwayEra -> MaryEraOnwardsConway + DijkstraEra -> MaryEraOnwardsDijkstra instance Convert Era ConwayEraOnwards where convert = \case ConwayEra -> ConwayEraOnwardsConway + DijkstraEra -> ConwayEraOnwardsDijkstra instance Convert ConwayEraOnwards Era where convert = \case ConwayEraOnwardsConway -> ConwayEra + ConwayEraOnwardsDijkstra -> DijkstraEra newtype DeprecatedEra era = DeprecatedEra (ShelleyBasedEra era) @@ -245,6 +260,7 @@ sbeToEra => ShelleyBasedEra era -> m (Era era) sbeToEra ShelleyBasedEraConway = return ConwayEra +sbeToEra ShelleyBasedEraDijkstra = return DijkstraEra sbeToEra e@ShelleyBasedEraBabbage = throwError $ DeprecatedEra e sbeToEra e@ShelleyBasedEraAlonzo = throwError $ DeprecatedEra e sbeToEra e@ShelleyBasedEraMary = throwError $ DeprecatedEra e @@ -264,11 +280,15 @@ class IsEra era where instance IsEra ConwayEra where useEra = ConwayEra +instance IsEra DijkstraEra where + useEra = DijkstraEra + obtainCommonConstraints :: Era era -> (EraCommonConstraints era => a) -> a obtainCommonConstraints ConwayEra x = x +obtainCommonConstraints DijkstraEra x = x type EraCommonConstraints era = ( L.AllegraEraScript (LedgerEra era) From 7a86381ede7861c0e5e6c97171e75b863e33076b Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Wed, 30 Jul 2025 09:18:36 -0400 Subject: [PATCH 06/42] COMBINE ME: cabal file updates --- cardano-api/cardano-api.cabal | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index 31f195933b..6c7188d518 100644 --- a/cardano-api/cardano-api.cabal +++ b/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, From 5be60e068ca3331ecdd1982cb775dab939b30579 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Wed, 30 Jul 2025 09:20:52 -0400 Subject: [PATCH 07/42] Update `QueryInShelleyBasedEra era result` - QueryAccountState returns `ChainAccountState` instead of `AccountState` - Use updated consensus queries `GetStakeDistribution2` and `GetPoolDistr2` --- cardano-api/src/Cardano/Api/Block.hs | 10 ++++- .../Api/Query/Internal/Type/QueryInMode.hs | 43 ++++++++++++------- 2 files changed, 36 insertions(+), 17 deletions(-) diff --git a/cardano-api/src/Cardano/Api/Block.hs b/cardano-api/src/Cardano/Api/Block.hs index 8760593873..20ccaaea70 100644 --- a/cardano-api/src/Cardano/Api/Block.hs +++ b/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 diff --git a/cardano-api/src/Cardano/Api/Query/Internal/Type/QueryInMode.hs b/cardano-api/src/Cardano/Api/Query/Internal/Type/QueryInMode.hs index e9b7913450..9b815ef809 100644 --- a/cardano-api/src/Cardano/Api/Query/Internal/Type/QueryInMode.hs +++ b/cardano-api/src/Cardano/Api/Query/Internal/Type/QueryInMode.hs @@ -72,6 +72,7 @@ import Cardano.Api.Certificate.Internal import Cardano.Api.Consensus.Internal.Mode import Cardano.Api.Era.Internal.Case import Cardano.Api.Era.Internal.Core +import Cardano.Api.Era.Internal.Eon.ConwayEraOnwards import Cardano.Api.Era.Internal.Eon.ShelleyBasedEra import Cardano.Api.Genesis.Internal.Parameters import Cardano.Api.HasTypeProxy (HasTypeProxy (..), Proxy) @@ -93,12 +94,11 @@ import Cardano.Ledger.Api qualified as L import Cardano.Ledger.Api.State.Query qualified as L import Cardano.Ledger.Binary import Cardano.Ledger.Binary.Plain qualified as Plain -import Cardano.Ledger.CertState qualified as L import Cardano.Ledger.Coin qualified as L +import Cardano.Ledger.Conway.State qualified as L import Cardano.Ledger.Credential qualified as Shelley import Cardano.Ledger.Shelley.API qualified as Shelley import Cardano.Ledger.Shelley.Core qualified as Core -import Cardano.Ledger.Shelley.LedgerState qualified as L import Cardano.Slotting.EpochInfo (hoistEpochInfo) import Cardano.Slotting.Slot (WithOrigin (..)) import Cardano.Slotting.Time (SystemStart (..)) @@ -116,9 +116,8 @@ import Ouroboros.Consensus.Ledger.Query qualified as Consensus import Ouroboros.Consensus.Protocol.Abstract qualified as Consensus import Ouroboros.Consensus.Shelley.Ledger qualified as Consensus import Ouroboros.Consensus.Shelley.Ledger.Query.Types qualified as Consensus -import Ouroboros.Consensus.Shelley.Protocol.Abstract (ProtoCrypto) import Ouroboros.Network.Block (Serialised (..)) -import Ouroboros.Network.PeerSelection.LedgerPeers.Type (LedgerPeerSnapshot) +import Ouroboros.Network.PeerSelection.LedgerPeers.Type import Ouroboros.Network.Protocol.LocalStateQuery.Client (Some (..)) import Codec.Serialise qualified as CBOR @@ -286,7 +285,7 @@ data QueryInShelleyBasedEra era result where :: Set StakeCredential -> QueryInShelleyBasedEra era (Map StakeCredential L.Coin) QueryAccountState - :: QueryInShelleyBasedEra era L.AccountState + :: QueryInShelleyBasedEra era L.ChainAccountState QueryConstitution :: QueryInShelleyBasedEra era (L.Constitution (ShelleyLedgerEra era)) QueryGovState @@ -406,7 +405,7 @@ decodePoolState (SerialisedPoolState (Serialised ls)) = newtype SerialisedPoolDistribution era = SerialisedPoolDistribution - (Serialised (Consensus.PoolDistr StandardCrypto)) + (Serialised Shelley.PoolDistr) newtype PoolDistribution era = PoolDistribution { unPoolDistr :: Consensus.PoolDistr StandardCrypto @@ -477,15 +476,15 @@ fromLedgerUTxO sbe (Shelley.UTxO utxo) = $ utxo fromShelleyPoolDistr - :: Consensus.PoolDistr StandardCrypto + :: Shelley.PoolDistr -> Map (Hash StakePoolKey) Rational fromShelleyPoolDistr = -- TODO: write an appropriate property to show it is safe to use -- Map.fromListAsc or to use Map.mapKeysMonotonic fromList - . map (bimap StakePoolKeyHash Consensus.individualPoolStake) + . map (bimap StakePoolKeyHash Shelley.individualPoolStake) . toList - . Consensus.unPoolDistr + . Shelley.unPoolDistr fromShelleyDelegations :: Map @@ -564,7 +563,7 @@ toConsensusQueryShelleyBased sbe = \case QueryProtocolParameters -> Some (consensusQueryInEraInMode era Consensus.GetCurrentPParams) QueryStakeDistribution -> - Some (consensusQueryInEraInMode era Consensus.GetStakeDistribution) + Some (consensusQueryInEraInMode era Consensus.GetStakeDistribution2) QueryUTxO QueryUTxOWhole -> Some (consensusQueryInEraInMode era Consensus.GetUTxOWhole) QueryUTxO (QueryUTxOByAddress addrs) -> @@ -613,7 +612,7 @@ toConsensusQueryShelleyBased sbe = \case ) QueryPoolDistribution poolIds -> Some - (consensusQueryInEraInMode era (Consensus.GetCBOR (Consensus.GetPoolDistr (getPoolIds <$> poolIds)))) + (consensusQueryInEraInMode era (Consensus.GetCBOR (Consensus.GetPoolDistr2 (getPoolIds <$> poolIds)))) where getPoolIds :: Set PoolId -> Set (Shelley.KeyHash Shelley.StakePool) getPoolIds = Set.map (\(StakePoolKeyHash kh) -> kh) @@ -640,7 +639,9 @@ toConsensusQueryShelleyBased sbe = \case QueryDRepState creds -> caseShelleyToBabbageOrConwayEraOnwards (const $ error "toConsensusQueryShelleyBased: QueryDRepState is only available in the Conway era") - (const $ Some (consensusQueryInEraInMode era (Consensus.GetDRepState creds))) + ( \w -> + Some (consensusQueryInEraInMode era (conwayEraOnwardsConstraints w $ Consensus.GetDRepState creds)) + ) sbe QueryDRepStakeDistr dreps -> caseShelleyToBabbageOrConwayEraOnwards @@ -727,6 +728,7 @@ consensusQueryInEraInMode erainmode b = AlonzoEra -> Consensus.QueryIfCurrentAlonzo b BabbageEra -> Consensus.QueryIfCurrentBabbage b ConwayEra -> Consensus.QueryIfCurrentConway b + DijkstraEra -> Consensus.QueryIfCurrentDijkstra b -- ---------------------------------------------------------------------------- -- Conversions of query results from the consensus types. @@ -849,6 +851,18 @@ fromConsensusQueryResult (QueryInEra (QueryInShelleyBasedEra ShelleyBasedEraConw ) r' _ -> fromConsensusQueryResultMismatch +fromConsensusQueryResult (QueryInEra (QueryInShelleyBasedEra ShelleyBasedEraDijkstra q)) q' r' = + case q' of + Consensus.BlockQuery (Consensus.QueryIfCurrentDijkstra q'') -> + bimap + fromConsensusEraMismatch + ( fromConsensusQueryResultShelleyBased + ShelleyBasedEraDijkstra + q + q'' + ) + r' + _ -> fromConsensusQueryResultMismatch -- This function is written like this so that we have exhaustive pattern checking -- on the @QueryInShelleyBasedEra era result@ value. Don't change the top-level @@ -858,7 +872,6 @@ fromConsensusQueryResultShelleyBased . HasCallStack => ShelleyLedgerEra era ~ ledgerera => ConsensusProtocol era ~ protocol - => ProtoCrypto protocol ~ StandardCrypto => ShelleyBasedEra era -> QueryInShelleyBasedEra era result -> Consensus.BlockQuery (Consensus.ShelleyBlock protocol ledgerera) fp result' @@ -884,7 +897,7 @@ fromConsensusQueryResultShelleyBased sbe sbeQuery q' r' = _ -> fromConsensusQueryResultMismatch QueryStakeDistribution -> case q' of - Consensus.GetStakeDistribution -> fromShelleyPoolDistr r' + Consensus.GetStakeDistribution2 -> fromShelleyPoolDistr r' _ -> fromConsensusQueryResultMismatch QueryUTxO QueryUTxOWhole -> case q' of @@ -939,7 +952,7 @@ fromConsensusQueryResultShelleyBased sbe sbeQuery q' r' = _ -> fromConsensusQueryResultMismatch QueryPoolDistribution{} -> case q' of - Consensus.GetCBOR Consensus.GetPoolDistr{} -> + Consensus.GetCBOR Consensus.GetPoolDistr2{} -> SerialisedPoolDistribution r' _ -> fromConsensusQueryResultMismatch QueryStakeSnapshot{} -> From 3a8826d011bbb36a64cd18f717fcc4ecdd59f14f Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Wed, 30 Jul 2025 09:23:51 -0400 Subject: [PATCH 08/42] Update `makeShelleyTransactionBody` with Dijkstra era --- .../src/Cardano/Api/Tx/Internal/Body.hs | 210 ++++++++++++++++-- 1 file changed, 196 insertions(+), 14 deletions(-) diff --git a/cardano-api/src/Cardano/Api/Tx/Internal/Body.hs b/cardano-api/src/Cardano/Api/Tx/Internal/Body.hs index 61dff7f7ad..a2f75f7c59 100644 --- a/cardano-api/src/Cardano/Api/Tx/Internal/Body.hs +++ b/cardano-api/src/Cardano/Api/Tx/Internal/Body.hs @@ -280,7 +280,6 @@ import Cardano.Ledger.BaseTypes (StrictMaybe (..)) import Cardano.Ledger.Binary (Annotated (..)) import Cardano.Ledger.Binary qualified as CBOR import Cardano.Ledger.Coin qualified as L -import Cardano.Ledger.Conway.Core qualified as L import Cardano.Ledger.Core () import Cardano.Ledger.Core qualified as Ledger import Cardano.Ledger.Credential qualified as Shelley @@ -1426,6 +1425,13 @@ validateTxBodyContent validateMetadata txMetadata validateTxInsCollateral txInsCollateral languages validateProtocolParameters txProtocolParams languages + ShelleyBasedEraDijkstra -> do + validateTxIns txIns + first TxBodyOutputError $ + validateTxOuts sbe txOuts + validateMetadata txMetadata + validateTxInsCollateral txInsCollateral languages + validateProtocolParameters txProtocolParams languages validateMetadata :: TxMetadataInEra era -> Either TxBodyError () validateMetadata txMetadata = @@ -1590,6 +1596,7 @@ fromLedgerTxIns sbe body = inputs_ ShelleyBasedEraAlonzo = view L.inputsTxBodyL inputs_ ShelleyBasedEraBabbage = view L.inputsTxBodyL inputs_ ShelleyBasedEraConway = view L.inputsTxBodyL + inputs_ ShelleyBasedEraDijkstra = view L.inputsTxBodyL fromLedgerTxInsCollateral :: forall era @@ -1696,6 +1703,11 @@ fromLedgerAuxiliaryData ShelleyBasedEraConway txAuxData = , fromShelleyBasedScript ShelleyBasedEraConway <$> toList (L.getAlonzoTxAuxDataScripts txAuxData) ) +fromLedgerAuxiliaryData ShelleyBasedEraDijkstra txAuxData = + ( fromShelleyMetadata (L.atadMetadata txAuxData) + , fromShelleyBasedScript ShelleyBasedEraDijkstra + <$> toList (L.getAlonzoTxAuxDataScripts txAuxData) + ) fromLedgerTxAuxiliaryData :: ShelleyBasedEra era @@ -2033,7 +2045,10 @@ mkCommonTxBody sbe txIns txOuts txFee txWithdrawals txAuxData = & L.auxDataHashTxBodyL .~ maybe SNothing (SJust . Ledger.hashTxAuxData) txAuxData -{-# DEPRECATED makeShelleyTransactionBody "Use 'createTransactionBody' instead." #-} +{-# DEPRECATED + makeShelleyTransactionBody + "Use 'createTransactionBody' instead. 'makeShelleyTransactionBody' will be removed after 11.0.0.0 release" + #-} makeShelleyTransactionBody :: forall era . () @@ -2593,6 +2608,159 @@ makeShelleyTransactionBody txAuxData :: Maybe (L.TxAuxData E.ConwayEra) txAuxData = toAuxiliaryData sbe txMetadata txAuxScripts +makeShelleyTransactionBody + sbe@ShelleyBasedEraDijkstra + txbodycontent@TxBodyContent + { txIns + , txInsCollateral + , txInsReference + , txReturnCollateral + , txTotalCollateral + , txOuts + , txFee + , txValidityLowerBound + , txValidityUpperBound + , txMetadata + , txAuxScripts + , txExtraKeyWits + , txProtocolParams + , txWithdrawals + , txCertificates + , txMintValue + , txScriptValidity + , txProposalProcedures + , txVotingProcedures + , txCurrentTreasuryValue + , txTreasuryDonation + } = do + let aOn = AllegraEraOnwardsDijkstra + let cOn = ConwayEraOnwardsDijkstra + let mOn = MaryEraOnwardsDijkstra + let bOn = BabbageEraOnwardsDijkstra + validateTxBodyContent sbe txbodycontent + let scriptIntegrityHash = + convPParamsToScriptIntegrityHash + AlonzoEraOnwardsDijkstra + txProtocolParams + redeemers + datums + languages + let txbody = + ( mkCommonTxBody sbe txIns txOuts txFee txWithdrawals txAuxData + & A.collateralInputsTxBodyL azOn + .~ case txInsCollateral of + TxInsCollateralNone -> Set.empty + TxInsCollateral _ txins -> fromList (map toShelleyTxIn txins) + & A.referenceInputsTxBodyL bOn + .~ convReferenceInputs txInsReference + & A.collateralReturnTxBodyL bOn + .~ convReturnCollateral sbe txReturnCollateral + & A.totalCollateralTxBodyL bOn + .~ convTotalCollateral txTotalCollateral + & A.certsTxBodyL sbe + .~ convCertificates sbe txCertificates + & A.invalidBeforeTxBodyL aOn + .~ convValidityLowerBound txValidityLowerBound + & A.invalidHereAfterTxBodyL sbe + .~ convValidityUpperBound sbe txValidityUpperBound + & A.reqSignerHashesTxBodyL azOn + .~ convExtraKeyWitnesses txExtraKeyWits + & A.mintTxBodyL mOn + .~ convMintValue txMintValue + & A.scriptIntegrityHashTxBodyL azOn + .~ scriptIntegrityHash + & A.votingProceduresTxBodyL cOn + .~ convVotingProcedures (maybe TxVotingProceduresNone unFeatured txVotingProcedures) + & A.proposalProceduresTxBodyL cOn + .~ convProposalProcedures (maybe TxProposalProceduresNone unFeatured txProposalProcedures) + & A.currentTreasuryValueTxBodyL cOn + .~ Ledger.maybeToStrictMaybe (unFeatured =<< txCurrentTreasuryValue) + & A.treasuryDonationTxBodyL cOn + .~ maybe (L.Coin 0) unFeatured txTreasuryDonation + -- TODO Conway: support optional network id in TxBodyContent + -- & L.networkIdTxBodyL .~ SNothing + ) + ^. A.txBodyL + return $ + ShelleyTxBody + sbe + txbody + scripts + ( TxBodyScriptData + AlonzoEraOnwardsDijkstra + datums + redeemers + ) + txAuxData + txScriptValidity + where + azOn = AlonzoEraOnwardsDijkstra + + witnesses :: [(ScriptWitnessIndex, AnyScriptWitness DijkstraEra)] + witnesses = collectTxBodyScriptWitnesses sbe txbodycontent + + scripts :: [Ledger.Script L.DijkstraEra] + scripts = + catMaybes + [ toShelleyScript <$> getScriptWitnessScript scriptwitness + | (_, AnyScriptWitness scriptwitness) <- witnesses + ] + + -- Note these do not include inline datums! + datums :: Alonzo.TxDats L.DijkstraEra + datums = + Alonzo.TxDats $ + fromList + [ (L.hashData d, d) + | d <- toAlonzoData <$> scriptdata + ] + + scriptdata :: [HashableScriptData] + scriptdata = + [d | TxOut _ _ (TxOutSupplementalDatum _ d) _ <- txOuts] + <> [ d + | ( _ + , AnyScriptWitness + ( PlutusScriptWitness + _ + _ + _ + (ScriptDatumForTxIn (Just d)) + _ + _ + ) + ) <- + witnesses + ] + + redeemers :: Alonzo.Redeemers L.DijkstraEra + redeemers = + Alonzo.Redeemers $ + fromList + [ (i, (toAlonzoData d, toAlonzoExUnits e)) + | ( idx + , AnyScriptWitness + (PlutusScriptWitness _ _ _ _ d e) + ) <- + witnesses + , Just i <- [fromScriptWitnessIndex azOn idx] + ] + + languages :: Set Plutus.Language + languages = + fromList $ + catMaybes + [ getScriptLanguage sw + | (_, AnyScriptWitness sw) <- witnesses + ] + + getScriptLanguage :: ScriptWitness witctx era -> Maybe Plutus.Language + getScriptLanguage (PlutusScriptWitness _ v _ _ _ _) = + Just $ toAlonzoLanguage (AnyPlutusScriptVersion v) + getScriptLanguage SimpleScriptWitness{} = Nothing + + txAuxData :: Maybe (L.TxAuxData L.DijkstraEra) + txAuxData = toAuxiliaryData sbe txMetadata txAuxScripts -- ---------------------------------------------------------------------------- -- Script witnesses within the tx body @@ -2697,6 +2865,7 @@ fromScriptWitnessIndex aOnwards widx = AlonzoEraOnwardsAlonzo -> fromScriptWitnessIndexAlonzo widx AlonzoEraOnwardsBabbage -> fromScriptWitnessIndexBabbage widx AlonzoEraOnwardsConway -> fromScriptWitnessIndexConway widx + AlonzoEraOnwardsDijkstra -> fromScriptWitnessIndexDijkstra widx fromScriptWitnessIndexAlonzo :: ScriptWitnessIndex -> Maybe (L.PlutusPurpose L.AsIx (ShelleyLedgerEra AlonzoEra)) @@ -2729,6 +2898,17 @@ fromScriptWitnessIndexConway i = ScriptWitnessIndexVoting n -> Just $ L.ConwayVoting (L.AsIx n) ScriptWitnessIndexProposing n -> Just $ L.ConwayProposing (L.AsIx n) +fromScriptWitnessIndexDijkstra + :: ScriptWitnessIndex -> Maybe (L.PlutusPurpose L.AsIx (ShelleyLedgerEra DijkstraEra)) +fromScriptWitnessIndexDijkstra i = + case i of + ScriptWitnessIndexTxIn n -> Just $ L.ConwaySpending (L.AsIx n) + ScriptWitnessIndexMint n -> Just $ L.ConwayMinting (L.AsIx n) + ScriptWitnessIndexCertificate n -> Just $ L.ConwayCertifying (L.AsIx n) + ScriptWitnessIndexWithdrawal n -> Just $ L.ConwayRewarding (L.AsIx n) + ScriptWitnessIndexVoting n -> Just $ L.ConwayVoting (L.AsIx n) + ScriptWitnessIndexProposing n -> Just $ L.ConwayProposing (L.AsIx n) + toScriptIndex :: AlonzoEraOnwards era -> L.PlutusPurpose L.AsIx (ShelleyLedgerEra era) @@ -2738,6 +2918,7 @@ toScriptIndex sbe scriptPurposeIndex = AlonzoEraOnwardsAlonzo -> toScriptIndexAlonzo scriptPurposeIndex AlonzoEraOnwardsBabbage -> toScriptIndexAlonzo scriptPurposeIndex AlonzoEraOnwardsConway -> toScriptIndexConway scriptPurposeIndex + AlonzoEraOnwardsDijkstra -> toScriptIndexConway scriptPurposeIndex toScriptIndexAlonzo :: L.AlonzoPlutusPurpose L.AsIx (ShelleyLedgerEra era) @@ -3002,18 +3183,17 @@ extractWitnessableVotes :: ConwayEraOnwards era -> TxBodyContent BuildTx era -> [(Witnessable VoterItem (ShelleyLedgerEra era), BuildTxWith BuildTx (Witness WitCtxStake era))] -extractWitnessableVotes e@ConwayEraOnwardsConway TxBodyContent{txVotingProcedures} = +extractWitnessableVotes e TxBodyContent{txVotingProcedures} = List.nub - [ (WitVote vote, BuildTxWith wit) - | (vote, wit) <- getVotes e $ maybe TxVotingProceduresNone unFeatured txVotingProcedures + [ (conwayEraOnwardsConstraints e $ WitVote vote, BuildTxWith wit) + | (vote, wit) <- getVotes $ maybe TxVotingProceduresNone unFeatured txVotingProcedures ] where getVotes - :: ConwayEraOnwards era - -> TxVotingProcedures BuildTx era + :: TxVotingProcedures BuildTx era -> [(L.Voter, Witness WitCtxStake era)] - getVotes ConwayEraOnwardsConway TxVotingProceduresNone = [] - getVotes ConwayEraOnwardsConway (TxVotingProcedures allVotingProcedures (BuildTxWith scriptWitnessedVotes)) = + getVotes TxVotingProceduresNone = [] + getVotes (TxVotingProcedures allVotingProcedures (BuildTxWith scriptWitnessedVotes)) = [ (voter, wit) | (voter, _) <- toList $ L.unVotingProcedures allVotingProcedures , let wit = case Map.lookup voter scriptWitnessedVotes of @@ -3025,9 +3205,9 @@ extractWitnessableProposals :: ConwayEraOnwards era -> TxBodyContent BuildTx era -> [(Witnessable ProposalItem (ShelleyLedgerEra era), BuildTxWith BuildTx (Witness WitCtxStake era))] -extractWitnessableProposals e@ConwayEraOnwardsConway TxBodyContent{txProposalProcedures} = +extractWitnessableProposals e TxBodyContent{txProposalProcedures} = List.nub - [ (WitProposal prop, BuildTxWith wit) + [ (conwayEraOnwardsConstraints e $ WitProposal prop, BuildTxWith wit) | (Proposal prop, wit) <- getProposals e $ maybe TxProposalProceduresNone unFeatured txProposalProcedures ] @@ -3036,9 +3216,9 @@ extractWitnessableProposals e@ConwayEraOnwardsConway TxBodyContent{txProposalPro :: ConwayEraOnwards era -> TxProposalProcedures BuildTx era -> [(Proposal era, Witness WitCtxStake era)] - getProposals ConwayEraOnwardsConway TxProposalProceduresNone = [] - getProposals ConwayEraOnwardsConway (TxProposalProcedures txps) = - [ (Proposal p, wit) + getProposals _ TxProposalProceduresNone = [] + getProposals w (TxProposalProcedures txps) = + [ (conwayEraOnwardsConstraints w $ Proposal p, wit) | (p, BuildTxWith mScriptWit) <- toList txps , let wit = case mScriptWit of Just sWit -> ScriptWitness ScriptWitnessForStakeAddr sWit @@ -3089,6 +3269,8 @@ toAuxiliaryData sbe txMetadata txAuxScripts = guard (not (Map.null ms && null ss)) $> L.mkAlonzoTxAuxData ms ss ShelleyBasedEraConway -> guard (not (Map.null ms && null ss)) $> L.mkAlonzoTxAuxData ms ss + ShelleyBasedEraDijkstra -> + guard (not (Map.null ms && null ss)) $> L.mkAlonzoTxAuxData ms ss -- ---------------------------------------------------------------------------- -- Other utilities helpful with making transaction bodies From e63bb2c36396d0cd5622b3b23e4c76322945cfc3 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Wed, 30 Jul 2025 09:27:30 -0400 Subject: [PATCH 09/42] Update ledger types `PParamUpdatePurpose`, `CommitteePurpose` and `ConstitutionPurpose` --- .../Governance/Internal/Action/ProposalProcedure.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/cardano-api/src/Cardano/Api/Governance/Internal/Action/ProposalProcedure.hs b/cardano-api/src/Cardano/Api/Governance/Internal/Action/ProposalProcedure.hs index f1b6002bb4..6ca5b03cfb 100644 --- a/cardano-api/src/Cardano/Api/Governance/Internal/Action/ProposalProcedure.hs +++ b/cardano-api/src/Cardano/Api/Governance/Internal/Action/ProposalProcedure.hs @@ -44,13 +44,13 @@ data AnyGovernanceAction = forall era. AnyGovernanceAction (Gov.GovAction era) -- TODO: Conway - Transitiion to Ledger.GovAction data GovernanceAction era = MotionOfNoConfidence - (StrictMaybe (Ledger.GovPurposeId Ledger.CommitteePurpose (ShelleyLedgerEra era))) + (StrictMaybe (Ledger.GovPurposeId Ledger.CommitteePurpose)) | ProposeNewConstitution - (StrictMaybe (Ledger.GovPurposeId Ledger.ConstitutionPurpose (ShelleyLedgerEra era))) + (StrictMaybe (Ledger.GovPurposeId Ledger.ConstitutionPurpose)) Ledger.Anchor (StrictMaybe Shelley.ScriptHash) | ProposeNewCommittee - (StrictMaybe (Ledger.GovPurposeId Ledger.CommitteePurpose (ShelleyLedgerEra era))) + (StrictMaybe (Ledger.GovPurposeId Ledger.CommitteePurpose)) [L.Credential ColdCommitteeRole] -- ^ Old constitutional committee (Map (L.Credential ColdCommitteeRole) EpochNo) @@ -63,11 +63,11 @@ data GovernanceAction era [(Network, StakeCredential, L.Coin)] !(StrictMaybe Shelley.ScriptHash) | InitiateHardfork - (StrictMaybe (Ledger.GovPurposeId Ledger.HardForkPurpose (ShelleyLedgerEra era))) + (StrictMaybe (Ledger.GovPurposeId Ledger.HardForkPurpose)) ProtVer | -- | Governance policy UpdatePParams - (StrictMaybe (Ledger.GovPurposeId Ledger.PParamUpdatePurpose (ShelleyLedgerEra era))) + (StrictMaybe (Ledger.GovPurposeId Ledger.PParamUpdatePurpose)) (Ledger.PParamsUpdate (ShelleyLedgerEra era)) !(StrictMaybe Shelley.ScriptHash) From 63ad603c3b23d2801b83e9d82198b6889775eeee Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Wed, 30 Jul 2025 09:29:25 -0400 Subject: [PATCH 10/42] Propagate `ChainAccountState` --- cardano-api/src/Cardano/Api/Ledger/Internal/Reexport.hs | 6 +++--- cardano-api/src/Cardano/Api/Query/Internal/Convenience.hs | 7 +++---- cardano-api/src/Cardano/Api/Query/Internal/Expr.hs | 5 ++--- 3 files changed, 8 insertions(+), 10 deletions(-) diff --git a/cardano-api/src/Cardano/Api/Ledger/Internal/Reexport.hs b/cardano-api/src/Cardano/Api/Ledger/Internal/Reexport.hs index 2f9e04bbaf..9119706bfa 100644 --- a/cardano-api/src/Cardano/Api/Ledger/Internal/Reexport.hs +++ b/cardano-api/src/Cardano/Api/Ledger/Internal/Reexport.hs @@ -112,7 +112,7 @@ module Cardano.Api.Ledger.Internal.Reexport , toPlainDecoder -- Shelley , secondsToNominalDiffTimeMicro - , AccountState (..) + , AccountState , NewEpochState (..) , ShelleyGenesisStaking (..) -- Babbage @@ -266,7 +266,6 @@ import Cardano.Ledger.Binary , toPlainDecoder ) import Cardano.Ledger.Binary.Plain (Decoder, serializeAsHexText) -import Cardano.Ledger.CertState (DRepState (..), csCommitteeCredsL) import Cardano.Ledger.Coin (Coin (..), addDeltaCoin, toDeltaCoin) import Cardano.Ledger.Conway.Core ( DRepVotingThresholds (..) @@ -293,6 +292,7 @@ import Cardano.Ledger.Conway.Governance ) import Cardano.Ledger.Conway.PParams (UpgradeConwayPParams (..)) import Cardano.Ledger.Conway.Scripts (ConwayPlutusPurpose (..)) +import Cardano.Ledger.Conway.State (DRepState (..), csCommitteeCredsL) import Cardano.Ledger.Conway.TxCert ( ConwayDelegCert (..) , ConwayEraTxCert (..) @@ -336,7 +336,7 @@ import Cardano.Ledger.Plutus.Data (Data (..), unData) import Cardano.Ledger.Plutus.Language (Language, Plutus, languageToText, plutusBinary) import Cardano.Ledger.PoolParams (PoolMetadata (..), PoolParams (..), StakePoolRelay (..)) import Cardano.Ledger.Shelley.API - ( AccountState (..) + ( AccountState , GenDelegPair (..) , NewEpochState (..) , StakeReference (..) diff --git a/cardano-api/src/Cardano/Api/Query/Internal/Convenience.hs b/cardano-api/src/Cardano/Api/Query/Internal/Convenience.hs index b85c89e1f4..8772226334 100644 --- a/cardano-api/src/Cardano/Api/Query/Internal/Convenience.hs +++ b/cardano-api/src/Cardano/Api/Query/Internal/Convenience.hs @@ -36,11 +36,10 @@ import Cardano.Api.Query.Internal.Type.QueryInMode import Cardano.Api.Tx.Internal.Body import Cardano.Api.UTxO (UTxO (..)) -import Cardano.Ledger.CertState (DRepState (..)) import Cardano.Ledger.Coin qualified as L +import Cardano.Ledger.Conway.State (ChainAccountState (..), DRepState (..)) import Cardano.Ledger.Credential qualified as L import Cardano.Ledger.Keys qualified as L -import Cardano.Ledger.Shelley.LedgerState qualified as L import Ouroboros.Consensus.HardFork.Combinator.AcrossEras (EraMismatch (..)) import Ouroboros.Network.Protocol.LocalStateQuery.Type (Target (..)) @@ -168,11 +167,11 @@ queryStateForBalancedTx era allTxIns certs = runExceptT $ do caseShelleyToBabbageOrConwayEraOnwards (const $ pure Nothing) ( \cOnwards -> do - L.AccountState{L.asTreasury} <- + chainAccountState <- lift (queryAccountState cOnwards) & onLeft (left . QceUnsupportedNtcVersion) & onLeft (left . QueryEraMismatch) - let txCurrentTreasuryValue = TxCurrentTreasuryValue asTreasury + let txCurrentTreasuryValue = TxCurrentTreasuryValue $ casTreasury chainAccountState return $ Just $ Featured cOnwards txCurrentTreasuryValue ) sbe diff --git a/cardano-api/src/Cardano/Api/Query/Internal/Expr.hs b/cardano-api/src/Cardano/Api/Query/Internal/Expr.hs index 46f0b305dd..a29834edee 100644 --- a/cardano-api/src/Cardano/Api/Query/Internal/Expr.hs +++ b/cardano-api/src/Cardano/Api/Query/Internal/Expr.hs @@ -59,12 +59,11 @@ import Cardano.Api.UTxO import Cardano.Ledger.Api qualified as L import Cardano.Ledger.Api.State.Query qualified as L -import Cardano.Ledger.CertState qualified as L import Cardano.Ledger.Coin qualified as L +import Cardano.Ledger.Conway.State qualified as L import Cardano.Ledger.Credential qualified as L import Cardano.Ledger.Hashes hiding (Hash) import Cardano.Ledger.Keys qualified as L -import Cardano.Ledger.Shelley.LedgerState qualified as L import Cardano.Slotting.Slot import Ouroboros.Consensus.Cardano.Block qualified as Consensus import Ouroboros.Consensus.HardFork.Combinator.AcrossEras as Consensus @@ -484,7 +483,7 @@ queryAccountState QueryInMode r IO - (Either UnsupportedNtcVersionError (Either EraMismatch L.AccountState)) + (Either UnsupportedNtcVersionError (Either EraMismatch L.ChainAccountState)) queryAccountState eon = querySbe eon QueryAccountState queryProposals From b483de73937d8e5cf264947cd5645080eaf207f4 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Wed, 30 Jul 2025 09:33:02 -0400 Subject: [PATCH 11/42] Consensus related Dijkstra changes --- .../src/Cardano/Api/Consensus/Internal/InMode.hs | 15 +++++++++++++++ .../src/Cardano/Api/Consensus/Internal/Mode.hs | 7 +++++++ 2 files changed, 22 insertions(+) diff --git a/cardano-api/src/Cardano/Api/Consensus/Internal/InMode.hs b/cardano-api/src/Cardano/Api/Consensus/Internal/InMode.hs index ca10b1abd5..8fea91d371 100644 --- a/cardano-api/src/Cardano/Api/Consensus/Internal/InMode.hs +++ b/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 diff --git a/cardano-api/src/Cardano/Api/Consensus/Internal/Mode.hs b/cardano-api/src/Cardano/Api/Consensus/Internal/Mode.hs index c4e4100c16..a51cf0f26e 100644 --- a/cardano-api/src/Cardano/Api/Consensus/Internal/Mode.hs +++ b/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" From 0d8ee49e50b4d15b25e1f30af427dc851c23579d Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Wed, 30 Jul 2025 09:33:58 -0400 Subject: [PATCH 12/42] Temporary Cardano.Api.LedgerState Dijkstra update Dijkstra genesis file needs to be parseable --- cardano-api/src/Cardano/Api/LedgerState.hs | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/cardano-api/src/Cardano/Api/LedgerState.hs b/cardano-api/src/Cardano/Api/LedgerState.hs index 382da1e351..eef2df7e8c 100644 --- a/cardano-api/src/Cardano/Api/LedgerState.hs +++ b/cardano-api/src/Cardano/Api/LedgerState.hs @@ -159,6 +159,7 @@ import Cardano.Ledger.BaseTypes qualified as Ledger import Cardano.Ledger.Binary (DecoderError) import Cardano.Ledger.Coin qualified as SL import Cardano.Ledger.Conway.Genesis (ConwayGenesis (..)) +import Cardano.Ledger.Dijkstra.Genesis import Cardano.Ledger.Keys qualified as SL import Cardano.Ledger.Shelley.API qualified as ShelleyAPI import Cardano.Ledger.Shelley.Core qualified as Core @@ -1147,6 +1148,7 @@ instance FromJSON NodeConfig where <*> parseAlonzoHardForkEpoch o <*> parseBabbageHardForkEpoch o <*> parseConwayHardForkEpoch o + <*> error "dijkstra" parseShelleyHardForkEpoch :: Object -> Parser (Consensus.CardanoHardForkTrigger blk) parseShelleyHardForkEpoch o = @@ -1363,7 +1365,7 @@ encodeLedgerState (LedgerState hst@(HFC.HardForkLedgerState st) tbs) = mconcat [ CBOR.encodeListLen 2 , HFC.encodeTelescope - (byron :* shelley :* allegra :* mary :* alonzo :* babbage :* conway :* Nil) + (byron :* shelley :* allegra :* mary :* alonzo :* babbage :* conway :* dijkstra :* Nil) st , Ledger.valuesMKEncoder hst tbs ] @@ -1375,13 +1377,15 @@ encodeLedgerState (LedgerState hst@(HFC.HardForkLedgerState st) tbs) = alonzo = fn (K . Shelley.encodeShelleyLedgerState . unFlip) babbage = fn (K . Shelley.encodeShelleyLedgerState . unFlip) conway = fn (K . Shelley.encodeShelleyLedgerState . unFlip) + dijkstra = fn (K . Shelley.encodeShelleyLedgerState . unFlip) decodeLedgerState :: forall s. CBOR.Decoder s LedgerState decodeLedgerState = do 2 <- CBOR.decodeListLen hst <- HFC.HardForkLedgerState - <$> HFC.decodeTelescope (byron :* shelley :* allegra :* mary :* alonzo :* babbage :* conway :* Nil) + <$> HFC.decodeTelescope + (byron :* shelley :* allegra :* mary :* alonzo :* babbage :* conway :* dijkstra :* Nil) tbs <- Ledger.valuesMKDecoder hst pure (LedgerState hst tbs) where @@ -1392,6 +1396,7 @@ decodeLedgerState = do alonzo = Comp $ Flip <$> Shelley.decodeShelleyLedgerState babbage = Comp $ Flip <$> Shelley.decodeShelleyLedgerState conway = Comp $ Flip <$> Shelley.decodeShelleyLedgerState + dijkstra = Comp $ Flip <$> Shelley.decodeShelleyLedgerState type LedgerStateEvents = (LedgerState, [LedgerEvent]) @@ -1477,7 +1482,8 @@ readCardanoGenesisConfig mEra enc = do ShelleyConfig shelleyGenesis shelleyGenesisHash <- readShelleyGenesisConfig enc alonzoGenesis <- readAlonzoGenesisConfig mEra enc conwayGenesis <- readConwayGenesisConfig enc - let transCfg = Ledger.mkLatestTransitionConfig shelleyGenesis alonzoGenesis conwayGenesis + let dijkstraGenesis = DijkstraGenesis $ error "dijkstra" + let transCfg = Ledger.mkLatestTransitionConfig shelleyGenesis alonzoGenesis conwayGenesis dijkstraGenesis pure $ GenesisCardano enc byronGenesis shelleyGenesisHash transCfg data GenesisConfigError From 730ff11156bc1fff80b0e123751b7e070e7f0911 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Wed, 30 Jul 2025 09:50:05 -0400 Subject: [PATCH 13/42] Update TxOut rendering to handle Dijkstra era --- .../src/Cardano/Api/Tx/Internal/Output.hs | 125 ++++++++++++++++-- 1 file changed, 113 insertions(+), 12 deletions(-) diff --git a/cardano-api/src/Cardano/Api/Tx/Internal/Output.hs b/cardano-api/src/Cardano/Api/Tx/Internal/Output.hs index c000b7dead..f09fbd76dc 100644 --- a/cardano-api/src/Cardano/Api/Tx/Internal/Output.hs +++ b/cardano-api/src/Cardano/Api/Tx/Internal/Output.hs @@ -60,6 +60,7 @@ import Cardano.Api.Era.Internal.Core import Cardano.Api.Era.Internal.Eon.AlonzoEraOnwards import Cardano.Api.Era.Internal.Eon.BabbageEraOnwards import Cardano.Api.Era.Internal.Eon.Convert +import Cardano.Api.Era.Internal.Eon.ConwayEraOnwards import Cardano.Api.Era.Internal.Eon.ShelleyBasedEra import Cardano.Api.Error (Error (..), displayError) import Cardano.Api.Hash @@ -209,6 +210,14 @@ fromLedgerTxOuts sbe body scriptdata = | let txdatums = selectTxDatums scriptdata , txouts <- toList (body ^. L.outputsTxBodyL) ] + ShelleyBasedEraDijkstra -> + [ fromBabbageTxOut + BabbageEraOnwardsDijkstra + txdatums + txouts + | let txdatums = selectTxDatums scriptdata + , txouts <- toList (body ^. L.outputsTxBodyL) + ] validateTxOuts :: ShelleyBasedEra era -> [TxOut CtxTx era] -> Either TxOutputError () validateTxOuts sbe txOuts = do @@ -349,6 +358,16 @@ txOutToJsonValue era (TxOut addr val dat refScript) = , "inlineDatumRaw" .= inlineDatumRawJsonCbor dat , "referenceScript" .= refScriptJsonVal refScript ] + DijkstraEra -> + object + [ "address" .= addr + , "value" .= val + , datHashJsonVal dat + , "datum" .= datJsonVal dat + , "inlineDatum" .= inlineDatumJsonVal dat + , "inlineDatumRaw" .= inlineDatumRawJsonCbor dat + , "referenceScript" .= refScriptJsonVal refScript + ] where datHashJsonVal :: TxOutDatum ctx era -> Aeson.Pair datHashJsonVal d = @@ -466,7 +485,31 @@ instance IsShelleyBasedEra era => FromJSON (TxOut CtxTx era) where mReferenceScript <- o .:? "referenceScript" - reconcileConway alonzoTxOutInConway mInlineDatum mReferenceScript + reconcileConway ConwayEraOnwardsConway alonzoTxOutInConway mInlineDatum mReferenceScript + ShelleyBasedEraDijkstra -> do + alonzoTxOutInConway <- alonzoTxOutParser AlonzoEraOnwardsDijkstra o + + -- We check for the existence of inline datums + inlineDatumHash <- o .:? "inlineDatumhash" + inlineDatum <- o .:? "inlineDatum" + mInlineDatum <- + case (inlineDatum, inlineDatumHash) of + (Just dVal, Just h) -> + case scriptDataFromJson ScriptDataJsonDetailedSchema dVal of + Left err -> + fail $ "Error parsing TxOut JSON: " <> displayError err + Right sData -> + if hashScriptDataBytes sData /= h + then fail "Inline datum not equivalent to inline datum hash" + else return $ TxOutDatumInline BabbageEraOnwardsDijkstra sData + (Nothing, Nothing) -> return TxOutDatumNone + (_, _) -> + fail + "Should not be possible to create a tx output with either an inline datum hash or an inline datum" + + mReferenceScript <- o .:? "referenceScript" + + reconcileConway ConwayEraOnwardsDijkstra alonzoTxOutInConway mInlineDatum mReferenceScript where reconcileBabbage :: TxOut CtxTx BabbageEra @@ -496,13 +539,14 @@ instance IsShelleyBasedEra era => FromJSON (TxOut CtxTx era) where return $ TxOut addr v finalDat finalRefScript reconcileConway - :: TxOut CtxTx ConwayEra + :: ConwayEraOnwards era + -> TxOut CtxTx era -- \^ Alonzo era datum in Conway era - -> TxOutDatum CtxTx ConwayEra + -> TxOutDatum CtxTx era -- \^ Babbage inline datum -> Maybe ScriptInAnyLang - -> Aeson.Parser (TxOut CtxTx ConwayEra) - reconcileConway top@(TxOut addr v dat r) babbageDatum mBabRefScript = do + -> Aeson.Parser (TxOut CtxTx era) + reconcileConway w top@(TxOut addr v dat r) babbageDatum mBabRefScript = do -- We check for conflicting datums finalDat <- case (dat, babbageDatum) of (TxOutDatumNone, bDatum) -> return bDatum @@ -519,7 +563,7 @@ instance IsShelleyBasedEra era => FromJSON (TxOut CtxTx era) where finalRefScript <- case mBabRefScript of Nothing -> return r Just anyScript -> - return $ ReferenceScript BabbageEraOnwardsConway anyScript + return $ ReferenceScript (convert w) anyScript return $ TxOut addr v finalDat finalRefScript alonzoTxOutParser @@ -622,7 +666,32 @@ instance IsShelleyBasedEra era => FromJSON (TxOut CtxUTxO era) where -- We check for a reference script mReferenceScript <- o .:? "referenceScript" - reconcileConway alonzoTxOutInConway mInlineDatum mReferenceScript + reconcileConway ConwayEraOnwardsConway alonzoTxOutInConway mInlineDatum mReferenceScript + ShelleyBasedEraDijkstra -> do + alonzoTxOutInConway <- alonzoTxOutParser AlonzoEraOnwardsDijkstra o + + -- We check for the existence of inline datums + inlineDatumHash <- o .:? "inlineDatumhash" + inlineDatum <- o .:? "inlineDatum" + mInlineDatum <- + case (inlineDatum, inlineDatumHash) of + (Just dVal, Just h) -> + case scriptDataFromJson ScriptDataJsonDetailedSchema dVal of + Left err -> + fail $ "Error parsing TxOut JSON: " <> displayError err + Right sData -> + if hashScriptDataBytes sData /= h + then fail "Inline datum not equivalent to inline datum hash" + else return $ TxOutDatumInline BabbageEraOnwardsDijkstra sData + (Nothing, Nothing) -> return TxOutDatumNone + (_, _) -> + fail + "Should not be possible to create a tx output with either an inline datum hash or an inline datum" + + -- We check for a reference script + mReferenceScript <- o .:? "referenceScript" + + reconcileConway ConwayEraOnwardsDijkstra alonzoTxOutInConway mInlineDatum mReferenceScript where reconcileBabbage :: TxOut CtxUTxO BabbageEra @@ -645,13 +714,14 @@ instance IsShelleyBasedEra era => FromJSON (TxOut CtxUTxO era) where return $ TxOut addr v finalDat finalRefScript reconcileConway - :: TxOut CtxUTxO ConwayEra + :: ConwayEraOnwards era + -> TxOut CtxUTxO era -- \^ Alonzo era datum in Conway era - -> TxOutDatum CtxUTxO ConwayEra + -> TxOutDatum CtxUTxO era -- \^ Babbage inline datum -> Maybe ScriptInAnyLang - -> Aeson.Parser (TxOut CtxUTxO ConwayEra) - reconcileConway (TxOut addr v dat r) babbageDatum mBabRefScript = do + -> Aeson.Parser (TxOut CtxUTxO era) + reconcileConway w (TxOut addr v dat r) babbageDatum mBabRefScript = do -- We check for conflicting datums finalDat <- case (dat, babbageDatum) of (TxOutDatumNone, bDatum) -> return bDatum @@ -660,7 +730,7 @@ instance IsShelleyBasedEra era => FromJSON (TxOut CtxUTxO era) where finalRefScript <- case mBabRefScript of Nothing -> return r Just anyScript -> - return $ ReferenceScript BabbageEraOnwardsConway anyScript + return $ ReferenceScript (convert w) anyScript return $ TxOut addr v finalDat finalRefScript @@ -723,6 +793,12 @@ toShelleyTxOut sbe = shelleyBasedEraConstraints sbe $ \case .~ toBabbageTxOutDatumUTxO txoutdata & L.referenceScriptTxOutL .~ refScriptToShelleyScript sbe refScript + AlonzoEraOnwardsDijkstra -> + L.mkBasicTxOut (toShelleyAddr addr) value + & L.datumTxOutL + .~ toBabbageTxOutDatumUTxO txoutdata + & L.referenceScriptTxOutL + .~ refScriptToShelleyScript sbe refScript ) sbe @@ -757,6 +833,12 @@ toShelleyTxOutAny sbe = shelleyBasedEraConstraints sbe $ \case .~ toBabbageTxOutDatum txoutdata & L.referenceScriptTxOutL .~ refScriptToShelleyScript sbe refScript + AlonzoEraOnwardsDijkstra -> + L.mkBasicTxOut (toShelleyAddr addr) value + & L.datumTxOutL + .~ toBabbageTxOutDatum txoutdata + & L.referenceScriptTxOutL + .~ refScriptToShelleyScript sbe refScript ) sbe @@ -819,6 +901,23 @@ fromShelleyTxOut sbe ledgerTxOut = shelleyBasedEraConstraints sbe $ do where datum = ledgerTxOut ^. L.datumTxOutL mRefScript = ledgerTxOut ^. L.referenceScriptTxOutL + ShelleyBasedEraDijkstra -> + TxOut + addressInEra + txOutValue + ( fromBabbageTxOutDatum + AlonzoEraOnwardsDijkstra + BabbageEraOnwardsDijkstra + datum + ) + ( case mRefScript of + SNothing -> ReferenceScriptNone + SJust refScript -> + fromShelleyScriptToReferenceScript ShelleyBasedEraDijkstra refScript + ) + where + datum = ledgerTxOut ^. L.datumTxOutL + mRefScript = ledgerTxOut ^. L.referenceScriptTxOutL -- ---------------------------------------------------------------------------- -- Transaction output values (era-dependent) @@ -1026,6 +1125,8 @@ binaryDataToScriptData BabbageEraOnwardsBabbage d = fromAlonzoData $ L.binaryDataToData d binaryDataToScriptData BabbageEraOnwardsConway d = fromAlonzoData $ L.binaryDataToData d +binaryDataToScriptData BabbageEraOnwardsDijkstra d = + fromAlonzoData $ L.binaryDataToData d data TxOutputError = TxOutputNegative !Quantity !TxOutInAnyEra From ca28c36dc882eaf7c1af6570f2ec38eb8fb4fab8 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Wed, 30 Jul 2025 09:51:25 -0400 Subject: [PATCH 14/42] Update `eraSpecificLedgerTxBody` with Dijkstra era --- .../src/Cardano/Api/Experimental/Tx.hs | 38 ++++++++++--------- 1 file changed, 20 insertions(+), 18 deletions(-) diff --git a/cardano-api/src/Cardano/Api/Experimental/Tx.hs b/cardano-api/src/Cardano/Api/Experimental/Tx.hs index eb42aa7ba6..5e032e20ec 100644 --- a/cardano-api/src/Cardano/Api/Experimental/Tx.hs +++ b/cardano-api/src/Cardano/Api/Experimental/Tx.hs @@ -167,7 +167,6 @@ import Cardano.Crypto.Hash qualified as Hash import Cardano.Ledger.Alonzo.TxBody qualified as L import Cardano.Ledger.Api qualified as L import Cardano.Ledger.Binary qualified as Ledger -import Cardano.Ledger.Conway.TxBody qualified as L import Cardano.Ledger.Core qualified as Ledger import Cardano.Ledger.Hashes qualified as L hiding (Hash) @@ -285,7 +284,7 @@ makeUnsignedTx era bc = obtainCommonConstraints era $ do & L.datsTxWitsL .~ datums & L.rdmrsTxWitsL .~ redeemers - eraSpecificTxBody <- eraSpecificLedgerTxBody era ledgerTxBody bc + let eraSpecificTxBody = eraSpecificLedgerTxBody era ledgerTxBody bc return . UnsignedTx $ L.mkBasicTx eraSpecificTxBody @@ -297,22 +296,25 @@ eraSpecificLedgerTxBody :: Era era -> Ledger.TxBody (LedgerEra era) -> TxBodyContent BuildTx era - -> Either TxBodyError (Ledger.TxBody (LedgerEra era)) -eraSpecificLedgerTxBody ConwayEra ledgerbody bc = - let propProcedures = txProposalProcedures bc - voteProcedures = txVotingProcedures bc - treasuryDonation = txTreasuryDonation bc - currentTresuryValue = txCurrentTreasuryValue bc - in return $ - ledgerbody - & L.proposalProceduresTxBodyL - .~ convProposalProcedures (maybe TxProposalProceduresNone unFeatured propProcedures) - & L.votingProceduresTxBodyL - .~ convVotingProcedures (maybe TxVotingProceduresNone unFeatured voteProcedures) - & L.treasuryDonationTxBodyL - .~ maybe (L.Coin 0) unFeatured treasuryDonation - & L.currentTreasuryValueTxBodyL - .~ L.maybeToStrictMaybe (unFeatured =<< currentTresuryValue) + -> Ledger.TxBody (LedgerEra era) +eraSpecificLedgerTxBody era ledgerbody bc = + body era + where + body e = + let propProcedures = txProposalProcedures bc + voteProcedures = txVotingProcedures bc + treasuryDonation = txTreasuryDonation bc + currentTresuryValue = txCurrentTreasuryValue bc + in obtainCommonConstraints e $ + ledgerbody + & L.proposalProceduresTxBodyL + .~ convProposalProcedures (maybe TxProposalProceduresNone unFeatured propProcedures) + & L.votingProceduresTxBodyL + .~ convVotingProcedures (maybe TxVotingProceduresNone unFeatured voteProcedures) + & L.treasuryDonationTxBodyL + .~ maybe (L.Coin 0) unFeatured treasuryDonation + & L.currentTreasuryValueTxBodyL + .~ L.maybeToStrictMaybe (unFeatured =<< currentTresuryValue) hashTxBody :: L.HashAnnotated (Ledger.TxBody era) L.EraIndependentTxBody From d91aedc0ad50445374a152b6cd166bf70e29235b Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Wed, 30 Jul 2025 12:02:06 -0400 Subject: [PATCH 15/42] Update `decodeBigLedgerPeerSnapshot` to support snapshot SRV names --- .../Cardano/Api/Query/Internal/Type/QueryInMode.hs | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/cardano-api/src/Cardano/Api/Query/Internal/Type/QueryInMode.hs b/cardano-api/src/Cardano/Api/Query/Internal/Type/QueryInMode.hs index 9b815ef809..7e8bba93d3 100644 --- a/cardano-api/src/Cardano/Api/Query/Internal/Type/QueryInMode.hs +++ b/cardano-api/src/Cardano/Api/Query/Internal/Type/QueryInMode.hs @@ -432,9 +432,16 @@ decodeStakeSnapshot decodeStakeSnapshot (SerialisedStakeSnapshots (Serialised ls)) = StakeSnapshot <$> Plain.decodeFull ls decodeBigLedgerPeerSnapshot - :: Serialised LedgerPeerSnapshot + :: Consensus.ShelleyNodeToClientVersion + -> Serialised LedgerPeerSnapshot -> Either (LBS.ByteString, DecoderError) LedgerPeerSnapshot -decodeBigLedgerPeerSnapshot (Serialised lps) = first (lps,) (Plain.decodeFull lps) +decodeBigLedgerPeerSnapshot ntcV (Serialised lps) = + first + (lps,) + $ Plain.decodeFullDecoder + "LedgerPeerSnapshot" + (decodeLedgerPeerSnapshot $ Consensus.ledgerPeerSnapshotSupportsSRV ntcV) + lps toShelleyAddrSet :: CardanoEra era From 338a6578bc35e340469cd54960d949325c7055f8 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Wed, 30 Jul 2025 14:02:59 -0400 Subject: [PATCH 16/42] Update generators with PlutusScriptV4 Implement orphan DijkstraPParams Arbitrary instances --- cardano-api/gen/Test/Gen/Cardano/Api/Era.hs | 4 +++ .../gen/Test/Gen/Cardano/Api/Orphans.hs | 24 +++++++++++++ cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs | 35 +++++++++++++++++++ 3 files changed, 63 insertions(+) create mode 100644 cardano-api/gen/Test/Gen/Cardano/Api/Orphans.hs diff --git a/cardano-api/gen/Test/Gen/Cardano/Api/Era.hs b/cardano-api/gen/Test/Gen/Cardano/Api/Era.hs index d877866925..ddd943db47 100644 --- a/cardano-api/gen/Test/Gen/Cardano/Api/Era.hs +++ b/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 diff --git a/cardano-api/gen/Test/Gen/Cardano/Api/Orphans.hs b/cardano-api/gen/Test/Gen/Cardano/Api/Orphans.hs new file mode 100644 index 0000000000..b2162f21ad --- /dev/null +++ b/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 \ No newline at end of file diff --git a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs index 89a25fd9c1..b9c6231449 100644 --- a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs +++ b/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,6 +347,14 @@ 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 <- @@ -348,6 +362,14 @@ genValidPlutusV3Script = do 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 From acdff31d5cb1a5d865d75c738f0ced7721f9472d Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Wed, 30 Jul 2025 14:05:31 -0400 Subject: [PATCH 17/42] Introduce PlutusScriptV4 --- .../src/Cardano/Api/Plutus/Internal/Script.hs | 100 ++++++++++++++++++ .../src/Cardano/Api/ProtocolParameters.hs | 4 + .../src/Cardano/Api/Tx/Internal/Body/Lens.hs | 1 - 3 files changed, 104 insertions(+), 1 deletion(-) diff --git a/cardano-api/src/Cardano/Api/Plutus/Internal/Script.hs b/cardano-api/src/Cardano/Api/Plutus/Internal/Script.hs index 34e236ca71..aeaaa25da3 100644 --- a/cardano-api/src/Cardano/Api/Plutus/Internal/Script.hs +++ b/cardano-api/src/Cardano/Api/Plutus/Internal/Script.hs @@ -24,6 +24,7 @@ module Cardano.Api.Plutus.Internal.Script , PlutusScriptV1 , PlutusScriptV2 , PlutusScriptV3 + , PlutusScriptV4 , ScriptLanguage (..) , PlutusScriptVersion (..) , AnyScriptLanguage (..) @@ -149,6 +150,7 @@ import Cardano.Ledger.BaseTypes (StrictMaybe (..)) import Cardano.Ledger.Binary qualified as Binary (decCBOR, decodeFullAnnotator) import Cardano.Ledger.Conway.Scripts qualified as Conway import Cardano.Ledger.Core qualified as Ledger +import Cardano.Ledger.Dijkstra.Scripts qualified as Dijkstra import Cardano.Ledger.Keys qualified as Shelley import Cardano.Ledger.Plutus.Language qualified as Plutus import Cardano.Ledger.Shelley.Scripts qualified as Shelley @@ -212,6 +214,8 @@ data PlutusScriptV2 data PlutusScriptV3 +data PlutusScriptV4 + instance HasTypeProxy SimpleScript' where data AsType SimpleScript' = AsSimpleScript proxyToAsType _ = AsSimpleScript @@ -229,6 +233,10 @@ instance HasTypeProxy PlutusScriptV3 where data AsType PlutusScriptV3 = AsPlutusScriptV3 proxyToAsType _ = AsPlutusScriptV3 +instance HasTypeProxy PlutusScriptV4 where + data AsType PlutusScriptV4 = AsPlutusScriptV4 + proxyToAsType _ = AsPlutusScriptV4 + -- ---------------------------------------------------------------------------- -- Value level representation for script languages -- @@ -252,6 +260,7 @@ data PlutusScriptVersion lang where PlutusScriptV1 :: PlutusScriptVersion PlutusScriptV1 PlutusScriptV2 :: PlutusScriptVersion PlutusScriptV2 PlutusScriptV3 :: PlutusScriptVersion PlutusScriptV3 + PlutusScriptV4 :: PlutusScriptVersion PlutusScriptV4 deriving instance (Eq (PlutusScriptVersion lang)) @@ -261,6 +270,7 @@ instance TestEquality PlutusScriptVersion where testEquality PlutusScriptV1 PlutusScriptV1 = Just Refl testEquality PlutusScriptV2 PlutusScriptV2 = Just Refl testEquality PlutusScriptV3 PlutusScriptV3 = Just Refl + testEquality PlutusScriptV4 PlutusScriptV4 = Just Refl testEquality _ _ = Nothing data AnyScriptLanguage where @@ -285,6 +295,7 @@ instance Enum AnyScriptLanguage where fromEnum (AnyScriptLanguage (PlutusScriptLanguage PlutusScriptV1)) = 1 fromEnum (AnyScriptLanguage (PlutusScriptLanguage PlutusScriptV2)) = 2 fromEnum (AnyScriptLanguage (PlutusScriptLanguage PlutusScriptV3)) = 3 + fromEnum (AnyScriptLanguage (PlutusScriptLanguage PlutusScriptV4)) = 4 instance Bounded AnyScriptLanguage where minBound = AnyScriptLanguage SimpleScriptLanguage @@ -313,6 +324,7 @@ instance Enum AnyPlutusScriptVersion where fromEnum (AnyPlutusScriptVersion PlutusScriptV1) = 0 fromEnum (AnyPlutusScriptVersion PlutusScriptV2) = 1 fromEnum (AnyPlutusScriptVersion PlutusScriptV3) = 2 + fromEnum (AnyPlutusScriptVersion PlutusScriptV4) = 3 instance Bounded AnyPlutusScriptVersion where minBound = AnyPlutusScriptVersion PlutusScriptV1 @@ -336,6 +348,8 @@ instance ToJSON AnyPlutusScriptVersion where Aeson.String "PlutusScriptV2" toJSON (AnyPlutusScriptVersion PlutusScriptV3) = Aeson.String "PlutusScriptV3" + toJSON (AnyPlutusScriptVersion PlutusScriptV4) = + Aeson.String "PlutusScriptV4" parsePlutusScriptVersion :: Text -> Aeson.Parser AnyPlutusScriptVersion parsePlutusScriptVersion t = @@ -358,16 +372,19 @@ instance Aeson.ToJSONKey AnyPlutusScriptVersion where toText (AnyPlutusScriptVersion PlutusScriptV1) = "PlutusScriptV1" toText (AnyPlutusScriptVersion PlutusScriptV2) = "PlutusScriptV2" toText (AnyPlutusScriptVersion PlutusScriptV3) = "PlutusScriptV3" + toText (AnyPlutusScriptVersion PlutusScriptV4) = "PlutusScriptV4" toAlonzoLanguage :: AnyPlutusScriptVersion -> Plutus.Language toAlonzoLanguage (AnyPlutusScriptVersion PlutusScriptV1) = Plutus.PlutusV1 toAlonzoLanguage (AnyPlutusScriptVersion PlutusScriptV2) = Plutus.PlutusV2 toAlonzoLanguage (AnyPlutusScriptVersion PlutusScriptV3) = Plutus.PlutusV3 +toAlonzoLanguage (AnyPlutusScriptVersion PlutusScriptV4) = Plutus.PlutusV4 fromAlonzoLanguage :: Plutus.Language -> AnyPlutusScriptVersion fromAlonzoLanguage Plutus.PlutusV1 = AnyPlutusScriptVersion PlutusScriptV1 fromAlonzoLanguage Plutus.PlutusV2 = AnyPlutusScriptVersion PlutusScriptV2 fromAlonzoLanguage Plutus.PlutusV3 = AnyPlutusScriptVersion PlutusScriptV3 +fromAlonzoLanguage Plutus.PlutusV4 = AnyPlutusScriptVersion PlutusScriptV3 class HasTypeProxy lang => IsScriptLanguage lang where scriptLanguage :: ScriptLanguage lang @@ -384,6 +401,9 @@ instance IsScriptLanguage PlutusScriptV2 where instance IsScriptLanguage PlutusScriptV3 where scriptLanguage = PlutusScriptLanguage PlutusScriptV3 +instance IsScriptLanguage PlutusScriptV4 where + scriptLanguage = PlutusScriptLanguage PlutusScriptV4 + class IsScriptLanguage lang => IsPlutusScriptLanguage lang where plutusScriptVersion :: PlutusScriptVersion lang @@ -396,6 +416,9 @@ instance IsPlutusScriptLanguage PlutusScriptV2 where instance IsPlutusScriptLanguage PlutusScriptV3 where plutusScriptVersion = PlutusScriptV3 +instance IsPlutusScriptLanguage PlutusScriptV4 where + plutusScriptVersion = PlutusScriptV4 + -- ---------------------------------------------------------------------------- -- Script type: covering all script languages -- @@ -437,6 +460,8 @@ instance IsScriptLanguage lang => SerialiseAsCBOR (Script lang) where SBS.fromShort s serialiseToCBOR (PlutusScript PlutusScriptV3 (PlutusScriptSerialised s)) = SBS.fromShort s + serialiseToCBOR (PlutusScript PlutusScriptV4 (PlutusScriptSerialised s)) = + SBS.fromShort s deserialiseFromCBOR _ bs = case scriptLanguage :: ScriptLanguage lang of @@ -453,6 +478,9 @@ instance IsScriptLanguage lang => SerialiseAsCBOR (Script lang) where PlutusScriptLanguage PlutusScriptV3 -> PlutusScript PlutusScriptV3 <$> deserialiseFromCBOR (AsPlutusScript AsPlutusScriptV3) bs + PlutusScriptLanguage PlutusScriptV4 -> + PlutusScript PlutusScriptV4 + <$> deserialiseFromCBOR (AsPlutusScript AsPlutusScriptV4) bs -- | Previously we were double encoding the plutus script -- bytes. This function removes a layer of encoding to return @@ -476,6 +504,7 @@ instance IsScriptLanguage lang => HasTextEnvelope (Script lang) where PlutusScriptLanguage PlutusScriptV1 -> "PlutusScriptV1" PlutusScriptLanguage PlutusScriptV2 -> "PlutusScriptV2" PlutusScriptLanguage PlutusScriptV3 -> "PlutusScriptV3" + PlutusScriptLanguage PlutusScriptV4 -> "PlutusScriptV4" -- ---------------------------------------------------------------------------- -- Scripts in any language @@ -521,6 +550,7 @@ instance ToJSON ScriptInAnyLang where obtainScriptLangConstraint (PlutusScriptLanguage PlutusScriptV1) f = f obtainScriptLangConstraint (PlutusScriptLanguage PlutusScriptV2) f = f obtainScriptLangConstraint (PlutusScriptLanguage PlutusScriptV3) f = f + obtainScriptLangConstraint (PlutusScriptLanguage PlutusScriptV4) f = f instance FromJSON ScriptInAnyLang where parseJSON = Aeson.withObject "ScriptInAnyLang" $ \o -> do @@ -574,12 +604,16 @@ data ScriptLanguageInEra lang era where SimpleScriptInAlonzo :: ScriptLanguageInEra SimpleScript' AlonzoEra SimpleScriptInBabbage :: ScriptLanguageInEra SimpleScript' BabbageEra SimpleScriptInConway :: ScriptLanguageInEra SimpleScript' ConwayEra + SimpleScriptInDijkstra :: ScriptLanguageInEra SimpleScript' DijkstraEra PlutusScriptV1InAlonzo :: ScriptLanguageInEra PlutusScriptV1 AlonzoEra PlutusScriptV1InBabbage :: ScriptLanguageInEra PlutusScriptV1 BabbageEra PlutusScriptV1InConway :: ScriptLanguageInEra PlutusScriptV1 ConwayEra + PlutusScriptV1InDijkstra :: ScriptLanguageInEra PlutusScriptV1 DijkstraEra PlutusScriptV2InBabbage :: ScriptLanguageInEra PlutusScriptV2 BabbageEra PlutusScriptV2InConway :: ScriptLanguageInEra PlutusScriptV2 ConwayEra + PlutusScriptV2InDijkstra :: ScriptLanguageInEra PlutusScriptV2 DijkstraEra PlutusScriptV3InConway :: ScriptLanguageInEra PlutusScriptV3 ConwayEra + PlutusScriptV3InDijkstra :: ScriptLanguageInEra PlutusScriptV3 DijkstraEra deriving instance Eq (ScriptLanguageInEra lang era) @@ -629,12 +663,16 @@ languageOfScriptLanguageInEra langInEra = SimpleScriptInAlonzo -> SimpleScriptLanguage SimpleScriptInBabbage -> SimpleScriptLanguage SimpleScriptInConway -> SimpleScriptLanguage + SimpleScriptInDijkstra -> SimpleScriptLanguage PlutusScriptV1InAlonzo -> PlutusScriptLanguage PlutusScriptV1 PlutusScriptV1InBabbage -> PlutusScriptLanguage PlutusScriptV1 PlutusScriptV1InConway -> PlutusScriptLanguage PlutusScriptV1 + PlutusScriptV1InDijkstra -> PlutusScriptLanguage PlutusScriptV1 PlutusScriptV2InBabbage -> PlutusScriptLanguage PlutusScriptV2 PlutusScriptV2InConway -> PlutusScriptLanguage PlutusScriptV2 + PlutusScriptV2InDijkstra -> PlutusScriptLanguage PlutusScriptV2 PlutusScriptV3InConway -> PlutusScriptLanguage PlutusScriptV3 + PlutusScriptV3InDijkstra -> PlutusScriptLanguage PlutusScriptV3 sbeToSimpleScriptLanguageInEra :: ShelleyBasedEra era @@ -646,6 +684,7 @@ sbeToSimpleScriptLanguageInEra = \case ShelleyBasedEraAlonzo -> SimpleScriptInAlonzo ShelleyBasedEraBabbage -> SimpleScriptInBabbage ShelleyBasedEraConway -> SimpleScriptInConway + ShelleyBasedEraDijkstra -> SimpleScriptInDijkstra eraOfScriptLanguageInEra :: ScriptLanguageInEra lang era @@ -657,12 +696,16 @@ eraOfScriptLanguageInEra = \case SimpleScriptInAlonzo -> ShelleyBasedEraAlonzo SimpleScriptInBabbage -> ShelleyBasedEraBabbage SimpleScriptInConway -> ShelleyBasedEraConway + SimpleScriptInDijkstra -> ShelleyBasedEraDijkstra PlutusScriptV1InAlonzo -> ShelleyBasedEraAlonzo PlutusScriptV1InBabbage -> ShelleyBasedEraBabbage PlutusScriptV1InConway -> ShelleyBasedEraConway + PlutusScriptV1InDijkstra -> ShelleyBasedEraDijkstra PlutusScriptV2InBabbage -> ShelleyBasedEraBabbage PlutusScriptV2InConway -> ShelleyBasedEraConway + PlutusScriptV2InDijkstra -> ShelleyBasedEraDijkstra PlutusScriptV3InConway -> ShelleyBasedEraConway + PlutusScriptV3InDijkstra -> ShelleyBasedEraDijkstra -- | Given a target era and a script in some language, check if the language is -- supported in that era, and if so return a 'ScriptInEra'. @@ -1007,6 +1050,14 @@ hashScript (PlutusScript PlutusScriptV3 (PlutusScriptSerialised script)) = . Conway.ConwayPlutusV3 . Plutus.Plutus $ Plutus.PlutusBinary script +hashScript (PlutusScript PlutusScriptV4 (PlutusScriptSerialised script)) = + ScriptHash + . Ledger.hashScript @(ShelleyLedgerEra DijkstraEra) + . Alonzo.PlutusScript + . Dijkstra.MkDijkstraPlutusScript + . Conway.ConwayPlutusV3 + . Plutus.Plutus + $ Plutus.PlutusBinary script toShelleyScriptHash :: ScriptHash -> Ledger.ScriptHash toShelleyScriptHash (ScriptHash h) = h @@ -1066,6 +1117,7 @@ instance IsPlutusScriptLanguage lang => HasTextEnvelope (PlutusScript lang) wher PlutusScriptV1 -> "PlutusScriptV1" PlutusScriptV2 -> "PlutusScriptV2" PlutusScriptV3 -> "PlutusScriptV3" + PlutusScriptV4 -> "PlutusScriptV4" -- | Smart-constructor for 'ScriptLanguageInEra' to write functions -- manipulating scripts that do not commit to a particular era. @@ -1169,6 +1221,7 @@ toShelleyScript (ScriptInEra langInEra (SimpleScript script)) = SimpleScriptInAlonzo -> Alonzo.TimelockScript (toAllegraTimelock script) SimpleScriptInBabbage -> Alonzo.TimelockScript (toAllegraTimelock script) SimpleScriptInConway -> Alonzo.TimelockScript (toAllegraTimelock script) + SimpleScriptInDijkstra -> Alonzo.TimelockScript (toAllegraTimelock script) toShelleyScript ( ScriptInEra langInEra @@ -1184,6 +1237,9 @@ toShelleyScript Alonzo.PlutusScript . Babbage.BabbagePlutusV1 . Plutus.Plutus $ Plutus.PlutusBinary script PlutusScriptV1InConway -> Alonzo.PlutusScript . Conway.ConwayPlutusV1 . Plutus.Plutus $ Plutus.PlutusBinary script + PlutusScriptV1InDijkstra -> + Alonzo.PlutusScript . Dijkstra.MkDijkstraPlutusScript . Conway.ConwayPlutusV1 . Plutus.Plutus $ + Plutus.PlutusBinary script toShelleyScript ( ScriptInEra langInEra @@ -1197,6 +1253,9 @@ toShelleyScript Alonzo.PlutusScript . Babbage.BabbagePlutusV2 . Plutus.Plutus $ Plutus.PlutusBinary script PlutusScriptV2InConway -> Alonzo.PlutusScript . Conway.ConwayPlutusV2 . Plutus.Plutus $ Plutus.PlutusBinary script + PlutusScriptV2InDijkstra -> + Alonzo.PlutusScript . Dijkstra.MkDijkstraPlutusScript . Conway.ConwayPlutusV2 . Plutus.Plutus $ + Plutus.PlutusBinary script toShelleyScript ( ScriptInEra langInEra @@ -1208,6 +1267,25 @@ toShelleyScript case langInEra of PlutusScriptV3InConway -> Alonzo.PlutusScript . Conway.ConwayPlutusV3 . Plutus.Plutus $ Plutus.PlutusBinary script + PlutusScriptV3InDijkstra -> + Alonzo.PlutusScript . Dijkstra.MkDijkstraPlutusScript . Conway.ConwayPlutusV3 . Plutus.Plutus $ + Plutus.PlutusBinary script +toShelleyScript + ( ScriptInEra + _langInEra + ( PlutusScript + PlutusScriptV4 + (PlutusScriptSerialised _script) + ) + ) = error "toShelleyScript: PlutusV4 not implemented yet." + +-- TODO: Ledger needs to introduce a plutusV4 constructor +-- case langInEra of +-- PlutusScriptV4InConway -> +-- Alonzo.PlutusScript . Conway.ConwayPlutusV3 . Plutus.Plutus $ Plutus.PlutusBinary script +-- PlutusScriptV4InDijkstra -> +-- Alonzo.PlutusScript . Dijkstra.MkDijkstraPlutusScript . Conway.ConwayPlutusV3 . Plutus.Plutus $ +-- Plutus.PlutusBinary script fromShelleyBasedScript :: ShelleyBasedEra era @@ -1273,6 +1351,26 @@ fromShelleyBasedScript sbe script = ScriptInEra SimpleScriptInConway . SimpleScript $ fromAllegraTimelock s + ShelleyBasedEraDijkstra -> + case script of + (Alonzo.PlutusScript (Dijkstra.MkDijkstraPlutusScript plutusV)) -> + case plutusV of + Conway.ConwayPlutusV1 (PlutusScriptBinary s) -> + ScriptInEra PlutusScriptV1InDijkstra + . PlutusScript PlutusScriptV1 + $ PlutusScriptSerialised s + Conway.ConwayPlutusV2 (PlutusScriptBinary s) -> + ScriptInEra PlutusScriptV2InDijkstra + . PlutusScript PlutusScriptV2 + $ PlutusScriptSerialised s + Conway.ConwayPlutusV3 (PlutusScriptBinary s) -> + ScriptInEra PlutusScriptV3InDijkstra + . PlutusScript PlutusScriptV3 + $ PlutusScriptSerialised s + Alonzo.TimelockScript s -> + ScriptInEra SimpleScriptInDijkstra + . SimpleScript + $ fromAllegraTimelock s data MultiSigError = MultiSigErrorTimelockNotsupported deriving Show @@ -1334,11 +1432,13 @@ fromAllegraTimelock = go go (Shelley.RequireAllOf s) = RequireAllOf (map go (toList s)) go (Shelley.RequireAnyOf s) = RequireAnyOf (map go (toList s)) go (Shelley.RequireMOf i s) = RequireMOf i (map go (toList s)) + go _ = error "dijkstra" type family ToLedgerPlutusLanguage lang where ToLedgerPlutusLanguage PlutusScriptV1 = Plutus.PlutusV1 ToLedgerPlutusLanguage PlutusScriptV2 = Plutus.PlutusV2 ToLedgerPlutusLanguage PlutusScriptV3 = Plutus.PlutusV3 + ToLedgerPlutusLanguage PlutusScriptV4 = Plutus.PlutusV4 data PlutusScriptInEra era lang where PlutusScriptInEra :: PlutusScript lang -> PlutusScriptInEra era lang diff --git a/cardano-api/src/Cardano/Api/ProtocolParameters.hs b/cardano-api/src/Cardano/Api/ProtocolParameters.hs index 12df9d4206..1182cdd8f6 100644 --- a/cardano-api/src/Cardano/Api/ProtocolParameters.hs +++ b/cardano-api/src/Cardano/Api/ProtocolParameters.hs @@ -1024,11 +1024,13 @@ toAlonzoScriptLanguage :: AnyPlutusScriptVersion -> Plutus.Language toAlonzoScriptLanguage (AnyPlutusScriptVersion PlutusScriptV1) = Plutus.PlutusV1 toAlonzoScriptLanguage (AnyPlutusScriptVersion PlutusScriptV2) = Plutus.PlutusV2 toAlonzoScriptLanguage (AnyPlutusScriptVersion PlutusScriptV3) = Plutus.PlutusV3 +toAlonzoScriptLanguage (AnyPlutusScriptVersion PlutusScriptV4) = Plutus.PlutusV4 fromAlonzoScriptLanguage :: Plutus.Language -> AnyPlutusScriptVersion fromAlonzoScriptLanguage Plutus.PlutusV1 = AnyPlutusScriptVersion PlutusScriptV1 fromAlonzoScriptLanguage Plutus.PlutusV2 = AnyPlutusScriptVersion PlutusScriptV2 fromAlonzoScriptLanguage Plutus.PlutusV3 = AnyPlutusScriptVersion PlutusScriptV3 +fromAlonzoScriptLanguage Plutus.PlutusV4 = AnyPlutusScriptVersion PlutusScriptV4 toAlonzoCostModel :: CostModel -> Plutus.Language -> Either ProtocolParametersConversionError Alonzo.CostModel @@ -1111,6 +1113,7 @@ toLedgerPParamsUpdate ShelleyBasedEraMary = toShelleyPParamsUpdate toLedgerPParamsUpdate ShelleyBasedEraAlonzo = toAlonzoPParamsUpdate toLedgerPParamsUpdate ShelleyBasedEraBabbage = toBabbagePParamsUpdate toLedgerPParamsUpdate ShelleyBasedEraConway = toConwayPParamsUpdate +toLedgerPParamsUpdate ShelleyBasedEraDijkstra = toConwayPParamsUpdate toShelleyCommonPParamsUpdate :: EraPParams ledgerera @@ -1310,6 +1313,7 @@ fromLedgerPParamsUpdate ShelleyBasedEraMary = fromShelleyPParamsUpdate fromLedgerPParamsUpdate ShelleyBasedEraAlonzo = fromAlonzoPParamsUpdate fromLedgerPParamsUpdate ShelleyBasedEraBabbage = fromBabbagePParamsUpdate fromLedgerPParamsUpdate ShelleyBasedEraConway = fromConwayPParamsUpdate +fromLedgerPParamsUpdate ShelleyBasedEraDijkstra = fromConwayPParamsUpdate fromShelleyCommonPParamsUpdate :: EraPParams ledgerera diff --git a/cardano-api/src/Cardano/Api/Tx/Internal/Body/Lens.hs b/cardano-api/src/Cardano/Api/Tx/Internal/Body/Lens.hs index 3565f8f272..cbaaa9d0c4 100644 --- a/cardano-api/src/Cardano/Api/Tx/Internal/Body/Lens.hs +++ b/cardano-api/src/Cardano/Api/Tx/Internal/Body/Lens.hs @@ -58,7 +58,6 @@ import Cardano.Ledger.Alonzo.Core qualified as L import Cardano.Ledger.Api qualified as L import Cardano.Ledger.BaseTypes (SlotNo, StrictMaybe (..)) import Cardano.Ledger.Coin qualified as L -import Cardano.Ledger.Conway.Core qualified as L import Cardano.Ledger.Mary.Value qualified as L import Cardano.Ledger.Shelley.PParams qualified as L import Cardano.Ledger.TxIn qualified as L From 3437b943ed1c323cb75ad147bdfb49f9717bdb04 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Wed, 30 Jul 2025 14:11:05 -0400 Subject: [PATCH 18/42] Propagate Dijkstra era --- .../src/Cardano/Api/Certificate/Internal.hs | 6 +++ .../src/Cardano/Api/Experimental/Era.hs | 1 + .../Internal/IndexedPlutusScriptWitness.hs | 1 + .../Internal/TxScriptWitnessRequirements.hs | 8 ++++ cardano-api/src/Cardano/Api/LedgerState.hs | 16 +++++++ .../src/Cardano/Api/Tx/Internal/Sign.hs | 44 ++++++++++++++++++- .../Cardano/Api/Transaction/Autobalance.hs | 1 + 7 files changed, 75 insertions(+), 2 deletions(-) diff --git a/cardano-api/src/Cardano/Api/Certificate/Internal.hs b/cardano-api/src/Cardano/Api/Certificate/Internal.hs index 24d91fd65c..2bd8f9c43c 100644 --- a/cardano-api/src/Cardano/Api/Certificate/Internal.hs +++ b/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 diff --git a/cardano-api/src/Cardano/Api/Experimental/Era.hs b/cardano-api/src/Cardano/Api/Experimental/Era.hs index 0e0051a0bb..000cd2d72b 100644 --- a/cardano-api/src/Cardano/Api/Experimental/Era.hs +++ b/cardano-api/src/Cardano/Api/Experimental/Era.hs @@ -295,6 +295,7 @@ type EraCommonConstraints era = , L.AlonzoEraTx (LedgerEra era) , L.BabbageEraPParams (LedgerEra era) , L.BabbageEraTxBody (LedgerEra era) + , L.ConwayEraTxBody (LedgerEra era) , L.ConwayEraTxCert (LedgerEra era) , L.TxCert (LedgerEra era) ~ L.ConwayTxCert (LedgerEra era) , L.Era (LedgerEra era) diff --git a/cardano-api/src/Cardano/Api/Experimental/Plutus/Internal/IndexedPlutusScriptWitness.hs b/cardano-api/src/Cardano/Api/Experimental/Plutus/Internal/IndexedPlutusScriptWitness.hs index c0c5d1530c..12a2206a07 100644 --- a/cardano-api/src/Cardano/Api/Experimental/Plutus/Internal/IndexedPlutusScriptWitness.hs +++ b/cardano-api/src/Cardano/Api/Experimental/Plutus/Internal/IndexedPlutusScriptWitness.hs @@ -211,3 +211,4 @@ obtainAlonzoScriptPurposeConstraints v = AlonzoEraOnwardsAlonzo -> id AlonzoEraOnwardsBabbage -> id AlonzoEraOnwardsConway -> id + AlonzoEraOnwardsDijkstra -> id diff --git a/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/TxScriptWitnessRequirements.hs b/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/TxScriptWitnessRequirements.hs index a458bd3e8f..b73287832f 100644 --- a/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/TxScriptWitnessRequirements.hs +++ b/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/TxScriptWitnessRequirements.hs @@ -61,6 +61,13 @@ instance Semigroup (TxScriptWitnessRequirements L.ConwayEra) where instance Monoid (TxScriptWitnessRequirements L.ConwayEra) where mempty = TxScriptWitnessRequirements mempty mempty mempty mempty +instance Semigroup (TxScriptWitnessRequirements L.DijkstraEra) where + (<>) (TxScriptWitnessRequirements l1 s1 d1 r1) (TxScriptWitnessRequirements l2 s2 d2 r2) = + TxScriptWitnessRequirements (l1 <> l2) (s1 <> s2) (d1 <> d2) (r1 <> r2) + +instance Monoid (TxScriptWitnessRequirements L.DijkstraEra) where + mempty = TxScriptWitnessRequirements mempty mempty mempty mempty + getTxScriptWitnessRequirements :: AlonzoEraOnwards era -> [(Witnessable witnessable (ShelleyLedgerEra era), AnyWitness (ShelleyLedgerEra era))] @@ -93,6 +100,7 @@ obtainMonoidConstraint eon = case eon of AlonzoEraOnwardsAlonzo -> id AlonzoEraOnwardsBabbage -> id AlonzoEraOnwardsConway -> id + AlonzoEraOnwardsDijkstra -> id extractExecutionUnits :: TxScriptWitnessRequirements era -> [ExecutionUnits] extractExecutionUnits (TxScriptWitnessRequirements _ _ _ redeemers) = diff --git a/cardano-api/src/Cardano/Api/LedgerState.hs b/cardano-api/src/Cardano/Api/LedgerState.hs index eef2df7e8c..4e1d0560b8 100644 --- a/cardano-api/src/Cardano/Api/LedgerState.hs +++ b/cardano-api/src/Cardano/Api/LedgerState.hs @@ -1290,6 +1290,11 @@ getNewEpochState era x = do ConwayLedgerState conwayCurrent -> pure $ Shelley.shelleyLedgerState $ unFlip $ currentState conwayCurrent _ -> Left err + ShelleyBasedEraDijkstra -> + case tip of + DijkstraLedgerState dijkstraCurrent -> + pure $ Shelley.shelleyLedgerState $ unFlip $ currentState dijkstraCurrent + _ -> Left err {-# COMPLETE ShelleyLedgerState @@ -1360,6 +1365,16 @@ pattern ConwayLedgerState -> NS (Current (Flip Consensus.LedgerState mk)) (Consensus.CardanoEras Consensus.StandardCrypto) pattern ConwayLedgerState x = S (S (S (S (S (S (Z x)))))) +pattern DijkstraLedgerState + :: Current + (Flip Consensus.LedgerState mk) + ( Shelley.ShelleyBlock + (Praos.Praos Ledger.StandardCrypto) + Consensus.DijkstraEra + ) + -> NS (Current (Flip Consensus.LedgerState mk)) (Consensus.CardanoEras Consensus.StandardCrypto) +pattern DijkstraLedgerState x = S (S (S (S (S (S (S (Z x))))))) + encodeLedgerState :: LedgerState -> CBOR.Encoding encodeLedgerState (LedgerState hst@(HFC.HardForkLedgerState st) tbs) = mconcat @@ -2267,6 +2282,7 @@ getLedgerTablesUTxOValues sbe tbs = ShelleyBasedEraAlonzo -> ejectTables (IS (IS (IS (IS IZ)))) ShelleyBasedEraBabbage -> ejectTables (IS (IS (IS (IS (IS IZ))))) ShelleyBasedEraConway -> ejectTables (IS (IS (IS (IS (IS (IS IZ)))))) + ShelleyBasedEraDijkstra -> ejectTables (IS (IS (IS (IS (IS (IS (IS IZ))))))) -- | Reconstructs the ledger's new epoch state and applies a supplied condition to it for every block. This -- function only terminates if the condition is met or we have reached the termination epoch. We need to diff --git a/cardano-api/src/Cardano/Api/Tx/Internal/Sign.hs b/cardano-api/src/Cardano/Api/Tx/Internal/Sign.hs index 1f2c8df849..fbbc085959 100644 --- a/cardano-api/src/Cardano/Api/Tx/Internal/Sign.hs +++ b/cardano-api/src/Cardano/Api/Tx/Internal/Sign.hs @@ -179,6 +179,10 @@ instance Show (Tx era) where showParen (p >= 11) $ showString "ShelleyTx ShelleyBasedEraConway " . showsPrec 11 tx + showsPrec p (ShelleyTx ShelleyBasedEraDijkstra tx) = + showParen (p >= 11) $ + showString "ShelleyTx ShelleyBasedEraDijkstra " + . showsPrec 11 tx instance HasTypeProxy era => HasTypeProxy (Tx era) where data AsType (Tx era) = AsTx (AsType era) @@ -277,6 +281,7 @@ instance IsShelleyBasedEra era => HasTextEnvelope (Tx era) where ShelleyBasedEraAlonzo -> "Tx AlonzoEra" ShelleyBasedEraBabbage -> "Tx BabbageEra" ShelleyBasedEraConway -> "Tx ConwayEra" + ShelleyBasedEraDijkstra -> "Tx DijkstraEra" -- ---------------------------------------------------------------------------- -- Transaction bodies @@ -472,6 +477,29 @@ instance Show (TxBody era) where . showChar ' ' . showsPrec 11 scriptValidity ) + showsPrec + p + ( ShelleyTxBody + ShelleyBasedEraDijkstra + txbody + txscripts + redeemers + txmetadata + scriptValidity + ) = + showParen + (p >= 11) + ( showString "ShelleyTxBody ShelleyBasedEraDijkstra " + . showsPrec 11 txbody + . showChar ' ' + . showsPrec 11 txscripts + . showChar ' ' + . showsPrec 11 redeemers + . showChar ' ' + . showsPrec 11 txmetadata + . showChar ' ' + . showsPrec 11 scriptValidity + ) instance HasTypeProxy era => HasTypeProxy (TxBody era) where data AsType (TxBody era) = AsTxBody (AsType era) @@ -513,6 +541,7 @@ instance IsShelleyBasedEra era => HasTextEnvelope (TxBody era) where ShelleyBasedEraAlonzo -> "TxBodyAlonzo" ShelleyBasedEraBabbage -> "TxBodyBabbage" ShelleyBasedEraConway -> "TxBodyConway" + ShelleyBasedEraDijkstra -> "TxBodyDijkstra" data TxBodyScriptData era where TxBodyNoScriptData :: TxBodyScriptData era @@ -531,7 +560,7 @@ selectTxDatums :: TxBodyScriptData era -> Map L.DataHash (L.Data (ShelleyLedgerEra era)) selectTxDatums TxBodyNoScriptData = Map.empty -selectTxDatums (TxBodyScriptData _ (Alonzo.TxDats' datums) _) = datums +selectTxDatums (TxBodyScriptData _ (Alonzo.TxDats datums) _) = datums -- | Indicates whether a script is expected to fail or pass validation. data ScriptValidity @@ -642,6 +671,10 @@ instance Show (KeyWitness era) where showParen (p >= 11) $ showString "ShelleyBootstrapWitness ShelleyBasedEraConway " . showsPrec 11 tx + showsPrec p (ShelleyBootstrapWitness ShelleyBasedEraDijkstra tx) = + showParen (p >= 11) $ + showString "ShelleyBootstrapWitness ShelleyBasedEraDijkstra " + . showsPrec 11 tx showsPrec p (ShelleyKeyWitness ShelleyBasedEraShelley tx) = showParen (p >= 11) $ showString "ShelleyKeyWitness ShelleyBasedEraShelley " @@ -666,6 +699,10 @@ instance Show (KeyWitness era) where showParen (p >= 11) $ showString "ShelleyKeyWitness ShelleyBasedEraConway " . showsPrec 11 tx + showsPrec p (ShelleyKeyWitness ShelleyBasedEraDijkstra tx) = + showParen (p >= 11) $ + showString "ShelleyKeyWitness ShelleyBasedEraDijkstra " + . showsPrec 11 tx instance HasTypeProxy era => HasTypeProxy (KeyWitness era) where data AsType (KeyWitness era) = AsKeyWitness (AsType era) @@ -707,6 +744,7 @@ instance IsCardanoEra era => SerialiseAsCBOR (KeyWitness era) where AlonzoEra -> decodeShelleyBasedWitness ShelleyBasedEraAlonzo bs BabbageEra -> decodeShelleyBasedWitness ShelleyBasedEraBabbage bs ConwayEra -> decodeShelleyBasedWitness ShelleyBasedEraConway bs + DijkstraEra -> decodeShelleyBasedWitness ShelleyBasedEraDijkstra bs encodeShelleyBasedKeyWitness :: CBOR.EncCBOR w => w -> CBOR.Encoding encodeShelleyBasedKeyWitness wit = @@ -752,6 +790,7 @@ instance IsCardanoEra era => HasTextEnvelope (KeyWitness era) where AlonzoEra -> "TxWitness AlonzoEra" BabbageEra -> "TxWitness BabbageEra" ConwayEra -> "TxWitness ConwayEra" + DijkstraEra -> "TxWitness DijkstraEra" getTxBodyAndWitnesses :: Tx era -> (TxBody era, [KeyWitness era]) getTxBodyAndWitnesses tx = (getTxBody tx, getTxWitnesses tx) @@ -905,6 +944,7 @@ makeSignedTransaction ShelleyBasedEraAlonzo -> alonzoSignedTransaction ShelleyBasedEraBabbage -> alonzoSignedTransaction ShelleyBasedEraConway -> alonzoSignedTransaction + ShelleyBasedEraDijkstra -> alonzoSignedTransaction where txCommon :: forall ledgerera @@ -1025,7 +1065,7 @@ makeShelleyBasedBootstrapWitness sbe nwOrAddr txbody (ByronSigningKey sk) = -- Byron era witnesses were weird. This reveals all that weirdness. Shelley.BootstrapWitness { Shelley.bwKey = vk - , Shelley.bwSig = signature + , Shelley.bwSignature = signature , Shelley.bwChainCode = chainCode , Shelley.bwAttributes = attributes } diff --git a/cardano-api/test/cardano-api-test/Test/Cardano/Api/Transaction/Autobalance.hs b/cardano-api/test/cardano-api-test/Test/Cardano/Api/Transaction/Autobalance.hs index 7fb9c0f70d..c5148d3290 100644 --- a/cardano-api/test/cardano-api-test/Test/Cardano/Api/Transaction/Autobalance.hs +++ b/cardano-api/test/cardano-api-test/Test/Cardano/Api/Transaction/Autobalance.hs @@ -651,6 +651,7 @@ loadPlutusWitness ceo = do H.leftFail $ deserialiseFromTextEnvelopeAnyOf textEnvTypes envelope let scriptLangInEra = case ceo of ConwayEraOnwardsConway -> PlutusScriptV3InConway + ConwayEraOnwardsDijkstra -> PlutusScriptV3InDijkstra pure ( hashScript s , PlutusScriptWitness From 0a737a67ef1c35dd78a2fbdd2dc04472357d9e9c Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Wed, 30 Jul 2025 14:29:59 -0400 Subject: [PATCH 19/42] Merge with PlutusV4 intro --- .../Plutus/Internal/ScriptWitness.hs | 7 ++++++ .../Plutus/Internal/Shim/LegacyScripts.hs | 4 ++++ .../Experimental/Tx/Internal/AnyWitness.hs | 23 +++++++++++++++++++ cardano-api/src/Cardano/Api/Plutus.hs | 1 + 4 files changed, 35 insertions(+) diff --git a/cardano-api/src/Cardano/Api/Experimental/Plutus/Internal/ScriptWitness.hs b/cardano-api/src/Cardano/Api/Experimental/Plutus/Internal/ScriptWitness.hs index 77fce5c280..7dbcfd1787 100644 --- a/cardano-api/src/Cardano/Api/Experimental/Plutus/Internal/ScriptWitness.hs +++ b/cardano-api/src/Cardano/Api/Experimental/Plutus/Internal/ScriptWitness.hs @@ -74,6 +74,7 @@ getPlutusScriptWitnessLanguage (PlutusScriptWitness l _ _ _ _) = L.SPlutusV1 -> L.plutusLanguage l L.SPlutusV2 -> L.plutusLanguage l L.SPlutusV3 -> L.plutusLanguage l + L.SPlutusV4 -> L.plutusLanguage l -- | Every Plutus script has a purpose that indicates -- what that script is witnessing. @@ -100,21 +101,27 @@ type family PlutusScriptDatumF (lang :: L.Language) (purpose :: PlutusScriptPurp PlutusScriptDatumF L.PlutusV1 SpendingScript = HashableScriptData PlutusScriptDatumF L.PlutusV2 SpendingScript = HashableScriptData PlutusScriptDatumF L.PlutusV3 SpendingScript = Maybe HashableScriptData -- CIP-69 + PlutusScriptDatumF L.PlutusV4 SpendingScript = Maybe HashableScriptData -- CIP-69 PlutusScriptDatumF L.PlutusV1 MintingScript = NoScriptDatum PlutusScriptDatumF L.PlutusV2 MintingScript = NoScriptDatum PlutusScriptDatumF L.PlutusV3 MintingScript = NoScriptDatum + PlutusScriptDatumF L.PlutusV4 MintingScript = NoScriptDatum PlutusScriptDatumF L.PlutusV1 WithdrawingScript = NoScriptDatum PlutusScriptDatumF L.PlutusV2 WithdrawingScript = NoScriptDatum PlutusScriptDatumF L.PlutusV3 WithdrawingScript = NoScriptDatum + PlutusScriptDatumF L.PlutusV4 WithdrawingScript = NoScriptDatum PlutusScriptDatumF L.PlutusV1 CertifyingScript = NoScriptDatum PlutusScriptDatumF L.PlutusV2 CertifyingScript = NoScriptDatum PlutusScriptDatumF L.PlutusV3 CertifyingScript = NoScriptDatum + PlutusScriptDatumF L.PlutusV4 CertifyingScript = NoScriptDatum PlutusScriptDatumF L.PlutusV1 ProposingScript = NoScriptDatum PlutusScriptDatumF L.PlutusV2 ProposingScript = NoScriptDatum PlutusScriptDatumF L.PlutusV3 ProposingScript = NoScriptDatum + PlutusScriptDatumF L.PlutusV4 ProposingScript = NoScriptDatum PlutusScriptDatumF L.PlutusV1 VotingScript = NoScriptDatum PlutusScriptDatumF L.PlutusV2 VotingScript = NoScriptDatum PlutusScriptDatumF L.PlutusV3 VotingScript = NoScriptDatum + PlutusScriptDatumF L.PlutusV4 VotingScript = NoScriptDatum data PlutusScriptDatum (lang :: L.Language) (purpose :: PlutusScriptPurpose) where SpendingScriptDatum diff --git a/cardano-api/src/Cardano/Api/Experimental/Plutus/Internal/Shim/LegacyScripts.hs b/cardano-api/src/Cardano/Api/Experimental/Plutus/Internal/Shim/LegacyScripts.hs index 88a69f6570..009a701f74 100644 --- a/cardano-api/src/Cardano/Api/Experimental/Plutus/Internal/Shim/LegacyScripts.hs +++ b/cardano-api/src/Cardano/Api/Experimental/Plutus/Internal/Shim/LegacyScripts.hs @@ -119,11 +119,13 @@ toPlutusScriptDatum -> Old.ScriptDatum Old.WitCtxTxIn -> PlutusScriptDatum (Old.ToLedgerPlutusLanguage lang) (ToPlutusScriptPurpose TxInItem) -- ^ Encapsulates CIP-69: V3 spending script datums are optional +toPlutusScriptDatum WitTxIn{} Old.PlutusScriptV4 (Old.ScriptDatumForTxIn r) = SpendingScriptDatum r toPlutusScriptDatum WitTxIn{} Old.PlutusScriptV3 (Old.ScriptDatumForTxIn r) = SpendingScriptDatum r -- \^ V2 and V1 spending script datums are required toPlutusScriptDatum WitTxIn{} Old.PlutusScriptV2 (Old.ScriptDatumForTxIn (Just r)) = SpendingScriptDatum r toPlutusScriptDatum WitTxIn{} Old.PlutusScriptV1 (Old.ScriptDatumForTxIn (Just r)) = SpendingScriptDatum r -- \^ V2 and V3 scripts can have inline datums +toPlutusScriptDatum WitTxIn{} Old.PlutusScriptV4 Old.InlineScriptDatum = InlineDatum toPlutusScriptDatum WitTxIn{} Old.PlutusScriptV3 Old.InlineScriptDatum = InlineDatum toPlutusScriptDatum WitTxIn{} Old.PlutusScriptV2 Old.InlineScriptDatum = InlineDatum -- \^ Everything else is not allowed. The old api does not prevent these invalid combinations. @@ -206,6 +208,7 @@ obtainConstraints v = Old.PlutusScriptV1 -> id Old.PlutusScriptV2 -> id Old.PlutusScriptV3 -> id + Old.PlutusScriptV4 -> id toPlutusSLanguage :: Old.PlutusScriptVersion lang -> L.SLanguage (Old.ToLedgerPlutusLanguage lang) @@ -213,3 +216,4 @@ toPlutusSLanguage = \case Old.PlutusScriptV1 -> L.SPlutusV1 Old.PlutusScriptV2 -> L.SPlutusV2 Old.PlutusScriptV3 -> L.SPlutusV3 + Old.PlutusScriptV4 -> L.SPlutusV4 diff --git a/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/AnyWitness.hs b/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/AnyWitness.hs index 24536ba065..3a3cd517c9 100644 --- a/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/AnyWitness.hs +++ b/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/AnyWitness.hs @@ -29,6 +29,7 @@ import Cardano.Ledger.Alonzo.Scripts qualified as L import Cardano.Ledger.Babbage.Scripts qualified as L import Cardano.Ledger.Conway.Scripts qualified as L import Cardano.Ledger.Core qualified as L +import Cardano.Ledger.Dijkstra.Scripts qualified as Dijkstra import Cardano.Ledger.Plutus.Data qualified as L import Cardano.Ledger.Plutus.Language qualified as L @@ -101,12 +102,14 @@ getAnyWitnessScript era ss@(AnySimpleScriptWitness{}) = ShelleyBasedEraAlonzo -> L.TimelockScript <$> getAnyWitnessSimpleScript ss ShelleyBasedEraBabbage -> L.TimelockScript <$> getAnyWitnessSimpleScript ss ShelleyBasedEraConway -> L.TimelockScript <$> getAnyWitnessSimpleScript ss + ShelleyBasedEraDijkstra -> L.TimelockScript <$> getAnyWitnessSimpleScript ss getAnyWitnessScript era ps@(AnyPlutusScriptWitness{}) = forShelleyBasedEraInEon era Nothing $ \aEon -> case aEon of AlonzoEraOnwardsAlonzo -> L.PlutusScript <$> getAnyWitnessPlutusScript aEon ps AlonzoEraOnwardsBabbage -> L.PlutusScript <$> getAnyWitnessPlutusScript aEon ps AlonzoEraOnwardsConway -> L.PlutusScript <$> getAnyWitnessPlutusScript aEon ps + AlonzoEraOnwardsDijkstra -> L.PlutusScript <$> getAnyWitnessPlutusScript aEon ps -- It should be noted that 'PlutusRunnable' is constructed via deserialization. The deserialization -- instance lives in ledger and will fail for an invalid script language/era pairing. Therefore @@ -127,6 +130,9 @@ fromPlutusRunnable L.SPlutusV1 eon runnable = AlonzoEraOnwardsConway -> let plutusScript = L.plutusFromRunnable runnable in Just $ L.ConwayPlutusV1 plutusScript + AlonzoEraOnwardsDijkstra -> + let plutusScript = L.plutusFromRunnable runnable + in Just $ Dijkstra.MkDijkstraPlutusScript $ L.ConwayPlutusV1 plutusScript fromPlutusRunnable L.SPlutusV2 eon runnable = case eon of AlonzoEraOnwardsAlonzo -> Nothing @@ -136,6 +142,9 @@ fromPlutusRunnable L.SPlutusV2 eon runnable = AlonzoEraOnwardsConway -> let plutusScript = L.plutusFromRunnable runnable in Just $ L.ConwayPlutusV2 plutusScript + AlonzoEraOnwardsDijkstra -> + let plutusScript = L.plutusFromRunnable runnable + in Just $ Dijkstra.MkDijkstraPlutusScript $ L.ConwayPlutusV2 plutusScript fromPlutusRunnable L.SPlutusV3 eon runnable = case eon of AlonzoEraOnwardsAlonzo -> Nothing @@ -143,6 +152,19 @@ fromPlutusRunnable L.SPlutusV3 eon runnable = AlonzoEraOnwardsConway -> let plutusScript = L.plutusFromRunnable runnable in Just $ L.ConwayPlutusV3 plutusScript + AlonzoEraOnwardsDijkstra -> + let plutusScript = L.plutusFromRunnable runnable + in Just $ Dijkstra.MkDijkstraPlutusScript $ L.ConwayPlutusV3 plutusScript +fromPlutusRunnable L.SPlutusV4 eon runnable = + case eon of + AlonzoEraOnwardsAlonzo -> Nothing + AlonzoEraOnwardsBabbage -> Nothing + AlonzoEraOnwardsConway -> + let plutusScript = L.plutusFromRunnable runnable + in Just $ (error "fromPlutusRunnable: ConwayPlutusV4") plutusScript + AlonzoEraOnwardsDijkstra -> + let plutusScript = L.plutusFromRunnable runnable + in Just $ Dijkstra.MkDijkstraPlutusScript $ (error "fromPlutusRunnable: DijkstraPlutusV4") plutusScript toAlonzoDatum :: AlonzoEraOnwards era @@ -160,5 +182,6 @@ getPlutusDatum getPlutusDatum L.SPlutusV1 (SpendingScriptDatum d) = Just d getPlutusDatum L.SPlutusV2 (SpendingScriptDatum d) = Just d getPlutusDatum L.SPlutusV3 (SpendingScriptDatum d) = d +getPlutusDatum L.SPlutusV4 (SpendingScriptDatum _d) = error "dijkstra" getPlutusDatum _ InlineDatum = Nothing getPlutusDatum _ NoScriptDatum = Nothing diff --git a/cardano-api/src/Cardano/Api/Plutus.hs b/cardano-api/src/Cardano/Api/Plutus.hs index 2c5a7fe96d..4b6674cc56 100644 --- a/cardano-api/src/Cardano/Api/Plutus.hs +++ b/cardano-api/src/Cardano/Api/Plutus.hs @@ -4,6 +4,7 @@ module Cardano.Api.Plutus , PlutusScriptV1 , PlutusScriptV2 , PlutusScriptV3 + , PlutusScriptV4 , ScriptLanguage (..) , PlutusScriptVersion (..) , AnyScriptLanguage (..) From 5229ec39b2bd59a33a5211f390123a42cf035669 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Wed, 30 Jul 2025 14:30:14 -0400 Subject: [PATCH 20/42] Merge with propagate Dikstra --- cardano-api/cardano-api.cabal | 3 + .../Experimental/Tx/Internal/Certificate.hs | 95 +++++++++++++------ .../Api/LedgerState/Internal/LedgerEvent.hs | 4 +- .../src/Cardano/Api/Network/IPC/Internal.hs | 3 +- .../cardano-api-test/Test/Cardano/Api/CBOR.hs | 1 + 5 files changed, 73 insertions(+), 33 deletions(-) diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index 6c7188d518..e7a7adf0c6 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -296,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 @@ -316,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, diff --git a/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/Certificate.hs b/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/Certificate.hs index 90e9a7ec9d..a792f5e7c0 100644 --- a/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/Certificate.hs +++ b/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/Certificate.hs @@ -15,8 +15,8 @@ where import Cardano.Api.Address qualified as Api import Cardano.Api.Certificate.Internal qualified as Api +import Cardano.Api.Era.Internal.Core (DijkstraEra) import Cardano.Api.Era.Internal.Eon.Convert -import Cardano.Api.Era.Internal.Eon.ConwayEraOnwards import Cardano.Api.Era.Internal.Eon.ShelleyToBabbageEra qualified as Api import Cardano.Api.Experimental.Era import Cardano.Api.Experimental.Plutus.Internal.Script qualified as Exp @@ -45,13 +45,18 @@ deriving instance Eq (Certificate era) deriving instance Ord (Certificate era) convertToOldApiCertificate :: Era era -> Certificate (LedgerEra era) -> Api.Certificate era -convertToOldApiCertificate ConwayEra (Certificate cert) = - Api.ConwayCertificate ConwayEraOnwardsConway cert +convertToOldApiCertificate e (Certificate cert) = + obtainCommonConstraints e $ Api.ConwayCertificate (convert e) cert convertToNewCertificate :: Era era -> Api.Certificate era -> Certificate (LedgerEra era) -convertToNewCertificate ConwayEra (Api.ConwayCertificate _ cert) = Certificate cert -convertToNewCertificate ConwayEra (Api.ShelleyRelatedCertificate sToBab _) = - case sToBab :: Api.ShelleyToBabbageEra ConwayEra of {} +convertToNewCertificate era (Api.ConwayCertificate _ cert) = + case era of + ConwayEra -> Certificate cert + DijkstraEra -> Certificate cert +convertToNewCertificate era (Api.ShelleyRelatedCertificate sToBab _) = + case era of + ConwayEra -> case sToBab :: Api.ShelleyToBabbageEra ConwayEra of {} + DijkstraEra -> case sToBab :: Api.ShelleyToBabbageEra DijkstraEra of {} mkTxCertificates :: forall era @@ -61,29 +66,29 @@ mkTxCertificates mkTxCertificates [] = TxCertificatesNone mkTxCertificates certs = TxCertificates (convert useEra) $ fromList $ map (getStakeCred useEra) certs - where - getStakeCred - :: Era era - -> (Certificate (LedgerEra era), AnyWitness (LedgerEra era)) - -> ( Api.Certificate era - , Api.BuildTxWith - Api.BuildTx - (Maybe (Api.StakeCredential, Api.Witness Api.WitCtxStake era)) - ) - getStakeCred era (Certificate cert, witness) = - case era of - ConwayEra -> do - let oldApiCert = Api.ConwayCertificate (convert era) cert - mStakeCred = Api.selectStakeCredentialWitness oldApiCert - wit = - case witness of - AnyKeyWitnessPlaceholder -> Api.KeyWitness Api.KeyWitnessForStakeAddr - AnySimpleScriptWitness ss -> - Api.ScriptWitness Api.ScriptWitnessForStakeAddr $ newToOldSimpleScriptWitness era ss - AnyPlutusScriptWitness psw -> - Api.ScriptWitness Api.ScriptWitnessForStakeAddr $ - newToOldPlutusCertificateScriptWitness ConwayEra psw - (oldApiCert, pure $ (,wit) <$> mStakeCred) + +getStakeCred + :: Era era + -> (Certificate (LedgerEra era), AnyWitness (LedgerEra era)) + -> ( Api.Certificate era + , Api.BuildTxWith + Api.BuildTx + (Maybe (Api.StakeCredential, Api.Witness Api.WitCtxStake era)) + ) +getStakeCred e (Certificate cert, witness) = do + let oldApiCert = obtainCommonConstraints e $ Api.ConwayCertificate (convert e) cert + mStakeCred = Api.selectStakeCredentialWitness oldApiCert + wit = + case witness of + AnyKeyWitnessPlaceholder -> Api.KeyWitness Api.KeyWitnessForStakeAddr + AnySimpleScriptWitness ss -> + Api.ScriptWitness Api.ScriptWitnessForStakeAddr $ + obtainCommonConstraints e $ + newToOldSimpleScriptWitness e ss + AnyPlutusScriptWitness psw -> + Api.ScriptWitness Api.ScriptWitnessForStakeAddr $ + newToOldPlutusCertificateScriptWitness e psw + (oldApiCert, pure $ (,wit) <$> mStakeCred) newToOldSimpleScriptWitness :: L.AllegraEraScript (LedgerEra era) @@ -127,12 +132,40 @@ newToOldPlutusCertificateScriptWitness ConwayEra (Exp.PlutusScriptWitness Plutus Api.NoScriptDatumForStake redeemer execUnits +newToOldPlutusCertificateScriptWitness ConwayEra (Exp.PlutusScriptWitness Plutus.SPlutusV4 _scriptOrRef _ _redeemer _execUnits) = + error "dijkstra" +newToOldPlutusCertificateScriptWitness DijkstraEra (Exp.PlutusScriptWitness Plutus.SPlutusV1 scriptOrRef _ redeemer execUnits) = + Api.PlutusScriptWitness + Api.PlutusScriptV1InDijkstra + Api.PlutusScriptV1 + (newToOldPlutusScriptOrReferenceInput DijkstraEra scriptOrRef) + Api.NoScriptDatumForStake + redeemer + execUnits +newToOldPlutusCertificateScriptWitness DijkstraEra (Exp.PlutusScriptWitness Plutus.SPlutusV2 scriptOrRef _ redeemer execUnits) = + Api.PlutusScriptWitness + Api.PlutusScriptV2InDijkstra + Api.PlutusScriptV2 + (newToOldPlutusScriptOrReferenceInput DijkstraEra scriptOrRef) + Api.NoScriptDatumForStake + redeemer + execUnits +newToOldPlutusCertificateScriptWitness DijkstraEra (Exp.PlutusScriptWitness Plutus.SPlutusV3 scriptOrRef _ redeemer execUnits) = + Api.PlutusScriptWitness + Api.PlutusScriptV3InDijkstra + Api.PlutusScriptV3 + (newToOldPlutusScriptOrReferenceInput DijkstraEra scriptOrRef) + Api.NoScriptDatumForStake + redeemer + execUnits +newToOldPlutusCertificateScriptWitness DijkstraEra (Exp.PlutusScriptWitness Plutus.SPlutusV4 _scriptOrRef _ _redeemer _execUnits) = + error "dijkstra" newToOldPlutusScriptOrReferenceInput :: Era era -> Exp.PlutusScriptOrReferenceInput lang (LedgerEra era) -> Api.PlutusScriptOrReferenceInput oldlang -newToOldPlutusScriptOrReferenceInput ConwayEra (Exp.PReferenceScript txin) = Api.PReferenceScript txin -newToOldPlutusScriptOrReferenceInput ConwayEra (Exp.PScript (Exp.PlutusScriptInEra plutusRunnable)) = +newToOldPlutusScriptOrReferenceInput _ (Exp.PReferenceScript txin) = Api.PReferenceScript txin +newToOldPlutusScriptOrReferenceInput _ (Exp.PScript (Exp.PlutusScriptInEra plutusRunnable)) = let oldScript = L.unPlutusBinary . L.plutusBinary $ L.plutusFromRunnable plutusRunnable in Api.PScript $ Api.PlutusScriptSerialised oldScript diff --git a/cardano-api/src/Cardano/Api/LedgerState/Internal/LedgerEvent.hs b/cardano-api/src/Cardano/Api/LedgerState/Internal/LedgerEvent.hs index aba7ff0737..4e12859834 100644 --- a/cardano-api/src/Cardano/Api/LedgerState/Internal/LedgerEvent.hs +++ b/cardano-api/src/Cardano/Api/LedgerState/Internal/LedgerEvent.hs @@ -20,6 +20,7 @@ import Cardano.Api.Key.Internal (Hash (..), StakePoolKey) import Cardano.Ledger.Coin qualified as L import Cardano.Ledger.Coin qualified as Ledger +import Cardano.Ledger.Compactible qualified as Ledger import Cardano.Ledger.Conway.Governance qualified as Ledger import Cardano.Ledger.Core qualified as Ledger.Core import Cardano.Ledger.Credential qualified as Ledger @@ -110,8 +111,9 @@ data PoolReapDetails = PoolReapDetails convertRetiredPoolsMap :: Map Ledger.StakeCredential - (Map (Ledger.KeyHash Ledger.StakePool) Ledger.Coin) + (Map (Ledger.KeyHash Ledger.StakePool) (Ledger.CompactForm Ledger.Coin)) -> Map StakeCredential (Map (Hash StakePoolKey) L.Coin) convertRetiredPoolsMap = Map.mapKeys fromShelleyStakeCredential . fmap (Map.mapKeys StakePoolKeyHash) + . (fmap . fmap) Ledger.fromCompact diff --git a/cardano-api/src/Cardano/Api/Network/IPC/Internal.hs b/cardano-api/src/Cardano/Api/Network/IPC/Internal.hs index 1b095bb73a..bfd4945148 100644 --- a/cardano-api/src/Cardano/Api/Network/IPC/Internal.hs +++ b/cardano-api/src/Cardano/Api/Network/IPC/Internal.hs @@ -132,6 +132,7 @@ import Data.ByteString.Lazy qualified as LBS import Data.Void (Void) import GHC.Exts (IsList (..)) import Network.Mux qualified as Net +import Network.Mux.Trace (nullTracers) -- ---------------------------------------------------------------------------- -- The types for the client side of the node-to-client IPC protocols @@ -211,7 +212,7 @@ connectToLocalNodeWithVersion Net.connectTo (Net.localSnocket iomgr) Net.NetworkConnectTracers - { Net.nctMuxTracer = nullTracer + { Net.nctMuxTracers = nullTracers , Net.nctHandshakeTracer = nullTracer } versionedProtocls diff --git a/cardano-api/test/cardano-api-test/Test/Cardano/Api/CBOR.hs b/cardano-api/test/cardano-api-test/Test/Cardano/Api/CBOR.hs index f94c86be7a..0b2b8b644b 100644 --- a/cardano-api/test/cardano-api-test/Test/Cardano/Api/CBOR.hs +++ b/cardano-api/test/cardano-api-test/Test/Cardano/Api/CBOR.hs @@ -77,6 +77,7 @@ prop_txbody_backwards_compatibility = H.property $ do ShelleyBasedEraAlonzo -> "Tx AlonzoEra" ShelleyBasedEraBabbage -> "Tx BabbageEra" ShelleyBasedEraConway -> "Tx ConwayEra" + ShelleyBasedEraDijkstra -> "Tx DijkstraEra" prop_text_envelope_roundtrip_txbody_CBOR :: Property prop_text_envelope_roundtrip_txbody_CBOR = H.property $ do From 6e832cb04ead16d32dd0f9f674844775805ce1f9 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Wed, 30 Jul 2025 14:30:27 -0400 Subject: [PATCH 21/42] REMOVE ME: Add ledger and consensus SRPs --- cabal.project | 54 +++++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 52 insertions(+), 2 deletions(-) diff --git a/cabal.project b/cabal.project index 00318cf5ad..7a8a7a468e 100644 --- a/cabal.project +++ b/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 \ No newline at end of file From 8330132fb798a3ba4ea430b00e849f57b5d77a5d Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Wed, 30 Jul 2025 08:30:52 -0400 Subject: [PATCH 22/42] Update nix flake --- flake.lock | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/flake.lock b/flake.lock index 3b72672e95..736b33c347 100644 --- a/flake.lock +++ b/flake.lock @@ -3,11 +3,11 @@ "CHaP": { "flake": false, "locked": { - "lastModified": 1750412109, - "narHash": "sha256-v5AlraKLH2Rgl3HRJb/DciXIkOlF5pD/RewHB6nDlrM=", + "lastModified": 1753894642, + "narHash": "sha256-7TP8sGtytiHNWdphUZ2j44oy/4tCEqq19BdE7nc1LB8=", "owner": "intersectmbo", "repo": "cardano-haskell-packages", - "rev": "25868b1d259155d46b8c0089f12076f1c7f94cab", + "rev": "8d401eefedf9b1a8703594b3d33165fdb7ee8f69", "type": "github" }, "original": { From f3ca5382b748bdf01c85012eee13e03e6cb54e0e Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Thu, 31 Jul 2025 14:46:30 -0400 Subject: [PATCH 23/42] Update cardano-rpc with PlutusV4 --- cardano-rpc/proto/utxorpc/v1alpha/cardano/cardano.proto | 1 + cardano-rpc/src/Cardano/Rpc/Server/Internal/Orphans.hs | 2 ++ .../cardano-rpc-test/Test/Cardano/Rpc/ProtocolParameters.hs | 1 - 3 files changed, 3 insertions(+), 1 deletion(-) diff --git a/cardano-rpc/proto/utxorpc/v1alpha/cardano/cardano.proto b/cardano-rpc/proto/utxorpc/v1alpha/cardano/cardano.proto index 7a7a5e1bab..1f27530506 100644 --- a/cardano-rpc/proto/utxorpc/v1alpha/cardano/cardano.proto +++ b/cardano-rpc/proto/utxorpc/v1alpha/cardano/cardano.proto @@ -40,6 +40,7 @@ message Script { bytes plutus_v1 = 2; // Plutus V1 script. bytes plutus_v2 = 3; // Plutus V2 script. bytes plutus_v3 = 4; // Plutus V3 script. + bytes plutus_v4 = 5; // Plutus V3 script. } } diff --git a/cardano-rpc/src/Cardano/Rpc/Server/Internal/Orphans.hs b/cardano-rpc/src/Cardano/Rpc/Server/Internal/Orphans.hs index efde50a6be..266aafea2c 100644 --- a/cardano-rpc/src/Cardano/Rpc/Server/Internal/Orphans.hs +++ b/cardano-rpc/src/Cardano/Rpc/Server/Internal/Orphans.hs @@ -86,6 +86,8 @@ instance Inject (ReferenceScript era) (Proto UtxoRpc.Script) where defMessage & #plutusV2 .~ serialiseToRawBytes ps PlutusScript PlutusScriptV3 ps -> defMessage & #plutusV3 .~ serialiseToRawBytes ps + PlutusScript PlutusScriptV4 ps -> + defMessage & #plutusV4 .~ serialiseToRawBytes ps instance IsCardanoEra era => Inject (UTxO era) [Proto UtxoRpc.AnyUtxoData] where inject utxo = diff --git a/cardano-rpc/test/cardano-rpc-test/Test/Cardano/Rpc/ProtocolParameters.hs b/cardano-rpc/test/cardano-rpc-test/Test/Cardano/Rpc/ProtocolParameters.hs index 3564e5f88f..16efc7fd8b 100644 --- a/cardano-rpc/test/cardano-rpc-test/Test/Cardano/Rpc/ProtocolParameters.hs +++ b/cardano-rpc/test/cardano-rpc-test/Test/Cardano/Rpc/ProtocolParameters.hs @@ -35,7 +35,6 @@ hprop_roundtrip_protocol_parameters = H.property $ do pp <- fmap unLedgerProtocolParameters . H.forAll $ genValidProtocolParameters (convert era) let costModels = L.costModelsValid $ pp ^. L.ppCostModelsL mCms = map (`M.lookup` costModels) [minBound .. maxBound] - nonEmptyCostModels = fromList . flip mapMaybe mCms $ \mCm -> mCm >>= \cm -> From 6d81484a8ff7d5b3d9db4e6e87f93d4773c64857 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Thu, 31 Jul 2025 10:38:48 -0400 Subject: [PATCH 24/42] Implement `executeLocalStateQueryExprWithVersion` --- cardano-api/src/Cardano/Api/Network/IPC.hs | 1 + .../Cardano/Api/Network/IPC/Internal/Monad.hs | 26 +++++++++++++++++++ 2 files changed, 27 insertions(+) diff --git a/cardano-api/src/Cardano/Api/Network/IPC.hs b/cardano-api/src/Cardano/Api/Network/IPC.hs index f896d2f2c1..1e05eeacef 100644 --- a/cardano-api/src/Cardano/Api/Network/IPC.hs +++ b/cardano-api/src/Cardano/Api/Network/IPC.hs @@ -219,6 +219,7 @@ module Cardano.Api.Network.IPC -- **** Query monad , LocalStateQueryExpr , executeLocalStateQueryExpr + , executeLocalStateQueryExprWithVersion , queryExpr -- *** Local tx monitoring diff --git a/cardano-api/src/Cardano/Api/Network/IPC/Internal/Monad.hs b/cardano-api/src/Cardano/Api/Network/IPC/Internal/Monad.hs index b294a364d3..648dfabc8d 100644 --- a/cardano-api/src/Cardano/Api/Network/IPC/Internal/Monad.hs +++ b/cardano-api/src/Cardano/Api/Network/IPC/Internal/Monad.hs @@ -5,6 +5,7 @@ module Cardano.Api.Network.IPC.Internal.Monad ( LocalStateQueryExpr , executeLocalStateQueryExpr + , executeLocalStateQueryExprWithVersion , queryExpr ) where @@ -44,6 +45,31 @@ newtype LocalStateQueryExpr block point query r m a = LocalStateQueryExpr } deriving (Functor, Applicative, Monad, MonadReader NodeToClientVersion, MonadIO) +-- | Execute a local state query expression. +executeLocalStateQueryExprWithVersion + :: () + => LocalNodeConnectInfo + -> Net.Query.Target ChainPoint + -> (NodeToClientVersion -> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a) + -> IO (Either AcquiringFailure a) +executeLocalStateQueryExprWithVersion connectInfo target f = do + tmvResultLocalState <- newEmptyTMVarIO + let waitResult = readTMVar tmvResultLocalState + + connectToLocalNodeWithVersion + connectInfo + ( \ntcVersion -> + LocalNodeClientProtocols + { localChainSyncClient = NoLocalChainSyncClient + , localStateQueryClient = + Just $ setupLocalStateQueryExpr waitResult target tmvResultLocalState ntcVersion (f ntcVersion) + , localTxSubmissionClient = Nothing + , localTxMonitoringClient = Nothing + } + ) + + atomically waitResult + -- | Execute a local state query expression. executeLocalStateQueryExpr :: () From 4904a0d7cddf9f431f7d61e5a7b67ed1bfce519b Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Thu, 31 Jul 2025 15:41:06 -0400 Subject: [PATCH 25/42] Fix parseHardForkTriggers --- cardano-api/src/Cardano/Api/LedgerState.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/cardano-api/src/Cardano/Api/LedgerState.hs b/cardano-api/src/Cardano/Api/LedgerState.hs index 4e1d0560b8..1fe7045308 100644 --- a/cardano-api/src/Cardano/Api/LedgerState.hs +++ b/cardano-api/src/Cardano/Api/LedgerState.hs @@ -1148,8 +1148,7 @@ instance FromJSON NodeConfig where <*> parseAlonzoHardForkEpoch o <*> parseBabbageHardForkEpoch o <*> parseConwayHardForkEpoch o - <*> error "dijkstra" - + <*> (pure Consensus.CardanoTriggerHardForkAtDefaultVersion) -- TODO: Dijkstra parseShelleyHardForkEpoch :: Object -> Parser (Consensus.CardanoHardForkTrigger blk) parseShelleyHardForkEpoch o = asum From 2da81eb1fd4e7086b953f960029c279bcc01047c Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Fri, 1 Aug 2025 10:31:03 +0200 Subject: [PATCH 26/42] Fix cardano-rpc-test for protocol parameters roundtrip --- cardano-rpc/proto/utxorpc/v1alpha/cardano/cardano.proto | 5 +++-- cardano-rpc/src/Cardano/Rpc/Server/Internal/Orphans.hs | 1 + cardano-rpc/src/Cardano/Rpc/Server/Internal/UtxoRpc/Type.hs | 3 ++- 3 files changed, 6 insertions(+), 3 deletions(-) diff --git a/cardano-rpc/proto/utxorpc/v1alpha/cardano/cardano.proto b/cardano-rpc/proto/utxorpc/v1alpha/cardano/cardano.proto index 1f27530506..1b12afe39e 100644 --- a/cardano-rpc/proto/utxorpc/v1alpha/cardano/cardano.proto +++ b/cardano-rpc/proto/utxorpc/v1alpha/cardano/cardano.proto @@ -33,14 +33,14 @@ message MultiAsset { } // Represents a script in Cardano. -// TODO u5c: removed native script representation +// TODO u5c: removed native script representation, added plutus_v4 message Script { oneof script { bytes native = 1; // Native script. bytes plutus_v1 = 2; // Plutus V1 script. bytes plutus_v2 = 3; // Plutus V2 script. bytes plutus_v3 = 4; // Plutus V3 script. - bytes plutus_v4 = 5; // Plutus V3 script. + bytes plutus_v4 = 5; // Plutus V4 script. } } @@ -77,6 +77,7 @@ message CostModels { CostModel plutus_v1 = 1; CostModel plutus_v2 = 2; CostModel plutus_v3 = 3; + CostModel plutus_v4 = 4; } message VotingThresholds { diff --git a/cardano-rpc/src/Cardano/Rpc/Server/Internal/Orphans.hs b/cardano-rpc/src/Cardano/Rpc/Server/Internal/Orphans.hs index 266aafea2c..3f727afd26 100644 --- a/cardano-rpc/src/Cardano/Rpc/Server/Internal/Orphans.hs +++ b/cardano-rpc/src/Cardano/Rpc/Server/Internal/Orphans.hs @@ -163,6 +163,7 @@ instance L.ConwayEraPParams lera => Inject (L.PParams lera) (Proto UtxoRpc.PPara & #costModels . #plutusV1 . #values .~ (join . maybeToList) (M.lookup L.PlutusV1 pparamsCostModels) & #costModels . #plutusV2 . #values .~ (join . maybeToList) (M.lookup L.PlutusV2 pparamsCostModels) & #costModels . #plutusV3 . #values .~ (join . maybeToList) (M.lookup L.PlutusV3 pparamsCostModels) + & #costModels . #plutusV4 . #values .~ (join . maybeToList) (M.lookup L.PlutusV4 pparamsCostModels) & #prices . #steps .~ pparams ^. L.ppPricesL . to L.prSteps . to L.unboundRational . to inject & #prices . #memory .~ pparams ^. L.ppPricesL . to L.prMem . to L.unboundRational . to inject & #maxExecutionUnitsPerTransaction .~ pparams ^. L.ppMaxTxExUnitsL . to inject diff --git a/cardano-rpc/src/Cardano/Rpc/Server/Internal/UtxoRpc/Type.hs b/cardano-rpc/src/Cardano/Rpc/Server/Internal/UtxoRpc/Type.hs index 4cc5d56939..9a4e8f9f82 100644 --- a/cardano-rpc/src/Cardano/Rpc/Server/Internal/UtxoRpc/Type.hs +++ b/cardano-rpc/src/Cardano/Rpc/Server/Internal/UtxoRpc/Type.hs @@ -83,9 +83,10 @@ utxoRpcPParamsToProtocolParams era pp = conwayEraOnwardsConstraints (convert era cm1 <- L.mkCostModel L.PlutusV1 $ pp ^. #costModels . #plutusV1 . #values cm2 <- L.mkCostModel L.PlutusV2 $ pp ^. #costModels . #plutusV2 . #values cm3 <- L.mkCostModel L.PlutusV3 $ pp ^. #costModels . #plutusV3 . #values + cm4 <- L.mkCostModel L.PlutusV4 $ pp ^. #costModels . #plutusV4 . #values -- do not add empty cost models let nonEmptyCostModels = - fromList . flip mapMaybe [cm1, cm2, cm3] $ \cm -> + fromList . flip mapMaybe [cm1, cm2, cm3, cm4] $ \cm -> if not (null $ L.getCostModelParams cm) then Just (L.getCostModelLanguage cm, cm) else Nothing From 673e4a8ec12a7fa38dc0b74bfd371dc69b12d018 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Fri, 1 Aug 2025 18:32:10 +0200 Subject: [PATCH 27/42] Update flake lock and ouroboros-network and plutus patches --- cabal.project | 12 ++++++------ flake.lock | 6 +++--- 2 files changed, 9 insertions(+), 9 deletions(-) diff --git a/cabal.project b/cabal.project index 7a8a7a468e..1dc70546c7 100644 --- a/cabal.project +++ b/cabal.project @@ -110,13 +110,13 @@ source-repository-package 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 @@ -130,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 @@ -210,4 +210,4 @@ allow-newer: -- https://github.com/phadej/vec/issues/121 , ral:QuickCheck , fin:QuickCheck - , bin:QuickCheck \ No newline at end of file + , bin:QuickCheck diff --git a/flake.lock b/flake.lock index 736b33c347..bcf93e9336 100644 --- a/flake.lock +++ b/flake.lock @@ -261,11 +261,11 @@ "hackageNix": { "flake": false, "locked": { - "lastModified": 1750624265, - "narHash": "sha256-6G+1a6WS1Y2CLWz+5MpUAvJs03pGMhpIZBaUAH3wQ1Y=", + "lastModified": 1754062911, + "narHash": "sha256-LGrkg4mwY2OXjxaurC563VqqmeoftN7QH/kL8j0lyto=", "owner": "input-output-hk", "repo": "hackage.nix", - "rev": "275b94a4dffdd33b33fd734e01066715da4d7f9c", + "rev": "a75ae374b602899891c7c8eb477135eb4cbe3f8e", "type": "github" }, "original": { From 65013af695f54d4dca2a85872bbd98598ecd16c7 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Fri, 1 Aug 2025 21:59:06 +0200 Subject: [PATCH 28/42] Update wasm cache --- .github/workflows/haskell-wasm.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/haskell-wasm.yml b/.github/workflows/haskell-wasm.yml index dd2b82ed10..0935d5dfe6 100644 --- a/.github/workflows/haskell-wasm.yml +++ b/.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/ From 1efbb74242e7f89970993bb459ffe1762b6f7fa4 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Thu, 7 Aug 2025 12:49:08 -0400 Subject: [PATCH 29/42] Merge with: Consensus related Dijkstra change --- cardano-api/src/Cardano/Api/Consensus/Internal/Mode.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/cardano-api/src/Cardano/Api/Consensus/Internal/Mode.hs b/cardano-api/src/Cardano/Api/Consensus/Internal/Mode.hs index a51cf0f26e..46ddadc5c7 100644 --- a/cardano-api/src/Cardano/Api/Consensus/Internal/Mode.hs +++ b/cardano-api/src/Cardano/Api/Consensus/Internal/Mode.hs @@ -167,4 +167,5 @@ 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" + Consensus.EraIndex (S (S (S (S (S (S (S _))))))) -> + AnyCardanoEra DijkstraEra \ No newline at end of file From faab1c22b69d93edef128f122dab45a76d7f7e85 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Thu, 7 Aug 2025 13:56:42 -0400 Subject: [PATCH 30/42] Use exampleDijkstraGenesis value --- cardano-api/cardano-api.cabal | 8 ++----- cardano-api/gen/Test/Gen/Cardano/Api/Era.hs | 2 -- .../gen/Test/Gen/Cardano/Api/Orphans.hs | 24 ------------------- cardano-api/src/Cardano/Api/LedgerState.hs | 4 ++-- .../Test/Cardano/Api/Orphans.hs | 2 +- 5 files changed, 5 insertions(+), 35 deletions(-) delete mode 100644 cardano-api/gen/Test/Gen/Cardano/Api/Orphans.hs diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index e7a7adf0c6..5089ba09e7 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -125,13 +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.2, cardano-ledger-conway >=1.19, cardano-ledger-core:{cardano-ledger-core, testlib} >=1.17, - cardano-ledger-dijkstra >= 0.1, + cardano-ledger-dijkstra:{cardano-ledger-dijkstra} >= 0.1, cardano-ledger-mary >=1.8, cardano-ledger-shelley >=1.16, cardano-protocol-tpraos >=1.4, @@ -296,7 +296,6 @@ 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 @@ -317,11 +316,9 @@ 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, @@ -345,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, diff --git a/cardano-api/gen/Test/Gen/Cardano/Api/Era.hs b/cardano-api/gen/Test/Gen/Cardano/Api/Era.hs index ddd943db47..b6b87f6eb4 100644 --- a/cardano-api/gen/Test/Gen/Cardano/Api/Era.hs +++ b/cardano-api/gen/Test/Gen/Cardano/Api/Era.hs @@ -17,8 +17,6 @@ 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 () diff --git a/cardano-api/gen/Test/Gen/Cardano/Api/Orphans.hs b/cardano-api/gen/Test/Gen/Cardano/Api/Orphans.hs deleted file mode 100644 index b2162f21ad..0000000000 --- a/cardano-api/gen/Test/Gen/Cardano/Api/Orphans.hs +++ /dev/null @@ -1,24 +0,0 @@ -{-# 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 \ No newline at end of file diff --git a/cardano-api/src/Cardano/Api/LedgerState.hs b/cardano-api/src/Cardano/Api/LedgerState.hs index 1fe7045308..43d1d42089 100644 --- a/cardano-api/src/Cardano/Api/LedgerState.hs +++ b/cardano-api/src/Cardano/Api/LedgerState.hs @@ -159,7 +159,6 @@ import Cardano.Ledger.BaseTypes qualified as Ledger import Cardano.Ledger.Binary (DecoderError) import Cardano.Ledger.Coin qualified as SL import Cardano.Ledger.Conway.Genesis (ConwayGenesis (..)) -import Cardano.Ledger.Dijkstra.Genesis import Cardano.Ledger.Keys qualified as SL import Cardano.Ledger.Shelley.API qualified as ShelleyAPI import Cardano.Ledger.Shelley.Core qualified as Core @@ -208,6 +207,7 @@ import Ouroboros.Network.Block qualified import Ouroboros.Network.Protocol.ChainSync.Client qualified as CS import Ouroboros.Network.Protocol.ChainSync.ClientPipelined qualified as CSP import Ouroboros.Network.Protocol.ChainSync.PipelineDecision +import Test.Cardano.Ledger.Api.Examples.Consensus.Dijkstra import Control.Concurrent import Control.DeepSeq @@ -1496,7 +1496,7 @@ readCardanoGenesisConfig mEra enc = do ShelleyConfig shelleyGenesis shelleyGenesisHash <- readShelleyGenesisConfig enc alonzoGenesis <- readAlonzoGenesisConfig mEra enc conwayGenesis <- readConwayGenesisConfig enc - let dijkstraGenesis = DijkstraGenesis $ error "dijkstra" + let dijkstraGenesis = exampleDijkstraGenesis -- TODO: Dijkstra - add plumbing to read Dijkstra genesis let transCfg = Ledger.mkLatestTransitionConfig shelleyGenesis alonzoGenesis conwayGenesis dijkstraGenesis pure $ GenesisCardano enc byronGenesis shelleyGenesisHash transCfg diff --git a/cardano-api/test/cardano-api-test/Test/Cardano/Api/Orphans.hs b/cardano-api/test/cardano-api-test/Test/Cardano/Api/Orphans.hs index cce4471248..348dda2680 100644 --- a/cardano-api/test/cardano-api-test/Test/Cardano/Api/Orphans.hs +++ b/cardano-api/test/cardano-api-test/Test/Cardano/Api/Orphans.hs @@ -9,7 +9,7 @@ module Test.Cardano.Api.Orphans () where import Cardano.Api.Byron import Cardano.Api.Key -import Test.Cardano.Crypto.Orphans () +--import Test.Cardano.Crypto.Orphans () -- Signing Key instances From 7b8fa125cc21ce81bd400835d0eae363d140fe65 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Thu, 7 Aug 2025 14:09:16 -0400 Subject: [PATCH 31/42] Fix cabal-gild CI failure --- cardano-api/cardano-api.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index 5089ba09e7..53e49132b4 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -131,7 +131,7 @@ library cardano-ledger-byron >=1.2, cardano-ledger-conway >=1.19, cardano-ledger-core:{cardano-ledger-core, testlib} >=1.17, - cardano-ledger-dijkstra:{cardano-ledger-dijkstra} >= 0.1, + cardano-ledger-dijkstra >=0.1, cardano-ledger-mary >=1.8, cardano-ledger-shelley >=1.16, cardano-protocol-tpraos >=1.4, @@ -187,7 +187,7 @@ library time, transformers, transformers-except ^>=0.1.3, - typed-protocols ^>= 1, + typed-protocols ^>=1, vector, yaml, From 0eeff17265628f2ad055c9e63e0f9698759c2e0b Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Thu, 7 Aug 2025 14:18:21 -0400 Subject: [PATCH 32/42] Run formolu --- cardano-api/src/Cardano/Api/Consensus/Internal/Mode.hs | 4 ++-- cardano-api/src/Cardano/Api/LedgerState.hs | 3 ++- cardano-api/test/cardano-api-test/Test/Cardano/Api/Orphans.hs | 2 +- 3 files changed, 5 insertions(+), 4 deletions(-) diff --git a/cardano-api/src/Cardano/Api/Consensus/Internal/Mode.hs b/cardano-api/src/Cardano/Api/Consensus/Internal/Mode.hs index 46ddadc5c7..bf0a7155dc 100644 --- a/cardano-api/src/Cardano/Api/Consensus/Internal/Mode.hs +++ b/cardano-api/src/Cardano/Api/Consensus/Internal/Mode.hs @@ -167,5 +167,5 @@ 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 _))))))) -> - AnyCardanoEra DijkstraEra \ No newline at end of file + Consensus.EraIndex (S (S (S (S (S (S (S _))))))) -> + AnyCardanoEra DijkstraEra diff --git a/cardano-api/src/Cardano/Api/LedgerState.hs b/cardano-api/src/Cardano/Api/LedgerState.hs index 43d1d42089..d77c326f56 100644 --- a/cardano-api/src/Cardano/Api/LedgerState.hs +++ b/cardano-api/src/Cardano/Api/LedgerState.hs @@ -207,7 +207,6 @@ import Ouroboros.Network.Block qualified import Ouroboros.Network.Protocol.ChainSync.Client qualified as CS import Ouroboros.Network.Protocol.ChainSync.ClientPipelined qualified as CSP import Ouroboros.Network.Protocol.ChainSync.PipelineDecision -import Test.Cardano.Ledger.Api.Examples.Consensus.Dijkstra import Control.Concurrent import Control.DeepSeq @@ -262,6 +261,8 @@ import Network.Mux qualified as Mux import Network.TypedProtocol.Core (Nat (..)) import System.FilePath +import Test.Cardano.Ledger.Api.Examples.Consensus.Dijkstra + data InitialLedgerStateError = -- | Failed to read or parse the network config file. ILSEConfigFile Text diff --git a/cardano-api/test/cardano-api-test/Test/Cardano/Api/Orphans.hs b/cardano-api/test/cardano-api-test/Test/Cardano/Api/Orphans.hs index 348dda2680..6ca404222e 100644 --- a/cardano-api/test/cardano-api-test/Test/Cardano/Api/Orphans.hs +++ b/cardano-api/test/cardano-api-test/Test/Cardano/Api/Orphans.hs @@ -9,7 +9,7 @@ module Test.Cardano.Api.Orphans () where import Cardano.Api.Byron import Cardano.Api.Key ---import Test.Cardano.Crypto.Orphans () +-- import Test.Cardano.Crypto.Orphans () -- Signing Key instances From a93eab2fb8da8a4d0eaf57a5ba2f9b910361fc67 Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Mon, 11 Aug 2025 14:26:39 +0200 Subject: [PATCH 33/42] Fix HLS CI job --- .github/workflows/hls.yml | 2 +- flake.nix | 3 +-- 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/.github/workflows/hls.yml b/.github/workflows/hls.yml index 5f8a72d59c..bc3ef335fe 100644 --- a/.github/workflows/hls.yml +++ b/.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-11" runs-on: ubuntu-latest timeout-minutes: 60 diff --git a/flake.nix b/flake.nix index 0a223592cf..10790695a9 100644 --- a/flake.nix +++ b/flake.nix @@ -123,11 +123,10 @@ cabal-gild = "1.3.1.2"; fourmolu = "0.18.0.0"; haskell-language-server = "latest"; - # This index-state makes it work for GHC 9.8.2 (it will need to tbe removed for 9.8.4) hlint = "3.10"; }; # and from nixpkgs or other inputs - shell.nativeBuildInputs = with nixpkgs; [gh jq yq-go actionlint shellcheck snappy protobuf]; + shell.nativeBuildInputs = with nixpkgs; [gh git jq yq-go actionlint shellcheck snappy protobuf]; # disable Hoogle until someone request it shell.withHoogle = false; # Skip cross compilers for the shell From 79b9c02d54a0207daf9dcebeb90f1aa4de417c27 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Tue, 12 Aug 2025 11:06:44 +0200 Subject: [PATCH 34/42] Address lints --- .../src/Cardano/Api/Experimental/Tx/Internal/AnyWitness.hs | 4 ++-- cardano-api/src/Cardano/Api/LedgerState.hs | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/AnyWitness.hs b/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/AnyWitness.hs index 3a3cd517c9..b1a05c9881 100644 --- a/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/AnyWitness.hs +++ b/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/AnyWitness.hs @@ -161,10 +161,10 @@ fromPlutusRunnable L.SPlutusV4 eon runnable = AlonzoEraOnwardsBabbage -> Nothing AlonzoEraOnwardsConway -> let plutusScript = L.plutusFromRunnable runnable - in Just $ (error "fromPlutusRunnable: ConwayPlutusV4") plutusScript + in Just $ error "fromPlutusRunnable: ConwayPlutusV4" plutusScript AlonzoEraOnwardsDijkstra -> let plutusScript = L.plutusFromRunnable runnable - in Just $ Dijkstra.MkDijkstraPlutusScript $ (error "fromPlutusRunnable: DijkstraPlutusV4") plutusScript + in Just $ Dijkstra.MkDijkstraPlutusScript $ error "fromPlutusRunnable: DijkstraPlutusV4" plutusScript toAlonzoDatum :: AlonzoEraOnwards era diff --git a/cardano-api/src/Cardano/Api/LedgerState.hs b/cardano-api/src/Cardano/Api/LedgerState.hs index d77c326f56..4d44b25274 100644 --- a/cardano-api/src/Cardano/Api/LedgerState.hs +++ b/cardano-api/src/Cardano/Api/LedgerState.hs @@ -1149,7 +1149,7 @@ instance FromJSON NodeConfig where <*> parseAlonzoHardForkEpoch o <*> parseBabbageHardForkEpoch o <*> parseConwayHardForkEpoch o - <*> (pure Consensus.CardanoTriggerHardForkAtDefaultVersion) -- TODO: Dijkstra + <*> pure Consensus.CardanoTriggerHardForkAtDefaultVersion -- TODO: Dijkstra parseShelleyHardForkEpoch :: Object -> Parser (Consensus.CardanoHardForkTrigger blk) parseShelleyHardForkEpoch o = asum From 64e62e7d6ac1bd250e4b61346f09ecd697ee2e90 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Tue, 12 Aug 2025 19:44:01 +0200 Subject: [PATCH 35/42] Update `ouroboros-consensus` stanza --- .github/workflows/hls.yml | 2 +- cabal.project | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/.github/workflows/hls.yml b/.github/workflows/hls.yml index bc3ef335fe..888612e246 100644 --- a/.github/workflows/hls.yml +++ b/.github/workflows/hls.yml @@ -14,7 +14,7 @@ jobs: test-hls-works: env: # Modify this value to "invalidate" the cache. - HLS_CACHE_VERSION: "2025-08-11" + HLS_CACHE_VERSION: "2025-08-12" runs-on: ubuntu-latest timeout-minutes: 60 diff --git a/cabal.project b/cabal.project index 1dc70546c7..abaf673c87 100644 --- a/cabal.project +++ b/cabal.project @@ -64,8 +64,8 @@ if impl (ghc >= 9.12) source-repository-package type: git location: https://github.com/IntersectMBO/ouroboros-consensus - tag: 15fc8c4fee64473350e1904347bfd5852f9cdbfa - --sha256: sha256-Tvw0dLGZkBAflpvcEwl7Acnrux9H5UaniW5YwMvIeIs= + tag: 5aac28bec41b7709f75a5c9f20e2431259cf237f + --sha256: sha256-PXnD7mAIZgnodqbMU3ImCb/uoat61vLsqnc6dUyTRIw= subdir: ouroboros-consensus ouroboros-consensus-cardano From 7ae44e93e87752e8876cedc38c64adcc26547af2 Mon Sep 17 00:00:00 2001 From: Ana Pantilie Date: Thu, 21 Aug 2025 14:47:45 +0300 Subject: [PATCH 36/42] WIP: update ledger and index-state --- cabal.project | 80 +++++++------------ cardano-api/cardano-api.cabal | 4 +- .../Cardano/Api/Ledger/Internal/Reexport.hs | 3 +- 3 files changed, 32 insertions(+), 55 deletions(-) diff --git a/cabal.project b/cabal.project index 4ffe03f7d3..278540a92e 100644 --- a/cabal.project +++ b/cabal.project @@ -14,7 +14,7 @@ repository cardano-haskell-packages -- you need to run if you change them index-state: , hackage.haskell.org 2025-06-22T20:18:27Z - , cardano-haskell-packages 2025-07-28T14:33:19Z + , cardano-haskell-packages 2025-08-21T00:00:00Z packages: cardano-api @@ -178,61 +178,39 @@ allow-newer: source-repository-package type: git - location: https://github.com/input-output-hk/kes-agent - tag: 60acf5d1c949695dc7822945b18fc916e7ef4391 - --sha256: sha256-oTsxaFAs1c/H0oYLhiivO5mr48oHNsPi5k2XyXxwCJg= + location: https://github.com/IntersectMBO/cardano-ledger + tag: 4edd7fd8b7101d24625c88d45c31f15e6345998e + --sha256: sha256-cJQIEmKeGDOkvNMm4Gmhp3l0Ikhpu/PQD9WqzSZWB68= subdir: - kes-agent - -source-repository-package - type: git - location: https://github.com/IntersectMBO/ouroboros-network - tag: 253316ae1c5ec0eaf79f306eac1986969b7842a4 - --sha256: sha256-0HZ49kIgCrv/H9I/aUb+wFfRiVuZMrUofJFdgWPG17o= - subdir: ouroboros-network-api - ouroboros-network - ouroboros-network-framework - ouroboros-network-protocols - -source-repository-package - type: git - location: https://github.com/IntersectMBO/cardano-ledger - tag: ca8d451bbce11dde3b68e99782c79f9b4c1dfca5 - --sha256: sha256-YHIscWnp9GrFn0EYGM7xd8Ds8x0O00FWBAIZX22bWpA= - 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/conway/test-suite - 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-ledger-test - libs/cardano-protocol-tpraos - libs/constrained-generators - libs/non-integral - libs/set-algebra - libs/small-steps - libs/vector-map + eras/allegra/impl + eras/alonzo/impl + eras/alonzo/test-suite + eras/babbage/impl + 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 source-repository-package type: git location: https://github.com/IntersectMBO/ouroboros-consensus - tag: 26c831eb40bd15750ef8243285466fe9bd582cf7 - --sha256: sha256-oTsxaFAs1c/H0oYLhiivO5mr48oHNsPi5k2XyXxwCJg= + tag: e62e46a91e1912dede59ee48ce55bd09574ca72a + --sha256: sha256-up0zy9tN1+wOxFO2cD/9W69HVaZjw8+aL8jJPf7LTCw= subdir: ouroboros-consensus ouroboros-consensus-cardano diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index ad41017a4d..f9432bbce5 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -125,7 +125,7 @@ library cardano-data >=1.0, cardano-ledger-allegra >=1.7, cardano-ledger-alonzo >=1.13, - cardano-ledger-api:{cardano-ledger-api, testlib} >=1.11, + cardano-ledger-api >=1.11, cardano-ledger-babbage >=1.11, cardano-ledger-binary >=1.6, cardano-ledger-byron >=1.2, @@ -344,7 +344,6 @@ test-suite cardano-api-test cardano-crypto-class ^>=2.2.1, cardano-crypto-tests ^>=2.2, cardano-ledger-alonzo, - cardano-ledger-api >=1.9, cardano-ledger-binary, cardano-ledger-conway, cardano-ledger-core:{cardano-ledger-core, testlib} >=1.14, @@ -416,7 +415,6 @@ test-suite cardano-api-golden cardano-crypto-class ^>=2.2.1, cardano-data >=1.0, cardano-ledger-alonzo, - cardano-ledger-api >=1.9, cardano-ledger-binary, cardano-ledger-core:{cardano-ledger-core, testlib} >=1.14, cardano-ledger-shelley, diff --git a/cardano-api/src/Cardano/Api/Ledger/Internal/Reexport.hs b/cardano-api/src/Cardano/Api/Ledger/Internal/Reexport.hs index 78cc32c135..344dfdba96 100644 --- a/cardano-api/src/Cardano/Api/Ledger/Internal/Reexport.hs +++ b/cardano-api/src/Cardano/Api/Ledger/Internal/Reexport.hs @@ -335,7 +335,7 @@ import Cardano.Ledger.Keys import Cardano.Ledger.Mary.Value (MultiAsset (..)) import Cardano.Ledger.Plutus.Data (Data (..), unData) import Cardano.Ledger.Plutus.Language (Language, Plutus, languageToText, plutusBinary) -import Cardano.Ledger.PoolParams (PoolMetadata (..), PoolParams (..), StakePoolRelay (..)) +import Cardano.Ledger.State (PoolMetadata (..), PoolParams (..), StakePoolRelay (..)) import Cardano.Ledger.Shelley.API ( AccountState , GenDelegPair (..) @@ -344,6 +344,7 @@ import Cardano.Ledger.Shelley.API , WitVKey (..) , hashKey , hashVerKeyVRF + , ChainAccountState (..) ) import Cardano.Ledger.Shelley.Genesis ( ShelleyGenesisStaking (..) From f18e5cb09a9be6e9aa9d0e968dd8fd0267b6d86b Mon Sep 17 00:00:00 2001 From: Ana Pantilie Date: Mon, 25 Aug 2025 15:24:15 +0300 Subject: [PATCH 37/42] Fix most compilation errors --- cardano-api/cardano-api.cabal | 6 ++++-- .../src/Cardano/Api/Consensus/Internal/InMode.hs | 1 - cardano-api/src/Cardano/Api/Experimental/Tx.hs | 3 ++- .../Api/Experimental/Tx/Internal/AnyWitness.hs | 1 - cardano-api/src/Cardano/Api/Genesis/Internal.hs | 2 +- .../Cardano/Api/Internal/Orphans/Serialisation.hs | 10 ++++++---- cardano-api/src/Cardano/Api/LedgerState.hs | 9 +++------ .../src/Cardano/Api/Query/Internal/Convenience.hs | 7 ++++++- .../Cardano/Api/Query/Internal/Type/QueryInMode.hs | 5 ++--- cardano-api/src/Cardano/Api/Tx/Internal/Body.hs | 13 +++++++------ .../src/Cardano/Api/Tx/Internal/Body/Lens.hs | 2 +- 11 files changed, 32 insertions(+), 27 deletions(-) diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index f9432bbce5..c6da6d6c18 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -131,9 +131,9 @@ library 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-dijkstra:{cardano-ledger-dijkstra, testlib} >=0.1, cardano-ledger-mary >=1.8, - cardano-ledger-shelley >=1.16, + cardano-ledger-shelley:{cardano-ledger-shelley, testlib} >=1.16, cardano-protocol-tpraos >=1.4, cardano-slotting >=0.2.0.0, cardano-strict-containers >=0.1, @@ -348,6 +348,7 @@ test-suite cardano-api-test cardano-ledger-conway, cardano-ledger-core:{cardano-ledger-core, testlib} >=1.14, cardano-ledger-mary, + cardano-ledger-api >=1.11, cardano-protocol-tpraos, cardano-slotting, cborg, @@ -419,6 +420,7 @@ test-suite cardano-api-golden cardano-ledger-core:{cardano-ledger-core, testlib} >=1.14, cardano-ledger-shelley, cardano-ledger-shelley-test >=1.2.0.1, + cardano-ledger-api >=1.11, cardano-protocol-tpraos, containers, errors, diff --git a/cardano-api/src/Cardano/Api/Consensus/Internal/InMode.hs b/cardano-api/src/Cardano/Api/Consensus/Internal/InMode.hs index 5063b34dca..8fea91d371 100644 --- a/cardano-api/src/Cardano/Api/Consensus/Internal/InMode.hs +++ b/cardano-api/src/Cardano/Api/Consensus/Internal/InMode.hs @@ -317,4 +317,3 @@ fromConsensusApplyTxErr = \case TxValidationErrorInCardanoMode $ ShelleyTxValidationError ShelleyBasedEraDijkstra err Consensus.ApplyTxErrWrongEra err -> TxValidationEraMismatch err - _ -> undefined diff --git a/cardano-api/src/Cardano/Api/Experimental/Tx.hs b/cardano-api/src/Cardano/Api/Experimental/Tx.hs index 5e032e20ec..dd0fd2d09f 100644 --- a/cardano-api/src/Cardano/Api/Experimental/Tx.hs +++ b/cardano-api/src/Cardano/Api/Experimental/Tx.hs @@ -214,7 +214,8 @@ newtype UnsignedTxError = UnsignedTxError TxBodyError makeUnsignedTx - :: Era era + :: Ledger.ProtVerAtMost (LedgerEra era) 11 + => Era era -> TxBodyContent BuildTx era -> Either TxBodyError (UnsignedTx era) makeUnsignedTx era bc = obtainCommonConstraints era $ do diff --git a/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/AnyWitness.hs b/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/AnyWitness.hs index d718b76066..340c77cf02 100644 --- a/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/AnyWitness.hs +++ b/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/AnyWitness.hs @@ -185,5 +185,4 @@ getPlutusDatum L.SPlutusV3 (SpendingScriptDatum d) = d getPlutusDatum L.SPlutusV4 (SpendingScriptDatum _d) = error "dijkstra" getPlutusDatum _ InlineDatum = Nothing getPlutusDatum _ NoScriptDatum = Nothing -getPlutusDatum _ _ = undefined diff --git a/cardano-api/src/Cardano/Api/Genesis/Internal.hs b/cardano-api/src/Cardano/Api/Genesis/Internal.hs index e1259cdfbe..304a98b1ca 100644 --- a/cardano-api/src/Cardano/Api/Genesis/Internal.hs +++ b/cardano-api/src/Cardano/Api/Genesis/Internal.hs @@ -312,7 +312,7 @@ decodeAlonzoGenesis (Just era) genesisBs = modifyError ("Cannot decode era-sensi -- use all available parameters >= conway | isConwayOnwards = length allCostModelParams -- use only required params in < conway - | otherwise = L.costModelParamsCount L.PlutusV2 -- Babbage + | otherwise = L.costModelInitParamCount L.PlutusV2 -- Babbage -- A list-like of tuples (param name, value) with default maxBound value optionalCostModelDefaultValues :: (Item l ~ (V2.ParamName, Int64), IsList l) => l diff --git a/cardano-api/src/Cardano/Api/Internal/Orphans/Serialisation.hs b/cardano-api/src/Cardano/Api/Internal/Orphans/Serialisation.hs index 2517dc7ec1..d6a77eff7c 100644 --- a/cardano-api/src/Cardano/Api/Internal/Orphans/Serialisation.hs +++ b/cardano-api/src/Cardano/Api/Internal/Orphans/Serialisation.hs @@ -195,20 +195,22 @@ deriving anyclass instance ToJSON (L.PredicateFailure (L.EraRule "UTXO" ledgerera)) => ToJSON (L.ShelleyPpupPredFailure ledgerera) -deriving anyclass instance +instance ( ToJSON (L.PredicateFailure (L.EraRule "UTXO" ledgerera)) , ToJSON (L.PlutusPurpose L.AsItem ledgerera) , ToJSON (L.PlutusPurpose L.AsIx ledgerera) ) - => ToJSON (L.AlonzoUtxowPredFailure ledgerera) + => ToJSON (L.AlonzoUtxowPredFailure ledgerera) where + toJSON = undefined -deriving anyclass instance +instance ( ToJSON (L.PredicateFailure (L.EraRule "UTXO" ledgerera)) , ToJSON (L.TxCert ledgerera) , ToJSON (L.PlutusPurpose L.AsItem ledgerera) , ToJSON (L.PlutusPurpose L.AsIx ledgerera) ) - => ToJSON (L.BabbageUtxowPredFailure ledgerera) + => ToJSON (L.BabbageUtxowPredFailure ledgerera) where + toJSON = undefined deriving anyclass instance ToJSON (L.PredicateFailure (L.EraRule "LEDGER" ledgerera)) diff --git a/cardano-api/src/Cardano/Api/LedgerState.hs b/cardano-api/src/Cardano/Api/LedgerState.hs index 33d27b1724..2b652331a1 100644 --- a/cardano-api/src/Cardano/Api/LedgerState.hs +++ b/cardano-api/src/Cardano/Api/LedgerState.hs @@ -263,7 +263,8 @@ import Network.Mux qualified as Mux import Network.TypedProtocol.Core (Nat (..)) import System.FilePath -import Test.Cardano.Ledger.Api.Examples.Consensus.Dijkstra +import Test.Cardano.Ledger.Dijkstra.Examples qualified as Dijkstra +import Test.Cardano.Ledger.Shelley.Examples qualified as Shelley data InitialLedgerStateError = -- | Failed to read or parse the network config file. @@ -1401,12 +1402,8 @@ decodeLedgerState = do 2 <- CBOR.decodeListLen hst <- HFC.HardForkLedgerState -<<<<<<< HEAD <$> HFC.decodeTelescope (byron :* shelley :* allegra :* mary :* alonzo :* babbage :* conway :* dijkstra :* Nil) -======= - <$> HFC.decodeTelescope (byron :* shelley :* allegra :* mary :* alonzo :* babbage :* conway :* undefined :* Nil) ->>>>>>> origin/fraser-iohk/cardano-api-kes-agent tbs <- Ledger.valuesMKDecoder hst pure (LedgerState hst tbs) where @@ -1503,7 +1500,7 @@ readCardanoGenesisConfig mEra enc = do ShelleyConfig shelleyGenesis shelleyGenesisHash <- readShelleyGenesisConfig enc alonzoGenesis <- readAlonzoGenesisConfig mEra enc conwayGenesis <- readConwayGenesisConfig enc - let dijkstraGenesis = exampleDijkstraGenesis -- TODO: Dijkstra - add plumbing to read Dijkstra genesis + let dijkstraGenesis = Shelley.leTranslationContext Dijkstra.ledgerExamples -- TODO: Dijkstra - add plumbing to read Dijkstra genesis let transCfg = Ledger.mkLatestTransitionConfig shelleyGenesis alonzoGenesis conwayGenesis dijkstraGenesis pure $ GenesisCardano enc byronGenesis shelleyGenesisHash transCfg diff --git a/cardano-api/src/Cardano/Api/Query/Internal/Convenience.hs b/cardano-api/src/Cardano/Api/Query/Internal/Convenience.hs index 710a874171..d4e20eef8d 100644 --- a/cardano-api/src/Cardano/Api/Query/Internal/Convenience.hs +++ b/cardano-api/src/Cardano/Api/Query/Internal/Convenience.hs @@ -20,6 +20,10 @@ module Cardano.Api.Query.Internal.Convenience ) where +import Ouroboros.Consensus.HardFork.Combinator.AcrossEras (EraMismatch (..)) + +import Ouroboros.Network.Protocol.LocalStateQuery.Type (Target (..)) + import Cardano.Api.Address import Cardano.Api.Certificate.Internal import Cardano.Api.Consensus.Internal.Mode @@ -49,6 +53,7 @@ import Data.Maybe (mapMaybe) import Data.Set (Set) import Data.Text (Text) import GHC.Exts (IsList (..), IsString (..)) +import Control.Exception (SomeException, displayException) data QueryConvenienceError = AcqFailure AcquiringFailure @@ -109,7 +114,7 @@ queryStateForBalancedTx , SystemStart , Set PoolId , Map StakeCredential L.Coin - , Map (L.Credential L.DRepRole) L.Coin + , Map (L.Credential L.DRepRole) (L.CompactForm L.Coin) , Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue) ) ) diff --git a/cardano-api/src/Cardano/Api/Query/Internal/Type/QueryInMode.hs b/cardano-api/src/Cardano/Api/Query/Internal/Type/QueryInMode.hs index 15f7afdc7a..80cb15b7a4 100644 --- a/cardano-api/src/Cardano/Api/Query/Internal/Type/QueryInMode.hs +++ b/cardano-api/src/Cardano/Api/Query/Internal/Type/QueryInMode.hs @@ -139,7 +139,6 @@ import Data.Text qualified as Text import Data.Word (Word64) import GHC.Exts (IsList (..)) import GHC.Stack -import Data.Coerce (coerce) -- ---------------------------------------------------------------------------- -- Queries @@ -648,7 +647,7 @@ toConsensusQueryShelleyBased sbe = \case caseShelleyToBabbageOrConwayEraOnwards (const $ error "toConsensusQueryShelleyBased: QueryDRepState is only available in the Conway era") ( \w -> - Some (consensusQueryInEraInMode era (conwayEraOnwardsConstraints w $ Consensus.GetDRepState creds)) + Some (consensusQueryInEraInMode era (conwayEraOnwardsConstraints w $ Consensus.GetDRepState _creds)) ) sbe QueryDRepStakeDistr dreps -> @@ -937,7 +936,7 @@ fromConsensusQueryResultShelleyBased sbe sbeQuery q' r' = Consensus.GetStakePoolParams{} -> Map.map fromShelleyPoolParams . Map.mapKeysMonotonic StakePoolKeyHash - $ r' + $ undefined -- r' _ -> fromConsensusQueryResultMismatch QueryDebugLedgerState{} -> case q' of diff --git a/cardano-api/src/Cardano/Api/Tx/Internal/Body.hs b/cardano-api/src/Cardano/Api/Tx/Internal/Body.hs index a2f75f7c59..6dbbba6a86 100644 --- a/cardano-api/src/Cardano/Api/Tx/Internal/Body.hs +++ b/cardano-api/src/Cardano/Api/Tx/Internal/Body.hs @@ -272,7 +272,7 @@ import Cardano.Crypto.Hashing qualified as Byron import Cardano.Ledger.Allegra.Core qualified as L import Cardano.Ledger.Alonzo.Core qualified as L import Cardano.Ledger.Alonzo.Scripts qualified as Alonzo -import Cardano.Ledger.Alonzo.Tx qualified as Alonzo (hashScriptIntegrity) +-- import Cardano.Ledger.Alonzo.Tx qualified as Alonzo (hashScriptIntegrity) import Cardano.Ledger.Alonzo.TxWits qualified as Alonzo import Cardano.Ledger.Api qualified as L import Cardano.Ledger.Babbage.UTxO qualified as L @@ -1739,14 +1739,14 @@ fromLedgerTxExtraKeyWitnesses sbe body = caseShelleyToMaryOrAlonzoEraOnwards (const TxExtraKeyWitnessesNone) ( \w -> - let keyhashes = body ^. L.reqSignerHashesTxBodyL + let keyhashes = body ^. L.reqSignerHashesTxBodyG in if Set.null keyhashes then TxExtraKeyWitnessesNone else TxExtraKeyWitnesses w [ PaymentKeyHash (Shelley.coerceKeyRole keyhash) - | keyhash <- toList $ body ^. L.reqSignerHashesTxBodyL + | keyhash <- toList $ body ^. L.reqSignerHashesTxBodyG ] ) sbe @@ -1981,12 +1981,13 @@ convPParamsToScriptIntegrityHash -> Alonzo.TxDats (ShelleyLedgerEra era) -> Set Plutus.Language -> StrictMaybe L.ScriptIntegrityHash -convPParamsToScriptIntegrityHash w (BuildTxWith mTxProtocolParams) redeemers datums languages = +convPParamsToScriptIntegrityHash w (BuildTxWith mTxProtocolParams) _ _ _ = -- redeemers datums languages = alonzoEraOnwardsConstraints w $ case mTxProtocolParams of Nothing -> SNothing - Just (LedgerProtocolParameters pp) -> - Alonzo.hashScriptIntegrity (Set.map (L.getLanguageView pp) languages) redeemers datums + Just (LedgerProtocolParameters _) -> undefined + -- Just (LedgerProtocolParameters pp) -> + -- Alonzo.hashScriptIntegrity (Set.map (L.getLanguageView pp) languages) redeemers datums convLanguages :: [(ScriptWitnessIndex, AnyScriptWitness era)] -> Set Plutus.Language convLanguages witnesses = diff --git a/cardano-api/src/Cardano/Api/Tx/Internal/Body/Lens.hs b/cardano-api/src/Cardano/Api/Tx/Internal/Body/Lens.hs index cbaaa9d0c4..8e82a4687c 100644 --- a/cardano-api/src/Cardano/Api/Tx/Internal/Body/Lens.hs +++ b/cardano-api/src/Cardano/Api/Tx/Internal/Body/Lens.hs @@ -163,7 +163,7 @@ collateralInputsTxBodyL w = alonzoEraOnwardsConstraints w $ txBodyL . L.collater reqSignerHashesTxBodyL :: AlonzoEraOnwards era -> Lens' (LedgerTxBody era) (Set (L.KeyHash L.Witness)) -reqSignerHashesTxBodyL w = alonzoEraOnwardsConstraints w $ txBodyL . L.reqSignerHashesTxBodyL +reqSignerHashesTxBodyL w = alonzoEraOnwardsConstraints w $ txBodyL . undefined -- L.reqSignerHashesTxBodyL referenceInputsTxBodyL :: BabbageEraOnwards era -> Lens' (LedgerTxBody era) (Set L.TxIn) From 764c70827fe100dfd6fb17c9ad9ae1214769b6c8 Mon Sep 17 00:00:00 2001 From: Ana Pantilie Date: Mon, 25 Aug 2025 15:34:07 +0300 Subject: [PATCH 38/42] Upgrade plutus to 1.52 --- cardano-api/cardano-api.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index c6da6d6c18..e88c53b9e5 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -169,7 +169,7 @@ library ouroboros-network-framework, ouroboros-network-protocols >=0.15, parsec, - plutus-ledger-api:{plutus-ledger-api, plutus-ledger-api-testlib} ^>=1.50, + plutus-ledger-api:{plutus-ledger-api, plutus-ledger-api-testlib} ^>=1.52, pretty-simple, prettyprinter, prettyprinter-ansi-terminal, @@ -428,7 +428,7 @@ test-suite cardano-api-golden hedgehog >=1.1, hedgehog-extras ^>=0.8, microlens, - plutus-core ^>=1.50, + plutus-core ^>=1.52, plutus-ledger-api, tasty, tasty-discover, From c21f792afb8862a42d754355222ae7df4b415bce Mon Sep 17 00:00:00 2001 From: Ana Pantilie Date: Tue, 26 Aug 2025 18:28:16 +0300 Subject: [PATCH 39/42] Add bounds to quickcheck --- cardano-api/cardano-api.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index e88c53b9e5..220bc88119 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -333,7 +333,7 @@ test-suite cardano-api-test type: exitcode-stdio-1.0 build-depends: FailT, - QuickCheck, + QuickCheck ^>=2.16, aeson >=1.5.6.0, base16-bytestring, bytestring, From ee5eccff3d1a5bdf66fcfdb0c8535950690203e5 Mon Sep 17 00:00:00 2001 From: Ana Pantilie Date: Tue, 26 Aug 2025 18:31:37 +0300 Subject: [PATCH 40/42] Add another quickcheck bound --- cardano-api/cardano-api.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index 220bc88119..beadb0f7dd 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -304,7 +304,7 @@ library gen Test.Hedgehog.Roundtrip.CBOR build-depends: - QuickCheck, + QuickCheck ^>=2.16, aeson >=1.5.6.0, base16-bytestring, bytestring, From f3de95392d23ef54106f5310fdeecd3ed4f2f082 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Tue, 26 Aug 2025 16:15:21 -0400 Subject: [PATCH 41/42] Fill in undefineds --- .../src/Cardano/Api/Certificate/Internal.hs | 70 +++++++++++++++++++ .../src/Cardano/Api/Experimental/Tx.hs | 6 +- .../Api/Internal/Orphans/Serialisation.hs | 27 +++++-- .../Api/Query/Internal/Type/QueryInMode.hs | 21 +++--- .../src/Cardano/Api/Tx/Internal/Body.hs | 9 +-- .../src/Cardano/Api/Tx/Internal/Body/Lens.hs | 8 ++- 6 files changed, 117 insertions(+), 24 deletions(-) diff --git a/cardano-api/src/Cardano/Api/Certificate/Internal.hs b/cardano-api/src/Cardano/Api/Certificate/Internal.hs index 2bd8f9c43c..d57912d9d7 100644 --- a/cardano-api/src/Cardano/Api/Certificate/Internal.hs +++ b/cardano-api/src/Cardano/Api/Certificate/Internal.hs @@ -67,6 +67,7 @@ module Cardano.Api.Certificate.Internal , fromShelleyCertificate , toShelleyPoolParams , fromShelleyPoolParams + , fromShelleyStakePoolState -- * Data family instances , AsType (..) @@ -100,6 +101,7 @@ import Cardano.Ledger.Api qualified as L import Cardano.Ledger.BaseTypes (strictMaybe) import Cardano.Ledger.Coin qualified as L import Cardano.Ledger.Keys qualified as Ledger +import Cardano.Ledger.State qualified as Ledger import Control.Monad.Except (MonadError (..)) import Data.ByteString (ByteString) @@ -781,6 +783,74 @@ fromShelleyPoolParams Text.encodeUtf8 . Ledger.dnsToText +fromShelleyStakePoolState + :: Ledger.KeyHash Ledger.StakePool + -> Ledger.StakePoolState + -> StakePoolParameters +fromShelleyStakePoolState + poolId + Ledger.StakePoolState + { Ledger.spsVrf + , Ledger.spsPledge + , Ledger.spsCost + , Ledger.spsMargin + , Ledger.spsRewardAccount + , Ledger.spsOwners + , Ledger.spsRelays + , Ledger.spsMetadata + } = + StakePoolParameters + { stakePoolId = StakePoolKeyHash poolId + , stakePoolVRF = VrfKeyHash (Ledger.fromVRFVerKeyHash spsVrf) + , stakePoolCost = spsCost + , stakePoolMargin = Ledger.unboundRational spsMargin + , stakePoolRewardAccount = fromShelleyStakeAddr spsRewardAccount + , stakePoolPledge = spsPledge + , stakePoolOwners = map StakeKeyHash (toList spsOwners) + , stakePoolRelays = + map + fromShelleyStakePoolRelay + (toList spsRelays) + , stakePoolMetadata = + fromShelleyPoolMetadata + <$> Ledger.strictMaybeToMaybe spsMetadata + } + where + fromShelleyStakePoolRelay :: Ledger.StakePoolRelay -> StakePoolRelay + fromShelleyStakePoolRelay (Ledger.SingleHostAddr mport mipv4 mipv6) = + StakePoolRelayIp + (Ledger.strictMaybeToMaybe mipv4) + (Ledger.strictMaybeToMaybe mipv6) + (fromIntegral . Ledger.portToWord16 <$> Ledger.strictMaybeToMaybe mport) + fromShelleyStakePoolRelay (Ledger.SingleHostName mport dnsname) = + StakePoolRelayDnsARecord + (fromShelleyDnsName dnsname) + (fromIntegral . Ledger.portToWord16 <$> Ledger.strictMaybeToMaybe mport) + fromShelleyStakePoolRelay (Ledger.MultiHostName dnsname) = + StakePoolRelayDnsSrvRecord + (fromShelleyDnsName dnsname) + + fromShelleyPoolMetadata :: Ledger.PoolMetadata -> StakePoolMetadataReference + fromShelleyPoolMetadata + Ledger.PoolMetadata + { Ledger.pmUrl + , Ledger.pmHash + } = + StakePoolMetadataReference + { stakePoolMetadataURL = Ledger.urlToText pmUrl + , stakePoolMetadataHash = + StakePoolMetadataHash + . fromMaybe (error "fromShelleyPoolMetadata: invalid hash. TODO: proper validation") + . Ledger.hashFromBytes + $ pmHash + } + + -- TODO: change the ledger rep of the DNS name to use ShortByteString + fromShelleyDnsName :: Ledger.DnsName -> ByteString + fromShelleyDnsName = + Text.encodeUtf8 + . Ledger.dnsToText + data AnchorDataFromCertificateError = InvalidPoolMetadataHashError Ledger.Url ByteString deriving (Eq, Show) diff --git a/cardano-api/src/Cardano/Api/Experimental/Tx.hs b/cardano-api/src/Cardano/Api/Experimental/Tx.hs index dd0fd2d09f..0cf6ff9a70 100644 --- a/cardano-api/src/Cardano/Api/Experimental/Tx.hs +++ b/cardano-api/src/Cardano/Api/Experimental/Tx.hs @@ -214,11 +214,11 @@ newtype UnsignedTxError = UnsignedTxError TxBodyError makeUnsignedTx - :: Ledger.ProtVerAtMost (LedgerEra era) 11 - => Era era + :: Era era -> TxBodyContent BuildTx era -> Either TxBodyError (UnsignedTx era) -makeUnsignedTx era bc = obtainCommonConstraints era $ do +makeUnsignedTx DijkstraEra _ = error "makeUnsignedTx: Dijkstra era not supported yet" +makeUnsignedTx era@ConwayEra bc = obtainCommonConstraints era $ do let sbe = convert era aeon = convert era TxScriptWitnessRequirements languages scripts datums redeemers <- diff --git a/cardano-api/src/Cardano/Api/Internal/Orphans/Serialisation.hs b/cardano-api/src/Cardano/Api/Internal/Orphans/Serialisation.hs index d6a77eff7c..b8247a45c3 100644 --- a/cardano-api/src/Cardano/Api/Internal/Orphans/Serialisation.hs +++ b/cardano-api/src/Cardano/Api/Internal/Orphans/Serialisation.hs @@ -45,10 +45,12 @@ import Cardano.Chain.Update.Validation.Voting qualified as L.Voting import Cardano.Crypto.Hash qualified as Crypto import Cardano.Ledger.Allegra.Rules qualified as L import Cardano.Ledger.Alonzo.PParams qualified as Ledger +import Cardano.Ledger.Alonzo.Rules qualified as Alonzo import Cardano.Ledger.Alonzo.Rules qualified as L import Cardano.Ledger.Alonzo.Tx qualified as L import Cardano.Ledger.Api qualified as L import Cardano.Ledger.Babbage.PParams qualified as Ledger +import Cardano.Ledger.Babbage.Rules qualified as Babbage import Cardano.Ledger.Babbage.Rules qualified as L import Cardano.Ledger.BaseTypes (strictMaybeToMaybe) import Cardano.Ledger.BaseTypes qualified as L @@ -91,11 +93,20 @@ import PlutusLedgerApi.V2 qualified as V2 import Codec.Binary.Bech32 qualified as Bech32 import Codec.CBOR.Read qualified as CBOR -import Data.Aeson (KeyValue ((.=)), ToJSON (..), ToJSONKey (..), object, pairs) +import Data.Aeson + ( KeyValue ((.=)) + , ToJSON (..) + , ToJSONKey (..) + , defaultOptions + , genericToJSON + , object + , pairs + ) import Data.Aeson qualified as A import Data.Aeson qualified as Aeson import Data.Bifunctor import Data.ByteString qualified as BS +import Data.ByteString.Base16 qualified as B16 import Data.ByteString.Base16 qualified as Base16 import Data.ByteString.Char8 qualified as C8 import Data.ByteString.Short qualified as SBS @@ -106,6 +117,7 @@ import Data.ListMap qualified as ListMap import Data.Maybe.Strict (StrictMaybe (..)) import Data.Monoid import Data.Text qualified as T +import Data.Text qualified as Text import Data.Text.Encoding qualified as Text import Data.Typeable (Typeable) import GHC.Exts (IsList (..), IsString (..)) @@ -200,8 +212,12 @@ instance , ToJSON (L.PlutusPurpose L.AsItem ledgerera) , ToJSON (L.PlutusPurpose L.AsIx ledgerera) ) - => ToJSON (L.AlonzoUtxowPredFailure ledgerera) where - toJSON = undefined + => ToJSON (L.AlonzoUtxowPredFailure ledgerera) + where + toJSON = genericToJSON defaultOptions + +instance ToJSON C8.ByteString where + toJSON = Aeson.String . Text.decodeLatin1 . B16.encode instance ( ToJSON (L.PredicateFailure (L.EraRule "UTXO" ledgerera)) @@ -209,8 +225,9 @@ instance , ToJSON (L.PlutusPurpose L.AsItem ledgerera) , ToJSON (L.PlutusPurpose L.AsIx ledgerera) ) - => ToJSON (L.BabbageUtxowPredFailure ledgerera) where - toJSON = undefined + => ToJSON (L.BabbageUtxowPredFailure ledgerera) + where + toJSON = genericToJSON defaultOptions deriving anyclass instance ToJSON (L.PredicateFailure (L.EraRule "LEDGER" ledgerera)) diff --git a/cardano-api/src/Cardano/Api/Query/Internal/Type/QueryInMode.hs b/cardano-api/src/Cardano/Api/Query/Internal/Type/QueryInMode.hs index 80cb15b7a4..4b9e3d1400 100644 --- a/cardano-api/src/Cardano/Api/Query/Internal/Type/QueryInMode.hs +++ b/cardano-api/src/Cardano/Api/Query/Internal/Type/QueryInMode.hs @@ -643,11 +643,11 @@ toConsensusQueryShelleyBased sbe = \case ) (const $ Some (consensusQueryInEraInMode era Consensus.GetFuturePParams)) sbe - QueryDRepState _creds -> + QueryDRepState creds -> caseShelleyToBabbageOrConwayEraOnwards (const $ error "toConsensusQueryShelleyBased: QueryDRepState is only available in the Conway era") ( \w -> - Some (consensusQueryInEraInMode era (conwayEraOnwardsConstraints w $ Consensus.GetDRepState _creds)) + Some (consensusQueryInEraInMode era (conwayEraOnwardsConstraints w $ Consensus.GetDRepState creds)) ) sbe QueryDRepStakeDistr dreps -> @@ -664,16 +664,15 @@ toConsensusQueryShelleyBased sbe = \case ) (const $ Some (consensusQueryInEraInMode era (Consensus.GetSPOStakeDistr spos))) sbe - QueryCommitteeMembersState _coldCreds _hotCreds _statuses -> + QueryCommitteeMembersState coldCreds hotCreds statuses -> caseShelleyToBabbageOrConwayEraOnwards ( const $ error "toConsensusQueryShelleyBased: QueryCommitteeMembersState is only available in the Conway era" ) - undefined - -- ( const $ - -- Some - -- (consensusQueryInEraInMode era (Consensus.GetCommitteeMembersState coldCreds hotCreds statuses)) - -- ) + ( const $ + Some + (consensusQueryInEraInMode era (Consensus.GetCommitteeMembersState coldCreds hotCreds statuses)) + ) sbe QueryStakeVoteDelegatees creds -> caseShelleyToBabbageOrConwayEraOnwards @@ -934,9 +933,9 @@ fromConsensusQueryResultShelleyBased sbe sbeQuery q' r' = QueryStakePoolParameters{} -> case q' of Consensus.GetStakePoolParams{} -> - Map.map fromShelleyPoolParams - . Map.mapKeysMonotonic StakePoolKeyHash - $ undefined -- r' + Map.mapKeysMonotonic StakePoolKeyHash + . Map.mapWithKey fromShelleyStakePoolState + $ r' _ -> fromConsensusQueryResultMismatch QueryDebugLedgerState{} -> case q' of diff --git a/cardano-api/src/Cardano/Api/Tx/Internal/Body.hs b/cardano-api/src/Cardano/Api/Tx/Internal/Body.hs index 6dbbba6a86..d673f4aaf8 100644 --- a/cardano-api/src/Cardano/Api/Tx/Internal/Body.hs +++ b/cardano-api/src/Cardano/Api/Tx/Internal/Body.hs @@ -272,6 +272,7 @@ import Cardano.Crypto.Hashing qualified as Byron import Cardano.Ledger.Allegra.Core qualified as L import Cardano.Ledger.Alonzo.Core qualified as L import Cardano.Ledger.Alonzo.Scripts qualified as Alonzo +import Cardano.Ledger.Alonzo.Tx qualified as L -- import Cardano.Ledger.Alonzo.Tx qualified as Alonzo (hashScriptIntegrity) import Cardano.Ledger.Alonzo.TxWits qualified as Alonzo import Cardano.Ledger.Api qualified as L @@ -1981,13 +1982,13 @@ convPParamsToScriptIntegrityHash -> Alonzo.TxDats (ShelleyLedgerEra era) -> Set Plutus.Language -> StrictMaybe L.ScriptIntegrityHash -convPParamsToScriptIntegrityHash w (BuildTxWith mTxProtocolParams) _ _ _ = -- redeemers datums languages = +convPParamsToScriptIntegrityHash w (BuildTxWith mTxProtocolParams) redeemers datums languages = alonzoEraOnwardsConstraints w $ case mTxProtocolParams of Nothing -> SNothing - Just (LedgerProtocolParameters _) -> undefined - -- Just (LedgerProtocolParameters pp) -> - -- Alonzo.hashScriptIntegrity (Set.map (L.getLanguageView pp) languages) redeemers datums + Just (LedgerProtocolParameters pp) -> + let scriptIntegrity = L.ScriptIntegrity redeemers datums (Set.map (L.getLanguageView pp) languages) + in SJust $ L.hashScriptIntegrity scriptIntegrity convLanguages :: [(ScriptWitnessIndex, AnyScriptWitness era)] -> Set Plutus.Language convLanguages witnesses = diff --git a/cardano-api/src/Cardano/Api/Tx/Internal/Body/Lens.hs b/cardano-api/src/Cardano/Api/Tx/Internal/Body/Lens.hs index 8e82a4687c..0f4ab8ae43 100644 --- a/cardano-api/src/Cardano/Api/Tx/Internal/Body/Lens.hs +++ b/cardano-api/src/Cardano/Api/Tx/Internal/Body/Lens.hs @@ -1,8 +1,11 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} {- HLINT ignore "Eta reduce" -} +-- TODO: Deprecate all the lenses that use eons. Explore parameterizing them on `Era era` instead. + module Cardano.Api.Tx.Internal.Body.Lens ( -- * Types LedgerTxBody (..) @@ -163,7 +166,10 @@ collateralInputsTxBodyL w = alonzoEraOnwardsConstraints w $ txBodyL . L.collater reqSignerHashesTxBodyL :: AlonzoEraOnwards era -> Lens' (LedgerTxBody era) (Set (L.KeyHash L.Witness)) -reqSignerHashesTxBodyL w = alonzoEraOnwardsConstraints w $ txBodyL . undefined -- L.reqSignerHashesTxBodyL +reqSignerHashesTxBodyL w@AlonzoEraOnwardsAlonzo = alonzoEraOnwardsConstraints w $ txBodyL . L.reqSignerHashesTxBodyL +reqSignerHashesTxBodyL w@AlonzoEraOnwardsBabbage = alonzoEraOnwardsConstraints w $ txBodyL . L.reqSignerHashesTxBodyL +reqSignerHashesTxBodyL w@AlonzoEraOnwardsConway = alonzoEraOnwardsConstraints w $ txBodyL . L.reqSignerHashesTxBodyL +reqSignerHashesTxBodyL AlonzoEraOnwardsDijkstra = error "reqSignerHashesTxBodyL: DijkstraEra not supported yet" referenceInputsTxBodyL :: BabbageEraOnwards era -> Lens' (LedgerTxBody era) (Set L.TxIn) From 22b76a19e35676d2bd1fa8911ba680fe1f303717 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Tue, 9 Sep 2025 10:01:36 -0400 Subject: [PATCH 42/42] Bump CHaP in nix flake --- flake.lock | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/flake.lock b/flake.lock index bcf93e9336..fdb1abac70 100644 --- a/flake.lock +++ b/flake.lock @@ -3,11 +3,11 @@ "CHaP": { "flake": false, "locked": { - "lastModified": 1753894642, - "narHash": "sha256-7TP8sGtytiHNWdphUZ2j44oy/4tCEqq19BdE7nc1LB8=", + "lastModified": 1757088431, + "narHash": "sha256-yUv1JB7WOjoVWhEfk8cKap1P9QDn4hLd4ZHdkNoqvuY=", "owner": "intersectmbo", "repo": "cardano-haskell-packages", - "rev": "8d401eefedf9b1a8703594b3d33165fdb7ee8f69", + "rev": "8e043cb654d69e62bfb59b80afb2ddda8481f6f7", "type": "github" }, "original": {