Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Unwrap script validity field in TxBodyContent #3091

Merged
merged 1 commit into from
Aug 22, 2021
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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 .
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion bench/tx-generator/src/Cardano/Benchmarking/Wallet.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion cardano-api/gen/Gen/Cardano/Api/Typed.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
7 changes: 4 additions & 3 deletions cardano-api/src/Cardano/Api/Fees.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
19 changes: 8 additions & 11 deletions cardano-api/src/Cardano/Api/TxBody.hs
Original file line number Diff line number Diff line change
Expand Up @@ -73,7 +73,6 @@ module Cardano.Api.TxBody (

-- ** Building vs viewing transactions
BuildTxWith(..),
unBuildTxWith,
BuildTx,
ViewTx,

Expand Down Expand Up @@ -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)
--
Expand Down Expand Up @@ -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
}


Expand Down Expand Up @@ -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
Expand All @@ -1627,7 +1624,7 @@ fromLedgerTxBody era body mAux =
, txMetadata
, txAuxScripts
, txExtraScriptData = ViewTx
, txScriptValidity = ViewTx
, txScriptValidity = scriptValidity
}
where
(txMetadata, txAuxScripts) = fromLedgerTxAuxiliaryData era mAux
Expand Down Expand Up @@ -2018,7 +2015,7 @@ getByronTxBodyContent (Annotated Byron.UnsafeTx{txInputs, txOutputs} _) =
txCertificates = TxCertificatesNone,
txUpdateProposal = TxUpdateProposalNone,
txMintValue = TxMintNone,
txScriptValidity = ViewTx
txScriptValidity = TxScriptValidityNone
}

makeShelleyTransactionBody :: ()
Expand Down Expand Up @@ -2362,7 +2359,7 @@ makeShelleyTransactionBody era@ShelleyBasedEraAlonzo
scripts
(TxBodyScriptData ScriptDataInAlonzoEra datums redeemers)
txAuxData
(unBuildTxWith txScriptValidity)
txScriptValidity
where
witnesses :: [(ScriptWitnessIndex, AnyScriptWitness AlonzoEra)]
witnesses = collectTxBodyScriptWitnesses txbodycontent
Expand Down
4 changes: 2 additions & 2 deletions cardano-cli/src/Cardano/CLI/Byron/Tx.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
6 changes: 3 additions & 3 deletions cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down