From eda3544dbeb74b4683d803df2eca1c508c1f9af0 Mon Sep 17 00:00:00 2001 From: John Ky Date: Sat, 28 Oct 2023 04:11:02 +1100 Subject: [PATCH] Fix CLI support for TxValidityUpperBound --- .../CLI/EraBased/Commands/Transaction.hs | 4 +- .../Cardano/CLI/EraBased/Options/Common.hs | 74 +++++++++++++------ .../CLI/EraBased/Options/Transaction.hs | 10 +-- .../Cardano/CLI/EraBased/Run/Transaction.hs | 11 +-- cardano-cli/src/Cardano/CLI/Json/Friendly.hs | 10 --- cardano-cli/src/Cardano/CLI/Legacy/Options.hs | 4 +- .../src/Cardano/CLI/Legacy/Run/Transaction.hs | 17 ++++- .../files/golden/allegra/transaction-view.out | 3 +- .../files/golden/shelley/transaction-view.out | 3 +- 9 files changed, 84 insertions(+), 52 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs index 3a7a36d7f7..a227a08dd2 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs @@ -62,7 +62,7 @@ data TransactionBuildRawCmdArgs era = TransactionBuildRawCmdArgs -- ^ Multi-Asset value with script witness , mValidityLowerBound :: !(Maybe SlotNo) -- ^ Transaction validity lower bound - , mValidityUpperBound :: !(Maybe SlotNo) + , mValidityUpperBound :: !(TxValidityUpperBound era) -- ^ Transaction validity upper bound , fee :: !(Maybe Lovelace) -- ^ Transaction fee @@ -110,7 +110,7 @@ data TransactionBuildCmdArgs era = TransactionBuildCmdArgs -- ^ Multi-Asset value with script witness , mValidityLowerBound :: !(Maybe SlotNo) -- ^ Transaction validity lower bound - , mValidityUpperBound :: !(Maybe SlotNo) + , mValidityUpperBound :: !(TxValidityUpperBound era) -- ^ Transaction validity upper bound , certificates :: ![(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))] -- ^ Certificates with potential script witness diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs index 0f8f0ff578..8d6763a64f 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs @@ -2077,30 +2077,62 @@ pInvalidBefore = fmap SlotNo $ asum ] ] -pInvalidHereafter :: Parser SlotNo -pInvalidHereafter = +pLegacyInvalidHereafter :: Parser SlotNo +pLegacyInvalidHereafter = fmap SlotNo $ asum - [ Opt.option (bounded "SLOT") $ mconcat - [ Opt.long "invalid-hereafter" - , Opt.metavar "SLOT" - , Opt.help "Time that transaction is valid until (in slots)." - ] - , Opt.option (bounded "SLOT") $ mconcat - [ Opt.long "upper-bound" - , Opt.metavar "SLOT" - , Opt.help $ mconcat - [ "Time that transaction is valid until (in slots) " - , "(deprecated; use --invalid-hereafter instead)." + [ Opt.option (bounded "SLOT") $ mconcat + [ Opt.long "invalid-hereafter" + , Opt.metavar "SLOT" + , Opt.help "Time that transaction is valid until (in slots)." + ] + , Opt.option (bounded "SLOT") $ mconcat + [ Opt.long "upper-bound" + , Opt.metavar "SLOT" + , Opt.help $ mconcat + [ "Time that transaction is valid until (in slots) " + , "(deprecated; use --invalid-hereafter instead)." + ] + , Opt.internal + ] + , Opt.option (bounded "SLOT") $ mconcat + [ Opt.long "ttl" + , Opt.metavar "SLOT" + , Opt.help "Time to live (in slots) (deprecated; use --invalid-hereafter instead)." + , Opt.internal ] - , Opt.internal - ] - , Opt.option (bounded "SLOT") $ mconcat - [ Opt.long "ttl" - , Opt.metavar "SLOT" - , Opt.help "Time to live (in slots) (deprecated; use --invalid-hereafter instead)." - , Opt.internal ] - ] + +pInvalidHereafter :: () + => CardanoEra era + -> Parser (TxValidityUpperBound era) +pInvalidHereafter = + caseByronOrShelleyBasedEra + (pure . TxValidityNoUpperBound) + (\eon -> + fmap (TxValidityUpperBound eon) $ asum + [ fmap (Just . SlotNo) $ Opt.option (bounded "SLOT") $ mconcat + [ Opt.long "invalid-hereafter" + , Opt.metavar "SLOT" + , Opt.help "Time that transaction is valid until (in slots)." + ] + , fmap (Just . SlotNo) $ Opt.option (bounded "SLOT") $ mconcat + [ Opt.long "upper-bound" + , Opt.metavar "SLOT" + , Opt.help $ mconcat + [ "Time that transaction is valid until (in slots) " + , "(deprecated; use --invalid-hereafter instead)." + ] + , Opt.internal + ] + , fmap (Just . SlotNo) $ Opt.option (bounded "SLOT") $ mconcat + [ Opt.long "ttl" + , Opt.metavar "SLOT" + , Opt.help "Time to live (in slots) (deprecated; use --invalid-hereafter instead)." + , Opt.internal + ] + , pure Nothing + ] + ) pTxFee :: Parser Lovelace pTxFee = diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Transaction.hs index 220457b798..13b1211dc4 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Transaction.hs @@ -155,9 +155,9 @@ pTransactionBuildCmd era envCli = do ] where pCmd :: ShelleyBasedEra era -> Parser (TransactionCmds era) - pCmd w = + pCmd sbe = fmap TransactionBuildCmd $ - TransactionBuildCmdArgs w + TransactionBuildCmdArgs sbe <$> pSocketPath envCli <*> pConsensusModeParams <*> pNetworkId envCli @@ -173,7 +173,7 @@ pTransactionBuildCmd era envCli = do <*> pChangeAddress <*> optional (pMintMultiAsset AutoBalance) <*> optional pInvalidBefore - <*> optional pInvalidHereafter + <*> pInvalidHereafter (shelleyBasedToCardanoEra sbe) <*> many (pCertificateFile AutoBalance) <*> many (pWithdrawal AutoBalance) <*> pTxMetadataJsonSchema @@ -182,7 +182,7 @@ pTransactionBuildCmd era envCli = do Nothing "Filepath of auxiliary script(s)") <*> many pMetadataFile - <*> pFeatured (shelleyBasedToCardanoEra w) (optional pUpdateProposalFile) + <*> pFeatured (shelleyBasedToCardanoEra sbe) (optional pUpdateProposalFile) <*> many (pFileInDirection "vote-file" "Filepath of the vote.") <*> many (pFileInDirection "proposal-file" "Filepath of the proposal.") <*> (OutputTxBodyOnly <$> pTxBodyFileOut <|> pCalculatePlutusScriptCost) @@ -209,7 +209,7 @@ pTransactionBuildRaw era = <*> many pTxOut <*> optional (pMintMultiAsset ManualBalance) <*> optional pInvalidBefore - <*> optional pInvalidHereafter + <*> pInvalidHereafter era <*> optional pTxFee <*> many (pCertificateFile ManualBalance ) <*> many (pWithdrawal ManualBalance) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs index 3bec842026..437db0bfe4 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs @@ -376,7 +376,7 @@ runTxBuildRaw :: () -> [TxOut CtxTx era] -> Maybe SlotNo -- ^ Tx lower bound - -> Maybe SlotNo + -> TxValidityUpperBound era -- ^ Tx upper bound -> Maybe Lovelace -- ^ Tx fee @@ -420,8 +420,6 @@ runTxBuildRaw era <- first TxCmdTxFeeValidationError $ validateTxFee era mFee validatedLowerBound <- first TxCmdTxValidityLowerBoundValidationError (validateTxValidityLowerBound era mLowerBound) - validatedUpperBound - <- first TxCmdTxValidityUpperBoundValidationError (validateTxValidityUpperBound era mUpperBound) validatedReqSigners <- first TxCmdRequiredSignersValidationError $ validateRequiredSigners era reqSigners validatedPParams @@ -446,7 +444,7 @@ runTxBuildRaw era , txReturnCollateral = validatedRetCol , txFee = validatedFee , txValidityLowerBound = validatedLowerBound - , txValidityUpperBound = validatedUpperBound + , txValidityUpperBound = mUpperBound , txMetadata = txMetadata , txAuxScripts = txAuxScripts , txExtraKeyWits = validatedReqSigners @@ -488,7 +486,7 @@ runTxBuild :: () -- ^ Multi-Asset value(s) -> Maybe SlotNo -- ^ Tx lower bound - -> Maybe SlotNo + -> TxValidityUpperBound era -- ^ Tx upper bound -> [(Certificate era, Maybe (ScriptWitness WitCtxStake era))] -- ^ Certificate with potential script witness @@ -532,7 +530,6 @@ runTxBuild <- hoistEither $ first TxCmdReturnCollateralValidationError $ validateTxReturnCollateral era mReturnCollateral dFee <- hoistEither $ first TxCmdTxFeeValidationError $ validateTxFee era dummyFee validatedLowerBound <- hoistEither (first TxCmdTxValidityLowerBoundValidationError (validateTxValidityLowerBound era mLowerBound)) - validatedUpperBound <- hoistEither (first TxCmdTxValidityUpperBoundValidationError (validateTxValidityUpperBound era mUpperBound)) validatedReqSigners <- hoistEither (first TxCmdRequiredSignersValidationError $ validateRequiredSigners era reqSigners) validatedTxWtdrwls <- hoistEither (first TxCmdTxWithdrawalsValidationError $ validateTxWithdrawals era withdrawals) validatedTxCerts <- hoistEither (first TxCmdTxCertificatesValidationError $ validateTxCertificates era certsAndMaybeScriptWits) @@ -583,7 +580,7 @@ runTxBuild , txReturnCollateral = validatedRetCol , txFee = dFee , txValidityLowerBound = validatedLowerBound - , txValidityUpperBound = validatedUpperBound + , txValidityUpperBound = mUpperBound , txMetadata = txMetadata , txAuxScripts = txAuxScripts , txExtraKeyWits = validatedReqSigners diff --git a/cardano-cli/src/Cardano/CLI/Json/Friendly.hs b/cardano-cli/src/Cardano/CLI/Json/Friendly.hs index d4847b5896..4385cb7a60 100644 --- a/cardano-cli/src/Cardano/CLI/Json/Friendly.hs +++ b/cardano-cli/src/Cardano/CLI/Json/Friendly.hs @@ -188,21 +188,11 @@ friendlyExtraKeyWits = \case TxExtraKeyWitnessesNone -> Null TxExtraKeyWitnesses _supported paymentKeyHashes -> toJSON paymentKeyHashes --- | Special case of validity range: --- in Shelley, upper bound is TTL, and no lower bound -pattern ShelleyTtl - :: Maybe SlotNo -> (TxValidityLowerBound era, TxValidityUpperBound era) -pattern ShelleyTtl ttl <- - ( TxValidityNoLowerBound - , TxValidityUpperBound _ ttl - ) - friendlyValidityRange :: CardanoEra era -> (TxValidityLowerBound era, TxValidityUpperBound era) -> Aeson.Value friendlyValidityRange era = \case - ShelleyTtl ttl -> object ["time to live" .= ttl] (lowerBound, upperBound) | isLowerBoundSupported || isUpperBoundSupported -> object diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Options.hs b/cardano-cli/src/Cardano/CLI/Legacy/Options.hs index 96349e0129..95bf1f8eb2 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Options.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Options.hs @@ -324,7 +324,7 @@ pTransaction envCli = <*> pChangeAddress <*> optional (pMintMultiAsset AutoBalance) <*> optional pInvalidBefore - <*> optional pInvalidHereafter + <*> optional pLegacyInvalidHereafter <*> many (pCertificateFile AutoBalance) <*> many (pWithdrawal AutoBalance) <*> pTxMetadataJsonSchema @@ -360,7 +360,7 @@ pTransaction envCli = <*> many pTxOut <*> optional (pMintMultiAsset ManualBalance) <*> optional pInvalidBefore - <*> optional pInvalidHereafter + <*> optional pLegacyInvalidHereafter <*> optional pTxFee <*> many (pCertificateFile ManualBalance ) <*> many (pWithdrawal ManualBalance) diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/Legacy/Run/Transaction.hs index f4f371e0b4..c490945013 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Run/Transaction.hs @@ -104,11 +104,13 @@ runLegacyTransactionBuildCmd & hoistEither & firstExceptT TxCmdTxUpdateProposalValidationError + let upperBound = TxValidityUpperBound sbe mUpperBound + runTransactionBuildCmd ( Cmd.TransactionBuildCmdArgs sbe socketPath consensusModeParams nid mScriptValidity mOverrideWits txins readOnlyRefIns reqSigners txinsc mReturnColl mTotCollateral txouts changeAddr mValue mLowBound - mUpperBound certs wdrls metadataSchema scriptFiles metadataFiles mfUpdateProposalFile voteFiles + upperBound certs wdrls metadataSchema scriptFiles metadataFiles mfUpdateProposalFile voteFiles proposalFiles outputOptions ) @@ -136,7 +138,7 @@ runLegacyTransactionBuildRawCmd :: () -> TxBodyFile Out -> ExceptT TxCmdError IO () runLegacyTransactionBuildRawCmd - (AnyCardanoEra era) mScriptValidity txins readOnlyRefIns txinsc mReturnColl + anyEra@(AnyCardanoEra era) mScriptValidity txins readOnlyRefIns txinsc mReturnColl mTotColl reqSigners txouts mValue mLowBound mUpperBound fee certs wdrls metadataSchema scriptFiles metadataFiles mProtocolParamsFile mUpdateProposal outFile = do @@ -146,10 +148,19 @@ runLegacyTransactionBuildRawCmd & hoistEither & firstExceptT TxCmdTxUpdateProposalValidationError + upperBound <- + caseByronOrShelleyBasedEra + (\w -> case mUpperBound of + Nothing -> pure $ TxValidityNoUpperBound w + Just _ -> left $ TxCmdTxValidityUpperBoundValidationError $ TxValidityUpperBoundNotSupported anyEra + ) + (\w -> pure $ TxValidityUpperBound w mUpperBound) + era + runTransactionBuildRawCmd ( Cmd.TransactionBuildRawCmdArgs era mScriptValidity txins readOnlyRefIns txinsc mReturnColl - mTotColl reqSigners txouts mValue mLowBound mUpperBound fee certs wdrls + mTotColl reqSigners txouts mValue mLowBound upperBound fee certs wdrls metadataSchema scriptFiles metadataFiles mProtocolParamsFile mfUpdateProposalFile [] [] outFile ) diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/allegra/transaction-view.out b/cardano-cli/test/cardano-cli-golden/files/golden/allegra/transaction-view.out index 8fe812eff0..b4a82f94d2 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/allegra/transaction-view.out +++ b/cardano-cli/test/cardano-cli-golden/files/golden/allegra/transaction-view.out @@ -22,5 +22,6 @@ return collateral: null total collateral: null update proposal: null validity range: - time to live: 101 + lower bound: null + upper bound: 101 withdrawals: null diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/shelley/transaction-view.out b/cardano-cli/test/cardano-cli-golden/files/golden/shelley/transaction-view.out index 774c2780d4..e8f51f0365 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/shelley/transaction-view.out +++ b/cardano-cli/test/cardano-cli-golden/files/golden/shelley/transaction-view.out @@ -72,7 +72,8 @@ update proposal: transaction fee linear per byte: 76 treasury expansion: 87/88 validity range: - time to live: 33 + lower bound: null + upper bound: 33 withdrawals: - address: stake_test1up00fz9lyqs5sjks82k22eqz7a9srym9vysjgp3h2ua2v2cm522kg amount: 42 Lovelace