Unwrap script validity field in TxBodyContent

IntersectMBO · Aug 20, 2021 · af2a59a · af2a59a
1 parent 64068a7
commit af2a59a
Show file tree

Hide file tree

Showing 9 changed files with 27 additions and 29 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
      }
 
 
@@ -1597,21 +1593,22 @@ makeTransactionBody =
 
 
 pattern TxBody :: TxBodyContent ViewTx era -> TxBody era
-pattern TxBody txbodycontent <- (getTxBodyContent -> txbodycontent)
+pattern TxBody txbodycontent <- (getTxBodyContent TxScriptValidityNone -> txbodycontent)
 {-# COMPLETE TxBody #-}
 
-getTxBodyContent :: TxBody era -> TxBodyContent ViewTx era
-getTxBodyContent (ByronTxBody body) = getByronTxBodyContent body
-getTxBodyContent (ShelleyTxBody era body _scripts _redeemers mAux _scriptValidity) =
-    fromLedgerTxBody era body mAux
+getTxBodyContent :: TxScriptValidity era -> TxBody era -> TxBodyContent ViewTx era
+getTxBodyContent _ (ByronTxBody body) = getByronTxBodyContent body
+getTxBodyContent scriptValidity (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
@@ -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
@@ -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