From a272b0bdaa875081f47c2b9dd9540b04f1a4f23c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Cl=C3=A9ment=20Hurlin?= Date: Fri, 15 Nov 2024 10:28:53 +0100 Subject: [PATCH 01/17] Use new inject function instead of the XToY era functions --- .../src/Cardano/CLI/Compatible/Transaction.hs | 6 ++-- .../EraBased/Options/Governance/Actions.hs | 8 ++--- .../src/Cardano/CLI/EraBased/Options/Query.hs | 4 +-- .../CLI/EraBased/Options/StakeAddress.hs | 4 +-- .../CLI/EraBased/Options/Transaction.hs | 2 +- .../Cardano/CLI/EraBased/Run/Governance.hs | 15 +++++---- .../CLI/EraBased/Run/Governance/Actions.hs | 31 ++++++++++--------- .../GenesisKeyDelegationCertificate.hs | 6 ++-- .../CLI/EraBased/Run/Governance/Vote.hs | 8 ++--- .../Cardano/CLI/EraBased/Run/Transaction.hs | 6 ++-- cardano-cli/src/Cardano/CLI/Json/Friendly.hs | 4 +-- cardano-cli/src/Cardano/CLI/Read.hs | 4 +-- 12 files changed, 52 insertions(+), 46 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/Compatible/Transaction.hs b/cardano-cli/src/Cardano/CLI/Compatible/Transaction.hs index 8c3cc9d2c4..a1ffb8cee0 100644 --- a/cardano-cli/src/Cardano/CLI/Compatible/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/Compatible/Transaction.hs @@ -270,18 +270,18 @@ readUpdateProposalFile :: Featured ShelleyToBabbageEra era (Maybe UpdateProposalFile) -> ExceptT CompatibleTransactionError IO (AnyProtocolUpdate era) readUpdateProposalFile (Featured sToB Nothing) = - return $ NoPParamsUpdate $ shelleyToBabbageEraToShelleyBasedEra sToB + return $ NoPParamsUpdate $ inject sToB readUpdateProposalFile (Featured sToB (Just updateProposalFile)) = do prop <- firstExceptT CompatibleFileError $ readTxUpdateProposal sToB updateProposalFile case prop of - TxUpdateProposalNone -> return $ NoPParamsUpdate $ shelleyToBabbageEraToShelleyBasedEra sToB + TxUpdateProposalNone -> return $ NoPParamsUpdate $ inject sToB TxUpdateProposal _ proposal -> return $ ProtocolUpdate sToB proposal readProposalProcedureFile :: Featured ConwayEraOnwards era [(ProposalFile In, Maybe (ScriptWitnessFiles WitCtxStake))] -> ExceptT CompatibleTransactionError IO (AnyProtocolUpdate era) readProposalProcedureFile (Featured cEraOnwards []) = - let sbe = conwayEraOnwardsToShelleyBasedEra cEraOnwards + let sbe = inject cEraOnwards in return $ NoPParamsUpdate sbe readProposalProcedureFile (Featured cEraOnwards proposals) = do props <- diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Actions.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Actions.hs index 69efca1e4d..d0c3244542 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Actions.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Actions.hs @@ -185,11 +185,11 @@ pUpdateProtocolParametersCmd pUpdateProtocolParametersCmd = caseShelleyToBabbageOrConwayEraOnwards ( \shelleyToBab -> - let sbe = shelleyToBabbageEraToShelleyBasedEra shelleyToBab + let sbe = inject shelleyToBab in subParser "create-protocol-parameters-update" $ Opt.info ( Cmd.GovernanceActionProtocolParametersUpdateCmdArgs - (shelleyToBabbageEraToShelleyBasedEra shelleyToBab) + (inject shelleyToBab) <$> fmap Just (pUpdateProtocolParametersPreConway shelleyToBab) <*> pure Nothing <*> dpGovActionProtocolParametersUpdate sbe @@ -199,11 +199,11 @@ pUpdateProtocolParametersCmd = $ Opt.progDesc "Create a protocol parameters update." ) ( \conwayOnwards -> - let sbe = conwayEraOnwardsToShelleyBasedEra conwayOnwards + let sbe = inject conwayOnwards in subParser "create-protocol-parameters-update" $ Opt.info ( Cmd.GovernanceActionProtocolParametersUpdateCmdArgs - (conwayEraOnwardsToShelleyBasedEra conwayOnwards) + (inject conwayOnwards) Nothing <$> fmap Just (pUpdateProtocolParametersPostConway conwayOnwards) <*> dpGovActionProtocolParametersUpdate sbe diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Query.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Query.hs index 03fd68e489..031db5e0e3 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Query.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Query.hs @@ -678,7 +678,7 @@ pQueryTreasuryValueCmd era envCli = do <*> optional pOutputFile pQueryNoArgCmdArgs - :: () + :: forall era. () => ConwayEraOnwards era -> EnvCli -> Parser (QueryNoArgCmdArgs era) @@ -687,5 +687,5 @@ pQueryNoArgCmdArgs w envCli = <$> pSocketPath envCli <*> pConsensusModeParams <*> pNetworkId envCli - <*> pTarget (conwayEraOnwardsToShelleyBasedEra w) + <*> pTarget (inject w :: ShelleyBasedEra era) <*> optional pOutputFile diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/StakeAddress.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/StakeAddress.hs index 33722c2f6f..e8f6f1aceb 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/StakeAddress.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/StakeAddress.hs @@ -121,7 +121,7 @@ pStakeAddressDeregistrationCertificateCmd = ( \shelleyToBabbage -> subParser "deregistration-certificate" $ Opt.info - ( StakeAddressDeregistrationCertificateCmd (shelleyToBabbageEraToShelleyBasedEra shelleyToBabbage) + ( StakeAddressDeregistrationCertificateCmd (inject shelleyToBabbage) <$> pStakeIdentifier Nothing <*> pure Nothing <*> pOutputFile @@ -131,7 +131,7 @@ pStakeAddressDeregistrationCertificateCmd = ( \conwayOnwards -> subParser "deregistration-certificate" $ Opt.info - ( StakeAddressDeregistrationCertificateCmd (conwayEraOnwardsToShelleyBasedEra conwayOnwards) + ( StakeAddressDeregistrationCertificateCmd (inject conwayOnwards) <$> pStakeIdentifier Nothing <*> fmap Just pKeyRegistDeposit <*> pOutputFile diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Transaction.hs index 2bdb9375e5..cf07a9f14f 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Transaction.hs @@ -227,7 +227,7 @@ pTransactionBuildEstimateCmd eon' _envCli = do where pCmd :: Exp.Era era -> Parser (TransactionCmds era) pCmd era' = do - let sbe = Exp.eraToSbe era' + let sbe = inject era' fmap TransactionBuildEstimateCmd $ TransactionBuildEstimateCmdArgs era' <$> optional pScriptValidity diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance.hs index c982858983..76f93cdf92 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance.hs @@ -65,7 +65,7 @@ runGovernanceCmds = \case runGovernanceVoteCmds cmds runGovernanceMIRCertificatePayStakeAddrs - :: ShelleyToBabbageEra era + :: forall era. ShelleyToBabbageEra era -> L.MIRPot -> [StakeAddress] -- ^ Stake addresses @@ -92,10 +92,11 @@ runGovernanceMIRCertificatePayStakeAddrs w mirPot sAddrs rwdAmts oFp = do makeMIRCertificate $ MirCertificateRequirements w mirPot $ shelleyToBabbageEraConstraints w mirTarget + sbe :: ShelleyBasedEra era = inject w firstExceptT GovernanceCmdTextEnvWriteError . newExceptT - $ shelleyBasedEraConstraints (shelleyToBabbageEraToShelleyBasedEra w) + $ shelleyBasedEraConstraints sbe $ writeLazyByteStringFile oFp $ textEnvelopeToJSON (Just mirCertDesc) mirCert where @@ -103,7 +104,7 @@ runGovernanceMIRCertificatePayStakeAddrs w mirPot sAddrs rwdAmts oFp = do mirCertDesc = "Move Instantaneous Rewards Certificate" runGovernanceCreateMirCertificateTransferToTreasuryCmd - :: () + :: forall era. () => ShelleyToBabbageEra era -> Lovelace -> File () Out @@ -112,10 +113,11 @@ runGovernanceCreateMirCertificateTransferToTreasuryCmd w ll oFp = do let mirTarget = L.SendToOppositePotMIR ll let mirCert = makeMIRCertificate $ MirCertificateRequirements w L.ReservesMIR mirTarget + sbe :: ShelleyBasedEra era = inject w firstExceptT GovernanceCmdTextEnvWriteError . newExceptT - $ shelleyBasedEraConstraints (shelleyToBabbageEraToShelleyBasedEra w) + $ shelleyBasedEraConstraints sbe $ writeLazyByteStringFile oFp $ textEnvelopeToJSON (Just mirCertDesc) mirCert where @@ -123,7 +125,7 @@ runGovernanceCreateMirCertificateTransferToTreasuryCmd w ll oFp = do mirCertDesc = "MIR Certificate Send To Treasury" runGovernanceCreateMirCertificateTransferToReservesCmd - :: () + :: forall era. () => ShelleyToBabbageEra era -> Lovelace -> File () Out @@ -132,10 +134,11 @@ runGovernanceCreateMirCertificateTransferToReservesCmd w ll oFp = do let mirTarget = L.SendToOppositePotMIR ll let mirCert = makeMIRCertificate $ MirCertificateRequirements w L.TreasuryMIR mirTarget + sbe :: ShelleyBasedEra era = inject w firstExceptT GovernanceCmdTextEnvWriteError . newExceptT - $ shelleyBasedEraConstraints (shelleyToBabbageEraToShelleyBasedEra w) + $ shelleyBasedEraConstraints sbe $ writeLazyByteStringFile oFp $ textEnvelopeToJSON (Just mirCertDesc) mirCert where diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Actions.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Actions.hs index 7faa12f9a2..e164dcd8ce 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Actions.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Actions.hs @@ -3,6 +3,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} module Cardano.CLI.EraBased.Run.Governance.Actions @@ -77,7 +78,7 @@ runGovernanceActionViewCmd proposal runGovernanceActionInfoCmd - :: () + :: forall era. () => GovernanceActionInfoCmdArgs era -> ExceptT GovernanceActionsError IO () runGovernanceActionInfoCmd @@ -103,7 +104,7 @@ runGovernanceActionInfoCmd carryHashChecks checkProposalHash proposalAnchor ProposalCheck - let sbe = conwayEraOnwardsToShelleyBasedEra eon + let sbe :: ShelleyBasedEra era = inject eon govAction = InfoAct proposalProcedure = createProposalProcedure sbe networkId deposit depositStakeCredential govAction proposalAnchor @@ -117,7 +118,7 @@ fetchURLErrorToGovernanceActionError adt = withExceptT (GovernanceActionsProposa -- TODO: Conway era - update with new ledger types from cardano-ledger-conway-1.7.0.0 runGovernanceActionCreateNoConfidenceCmd - :: () + :: forall era. () => GovernanceActionCreateNoConfidenceCmdArgs era -> ExceptT GovernanceActionsError IO () runGovernanceActionCreateNoConfidenceCmd @@ -144,7 +145,7 @@ runGovernanceActionCreateNoConfidenceCmd carryHashChecks checkProposalHash proposalAnchor ProposalCheck - let sbe = conwayEraOnwardsToShelleyBasedEra eon + let sbe :: ShelleyBasedEra era = inject eon previousGovernanceAction = MotionOfNoConfidence $ L.maybeToStrictMaybe $ @@ -165,7 +166,7 @@ runGovernanceActionCreateNoConfidenceCmd writeFileTextEnvelope outFile (Just "Motion of no confidence proposal") proposalProcedure runGovernanceActionCreateConstitutionCmd - :: () + :: forall era. () => GovernanceActionCreateConstitutionCmdArgs era -> ExceptT GovernanceActionsError IO () runGovernanceActionCreateConstitutionCmd @@ -210,7 +211,7 @@ runGovernanceActionCreateConstitutionCmd prevGovActId constitutionAnchor (toShelleyScriptHash <$> L.maybeToStrictMaybe constitutionScript) - sbe = conwayEraOnwardsToShelleyBasedEra eon + sbe :: ShelleyBasedEra era = inject eon proposalProcedure = createProposalProcedure sbe networkId deposit depositStakeCredential govAct proposalAnchor carryHashChecks checkConstitutionHash constitutionAnchor ConstitutionCheck @@ -225,7 +226,7 @@ runGovernanceActionCreateConstitutionCmd -- TODO: Conway era - After ledger bump update this function -- with the new ledger types runGovernanceActionUpdateCommitteeCmd - :: () + :: forall era. () => GovernanceActionUpdateCommitteeCmdArgs era -> ExceptT GovernanceActionsError IO () runGovernanceActionUpdateCommitteeCmd @@ -243,7 +244,7 @@ runGovernanceActionUpdateCommitteeCmd , Cmd.mPrevGovernanceActionId , Cmd.outFile } = do - let sbe = conwayEraOnwardsToShelleyBasedEra eon + let sbe :: ShelleyBasedEra era = inject eon govActIdentifier = L.maybeToStrictMaybe $ shelleyBasedEraConstraints sbe $ @@ -301,7 +302,7 @@ runGovernanceActionUpdateCommitteeCmd proposal runGovernanceActionCreateProtocolParametersUpdateCmd - :: () + :: forall era. () => Cmd.GovernanceActionProtocolParametersUpdateCmdArgs era -> ExceptT GovernanceActionsError IO () runGovernanceActionCreateProtocolParametersUpdateCmd eraBasedPParams' = do @@ -309,7 +310,7 @@ runGovernanceActionCreateProtocolParametersUpdateCmd eraBasedPParams' = do caseShelleyToBabbageOrConwayEraOnwards ( \sToB -> do let oFp = uppFilePath eraBasedPParams' - anyEra = AnyShelleyBasedEra $ shelleyToBabbageEraToShelleyBasedEra sToB + anyEra = AnyShelleyBasedEra (inject sToB :: ShelleyBasedEra era) UpdateProtocolParametersPreConway _stB expEpoch genesisVerKeys <- hoistMaybe (GovernanceActionsValueUpdateProtocolParametersNotFound anyEra) $ uppPreConway eraBasedPParams' @@ -335,7 +336,7 @@ runGovernanceActionCreateProtocolParametersUpdateCmd eraBasedPParams' = do ) ( \conwayOnwards -> do let oFp = uppFilePath eraBasedPParams' - anyEra = AnyShelleyBasedEra $ conwayEraOnwardsToShelleyBasedEra conwayOnwards + anyEra = AnyShelleyBasedEra (inject conwayOnwards :: ShelleyBasedEra era) UpdateProtocolParametersConwayOnwards _cOnwards @@ -413,7 +414,7 @@ addCostModelsToEraBasedProtocolParametersUpdate ConwayEraBasedProtocolParametersUpdate common (aOn{alCostModels = SJust cmdls}) inB inC runGovernanceActionTreasuryWithdrawalCmd - :: () + :: forall era. () => GovernanceActionTreasuryWithdrawalCmdArgs era -> ExceptT GovernanceActionsError IO () runGovernanceActionTreasuryWithdrawalCmd @@ -446,7 +447,7 @@ runGovernanceActionTreasuryWithdrawalCmd firstExceptT GovernanceActionsReadStakeCredErrror $ getStakeCredentialFromIdentifier stakeIdentifier pure (networkId, stakeCredential, lovelace) - let sbe = conwayEraOnwardsToShelleyBasedEra eon + let sbe :: ShelleyBasedEra era = inject eon treasuryWithdrawals = TreasuryWithdrawal withdrawals @@ -465,7 +466,7 @@ runGovernanceActionTreasuryWithdrawalCmd writeFileTextEnvelope outFile (Just "Treasury withdrawal proposal") proposal runGovernanceActionHardforkInitCmd - :: () + :: forall era. () => GovernanceActionHardforkInitCmdArgs era -> ExceptT GovernanceActionsError IO () runGovernanceActionHardforkInitCmd @@ -493,7 +494,7 @@ runGovernanceActionHardforkInitCmd carryHashChecks checkProposalHash proposalAnchor ProposalCheck - let sbe = conwayEraOnwardsToShelleyBasedEra eon + let sbe :: ShelleyBasedEra era = inject eon govActIdentifier = L.maybeToStrictMaybe $ shelleyBasedEraConstraints sbe $ diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/GenesisKeyDelegationCertificate.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/GenesisKeyDelegationCertificate.hs index f8759e4acc..740f5d97b4 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/GenesisKeyDelegationCertificate.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/GenesisKeyDelegationCertificate.hs @@ -1,5 +1,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} module Cardano.CLI.EraBased.Run.Governance.GenesisKeyDelegationCertificate ( runGovernanceGenesisKeyDelegationCertificate @@ -13,7 +15,7 @@ import Cardano.CLI.Types.Errors.GovernanceCmdError import Cardano.CLI.Types.Key runGovernanceGenesisKeyDelegationCertificate - :: ShelleyToBabbageEra era + :: forall era. ShelleyToBabbageEra era -> VerificationKeyOrHashOrFile GenesisKey -> VerificationKeyOrHashOrFile GenesisDelegateKey -> VerificationKeyOrHashOrFile VrfKey @@ -41,7 +43,7 @@ runGovernanceGenesisKeyDelegationCertificate firstExceptT GovernanceCmdTextEnvWriteError . newExceptT $ writeLazyByteStringFile oFp - $ shelleyBasedEraConstraints (shelleyToBabbageEraToShelleyBasedEra stb) + $ shelleyBasedEraConstraints (inject stb :: ShelleyBasedEra era) $ textEnvelopeToJSON (Just genKeyDelegCertDesc) genKeyDelegCert where genKeyDelegCertDesc :: TextEnvelopeDescr diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Vote.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Vote.hs index b48c073660..582332f911 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Vote.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Vote.hs @@ -41,7 +41,7 @@ runGovernanceVoteCmds = \case & firstExceptT CmdGovernanceVoteError runGovernanceVoteCreateCmd - :: () + :: forall era. () => Cmd.GovernanceVoteCreateCmdArgs era -> ExceptT GovernanceVoteCmdError IO () runGovernanceVoteCreateCmd @@ -54,7 +54,7 @@ runGovernanceVoteCreateCmd , outFile } = do let (govActionTxId, govActionIndex) = governanceAction - sbe = conwayEraOnwardsToShelleyBasedEra eon -- TODO: Conway era - update vote creation related function to take ConwayEraOnwards + sbe :: ShelleyBasedEra era = inject eon -- TODO: Conway era - update vote creation related function to take ConwayEraOnwards mAnchor' = fmap ( \pca@PotentiallyCheckedAnchor{pcaAnchor = (VoteUrl url, voteHash)} -> @@ -92,7 +92,7 @@ runGovernanceVoteCreateCmd writeFileTextEnvelope outFile Nothing votingProcedures runGovernanceVoteViewCmd - :: () + :: forall era. () => Cmd.GovernanceVoteViewCmdArgs era -> ExceptT GovernanceVoteCmdError IO () runGovernanceVoteViewCmd @@ -102,7 +102,7 @@ runGovernanceVoteViewCmd , voteFile , mOutFile } = do - let sbe = conwayEraOnwardsToShelleyBasedEra eon + let sbe :: ShelleyBasedEra era = inject eon shelleyBasedEraConstraints sbe $ do voteProcedures <- diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs index 877e7ddbdf..45ce800e43 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs @@ -136,7 +136,7 @@ runTransactionBuildCmd , treasuryDonation -- Maybe TxTreasuryDonation , buildOutputOptions } = do - let eon = Exp.eraToSbe currentEra + let eon = inject currentEra era' = toCardanoEra eon -- The user can specify an era prior to the era that the node is currently in. @@ -388,8 +388,8 @@ runTransactionBuildEstimateCmd -- TODO change type , currentTreasuryValueAndDonation , txBodyOutFile } = do - let sbe = Exp.eraToSbe currentEra - meo = babbageEraOnwardsToMaryEraOnwards $ Exp.eraToBabbageEraOnwards currentEra + let sbe = inject currentEra + meo = babbageEraOnwardsToMaryEraOnwards $ inject currentEra ledgerPParams <- firstExceptT TxCmdProtocolParamsError $ readProtocolParameters sbe protocolParamsFile diff --git a/cardano-cli/src/Cardano/CLI/Json/Friendly.hs b/cardano-cli/src/Cardano/CLI/Json/Friendly.hs index 8c95c4bf3f..6791c4b64d 100644 --- a/cardano-cli/src/Cardano/CLI/Json/Friendly.hs +++ b/cardano-cli/src/Cardano/CLI/Json/Friendly.hs @@ -786,10 +786,10 @@ friendlyFee = \case friendlyLovelace :: Lovelace -> Aeson.Value friendlyLovelace value = String $ docToText (pretty value) -friendlyMintValue :: TxMintValue ViewTx era -> Aeson.Value +friendlyMintValue :: forall era. TxMintValue ViewTx era -> Aeson.Value friendlyMintValue = \case TxMintNone -> Null - TxMintValue sbe v _ -> friendlyValue (maryEraOnwardsToShelleyBasedEra sbe) v + TxMintValue sbe v _ -> friendlyValue ((inject sbe) :: ShelleyBasedEra era) v friendlyTxOutValue :: TxOutValue era -> Aeson.Value friendlyTxOutValue = \case diff --git a/cardano-cli/src/Cardano/CLI/Read.hs b/cardano-cli/src/Cardano/CLI/Read.hs index 204e9672bc..d1339d00a2 100644 --- a/cardano-cli/src/Cardano/CLI/Read.hs +++ b/cardano-cli/src/Cardano/CLI/Read.hs @@ -919,7 +919,7 @@ readSingleVote w (voteFp, mScriptWitFiles) = do case mScriptWitFiles of Nothing -> pure $ (,Nothing) <$> votProceds sWitFile -> do - let sbe = conwayEraOnwardsToShelleyBasedEra w + let sbe = inject w runExceptT $ do sWits <- firstExceptT VoteErrorScriptWitness $ @@ -965,7 +965,7 @@ readProposal w (fp, mScriptWit) = do case mScriptWit of Nothing -> pure $ (,Nothing) <$> prop sWitFile -> do - let sbe = conwayEraOnwardsToShelleyBasedEra w + let sbe = inject w runExceptT $ do sWit <- firstExceptT ProposalErrorScriptWitness $ From ea0476cc5f66015b6ef11148b50c81e90a671db1 Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Mon, 18 Nov 2024 19:23:23 +0100 Subject: [PATCH 02/17] Remove use of experimental api in transaction balancing --- .../Cardano/CLI/EraBased/Run/Transaction.hs | 30 +++++++++++-------- 1 file changed, 17 insertions(+), 13 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs index 45ce800e43..84bd01350e 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs @@ -37,13 +37,14 @@ where import Cardano.Api import qualified Cardano.Api.Byron as Byron -import qualified Cardano.Api.Experimental as Exp import qualified Cardano.Api.Ledger as L import qualified Cardano.Api.Network as Consensus import qualified Cardano.Api.Network as Net.Tx import Cardano.Api.Shelley import qualified Cardano.Binary as CBOR +import Cardano.CLI.EraBased.Commands.Transaction + (TransactionCalculateMinFeeCmdArgs (txBodyFile)) import qualified Cardano.CLI.EraBased.Commands.Transaction as Cmd import Cardano.CLI.EraBased.Run.Genesis.Common (readProtocolParameters) import Cardano.CLI.EraBased.Run.Query @@ -284,7 +285,7 @@ runTransactionBuildCmd (Just td, Just ctv) -> Just (ctv, td) -- We need to construct the txBodycontent outside of runTxBuild - BalancedTxBody txBodyContent unsignedTx@(Exp.UnsignedTx balancedTxBody) _ _ <- + BalancedTxBody txBodyContent balancedTxBody _ _ <- runTxBuild eon nodeSocketPath @@ -329,13 +330,13 @@ runTransactionBuildCmd scriptExecUnitsMap <- firstExceptT (TxCmdTxExecUnitsErr . AnyTxCmdTxExecUnitsErr) $ hoistEither $ - evaluateTransactionExecutionUnitsShelley - eon + evaluateTransactionExecutionUnits + era' systemStart (toLedgerEpochInfo eraHistory) pparams txEraUtxo - (Exp.obtainCommonConstraints currentEra balancedTxBody) + balancedTxBody let mScriptWits = forEraInEon era' [] $ \sbe -> collectTxBodyScriptWitnesses sbe txBodyContent @@ -349,13 +350,13 @@ runTransactionBuildCmd scriptExecUnitsMap liftIO $ LBS.writeFile (unFile fp) $ encodePretty scriptCostOutput OutputTxBodyOnly fpath -> do - let noWitTx = ShelleyTx eon $ Exp.obtainCommonConstraints currentEra $ Exp.signTx currentEra [] [] unsignedTx - lift (writeTxFileTextEnvelopeCddl eon fpath noWitTx) + let noWitTx = makeSignedTransaction [] balancedTxBody + lift (cardanoEraConstraints era' $ writeTxFileTextEnvelopeCddl eon fpath noWitTx) & onLeft (left . TxCmdWriteFileError) runTransactionBuildEstimateCmd - :: () - => Cmd.TransactionBuildEstimateCmdArgs era + :: forall era + . Cmd.TransactionBuildEstimateCmdArgs era -> ExceptT TxCmdError IO () runTransactionBuildEstimateCmd -- TODO change type Cmd.TransactionBuildEstimateCmdArgs @@ -389,7 +390,7 @@ runTransactionBuildEstimateCmd -- TODO change type , txBodyOutFile } = do let sbe = inject currentEra - meo = babbageEraOnwardsToMaryEraOnwards $ inject currentEra + meo = inject @(BabbageEraOnwards era) $ inject currentEra ledgerPParams <- firstExceptT TxCmdProtocolParamsError $ readProtocolParameters sbe protocolParamsFile @@ -491,7 +492,7 @@ runTransactionBuildEstimateCmd -- TODO change type collectTxBodyScriptWitnesses sbe txBodyContent ] - BalancedTxBody _ unsignedTx _ _ <- + BalancedTxBody _ balancedTxBody _ _ <- hoistEither $ first TxCmdFeeEstimationError $ estimateBalancedTxBody @@ -509,8 +510,11 @@ runTransactionBuildEstimateCmd -- TODO change type (anyAddressInShelleyBasedEra sbe changeAddr) totalUTxOValue - let noWitTx = ShelleyTx sbe $ Exp.obtainCommonConstraints currentEra $ Exp.signTx currentEra [] [] unsignedTx - lift (writeTxFileTextEnvelopeCddl sbe txBodyOutFile noWitTx) + let noWitTx = makeSignedTransaction [] balancedTxBody + lift + ( cardanoEraConstraints (toCardanoEra meo) $ + writeTxFileTextEnvelopeCddl (inject meo) txBodyOutFile noWitTx + ) & onLeft (left . TxCmdWriteFileError) getPoolDeregistrationInfo From 3e9a647d212bc8d61c996f560dbe2a09e0f5c0c3 Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Wed, 20 Nov 2024 21:53:41 +0100 Subject: [PATCH 03/17] Bump cardano-api-10.3 --- cabal.project | 2 +- cardano-cli/cardano-cli.cabal | 2 +- cardano-cli/src/Cardano/CLI/Json/Friendly.hs | 2 +- flake.lock | 6 +++--- 4 files changed, 6 insertions(+), 6 deletions(-) diff --git a/cabal.project b/cabal.project index 1864d105fa..c84909c853 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 2024-10-11T15:49:11Z - , cardano-haskell-packages 2024-11-12T08:40:13Z + , cardano-haskell-packages 2024-11-20T20:05:41Z packages: cardano-cli diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index c920646133..dc141b728b 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -203,7 +203,7 @@ library binary, bytestring, canonical-json, - cardano-api ^>=10.2, + cardano-api ^>=10.3, cardano-binary, cardano-crypto, cardano-crypto-class ^>=2.1.2, diff --git a/cardano-cli/src/Cardano/CLI/Json/Friendly.hs b/cardano-cli/src/Cardano/CLI/Json/Friendly.hs index 6791c4b64d..70c48ec3d4 100644 --- a/cardano-cli/src/Cardano/CLI/Json/Friendly.hs +++ b/cardano-cli/src/Cardano/CLI/Json/Friendly.hs @@ -789,7 +789,7 @@ friendlyLovelace value = String $ docToText (pretty value) friendlyMintValue :: forall era. TxMintValue ViewTx era -> Aeson.Value friendlyMintValue = \case TxMintNone -> Null - TxMintValue sbe v _ -> friendlyValue ((inject sbe) :: ShelleyBasedEra era) v + txMintValue@(TxMintValue w _) -> friendlyValue @era (inject w) $ txMintValueToValue txMintValue friendlyTxOutValue :: TxOutValue era -> Aeson.Value friendlyTxOutValue = \case diff --git a/flake.lock b/flake.lock index 8a0d9daf9e..fa6ae379a3 100644 --- a/flake.lock +++ b/flake.lock @@ -3,11 +3,11 @@ "CHaP": { "flake": false, "locked": { - "lastModified": 1731401651, - "narHash": "sha256-tXaUck9+0Ob4h6GBlbhYMI4ekW5e8biVJU5jPT/rjus=", + "lastModified": 1732134025, + "narHash": "sha256-BBz3q09+DqDMYnLLgqXYyAxj9amVibxuEevHzgqL6UM=", "owner": "intersectmbo", "repo": "cardano-haskell-packages", - "rev": "82b295d6147a566c28dbcf038c54040f06f7e6b4", + "rev": "d36fcfb3c0f2632bdaf4637c72e91b93f7eada56", "type": "github" }, "original": { From 3a164af9222074ddba0039ad98a4514119a03fe1 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Mon, 18 Nov 2024 13:47:04 -0400 Subject: [PATCH 04/17] Add Cardano.CLI.Plutus.Minting module Define the data definition CliMintScriptRequirements This type makes it clearer that we require the policy id for transaction construction when using a minting script --- cardano-cli/src/Cardano/CLI/Plutus/Minting.hs | 200 ++++++++++++++++++ 1 file changed, 200 insertions(+) create mode 100644 cardano-cli/src/Cardano/CLI/Plutus/Minting.hs diff --git a/cardano-cli/src/Cardano/CLI/Plutus/Minting.hs b/cardano-cli/src/Cardano/CLI/Plutus/Minting.hs new file mode 100644 index 0000000000..aa51a3cb73 --- /dev/null +++ b/cardano-cli/src/Cardano/CLI/Plutus/Minting.hs @@ -0,0 +1,200 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} + +module Cardano.CLI.Plutus.Minting + ( CliMintScriptRequirements (..) + , MintScriptWitWithPolId (..) + , createOnDiskSimpleOfPlutusScriptCliArgs + , createOnDiskSimpleReferenceScriptCliArgs + , createOnDiskPlutusReferenceScriptCliArgs + , CliScriptWitnessError + , readMintScriptWitness + ) +where + +import Cardano.Api +import Cardano.Api.Shelley + +import Cardano.CLI.Read +import Cardano.CLI.Types.Common (ScriptDataOrFile) + +-- We always need the policy id when constructing a transaction that mints. +-- In the case of reference scripts, the user currently must provide the policy id (script hash) +-- in order to correctly construct the transaction. +data MintScriptWitWithPolId era + = MintScriptWitWithPolId + { mswPolId :: PolicyId + , mswScriptWitness :: ScriptWitness WitCtxMint era + } + deriving Show + +data OnDiskSimpleOrPlutusScriptCliArgs + = OnDiskSimpleScriptCliArgs + (File ScriptInAnyLang In) + | OnDiskPlutusScriptCliArgs + (File ScriptInAnyLang In) + ScriptDataOrFile + ExecutionUnits + deriving Show + +createOnDiskSimpleOfPlutusScriptCliArgs + :: File ScriptInAnyLang In + -> Maybe (ScriptDataOrFile, ExecutionUnits) + -> CliMintScriptRequirements +createOnDiskSimpleOfPlutusScriptCliArgs scriptFp Nothing = + OnDiskSimpleOrPlutusScript $ OnDiskSimpleScriptCliArgs scriptFp +createOnDiskSimpleOfPlutusScriptCliArgs scriptFp (Just (redeemerFile, execUnits)) = + OnDiskSimpleOrPlutusScript $ OnDiskPlutusScriptCliArgs scriptFp redeemerFile execUnits + +data SimpleRefScriptCliArgs + = SimpleRefScriptCliArgs + TxIn + PolicyId + deriving Show + +createOnDiskSimpleReferenceScriptCliArgs + :: TxIn + -> PolicyId + -> CliMintScriptRequirements +createOnDiskSimpleReferenceScriptCliArgs txin polid = + OnDiskSimpleRefScript $ SimpleRefScriptCliArgs txin polid + +data PlutusRefScriptCliArgs + = PlutusRefScriptCliArgs + TxIn + AnyPlutusScriptVersion + ScriptDataOrFile + ExecutionUnits + PolicyId + deriving Show + +createOnDiskPlutusReferenceScriptCliArgs + :: TxIn + -> AnyPlutusScriptVersion + -> ScriptDataOrFile + -> ExecutionUnits + -> PolicyId + -> CliMintScriptRequirements +createOnDiskPlutusReferenceScriptCliArgs txin scriptVersion scriptData execUnits polid = + OnDiskPlutusRefScript $ PlutusRefScriptCliArgs txin scriptVersion scriptData execUnits polid + +data CliMintScriptRequirements + = OnDiskSimpleOrPlutusScript OnDiskSimpleOrPlutusScriptCliArgs + | OnDiskSimpleRefScript SimpleRefScriptCliArgs + | OnDiskPlutusRefScript PlutusRefScriptCliArgs + deriving Show + +data CliScriptWitnessError + = SimpleScriptWitnessDecodeError ScriptDecodeError + | PlutusScriptWitnessDecodeError PlutusScriptDecodeError + | PlutusScriptWitnessLanguageNotSupportedInEra + AnyPlutusScriptVersion + AnyShelleyBasedEra + | PlutusScriptWitnessRedeemerError ScriptDataError + +instance Error CliScriptWitnessError where + prettyError = \case + SimpleScriptWitnessDecodeError err -> prettyError err + PlutusScriptWitnessDecodeError err -> prettyError err + PlutusScriptWitnessLanguageNotSupportedInEra version era -> + "Plutus script version " <> pshow version <> " is not supported in era " <> pshow era + PlutusScriptWitnessRedeemerError err -> renderScriptDataError err + +readMintScriptWitness + :: MonadIOTransError (FileError CliScriptWitnessError) t m + => ShelleyBasedEra era -> CliMintScriptRequirements -> t m (MintScriptWitWithPolId era) +readMintScriptWitness sbe (OnDiskSimpleOrPlutusScript simpleOrPlutus) = + case simpleOrPlutus of + OnDiskSimpleScriptCliArgs simpleFp -> do + let sFp = unFile simpleFp + s <- + modifyError (fmap SimpleScriptWitnessDecodeError) $ readFileSimpleScript sFp + case s of + SimpleScript ss -> do + let polId = PolicyId $ hashScript s + return $ + MintScriptWitWithPolId polId $ + SimpleScriptWitness (sbeToSimpleScriptLangInEra sbe) $ + SScript ss + OnDiskPlutusScriptCliArgs plutusScriptFp redeemerFile execUnits -> do + let sFp = unFile plutusScriptFp + plutusScript <- + modifyError (fmap PlutusScriptWitnessDecodeError) $ + readFilePlutusScript $ + unFile plutusScriptFp + + redeemer <- + modifyError (FileError sFp . PlutusScriptWitnessRedeemerError) $ + readScriptDataOrFile redeemerFile + case plutusScript of + AnyPlutusScript lang script -> do + let pScript = PScript script + polId = PolicyId $ hashScript $ PlutusScript lang script + sLangSupported <- + modifyError (FileError sFp) + $ hoistMaybe + ( PlutusScriptWitnessLanguageNotSupportedInEra + (AnyPlutusScriptVersion lang) + (shelleyBasedEraConstraints sbe $ AnyShelleyBasedEra sbe) + ) + $ scriptLanguageSupportedInEra sbe + $ PlutusScriptLanguage lang + return $ + MintScriptWitWithPolId polId $ + PlutusScriptWitness + sLangSupported + lang + pScript + NoScriptDatumForMint + redeemer + execUnits +readMintScriptWitness sbe (OnDiskSimpleRefScript (SimpleRefScriptCliArgs refTxIn polId)) = + return $ + MintScriptWitWithPolId polId $ + SimpleScriptWitness + (sbeToSimpleScriptLangInEra sbe) + (SReferenceScript refTxIn $ Just $ unPolicyId polId) +readMintScriptWitness + sbe + ( OnDiskPlutusRefScript + (PlutusRefScriptCliArgs refTxIn anyPlutusScriptVersion redeemerFile execUnits polId) + ) = do + case anyPlutusScriptVersion of + AnyPlutusScriptVersion lang -> do + let pScript = PReferenceScript refTxIn $ Just $ unPolicyId polId + redeemer <- + -- TODO: Implement a new error type to capture this. FileError is not representative of cases + -- where we do not have access to the script. + modifyError (FileError "Reference script filepath not available" . PlutusScriptWitnessRedeemerError) $ + readScriptDataOrFile redeemerFile + sLangSupported <- + -- TODO: Implement a new error type to capture this. FileError is not representative of cases + -- where we do not have access to the script. + modifyError (FileError "Reference script filepath not available") + $ hoistMaybe + ( PlutusScriptWitnessLanguageNotSupportedInEra + (AnyPlutusScriptVersion lang) + (shelleyBasedEraConstraints sbe $ AnyShelleyBasedEra sbe) + ) + $ scriptLanguageSupportedInEra sbe + $ PlutusScriptLanguage lang + return $ + MintScriptWitWithPolId polId $ + PlutusScriptWitness + sLangSupported + lang + pScript + NoScriptDatumForMint + redeemer + execUnits + +sbeToSimpleScriptLangInEra + :: ShelleyBasedEra era -> ScriptLanguageInEra SimpleScript' era +sbeToSimpleScriptLangInEra ShelleyBasedEraShelley = SimpleScriptInShelley +sbeToSimpleScriptLangInEra ShelleyBasedEraAllegra = SimpleScriptInAllegra +sbeToSimpleScriptLangInEra ShelleyBasedEraMary = SimpleScriptInMary +sbeToSimpleScriptLangInEra ShelleyBasedEraAlonzo = SimpleScriptInAlonzo +sbeToSimpleScriptLangInEra ShelleyBasedEraBabbage = SimpleScriptInBabbage +sbeToSimpleScriptLangInEra ShelleyBasedEraConway = SimpleScriptInConway From 8426cdb54226997151de429aca6d24b89c27b5ea Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Mon, 18 Nov 2024 14:06:15 -0400 Subject: [PATCH 05/17] Refine plutusP to return AnyPlutusScriptVersion instead of AnyScriptLanguage Replace ScriptWitnessFiles WitCtxMint with CliMintScriptRequirements --- .../Cardano/CLI/EraBased/Options/Common.hs | 71 +++++++++++-------- 1 file changed, 41 insertions(+), 30 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs index 8f5a50be6d..1a23642838 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs @@ -19,6 +19,7 @@ import Cardano.Api.Shelley import Cardano.CLI.Environment (EnvCli (..), envCliAnyEon) import Cardano.CLI.Parser +import Cardano.CLI.Plutus.Minting import Cardano.CLI.Read import Cardano.CLI.Types.Common import Cardano.CLI.Types.Governance @@ -1006,6 +1007,28 @@ pPollNonce = -------------------------------------------------------------------------------- +pMintScriptFile :: Parser (File ScriptInAnyLang In) +pMintScriptFile = + pScriptFor + "mint-script-file" + (Just "minting-script-file") + "The file containing the script to witness the minting of assets for a particular policy Id." + +pPlutusMintScriptWitnessData + :: ShelleyBasedEra era + -> WitCtx witctx + -> BalanceTxExecUnits + -> Parser (ScriptDataOrFile, ExecutionUnits) +pPlutusMintScriptWitnessData _sbe _witctx autoBalanceExecUnits = + let scriptFlagPrefix = "mint" + in ( (,) + <$> pScriptRedeemerOrFile scriptFlagPrefix + <*> ( case autoBalanceExecUnits of + AutoBalance -> pure (ExecutionUnits 0 0) + ManualBalance -> pExecutionUnits scriptFlagPrefix + ) + ) + pScriptWitnessFiles :: forall witctx era . ShelleyBasedEra era @@ -1535,13 +1558,15 @@ pPlutusStakeReferenceScriptWitnessFiles prefix autoBalanceExecUnits = ) <*> pure Nothing -pPlutusScriptLanguage :: String -> Parser AnyScriptLanguage +pPlutusScriptLanguage :: String -> Parser AnyPlutusScriptVersion pPlutusScriptLanguage prefix = plutusP prefix PlutusScriptV2 "v2" <|> plutusP prefix PlutusScriptV3 "v3" -plutusP :: String -> PlutusScriptVersion lang -> String -> Parser AnyScriptLanguage +plutusP + :: IsPlutusScriptLanguage lang + => String -> PlutusScriptVersion lang -> String -> Parser AnyPlutusScriptVersion plutusP prefix plutusVersion versionString = Opt.flag' - (AnyScriptLanguage $ PlutusScriptLanguage plutusVersion) + (AnyPlutusScriptVersion plutusVersion) ( Opt.long (prefix <> "plutus-script-" <> versionString) <> Opt.help ("Specify a plutus script " <> versionString <> " reference script.") ) @@ -1954,7 +1979,7 @@ pTxIn sbe balance = where createPlutusReferenceScriptWitnessFiles :: TxIn - -> AnyScriptLanguage + -> AnyPlutusScriptVersion -> ScriptDatumOrFile WitCtxTxIn -> ScriptRedeemerOrFile -> ExecutionUnits @@ -2132,7 +2157,7 @@ pRefScriptFp = pMintMultiAsset :: ShelleyBasedEra era -> BalanceTxExecUnits - -> Parser (Value, [ScriptWitnessFiles WitCtxMint]) + -> Parser (Value, [CliMintScriptRequirements]) pMintMultiAsset sbe balanceExecUnits = (,) <$> Opt.option @@ -2142,49 +2167,35 @@ pMintMultiAsset sbe balanceExecUnits = <> Opt.help helpText ) <*> some - ( pMintingScriptOrReferenceScriptWit balanceExecUnits + ( pMintingScript <|> pSimpleReferenceMintingScriptWitness <|> pPlutusMintReferenceScriptWitnessFiles balanceExecUnits ) where - pMintingScriptOrReferenceScriptWit - :: BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxMint) - pMintingScriptOrReferenceScriptWit bExecUnits = - pScriptWitnessFiles - sbe - WitCtxMint - bExecUnits - "mint" - (Just "minting") - "the minting of assets for a particular policy Id." + pMintingScript :: Parser CliMintScriptRequirements + pMintingScript = + createOnDiskSimpleOfPlutusScriptCliArgs + <$> pMintScriptFile + <*> optional (pPlutusMintScriptWitnessData sbe WitCtxMint balanceExecUnits) - pSimpleReferenceMintingScriptWitness :: Parser (ScriptWitnessFiles WitCtxMint) + pSimpleReferenceMintingScriptWitness :: Parser CliMintScriptRequirements pSimpleReferenceMintingScriptWitness = - createSimpleMintingReferenceScriptWitnessFiles + createOnDiskSimpleReferenceScriptCliArgs <$> pReferenceTxIn "simple-minting-script-" "simple" <*> pPolicyId - where - createSimpleMintingReferenceScriptWitnessFiles - :: TxIn - -> PolicyId - -> ScriptWitnessFiles WitCtxMint - createSimpleMintingReferenceScriptWitnessFiles refTxIn pid = - let simpleLang = AnyScriptLanguage SimpleScriptLanguage - in SimpleReferenceScriptWitnessFiles refTxIn simpleLang (Just pid) pPlutusMintReferenceScriptWitnessFiles - :: BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxMint) + :: BalanceTxExecUnits -> Parser CliMintScriptRequirements pPlutusMintReferenceScriptWitnessFiles autoBalanceExecUnits = - PlutusReferenceScriptWitnessFiles + createOnDiskPlutusReferenceScriptCliArgs <$> pReferenceTxIn "mint-" "plutus" <*> pPlutusScriptLanguage "mint-" - <*> pure NoScriptDatumOrFileForMint <*> pScriptRedeemerOrFile "mint-reference-tx-in" <*> ( case autoBalanceExecUnits of AutoBalance -> pure (ExecutionUnits 0 0) ManualBalance -> pExecutionUnits "mint-reference-tx-in" ) - <*> (Just <$> pPolicyId) + <*> pPolicyId helpText = mconcat From d4d37536c43611fbfff9d43020bf44eedd876eb9 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Mon, 18 Nov 2024 14:11:58 -0400 Subject: [PATCH 06/17] Modify PlutusReferenceScriptWitnessFiles to accept AnyPlutusScriptVersion instead of AnyScriptLanguage --- cardano-cli/src/Cardano/CLI/Types/Common.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/cardano-cli/src/Cardano/CLI/Types/Common.hs b/cardano-cli/src/Cardano/CLI/Types/Common.hs index c4d65f2498..492ae1a746 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Common.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Common.hs @@ -9,6 +9,7 @@ module Cardano.CLI.Types.Common ( AllOrOnly (..) , AddressKeyType (..) + , AnyPlutusScriptVersion (..) , BalanceTxExecUnits (..) , BlockId (..) , ByronKeyFormat (..) @@ -416,7 +417,7 @@ data ScriptWitnessFiles witctx where -- TODO: Need to figure out how to exclude PlutusV1 scripts at the type level PlutusReferenceScriptWitnessFiles :: TxIn - -> AnyScriptLanguage + -> AnyPlutusScriptVersion -> ScriptDatumOrFile witctx -> ScriptRedeemerOrFile -> ExecutionUnits From b2ac54899e05b85ab418616a39e254700a33f9e8 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Mon, 18 Nov 2024 14:12:52 -0400 Subject: [PATCH 07/17] Implement readFileSimpleScript and readFilePlutusScript Refactor readScriptWitness and eliminate invalid states Factor out fromSomeTypeSimpleScript and fromSomeTypePlutusScripts fromSomeTypePlutusScripts should automatically be updated as soon as the Enum AnyPlutusScriptVersion instance is updated in cardano-api --- cardano-cli/src/Cardano/CLI/Read.hs | 179 ++++++++++++++++++++++------ 1 file changed, 140 insertions(+), 39 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/Read.hs b/cardano-cli/src/Cardano/CLI/Read.hs index d1339d00a2..d59d86ac29 100644 --- a/cardano-cli/src/Cardano/CLI/Read.hs +++ b/cardano-cli/src/Cardano/CLI/Read.hs @@ -6,6 +6,7 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeFamilies #-} module Cardano.CLI.Read ( -- * Metadata @@ -24,6 +25,10 @@ module Cardano.CLI.Read , ScriptDecodeError (..) , deserialiseScriptInAnyLang , readFileScriptInAnyLang + , readFileSimpleScript + , AnyPlutusScript (..) + , PlutusScriptDecodeError (..) + , readFilePlutusScript -- * Script data (datums and redeemers) , ScriptDataError (..) @@ -348,7 +353,7 @@ readScriptWitness era ( PlutusReferenceScriptWitnessFiles refTxIn - anyScrLang@(AnyScriptLanguage anyScriptLanguage) + (AnyPlutusScriptVersion version) datumOrFile redeemerOrFile execUnits @@ -361,31 +366,28 @@ readScriptWitness cardanoEraConstraints (toCardanoEra era) (AnyShelleyBasedEra era) ) ( const $ - case scriptLanguageSupportedInEra era anyScriptLanguage of + case scriptLanguageSupportedInEra era $ PlutusScriptLanguage version of Just sLangInEra -> - case languageOfScriptLanguageInEra sLangInEra of - SimpleScriptLanguage -> - -- TODO: We likely need another datatype eg data ReferenceScriptWitness lang - -- in order to make this branch unrepresentable. - error "readScriptWitness: Should not be possible to specify a simple script" - PlutusScriptLanguage version -> do - datum <- - firstExceptT ScriptWitnessErrorScriptData $ - readScriptDatumOrFile datumOrFile - redeemer <- - firstExceptT ScriptWitnessErrorScriptData $ - readScriptRedeemerOrFile redeemerOrFile - return $ - PlutusScriptWitness - sLangInEra - version - (PReferenceScript refTxIn (unPolicyId <$> mPid)) - datum - redeemer - execUnits + do + datum <- + firstExceptT ScriptWitnessErrorScriptData $ + readScriptDatumOrFile datumOrFile + redeemer <- + firstExceptT ScriptWitnessErrorScriptData $ + readScriptRedeemerOrFile redeemerOrFile + return $ + PlutusScriptWitness + sLangInEra + version + (PReferenceScript refTxIn (unPolicyId <$> mPid)) + datum + redeemer + execUnits Nothing -> left $ - ScriptWitnessErrorScriptLanguageNotSupportedInEra anyScrLang (anyCardanoEra $ toCardanoEra era) + ScriptWitnessErrorScriptLanguageNotSupportedInEra + (AnyScriptLanguage $ PlutusScriptLanguage version) + (anyCardanoEra $ toCardanoEra era) ) era readScriptWitness @@ -472,8 +474,9 @@ readScriptRedeemerOrFile readScriptRedeemerOrFile = readScriptDataOrFile readScriptDataOrFile - :: ScriptDataOrFile - -> ExceptT ScriptDataError IO HashableScriptData + :: MonadIO m + => ScriptDataOrFile + -> ExceptT ScriptDataError m HashableScriptData readScriptDataOrFile (ScriptDataValue d) = return d readScriptDataOrFile (ScriptDataJsonFile fp) = do sDataBs <- handleIOExceptT (ScriptDataErrorFile . FileIOError fp) $ LBS.readFile fp @@ -565,20 +568,118 @@ deserialiseScriptInAnyLang bs = -- TODO: Think of a way to get type checker to warn when there is a missing -- script version. textEnvTypes :: [FromSomeType HasTextEnvelope ScriptInAnyLang] - textEnvTypes = - [ FromSomeType - (AsScript AsSimpleScript) - (ScriptInAnyLang SimpleScriptLanguage) - , FromSomeType - (AsScript AsPlutusScriptV1) - (ScriptInAnyLang (PlutusScriptLanguage PlutusScriptV1)) - , FromSomeType - (AsScript AsPlutusScriptV2) - (ScriptInAnyLang (PlutusScriptLanguage PlutusScriptV2)) - , FromSomeType - (AsScript AsPlutusScriptV3) - (ScriptInAnyLang (PlutusScriptLanguage PlutusScriptV3)) - ] + textEnvTypes = fromSomeTypeSimpleScript : fromSomeTypePlutusScripts + +fromSomeTypeSimpleScript :: FromSomeType HasTextEnvelope ScriptInAnyLang +fromSomeTypeSimpleScript = + FromSomeType + (AsScript AsSimpleScript) + (ScriptInAnyLang SimpleScriptLanguage) + +fromSomeTypePlutusScripts :: [FromSomeType HasTextEnvelope ScriptInAnyLang] +fromSomeTypePlutusScripts = + let allPlutusVersions :: [AnyPlutusScriptVersion] = [minBound .. maxBound] + in [plutusScriptVersionFromSomeType v | AnyPlutusScriptVersion v <- allPlutusVersions] + where + plutusScriptVersionFromSomeType + :: IsPlutusScriptLanguage lang + => PlutusScriptVersion lang -> FromSomeType HasTextEnvelope ScriptInAnyLang + plutusScriptVersionFromSomeType v = + FromSomeType + (AsScript $ proxyToAsType (Proxy :: Proxy lang)) + (ScriptInAnyLang $ PlutusScriptLanguage v) + +readFileSimpleScript + :: MonadIOTransError (FileError ScriptDecodeError) t m + => FilePath + -> t m (Script SimpleScript') +readFileSimpleScript file = do + scriptBytes <- handleIOExceptionsLiftWith (FileIOError file) . liftIO $ BS.readFile file + modifyError (FileError file) $ + hoistEither $ + deserialiseSimpleScript scriptBytes + +deserialiseSimpleScript + :: BS.ByteString + -> Either ScriptDecodeError (Script SimpleScript') +deserialiseSimpleScript bs = + case deserialiseFromJSON AsTextEnvelope bs of + Left _ -> + -- In addition to the TextEnvelope format, we also try to + -- deserialize the JSON representation of SimpleScripts. + case Aeson.eitherDecodeStrict' bs of + Left err -> Left (ScriptDecodeSimpleScriptError $ JsonDecodeError err) + Right script -> Right $ SimpleScript script + Right te -> + case deserialiseFromTextEnvelopeAnyOf [teType'] te of + Left err -> Left (ScriptDecodeTextEnvelopeError err) + Right script -> Right script + where + teType' :: FromSomeType HasTextEnvelope (Script SimpleScript') + teType' = FromSomeType (AsScript AsSimpleScript) id + +readFilePlutusScript + :: MonadIOTransError (FileError PlutusScriptDecodeError) t m + => FilePath + -> t m AnyPlutusScript +readFilePlutusScript plutusScriptFp = do + bs <- + handleIOExceptionsLiftWith (FileIOError plutusScriptFp) . liftIO $ + BS.readFile plutusScriptFp + modifyError (FileError plutusScriptFp) $ + hoistEither $ + deserialisePlutusScript bs + +data PlutusScriptDecodeError + = PlutusScriptDecodeErrorUnknownVersion !Text + | PlutusScriptJsonDecodeError !JsonDecodeError + | PlutusScriptDecodeTextEnvelopeError !TextEnvelopeError + +instance Error PlutusScriptDecodeError where + prettyError = \case + PlutusScriptDecodeErrorUnknownVersion version -> + "Unknown Plutus script version: " <> pretty version + PlutusScriptJsonDecodeError err -> + prettyError err + PlutusScriptDecodeTextEnvelopeError err -> + prettyError err + +deserialisePlutusScript + :: BS.ByteString + -> Either PlutusScriptDecodeError AnyPlutusScript +deserialisePlutusScript bs = + case deserialiseFromJSON AsTextEnvelope bs of + Left err -> Left $ PlutusScriptJsonDecodeError err + Right te -> + case teType te of + "PlutusScriptV1" -> + case deserialiseFromTextEnvelopeAnyOf [teTypes (AnyPlutusScriptVersion PlutusScriptV1)] te of + Left err -> Left (PlutusScriptDecodeTextEnvelopeError err) + Right script -> Right script + "PlutusScriptV2" -> + case deserialiseFromTextEnvelopeAnyOf [teTypes (AnyPlutusScriptVersion PlutusScriptV2)] te of + Left err -> Left (PlutusScriptDecodeTextEnvelopeError err) + Right script -> Right script + "PlutusScriptV3" -> + case deserialiseFromTextEnvelopeAnyOf [teTypes (AnyPlutusScriptVersion PlutusScriptV3)] te of + Left err -> Left (PlutusScriptDecodeTextEnvelopeError err) + Right script -> Right script + (TextEnvelopeType unknownScriptVersion) -> + Left . PlutusScriptDecodeErrorUnknownVersion $ Text.pack unknownScriptVersion + where + teTypes :: AnyPlutusScriptVersion -> FromSomeType HasTextEnvelope AnyPlutusScript + teTypes = + \case + AnyPlutusScriptVersion PlutusScriptV1 -> + FromSomeType (AsPlutusScript AsPlutusScriptV1) (AnyPlutusScript PlutusScriptV1) + AnyPlutusScriptVersion PlutusScriptV2 -> + FromSomeType (AsPlutusScript AsPlutusScriptV2) (AnyPlutusScript PlutusScriptV2) + AnyPlutusScriptVersion PlutusScriptV3 -> + FromSomeType (AsPlutusScript AsPlutusScriptV3) (AnyPlutusScript PlutusScriptV3) + +data AnyPlutusScript where + AnyPlutusScript + :: IsPlutusScriptLanguage lang => PlutusScriptVersion lang -> PlutusScript lang -> AnyPlutusScript -- Tx & TxBody From 5c276ae40597d6988bd610fd3353681a555651c5 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Mon, 18 Nov 2024 14:20:41 -0400 Subject: [PATCH 08/17] Replace ScriptWitnessFiles WitCtxMint with CliMintScriptRequirements --- .../src/Cardano/CLI/EraBased/Commands/Transaction.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs index dd9b2604f1..5cc225d40b 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs @@ -25,6 +25,7 @@ import qualified Cardano.Api.Experimental as Exp import Cardano.Api.Ledger (Coin) import Cardano.Api.Shelley +import Cardano.CLI.Plutus.Minting import Cardano.CLI.Types.Common import Cardano.CLI.Types.Governance @@ -61,7 +62,7 @@ data TransactionBuildRawCmdArgs era = TransactionBuildRawCmdArgs , requiredSigners :: ![RequiredSigner] -- ^ Required signers , txouts :: ![TxOutAnyEra] - , mValue :: !(Maybe (Value, [ScriptWitnessFiles WitCtxMint])) + , mValue :: !(Maybe (Value, [CliMintScriptRequirements])) -- ^ Multi-Asset value with script witness , mValidityLowerBound :: !(Maybe SlotNo) -- ^ Transaction validity lower bound @@ -111,7 +112,7 @@ data TransactionBuildCmdArgs era = TransactionBuildCmdArgs -- ^ Normal outputs , changeAddresses :: !TxOutChangeAddress -- ^ A change output - , mValue :: !(Maybe (Value, [ScriptWitnessFiles WitCtxMint])) + , mValue :: !(Maybe (Value, [CliMintScriptRequirements])) -- ^ Multi-Asset value with script witness , mValidityLowerBound :: !(Maybe SlotNo) -- ^ Transaction validity lower bound @@ -157,7 +158,7 @@ data TransactionBuildEstimateCmdArgs era = TransactionBuildEstimateCmdArgs -- ^ Normal outputs , changeAddress :: !TxOutChangeAddress -- ^ A change output - , mValue :: !(Maybe (Value, [ScriptWitnessFiles WitCtxMint])) + , mValue :: !(Maybe (Value, [CliMintScriptRequirements])) -- ^ Multi-Asset value with script witness , mValidityLowerBound :: !(Maybe SlotNo) -- ^ Transaction validity lower bound From d7a6085fc0a8b05c5a70c03904514e9aff848569 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Mon, 18 Nov 2024 14:35:51 -0400 Subject: [PATCH 09/17] Propagate MintScriptWitWithPolId era --- .../Cardano/CLI/EraBased/Run/Transaction.hs | 33 +++++++++++++------ 1 file changed, 23 insertions(+), 10 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs index 84bd01350e..4de5d5e967 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs @@ -50,6 +50,7 @@ import Cardano.CLI.EraBased.Run.Genesis.Common (readProtocolParameters import Cardano.CLI.EraBased.Run.Query import Cardano.CLI.EraBased.Transaction.HashCheck (checkCertificateHashes, checkProposalHashes, checkVotingProcedureHashes) +import Cardano.CLI.Plutus.Minting import Cardano.CLI.Read import Cardano.CLI.Types.Common import Cardano.CLI.Types.Errors.BootstrapWitnessError @@ -175,7 +176,9 @@ runTransactionBuildCmd txMetadata <- firstExceptT TxCmdMetadataError . newExceptT $ readTxMetadata eon metadataSchema metadataFiles - valuesWithScriptWits <- readValueScriptWitnesses eon $ fromMaybe mempty mValue + let (mas, sWitFiles) = fromMaybe (mempty, mempty) mValue + usedToGetReferenceInputs <- + (mas,) <$> firstExceptT TxCmdCliScriptWitnessError (mapM (readMintScriptWitness eon) sWitFiles) scripts <- firstExceptT TxCmdScriptFileError $ mapM (readFileScriptInAnyLang . unFile) scriptFiles @@ -253,7 +256,7 @@ runTransactionBuildCmd let allReferenceInputs = getAllReferenceInputs inputsAndMaybeScriptWits - (snd valuesWithScriptWits) + (map mswScriptWitness $ snd usedToGetReferenceInputs) certsAndMaybeScriptWits withdrawalsAndMaybeScriptWits votingProceduresAndMaybeScriptWits @@ -278,6 +281,8 @@ runTransactionBuildCmd & onLeft (left . TxCmdQueryConvenienceError . AcqFailure) & onLeft (left . TxCmdQueryConvenienceError) + valuesWithScriptWits <- + (mas,) <$> firstExceptT TxCmdCliScriptWitnessError (mapM (readMintScriptWitness eon) sWitFiles) let currentTreasuryValueAndDonation = case (treasuryDonation, unFeatured <$> featuredCurrentTreasuryValueM) of (Nothing, _) -> Nothing -- We shouldn't specify the treasury value when no donation is being done @@ -408,7 +413,11 @@ runTransactionBuildEstimateCmd -- TODO change type firstExceptT TxCmdMetadataError . newExceptT $ readTxMetadata sbe metadataSchema metadataFiles - valuesWithScriptWits <- readValueScriptWitnesses sbe $ fromMaybe mempty mValue + + let (mas, sWitFiles) = fromMaybe (mempty, mempty) mValue + valuesWithScriptWits <- + (mas,) <$> firstExceptT TxCmdCliScriptWitnessError (mapM (readMintScriptWitness sbe) sWitFiles) + scripts <- firstExceptT TxCmdScriptFileError $ mapM (readFileScriptInAnyLang . unFile) scriptFiles @@ -645,7 +654,11 @@ runTransactionBuildRawCmd firstExceptT TxCmdMetadataError . newExceptT $ readTxMetadata eon metadataSchema metadataFiles - valuesWithScriptWits <- readValueScriptWitnesses eon $ fromMaybe mempty mValue + + let (mas, sWitFiles) = fromMaybe (mempty, mempty) mValue + valuesWithScriptWits <- + (mas,) <$> firstExceptT TxCmdCliScriptWitnessError (mapM (readMintScriptWitness eon) sWitFiles) + scripts <- firstExceptT TxCmdScriptFileError $ mapM (readFileScriptInAnyLang . unFile) scriptFiles @@ -749,7 +762,7 @@ runTxBuildRaw -- ^ Tx upper bound -> Lovelace -- ^ Tx fee - -> (Value, [ScriptWitness WitCtxMint era]) + -> (Value, [MintScriptWitWithPolId era]) -- ^ Multi-Asset value(s) -> [(Certificate era, Maybe (ScriptWitness WitCtxStake era))] -- ^ Certificate with potential script witness @@ -835,7 +848,7 @@ constructTxBodyContent -- ^ Tx lower bound -> TxValidityUpperBound era -- ^ Tx upper bound - -> (Value, [ScriptWitness WitCtxMint era]) + -> (Value, [MintScriptWitWithPolId era]) -- ^ Multi-Asset value(s) -> [(Certificate era, Maybe (ScriptWitness WitCtxStake era))] -- ^ Certificate with potential script witness @@ -882,7 +895,7 @@ constructTxBodyContent let allReferenceInputs = getAllReferenceInputs inputsAndMaybeScriptWits - (snd valuesWithScriptWits) + (map mswScriptWitness $ snd valuesWithScriptWits) certsAndMaybeScriptWits withdrawals votingProcedures @@ -975,7 +988,7 @@ runTxBuild -- ^ Normal outputs -> TxOutChangeAddress -- ^ A change output - -> (Value, [ScriptWitness WitCtxMint era]) + -> (Value, [MintScriptWitWithPolId era]) -- ^ Multi-Asset value(s) -> Maybe SlotNo -- ^ Tx lower bound @@ -1029,7 +1042,7 @@ runTxBuild let allReferenceInputs = getAllReferenceInputs inputsAndMaybeScriptWits - (snd valuesWithScriptWits) + (map mswScriptWitness $ snd valuesWithScriptWits) certsAndMaybeScriptWits withdrawals votingProcedures @@ -1380,7 +1393,7 @@ toTxAlonzoDatum supp cliDatum = createTxMintValue :: forall era . ShelleyBasedEra era - -> (Value, [ScriptWitness WitCtxMint era]) + -> (Value, [MintScriptWitWithPolId era]) -> Either TxCmdError (TxMintValue BuildTx era) createTxMintValue era (val, scriptWitnesses) = if List.null (toList val) && List.null scriptWitnesses From e567a54013a5fcdcd4fd4e3955f9df0ba09b6715 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Mon, 18 Nov 2024 14:36:44 -0400 Subject: [PATCH 10/17] Remove gatherMintingWitnesses because by default we require a PolicyId --- .../Cardano/CLI/EraBased/Run/Transaction.hs | 29 +------------------ 1 file changed, 1 insertion(+), 28 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs index 4de5d5e967..1636c738fb 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs @@ -1408,7 +1408,7 @@ createTxMintValue era (val, scriptWitnesses) = fromList [pid | (AssetId pid _, _) <- toList val] let witnessesProvidedMap :: Map PolicyId (ScriptWitness WitCtxMint era) - witnessesProvidedMap = fromList $ gatherMintingWitnesses scriptWitnesses + witnessesProvidedMap = fromList $ [(polid, sWit) | MintScriptWitWithPolId polid sWit <- scriptWitnesses] witnessesProvidedSet = Map.keysSet witnessesProvidedMap -- Check not too many, nor too few: @@ -1418,15 +1418,6 @@ createTxMintValue era (val, scriptWitnesses) = ) era where - gatherMintingWitnesses - :: [ScriptWitness WitCtxMint era] - -> [(PolicyId, ScriptWitness WitCtxMint era)] - gatherMintingWitnesses [] = [] - gatherMintingWitnesses (sWit : rest) = - case scriptWitnessPolicyId sWit of - Nothing -> gatherMintingWitnesses rest - Just pid -> (pid, sWit) : gatherMintingWitnesses rest - validateAllWitnessesProvided witnessesNeeded witnessesProvided | null witnessesMissing = return () | otherwise = Left (TxCmdPolicyIdsMissing witnessesMissing (toList witnessesProvided)) @@ -1439,24 +1430,6 @@ createTxMintValue era (val, scriptWitnesses) = where witnessesExtra = Set.elems (witnessesProvided Set.\\ witnessesNeeded) -scriptWitnessPolicyId :: ScriptWitness witctx era -> Maybe PolicyId -scriptWitnessPolicyId (SimpleScriptWitness _ (SScript script)) = - Just . scriptPolicyId $ SimpleScript script -scriptWitnessPolicyId (SimpleScriptWitness _ (SReferenceScript _ mPid)) = - PolicyId <$> mPid -scriptWitnessPolicyId (PlutusScriptWitness _ version (PScript script) _ _ _) = - Just . scriptPolicyId $ PlutusScript version script -scriptWitnessPolicyId (PlutusScriptWitness _ _ (PReferenceScript _ mPid) _ _ _) = - PolicyId <$> mPid - -readValueScriptWitnesses - :: ShelleyBasedEra era - -> (Value, [ScriptWitnessFiles WitCtxMint]) - -> ExceptT TxCmdError IO (Value, [ScriptWitness WitCtxMint era]) -readValueScriptWitnesses era (v, sWitFiles) = do - sWits <- mapM (firstExceptT TxCmdScriptWitnessError . readScriptWitness era) sWitFiles - return (v, sWits) - -- ---------------------------------------------------------------------------- -- Transaction signing -- From 34281ab4b269b4778f99db9f122ed979e149f1d0 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Mon, 18 Nov 2024 15:10:11 -0400 Subject: [PATCH 11/17] Add TxCmdCliScriptWitnessError to TxCmdError Add ScriptDecodeUnknownPlutusScriptVersion to ScriptDecodeError --- cardano-cli/cardano-cli.cabal | 1 + .../src/Cardano/CLI/Types/Errors/ScriptDecodeError.hs | 5 +++++ cardano-cli/src/Cardano/CLI/Types/Errors/TxCmdError.hs | 4 ++++ 3 files changed, 10 insertions(+) diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index dc141b728b..175fefa4d9 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -135,6 +135,7 @@ library Cardano.CLI.Options.Key Cardano.CLI.Options.Node Cardano.CLI.Options.Ping + Cardano.CLI.Plutus.Minting Cardano.CLI.Orphans Cardano.CLI.Parser Cardano.CLI.Read diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/ScriptDecodeError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/ScriptDecodeError.hs index 2b4c37c9c6..7ba879c591 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Errors/ScriptDecodeError.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/ScriptDecodeError.hs @@ -7,6 +7,8 @@ where import Cardano.Api +import Data.Text + -- -- Handling decoding the variety of script languages and formats -- @@ -14,6 +16,7 @@ import Cardano.Api data ScriptDecodeError = ScriptDecodeTextEnvelopeError TextEnvelopeError | ScriptDecodeSimpleScriptError JsonDecodeError + | ScriptDecodeUnknownPlutusScriptVersion Text deriving Show instance Error ScriptDecodeError where @@ -22,3 +25,5 @@ instance Error ScriptDecodeError where "Error decoding script: " <> prettyError err ScriptDecodeSimpleScriptError err -> "Syntax error in script: " <> prettyError err + ScriptDecodeUnknownPlutusScriptVersion version -> + "Unknown Plutus script version: " <> pshow version diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/TxCmdError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/TxCmdError.hs index 19582fba41..87820b3b79 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Errors/TxCmdError.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/TxCmdError.hs @@ -19,6 +19,7 @@ import Cardano.Api.Consensus (EraMismatch (..)) import qualified Cardano.Api.Ledger as L import Cardano.Api.Shelley +import Cardano.CLI.Plutus.Minting import Cardano.CLI.Read import Cardano.CLI.Types.Common import Cardano.CLI.Types.Errors.BootstrapWitnessError @@ -50,6 +51,7 @@ data TxCmdError | TxCmdScriptWitnessError ScriptWitnessError | TxCmdProtocolParamsError ProtocolParamsError | TxCmdScriptFileError (FileError ScriptDecodeError) + | TxCmdCliScriptWitnessError !(FileError CliScriptWitnessError) | TxCmdKeyFileError (FileError InputDecodeError) | TxCmdReadTextViewFileError !(FileError TextEnvelopeError) | TxCmdReadWitnessSigningDataError !ReadWitnessSigningDataError @@ -105,6 +107,8 @@ renderTxCmdError = \case prettyError fileErr TxCmdScriptFileError fileErr -> prettyError fileErr + TxCmdCliScriptWitnessError cliScriptWitnessErr -> + prettyError cliScriptWitnessErr TxCmdKeyFileError fileErr -> prettyError fileErr TxCmdReadWitnessSigningDataError witSignDataErr -> From 8453b12b7f8600264137a789faf9a01f458dd430 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Wed, 20 Nov 2024 14:26:15 -0400 Subject: [PATCH 12/17] Review rename and refactor suggestions --- .../Cardano/CLI/EraBased/Options/Common.hs | 6 +-- .../Cardano/CLI/EraBased/Run/Transaction.hs | 10 ++-- cardano-cli/src/Cardano/CLI/Plutus/Minting.hs | 48 ++++++++--------- cardano-cli/src/Cardano/CLI/Read.hs | 51 ++++++++++++------- 4 files changed, 64 insertions(+), 51 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs index 1a23642838..35aeaa7027 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs @@ -2174,20 +2174,20 @@ pMintMultiAsset sbe balanceExecUnits = where pMintingScript :: Parser CliMintScriptRequirements pMintingScript = - createOnDiskSimpleOfPlutusScriptCliArgs + createSimpleOrPlutusScriptFromCliArgs <$> pMintScriptFile <*> optional (pPlutusMintScriptWitnessData sbe WitCtxMint balanceExecUnits) pSimpleReferenceMintingScriptWitness :: Parser CliMintScriptRequirements pSimpleReferenceMintingScriptWitness = - createOnDiskSimpleReferenceScriptCliArgs + createSimpleReferenceScriptFromCliArgs <$> pReferenceTxIn "simple-minting-script-" "simple" <*> pPolicyId pPlutusMintReferenceScriptWitnessFiles :: BalanceTxExecUnits -> Parser CliMintScriptRequirements pPlutusMintReferenceScriptWitnessFiles autoBalanceExecUnits = - createOnDiskPlutusReferenceScriptCliArgs + createPlutusReferenceScriptFromCliArgs <$> pReferenceTxIn "mint-" "plutus" <*> pPlutusScriptLanguage "mint-" <*> pScriptRedeemerOrFile "mint-reference-tx-in" diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs index 1636c738fb..3940f377f2 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs @@ -762,7 +762,7 @@ runTxBuildRaw -- ^ Tx upper bound -> Lovelace -- ^ Tx fee - -> (Value, [MintScriptWitWithPolId era]) + -> (Value, [MintScriptWitnessWithPolicyId era]) -- ^ Multi-Asset value(s) -> [(Certificate era, Maybe (ScriptWitness WitCtxStake era))] -- ^ Certificate with potential script witness @@ -848,7 +848,7 @@ constructTxBodyContent -- ^ Tx lower bound -> TxValidityUpperBound era -- ^ Tx upper bound - -> (Value, [MintScriptWitWithPolId era]) + -> (Value, [MintScriptWitnessWithPolicyId era]) -- ^ Multi-Asset value(s) -> [(Certificate era, Maybe (ScriptWitness WitCtxStake era))] -- ^ Certificate with potential script witness @@ -988,7 +988,7 @@ runTxBuild -- ^ Normal outputs -> TxOutChangeAddress -- ^ A change output - -> (Value, [MintScriptWitWithPolId era]) + -> (Value, [MintScriptWitnessWithPolicyId era]) -- ^ Multi-Asset value(s) -> Maybe SlotNo -- ^ Tx lower bound @@ -1393,7 +1393,7 @@ toTxAlonzoDatum supp cliDatum = createTxMintValue :: forall era . ShelleyBasedEra era - -> (Value, [MintScriptWitWithPolId era]) + -> (Value, [MintScriptWitnessWithPolicyId era]) -> Either TxCmdError (TxMintValue BuildTx era) createTxMintValue era (val, scriptWitnesses) = if List.null (toList val) && List.null scriptWitnesses @@ -1408,7 +1408,7 @@ createTxMintValue era (val, scriptWitnesses) = fromList [pid | (AssetId pid _, _) <- toList val] let witnessesProvidedMap :: Map PolicyId (ScriptWitness WitCtxMint era) - witnessesProvidedMap = fromList $ [(polid, sWit) | MintScriptWitWithPolId polid sWit <- scriptWitnesses] + witnessesProvidedMap = fromList $ [(polid, sWit) | MintScriptWitnessWithPolicyId polid sWit <- scriptWitnesses] witnessesProvidedSet = Map.keysSet witnessesProvidedMap -- Check not too many, nor too few: diff --git a/cardano-cli/src/Cardano/CLI/Plutus/Minting.hs b/cardano-cli/src/Cardano/CLI/Plutus/Minting.hs index aa51a3cb73..5e5edaf017 100644 --- a/cardano-cli/src/Cardano/CLI/Plutus/Minting.hs +++ b/cardano-cli/src/Cardano/CLI/Plutus/Minting.hs @@ -5,10 +5,10 @@ module Cardano.CLI.Plutus.Minting ( CliMintScriptRequirements (..) - , MintScriptWitWithPolId (..) - , createOnDiskSimpleOfPlutusScriptCliArgs - , createOnDiskSimpleReferenceScriptCliArgs - , createOnDiskPlutusReferenceScriptCliArgs + , MintScriptWitnessWithPolicyId (..) + , createSimpleOrPlutusScriptFromCliArgs + , createSimpleReferenceScriptFromCliArgs + , createPlutusReferenceScriptFromCliArgs , CliScriptWitnessError , readMintScriptWitness ) @@ -23,13 +23,19 @@ import Cardano.CLI.Types.Common (ScriptDataOrFile) -- We always need the policy id when constructing a transaction that mints. -- In the case of reference scripts, the user currently must provide the policy id (script hash) -- in order to correctly construct the transaction. -data MintScriptWitWithPolId era - = MintScriptWitWithPolId +data MintScriptWitnessWithPolicyId era + = MintScriptWitnessWithPolicyId { mswPolId :: PolicyId , mswScriptWitness :: ScriptWitness WitCtxMint era } deriving Show +data CliMintScriptRequirements + = OnDiskSimpleOrPlutusScript OnDiskSimpleOrPlutusScriptCliArgs + | OnDiskSimpleRefScript SimpleRefScriptCliArgs + | OnDiskPlutusRefScript PlutusRefScriptCliArgs + deriving Show + data OnDiskSimpleOrPlutusScriptCliArgs = OnDiskSimpleScriptCliArgs (File ScriptInAnyLang In) @@ -39,13 +45,13 @@ data OnDiskSimpleOrPlutusScriptCliArgs ExecutionUnits deriving Show -createOnDiskSimpleOfPlutusScriptCliArgs +createSimpleOrPlutusScriptFromCliArgs :: File ScriptInAnyLang In -> Maybe (ScriptDataOrFile, ExecutionUnits) -> CliMintScriptRequirements -createOnDiskSimpleOfPlutusScriptCliArgs scriptFp Nothing = +createSimpleOrPlutusScriptFromCliArgs scriptFp Nothing = OnDiskSimpleOrPlutusScript $ OnDiskSimpleScriptCliArgs scriptFp -createOnDiskSimpleOfPlutusScriptCliArgs scriptFp (Just (redeemerFile, execUnits)) = +createSimpleOrPlutusScriptFromCliArgs scriptFp (Just (redeemerFile, execUnits)) = OnDiskSimpleOrPlutusScript $ OnDiskPlutusScriptCliArgs scriptFp redeemerFile execUnits data SimpleRefScriptCliArgs @@ -54,11 +60,11 @@ data SimpleRefScriptCliArgs PolicyId deriving Show -createOnDiskSimpleReferenceScriptCliArgs +createSimpleReferenceScriptFromCliArgs :: TxIn -> PolicyId -> CliMintScriptRequirements -createOnDiskSimpleReferenceScriptCliArgs txin polid = +createSimpleReferenceScriptFromCliArgs txin polid = OnDiskSimpleRefScript $ SimpleRefScriptCliArgs txin polid data PlutusRefScriptCliArgs @@ -70,22 +76,16 @@ data PlutusRefScriptCliArgs PolicyId deriving Show -createOnDiskPlutusReferenceScriptCliArgs +createPlutusReferenceScriptFromCliArgs :: TxIn -> AnyPlutusScriptVersion -> ScriptDataOrFile -> ExecutionUnits -> PolicyId -> CliMintScriptRequirements -createOnDiskPlutusReferenceScriptCliArgs txin scriptVersion scriptData execUnits polid = +createPlutusReferenceScriptFromCliArgs txin scriptVersion scriptData execUnits polid = OnDiskPlutusRefScript $ PlutusRefScriptCliArgs txin scriptVersion scriptData execUnits polid -data CliMintScriptRequirements - = OnDiskSimpleOrPlutusScript OnDiskSimpleOrPlutusScriptCliArgs - | OnDiskSimpleRefScript SimpleRefScriptCliArgs - | OnDiskPlutusRefScript PlutusRefScriptCliArgs - deriving Show - data CliScriptWitnessError = SimpleScriptWitnessDecodeError ScriptDecodeError | PlutusScriptWitnessDecodeError PlutusScriptDecodeError @@ -104,7 +104,7 @@ instance Error CliScriptWitnessError where readMintScriptWitness :: MonadIOTransError (FileError CliScriptWitnessError) t m - => ShelleyBasedEra era -> CliMintScriptRequirements -> t m (MintScriptWitWithPolId era) + => ShelleyBasedEra era -> CliMintScriptRequirements -> t m (MintScriptWitnessWithPolicyId era) readMintScriptWitness sbe (OnDiskSimpleOrPlutusScript simpleOrPlutus) = case simpleOrPlutus of OnDiskSimpleScriptCliArgs simpleFp -> do @@ -115,7 +115,7 @@ readMintScriptWitness sbe (OnDiskSimpleOrPlutusScript simpleOrPlutus) = SimpleScript ss -> do let polId = PolicyId $ hashScript s return $ - MintScriptWitWithPolId polId $ + MintScriptWitnessWithPolicyId polId $ SimpleScriptWitness (sbeToSimpleScriptLangInEra sbe) $ SScript ss OnDiskPlutusScriptCliArgs plutusScriptFp redeemerFile execUnits -> do @@ -142,7 +142,7 @@ readMintScriptWitness sbe (OnDiskSimpleOrPlutusScript simpleOrPlutus) = $ scriptLanguageSupportedInEra sbe $ PlutusScriptLanguage lang return $ - MintScriptWitWithPolId polId $ + MintScriptWitnessWithPolicyId polId $ PlutusScriptWitness sLangSupported lang @@ -152,7 +152,7 @@ readMintScriptWitness sbe (OnDiskSimpleOrPlutusScript simpleOrPlutus) = execUnits readMintScriptWitness sbe (OnDiskSimpleRefScript (SimpleRefScriptCliArgs refTxIn polId)) = return $ - MintScriptWitWithPolId polId $ + MintScriptWitnessWithPolicyId polId $ SimpleScriptWitness (sbeToSimpleScriptLangInEra sbe) (SReferenceScript refTxIn $ Just $ unPolicyId polId) @@ -181,7 +181,7 @@ readMintScriptWitness $ scriptLanguageSupportedInEra sbe $ PlutusScriptLanguage lang return $ - MintScriptWitWithPolId polId $ + MintScriptWitnessWithPolicyId polId $ PlutusScriptWitness sLangSupported lang diff --git a/cardano-cli/src/Cardano/CLI/Read.hs b/cardano-cli/src/Cardano/CLI/Read.hs index d59d86ac29..22673eabd3 100644 --- a/cardano-cli/src/Cardano/CLI/Read.hs +++ b/cardano-cli/src/Cardano/CLI/Read.hs @@ -634,6 +634,11 @@ data PlutusScriptDecodeError = PlutusScriptDecodeErrorUnknownVersion !Text | PlutusScriptJsonDecodeError !JsonDecodeError | PlutusScriptDecodeTextEnvelopeError !TextEnvelopeError + | PlutusScriptDecodeErrorVersionMismatch + !Text + -- ^ Script version + !AnyPlutusScriptVersion + -- ^ Attempted to decode with version instance Error PlutusScriptDecodeError where prettyError = \case @@ -643,30 +648,38 @@ instance Error PlutusScriptDecodeError where prettyError err PlutusScriptDecodeTextEnvelopeError err -> prettyError err + PlutusScriptDecodeErrorVersionMismatch version (AnyPlutusScriptVersion v) -> + "Version mismatch in code: script version that was read" + <> pretty version + <> " but tried to decode script version: " + <> pshow v deserialisePlutusScript :: BS.ByteString -> Either PlutusScriptDecodeError AnyPlutusScript -deserialisePlutusScript bs = - case deserialiseFromJSON AsTextEnvelope bs of - Left err -> Left $ PlutusScriptJsonDecodeError err - Right te -> - case teType te of - "PlutusScriptV1" -> - case deserialiseFromTextEnvelopeAnyOf [teTypes (AnyPlutusScriptVersion PlutusScriptV1)] te of - Left err -> Left (PlutusScriptDecodeTextEnvelopeError err) - Right script -> Right script - "PlutusScriptV2" -> - case deserialiseFromTextEnvelopeAnyOf [teTypes (AnyPlutusScriptVersion PlutusScriptV2)] te of - Left err -> Left (PlutusScriptDecodeTextEnvelopeError err) - Right script -> Right script - "PlutusScriptV3" -> - case deserialiseFromTextEnvelopeAnyOf [teTypes (AnyPlutusScriptVersion PlutusScriptV3)] te of - Left err -> Left (PlutusScriptDecodeTextEnvelopeError err) - Right script -> Right script - (TextEnvelopeType unknownScriptVersion) -> - Left . PlutusScriptDecodeErrorUnknownVersion $ Text.pack unknownScriptVersion +deserialisePlutusScript bs = do + te <- first PlutusScriptJsonDecodeError $ deserialiseFromJSON AsTextEnvelope bs + case teType te of + TextEnvelopeType s -> case s of + sVer@"PlutusScriptV1" -> deserialiseAnyPlutusScriptVersion sVer PlutusScriptV1 te + sVer@"PlutusScriptV2" -> deserialiseAnyPlutusScriptVersion sVer PlutusScriptV2 te + sVer@"PlutusScriptV3" -> deserialiseAnyPlutusScriptVersion sVer PlutusScriptV3 te + unknownScriptVersion -> + Left . PlutusScriptDecodeErrorUnknownVersion $ Text.pack unknownScriptVersion where + deserialiseAnyPlutusScriptVersion + :: IsPlutusScriptLanguage lang + => String + -> PlutusScriptVersion lang + -> TextEnvelope + -> Either PlutusScriptDecodeError AnyPlutusScript + deserialiseAnyPlutusScriptVersion v lang tEnv = + if v == show lang + then case deserialiseFromTextEnvelopeAnyOf [teTypes (AnyPlutusScriptVersion lang)] tEnv of + Left err -> Left (PlutusScriptDecodeTextEnvelopeError err) + Right script -> Right script + else Left $ PlutusScriptDecodeErrorVersionMismatch (Text.pack v) (AnyPlutusScriptVersion lang) + teTypes :: AnyPlutusScriptVersion -> FromSomeType HasTextEnvelope AnyPlutusScript teTypes = \case From fafcea1c61a0e45561391b9354c11b6104db9806 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Wed, 20 Nov 2024 15:13:56 -0400 Subject: [PATCH 13/17] Module split and rename suggestions --- cardano-cli/cardano-cli.cabal | 3 +- .../CLI/EraBased/Commands/Transaction.hs | 2 +- .../Cardano/CLI/EraBased/Options/Common.hs | 2 +- .../Cardano/CLI/EraBased/Run/Transaction.hs | 3 +- .../Script/Mint/Read.hs} | 96 +--------------- .../Cardano/CLI/EraBased/Script/Mint/Types.hs | 104 ++++++++++++++++++ .../Cardano/CLI/Types/Errors/TxCmdError.hs | 2 +- 7 files changed, 115 insertions(+), 97 deletions(-) rename cardano-cli/src/Cardano/CLI/{Plutus/Minting.hs => EraBased/Script/Mint/Read.hs} (58%) create mode 100644 cardano-cli/src/Cardano/CLI/EraBased/Script/Mint/Types.hs diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index 175fefa4d9..437bb156e7 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -116,6 +116,8 @@ library Cardano.CLI.EraBased.Run.StakePool Cardano.CLI.EraBased.Run.TextView Cardano.CLI.EraBased.Run.Transaction + Cardano.CLI.EraBased.Script.Mint.Read + Cardano.CLI.EraBased.Script.Mint.Types Cardano.CLI.EraBased.Transaction.HashCheck Cardano.CLI.Helpers Cardano.CLI.IO.Lazy @@ -135,7 +137,6 @@ library Cardano.CLI.Options.Key Cardano.CLI.Options.Node Cardano.CLI.Options.Ping - Cardano.CLI.Plutus.Minting Cardano.CLI.Orphans Cardano.CLI.Parser Cardano.CLI.Read diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs index 5cc225d40b..de11edc37b 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs @@ -25,7 +25,7 @@ import qualified Cardano.Api.Experimental as Exp import Cardano.Api.Ledger (Coin) import Cardano.Api.Shelley -import Cardano.CLI.Plutus.Minting +import Cardano.CLI.EraBased.Script.Mint.Types import Cardano.CLI.Types.Common import Cardano.CLI.Types.Governance diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs index 35aeaa7027..fe5a1fd738 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs @@ -18,8 +18,8 @@ import qualified Cardano.Api.Network as Consensus import Cardano.Api.Shelley import Cardano.CLI.Environment (EnvCli (..), envCliAnyEon) +import Cardano.CLI.EraBased.Script.Mint.Types import Cardano.CLI.Parser -import Cardano.CLI.Plutus.Minting import Cardano.CLI.Read import Cardano.CLI.Types.Common import Cardano.CLI.Types.Governance diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs index 3940f377f2..398c6816a7 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs @@ -48,9 +48,10 @@ import Cardano.CLI.EraBased.Commands.Transaction import qualified Cardano.CLI.EraBased.Commands.Transaction as Cmd import Cardano.CLI.EraBased.Run.Genesis.Common (readProtocolParameters) import Cardano.CLI.EraBased.Run.Query +import Cardano.CLI.EraBased.Script.Mint.Read +import Cardano.CLI.EraBased.Script.Mint.Types import Cardano.CLI.EraBased.Transaction.HashCheck (checkCertificateHashes, checkProposalHashes, checkVotingProcedureHashes) -import Cardano.CLI.Plutus.Minting import Cardano.CLI.Read import Cardano.CLI.Types.Common import Cardano.CLI.Types.Errors.BootstrapWitnessError diff --git a/cardano-cli/src/Cardano/CLI/Plutus/Minting.hs b/cardano-cli/src/Cardano/CLI/EraBased/Script/Mint/Read.hs similarity index 58% rename from cardano-cli/src/Cardano/CLI/Plutus/Minting.hs rename to cardano-cli/src/Cardano/CLI/EraBased/Script/Mint/Read.hs index 5e5edaf017..3ff7db7e95 100644 --- a/cardano-cli/src/Cardano/CLI/Plutus/Minting.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Script/Mint/Read.hs @@ -1,106 +1,17 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} -{-# LANGUAGE LambdaCase #-} -module Cardano.CLI.Plutus.Minting - ( CliMintScriptRequirements (..) - , MintScriptWitnessWithPolicyId (..) - , createSimpleOrPlutusScriptFromCliArgs - , createSimpleReferenceScriptFromCliArgs - , createPlutusReferenceScriptFromCliArgs - , CliScriptWitnessError - , readMintScriptWitness +module Cardano.CLI.EraBased.Script.Mint.Read + ( readMintScriptWitness ) where import Cardano.Api import Cardano.Api.Shelley +import Cardano.CLI.EraBased.Script.Mint.Types import Cardano.CLI.Read -import Cardano.CLI.Types.Common (ScriptDataOrFile) - --- We always need the policy id when constructing a transaction that mints. --- In the case of reference scripts, the user currently must provide the policy id (script hash) --- in order to correctly construct the transaction. -data MintScriptWitnessWithPolicyId era - = MintScriptWitnessWithPolicyId - { mswPolId :: PolicyId - , mswScriptWitness :: ScriptWitness WitCtxMint era - } - deriving Show - -data CliMintScriptRequirements - = OnDiskSimpleOrPlutusScript OnDiskSimpleOrPlutusScriptCliArgs - | OnDiskSimpleRefScript SimpleRefScriptCliArgs - | OnDiskPlutusRefScript PlutusRefScriptCliArgs - deriving Show - -data OnDiskSimpleOrPlutusScriptCliArgs - = OnDiskSimpleScriptCliArgs - (File ScriptInAnyLang In) - | OnDiskPlutusScriptCliArgs - (File ScriptInAnyLang In) - ScriptDataOrFile - ExecutionUnits - deriving Show - -createSimpleOrPlutusScriptFromCliArgs - :: File ScriptInAnyLang In - -> Maybe (ScriptDataOrFile, ExecutionUnits) - -> CliMintScriptRequirements -createSimpleOrPlutusScriptFromCliArgs scriptFp Nothing = - OnDiskSimpleOrPlutusScript $ OnDiskSimpleScriptCliArgs scriptFp -createSimpleOrPlutusScriptFromCliArgs scriptFp (Just (redeemerFile, execUnits)) = - OnDiskSimpleOrPlutusScript $ OnDiskPlutusScriptCliArgs scriptFp redeemerFile execUnits - -data SimpleRefScriptCliArgs - = SimpleRefScriptCliArgs - TxIn - PolicyId - deriving Show - -createSimpleReferenceScriptFromCliArgs - :: TxIn - -> PolicyId - -> CliMintScriptRequirements -createSimpleReferenceScriptFromCliArgs txin polid = - OnDiskSimpleRefScript $ SimpleRefScriptCliArgs txin polid - -data PlutusRefScriptCliArgs - = PlutusRefScriptCliArgs - TxIn - AnyPlutusScriptVersion - ScriptDataOrFile - ExecutionUnits - PolicyId - deriving Show - -createPlutusReferenceScriptFromCliArgs - :: TxIn - -> AnyPlutusScriptVersion - -> ScriptDataOrFile - -> ExecutionUnits - -> PolicyId - -> CliMintScriptRequirements -createPlutusReferenceScriptFromCliArgs txin scriptVersion scriptData execUnits polid = - OnDiskPlutusRefScript $ PlutusRefScriptCliArgs txin scriptVersion scriptData execUnits polid - -data CliScriptWitnessError - = SimpleScriptWitnessDecodeError ScriptDecodeError - | PlutusScriptWitnessDecodeError PlutusScriptDecodeError - | PlutusScriptWitnessLanguageNotSupportedInEra - AnyPlutusScriptVersion - AnyShelleyBasedEra - | PlutusScriptWitnessRedeemerError ScriptDataError - -instance Error CliScriptWitnessError where - prettyError = \case - SimpleScriptWitnessDecodeError err -> prettyError err - PlutusScriptWitnessDecodeError err -> prettyError err - PlutusScriptWitnessLanguageNotSupportedInEra version era -> - "Plutus script version " <> pshow version <> " is not supported in era " <> pshow era - PlutusScriptWitnessRedeemerError err -> renderScriptDataError err readMintScriptWitness :: MonadIOTransError (FileError CliScriptWitnessError) t m @@ -190,6 +101,7 @@ readMintScriptWitness redeemer execUnits +-- TODO: Remove me when exposed from cardano-api sbeToSimpleScriptLangInEra :: ShelleyBasedEra era -> ScriptLanguageInEra SimpleScript' era sbeToSimpleScriptLangInEra ShelleyBasedEraShelley = SimpleScriptInShelley diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Script/Mint/Types.hs b/cardano-cli/src/Cardano/CLI/EraBased/Script/Mint/Types.hs new file mode 100644 index 0000000000..c4c93b9e8f --- /dev/null +++ b/cardano-cli/src/Cardano/CLI/EraBased/Script/Mint/Types.hs @@ -0,0 +1,104 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} + +module Cardano.CLI.EraBased.Script.Mint.Types + ( CliScriptWitnessError (..) + , CliMintScriptRequirements (..) + , SimpleOrPlutusScriptCliArgs (..) + , createSimpleOrPlutusScriptFromCliArgs + , PlutusRefScriptCliArgs (..) + , createPlutusReferenceScriptFromCliArgs + , SimpleRefScriptCliArgs (..) + , createSimpleReferenceScriptFromCliArgs + , MintScriptWitnessWithPolicyId (..) + ) +where + +import Cardano.Api + +import Cardano.CLI.Read +import Cardano.CLI.Types.Common (ScriptDataOrFile) + +-- We always need the policy id when constructing a transaction that mints. +-- In the case of reference scripts, the user currently must provide the policy id (script hash) +-- in order to correctly construct the transaction. +data MintScriptWitnessWithPolicyId era + = MintScriptWitnessWithPolicyId + { mswPolId :: PolicyId + , mswScriptWitness :: ScriptWitness WitCtxMint era + } + deriving Show + +data CliMintScriptRequirements + = OnDiskSimpleOrPlutusScript SimpleOrPlutusScriptCliArgs + | OnDiskSimpleRefScript SimpleRefScriptCliArgs + | OnDiskPlutusRefScript PlutusRefScriptCliArgs + deriving Show + +data SimpleOrPlutusScriptCliArgs + = OnDiskSimpleScriptCliArgs + (File ScriptInAnyLang In) + | OnDiskPlutusScriptCliArgs + (File ScriptInAnyLang In) + ScriptDataOrFile + ExecutionUnits + deriving Show + +createSimpleOrPlutusScriptFromCliArgs + :: File ScriptInAnyLang In + -> Maybe (ScriptDataOrFile, ExecutionUnits) + -> CliMintScriptRequirements +createSimpleOrPlutusScriptFromCliArgs scriptFp Nothing = + OnDiskSimpleOrPlutusScript $ OnDiskSimpleScriptCliArgs scriptFp +createSimpleOrPlutusScriptFromCliArgs scriptFp (Just (redeemerFile, execUnits)) = + OnDiskSimpleOrPlutusScript $ OnDiskPlutusScriptCliArgs scriptFp redeemerFile execUnits + +data SimpleRefScriptCliArgs + = SimpleRefScriptCliArgs + TxIn + PolicyId + deriving Show + +createSimpleReferenceScriptFromCliArgs + :: TxIn + -> PolicyId + -> CliMintScriptRequirements +createSimpleReferenceScriptFromCliArgs txin polid = + OnDiskSimpleRefScript $ SimpleRefScriptCliArgs txin polid + +data PlutusRefScriptCliArgs + = PlutusRefScriptCliArgs + TxIn + AnyPlutusScriptVersion + ScriptDataOrFile + ExecutionUnits + PolicyId + deriving Show + +createPlutusReferenceScriptFromCliArgs + :: TxIn + -> AnyPlutusScriptVersion + -> ScriptDataOrFile + -> ExecutionUnits + -> PolicyId + -> CliMintScriptRequirements +createPlutusReferenceScriptFromCliArgs txin scriptVersion scriptData execUnits polid = + OnDiskPlutusRefScript $ PlutusRefScriptCliArgs txin scriptVersion scriptData execUnits polid + +data CliScriptWitnessError + = SimpleScriptWitnessDecodeError ScriptDecodeError + | PlutusScriptWitnessDecodeError PlutusScriptDecodeError + | PlutusScriptWitnessLanguageNotSupportedInEra + AnyPlutusScriptVersion + AnyShelleyBasedEra + | PlutusScriptWitnessRedeemerError ScriptDataError + +instance Error CliScriptWitnessError where + prettyError = \case + SimpleScriptWitnessDecodeError err -> prettyError err + PlutusScriptWitnessDecodeError err -> prettyError err + PlutusScriptWitnessLanguageNotSupportedInEra version era -> + "Plutus script version " <> pshow version <> " is not supported in era " <> pshow era + PlutusScriptWitnessRedeemerError err -> renderScriptDataError err diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/TxCmdError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/TxCmdError.hs index 87820b3b79..4e57677428 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Errors/TxCmdError.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/TxCmdError.hs @@ -19,7 +19,7 @@ import Cardano.Api.Consensus (EraMismatch (..)) import qualified Cardano.Api.Ledger as L import Cardano.Api.Shelley -import Cardano.CLI.Plutus.Minting +import Cardano.CLI.EraBased.Script.Mint.Types import Cardano.CLI.Read import Cardano.CLI.Types.Common import Cardano.CLI.Types.Errors.BootstrapWitnessError From 6c4869fde3a85868c6d1f2a04855e90f9ddbdb69 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Thu, 21 Nov 2024 12:28:08 -0400 Subject: [PATCH 14/17] Add separate error modules: - Cardano.CLI.Types.Errors.PlutusScriptDecodeError - Cardano.CLI.Types.Errors.ScriptDataError --- cardano-cli/cardano-cli.cabal | 3 ++ cardano-cli/src/Cardano/CLI/Read.hs | 50 +------------------ .../Types/Errors/PlutusScriptDecodeError.hs | 32 ++++++++++++ .../CLI/Types/Errors/ScriptDataError.hs | 36 +++++++++++++ 4 files changed, 73 insertions(+), 48 deletions(-) create mode 100644 cardano-cli/src/Cardano/CLI/Types/Errors/PlutusScriptDecodeError.hs create mode 100644 cardano-cli/src/Cardano/CLI/Types/Errors/ScriptDataError.hs diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index 437bb156e7..5cb7a7d184 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -45,6 +45,7 @@ library if impl(ghc < 9.6) ghc-options: -Wno-redundant-constraints + hs-source-dirs: src exposed-modules: Cardano.CLI.Byron.Commands @@ -172,10 +173,12 @@ library Cardano.CLI.Types.Errors.KeyCmdError Cardano.CLI.Types.Errors.NodeCmdError Cardano.CLI.Types.Errors.NodeEraMismatchError + Cardano.CLI.Types.Errors.PlutusScriptDecodeError Cardano.CLI.Types.Errors.ProtocolParamsError Cardano.CLI.Types.Errors.QueryCmdError Cardano.CLI.Types.Errors.QueryCmdLocalStateQueryError Cardano.CLI.Types.Errors.RegistrationError + Cardano.CLI.Types.Errors.ScriptDataError Cardano.CLI.Types.Errors.ScriptDecodeError Cardano.CLI.Types.Errors.StakeAddressCmdError Cardano.CLI.Types.Errors.StakeAddressDelegationError diff --git a/cardano-cli/src/Cardano/CLI/Read.hs b/cardano-cli/src/Cardano/CLI/Read.hs index 22673eabd3..619896b044 100644 --- a/cardano-cli/src/Cardano/CLI/Read.hs +++ b/cardano-cli/src/Cardano/CLI/Read.hs @@ -112,6 +112,8 @@ import Cardano.Api.Shelley as Api import qualified Cardano.Binary as CBOR import Cardano.CLI.Types.Common import Cardano.CLI.Types.Errors.DelegationError +import Cardano.CLI.Types.Errors.PlutusScriptDecodeError +import Cardano.CLI.Types.Errors.ScriptDataError import Cardano.CLI.Types.Errors.ScriptDecodeError import Cardano.CLI.Types.Errors.StakeCredentialError import Cardano.CLI.Types.Governance @@ -433,30 +435,6 @@ validateScriptSupportedInEra era script@(ScriptInAnyLang lang _) = (anyCardanoEra $ toCardanoEra era) Just script' -> pure script' -data ScriptDataError - = ScriptDataErrorFile (FileError ()) - | ScriptDataErrorJsonParse !FilePath !String - | ScriptDataErrorConversion !FilePath !ScriptDataJsonError - | ScriptDataErrorValidation !FilePath !ScriptDataRangeError - | ScriptDataErrorMetadataDecode !FilePath !CBOR.DecoderError - | ScriptDataErrorJsonBytes !ScriptDataJsonBytesError - deriving Show - -renderScriptDataError :: ScriptDataError -> Doc ann -renderScriptDataError = \case - ScriptDataErrorFile err -> - prettyError err - ScriptDataErrorJsonParse fp jsonErr -> - "Invalid JSON format in file: " <> pshow fp <> "\nJSON parse error: " <> pretty jsonErr - ScriptDataErrorConversion fp sDataJsonErr -> - "Error reading metadata at: " <> pshow fp <> "\n" <> prettyError sDataJsonErr - ScriptDataErrorValidation fp sDataRangeErr -> - "Error validating script data at: " <> pshow fp <> ":\n" <> prettyError sDataRangeErr - ScriptDataErrorMetadataDecode fp decoderErr -> - "Error decoding CBOR metadata at: " <> pshow fp <> " Error: " <> pshow decoderErr - ScriptDataErrorJsonBytes e -> - prettyError e - readScriptDatumOrFile :: ScriptDatumOrFile witctx -> ExceptT ScriptDataError IO (ScriptDatum witctx) @@ -630,30 +608,6 @@ readFilePlutusScript plutusScriptFp = do hoistEither $ deserialisePlutusScript bs -data PlutusScriptDecodeError - = PlutusScriptDecodeErrorUnknownVersion !Text - | PlutusScriptJsonDecodeError !JsonDecodeError - | PlutusScriptDecodeTextEnvelopeError !TextEnvelopeError - | PlutusScriptDecodeErrorVersionMismatch - !Text - -- ^ Script version - !AnyPlutusScriptVersion - -- ^ Attempted to decode with version - -instance Error PlutusScriptDecodeError where - prettyError = \case - PlutusScriptDecodeErrorUnknownVersion version -> - "Unknown Plutus script version: " <> pretty version - PlutusScriptJsonDecodeError err -> - prettyError err - PlutusScriptDecodeTextEnvelopeError err -> - prettyError err - PlutusScriptDecodeErrorVersionMismatch version (AnyPlutusScriptVersion v) -> - "Version mismatch in code: script version that was read" - <> pretty version - <> " but tried to decode script version: " - <> pshow v - deserialisePlutusScript :: BS.ByteString -> Either PlutusScriptDecodeError AnyPlutusScript diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/PlutusScriptDecodeError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/PlutusScriptDecodeError.hs new file mode 100644 index 0000000000..24effd990a --- /dev/null +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/PlutusScriptDecodeError.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE LambdaCase #-} + +module Cardano.CLI.Types.Errors.PlutusScriptDecodeError + ( PlutusScriptDecodeError(..) + ) where + +import Cardano.Api +import Data.Text (Text) + +data PlutusScriptDecodeError + = PlutusScriptDecodeErrorUnknownVersion !Text + | PlutusScriptJsonDecodeError !JsonDecodeError + | PlutusScriptDecodeTextEnvelopeError !TextEnvelopeError + | PlutusScriptDecodeErrorVersionMismatch + !Text + -- ^ Script version + !AnyPlutusScriptVersion + -- ^ Attempted to decode with version + +instance Error PlutusScriptDecodeError where + prettyError = \case + PlutusScriptDecodeErrorUnknownVersion version -> + "Unknown Plutus script version: " <> pretty version + PlutusScriptJsonDecodeError err -> + prettyError err + PlutusScriptDecodeTextEnvelopeError err -> + prettyError err + PlutusScriptDecodeErrorVersionMismatch version (AnyPlutusScriptVersion v) -> + "Version mismatch in code: script version that was read" + <> pretty version + <> " but tried to decode script version: " + <> pshow v \ No newline at end of file diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/ScriptDataError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/ScriptDataError.hs new file mode 100644 index 0000000000..909c6032cd --- /dev/null +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/ScriptDataError.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE LambdaCase #-} + +module Cardano.CLI.Types.Errors.ScriptDataError + ( ScriptDataError(..) + , renderScriptDataError + ) where + + + +import Cardano.Api +import qualified Cardano.Binary as CBOR + + +data ScriptDataError + = ScriptDataErrorFile (FileError ()) + | ScriptDataErrorJsonParse !FilePath !String + | ScriptDataErrorConversion !FilePath !ScriptDataJsonError + | ScriptDataErrorValidation !FilePath !ScriptDataRangeError + | ScriptDataErrorMetadataDecode !FilePath !CBOR.DecoderError + | ScriptDataErrorJsonBytes !ScriptDataJsonBytesError + deriving Show + +renderScriptDataError :: ScriptDataError -> Doc ann +renderScriptDataError = \case + ScriptDataErrorFile err -> + prettyError err + ScriptDataErrorJsonParse fp jsonErr -> + "Invalid JSON format in file: " <> pshow fp <> "\nJSON parse error: " <> pretty jsonErr + ScriptDataErrorConversion fp sDataJsonErr -> + "Error reading metadata at: " <> pshow fp <> "\n" <> prettyError sDataJsonErr + ScriptDataErrorValidation fp sDataRangeErr -> + "Error validating script data at: " <> pshow fp <> ":\n" <> prettyError sDataRangeErr + ScriptDataErrorMetadataDecode fp decoderErr -> + "Error decoding CBOR metadata at: " <> pshow fp <> " Error: " <> pshow decoderErr + ScriptDataErrorJsonBytes e -> + prettyError e \ No newline at end of file From e72b227ce1e2f9e68f967b4e4ffe109211ab736a Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Thu, 21 Nov 2024 12:39:01 -0400 Subject: [PATCH 15/17] With the implementation and use MintScriptWitnessWithPolicyId era to handle all minting scripts (simple and plutus) we no longer have to accomodate for the PolicyId in the constructors PlutusReferenceScriptWitnessFiles and SimpleReferenceScriptWitnessFiles This is evidenced by the diff of this commit The goal is to deprecate ScriptWitnessFiles and replace it with a collection of types for the different script purposes. The first example of this is MintScriptWitnessWithPolicyId era --- .../Cardano/CLI/EraBased/Options/Common.hs | 18 +++---------- cardano-cli/src/Cardano/CLI/Read.hs | 12 ++++----- cardano-cli/src/Cardano/CLI/Types/Common.hs | 26 ++++++++++++------- 3 files changed, 25 insertions(+), 31 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs index fe5a1fd738..629c70d67b 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs @@ -1539,7 +1539,6 @@ pPlutusStakeReferenceScriptWitnessFilesVotingProposing prefix autoBalanceExecUni AutoBalance -> pure (ExecutionUnits 0 0) ManualBalance -> pExecutionUnits $ prefix ++ "reference-tx-in" ) - <*> pure Nothing pPlutusStakeReferenceScriptWitnessFiles :: String @@ -1556,7 +1555,6 @@ pPlutusStakeReferenceScriptWitnessFiles prefix autoBalanceExecUnits = AutoBalance -> pure (ExecutionUnits 0 0) ManualBalance -> pExecutionUnits $ prefix ++ "reference-tx-in" ) - <*> pure Nothing pPlutusScriptLanguage :: String -> Parser AnyPlutusScriptVersion pPlutusScriptLanguage prefix = plutusP prefix PlutusScriptV2 "v2" <|> plutusP prefix PlutusScriptV3 "v3" @@ -1947,14 +1945,14 @@ pTxIn sbe balance = -> ScriptWitnessFiles WitCtxTxIn createSimpleReferenceScriptWitnessFiles refTxIn = let simpleLang = AnyScriptLanguage SimpleScriptLanguage - in SimpleReferenceScriptWitnessFiles refTxIn simpleLang Nothing + in SimpleReferenceScriptWitnessFiles refTxIn simpleLang pPlutusReferenceScriptWitness :: ShelleyBasedEra era -> BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxTxIn) pPlutusReferenceScriptWitness sbe' autoBalanceExecUnits = caseShelleyToBabbageOrConwayEraOnwards ( const $ - createPlutusReferenceScriptWitnessFiles + PlutusReferenceScriptWitnessFiles <$> pReferenceTxIn "spending-" "plutus" <*> pPlutusScriptLanguage "spending-" <*> pScriptDatumOrFile "spending-reference-tx-in" WitCtxTxIn @@ -1965,7 +1963,7 @@ pTxIn sbe balance = ) ) ( const $ - createPlutusReferenceScriptWitnessFiles + PlutusReferenceScriptWitnessFiles <$> pReferenceTxIn "spending-" "plutus" <*> pPlutusScriptLanguage "spending-" <*> pScriptDatumOrFileCip69 "spending-reference-tx-in" WitCtxTxIn @@ -1976,16 +1974,6 @@ pTxIn sbe balance = ) ) sbe' - where - createPlutusReferenceScriptWitnessFiles - :: TxIn - -> AnyPlutusScriptVersion - -> ScriptDatumOrFile WitCtxTxIn - -> ScriptRedeemerOrFile - -> ExecutionUnits - -> ScriptWitnessFiles WitCtxTxIn - createPlutusReferenceScriptWitnessFiles refIn sLang sDatum sRedeemer execUnits = - PlutusReferenceScriptWitnessFiles refIn sLang sDatum sRedeemer execUnits Nothing pEmbeddedPlutusScriptWitness :: Parser (ScriptWitnessFiles WitCtxTxIn) pEmbeddedPlutusScriptWitness = diff --git a/cardano-cli/src/Cardano/CLI/Read.hs b/cardano-cli/src/Cardano/CLI/Read.hs index 619896b044..8d2a65c085 100644 --- a/cardano-cli/src/Cardano/CLI/Read.hs +++ b/cardano-cli/src/Cardano/CLI/Read.hs @@ -359,7 +359,6 @@ readScriptWitness datumOrFile redeemerOrFile execUnits - mPid ) = do caseShelleyToAlonzoOrBabbageEraOnwards ( const $ @@ -381,7 +380,7 @@ readScriptWitness PlutusScriptWitness sLangInEra version - (PReferenceScript refTxIn (unPolicyId <$> mPid)) + (PReferenceScript refTxIn) datum redeemer execUnits @@ -397,7 +396,6 @@ readScriptWitness ( SimpleReferenceScriptWitnessFiles refTxIn anyScrLang@(AnyScriptLanguage anyScriptLanguage) - mPid ) = do caseShelleyToAlonzoOrBabbageEraOnwards ( const $ @@ -411,7 +409,7 @@ readScriptWitness case languageOfScriptLanguageInEra sLangInEra of SimpleScriptLanguage -> return . SimpleScriptWitness sLangInEra $ - SReferenceScript refTxIn (unPolicyId <$> mPid) + SReferenceScript refTxIn PlutusScriptLanguage{} -> error "readScriptWitness: Should not be possible to specify a plutus script" Nothing -> @@ -629,9 +627,9 @@ deserialisePlutusScript bs = do -> Either PlutusScriptDecodeError AnyPlutusScript deserialiseAnyPlutusScriptVersion v lang tEnv = if v == show lang - then case deserialiseFromTextEnvelopeAnyOf [teTypes (AnyPlutusScriptVersion lang)] tEnv of - Left err -> Left (PlutusScriptDecodeTextEnvelopeError err) - Right script -> Right script + then + first PlutusScriptDecodeTextEnvelopeError $ + deserialiseFromTextEnvelopeAnyOf [teTypes (AnyPlutusScriptVersion lang)] tEnv else Left $ PlutusScriptDecodeErrorVersionMismatch (Text.pack v) (AnyPlutusScriptVersion lang) teTypes :: AnyPlutusScriptVersion -> FromSomeType HasTextEnvelope AnyPlutusScript diff --git a/cardano-cli/src/Cardano/CLI/Types/Common.hs b/cardano-cli/src/Cardano/CLI/Types/Common.hs index 492ae1a746..c88ba44628 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Common.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Common.hs @@ -399,11 +399,19 @@ type ScriptRedeemerOrFile = ScriptDataOrFile -- the script witness data representation. -- -- It is era-independent, but witness context-dependent. --- --- TODO: Potentially update to WitnessFiles so we can get --- rid of Maybe (ScriptWitnessFiles). This will be clearer --- in conveying that we either expect a script witness --- or a key witness is provided at the signing stage. +-- NB: This is in the process of being deprecated because it is difficult +-- to accomodate for changes for specific plutus script purposes. As an +-- example when minting a multi-asset with a plutus script we need the policy +-- id of the said script. This is fine when we have access to the plutus script however +-- in the case of a reference script we demand the user provides the policy id. +-- Enshrining that change in the 'ScriptWitnessFiles' is difficult because only +-- minting scripts require this but not the other kinds of plutus scripts (spending, certifying etc.) +-- Another example is CIP-69 where datums are no longer required for spending scripts. This is +-- further complicated by the fact at the parsing level we make user facing simplifications e.g `--mint-script-file` +-- which says nothing about the script type (simple vs plutus) or script version. +-- As a result need to separate the different script purposes into +-- their own separate data definitions where we can make changes specific to that script purpose +-- more easily without affecting the rest of the api. data ScriptWitnessFiles witctx where SimpleScriptWitnessFile :: ScriptFile @@ -414,21 +422,21 @@ data ScriptWitnessFiles witctx where -> ScriptRedeemerOrFile -> ExecutionUnits -> ScriptWitnessFiles witctx - -- TODO: Need to figure out how to exclude PlutusV1 scripts at the type level + -- NB: This no longer is used for minting scripts + -- Use MintScriptWitnessWithPolicyId instead PlutusReferenceScriptWitnessFiles :: TxIn -> AnyPlutusScriptVersion -> ScriptDatumOrFile witctx -> ScriptRedeemerOrFile -> ExecutionUnits - -> Maybe PolicyId -- ^ For minting reference scripts -> ScriptWitnessFiles witctx + -- NB: This no longer is used for minting scripts + -- Use MintScriptWitnessWithPolicyId instead SimpleReferenceScriptWitnessFiles :: TxIn -> AnyScriptLanguage - -> Maybe PolicyId - -- ^ For minting reference scripts -> ScriptWitnessFiles witctx deriving instance Show (ScriptWitnessFiles witctx) From 1e136a37aeed511d10d1f63aeab067b73058f50a Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Thu, 21 Nov 2024 12:43:23 -0400 Subject: [PATCH 16/17] Update createTxMintValue and propagate the removal of Maybe PolicyId from PReferenceScript and SReferenceScript constructors MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: Mateusz Gałażyn --- .../Cardano/CLI/EraBased/Run/Transaction.hs | 25 ++++++++++++------- .../Cardano/CLI/EraBased/Script/Mint/Read.hs | 4 +-- .../Cardano/CLI/EraBased/Script/Mint/Types.hs | 4 ++- cardano-cli/src/Cardano/CLI/Types/Output.hs | 2 +- 4 files changed, 22 insertions(+), 13 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs index 398c6816a7..93cc93f889 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs @@ -77,7 +77,7 @@ import Data.Function ((&)) import qualified Data.List as List import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map -import Data.Maybe (catMaybes, fromMaybe, mapMaybe) +import Data.Maybe (catMaybes, fromMaybe, mapMaybe, maybeToList) import Data.Set (Set) import qualified Data.Set as Set import qualified Data.Text as Text @@ -1248,9 +1248,9 @@ getAllReferenceInputs :: ScriptWitness witctx era -> Maybe TxIn getReferenceInput sWit = case sWit of - PlutusScriptWitness _ _ (PReferenceScript refIn _) _ _ _ -> Just refIn + PlutusScriptWitness _ _ (PReferenceScript refIn) _ _ _ -> Just refIn PlutusScriptWitness _ _ PScript{} _ _ _ -> Nothing - SimpleScriptWitness _ (SReferenceScript refIn _) -> Just refIn + SimpleScriptWitness _ (SReferenceScript refIn) -> Just refIn SimpleScriptWitness _ SScript{} -> Nothing toAddressInAnyEra @@ -1403,19 +1403,26 @@ createTxMintValue era (val, scriptWitnesses) = caseShelleyToAllegraOrMaryEraOnwards (const (txFeatureMismatchPure (toCardanoEra era) TxFeatureMintValue)) ( \w -> do - -- The set of policy ids for which we need witnesses: - let witnessesNeededSet :: Set PolicyId - witnessesNeededSet = - fromList [pid | (AssetId pid _, _) <- toList val] + let policiesWithAssets :: [(PolicyId, AssetName, Quantity)] + policiesWithAssets = [(pid, assetName, quantity) | (AssetId pid assetName, quantity) <- toList val] + -- The set of policy ids for which we need witnesses: + witnessesNeededSet :: Set PolicyId + witnessesNeededSet = fromList [pid | (pid, _, _) <- policiesWithAssets] let witnessesProvidedMap :: Map PolicyId (ScriptWitness WitCtxMint era) witnessesProvidedMap = fromList $ [(polid, sWit) | MintScriptWitnessWithPolicyId polid sWit <- scriptWitnesses] witnessesProvidedSet = Map.keysSet witnessesProvidedMap - + policiesWithWitnesses = + Map.fromListWith + (<>) + [ (pid, [(assetName, quantity, BuildTxWith witness)]) + | (pid, assetName, quantity) <- policiesWithAssets + , witness <- maybeToList $ Map.lookup pid witnessesProvidedMap + ] -- Check not too many, nor too few: validateAllWitnessesProvided witnessesNeededSet witnessesProvidedSet validateNoUnnecessaryWitnesses witnessesNeededSet witnessesProvidedSet - return (TxMintValue w val (BuildTxWith witnessesProvidedMap)) + pure $ TxMintValue w policiesWithWitnesses ) era where 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 3ff7db7e95..5b40eb1690 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Script/Mint/Read.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Script/Mint/Read.hs @@ -66,7 +66,7 @@ readMintScriptWitness sbe (OnDiskSimpleRefScript (SimpleRefScriptCliArgs refTxIn MintScriptWitnessWithPolicyId polId $ SimpleScriptWitness (sbeToSimpleScriptLangInEra sbe) - (SReferenceScript refTxIn $ Just $ unPolicyId polId) + (SReferenceScript refTxIn) readMintScriptWitness sbe ( OnDiskPlutusRefScript @@ -74,7 +74,7 @@ readMintScriptWitness ) = do case anyPlutusScriptVersion of AnyPlutusScriptVersion lang -> do - let pScript = PReferenceScript refTxIn $ Just $ unPolicyId polId + let pScript = PReferenceScript refTxIn redeemer <- -- TODO: Implement a new error type to capture this. FileError is not representative of cases -- where we do not have access to the script. diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Script/Mint/Types.hs b/cardano-cli/src/Cardano/CLI/EraBased/Script/Mint/Types.hs index c4c93b9e8f..192e4ed0f3 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Script/Mint/Types.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Script/Mint/Types.hs @@ -18,8 +18,10 @@ where import Cardano.Api -import Cardano.CLI.Read import Cardano.CLI.Types.Common (ScriptDataOrFile) +import Cardano.CLI.Types.Errors.PlutusScriptDecodeError +import Cardano.CLI.Types.Errors.ScriptDataError +import Cardano.CLI.Types.Errors.ScriptDecodeError -- We always need the policy id when constructing a transaction that mints. -- In the case of reference scripts, the user currently must provide the policy id (script hash) diff --git a/cardano-cli/src/Cardano/CLI/Types/Output.hs b/cardano-cli/src/Cardano/CLI/Types/Output.hs index 1e9c5d1240..4f47c4ad95 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Output.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Output.hs @@ -383,7 +383,7 @@ renderScriptCosts (UTxO utxo) eUnitPrices scriptMapping executionCostMapping = Left err -> Left (PlutusScriptCostErrExecError sWitInd (Just scriptHash) err) : accum -- TODO: Create a new sum type to encapsulate the fact that we can also -- have a txin and render the txin in the case of reference scripts. - Just (AnyScriptWitness (PlutusScriptWitness _ _ (PReferenceScript refTxIn _) _ _ _)) -> + Just (AnyScriptWitness (PlutusScriptWitness _ _ (PReferenceScript refTxIn) _ _ _)) -> case Map.lookup refTxIn utxo of Nothing -> Left (PlutusScriptCostErrRefInputNotInUTxO refTxIn) : accum Just (TxOut _ _ _ refScript) -> From 5649c78c344c3741751eedb1d3f94155f237907e Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Thu, 21 Nov 2024 12:53:58 -0400 Subject: [PATCH 17/17] Formatting fixes --- cardano-cli/cardano-cli.cabal | 1 - .../src/Cardano/CLI/EraBased/Options/Query.hs | 3 ++- .../Cardano/CLI/EraBased/Run/Governance.hs | 9 +++++--- .../CLI/EraBased/Run/Governance/Actions.hs | 21 ++++++++++++------- .../GenesisKeyDelegationCertificate.hs | 3 ++- .../CLI/EraBased/Run/Governance/Vote.hs | 6 ++++-- .../Types/Errors/PlutusScriptDecodeError.hs | 14 +++++++------ .../CLI/Types/Errors/ScriptDataError.hs | 13 ++++++------ 8 files changed, 42 insertions(+), 28 deletions(-) diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index 5cb7a7d184..296d30527a 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -45,7 +45,6 @@ library if impl(ghc < 9.6) ghc-options: -Wno-redundant-constraints - hs-source-dirs: src exposed-modules: Cardano.CLI.Byron.Commands diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Query.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Query.hs index 031db5e0e3..490e81bd0d 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Query.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Query.hs @@ -678,7 +678,8 @@ pQueryTreasuryValueCmd era envCli = do <*> optional pOutputFile pQueryNoArgCmdArgs - :: forall era. () + :: forall era + . () => ConwayEraOnwards era -> EnvCli -> Parser (QueryNoArgCmdArgs era) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance.hs index 76f93cdf92..2b558ec325 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance.hs @@ -65,7 +65,8 @@ runGovernanceCmds = \case runGovernanceVoteCmds cmds runGovernanceMIRCertificatePayStakeAddrs - :: forall era. ShelleyToBabbageEra era + :: forall era + . ShelleyToBabbageEra era -> L.MIRPot -> [StakeAddress] -- ^ Stake addresses @@ -104,7 +105,8 @@ runGovernanceMIRCertificatePayStakeAddrs w mirPot sAddrs rwdAmts oFp = do mirCertDesc = "Move Instantaneous Rewards Certificate" runGovernanceCreateMirCertificateTransferToTreasuryCmd - :: forall era. () + :: forall era + . () => ShelleyToBabbageEra era -> Lovelace -> File () Out @@ -125,7 +127,8 @@ runGovernanceCreateMirCertificateTransferToTreasuryCmd w ll oFp = do mirCertDesc = "MIR Certificate Send To Treasury" runGovernanceCreateMirCertificateTransferToReservesCmd - :: forall era. () + :: forall era + . () => ShelleyToBabbageEra era -> Lovelace -> File () Out diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Actions.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Actions.hs index e164dcd8ce..33f1c9e78e 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Actions.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Actions.hs @@ -78,7 +78,8 @@ runGovernanceActionViewCmd proposal runGovernanceActionInfoCmd - :: forall era. () + :: forall era + . () => GovernanceActionInfoCmdArgs era -> ExceptT GovernanceActionsError IO () runGovernanceActionInfoCmd @@ -118,7 +119,8 @@ fetchURLErrorToGovernanceActionError adt = withExceptT (GovernanceActionsProposa -- TODO: Conway era - update with new ledger types from cardano-ledger-conway-1.7.0.0 runGovernanceActionCreateNoConfidenceCmd - :: forall era. () + :: forall era + . () => GovernanceActionCreateNoConfidenceCmdArgs era -> ExceptT GovernanceActionsError IO () runGovernanceActionCreateNoConfidenceCmd @@ -166,7 +168,8 @@ runGovernanceActionCreateNoConfidenceCmd writeFileTextEnvelope outFile (Just "Motion of no confidence proposal") proposalProcedure runGovernanceActionCreateConstitutionCmd - :: forall era. () + :: forall era + . () => GovernanceActionCreateConstitutionCmdArgs era -> ExceptT GovernanceActionsError IO () runGovernanceActionCreateConstitutionCmd @@ -226,7 +229,8 @@ runGovernanceActionCreateConstitutionCmd -- TODO: Conway era - After ledger bump update this function -- with the new ledger types runGovernanceActionUpdateCommitteeCmd - :: forall era. () + :: forall era + . () => GovernanceActionUpdateCommitteeCmdArgs era -> ExceptT GovernanceActionsError IO () runGovernanceActionUpdateCommitteeCmd @@ -302,7 +306,8 @@ runGovernanceActionUpdateCommitteeCmd proposal runGovernanceActionCreateProtocolParametersUpdateCmd - :: forall era. () + :: forall era + . () => Cmd.GovernanceActionProtocolParametersUpdateCmdArgs era -> ExceptT GovernanceActionsError IO () runGovernanceActionCreateProtocolParametersUpdateCmd eraBasedPParams' = do @@ -414,7 +419,8 @@ addCostModelsToEraBasedProtocolParametersUpdate ConwayEraBasedProtocolParametersUpdate common (aOn{alCostModels = SJust cmdls}) inB inC runGovernanceActionTreasuryWithdrawalCmd - :: forall era. () + :: forall era + . () => GovernanceActionTreasuryWithdrawalCmdArgs era -> ExceptT GovernanceActionsError IO () runGovernanceActionTreasuryWithdrawalCmd @@ -466,7 +472,8 @@ runGovernanceActionTreasuryWithdrawalCmd writeFileTextEnvelope outFile (Just "Treasury withdrawal proposal") proposal runGovernanceActionHardforkInitCmd - :: forall era. () + :: forall era + . () => GovernanceActionHardforkInitCmdArgs era -> ExceptT GovernanceActionsError IO () runGovernanceActionHardforkInitCmd diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/GenesisKeyDelegationCertificate.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/GenesisKeyDelegationCertificate.hs index 740f5d97b4..b7c1b702b8 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/GenesisKeyDelegationCertificate.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/GenesisKeyDelegationCertificate.hs @@ -15,7 +15,8 @@ import Cardano.CLI.Types.Errors.GovernanceCmdError import Cardano.CLI.Types.Key runGovernanceGenesisKeyDelegationCertificate - :: forall era. ShelleyToBabbageEra era + :: forall era + . ShelleyToBabbageEra era -> VerificationKeyOrHashOrFile GenesisKey -> VerificationKeyOrHashOrFile GenesisDelegateKey -> VerificationKeyOrHashOrFile VrfKey diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Vote.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Vote.hs index 582332f911..4443c46bea 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Vote.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Vote.hs @@ -41,7 +41,8 @@ runGovernanceVoteCmds = \case & firstExceptT CmdGovernanceVoteError runGovernanceVoteCreateCmd - :: forall era. () + :: forall era + . () => Cmd.GovernanceVoteCreateCmdArgs era -> ExceptT GovernanceVoteCmdError IO () runGovernanceVoteCreateCmd @@ -92,7 +93,8 @@ runGovernanceVoteCreateCmd writeFileTextEnvelope outFile Nothing votingProcedures runGovernanceVoteViewCmd - :: forall era. () + :: forall era + . () => Cmd.GovernanceVoteViewCmdArgs era -> ExceptT GovernanceVoteCmdError IO () runGovernanceVoteViewCmd diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/PlutusScriptDecodeError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/PlutusScriptDecodeError.hs index 24effd990a..e00583b194 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Errors/PlutusScriptDecodeError.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/PlutusScriptDecodeError.hs @@ -1,11 +1,13 @@ {-# LANGUAGE LambdaCase #-} -module Cardano.CLI.Types.Errors.PlutusScriptDecodeError - ( PlutusScriptDecodeError(..) - ) where +module Cardano.CLI.Types.Errors.PlutusScriptDecodeError + ( PlutusScriptDecodeError (..) + ) +where -import Cardano.Api -import Data.Text (Text) +import Cardano.Api + +import Data.Text (Text) data PlutusScriptDecodeError = PlutusScriptDecodeErrorUnknownVersion !Text @@ -29,4 +31,4 @@ instance Error PlutusScriptDecodeError where "Version mismatch in code: script version that was read" <> pretty version <> " but tried to decode script version: " - <> pshow v \ No newline at end of file + <> pshow v diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/ScriptDataError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/ScriptDataError.hs index 909c6032cd..aa994380c6 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Errors/ScriptDataError.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/ScriptDataError.hs @@ -1,15 +1,14 @@ {-# LANGUAGE LambdaCase #-} -module Cardano.CLI.Types.Errors.ScriptDataError - ( ScriptDataError(..) +module Cardano.CLI.Types.Errors.ScriptDataError + ( ScriptDataError (..) , renderScriptDataError - ) where - - + ) +where import Cardano.Api -import qualified Cardano.Binary as CBOR +import qualified Cardano.Binary as CBOR data ScriptDataError = ScriptDataErrorFile (FileError ()) @@ -33,4 +32,4 @@ renderScriptDataError = \case ScriptDataErrorMetadataDecode fp decoderErr -> "Error decoding CBOR metadata at: " <> pshow fp <> " Error: " <> pshow decoderErr ScriptDataErrorJsonBytes e -> - prettyError e \ No newline at end of file + prettyError e