From 573a054ef6a437dd5945334da0d9b1b51a22ae4a Mon Sep 17 00:00:00 2001 From: Georgy Lukyanov Date: Fri, 6 Feb 2026 10:04:48 +0100 Subject: [PATCH 1/5] Bump Hackage and CHaP index states --- cabal.project | 4 ++-- flake.lock | 12 ++++++------ 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/cabal.project b/cabal.project index 234174b5ae..9876ef6ecc 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 2026-02-06T20:27:32Z - , cardano-haskell-packages 2026-02-27T19:25:49Z + , hackage.haskell.org 2026-02-17T10:15:41Z + , cardano-haskell-packages 2026-03-19T11:07:17Z packages: cardano-cli diff --git a/flake.lock b/flake.lock index 92c12dcaaf..907ed1a7d9 100644 --- a/flake.lock +++ b/flake.lock @@ -3,11 +3,11 @@ "CHaP": { "flake": false, "locked": { - "lastModified": 1772448899, - "narHash": "sha256-ziFMOKg2iIkwH5ZHaH2j2nbpHa6AbOUjoMAPQmP4MYc=", + "lastModified": 1773919794, + "narHash": "sha256-uIGg1jpaQUnGsL9ryTh10qCFDYQeowhnH7V+D/xHwmE=", "owner": "intersectmbo", "repo": "cardano-haskell-packages", - "rev": "5ce9a0b9c1c243c384cde6a1051fba12a3378f64", + "rev": "8f90512a19f6921a1229abcdda3f15e815f141ab", "type": "github" }, "original": { @@ -226,11 +226,11 @@ "hackageNix": { "flake": false, "locked": { - "lastModified": 1771507109, - "narHash": "sha256-I0EC+x8xiMTyGJ4oHX78PKZksgFrPWhpnYnUv6KfRXs=", + "lastModified": 1771470642, + "narHash": "sha256-OV0BtXWEyp9kWStVHA1e3yV4XXGsBOyalD5OjYhurTs=", "owner": "input-output-hk", "repo": "hackage.nix", - "rev": "565f1da8ee9e080fc577e91e00dcf5326d76df0b", + "rev": "160d3582e9b8167942e4361c62b951c27c982936", "type": "github" }, "original": { From c32b08e4e5acb0d76f04032c6ad15d57840e4edf Mon Sep 17 00:00:00 2001 From: Georgy Lukyanov Date: Mon, 5 Jan 2026 09:50:07 +0100 Subject: [PATCH 2/5] Use `cardano-crypto-class-2.3.*` and `cardano-crypto-wrapper-1.7.*` --- cardano-cli/cardano-cli.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index 53ac7fa587..e2a1d372ac 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -245,8 +245,8 @@ library cardano-api ^>=10.24, cardano-binary, cardano-crypto, - cardano-crypto-class ^>=2.2.3.2, - cardano-crypto-wrapper ^>=1.6, + cardano-crypto-class ^>=2.3, + cardano-crypto-wrapper ^>=1.7, cardano-data >=1.1, cardano-git-rev ^>=0.2.2, cardano-ledger-api, From 4e0368c6f093f7dab69b386e385c409ee5b93eca Mon Sep 17 00:00:00 2001 From: Georgy Lukyanov Date: Thu, 19 Mar 2026 12:37:38 +0100 Subject: [PATCH 3/5] Use `cardano-api-10.25.*` --- cardano-cli/cardano-cli.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index e2a1d372ac..57a1312567 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -242,7 +242,7 @@ library binary, bytestring, canonical-json, - cardano-api ^>=10.24, + cardano-api ^>=10.25, cardano-binary, cardano-crypto, cardano-crypto-class ^>=2.3, From 7165b1ecf56d3e17b5eab03cf487cefb5180914b Mon Sep 17 00:00:00 2001 From: Georgy Lukyanov Date: Fri, 6 Feb 2026 10:16:19 +0100 Subject: [PATCH 4/5] Integrate Consensus and Network-related changes - Integrate the `GetLedgerPeerSnapshot` query - Add ledger peer type parameter for the ledger peer query - add CLI options for Big and All ledger peers - Integrate changes to the `GetStakeSnapshot` query - Adapt to the new Consensus packages' structure - Adapt to changes of `TxSubmitResult` type --- cardano-cli/cardano-cli.cabal | 5 +- cardano-cli/src/Cardano/CLI/Byron/Tx.hs | 6 +- .../src/Cardano/CLI/EraBased/Query/Command.hs | 6 ++ .../src/Cardano/CLI/EraBased/Query/Option.hs | 9 +++ .../src/Cardano/CLI/EraBased/Query/Run.hs | 74 ++++++++++--------- .../Cardano/CLI/EraBased/Transaction/Run.hs | 7 +- flake.nix | 2 +- 7 files changed, 63 insertions(+), 46 deletions(-) diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index 57a1312567..1766689ed8 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -253,7 +253,7 @@ library cardano-ledger-conway, cardano-ledger-core, cardano-ledger-dijkstra, - cardano-ping ^>=0.9, + cardano-ping ^>=0.10, cardano-prelude, cardano-protocol-tpraos, cardano-slotting ^>=0.2.0.0, @@ -282,8 +282,7 @@ library network-uri, optparse-applicative-fork, ordered-containers, - ouroboros-consensus, - ouroboros-consensus-cardano, + ouroboros-consensus:{cardano, ouroboros-consensus}, prettyprinter, prettyprinter-ansi-terminal, random, diff --git a/cardano-cli/src/Cardano/CLI/Byron/Tx.hs b/cardano-cli/src/Cardano/CLI/Byron/Tx.hs index ec3449fe71..606605b396 100644 --- a/cardano-cli/src/Cardano/CLI/Byron/Tx.hs +++ b/cardano-cli/src/Cardano/CLI/Byron/Tx.hs @@ -26,7 +26,6 @@ import Cardano.Api import Cardano.Api.Byron qualified as Byron import Cardano.Api.Consensus qualified as Byron import Cardano.Api.Ledger qualified as L -import Cardano.Api.Network qualified as Net.Tx import Cardano.Binary qualified as Binary import Cardano.CLI.Byron.Key (byronWitnessToVerKey) @@ -199,11 +198,12 @@ nodeSubmitTx nodeSocketPath network gentx = do } res <- liftIO $ submitTxToNodeLocal connctInfo (TxInByronSpecial gentx) case res of - Net.Tx.SubmitSuccess -> liftIO $ Text.putStrLn "Transaction successfully submitted." - Net.Tx.SubmitFail reason -> + TxSubmitSuccess -> liftIO $ Text.putStrLn "Transaction successfully submitted." + TxSubmitFail reason -> case reason of TxValidationErrorInCardanoMode err -> left . ByronTxSubmitError . Text.pack $ show err TxValidationEraMismatch mismatchErr -> left $ ByronTxSubmitErrorEraMismatch mismatchErr + TxSubmitError err -> left . ByronTxSubmitError . Text.pack $ show err return () diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Query/Command.hs b/cardano-cli/src/Cardano/CLI/EraBased/Query/Command.hs index 0c6a32f67d..0d99998e98 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Query/Command.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Query/Command.hs @@ -33,6 +33,7 @@ module Cardano.CLI.EraBased.Query.Command , QueryEraHistoryCmdArgs (..) , renderQueryCmds , IncludeStake (..) + , CliLedgerPeers (..) ) where @@ -149,8 +150,13 @@ data QueryLedgerStateCmdArgs = QueryLedgerStateCmdArgs } deriving (Generic, Show) +-- | Term-level equivalent of Ouroboros.Network.PeerSelection.LedgerPeers.Type.LedgerPeersKind +data CliLedgerPeers = CliAllLedgerPeers | CliBigLedgerPeers + deriving (Generic, Show) + data QueryLedgerPeerSnapshotCmdArgs = QueryLedgerPeerSnapshotCmdArgs { commons :: !QueryCommons + , ledgerPeerKind :: !CliLedgerPeers , outputFormat :: !(Vary [FormatJson, FormatYaml]) , mOutFile :: !(Maybe (File () Out)) } diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Query/Option.hs b/cardano-cli/src/Cardano/CLI/EraBased/Query/Option.hs index b23327c90d..510c38d524 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Query/Option.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Query/Option.hs @@ -447,12 +447,21 @@ pQueryLedgerPeerSnapshotCmd envCli = fmap QueryLedgerPeerSnapshotCmd $ QueryLedgerPeerSnapshotCmdArgs <$> pQueryCommons @era envCli + <*> pLedgerPeersKind <*> pFormatQueryOutputFlags "ledger-peer-snapshot" [ flagFormatJson & setDefault , flagFormatYaml ] <*> pMaybeOutputFile + where + pLedgerPeersKind :: Parser CliLedgerPeers + pLedgerPeersKind = + Opt.flag CliBigLedgerPeers CliAllLedgerPeers $ + mconcat + [ Opt.long "all-ledger-peers" + , Opt.help "Query all ledger peers instead of big ones" + ] pQueryProtocolStateCmd :: forall era. IsEra era => EnvCli -> Parser (QueryCmds era) pQueryProtocolStateCmd envCli = diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Query/Run.hs b/cardano-cli/src/Cardano/CLI/EraBased/Query/Run.hs index 676e68fd7b..d1795d0116 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Query/Run.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Query/Run.hs @@ -66,6 +66,7 @@ import Cardano.CLI.Type.Key import Cardano.CLI.Type.Output (QueryDRepStateOutput (..)) import Cardano.CLI.Type.Output qualified as O import Cardano.Crypto.Hash (hashToBytesAsHex) +import Cardano.Ledger.Address qualified as L import Cardano.Ledger.Api.State.Query qualified as L import Cardano.Ledger.Conway.State (ChainAccountState (..)) import Cardano.Slotting.EpochInfo (EpochInfo (..), epochInfoSlotToUTCTime, hoistEpochInfo) @@ -358,7 +359,7 @@ runQueryKesPeriodInfoCmd ( executeLocalStateQueryExpr nodeConnInfo target $ runExceptT $ do AnyCardanoEra cEra <- easyRunQueryCurrentEra - era <- hoist liftIO $ supportedEra cEra + era <- supportedEra cEra let sbe = convert era -- We check that the KES period specified in the operational certificate is correct -- based on the KES period defined in the genesis parameters and the current slot number @@ -652,7 +653,7 @@ runQueryPoolStateCmd ( executeLocalStateQueryExpr nodeConnInfo target $ runExceptT $ do AnyCardanoEra cEra <- easyRunQueryCurrentEra - era <- hoist liftIO $ supportedEra cEra + era <- supportedEra cEra let beo = convert era poolFilter = case allOrOnlyPoolIds of @@ -732,7 +733,7 @@ runQueryRefScriptSizeCmd r <- fromEitherIOCli $ executeLocalStateQueryExpr nodeConnInfo target $ runExceptT $ do AnyCardanoEra cEra <- easyRunQueryCurrentEra - era <- hoist liftIO $ supportedEra cEra + era <- supportedEra cEra let beo = convert era sbe = convert era @@ -779,7 +780,7 @@ runQueryStakeSnapshotCmd ( executeLocalStateQueryExpr nodeConnInfo target $ runExceptT $ do AnyCardanoEra cEra <- easyRunQueryCurrentEra - era <- hoist liftIO $ supportedEra cEra + era <- supportedEra cEra let poolFilter = case allOrOnlyPoolIds of All -> Nothing @@ -789,7 +790,7 @@ runQueryStakeSnapshotCmd result <- easyRunQuery (queryStakeSnapshot beo poolFilter) - hoist liftIO $ obtainCommonConstraints era (writeStakeSnapshots outputFormat mOutFile) result + hoist liftIO $ obtainCommonConstraints era (writeStakeSnapshots era outputFormat mOutFile) result ) & fromEitherCIOCli @@ -813,7 +814,7 @@ runQueryLedgerStateCmd ( executeLocalStateQueryExpr nodeConnInfo target $ runExceptT $ do AnyCardanoEra cEra <- easyRunQueryCurrentEra - era <- hoist liftIO $ supportedEra cEra + era <- supportedEra cEra let sbe = convert era serialisedDebugLedgerState <- easyRunQuery (queryDebugLedgerState sbe) @@ -877,35 +878,35 @@ runQueryLedgerPeerSnapshot { Cmd.nodeConnInfo , Cmd.target } + , Cmd.ledgerPeerKind , Cmd.outputFormat , Cmd.mOutFile } = do - result <- - fromEitherIOCli + decodedResult <- + (fromEitherIOCli . fromEitherIOCli) ( executeLocalStateQueryExprWithVersion nodeConnInfo target $ \globalNtcVersion -> runExceptT $ do AnyCardanoEra cEra <- lift queryCurrentEra & onLeft (left . QueryCmdUnsupportedNtcVersion) - era <- hoist liftIO $ supportedEra cEra - let sbe = convert era - - result <- easyRunQuery (queryLedgerPeerSnapshot sbe) + era <- supportedEra cEra + ntcVersion <- hoistEither (getShelleyNodeToClientVersion era globalNtcVersion) - shelleyNtcVersion <- hoistEither $ getShelleyNodeToClientVersion era globalNtcVersion - - hoist liftIO $ - obtainCommonConstraints era $ - case decodeBigLedgerPeerSnapshot shelleyNtcVersion result of - Left (bs, _decoderError) -> pure $ Left bs - Right snapshot -> pure $ Right snapshot + case ledgerPeerKind of + Cmd.CliBigLedgerPeers -> do + result <- easyRunQuery (queryLedgerPeerSnapshot (convert era) SingBigLedgerPeers) + pure $ SomeLedgerPeerSnapshot <$> decodeLedgerPeerSnapshot SingBigLedgerPeers ntcVersion result + Cmd.CliAllLedgerPeers -> do + result <- easyRunQuery (queryLedgerPeerSnapshot (convert era) SingAllLedgerPeers) + pure $ SomeLedgerPeerSnapshot <$> decodeLedgerPeerSnapshot SingAllLedgerPeers ntcVersion result ) - & fromEitherCIOCli - case result of - Left (bs :: LBS.ByteString) -> do + case decodedResult of + Left (bs, decoderError) -> do + -- unable to decode, just dump cbor with a warning + liftIO . IO.hPrint IO.stderr $ decoderError fromExceptTCli $ pPrintCBOR bs - Right (snapshot :: LedgerPeerSnapshot) -> do + Right (SomeLedgerPeerSnapshot snapshot) -> do let output = outputFormat & ( id @@ -914,7 +915,6 @@ runQueryLedgerPeerSnapshot $ Vary.exhaustiveCase ) $ snapshot - fromEitherIOCli @(FileError ()) $ writeLazyByteStringOutput mOutFile output @@ -1024,7 +1024,7 @@ getQueryStakeAddressInfo lift $ executeLocalStateQueryExpr nodeConnInfo target $ runExceptT $ do AnyCardanoEra cEra <- easyRunQueryCurrentEra - era <- hoist liftIO $ supportedEra cEra + era <- supportedEra cEra let stakeAddr = Set.singleton $ fromShelleyStakeCredential addr sbe = convert era @@ -1051,7 +1051,7 @@ getQueryStakeAddressInfo | gas <- toList govActionStates , let proc = L.gasProposalProcedure gas , let rewardAccount = L.pProcReturnAddr proc - stakeCredential :: Api.StakeCredential = fromShelleyStakeCredential $ L.raCredential rewardAccount + stakeCredential :: Api.StakeCredential = fromShelleyStakeCredential (rewardAccount ^. L.accountAddressCredentialL) , stakeCredential == fromShelleyStakeCredential addr ] @@ -1162,13 +1162,14 @@ writeStakeAddressInfo writeStakeSnapshots :: forall era - . Vary [FormatJson, FormatYaml] + . Exp.Era era + -> Vary [FormatJson, FormatYaml] -> Maybe (File () Out) -> SerialisedStakeSnapshots era -> ExceptT QueryCmdError IO () -writeStakeSnapshots outputFormat mOutFile qState = do +writeStakeSnapshots era outputFormat mOutFile qState = do StakeSnapshot snapshot <- - pure (decodeStakeSnapshot qState) + pure (decodeStakeSnapshot (convert era) qState) & onLeft (left . QueryCmdStakeSnapshotDecodeError) let output = @@ -1287,7 +1288,7 @@ runQueryStakePoolsCmd ( executeLocalStateQueryExpr nodeConnInfo target $ runExceptT @QueryCmdError $ do AnyCardanoEra cEra <- easyRunQueryCurrentEra - era <- hoist liftIO $ supportedEra cEra + era <- supportedEra cEra let sbe = convert era poolIds <- easyRunQuery (queryStakePools sbe) @@ -1359,7 +1360,7 @@ runQueryStakeDistributionCmd ( executeLocalStateQueryExpr nodeConnInfo target $ runExceptT $ do AnyCardanoEra cEra <- easyRunQueryCurrentEra - era <- hoist liftIO $ supportedEra cEra + era <- supportedEra cEra let sbe = convert era result <- easyRunQuery (queryStakeDistribution sbe) @@ -1437,7 +1438,7 @@ runQueryLeadershipScheduleCmd ( executeLocalStateQueryExpr nodeConnInfo target $ runExceptT $ do AnyCardanoEra cEra <- easyRunQueryCurrentEra - era <- hoist liftIO $ supportedEra cEra + era <- supportedEra cEra let sbe = convert era pparams <- easyRunQuery (queryProtocolParameters sbe) @@ -2102,7 +2103,10 @@ easyRunQuery q = & onLeft (left . QueryCmdUnsupportedNtcVersion) & onLeft (left . QueryCmdEraMismatch) -supportedEra :: Typeable era => CardanoEra era -> ExceptT QueryCmdError IO (Exp.Era era) +supportedEra + :: Typeable era + => MonadError QueryCmdError m + => CardanoEra era + -> m (Exp.Era era) supportedEra cEra = - pure (forEraMaybeEon cEra) - & onNothing (left $ QueryCmdEraNotSupported (AnyCardanoEra cEra)) + maybe (throwError $ QueryCmdEraNotSupported (AnyCardanoEra cEra)) pure $ forEraMaybeEon cEra diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Transaction/Run.hs b/cardano-cli/src/Cardano/CLI/EraBased/Transaction/Run.hs index d5f4375b35..27d61cfec4 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Transaction/Run.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Transaction/Run.hs @@ -39,12 +39,10 @@ import Cardano.Api qualified as Api import Cardano.Api.Byron qualified as Byron import Cardano.Api.Experimental (obtainCommonConstraints) import Cardano.Api.Experimental qualified as Exp -import Cardano.Api.Experimental.AnyScript qualified as Exp import Cardano.Api.Experimental.AnyScriptWitness qualified as Exp import Cardano.Api.Experimental.Tx qualified as Exp import Cardano.Api.Ledger qualified as L import Cardano.Api.Network qualified as Consensus -import Cardano.Api.Network qualified as Net.Tx import Cardano.Binary qualified as CBOR import Cardano.CLI.Compatible.Exception @@ -1335,13 +1333,14 @@ runTransactionSubmitCmd let txInMode = TxInMode era tx res <- liftIO $ submitTxToNodeLocal nodeConnInfo txInMode case res of - Net.Tx.SubmitSuccess -> do + TxSubmitSuccess -> do liftIO $ Text.hPutStrLn IO.stderr "Transaction successfully submitted. Transaction hash is:" liftIO $ LBS.putStrLn $ Aeson.encode $ TxSubmissionResult $ getTxId $ getTxBody tx - Net.Tx.SubmitFail reason -> + TxSubmitFail reason -> case reason of TxValidationErrorInCardanoMode err -> left . TxCmdTxSubmitError . Text.pack $ show err TxValidationEraMismatch mismatchErr -> left $ TxCmdTxSubmitErrorEraMismatch mismatchErr + TxSubmitError err -> left . TxCmdTxSubmitError . Text.pack $ show err -- ---------------------------------------------------------------------------- -- Transaction fee calculation diff --git a/flake.nix b/flake.nix index 5cd1d5986d..eddfd9000d 100644 --- a/flake.nix +++ b/flake.nix @@ -164,7 +164,7 @@ "https://chap.intersectmbo.org/" = inputs.CHaP; }; shell = { - packages = p: [p.cardano-cli p.cardano-ledger-core p.cardano-api p.ouroboros-consensus-cardano]; + packages = p: [p.cardano-cli p.cardano-ledger-core p.cardano-api p.ouroboros-consensus]; # tools we want in our shell, from hackage tools = { From 88c601cc05d33615bb355d13d372cc94f3bbc911 Mon Sep 17 00:00:00 2001 From: Georgy Lukyanov Date: Fri, 6 Feb 2026 12:59:29 +0100 Subject: [PATCH 5/5] Integrate Ledger-related changes - Fix simple script decoding fallback for Conway - Introduce transaction levels. - Replace promoted constructors with types. - Introduce CoinPerByte. - Use StrictMaybe where necessary. - `PoolParams` -> `StakePoolParams` --- cardano-cli/cardano-cli.cabal | 2 - .../Cardano/CLI/Compatible/Json/Friendly.hs | 10 ++--- .../Cardano/CLI/Compatible/Transaction/Run.hs | 6 +-- .../Compatible/Transaction/ScriptWitness.hs | 6 +-- .../src/Cardano/CLI/EraBased/Common/Option.hs | 23 ++++++---- .../EraBased/Genesis/CreateTestnetData/Run.hs | 36 ++++++++-------- .../src/Cardano/CLI/EraBased/Genesis/Run.hs | 42 +++++++++---------- .../CLI/EraBased/Governance/Actions/Option.hs | 2 +- .../src/Cardano/CLI/EraBased/Query/Run.hs | 4 +- .../CLI/EraBased/Script/Certificate/Read.hs | 6 +-- .../Cardano/CLI/EraBased/Script/Mint/Read.hs | 6 +-- .../CLI/EraBased/Script/Proposal/Read.hs | 6 +-- .../CLI/EraBased/Script/Read/Common.hs | 14 ++++--- .../Cardano/CLI/EraBased/Script/Spend/Read.hs | 6 +-- .../Cardano/CLI/EraBased/Script/Vote/Read.hs | 6 +-- .../CLI/EraBased/Script/Withdrawal/Read.hs | 6 +-- .../Cardano/CLI/EraBased/Transaction/Run.hs | 8 ++-- cardano-cli/src/Cardano/CLI/Read.hs | 29 ++++++------- cardano-cli/src/Cardano/CLI/Type/Common.hs | 5 ++- .../Test/Golden/CreateTestnetData.hs | 2 +- .../Test/Golden/Legacy/Genesis/Create.hs | 22 ++++------ .../cardano-cli-golden/files/golden/help.cli | 3 ++ .../conway_query_ledger-peer-snapshot.cli | 2 + .../latest_query_ledger-peer-snapshot.cli | 2 + .../help/query_ledger-peer-snapshot.cli | 2 + 25 files changed, 135 insertions(+), 121 deletions(-) diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index 1766689ed8..5ce6caf0f9 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -442,10 +442,8 @@ test-suite cardano-cli-golden cardano-cli, cardano-cli:cardano-cli-test-lib, cardano-crypto-wrapper, - cardano-ledger-core, cardano-strict-containers ^>=0.1, cborg, - containers, directory, exceptions, extra, diff --git a/cardano-cli/src/Cardano/CLI/Compatible/Json/Friendly.hs b/cardano-cli/src/Cardano/CLI/Compatible/Json/Friendly.hs index f0be7ae646..faef8f3a74 100644 --- a/cardano-cli/src/Cardano/CLI/Compatible/Json/Friendly.hs +++ b/cardano-cli/src/Cardano/CLI/Compatible/Json/Friendly.hs @@ -284,7 +284,7 @@ getScriptWitnessDetails era tb = where aeo = convert era friendlyRedeemers - :: Ledger.Tx (ShelleyLedgerEra era) + :: Ledger.Tx C.TopTx (ShelleyLedgerEra era) -> Aeson.Value friendlyRedeemers tx = alonzoEraOnwardsConstraints aeo $ do @@ -293,7 +293,7 @@ getScriptWitnessDetails era tb = Aeson.Array $ Vector.fromList redeemerList friendlyRedeemerInfo - :: Ledger.Tx (ShelleyLedgerEra era) + :: Ledger.Tx C.TopTx (ShelleyLedgerEra era) -> Ledger.PlutusPurpose Ledger.AsIx (ShelleyLedgerEra era) -> (Ledger.Data (ShelleyLedgerEra era), ExUnits) -> Aeson.Value @@ -373,7 +373,7 @@ getScriptWitnessDetails era tb = addLabelToPurpose Proposing pp = Aeson.object ["submitting a proposal following proposal policy" .= pp] addLabelToPurpose Guarding _ = error "TODO Dijkstra" - friendlyScriptData :: Ledger.Tx (ShelleyLedgerEra era) -> Aeson.Value + friendlyScriptData :: Ledger.Tx C.TopTx (ShelleyLedgerEra era) -> Aeson.Value friendlyScriptData tx = alonzoEraOnwardsConstraints aeo $ do Aeson.Array $ @@ -386,7 +386,7 @@ getScriptWitnessDetails era tb = | (scriptHash, scriptData) <- Map.toList $ tx ^. Ledger.witsTxL . Ledger.scriptTxWitsL ] - friendlyDats :: Ledger.Tx (ShelleyLedgerEra era) -> Aeson.Value + friendlyDats :: Ledger.Tx C.TopTx (ShelleyLedgerEra era) -> Aeson.Value friendlyDats tx = alonzoEraOnwardsConstraints aeo $ let Ledger.TxDats dats = tx ^. Ledger.witsTxL . Ledger.datsTxWitsL @@ -633,7 +633,7 @@ renderCertificate sbe (Exp.Certificate c) = renderDrepCredential :: () - => L.Credential 'L.DRepRole + => L.Credential L.DRepRole -> Aeson.Value renderDrepCredential = object . \case diff --git a/cardano-cli/src/Cardano/CLI/Compatible/Transaction/Run.hs b/cardano-cli/src/Cardano/CLI/Compatible/Transaction/Run.hs index 57c2d5e6f1..ed7670e4d4 100644 --- a/cardano-cli/src/Cardano/CLI/Compatible/Transaction/Run.hs +++ b/cardano-cli/src/Cardano/CLI/Compatible/Transaction/Run.hs @@ -18,7 +18,7 @@ import Cardano.Api.Compatible.Certificate qualified as Compatible import Cardano.Api.Experimental (obtainCommonConstraints) import Cardano.Api.Experimental qualified as Exp import Cardano.Api.Experimental.AnyScriptWitness qualified as Exp -import Cardano.Api.Experimental.Plutus qualified as Exp +import Cardano.Api.Experimental.Plutus qualified as Exp.Plutus import Cardano.Api.Experimental.Tx qualified as Exp import Cardano.Api.Ledger qualified as L hiding ( VotingProcedures @@ -158,9 +158,9 @@ readCertificateScriptWitnessSbe (OnDiskPlutusScriptCliArgs scriptFp Exp.NoScriptDatumAllowed redeemerFile execUnits) ) = do let plutusScriptFp = unFile scriptFp - Exp.AnyPlutusScript anyPlutusScript <- Compatible.readFilePlutusScript sbe plutusScriptFp + Exp.Plutus.AnyPlutusScript anyPlutusScript <- Compatible.readFilePlutusScript sbe plutusScriptFp let - lang = Exp.plutusScriptInEraSLanguage anyPlutusScript + lang = Exp.Plutus.plutusScriptInEraSLanguage anyPlutusScript let script' = Exp.PScript anyPlutusScript redeemer <- diff --git a/cardano-cli/src/Cardano/CLI/Compatible/Transaction/ScriptWitness.hs b/cardano-cli/src/Cardano/CLI/Compatible/Transaction/ScriptWitness.hs index b3921188ec..a207588ebc 100644 --- a/cardano-cli/src/Cardano/CLI/Compatible/Transaction/ScriptWitness.hs +++ b/cardano-cli/src/Cardano/CLI/Compatible/Transaction/ScriptWitness.hs @@ -21,7 +21,7 @@ import Cardano.Api ) import Cardano.Api.Experimental qualified as Exp import Cardano.Api.Experimental.AnyScriptWitness qualified as Exp -import Cardano.Api.Experimental.Plutus qualified as Exp +import Cardano.Api.Experimental.Plutus qualified as Exp.Plutus import Cardano.CLI.Compatible.Exception import Cardano.CLI.Compatible.Read (readFilePlutusScript, readFileSimpleScript) @@ -68,8 +68,8 @@ readCertificateScriptWitness sbe certScriptReq = OnDiskPlutusScript (OnDiskPlutusScriptCliArgs scriptFp Exp.NoScriptDatumAllowed redeemerFile execUnits) -> do let plutusScriptFp = unFile scriptFp - Exp.AnyPlutusScript anyPlutusScript <- readFilePlutusScript sbe plutusScriptFp - let lang = Exp.plutusScriptInEraSLanguage anyPlutusScript + Exp.Plutus.AnyPlutusScript anyPlutusScript <- readFilePlutusScript sbe plutusScriptFp + let lang = Exp.Plutus.plutusScriptInEraSLanguage anyPlutusScript script' = Exp.PScript anyPlutusScript redeemer <- fromExceptTCli $ diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Common/Option.hs b/cardano-cli/src/Cardano/CLI/EraBased/Common/Option.hs index 8941a0be70..39694442c3 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Common/Option.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Common/Option.hs @@ -374,6 +374,13 @@ parseLovelace = do then fail $ show i <> " lovelace exceeds the Word64 upper bound" else return $ L.Coin i +parseCoinPerByte :: P.Parser L.CoinPerByte +parseCoinPerByte = do + i <- P.parseDecimal + case L.toCompact (Coin i) of + Nothing -> fail $ show i <> " lovelace exceeds the Word64 upper bound" + Just c -> pure . L.CoinPerByte $ c + -- | The first argument is the optional prefix. pStakePoolVerificationKeyOrFile :: Maybe String @@ -2712,9 +2719,9 @@ pCostModels = , Opt.completer (Opt.bashCompleter "file") ] -pMinFeePerByteFactor :: Parser Lovelace +pMinFeePerByteFactor :: Parser L.CoinPerByte pMinFeePerByteFactor = - Opt.option (readerFromParsecParser parseLovelace) $ + Opt.option (readerFromParsecParser parseCoinPerByte) $ mconcat [ Opt.long "min-fee-linear" , Opt.metavar "LOVELACE" @@ -2935,9 +2942,9 @@ pExtraEntropy = . BSC.pack =<< some P.hexDigit -pUTxOCostPerByte :: Parser Lovelace +pUTxOCostPerByte :: Parser L.CoinPerByte pUTxOCostPerByte = - Opt.option (readerFromParsecParser parseLovelace) $ + Opt.option (readerFromParsecParser parseCoinPerByte) $ mconcat [ Opt.long "utxo-cost-per-byte" , Opt.metavar "LOVELACE" @@ -3004,7 +3011,7 @@ pMaxBlockExecutionUnits = ] ) -pMaxValueSize :: Parser Natural +pMaxValueSize :: Parser Word32 pMaxValueSize = Opt.option integralReader $ mconcat @@ -3016,7 +3023,7 @@ pMaxValueSize = ] ] -pCollateralPercent :: Parser Natural +pCollateralPercent :: Parser Word16 pCollateralPercent = Opt.option integralReader $ mconcat @@ -3030,7 +3037,7 @@ pCollateralPercent = ] ] -pMaxCollateralInputs :: Parser Natural +pMaxCollateralInputs :: Parser Word16 pMaxCollateralInputs = Opt.option integralReader $ mconcat @@ -3208,7 +3215,7 @@ pDRepVotingThresholds = , Opt.help "Acceptance threshold for DRep votes on treasury withdrawals." ] -pMinCommitteeSize :: Parser Natural +pMinCommitteeSize :: Parser Word16 pMinCommitteeSize = Opt.option integralReader $ mconcat diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Genesis/CreateTestnetData/Run.hs b/cardano-cli/src/Cardano/CLI/EraBased/Genesis/CreateTestnetData/Run.hs index 0e24d5c429..d7e1625d33 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Genesis/CreateTestnetData/Run.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Genesis/CreateTestnetData/Run.hs @@ -382,8 +382,8 @@ runGenesisCreateTestNetDataCmd addDRepsToConwayGenesis dRepKeys (map snd delegatorKeys) conwayGenesis <&> addCommitteeToConwayGenesis ccColdKeys - let stake = second L.ppId . mkDelegationMapEntry <$> delegations - stakePools = [(L.ppId poolParams', poolParams') | poolParams' <- snd . mkDelegationMapEntry <$> delegations] + let stake = second L.sppId . mkDelegationMapEntry <$> delegations + stakePools = [(L.sppId poolParams', poolParams') | poolParams' <- snd . mkDelegationMapEntry <$> delegations] delegAddrs = dInitialUtxoAddr <$> delegations !shelleyGenesis' <- fromExceptTCli $ @@ -447,7 +447,7 @@ runGenesisCreateTestNetDataCmd mkPoolDir idx = poolsDir ("pool" <> show idx) mkDelegationMapEntry - :: Delegation -> (L.KeyHash L.Staking, L.PoolParams) + :: Delegation -> (L.KeyHash L.Staking, L.StakePoolParams) mkDelegationMapEntry d = (dDelegStaking d, dPoolParams d) addCommitteeToConwayGenesis @@ -751,7 +751,7 @@ createPoolCredentials fmt dir = do data Delegation = Delegation { dInitialUtxoAddr :: !(AddressInEra ShelleyEra) , dDelegStaking :: !(L.KeyHash L.Staking) - , dPoolParams :: !L.PoolParams + , dPoolParams :: !L.StakePoolParams } deriving (Generic, NFData) @@ -763,7 +763,7 @@ buildPoolParams -- ^ The index of the pool being built. Starts at 0. -> Map Word [L.StakePoolRelay] -- ^ User submitted stake pool relay map. Starts at 0 - -> ExceptT GenesisCmdError IO L.PoolParams + -> ExceptT GenesisCmdError IO L.StakePoolParams buildPoolParams nw dir index specifiedRelays = do StakePoolVerificationKey poolColdVK <- firstExceptT (GenesisCmdStakePoolCmdError . StakePoolCmdReadFileError) @@ -780,17 +780,17 @@ buildPoolParams nw dir index specifiedRelays = do $ readFileTextEnvelope poolRewardVKF pure - L.PoolParams - { L.ppId = L.hashKey poolColdVK - , L.ppVrf = C.hashVerKeyVRF @StandardCrypto poolVrfVK - , L.ppPledge = L.Coin 0 - , L.ppCost = L.Coin 0 - , L.ppMargin = minBound - , L.ppRewardAccount = + L.StakePoolParams + { L.sppId = L.hashKey poolColdVK + , L.sppVrf = C.hashVerKeyVRF @StandardCrypto poolVrfVK + , L.sppPledge = L.Coin 0 + , L.sppCost = L.Coin 0 + , L.sppMargin = minBound + , L.sppAccountAddress = toShelleyStakeAddr $ makeStakeAddress nw $ StakeCredentialByKey (verificationKeyHash rewardsSVK) - , L.ppOwners = mempty - , L.ppRelays = lookupPoolRelay specifiedRelays - , L.ppMetadata = L.SNothing + , L.sppOwners = mempty + , L.sppRelays = lookupPoolRelay specifiedRelays + , L.sppMetadata = L.SNothing } where lookupPoolRelay :: Map Word [L.StakePoolRelay] -> Seq.StrictSeq L.StakePoolRelay @@ -812,7 +812,7 @@ computeInsecureStakeKeyAddr g0 = do computeDelegation :: NetworkId -> (VerificationKey PaymentKey, VerificationKey StakeKey) - -> L.PoolParams + -> L.StakePoolParams -> Delegation computeDelegation nw (paymentVK, stakeVK) dPoolParams = do let paymentCredential = PaymentCredentialByKey (verificationKeyHash paymentVK) @@ -835,9 +835,9 @@ updateOutputTemplate -- ^ Total amount of lovelace -> [AddressInEra ShelleyEra] -- ^ UTxO addresses that are not delegating - -> [(L.KeyHash 'L.StakePool, L.PoolParams)] + -> [(L.KeyHash L.StakePool, L.StakePoolParams)] -- ^ Pool map - -> [(L.KeyHash 'L.Staking, L.KeyHash 'L.StakePool)] + -> [(L.KeyHash L.Staking, L.KeyHash L.StakePool)] -- ^ Delegaton map -> Maybe Lovelace -- ^ Amount of lovelace to delegate diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Genesis/Run.hs b/cardano-cli/src/Cardano/CLI/EraBased/Genesis/Run.hs index d633a32ff5..9eac0d4d6f 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Genesis/Run.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Genesis/Run.hs @@ -681,8 +681,8 @@ runGenesisCreateStakedCmd stuffedUtxoAddrs <- liftIO $ Lazy.replicateM (fromIntegral numStuffedUtxo) $ genStuffedAddress network - let stake = second L.ppId . mkDelegationMapEntry <$> delegations - stakePools = [(L.ppId poolParams', poolParams') | poolParams' <- snd . mkDelegationMapEntry <$> delegations] + let stake = second L.sppId . mkDelegationMapEntry <$> delegations + stakePools = [(L.sppId poolParams', poolParams') | poolParams' <- snd . mkDelegationMapEntry <$> delegations] delegAddrs = dInitialUtxoAddr <$> delegations !shelleyGenesis = updateOutputTemplate @@ -740,7 +740,7 @@ runGenesisCreateStakedCmd where adjustTemplate t = t{sgNetworkMagic = unNetworkMagic (toNetworkMagic networkId)} mkDelegationMapEntry - :: Delegation -> (L.KeyHash L.Staking, L.PoolParams) + :: Delegation -> (L.KeyHash L.Staking, L.StakePoolParams) mkDelegationMapEntry d = (dDelegStaking d, dPoolParams d) -- ------------------------------------------------------------------------------------------------- @@ -756,9 +756,9 @@ updateOutputTemplate -- ^ Number of UTxO addresses that are delegating -> [AddressInEra ShelleyEra] -- ^ UTxO addresses that are not delegating - -> [(L.KeyHash 'L.StakePool, L.PoolParams)] + -> [(L.KeyHash L.StakePool, L.StakePoolParams)] -- ^ Pool map - -> [(L.KeyHash 'L.Staking, L.KeyHash 'L.StakePool)] + -> [(L.KeyHash L.Staking, L.KeyHash L.StakePool)] -- ^ Delegaton map -> Maybe Lovelace -- ^ Amount of lovelace to delegate @@ -939,7 +939,7 @@ createPoolCredentials fmt dir index = do data Delegation = Delegation { dInitialUtxoAddr :: !(AddressInEra ShelleyEra) , dDelegStaking :: !(L.KeyHash L.Staking) - , dPoolParams :: !L.PoolParams + , dPoolParams :: !L.StakePoolParams } deriving (Generic, NFData) @@ -950,7 +950,7 @@ buildPoolParams -> Maybe Word -> Map Word [L.StakePoolRelay] -- ^ User submitted stake pool relay map - -> ExceptT GenesisCmdError IO L.PoolParams + -> ExceptT GenesisCmdError IO L.StakePoolParams buildPoolParams nw dir index specifiedRelays = do StakePoolVerificationKey poolColdVK <- firstExceptT (GenesisCmdStakePoolCmdError . StakePoolCmdReadFileError) @@ -967,17 +967,17 @@ buildPoolParams nw dir index specifiedRelays = do $ readFileTextEnvelope @(VerificationKey StakeKey) poolRewardVKF pure - L.PoolParams - { L.ppId = L.hashKey poolColdVK - , L.ppVrf = C.hashVerKeyVRF @C.StandardCrypto poolVrfVK - , L.ppPledge = L.Coin 0 - , L.ppCost = L.Coin 0 - , L.ppMargin = minBound - , L.ppRewardAccount = + L.StakePoolParams + { L.sppId = L.hashKey poolColdVK + , L.sppVrf = C.hashVerKeyVRF @C.StandardCrypto poolVrfVK + , L.sppPledge = L.Coin 0 + , L.sppCost = L.Coin 0 + , L.sppMargin = minBound + , L.sppAccountAddress = toShelleyStakeAddr $ makeStakeAddress nw $ StakeCredentialByKey (verificationKeyHash rewardsSVK) - , L.ppOwners = mempty - , L.ppRelays = lookupPoolRelay specifiedRelays - , L.ppMetadata = L.SNothing + , L.sppOwners = mempty + , L.sppRelays = lookupPoolRelay specifiedRelays + , L.sppMetadata = L.SNothing } where lookupPoolRelay @@ -1030,7 +1030,7 @@ writeBulkPoolCredentials dir bulkIx poolIxs = do computeInsecureDelegation :: StdGen -> NetworkId - -> L.PoolParams + -> L.StakePoolParams -> IO (StdGen, Delegation) computeInsecureDelegation g0 nw pool = do (paymentVK, g1) <- first getVerificationKey <$> generateInsecureSigningKey g0 AsPaymentKey @@ -1080,7 +1080,7 @@ updateTemplate -- ^ Amount of lovelace not delegated -> [AddressInEra ShelleyEra] -- ^ UTxO addresses that are not delegating - -> Map (L.KeyHash 'L.Staking) L.PoolParams + -> Map (L.KeyHash L.Staking) L.StakePoolParams -- ^ Genesis staking: pools/delegation map & delegated initial UTxO spec -> Lovelace -- ^ Number of UTxO Addresses for delegation @@ -1120,10 +1120,10 @@ updateTemplate ShelleyGenesisStaking { sgsPools = fromList - [ (L.ppId poolParams, poolParams) + [ (L.sppId poolParams, poolParams) | poolParams <- Map.elems poolSpecs ] - , sgsStake = ListMap.fromMap $ L.ppId <$> poolSpecs + , sgsStake = ListMap.fromMap $ L.sppId <$> poolSpecs } , sgProtocolParams = pparamsFromTemplate } diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Governance/Actions/Option.hs b/cardano-cli/src/Cardano/CLI/EraBased/Governance/Actions/Option.hs index 74d087c85f..2b70dfe8e8 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Governance/Actions/Option.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Governance/Actions/Option.hs @@ -287,7 +287,7 @@ pAlonzoOnwardsPParams = pIntroducedInBabbagePParams :: Parser (IntroducedInBabbagePParams ledgerera) pIntroducedInBabbagePParams = IntroducedInBabbagePParams - <$> convertToLedger L.CoinPerByte (optional pUTxOCostPerByte) + <$> convertToLedger id (optional pUTxOCostPerByte) pIntroducedInConwayPParams :: Parser (IntroducedInConwayPParams ledgerera) pIntroducedInConwayPParams = diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Query/Run.hs b/cardano-cli/src/Cardano/CLI/EraBased/Query/Run.hs index d1795d0116..3b6c677f53 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Query/Run.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Query/Run.hs @@ -1818,10 +1818,10 @@ runQuerySPOStakeDistribution PoolState poolStateResult <- fromEitherCli $ decodePoolState (convert eon) serialisedPoolState - let spoToRewardCred :: Map (L.KeyHash L.StakePool) (L.Credential 'L.Staking) + let spoToRewardCred :: Map (L.KeyHash L.StakePool) (L.Credential L.Staking) spoToRewardCred = Map.map - (L.raCredential . L.ppRewardAccount) + (\params -> L.sppAccountAddress params ^. L.accountAddressCredentialL) (L.qpsrStakePoolParams poolStateResult) allRewardCreds :: Set StakeCredential diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Script/Certificate/Read.hs b/cardano-cli/src/Cardano/CLI/EraBased/Script/Certificate/Read.hs index 91bec4c800..1455a1aa23 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Script/Certificate/Read.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Script/Certificate/Read.hs @@ -15,7 +15,7 @@ import Cardano.Api (File (..)) import Cardano.Api.Experimental import Cardano.Api.Experimental qualified as Exp import Cardano.Api.Experimental.AnyScriptWitness -import Cardano.Api.Experimental.Plutus qualified as Exp +import Cardano.Api.Experimental.Plutus qualified as Exp.Plutus import Cardano.CLI.Compatible.Exception import Cardano.CLI.EraBased.Script.Read.Common @@ -37,11 +37,11 @@ readCertificateScriptWitness (OnDiskPlutusScriptCliArgs scriptFp Exp.NoScriptDatumAllowed redeemerFile execUnits) ) = do let plutusScriptFp = unFile scriptFp - Exp.AnyPlutusScript script <- + Exp.Plutus.AnyPlutusScript script <- readFilePlutusScript @_ @era plutusScriptFp let - lang = Exp.plutusScriptInEraSLanguage script + lang = Exp.Plutus.plutusScriptInEraSLanguage script script' = PScript script redeemer <- diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Script/Mint/Read.hs b/cardano-cli/src/Cardano/CLI/EraBased/Script/Mint/Read.hs index ba109ac91d..4dc6c76949 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Script/Mint/Read.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Script/Mint/Read.hs @@ -13,7 +13,7 @@ where import Cardano.Api hiding (AnyScriptWitness) import Cardano.Api.Experimental qualified as Exp import Cardano.Api.Experimental.AnyScriptWitness -import Cardano.Api.Experimental.Plutus qualified as Exp +import Cardano.Api.Experimental.Plutus qualified as Exp.Plutus import Cardano.Api.Experimental.Plutus qualified as L import Cardano.Api.Ledger qualified as L @@ -39,7 +39,7 @@ readMintScriptWitness (OnDiskPlutusScriptCliArgs scriptFp Exp.NoScriptDatumAllowed redeemerFile execUnits) ) = do let plutusScriptFp = unFile scriptFp - Exp.AnyPlutusScript script <- + Exp.Plutus.AnyPlutusScript script <- readFilePlutusScript @_ @era plutusScriptFp let polId = fromMaryPolicyID . L.PolicyID $ L.hashPlutusScriptInEra script redeemer <- @@ -47,7 +47,7 @@ readMintScriptWitness readScriptDataOrFile redeemerFile let pScript = Exp.PScript script - lang = Exp.plutusScriptInEraSLanguage script + lang = Exp.Plutus.plutusScriptInEraSLanguage script let sw = Exp.PlutusScriptWitness lang diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Script/Proposal/Read.hs b/cardano-cli/src/Cardano/CLI/EraBased/Script/Proposal/Read.hs index 3a0f8d03e8..74340a777f 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Script/Proposal/Read.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Script/Proposal/Read.hs @@ -17,7 +17,7 @@ import Cardano.Api import Cardano.Api.Experimental (obtainCommonConstraints) import Cardano.Api.Experimental qualified as Exp import Cardano.Api.Experimental.AnyScriptWitness -import Cardano.Api.Experimental.Plutus qualified as Exp +import Cardano.Api.Experimental.Plutus qualified as Exp.Plutus import Cardano.CLI.Compatible.Exception import Cardano.CLI.EraBased.Script.Proposal.Type @@ -56,9 +56,9 @@ readProposalScriptWitness (propFp, Just certScriptReq) = OnDiskPlutusScript (OnDiskPlutusScriptCliArgs scriptFp Exp.NoScriptDatumAllowed redeemerFile execUnits) -> do let plutusScriptFp = unFile scriptFp - Exp.AnyPlutusScript plutusScript <- + Exp.Plutus.AnyPlutusScript plutusScript <- readFilePlutusScript @_ @era plutusScriptFp - let lang = Exp.plutusScriptInEraSLanguage plutusScript + let lang = Exp.Plutus.plutusScriptInEraSLanguage plutusScript redeemer <- fromExceptTCli $ readScriptDataOrFile redeemerFile diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Script/Read/Common.hs b/cardano-cli/src/Cardano/CLI/EraBased/Script/Read/Common.hs index 0382ceab5a..7c3254ad8c 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Script/Read/Common.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Script/Read/Common.hs @@ -38,12 +38,14 @@ readFileSimpleScript readFileSimpleScript file era = do bs <- readFileCli file case deserialiseFromJSON bs of - Left _ -> do - -- In addition to the TextEnvelope format, we also try to - -- deserialize the JSON representation of SimpleScripts.. - script :: SimpleScript <- fromEitherCli $ Aeson.eitherDecodeStrict' bs - let s :: L.NativeScript (Exp.LedgerEra era) = obtainCommonConstraints era $ toAllegraTimelock script - return $ obtainCommonConstraints (era :: Exp.Era era) $ Exp.SimpleScript s + Left _ -> case era of + Exp.DijkstraEra -> error "TODO Dijkstra: Simple script not supported" + Exp.ConwayEra -> Exp.obtainConwayConstraints era $ do + -- In addition to the TextEnvelope format, we also try to + -- deserialize the JSON representation of SimpleScripts.. + script :: SimpleScript <- fromEitherCli $ Aeson.eitherDecodeStrict' bs + let s :: L.NativeScript (Exp.LedgerEra era) = obtainCommonConstraints era $ toAllegraTimelock script + return $ Exp.SimpleScript s Right te -> do let scriptBs = teRawCBOR te obtainCommonConstraints era $ diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Script/Spend/Read.hs b/cardano-cli/src/Cardano/CLI/EraBased/Script/Spend/Read.hs index 8427795fe8..6744245d9c 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Script/Spend/Read.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Script/Spend/Read.hs @@ -26,7 +26,7 @@ import Cardano.Api.Experimental hiding ) import Cardano.Api.Experimental qualified as Exp import Cardano.Api.Experimental.AnyScriptWitness qualified as Exp -import Cardano.Api.Experimental.Plutus qualified as Exp +import Cardano.Api.Experimental.Plutus qualified as Exp.Plutus import Cardano.CLI.Compatible.Exception import Cardano.CLI.EraBased.Script.Read.Common @@ -64,11 +64,11 @@ readSpendScriptWitness (Just spendScriptReq) = anyScript <- readFilePlutusScript @_ @era (unFile plutusScriptFp) case anyScript of - Exp.AnyPlutusScript script -> do + Exp.Plutus.AnyPlutusScript script -> do redeemer <- fromExceptTCli $ readScriptDataOrFile redeemerFile - let lang = Exp.plutusScriptInEraSLanguage script + let lang = Exp.Plutus.plutusScriptInEraSLanguage script mDatum <- handlePotentialScriptDatum mScriptDatum lang let pScript = Exp.PScript script diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Script/Vote/Read.hs b/cardano-cli/src/Cardano/CLI/EraBased/Script/Vote/Read.hs index 2c66b45eaa..de52e253eb 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Script/Vote/Read.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Script/Vote/Read.hs @@ -14,7 +14,7 @@ where import Cardano.Api import Cardano.Api.Experimental qualified as Exp import Cardano.Api.Experimental.AnyScriptWitness -import Cardano.Api.Experimental.Plutus qualified as Exp +import Cardano.Api.Experimental.Plutus qualified as Exp.Plutus import Cardano.CLI.Compatible.Exception import Cardano.CLI.EraBased.Script.Read.Common @@ -55,14 +55,14 @@ readVoteScriptWitness (voteFp, Just certScriptReq) = do OnDiskPlutusScript (OnDiskPlutusScriptCliArgs scriptFp Exp.NoScriptDatumAllowed redeemerFile execUnits) -> do let plutusScriptFp = unFile scriptFp - Exp.AnyPlutusScript script <- + Exp.Plutus.AnyPlutusScript script <- readFilePlutusScript @_ @era plutusScriptFp redeemer <- fromExceptTCli $ readScriptDataOrFile redeemerFile let pScript = Exp.PScript script - lang = Exp.plutusScriptInEraSLanguage script + lang = Exp.Plutus.plutusScriptInEraSLanguage script let sw = Exp.PlutusScriptWitness lang diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Script/Withdrawal/Read.hs b/cardano-cli/src/Cardano/CLI/EraBased/Script/Withdrawal/Read.hs index 244475c4ea..25d176e0b3 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Script/Withdrawal/Read.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Script/Withdrawal/Read.hs @@ -20,7 +20,7 @@ import Cardano.Api.Experimental ) import Cardano.Api.Experimental qualified as Exp import Cardano.Api.Experimental.AnyScriptWitness -import Cardano.Api.Experimental.Plutus qualified as Exp +import Cardano.Api.Experimental.Plutus qualified as Exp.Plutus import Cardano.CLI.Compatible.Exception import Cardano.CLI.EraBased.Script.Read.Common @@ -48,13 +48,13 @@ readWithdrawalScriptWitness (stakeAddr, withdrawalAmt, Just certScriptReq) = ) OnDiskPlutusScript (OnDiskPlutusScriptCliArgs scriptFp NoScriptDatumAllowed redeemerFile execUnits) -> do let plutusScriptFp = unFile scriptFp - Exp.AnyPlutusScript script <- + Exp.Plutus.AnyPlutusScript script <- readFilePlutusScript @_ @era plutusScriptFp redeemer <- fromExceptTCli $ readScriptDataOrFile redeemerFile - let lang = Exp.plutusScriptInEraSLanguage script + let lang = Exp.Plutus.plutusScriptInEraSLanguage script pScript = Exp.PScript script sw = Exp.PlutusScriptWitness diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Transaction/Run.hs b/cardano-cli/src/Cardano/CLI/EraBased/Transaction/Run.hs index 27d61cfec4..4e5c258856 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Transaction/Run.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Transaction/Run.hs @@ -1379,7 +1379,7 @@ runTransactionCalculateMinFeeCmd let byronfee = shelleyBasedEraConstraints sbe $ - calculateByronWitnessFees (lpparams ^. L.ppMinFeeAL) nByronKeyWitnesses + calculateByronWitnessFees (lpparams ^. L.ppTxFeePerByteL) nByronKeyWitnesses let fee = shelleyfee + byronfee textToWrite = docToText $ pretty fee @@ -1419,14 +1419,14 @@ runTransactionCalculateMinFeeCmd -- TODO: move this to Cardano.API.Fee.evaluateTransactionFee. calculateByronWitnessFees :: () - => Lovelace + => L.CoinPerByte -- ^ The tx fee per byte (from protocol parameters) -> Int -- ^ The number of Byron key witnesses -> Lovelace -calculateByronWitnessFees txFeePerByte byronwitcount = +calculateByronWitnessFees (L.CoinPerByte txFeePerByte) byronwitcount = L.Coin $ - toInteger txFeePerByte + toInteger (L.fromCompact txFeePerByte) * toInteger byronwitcount * toInteger sizeByronKeyWitnesses where diff --git a/cardano-cli/src/Cardano/CLI/Read.hs b/cardano-cli/src/Cardano/CLI/Read.hs index cd5d2a960c..ac00562387 100644 --- a/cardano-cli/src/Cardano/CLI/Read.hs +++ b/cardano-cli/src/Cardano/CLI/Read.hs @@ -99,8 +99,7 @@ import Cardano.Api.Byron (ByronKey) import Cardano.Api.Byron qualified as Byron import Cardano.Api.Experimental (obtainCommonConstraints) import Cardano.Api.Experimental qualified as Exp -import Cardano.Api.Experimental.AnyScript qualified as Exp -import Cardano.Api.Experimental.Plutus qualified as Exp' +import Cardano.Api.Experimental.Plutus qualified as Exp.Plutus import Cardano.Api.Ledger qualified as L import Cardano.Api.Parser.Text qualified as P @@ -116,6 +115,7 @@ import Cardano.CLI.Type.Governance import Cardano.CLI.Type.Key import Cardano.Crypto.Hash qualified as Crypto import Cardano.Ledger.Api qualified as L +import Cardano.Ledger.Core qualified as L import RIO (readFileBinary) import Prelude @@ -212,19 +212,20 @@ readAnyScript anyScriptFp = do case Aeson.eitherDecodeStrict' bs :: Either String SimpleScript of Left err -> throwCliError err Right script -> - let s :: L.NativeScript (Exp.LedgerEra era) = obtainCommonConstraints (Exp.useEra @era) $ toAllegraTimelock script - in return . Exp.AnySimpleScript $ - obtainCommonConstraints (Exp.useEra :: Exp.Era era) $ - Exp.SimpleScript s + case Exp.useEra @era of + Exp.DijkstraEra -> error "TODO Dijkstra: Simple script not supported" + era@Exp.ConwayEra -> Exp.obtainConwayConstraints era $ do + let s :: L.NativeScript (Exp.LedgerEra era) = toAllegraTimelock script + return . Exp.AnySimpleScript $ Exp.SimpleScript s Right te -> do let scriptBs = teRawCBOR te TextEnvelopeType anyScriptType = teType te - case Exp'.textToPlutusLanguage $ Text.pack anyScriptType of + case Exp.Plutus.textToPlutusLanguage $ Text.pack anyScriptType of Just anyPlutusScriptLang -> do case Exp.obtainCommonConstraints (Exp.useEra @era) $ - Exp'.decodeAnyPlutusScript @(Exp.LedgerEra era) scriptBs anyPlutusScriptLang - :: Either CBOR.DecoderError (Exp'.AnyPlutusScript (Exp.LedgerEra era)) of - Right (Exp'.AnyPlutusScript plutusScript) -> return $ Exp.AnyPlutusScript plutusScript + Exp.Plutus.decodeAnyPlutusScript @(Exp.LedgerEra era) scriptBs anyPlutusScriptLang + :: Either CBOR.DecoderError (Exp.Plutus.AnyPlutusScript (Exp.LedgerEra era)) of + Right (Exp.Plutus.AnyPlutusScript plutusScript) -> return $ Exp.AnyPlutusScript plutusScript Left e -> throwCliError $ "Failed to decode Plutus script: " <> show e -- Simple script text envelope format @@ -386,7 +387,7 @@ mkShelleyBootstrapWitness :: () => ShelleyBasedEra era -> Maybe NetworkId - -> L.TxBody (ShelleyLedgerEra era) + -> L.TxBody L.TopTx (ShelleyLedgerEra era) -> ShelleyBootstrapWitnessSigningKeyData -> Either BootstrapWitnessError (KeyWitness era) mkShelleyBootstrapWitness _ Nothing _ (ShelleyBootstrapWitnessSigningKeyData _ Nothing) = @@ -819,16 +820,16 @@ readFilePlutusScript :: forall e era . Exp.IsEra era => FilePath - -> CIO e (Exp'.AnyPlutusScript (Exp.LedgerEra era)) + -> CIO e (Exp.Plutus.AnyPlutusScript (Exp.LedgerEra era)) readFilePlutusScript plutusScriptFp = do bs <- readFileCli plutusScriptFp te <- fromEitherCli $ deserialiseFromJSON bs let scriptBs = teRawCBOR te TextEnvelopeType anyScriptType = teType te - case Exp'.textToPlutusLanguage (Text.pack anyScriptType) of + case Exp.Plutus.textToPlutusLanguage (Text.pack anyScriptType) of Just lang -> do - let s :: Either CBOR.DecoderError (Exp'.AnyPlutusScript (Exp.LedgerEra era)) = obtainCommonConstraints (Exp.useEra @era) $ Exp'.decodeAnyPlutusScript scriptBs lang + let s :: Either CBOR.DecoderError (Exp.Plutus.AnyPlutusScript (Exp.LedgerEra era)) = obtainCommonConstraints (Exp.useEra @era) $ Exp.Plutus.decodeAnyPlutusScript scriptBs lang fromEitherCli s Nothing -> throwCliError $ "Unsupported script language: " <> anyScriptType diff --git a/cardano-cli/src/Cardano/CLI/Type/Common.hs b/cardano-cli/src/Cardano/CLI/Type/Common.hs index 41bdcd84bf..ac7c8e43c5 100644 --- a/cardano-cli/src/Cardano/CLI/Type/Common.hs +++ b/cardano-cli/src/Cardano/CLI/Type/Common.hs @@ -381,11 +381,12 @@ mkPoolStates ) ) = (`Map.mapWithKey` qpsrStakePoolParams) $ \kh pp -> do let mDeposit = L.toCompact =<< Map.lookup kh qpsrDeposits + stakingCredentials = mempty -- QueryPoolStateResult does not provide delegators PoolParams - { poolParameters = (`L.mkStakePoolState` pp) <$> mDeposit + { poolParameters = (\deposit -> L.mkStakePoolState deposit stakingCredentials pp) <$> mDeposit , futurePoolParameters = do futurePp <- Map.lookup kh qpsrFutureStakePoolParams - (`L.mkStakePoolState` futurePp) <$> mDeposit + (\deposit -> L.mkStakePoolState deposit stakingCredentials futurePp) <$> mDeposit , retiringEpoch = Map.lookup kh qpsrRetiring } diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/CreateTestnetData.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/CreateTestnetData.hs index 420c0ac3a7..dcdc01cd4b 100644 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/CreateTestnetData.hs +++ b/cardano-cli/test/cardano-cli-golden/Test/Golden/CreateTestnetData.hs @@ -131,7 +131,7 @@ golden_create_testnet_data mShelleyTemplate = length (L.sgsPools $ sgStaking shelleyGenesis) H.=== numPools forM_ (L.sgsPools $ sgStaking shelleyGenesis) $ \pool -> - Seq.length (L.ppRelays pool) H.=== 1 + Seq.length (L.sppRelays pool) H.=== 1 actualNumCCs <- liftIO $ listDirectories $ outputDir "cc-keys" length actualNumCCs H.=== numCommitteeKeys diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Legacy/Genesis/Create.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Legacy/Genesis/Create.hs index 44797a1715..776605df9e 100644 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Legacy/Genesis/Create.hs +++ b/cardano-cli/test/cardano-cli-golden/Test/Golden/Legacy/Genesis/Create.hs @@ -2,12 +2,9 @@ module Test.Golden.Legacy.Genesis.Create where -import Cardano.Api.Ledger (AlonzoGenesis (AlonzoGenesis), costModelsValid, getCostModelParams) - -import Cardano.Ledger.Plutus.Language +import Cardano.Api.Ledger (AlonzoGenesis (AlonzoGenesis), getCostModelParams) import Control.Monad (void) -import Data.Map.Strict qualified as Map import System.FilePath (()) import Test.Cardano.CLI.Util (execCardanoCLI, propertyOnce, watchdogProp) @@ -16,9 +13,11 @@ import Hedgehog (Property) import Hedgehog qualified as H import Hedgehog.Extras.Test qualified as H --- | QA needs the ability to generate a V2 cost model with 175 parameters in the Alonzo era -hprop_golden_alonzo_genesis_v2_cost_model_has_175_parameters :: Property -hprop_golden_alonzo_genesis_v2_cost_model_has_175_parameters = +-- | Verify that the generated Alonzo genesis contains a PlutusV1 cost model with 166 parameters. +-- AlonzoGenesis only stores a PlutusV1 cost model. PlutusV2 cost models are not part of any +-- genesis file - they are introduced via protocol parameter updates. +hprop_golden_alonzo_genesis_v1_cost_model_has_166_parameters :: Property +hprop_golden_alonzo_genesis_v1_cost_model_has_166_parameters = watchdogProp . propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do alonzoGenesisSpec <- H.note "test/cardano-cli-golden/files/input/genesis.alonzo.spec.json" @@ -58,10 +57,7 @@ hprop_golden_alonzo_genesis_v2_cost_model_has_175_parameters = -- Read generated alonzo genesis file alonzoGenesisFp <- H.note $ outDir "genesis.alonzo.json" - AlonzoGenesis _ costModels _ _ _ _ _ _ <- H.readJsonFileOk alonzoGenesisFp - let v2CostModel = costModelsValid costModels - mV2Params = Map.lookup PlutusV2 v2CostModel - v2Params <- getCostModelParams <$> H.evalMaybe mV2Params - + AlonzoGenesis _ v1CostModel _ _ _ _ _ _ _extraConfig <- H.readJsonFileOk alonzoGenesisFp + let v1Params = getCostModelParams v1CostModel H.note_ $ "Cost model filepath: " <> alonzoGenesisFp - length v2Params H.=== 175 + length v1Params H.=== 166 diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help.cli index 36e188a3ea..0ed67ceb95 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help.cli @@ -524,6 +524,7 @@ Usage: cardano-cli query ledger-peer-snapshot [ --volatile-tip | --immutable-tip ] + [--all-ledger-peers] [--output-json | --output-yaml] [--out-file FILEPATH] @@ -1957,6 +1958,7 @@ Usage: cardano-cli conway query ledger-peer-snapshot [ --volatile-tip | --immutable-tip ] + [--all-ledger-peers] [ --output-json | --output-yaml ] @@ -4255,6 +4257,7 @@ Usage: cardano-cli latest query ledger-peer-snapshot [ --volatile-tip | --immutable-tip ] + [--all-ledger-peers] [ --output-json | --output-yaml ] diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_query_ledger-peer-snapshot.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_query_ledger-peer-snapshot.cli index 30eb62086a..bb05589cd4 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_query_ledger-peer-snapshot.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_query_ledger-peer-snapshot.cli @@ -8,6 +8,7 @@ Usage: cardano-cli conway query ledger-peer-snapshot [ --volatile-tip | --immutable-tip ] + [--all-ledger-peers] [ --output-json | --output-yaml ] @@ -33,6 +34,7 @@ Available options: --volatile-tip Use the volatile tip as a target. (This is the default) --immutable-tip Use the immutable tip as a target. + --all-ledger-peers Query all ledger peers instead of big ones --output-json Format ledger-peer-snapshot query output to JSON (default). --output-yaml Format ledger-peer-snapshot query output to YAML. diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/latest_query_ledger-peer-snapshot.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/latest_query_ledger-peer-snapshot.cli index 1bcecd9daf..cea79de478 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/latest_query_ledger-peer-snapshot.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/latest_query_ledger-peer-snapshot.cli @@ -8,6 +8,7 @@ Usage: cardano-cli latest query ledger-peer-snapshot [ --volatile-tip | --immutable-tip ] + [--all-ledger-peers] [ --output-json | --output-yaml ] @@ -33,6 +34,7 @@ Available options: --volatile-tip Use the volatile tip as a target. (This is the default) --immutable-tip Use the immutable tip as a target. + --all-ledger-peers Query all ledger peers instead of big ones --output-json Format ledger-peer-snapshot query output to JSON (default). --output-yaml Format ledger-peer-snapshot query output to YAML. diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/query_ledger-peer-snapshot.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/query_ledger-peer-snapshot.cli index c8465c77a1..4aa76b5b97 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/query_ledger-peer-snapshot.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/query_ledger-peer-snapshot.cli @@ -8,6 +8,7 @@ Usage: cardano-cli query ledger-peer-snapshot [ --volatile-tip | --immutable-tip ] + [--all-ledger-peers] [--output-json | --output-yaml] [--out-file FILEPATH] @@ -31,6 +32,7 @@ Available options: --volatile-tip Use the volatile tip as a target. (This is the default) --immutable-tip Use the immutable tip as a target. + --all-ledger-peers Query all ledger peers instead of big ones --output-json Format ledger-peer-snapshot query output to JSON (default). --output-yaml Format ledger-peer-snapshot query output to YAML.