From f6c231af6b1c02b1e69ef833304f8dae00873902 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Cl=C3=A9ment=20Hurlin?= Date: Fri, 14 Jun 2024 10:29:58 +0200 Subject: [PATCH 1/2] evaluateTransactionExecutionUnitsShelley: return logs --- cardano-api/internal/Cardano/Api/Fees.hs | 30 +++++++++++++----------- 1 file changed, 16 insertions(+), 14 deletions(-) diff --git a/cardano-api/internal/Cardano/Api/Fees.hs b/cardano-api/internal/Cardano/Api/Fees.hs index 6765081a16..2085df839c 100644 --- a/cardano-api/internal/Cardano/Api/Fees.hs +++ b/cardano-api/internal/Cardano/Api/Fees.hs @@ -84,7 +84,7 @@ import qualified Ouroboros.Consensus.HardFork.History as Consensus import qualified PlutusLedgerApi.V1 as Plutus import Control.Monad (forM_) -import Data.Bifunctor (bimap, first) +import Data.Bifunctor (bimap, first, second) import Data.ByteString.Short (ShortByteString) import Data.Foldable (toList) import Data.Function ((&)) @@ -97,6 +97,7 @@ import Data.Ratio import Data.Set (Set) import qualified Data.Set as Set import qualified Data.Text as Text +import Data.Text (Text) import Lens.Micro ((.~), (^.)) {- HLINT ignore "Redundant return" -} @@ -618,7 +619,7 @@ evaluateTransactionExecutionUnits :: forall era. () -> UTxO era -> TxBody era -> Either (TransactionValidityError era) - (Map ScriptWitnessIndex (Either ScriptExecutionError ExecutionUnits)) + (Map ScriptWitnessIndex (Either ScriptExecutionError ([Text], ExecutionUnits))) evaluateTransactionExecutionUnits era systemstart epochInfo pp utxo txbody = case makeSignedTransaction' era [] txbody of ShelleyTx sbe tx' -> evaluateTransactionExecutionUnitsShelley sbe systemstart epochInfo pp utxo tx' @@ -631,11 +632,11 @@ evaluateTransactionExecutionUnitsShelley :: forall era. () -> UTxO era -> L.Tx (ShelleyLedgerEra era) -> Either (TransactionValidityError era) - (Map ScriptWitnessIndex (Either ScriptExecutionError ExecutionUnits)) + (Map ScriptWitnessIndex (Either ScriptExecutionError ([Text], ExecutionUnits))) evaluateTransactionExecutionUnitsShelley sbe systemstart epochInfo (LedgerProtocolParameters pp) utxo tx = caseShelleyToMaryOrAlonzoEraOnwards (const (Right Map.empty)) - (\w -> case alonzoEraOnwardsConstraints w $ L.evalTxExUnits pp tx (toLedgerUTxO sbe utxo) ledgerEpochInfo systemstart of + (\w -> case alonzoEraOnwardsConstraints w $ L.evalTxExUnitsWithLogs pp tx (toLedgerUTxO sbe utxo) ledgerEpochInfo systemstart of Left err -> Left $ alonzoEraOnwardsConstraints w $ TransactionValidityTranslationError err Right exmap -> Right (fromLedgerScriptExUnitsMap w exmap) @@ -648,12 +649,12 @@ evaluateTransactionExecutionUnitsShelley sbe systemstart epochInfo (LedgerProtoc :: Alonzo.AlonzoEraScript (ShelleyLedgerEra era) => AlonzoEraOnwards era -> Map (L.PlutusPurpose L.AsIx (ShelleyLedgerEra era)) - (Either (L.TransactionScriptFailure (ShelleyLedgerEra era)) Alonzo.ExUnits) - -> Map ScriptWitnessIndex (Either ScriptExecutionError ExecutionUnits) + (Either (L.TransactionScriptFailure (ShelleyLedgerEra era)) ([Text.Text], Alonzo.ExUnits)) + -> Map ScriptWitnessIndex (Either ScriptExecutionError ([Text.Text], ExecutionUnits)) fromLedgerScriptExUnitsMap aOnwards exmap = Map.fromList [ (toScriptIndex aOnwards rdmrptr, - bimap (fromAlonzoScriptExecutionError aOnwards) fromAlonzoExUnits exunitsOrFailure) + bimap (fromAlonzoScriptExecutionError aOnwards) (second fromAlonzoExUnits) exunitsOrFailure) | (rdmrptr, exunitsOrFailure) <- Map.toList exmap ] fromAlonzoScriptExecutionError @@ -980,13 +981,14 @@ makeTransactionBodyAutoBalance sbe systemstart history lpp@(LedgerProtocolParame -- 1,2,4 or 8 bytes? } - exUnitsMap <- first TxBodyErrorValidityInterval $ - evaluateTransactionExecutionUnits - era - systemstart history - lpp - utxo - txbody0 + exUnitsMapWithLogs <- first TxBodyErrorValidityInterval $ + evaluateTransactionExecutionUnits + era + systemstart history + lpp + utxo + txbody0 + let exUnitsMap = Map.map (fmap snd) exUnitsMapWithLogs exUnitsMap' <- case Map.mapEither id exUnitsMap of From 37fae815fdfa1a794e8011ebf649f837d86f3201 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Cl=C3=A9ment=20Hurlin?= Date: Mon, 17 Jun 2024 17:53:01 +0200 Subject: [PATCH 2/2] Fees: add a type synonym for logs returned by evalTxExUnitsWithLogs --- cardano-api/internal/Cardano/Api/Fees.hs | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/cardano-api/internal/Cardano/Api/Fees.hs b/cardano-api/internal/Cardano/Api/Fees.hs index 2085df839c..955c3e93dd 100644 --- a/cardano-api/internal/Cardano/Api/Fees.hs +++ b/cardano-api/internal/Cardano/Api/Fees.hs @@ -102,6 +102,10 @@ import Lens.Micro ((.~), (^.)) {- HLINT ignore "Redundant return" -} +-- | Type synonym for logs returned by the ledger's @evalTxExUnitsWithLogs@ function. +-- for scripts in transactions. +type EvalTxExecutionUnitsLog = [Text] + data AutoBalanceError era = AutoBalanceEstimationError (TxFeeEstimationError era) | AutoBalanceCalculationError (TxBodyErrorAutoBalance era) @@ -619,7 +623,7 @@ evaluateTransactionExecutionUnits :: forall era. () -> UTxO era -> TxBody era -> Either (TransactionValidityError era) - (Map ScriptWitnessIndex (Either ScriptExecutionError ([Text], ExecutionUnits))) + (Map ScriptWitnessIndex (Either ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits))) evaluateTransactionExecutionUnits era systemstart epochInfo pp utxo txbody = case makeSignedTransaction' era [] txbody of ShelleyTx sbe tx' -> evaluateTransactionExecutionUnitsShelley sbe systemstart epochInfo pp utxo tx' @@ -632,7 +636,7 @@ evaluateTransactionExecutionUnitsShelley :: forall era. () -> UTxO era -> L.Tx (ShelleyLedgerEra era) -> Either (TransactionValidityError era) - (Map ScriptWitnessIndex (Either ScriptExecutionError ([Text], ExecutionUnits))) + (Map ScriptWitnessIndex (Either ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits))) evaluateTransactionExecutionUnitsShelley sbe systemstart epochInfo (LedgerProtocolParameters pp) utxo tx = caseShelleyToMaryOrAlonzoEraOnwards (const (Right Map.empty)) @@ -649,8 +653,8 @@ evaluateTransactionExecutionUnitsShelley sbe systemstart epochInfo (LedgerProtoc :: Alonzo.AlonzoEraScript (ShelleyLedgerEra era) => AlonzoEraOnwards era -> Map (L.PlutusPurpose L.AsIx (ShelleyLedgerEra era)) - (Either (L.TransactionScriptFailure (ShelleyLedgerEra era)) ([Text.Text], Alonzo.ExUnits)) - -> Map ScriptWitnessIndex (Either ScriptExecutionError ([Text.Text], ExecutionUnits)) + (Either (L.TransactionScriptFailure (ShelleyLedgerEra era)) (EvalTxExecutionUnitsLog, Alonzo.ExUnits)) + -> Map ScriptWitnessIndex (Either ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits)) fromLedgerScriptExUnitsMap aOnwards exmap = Map.fromList [ (toScriptIndex aOnwards rdmrptr,