From 45ce7fd1b33ea05043817f330d4ba2727faac017 Mon Sep 17 00:00:00 2001 From: John Ky Date: Wed, 18 Aug 2021 11:23:46 +1000 Subject: [PATCH] Unwrap script validity field in TxBodyContent --- .../Benchmarking/GeneratorTx/SizedMetadata.hs | 2 +- .../Cardano/Benchmarking/GeneratorTx/Tx.hs | 4 ++-- .../src/Cardano/Benchmarking/PlutusExample.hs | 4 ++-- .../src/Cardano/Benchmarking/Wallet.hs | 2 +- cardano-api/gen/Gen/Cardano/Api/Typed.hs | 2 +- cardano-api/src/Cardano/Api/Fees.hs | 7 ++++--- cardano-api/src/Cardano/Api/TxBody.hs | 19 ++++++++----------- cardano-cli/src/Cardano/CLI/Byron/Tx.hs | 4 ++-- .../Cardano/CLI/Shelley/Run/Transaction.hs | 6 +++--- 9 files changed, 24 insertions(+), 26 deletions(-) diff --git a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SizedMetadata.hs b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SizedMetadata.hs index ce290c8ddc5..cbdb7217550 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SizedMetadata.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SizedMetadata.hs @@ -115,7 +115,7 @@ dummyTxSizeInEra metadata = case makeTransactionBody dummyTx of , txCertificates = TxCertificatesNone , txUpdateProposal = TxUpdateProposalNone , txMintValue = TxMintNone - , txScriptValidity = BuildTxWith TxScriptValidityNone + , txScriptValidity = TxScriptValidityNone } dummyTxSize :: forall era . IsShelleyBasedEra era => AsType era -> Maybe TxMetadata -> Int diff --git a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/Tx.hs b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/Tx.hs index 7e3932b3e5d..a57775c0bec 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/Tx.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/Tx.hs @@ -80,7 +80,7 @@ mkGenesisTransaction key _payloadSize ttl fee txins txouts , txCertificates = TxCertificatesNone , txUpdateProposal = TxUpdateProposalNone , txMintValue = TxMintNone - , txScriptValidity = BuildTxWith TxScriptValidityNone + , txScriptValidity = TxScriptValidityNone } fees = case shelleyBasedEra @ era of ShelleyBasedEraShelley -> TxFeeExplicit TxFeesExplicitInShelleyEra fee @@ -122,7 +122,7 @@ mkTransaction key metadata ttl fee txins txouts , txCertificates = TxCertificatesNone , txUpdateProposal = TxUpdateProposalNone , txMintValue = TxMintNone - , txScriptValidity = BuildTxWith TxScriptValidityNone + , txScriptValidity = TxScriptValidityNone } mkFee :: forall era . diff --git a/bench/tx-generator/src/Cardano/Benchmarking/PlutusExample.hs b/bench/tx-generator/src/Cardano/Benchmarking/PlutusExample.hs index d2d2e27a1cc..92405c6fdaf 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/PlutusExample.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/PlutusExample.hs @@ -46,7 +46,7 @@ payToScript key (script, txOutDatumHash) networkId inFunds outValues validity , txCertificates = TxCertificatesNone , txUpdateProposal = TxUpdateProposalNone , txMintValue = TxMintNone - , txScriptValidity = BuildTxWith TxScriptValidityNone + , txScriptValidity = TxScriptValidityNone } mkTxOut v = TxOut plutusScriptAddr (mkTxOutValueAdaOnly v) (TxOutDatumHash ScriptDataInAlonzoEra txOutDatumHash) @@ -115,7 +115,7 @@ spendFromScript key script networkId protocolParameters collateral inFunds valid , txCertificates = TxCertificatesNone , txUpdateProposal = TxUpdateProposalNone , txMintValue = TxMintNone - , txScriptValidity = BuildTxWith TxScriptValidityNone + , txScriptValidity = TxScriptValidityNone } requiredMemory = 700000000 requiredSteps = 700000000 diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Wallet.hs b/bench/tx-generator/src/Cardano/Benchmarking/Wallet.hs index 61ce6460c90..4ac4533ab24 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Wallet.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Wallet.hs @@ -119,7 +119,7 @@ genTx key networkId fee metadata inFunds outValues validity , txCertificates = TxCertificatesNone , txUpdateProposal = TxUpdateProposalNone , txMintValue = TxMintNone - , txScriptValidity = BuildTxWith TxScriptValidityNone + , txScriptValidity = TxScriptValidityNone } mkTxOut v = TxOut (Tx.keyAddress @ era networkId key) (mkTxOutValueAdaOnly v) TxOutDatumHashNone diff --git a/cardano-api/gen/Gen/Cardano/Api/Typed.hs b/cardano-api/gen/Gen/Cardano/Api/Typed.hs index b8a75d1f9ad..474a746be35 100644 --- a/cardano-api/gen/Gen/Cardano/Api/Typed.hs +++ b/cardano-api/gen/Gen/Cardano/Api/Typed.hs @@ -496,7 +496,7 @@ genTxBodyContent era = do txCertificates <- genTxCertificates era txUpdateProposal <- genTxUpdateProposal era txMintValue <- genTxMintValue era - txScriptValidity <- BuildTxWith <$> genTxScriptValidity era + txScriptValidity <- genTxScriptValidity era pure $ TxBodyContent { Api.txIns diff --git a/cardano-api/src/Cardano/Api/Fees.hs b/cardano-api/src/Cardano/Api/Fees.hs index 36c6bf2751c..4938bb561f5 100644 --- a/cardano-api/src/Cardano/Api/Fees.hs +++ b/cardano-api/src/Cardano/Api/Fees.hs @@ -838,12 +838,13 @@ makeTransactionBodyAutoBalance eraInMode systemstart history pparams utxo txbody0 - let aScriptValidity = unBuildTxWith (txScriptValidity txbodycontent) - exUnitsMap' <- case Map.mapEither id exUnitsMap of (failures, exUnitsMap') -> - handleExUnitsErrors (txScriptValidityToScriptValidity aScriptValidity) failures exUnitsMap' + handleExUnitsErrors + (txScriptValidityToScriptValidity (txScriptValidity txbodycontent)) + failures + exUnitsMap' let txbodycontent1 = substituteExecutionUnits exUnitsMap' txbodycontent diff --git a/cardano-api/src/Cardano/Api/TxBody.hs b/cardano-api/src/Cardano/Api/TxBody.hs index 02b7ae9335d..12bfc9b9a93 100644 --- a/cardano-api/src/Cardano/Api/TxBody.hs +++ b/cardano-api/src/Cardano/Api/TxBody.hs @@ -73,7 +73,6 @@ module Cardano.Api.TxBody ( -- ** Building vs viewing transactions BuildTxWith(..), - unBuildTxWith, BuildTx, ViewTx, @@ -911,9 +910,6 @@ data BuildTxWith build a where deriving instance Eq a => Eq (BuildTxWith build a) deriving instance Show a => Show (BuildTxWith build a) -unBuildTxWith :: BuildTxWith BuildTx a -> a -unBuildTxWith (BuildTxWith a) = a - -- ---------------------------------------------------------------------------- -- Transaction input values (era-dependent) -- @@ -1188,7 +1184,7 @@ data TxBodyContent build era = txCertificates :: TxCertificates build era, txUpdateProposal :: TxUpdateProposal era, txMintValue :: TxMintValue build era, - txScriptValidity :: BuildTxWith build (TxScriptValidity era) + txScriptValidity :: TxScriptValidity era } @@ -1602,16 +1598,17 @@ pattern TxBody txbodycontent <- (getTxBodyContent -> txbodycontent) getTxBodyContent :: TxBody era -> TxBodyContent ViewTx era getTxBodyContent (ByronTxBody body) = getByronTxBodyContent body -getTxBodyContent (ShelleyTxBody era body _scripts _redeemers mAux _scriptValidity) = - fromLedgerTxBody era body mAux +getTxBodyContent (ShelleyTxBody era body _scripts _redeemers mAux scriptValidity) = + fromLedgerTxBody era scriptValidity body mAux fromLedgerTxBody :: ShelleyBasedEra era + -> TxScriptValidity era -> Ledger.TxBody (ShelleyLedgerEra era) -> Maybe (Ledger.AuxiliaryData (ShelleyLedgerEra era)) -> TxBodyContent ViewTx era -fromLedgerTxBody era body mAux = +fromLedgerTxBody era scriptValidity body mAux = TxBodyContent { txIns = fromLedgerTxIns era body , txInsCollateral = fromLedgerTxInsCollateral era body @@ -1627,7 +1624,7 @@ fromLedgerTxBody era body mAux = , txMetadata , txAuxScripts , txExtraScriptData = ViewTx - , txScriptValidity = ViewTx + , txScriptValidity = scriptValidity } where (txMetadata, txAuxScripts) = fromLedgerTxAuxiliaryData era mAux @@ -2018,7 +2015,7 @@ getByronTxBodyContent (Annotated Byron.UnsafeTx{txInputs, txOutputs} _) = txCertificates = TxCertificatesNone, txUpdateProposal = TxUpdateProposalNone, txMintValue = TxMintNone, - txScriptValidity = ViewTx + txScriptValidity = TxScriptValidityNone } makeShelleyTransactionBody :: () @@ -2362,7 +2359,7 @@ makeShelleyTransactionBody era@ShelleyBasedEraAlonzo scripts (TxBodyScriptData ScriptDataInAlonzoEra datums redeemers) txAuxData - (unBuildTxWith txScriptValidity) + txScriptValidity where witnesses :: [(ScriptWitnessIndex, AnyScriptWitness AlonzoEra)] witnesses = collectTxBodyScriptWitnesses txbodycontent diff --git a/cardano-cli/src/Cardano/CLI/Byron/Tx.hs b/cardano-cli/src/Cardano/CLI/Byron/Tx.hs index 39999f501a4..2f3d9f8575e 100644 --- a/cardano-cli/src/Cardano/CLI/Byron/Tx.hs +++ b/cardano-cli/src/Cardano/CLI/Byron/Tx.hs @@ -169,7 +169,7 @@ txSpendGenesisUTxOByronPBFT gc nId sk (ByronAddress bAddr) outs = do TxCertificatesNone TxUpdateProposalNone TxMintNone - (BuildTxWith TxScriptValidityNone) + TxScriptValidityNone case makeTransactionBody txBodyCont of Left err -> error $ "Error occured while creating a Byron genesis based UTxO transaction: " <> show err Right txBody -> let bWit = fromByronWitness sk nId txBody @@ -209,7 +209,7 @@ txSpendUTxOByronPBFT nId sk txIns outs = do TxCertificatesNone TxUpdateProposalNone TxMintNone - (BuildTxWith TxScriptValidityNone) + TxScriptValidityNone case makeTransactionBody txBodyCont of Left err -> error $ "Error occured while creating a Byron genesis based UTxO transaction: " <> show err Right txBody -> let bWit = fromByronWitness sk nId txBody diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs index d8868218aa4..f25494000be 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs @@ -782,12 +782,12 @@ validateTxUpdateProposal era (Just (UpdateProposalFile file)) = validateTxScriptValidity :: forall era. CardanoEra era -> Maybe ScriptValidity - -> ExceptT ShelleyTxCmdError IO (BuildTxWith BuildTx (TxScriptValidity era)) -validateTxScriptValidity _ Nothing = pure $ BuildTxWith TxScriptValidityNone + -> ExceptT ShelleyTxCmdError IO (TxScriptValidity era) +validateTxScriptValidity _ Nothing = pure TxScriptValidityNone validateTxScriptValidity era (Just scriptValidity) = case txScriptValiditySupportedInCardanoEra era of Nothing -> txFeatureMismatch era TxFeatureScriptValidity - Just supported -> pure . BuildTxWith $ TxScriptValidity supported scriptValidity + Just supported -> pure $ TxScriptValidity supported scriptValidity validateTxMintValue :: forall era. CardanoEra era