diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs index 30e944861d..46e7b25a06 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs @@ -74,7 +74,7 @@ data TransactionBuildRawCmdArgs era = TransactionBuildRawCmdArgs -- ^ Auxiliary scripts , metadataFiles :: ![MetadataFile] , mProtocolParamsFile :: !(Maybe ProtocolParamsFile) - , mUpdateProprosalFile :: !(Maybe UpdateProposalFile) + , mUpdateProprosalFile :: !(Maybe (Featured ShelleyToBabbageEra era (Maybe UpdateProposalFile))) , voteFiles :: ![VoteFile In] , proposalFiles :: ![ProposalFile In] , txBodyOutFile :: !(TxBodyFile Out) @@ -120,7 +120,7 @@ data TransactionBuildCmdArgs era = TransactionBuildCmdArgs , scriptFiles :: ![ScriptFile] -- ^ Auxiliary scripts , metadataFiles :: ![MetadataFile] - , mUpdateProposalFile :: !(Maybe UpdateProposalFile) + , mfUpdateProposalFile :: !(Maybe (Featured ShelleyToBabbageEra era (Maybe UpdateProposalFile))) , voteFiles :: ![VoteFile In] , proposalFiles :: ![ProposalFile In] , buildOutputOptions :: !TxBuildOutputOptions diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs index de393ee5fa..8232eac11f 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs @@ -3246,6 +3246,18 @@ pTxId l h = -- Helpers -------------------------------------------------------------------------------- +pFeatured :: () + => Eon eon + => ToCardanoEra peon + => peon era + -> Parser a + -> Parser (Maybe (Featured eon era a)) +pFeatured peon p = do + let mw = forEraMaybeEon (toCardanoEra peon) + case mw of + Nothing -> pure Nothing + Just eon' -> Just . Featured eon' <$> p + hiddenSubParser :: String -> ParserInfo a -> Parser a hiddenSubParser availableCommand pInfo = Opt.hsubparser $ Opt.command availableCommand pInfo <> Opt.metavar availableCommand <> Opt.hidden diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Transaction.hs index fe7eee164e..61b5a8347b 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Transaction.hs @@ -177,7 +177,7 @@ pTransactionBuild era envCli = Nothing "Filepath of auxiliary script(s)") <*> many pMetadataFile - <*> optional pUpdateProposalFile + <*> pFeatured era (optional pUpdateProposalFile) <*> many (pFileInDirection "vote-file" "Filepath of the vote.") <*> many (pFileInDirection "proposal-file" "Filepath of the proposal.") <*> (OutputTxBodyOnly <$> pTxBodyFileOut <|> pCalculatePlutusScriptCost) @@ -212,7 +212,7 @@ pTransactionBuildRaw era = <*> many (pScriptFor "auxiliary-script-file" Nothing "Filepath of auxiliary script(s)") <*> many pMetadataFile <*> optional pProtocolParamsFile - <*> optional pUpdateProposalFile + <*> pFeatured era (optional pUpdateProposalFile) <*> many (pFileInDirection "vote-file" "Filepath of the vote.") <*> many (pFileInDirection "proposal-file" "Filepath of the proposal.") <*> pTxBodyFileOut diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs index 172c2679b7..fea8c2deff 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs @@ -121,7 +121,7 @@ runTransactionBuildCmd , metadataSchema , scriptFiles , metadataFiles - , mUpdateProposalFile + , mfUpdateProposalFile , voteFiles , proposalFiles , buildOutputOptions @@ -160,8 +160,11 @@ runTransactionBuildCmd mapM (readFileScriptInAnyLang . unScriptFile) scriptFiles txAuxScripts <- hoistEither $ first TxCmdAuxScriptsValidationError $ validateTxAuxScripts eon scripts - mProp <- forM mUpdateProposalFile $ \(UpdateProposalFile upFp) -> - firstExceptT TxCmdReadTextViewFileError (newExceptT $ readFileTextEnvelope AsUpdateProposal (File upFp)) + mProp <- case mfUpdateProposalFile of + Just (Featured w (Just updateProposalFile)) -> + readTxUpdateProposal w updateProposalFile & firstExceptT TxCmdReadTextViewFileError + _ -> pure TxUpdateProposalNone + requiredSigners <- mapM (firstExceptT TxCmdRequiredSignerError . newExceptT . readRequiredSigner) reqSigners mReturnCollateral <- forM mReturnColl $ toTxOutInAnyEra eon @@ -324,8 +327,10 @@ runTransactionBuildRawCmd firstExceptT TxCmdProtocolParamsConverstionError . hoistEither $ convertToLedgerProtocolParameters sbe pp - mProp <- forM mUpdateProprosalFile $ \(UpdateProposalFile upFp) -> - firstExceptT TxCmdReadTextViewFileError (newExceptT $ readFileTextEnvelope AsUpdateProposal (File upFp)) + txUpdateProposal <- case mUpdateProprosalFile of + Just (Featured w (Just updateProposalFile)) -> + readTxUpdateProposal w updateProposalFile & firstExceptT TxCmdReadTextViewFileError + _ -> pure TxUpdateProposalNone requiredSigners <- mapM (firstExceptT TxCmdRequiredSignerError . newExceptT . readRequiredSigner) reqSigners mReturnCollateral <- forM mReturnColl $ toTxOutInAnyEra eon @@ -350,7 +355,7 @@ runTransactionBuildRawCmd eon mScriptValidity inputsAndMaybeScriptWits readOnlyRefIns filteredTxinsc mReturnCollateral mTotalCollateral txOuts mValidityLowerBound mValidityUpperBound fee valuesWithScriptWits certsAndMaybeScriptWits withdrawalsAndMaybeScriptWits requiredSigners txAuxScripts - txMetadata mLedgerPParams mProp votingProcedures proposals + txMetadata mLedgerPParams txUpdateProposal votingProcedures proposals let noWitTx = makeSignedTransaction [] txBody lift (cardanoEraConstraints eon $ writeTxFileTextEnvelopeCddl eon txBodyOutFile noWitTx) @@ -388,7 +393,7 @@ runTxBuildRaw :: () -> TxAuxScripts era -> TxMetadataInEra era -> Maybe (LedgerProtocolParameters era) - -> Maybe UpdateProposal + -> TxUpdateProposal era -> VotingProcedures era -> [Proposal era] -> Either TxCmdError (TxBody era) @@ -399,7 +404,7 @@ runTxBuildRaw era mLowerBound mUpperBound mFee valuesWithScriptWits certsAndMaybeSriptWits withdrawals reqSigners - txAuxScripts txMetadata mpparams mUpdateProp votingProcedures proposals = do + txAuxScripts txMetadata mpparams txUpdateProposal votingProcedures proposals = do let allReferenceInputs = getAllReferenceInputs inputsAndMaybeScriptWits @@ -426,8 +431,6 @@ runTxBuildRaw era <- first TxCmdTxWithdrawalsValidationError $ validateTxWithdrawals era withdrawals validatedTxCerts <- first TxCmdTxCertificatesValidationError $ validateTxCertificates era certsAndMaybeSriptWits - validatedTxUpProp - <- first TxCmdTxUpdateProposalValidationError $ validateTxUpdateProposal era mUpdateProp validatedMintValue <- createTxMintValue era valuesWithScriptWits validatedTxScriptValidity @@ -450,7 +453,7 @@ runTxBuildRaw era , txProtocolParams = validatedPParams , txWithdrawals = validatedTxWtdrwls , txCertificates = validatedTxCerts - , txUpdateProposal = validatedTxUpProp + , txUpdateProposal = txUpdateProposal , txMintValue = validatedMintValue , txScriptValidity = validatedTxScriptValidity , txProposalProcedures = forEraInEonMaybe era (`Featured` validatedTxProposal) @@ -494,7 +497,7 @@ runTxBuild :: () -- ^ Required signers -> TxAuxScripts era -> TxMetadataInEra era - -> Maybe UpdateProposal + -> TxUpdateProposal era -> Maybe Word -> VotingProcedures era -> [Proposal era] @@ -505,7 +508,7 @@ runTxBuild inputsAndMaybeScriptWits readOnlyRefIns txinsc mReturnCollateral mTotCollateral txouts (TxOutChangeAddress changeAddr) valuesWithScriptWits mLowerBound mUpperBound certsAndMaybeScriptWits withdrawals reqSigners txAuxScripts txMetadata - mUpdatePropF mOverrideWits votingProcedures proposals outputOptions = cardanoEraConstraints era $ do + txUpdateProposal mOverrideWits votingProcedures proposals outputOptions = cardanoEraConstraints era $ do let consensusMode = consensusModeOnly cModeParams dummyFee = Just $ Lovelace 0 @@ -530,7 +533,6 @@ runTxBuild validatedReqSigners <- hoistEither (first TxCmdRequiredSignersValidationError $ validateRequiredSigners era reqSigners) validatedTxWtdrwls <- hoistEither (first TxCmdTxWithdrawalsValidationError $ validateTxWithdrawals era withdrawals) validatedTxCerts <- hoistEither (first TxCmdTxCertificatesValidationError $ validateTxCertificates era certsAndMaybeScriptWits) - validatedTxUpProp <- hoistEither (first TxCmdTxUpdateProposalValidationError $ validateTxUpdateProposal era mUpdatePropF) validatedMintValue <- hoistEither $ createTxMintValue era valuesWithScriptWits validatedTxScriptValidity <- hoistEither (first TxCmdScriptValidityValidationError $ validateTxScriptValidity era mScriptValidity) @@ -584,7 +586,7 @@ runTxBuild , txProtocolParams = validatedPParams , txWithdrawals = validatedTxWtdrwls , txCertificates = validatedTxCerts - , txUpdateProposal = validatedTxUpProp + , txUpdateProposal = txUpdateProposal , txMintValue = validatedMintValue , txScriptValidity = validatedTxScriptValidity , txProposalProcedures = forEraInEonMaybe era (`Featured` validatedTxProposalProcedures) diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/Legacy/Run/Transaction.hs index b26c3249e9..0f8cd3a665 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Run/Transaction.hs @@ -16,9 +16,12 @@ import Cardano.CLI.EraBased.Run.Transaction import Cardano.CLI.Legacy.Commands.Transaction import Cardano.CLI.Types.Common import Cardano.CLI.Types.Errors.TxCmdError +import Cardano.CLI.Types.Errors.TxValidationError import Cardano.CLI.Types.Governance import Control.Monad.Trans.Except +import Control.Monad.Trans.Except.Extra +import Data.Function runLegacyTransactionCmds :: LegacyTransactionCmds -> ExceptT TxCmdError IO () @@ -94,13 +97,19 @@ runLegacyTransactionBuildCmd socketPath (AnyCardanoEra era) consensusModeParams nid mScriptValidity mOverrideWits txins readOnlyRefIns reqSigners txinsc mReturnColl mTotCollateral txouts changeAddr mValue mLowBound - mUpperBound certs wdrls metadataSchema scriptFiles metadataFiles mUpProp voteFiles - proposalFiles outputOptions = + mUpperBound certs wdrls metadataSchema scriptFiles metadataFiles mUpdateProposal voteFiles + proposalFiles outputOptions = do + + mfUpdateProposalFile <- + validateUpdateProposalFile era mUpdateProposal + & hoistEither + & firstExceptT TxCmdTxUpdateProposalValidationError + runTransactionBuildCmd ( Cmd.TransactionBuildCmdArgs era socketPath consensusModeParams nid mScriptValidity mOverrideWits txins readOnlyRefIns reqSigners txinsc mReturnColl mTotCollateral txouts changeAddr mValue mLowBound - mUpperBound certs wdrls metadataSchema scriptFiles metadataFiles mUpProp voteFiles + mUpperBound certs wdrls metadataSchema scriptFiles metadataFiles mfUpdateProposalFile voteFiles proposalFiles outputOptions ) @@ -130,12 +139,19 @@ runLegacyTransactionBuildRawCmd :: () runLegacyTransactionBuildRawCmd (AnyCardanoEra era) mScriptValidity txins readOnlyRefIns txinsc mReturnColl mTotColl reqSigners txouts mValue mLowBound mUpperBound fee certs wdrls - metadataSchema scriptFiles metadataFiles mProtocolParamsFile mUpProp outFile = + metadataSchema scriptFiles metadataFiles mProtocolParamsFile mUpdateProposal + outFile = do + + mfUpdateProposalFile <- + validateUpdateProposalFile era mUpdateProposal + & hoistEither + & firstExceptT TxCmdTxUpdateProposalValidationError + runTransactionBuildRawCmd ( Cmd.TransactionBuildRawCmdArgs era mScriptValidity txins readOnlyRefIns txinsc mReturnColl mTotColl reqSigners txouts mValue mLowBound mUpperBound fee certs wdrls - metadataSchema scriptFiles metadataFiles mProtocolParamsFile mUpProp [] [] + metadataSchema scriptFiles metadataFiles mProtocolParamsFile mfUpdateProposalFile [] [] outFile ) diff --git a/cardano-cli/src/Cardano/CLI/Read.hs b/cardano-cli/src/Cardano/CLI/Read.hs index 499fa84616..4773b65f66 100644 --- a/cardano-cli/src/Cardano/CLI/Read.hs +++ b/cardano-cli/src/Cardano/CLI/Read.hs @@ -85,6 +85,8 @@ module Cardano.CLI.Read , scriptHashReader + -- * Update proposals + , readTxUpdateProposal -- * Vote related , readVoteDelegationTarget @@ -788,6 +790,13 @@ readVotingProceduresFiles w = \case pure $ foldl unsafeMergeVotingProcedures emptyVotingProcedures vpss +readTxUpdateProposal :: () + => ShelleyToBabbageEra era + -> UpdateProposalFile + -> ExceptT (FileError TextEnvelopeError) IO (TxUpdateProposal era) +readTxUpdateProposal w (UpdateProposalFile upFp) = do + TxUpdateProposal w <$> newExceptT (readFileTextEnvelope AsUpdateProposal (File upFp)) + readVotingProceduresFile :: () => ConwayEraOnwards era -> VoteFile In diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/TxValidationError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/TxValidationError.hs index ad14c7b7de..0f1f28c5e2 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Errors/TxValidationError.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/TxValidationError.hs @@ -28,16 +28,18 @@ module Cardano.CLI.Types.Errors.TxValidationError , validateTxReturnCollateral , validateTxScriptValidity , validateTxTotalCollateral - , validateTxUpdateProposal , validateTxValidityUpperBound , validateTxValidityLowerBound , validateTxWithdrawals + , validateUpdateProposalFile ) where import Cardano.Api import qualified Cardano.Api.Ledger as L import Cardano.Api.Shelley +import Cardano.CLI.Types.Common + import Prelude import Data.Bifunctor (first) @@ -316,15 +318,6 @@ instance Error TxUpdateProposalValidationError where displayError (TxUpdateProposalNotSupported e) = "Transaction update proposal is not supported in " <> Text.unpack (renderEra e) -validateTxUpdateProposal - :: CardanoEra era - -> Maybe UpdateProposal - -> Either TxUpdateProposalValidationError (TxUpdateProposal era) -validateTxUpdateProposal _ Nothing = return TxUpdateProposalNone -validateTxUpdateProposal era (Just prop) = do - supported <- conjureWitness era TxUpdateProposalNotSupported - pure $ TxUpdateProposal supported prop - newtype TxScriptValidityValidationError = ScriptValidityNotSupported AnyCardanoEra deriving Show @@ -342,6 +335,16 @@ validateTxScriptValidity era (Just scriptValidity) = do supported <- conjureWitness era ScriptValidityNotSupported pure $ TxScriptValidity supported scriptValidity +-- TODO legacy. This can be deleted when legacy commands are removed. +validateUpdateProposalFile + :: CardanoEra era + -> Maybe UpdateProposalFile + -> Either TxUpdateProposalValidationError (Maybe (Featured ShelleyToBabbageEra era (Maybe UpdateProposalFile))) +validateUpdateProposalFile era = \case + Nothing -> pure Nothing + Just updateProposal -> do + supported <- conjureWitness era TxUpdateProposalNotSupported + pure $ Just $ Featured supported $ Just updateProposal conjureWitness :: Eon eon => CardanoEra era -- ^ era to try to conjure eon from diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help.cli index 773c2dbdb3..12bcb60bda 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help.cli @@ -7100,7 +7100,6 @@ Usage: cardano-cli conway transaction build-raw | --metadata-cbor-file FILE ] [--protocol-params-file FILE] - [--update-proposal-file FILE] [--vote-file FILE] [--proposal-file FILE] --out-file FILE @@ -7221,7 +7220,6 @@ Usage: cardano-cli conway transaction build --socket-path SOCKET_PATH [ --metadata-json-file FILE | --metadata-cbor-file FILE ] - [--update-proposal-file FILE] [--vote-file FILE] [--proposal-file FILE] ( --out-file FILE diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_transaction_build-raw.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_transaction_build-raw.cli index 776f2fce16..ff12af6706 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_transaction_build-raw.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_transaction_build-raw.cli @@ -112,7 +112,6 @@ Usage: cardano-cli conway transaction build-raw | --metadata-cbor-file FILE ] [--protocol-params-file FILE] - [--update-proposal-file FILE] [--vote-file FILE] [--proposal-file FILE] --out-file FILE @@ -381,8 +380,6 @@ Available options: Filepath of the metadata, in raw CBOR format. --protocol-params-file FILE Filepath of the JSON-encoded protocol parameters file - --update-proposal-file FILE - Filepath of the update proposal. --vote-file FILE Filepath of the vote. --proposal-file FILE Filepath of the proposal. --out-file FILE Output filepath of the JSON TxBody. diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_transaction_build.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_transaction_build.cli index d6d86d2b01..67d7da4051 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_transaction_build.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_transaction_build.cli @@ -110,7 +110,6 @@ Usage: cardano-cli conway transaction build --socket-path SOCKET_PATH [ --metadata-json-file FILE | --metadata-cbor-file FILE ] - [--update-proposal-file FILE] [--vote-file FILE] [--proposal-file FILE] ( --out-file FILE @@ -382,8 +381,6 @@ Available options: Filepath of the metadata file, in JSON format. --metadata-cbor-file FILE Filepath of the metadata, in raw CBOR format. - --update-proposal-file FILE - Filepath of the update proposal. --vote-file FILE Filepath of the vote. --proposal-file FILE Filepath of the proposal. --out-file FILE Output filepath of the JSON TxBody.