diff --git a/cabal.project b/cabal.project index c5157d0c77..4a5bbdfee8 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 2023-11-20T23:52:53Z - , cardano-haskell-packages 2023-11-30T13:34:52Z + , cardano-haskell-packages 2023-12-04T19:04:02Z packages: cardano-cli diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index 83aecb26b0..0b1a73db19 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -196,7 +196,7 @@ library , binary , bytestring , canonical-json - , cardano-api ^>= 8.35.0.0 + , cardano-api ^>= 8.36.0.1 , cardano-binary , cardano-crypto , cardano-crypto-class ^>= 2.1.2 diff --git a/cardano-cli/src/Cardano/CLI/Byron/Run.hs b/cardano-cli/src/Cardano/CLI/Byron/Run.hs index 82517c932f..5c17012eee 100644 --- a/cardano-cli/src/Cardano/CLI/Byron/Run.hs +++ b/cardano-cli/src/Cardano/CLI/Byron/Run.hs @@ -9,7 +9,7 @@ module Cardano.CLI.Byron.Run ) where import Cardano.Api hiding (GenesisParameters, UpdateProposal) -import Cardano.Api.Byron (SomeByronSigningKey (..)) +import Cardano.Api.Byron (SomeByronSigningKey (..), serializeByronTx) import qualified Cardano.Chain.Genesis as Genesis import Cardano.CLI.Byron.Commands @@ -195,8 +195,10 @@ runSpendGenesisUTxO genesisFile nw bKeyFormat (NewTxFile ctTx) ctKey genRichAddr sk <- firstExceptT ByronCmdKeyFailure $ readByronSigningKey bKeyFormat ctKey let tx = txSpendGenesisUTxOByronPBFT genesis nw sk genRichAddr outs - firstExceptT ByronCmdHelpersError . ensureNewFileLBS ctTx $ serialiseToCBOR tx + firstExceptT ByronCmdHelpersError . ensureNewFileLBS ctTx + $ teCddlRawCBOR $ serializeByronTx tx +-- Construct a Byron era tx runSpendUTxO :: NetworkId -> ByronKeyFormat @@ -209,4 +211,5 @@ runSpendUTxO nw bKeyFormat (NewTxFile ctTx) ctKey ins outs = do sk <- firstExceptT ByronCmdKeyFailure $ readByronSigningKey bKeyFormat ctKey let gTx = txSpendUTxOByronPBFT nw sk ins outs - firstExceptT ByronCmdHelpersError . ensureNewFileLBS ctTx $ serialiseToCBOR gTx + firstExceptT ByronCmdHelpersError . ensureNewFileLBS ctTx + $ teCddlRawCBOR $ serializeByronTx gTx diff --git a/cardano-cli/src/Cardano/CLI/Byron/Tx.hs b/cardano-cli/src/Cardano/CLI/Byron/Tx.hs index eba3468645..8fa70d995a 100644 --- a/cardano-cli/src/Cardano/CLI/Byron/Tx.hs +++ b/cardano-cli/src/Cardano/CLI/Byron/Tx.hs @@ -27,7 +27,6 @@ where import Cardano.Api import Cardano.Api.Byron -import qualified Cardano.Api.Byron as Api import qualified Cardano.Api.Ledger as L import Cardano.Api.Pretty @@ -149,13 +148,13 @@ txSpendGenesisUTxOByronPBFT -> SomeByronSigningKey -> Address ByronAddr -> [TxOut CtxTx ByronEra] - -> Tx ByronEra + -> ATxAux ByteString txSpendGenesisUTxOByronPBFT gc nId sk (ByronAddress bAddr) outs = let txins = [(fromByronTxIn txIn, BuildTxWith (KeyWitness KeyWitnessForSpending))] in case makeByronTransactionBody txins outs of Left err -> error $ "Error occurred while creating a Byron genesis based UTxO transaction: " <> show err Right txBody -> let bWit = fromByronWitness sk nId txBody - in Api.ByronTx ByronEraOnlyByron $ makeSignedByronTransaction [bWit] txBody + in makeSignedByronTransaction [bWit] txBody where ByronVerificationKey vKey = byronWitnessToVerKey sk @@ -169,14 +168,14 @@ txSpendUTxOByronPBFT -> SomeByronSigningKey -> [TxIn] -> [TxOut CtxTx ByronEra] - -> Tx ByronEra + -> ATxAux ByteString txSpendUTxOByronPBFT nId sk txIns outs = do let apiTxIns = [ ( txIn, BuildTxWith (KeyWitness KeyWitnessForSpending)) | txIn <- txIns] case makeByronTransactionBody apiTxIns outs of Left err -> error $ "Error occurred while creating a Byron genesis based UTxO transaction: " <> show err Right txBody -> let bWit = fromByronWitness sk nId txBody - in Api.ByronTx ByronEraOnlyByron $ makeSignedByronTransaction [bWit] txBody + in makeSignedByronTransaction [bWit] txBody fromByronWitness :: SomeByronSigningKey -> NetworkId -> L.Annotated L.Tx ByteString -> KeyWitness ByronEra diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs index b806a5d561..500eeff5bd 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs @@ -167,7 +167,7 @@ runTransactionBuildCmd requiredSigners <- mapM (firstExceptT TxCmdRequiredSignerError . newExceptT . readRequiredSigner) reqSigners mReturnCollateral <- forM mReturnColl $ toTxOutInShelleyBasedEra eon - txOuts <- mapM (toTxOutInAnyEra era) txouts + txOuts <- mapM (toTxOutInAnyEra eon) txouts -- Conway related votingProcedures <- @@ -242,7 +242,7 @@ runTransactionBuildCmd OutputTxBodyOnly fpath -> let noWitTx = makeSignedTransaction [] balancedTxBody - in lift (cardanoEraConstraints era $ writeTxFileTextEnvelopeCddl era fpath noWitTx) + in lift (cardanoEraConstraints era $ writeTxFileTextEnvelopeCddl eon fpath noWitTx) & onLeft (left . TxCmdWriteFileError) getExecutionUnitPrices :: CardanoEra era -> LedgerProtocolParameters era -> Maybe Ledger.Prices @@ -317,8 +317,7 @@ runTransactionBuildRawCmd txOut <- toTxOutInShelleyBasedEra eon retColl return $ Just txOut - -- NB: We need to be able to construct txs in Byron to other Byron addresses - txOuts <- mapM (toTxOutInAnyEra $ toCardanoEra eon) txouts + txOuts <- mapM (toTxOutInAnyEra eon) txouts -- the same collateral input can be used for several plutus scripts let filteredTxinsc = Set.toList $ Set.fromList txInsCollateral @@ -349,9 +348,7 @@ runTransactionBuildRawCmd txMetadata mLedgerPParams txUpdateProposal votingProcedures proposals let noWitTx = makeSignedTransaction [] txBody - cEra = shelleyBasedToCardanoEra eon - -- TODO: Expose a version of writeTxFileTextEnvelopeCddl that is parameterized on ShelleyBasedEra - lift (cardanoEraConstraints cEra $ writeTxFileTextEnvelopeCddl cEra txBodyOutFile noWitTx) + lift (writeTxFileTextEnvelopeCddl eon txBodyOutFile noWitTx) & onLeft (left . TxCmdWriteFileError) @@ -414,7 +411,7 @@ runTxBuildRaw sbe validatedRetCol <- first TxCmdReturnCollateralValidationError $ validateTxReturnCollateral era mReturnCollateral validatedFee - <- first TxCmdTxFeeValidationError $ validateTxFee era mFee + <- first TxCmdTxFeeValidationError $ validateTxFee sbe mFee validatedLowerBound <- first TxCmdTxValidityLowerBoundValidationError (validateTxValidityLowerBound era mLowerBound) validatedReqSigners @@ -426,7 +423,7 @@ runTxBuildRaw sbe validatedTxCerts <- first TxCmdTxCertificatesValidationError $ validateTxCertificates era certsAndMaybeSriptWits validatedMintValue - <- createTxMintValue era valuesWithScriptWits + <- createTxMintValue sbe valuesWithScriptWits validatedTxScriptValidity <- first TxCmdScriptValidityValidationError $ validateTxScriptValidity era mScriptValidity let validatedTxProposal = proposals @@ -521,12 +518,12 @@ runTxBuild <- hoistEither $ first TxCmdTotalCollateralValidationError $ validateTxTotalCollateral era mTotCollateral validatedRetCol <- hoistEither $ first TxCmdReturnCollateralValidationError $ validateTxReturnCollateral era mReturnCollateral - dFee <- hoistEither $ first TxCmdTxFeeValidationError $ validateTxFee era dummyFee + dFee <- hoistEither $ first TxCmdTxFeeValidationError $ validateTxFee sbe dummyFee validatedLowerBound <- hoistEither (first TxCmdTxValidityLowerBoundValidationError (validateTxValidityLowerBound era mLowerBound)) validatedReqSigners <- hoistEither (first TxCmdRequiredSignersValidationError $ validateRequiredSigners era reqSigners) validatedTxWtdrwls <- hoistEither (first TxCmdTxWithdrawalsValidationError $ validateTxWithdrawals era withdrawals) validatedTxCerts <- hoistEither (first TxCmdTxCertificatesValidationError $ validateTxCertificates era certsAndMaybeScriptWits) - validatedMintValue <- hoistEither $ createTxMintValue era valuesWithScriptWits + validatedMintValue <- hoistEither $ createTxMintValue sbe valuesWithScriptWits validatedTxScriptValidity <- hoistEither (first TxCmdScriptValidityValidationError $ validateTxScriptValidity era mScriptValidity) let allTxInputs = inputsThatRequireWitnessing ++ allReferenceInputs ++ txinsc @@ -710,27 +707,19 @@ lovelaceToCoin :: Lovelace -> Ledger.Coin lovelaceToCoin (Lovelace ll) = Ledger.Coin ll toTxOutValueInAnyEra - :: CardanoEra era + :: ShelleyBasedEra era -> Value -> Either TxCmdError (TxOutValue era) toTxOutValueInAnyEra era val = - caseByronOrShelleyBasedEra - (const $ - case valueToLovelace val of - Just l -> return (TxOutValueByron l) - Nothing -> txFeatureMismatchPure era TxFeatureMultiAssetOutputs + caseShelleyToAllegraOrMaryEraOnwards + (\_ -> case valueToLovelace val of + Just l -> return (TxOutValueShelleyBased era $ lovelaceToCoin l) + Nothing -> txFeatureMismatchPure (toCardanoEra era) TxFeatureMultiAssetOutputs ) - (\sbe -> - caseShelleyToAllegraOrMaryEraOnwards - (\_ -> case valueToLovelace val of - Just l -> return (TxOutValueShelleyBased sbe $ lovelaceToCoin l) - Nothing -> txFeatureMismatchPure era TxFeatureMultiAssetOutputs - ) - (\w -> return (TxOutValueShelleyBased sbe (toLedgerValue w val)) - ) - sbe + (\w -> return (TxOutValueShelleyBased era (toLedgerValue w val)) ) era + toTxOutValueInShelleyBasedEra :: ShelleyBasedEra era -> Value @@ -773,28 +762,27 @@ toTxOutByronEra -> ExceptT TxCmdError IO (TxOut CtxTx ByronEra) toTxOutByronEra (TxOutAnyEra addr' val' _ _) = do addr <- hoistEither $ toAddressInAnyEra ByronEra addr' - val <- hoistEither $ toTxOutValueInAnyEra ByronEra val' - pure $ TxOut addr val TxOutDatumNone ReferenceScriptNone + let ada = TxOutValueByron $ selectLovelace val' + pure $ TxOut addr ada TxOutDatumNone ReferenceScriptNone -- TODO: toTxOutInAnyEra eventually will not be needed because -- byron related functionality will be treated -- separately -toTxOutInAnyEra :: CardanoEra era +toTxOutInAnyEra :: ShelleyBasedEra era -> TxOutAnyEra -> ExceptT TxCmdError IO (TxOut CtxTx era) toTxOutInAnyEra era (TxOutAnyEra addr' val' mDatumHash refScriptFp) = do - addr <- hoistEither $ toAddressInAnyEra era addr' + let cEra = toCardanoEra era + addr <- hoistEither $ toAddressInAnyEra cEra addr' val <- hoistEither $ toTxOutValueInAnyEra era val' - datum <- caseByronOrShelleyBasedEra - (const (pure TxOutDatumNone)) - (caseShelleyToMaryOrAlonzoEraOnwards + datum <- + caseShelleyToMaryOrAlonzoEraOnwards (const (pure TxOutDatumNone)) (\wa -> toTxAlonzoDatum wa mDatumHash) - ) - era + era - refScript <- caseByronToAlonzoOrBabbageEraOnwards + refScript <- caseShelleyToAlonzoOrBabbageEraOnwards (const (pure ReferenceScriptNone)) (\wb -> getReferenceScript wb refScriptFp) era @@ -833,34 +821,29 @@ toTxAlonzoDatum supp cliDatum = -- given reference input (since we don't have the script in this case). To avoid asking -- for the policy id twice (in the build command) we can potentially query the UTxO and -- access the script (and therefore the policy id). -createTxMintValue :: forall era. CardanoEra era +createTxMintValue :: forall era. ShelleyBasedEra era -> (Value, [ScriptWitness WitCtxMint era]) -> Either TxCmdError (TxMintValue BuildTx era) createTxMintValue era (val, scriptWitnesses) = if List.null (valueToList val) && List.null scriptWitnesses then return TxMintNone else do - caseByronOrShelleyBasedEra - (const (txFeatureMismatchPure era TxFeatureMintValue)) - (caseShelleyToAllegraOrMaryEraOnwards - (const (txFeatureMismatchPure era TxFeatureMintValue)) - (\w -> do - -- The set of policy ids for which we need witnesses: - let witnessesNeededSet :: Set PolicyId - witnessesNeededSet = - Set.fromList [ pid | (AssetId pid _, _) <- valueToList val ] - - let witnessesProvidedMap :: Map PolicyId (ScriptWitness WitCtxMint era) - witnessesProvidedMap = Map.fromList $ gatherMintingWitnesses scriptWitnesses - - witnessesProvidedSet = Map.keysSet witnessesProvidedMap - - -- Check not too many, nor too few: - validateAllWitnessesProvided witnessesNeededSet witnessesProvidedSet - validateNoUnnecessaryWitnesses witnessesNeededSet witnessesProvidedSet - - return (TxMintValue w val (BuildTxWith witnessesProvidedMap)) - ) + caseShelleyToAllegraOrMaryEraOnwards + (const (txFeatureMismatchPure (toCardanoEra era) TxFeatureMintValue)) + (\w -> do + -- The set of policy ids for which we need witnesses: + let witnessesNeededSet :: Set PolicyId + witnessesNeededSet = + Set.fromList [ pid | (AssetId pid _, _) <- valueToList val ] + + let witnessesProvidedMap :: Map PolicyId (ScriptWitness WitCtxMint era) + witnessesProvidedMap = Map.fromList $ gatherMintingWitnesses scriptWitnesses + witnessesProvidedSet = Map.keysSet witnessesProvidedMap + + -- Check not too many, nor too few: + validateAllWitnessesProvided witnessesNeededSet witnessesProvidedSet + validateNoUnnecessaryWitnesses witnessesNeededSet witnessesProvidedSet + return (TxMintValue w val (BuildTxWith witnessesProvidedMap)) ) era where @@ -941,7 +924,7 @@ runTransactionSignCmd allKeyWits = existingTxKeyWits ++ newShelleyKeyWits ++ byronWitnesses signedTx = makeSignedTransaction allKeyWits txbody - lift (writeTxFileTextEnvelopeCddl (shelleyBasedToCardanoEra sbe) outTxFile signedTx) + lift (writeTxFileTextEnvelopeCddl sbe outTxFile signedTx) & onLeft (left . TxCmdWriteFileError) InputTxBodyFile (File txbodyFilePath) -> do @@ -963,7 +946,7 @@ runTransactionSignCmd let shelleyKeyWitnesses = map (makeShelleyKeyWitness sbe txbody) sksShelley tx = makeSignedTransaction (byronWitnesses ++ shelleyKeyWitnesses) txbody - lift (writeTxFileTextEnvelopeCddl (shelleyBasedToCardanoEra sbe) outTxFile tx) + lift (writeTxFileTextEnvelopeCddl sbe outTxFile tx) & onLeft (left . TxCmdWriteFileError) UnwitnessedCliFormattedTxBody anyTxbody -> do @@ -998,7 +981,7 @@ runTransactionSubmitCmd } = do txFileOrPipe <- liftIO $ fileOrPipe txFile InAnyShelleyBasedEra era tx <- lift (readFileTx txFileOrPipe) & onLeft (left . TxCmdCddlError) - let txInMode = TxInMode (toCardanoEra era) tx + let txInMode = TxInMode era tx localNodeConnInfo = LocalNodeConnectInfo { localConsensusModeParams = consensusModeParams , localNodeNetworkId = networkId @@ -1304,8 +1287,8 @@ runTransactionSignWitnessCmd let tx = makeSignedTransaction witnesses txbody - lift (writeLazyByteStringFile outFile $ cardanoEraConstraints (toCardanoEra era) $ textEnvelopeToJSON Nothing tx) - & onLeft (left . TxCmdWriteFileError) + lift (writeLazyByteStringFile outFile $ shelleyBasedEraConstraints era + $ textEnvelopeToJSON Nothing tx) & onLeft (left . TxCmdWriteFileError) IncompleteCddlFormattedTx (InAnyShelleyBasedEra era anyTx) -> do let txbody = getTxBody anyTx @@ -1323,4 +1306,4 @@ runTransactionSignWitnessCmd let tx = makeSignedTransaction witnesses txbody - lift (writeTxFileTextEnvelopeCddl (shelleyBasedToCardanoEra era) outFile tx) & onLeft (left . TxCmdWriteFileError) + lift (writeTxFileTextEnvelopeCddl era outFile tx) & onLeft (left . TxCmdWriteFileError) diff --git a/cardano-cli/src/Cardano/CLI/Json/Friendly.hs b/cardano-cli/src/Cardano/CLI/Json/Friendly.hs index b311d102e6..02c92558ed 100644 --- a/cardano-cli/src/Cardano/CLI/Json/Friendly.hs +++ b/cardano-cli/src/Cardano/CLI/Json/Friendly.hs @@ -211,7 +211,6 @@ friendlyValidityRange era = \case TxValidityLowerBound _ s -> toJSON s , "upper bound" .= case upperBound of - TxValidityNoUpperBound _ -> Null TxValidityUpperBound _ s -> toJSON s ] | otherwise -> Null @@ -552,7 +551,6 @@ friendlyRational r = friendlyFee :: TxFee era -> Aeson.Value friendlyFee = \case - TxFeeImplicit _ -> "implicit" TxFeeExplicit _ fee -> friendlyLovelace $ toShelleyLovelace fee friendlyLovelace :: Ledger.Coin -> Aeson.Value diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Commands/Transaction.hs b/cardano-cli/src/Cardano/CLI/Legacy/Commands/Transaction.hs index 477dfe9b72..d2a9da514d 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Commands/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Commands/Transaction.hs @@ -123,7 +123,7 @@ data LegacyTransactionCmds TxShelleyWitnessCount TxByronWitnessCount | TransactionCalculateMinValueCmd - AnyCardanoEra + (EraInEon ShelleyBasedEra) ProtocolParamsFile TxOutShelleyBasedEra | TransactionHashScriptDataCmd diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Options.hs b/cardano-cli/src/Cardano/CLI/Legacy/Options.hs index dc025d70e5..d4f703770e 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Options.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Options.hs @@ -423,7 +423,7 @@ pTransaction envCli = pTransactionCalculateMinReqUTxO :: Parser LegacyTransactionCmds pTransactionCalculateMinReqUTxO = TransactionCalculateMinValueCmd - <$> pLegacyCardanoEra envCli + <$> pAnyShelleyBasedEra envCli <*> pProtocolParamsFile <*> pTxOutShelleyBased diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/Legacy/Run/Transaction.hs index 47e94b35f3..7e9631bbc0 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Run/Transaction.hs @@ -47,13 +47,8 @@ runLegacyTransactionCmds = \case runLegacyTransactionSubmitCmd mNodeSocketPath consensusModeParams network txFp TransactionCalculateMinFeeCmd txbody nw pParamsFile nInputs nOutputs nShelleyKeyWitnesses nByronKeyWitnesses -> runLegacyTransactionCalculateMinFeeCmd txbody nw pParamsFile nInputs nOutputs nShelleyKeyWitnesses nByronKeyWitnesses - TransactionCalculateMinValueCmd (AnyCardanoEra era) pParamsFile txOuts' -> - -- We choose to not modify TransactionCalculateMinValueCmd to avoid breaking the cli - -- Although in this case specifying Byron would have resulted in a call to error. - caseByronOrShelleyBasedEra - (const $ pure ()) - (\sbe -> runLegacyTransactionCalculateMinValueCmd (AnyShelleyBasedEra sbe) pParamsFile txOuts') - era + TransactionCalculateMinValueCmd (EraInEon sbe) pParamsFile txOuts' -> + runLegacyTransactionCalculateMinValueCmd (AnyShelleyBasedEra sbe) pParamsFile txOuts' TransactionHashScriptDataCmd scriptDataOrFile -> runLegacyTransactionHashScriptDataCmd scriptDataOrFile TransactionTxIdCmd txinfile -> @@ -123,7 +118,7 @@ runLegacyTransactionBuildCmd -- TODO: Neither QA nor Sam is using `cardano-cli byron transaction build-raw` -- for Byron era transactions. So we can parameterize this function on ShelleyBasedEra. --- They are using `issue-utxo-expenditure`. +-- They are using `issue-utxo-expenditure`. However we will deprecate it in a follow up PR. -- TODO: As a follow up we need to expose a simple tx building command that only -- uses inputs, outputs and update proposals. NB: Update proposals are a separate -- thing in the Byron era so we need to figure out how we are handling that at the @@ -160,8 +155,8 @@ runLegacyTransactionBuildRawCmd (AnyCardanoEra ByronEra) _ txins _ _ _ case makeByronTransactionBody apiTxIns byronOuts of Left err -> error $ "Error occurred while creating a Byron based UTxO transaction: " <> show err Right txBody -> do - let noWitTx = Api.ByronTx ByronEraOnlyByron $ makeSignedByronTransaction [] txBody - lift (cardanoEraConstraints ByronEra $ writeTxFileTextEnvelopeCddl ByronEra outFile noWitTx) + let noWitTx = makeSignedByronTransaction [] txBody + lift (Api.writeByronTxFileTextEnvelopeCddl outFile noWitTx) & onLeft (left . TxCmdWriteFileError) runLegacyTransactionBuildRawCmd @@ -171,7 +166,7 @@ runLegacyTransactionBuildRawCmd outFile = do caseByronOrShelleyBasedEra - (const $ error "runLegacyTransactionBuildRawCmd: This should be impossible") + (error "runLegacyTransactionBuildRawCmd: This should be impossible") (\sbe -> do mfUpdateProposalFile <- validateUpdateProposalFile era mUpdateProposal & hoistEither diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/TxValidationError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/TxValidationError.hs index 28c312df4f..0833f69f6f 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Errors/TxValidationError.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/TxValidationError.hs @@ -28,7 +28,6 @@ module Cardano.CLI.Types.Errors.TxValidationError , validateTxReturnCollateral , validateTxScriptValidity , validateTxTotalCollateral - , validateTxValidityUpperBound , validateTxValidityLowerBound , validateTxWithdrawals , validateUpdateProposalFile @@ -78,20 +77,14 @@ instance Error TxFeeValidationError where prettyError (TxFeatureExplicitFeesE era) = "Explicit transaction fee not supported in " <> pretty era -validateTxFee :: CardanoEra era - -> Maybe Lovelace +validateTxFee :: ShelleyBasedEra era + -> Maybe Lovelace -- TODO: Make this mandatory in the cli (Remove Maybe) -> Either TxFeeValidationError (TxFee era) validateTxFee era = \case Nothing -> - caseByronOrShelleyBasedEra - (pure . TxFeeImplicit) - (const $ Left . TxFeatureImplicitFeesE $ cardanoEraConstraints era $ AnyCardanoEra era) - era - Just fee -> - caseByronOrShelleyBasedEra - (const $ Left . TxFeatureExplicitFeesE $ cardanoEraConstraints era $ AnyCardanoEra era) - (\w -> pure (TxFeeExplicit w fee)) - era + let cEra = toCardanoEra era + in Left . TxFeatureImplicitFeesE $ cardanoEraConstraints cEra $ AnyCardanoEra cEra + Just fee -> pure (TxFeeExplicit era fee) newtype TxTotalCollateralValidationError = TxTotalCollateralNotSupported AnyCardanoEra @@ -150,17 +143,6 @@ instance Error TxValidityUpperBoundValidationError where prettyError (TxValidityUpperBoundNotSupported era) = "Transaction validity upper bound must be specified in " <> pretty era -validateTxValidityUpperBound - :: CardanoEra era - -> Maybe SlotNo - -> Either TxValidityUpperBoundValidationError (TxValidityUpperBound era) -validateTxValidityUpperBound era = \case - Just slot -> do - supported <- conjureWitness era TxValidityUpperBoundNotSupported - pure $ TxValidityUpperBound supported (Just slot) - Nothing -> do - supported <- conjureWitness era TxValidityUpperBoundNotSupported - pure $ TxValidityNoUpperBound supported data TxAuxScriptsValidationError = TxAuxScriptsNotSupportedInEra AnyCardanoEra 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 3c6e33fd82..931800edfe 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help.cli @@ -9471,12 +9471,12 @@ Usage: cardano-cli legacy transaction calculate-min-fee --tx-body-file FILE Calculate the minimum fee for a transaction. Usage: cardano-cli legacy transaction calculate-min-required-utxo - [ --byron-era - | --shelley-era + [ --shelley-era | --allegra-era | --mary-era | --alonzo-era | --babbage-era + | --conway-era ] --protocol-params-file FILE --tx-out ADDRESS VALUE @@ -9496,12 +9496,12 @@ Usage: cardano-cli legacy transaction calculate-min-required-utxo Calculate the minimum required UTxO for a transaction output. Usage: cardano-cli legacy transaction calculate-min-value - [ --byron-era - | --shelley-era + [ --shelley-era | --allegra-era | --mary-era | --alonzo-era | --babbage-era + | --conway-era ] --protocol-params-file FILE --tx-out ADDRESS VALUE @@ -10674,12 +10674,12 @@ Usage: cardano-cli transaction calculate-min-fee --tx-body-file FILE Calculate the minimum fee for a transaction. Usage: cardano-cli transaction calculate-min-required-utxo - [ --byron-era - | --shelley-era + [ --shelley-era | --allegra-era | --mary-era | --alonzo-era | --babbage-era + | --conway-era ] --protocol-params-file FILE --tx-out ADDRESS VALUE @@ -10699,12 +10699,12 @@ Usage: cardano-cli transaction calculate-min-required-utxo Calculate the minimum required UTxO for a transaction output. Usage: cardano-cli transaction calculate-min-value - [ --byron-era - | --shelley-era + [ --shelley-era | --allegra-era | --mary-era | --alonzo-era | --babbage-era + | --conway-era ] --protocol-params-file FILE --tx-out ADDRESS VALUE diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/legacy_transaction_calculate-min-required-utxo.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/legacy_transaction_calculate-min-required-utxo.cli index a994858445..db1022134b 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/legacy_transaction_calculate-min-required-utxo.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/legacy_transaction_calculate-min-required-utxo.cli @@ -1,10 +1,10 @@ Usage: cardano-cli legacy transaction calculate-min-required-utxo - [ --byron-era - | --shelley-era + [ --shelley-era | --allegra-era | --mary-era | --alonzo-era | --babbage-era + | --conway-era ] --protocol-params-file FILE --tx-out ADDRESS VALUE @@ -24,12 +24,12 @@ Usage: cardano-cli legacy transaction calculate-min-required-utxo Calculate the minimum required UTxO for a transaction output. Available options: - --byron-era Specify the Byron era --shelley-era Specify the Shelley era --allegra-era Specify the Allegra era --mary-era Specify the Mary era --alonzo-era Specify the Alonzo era --babbage-era Specify the Babbage era (default) + --conway-era Specify the Conway era --protocol-params-file FILE Filepath of the JSON-encoded protocol parameters file --tx-out ADDRESS VALUE The transaction output as ADDRESS VALUE where ADDRESS diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/legacy_transaction_calculate-min-value.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/legacy_transaction_calculate-min-value.cli index 51a9ea9b18..ccbe584825 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/legacy_transaction_calculate-min-value.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/legacy_transaction_calculate-min-value.cli @@ -1,10 +1,10 @@ Usage: cardano-cli legacy transaction calculate-min-value - [ --byron-era - | --shelley-era + [ --shelley-era | --allegra-era | --mary-era | --alonzo-era | --babbage-era + | --conway-era ] --protocol-params-file FILE --tx-out ADDRESS VALUE @@ -24,12 +24,12 @@ Usage: cardano-cli legacy transaction calculate-min-value DEPRECATED: Use 'calculate-min-required-utxo' instead. Available options: - --byron-era Specify the Byron era --shelley-era Specify the Shelley era --allegra-era Specify the Allegra era --mary-era Specify the Mary era --alonzo-era Specify the Alonzo era --babbage-era Specify the Babbage era (default) + --conway-era Specify the Conway era --protocol-params-file FILE Filepath of the JSON-encoded protocol parameters file --tx-out ADDRESS VALUE The transaction output as ADDRESS VALUE where ADDRESS diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/transaction_calculate-min-required-utxo.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/transaction_calculate-min-required-utxo.cli index 75aa2d7ab6..2bf1e107e4 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/transaction_calculate-min-required-utxo.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/transaction_calculate-min-required-utxo.cli @@ -1,10 +1,10 @@ Usage: cardano-cli transaction calculate-min-required-utxo - [ --byron-era - | --shelley-era + [ --shelley-era | --allegra-era | --mary-era | --alonzo-era | --babbage-era + | --conway-era ] --protocol-params-file FILE --tx-out ADDRESS VALUE @@ -24,12 +24,12 @@ Usage: cardano-cli transaction calculate-min-required-utxo Calculate the minimum required UTxO for a transaction output. Available options: - --byron-era Specify the Byron era --shelley-era Specify the Shelley era --allegra-era Specify the Allegra era --mary-era Specify the Mary era --alonzo-era Specify the Alonzo era --babbage-era Specify the Babbage era (default) + --conway-era Specify the Conway era --protocol-params-file FILE Filepath of the JSON-encoded protocol parameters file --tx-out ADDRESS VALUE The transaction output as ADDRESS VALUE where ADDRESS diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/transaction_calculate-min-value.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/transaction_calculate-min-value.cli index 80e936ad5c..00fc1e9ea5 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/transaction_calculate-min-value.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/transaction_calculate-min-value.cli @@ -1,10 +1,10 @@ Usage: cardano-cli transaction calculate-min-value - [ --byron-era - | --shelley-era + [ --shelley-era | --allegra-era | --mary-era | --alonzo-era | --babbage-era + | --conway-era ] --protocol-params-file FILE --tx-out ADDRESS VALUE @@ -24,12 +24,12 @@ Usage: cardano-cli transaction calculate-min-value DEPRECATED: Use 'calculate-min-required-utxo' instead. Available options: - --byron-era Specify the Byron era --shelley-era Specify the Shelley era --allegra-era Specify the Allegra era --mary-era Specify the Mary era --alonzo-era Specify the Alonzo era --babbage-era Specify the Babbage era (default) + --conway-era Specify the Conway era --protocol-params-file FILE Filepath of the JSON-encoded protocol parameters file --tx-out ADDRESS VALUE The transaction output as ADDRESS VALUE where ADDRESS diff --git a/flake.lock b/flake.lock index f06f09d7d8..9a494f0003 100644 --- a/flake.lock +++ b/flake.lock @@ -3,11 +3,11 @@ "CHaP": { "flake": false, "locked": { - "lastModified": 1701361459, - "narHash": "sha256-3BN5iWHEXL7hB/wOy2VsjurZz7s2cCNsfzHB6Wdj8O0=", + "lastModified": 1701717386, + "narHash": "sha256-/9vQ2DdQlHsCfh72owZUae+djjSAumMVWdxGA7ugkZ0=", "owner": "input-output-hk", "repo": "cardano-haskell-packages", - "rev": "e9de9c992581dd08d623a936eb4a0d80e8b46781", + "rev": "13b6ae939b747ad82ea8286f13b4e8f6ce8a3c49", "type": "github" }, "original": {