From 56252330813ce1f99fcb1164b55d88407090c968 Mon Sep 17 00:00:00 2001 From: Fraser Murray Date: Wed, 25 Jun 2025 01:42:42 +0100 Subject: [PATCH] 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 }