From 2a757857848d19c6c7607c3e142673e6d4f1b641 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Mon, 27 Jan 2025 16:19:13 +0100 Subject: [PATCH] Combine `renderScriptCostsWithScriptHashes` and `renderScriptCosts` functions --- .../Cardano/CLI/EraBased/Run/Transaction.hs | 4 +- cardano-cli/src/Cardano/CLI/Types/Output.hs | 97 ++++++++++--------- 2 files changed, 51 insertions(+), 50 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs index 480f4b69bb..f4f63b7b11 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs @@ -63,7 +63,7 @@ import Cardano.CLI.Types.Errors.BootstrapWitnessError import Cardano.CLI.Types.Errors.NodeEraMismatchError import Cardano.CLI.Types.Errors.TxCmdError import Cardano.CLI.Types.Errors.TxValidationError -import Cardano.CLI.Types.Output (renderScriptCosts, renderScriptCostsWithScriptHashes) +import Cardano.CLI.Types.Output (renderScriptCosts, renderScriptCostsWithScriptHashesMap) import Cardano.CLI.Types.TxFeature import Cardano.Ledger.Api (allInputsTxBodyF, bodyTxL) @@ -1748,7 +1748,7 @@ runTransactionCalculatePlutusScriptCostCmd scriptCostOutput <- firstExceptT TxCmdPlutusScriptCostErr $ hoistEither $ - renderScriptCostsWithScriptHashes + renderScriptCostsWithScriptHashesMap executionUnitPrices scriptHashes scriptExecUnitsMap diff --git a/cardano-cli/src/Cardano/CLI/Types/Output.hs b/cardano-cli/src/Cardano/CLI/Types/Output.hs index 44bbf5e381..147e2fb33d 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Output.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Output.hs @@ -14,7 +14,7 @@ module Cardano.CLI.Types.Output , ScriptCostOutput (..) , createOpCertIntervalInfo , renderScriptCosts - , renderScriptCostsWithScriptHashes + , renderScriptCostsWithScriptHashesMap ) where @@ -28,7 +28,6 @@ import Prelude import Data.Aeson import qualified Data.Aeson.Key as Aeson -import qualified Data.List as List import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import Data.Text (Text) @@ -364,49 +363,30 @@ renderScriptCosts -- ^ Post execution cost calculation mapping of script witness -- index to execution units. -> Either PlutusScriptCostError [ScriptCostOutput] -renderScriptCosts (UTxO utxo) eUnitPrices scriptMapping executionCostMapping = - sequenceA $ - Map.foldlWithKey - ( \accum sWitInd eExecUnits -> do - case List.lookup sWitInd scriptMapping of - Just (AnyScriptWitness SimpleScriptWitness{}) -> accum - Just (AnyScriptWitness (PlutusScriptWitness _ pVer (PScript pScript) _ _ _)) -> do - let scriptHash = hashScript $ PlutusScript pVer pScript - case eExecUnits of - Right (logs, execUnits) -> - case calculateExecutionUnitsLovelace eUnitPrices execUnits of - Just llCost -> - Right (ScriptCostOutput scriptHash execUnits llCost) - : accum - Nothing -> - Left (PlutusScriptCostErrRationalExceedsBound logs eUnitPrices execUnits) - : accum - Left err -> Left (PlutusScriptCostErrExecError sWitInd (Just scriptHash) err) : accum - -- TODO: Create a new sum type to encapsulate the fact that we can also - -- have a txin and render the txin in the case of reference scripts. - Just (AnyScriptWitness (PlutusScriptWitness _ _ (PReferenceScript refTxIn) _ _ _)) -> - case Map.lookup refTxIn utxo of - Nothing -> Left (PlutusScriptCostErrRefInputNotInUTxO refTxIn) : accum - Just (TxOut _ _ _ refScript) -> - case refScript of - ReferenceScriptNone -> Left (PlutusScriptCostErrRefInputNoScript refTxIn) : accum - ReferenceScript _ (ScriptInAnyLang _ script) -> - case eExecUnits of - Right (logs, execUnits) -> - case calculateExecutionUnitsLovelace eUnitPrices execUnits of - Just llCost -> - Right (ScriptCostOutput (hashScript script) execUnits llCost) - : accum - Nothing -> - Left (PlutusScriptCostErrRationalExceedsBound logs eUnitPrices execUnits) - : accum - Left err -> Left (PlutusScriptCostErrExecError sWitInd Nothing err) : accum - Nothing -> Left (PlutusScriptCostErrPlutusScriptNotFound sWitInd) : accum - ) - [] - executionCostMapping +renderScriptCosts (UTxO utxo) eUnitPrices scriptMapping = + renderScriptCostsWithScriptHashesFunc eUnitPrices getHashForScriptWitnessIndex + where + getHashForScriptWitnessIndex + :: ScriptWitnessIndex -> Either PlutusScriptCostError (Maybe ScriptHash) + getHashForScriptWitnessIndex sWitInd = case lookup sWitInd scriptMapping of + Nothing -> Left (PlutusScriptCostErrPlutusScriptNotFound sWitInd) + Just script -> anyScriptWitnessToHash script -renderScriptCostsWithScriptHashes + anyScriptWitnessToHash :: AnyScriptWitness era -> Either PlutusScriptCostError (Maybe ScriptHash) + anyScriptWitnessToHash = \case + AnyScriptWitness SimpleScriptWitness{} -> Right Nothing + AnyScriptWitness (PlutusScriptWitness _ pVer (PScript pScript) _ _ _) -> + Right $ Just $ hashScript $ PlutusScript pVer pScript + AnyScriptWitness (PlutusScriptWitness _ _ (PReferenceScript refTxIn) _ _ _) -> + case Map.lookup refTxIn utxo of + Nothing -> Left (PlutusScriptCostErrRefInputNotInUTxO refTxIn) + Just (TxOut _ _ _ refScript) -> + case refScript of + ReferenceScriptNone -> Left (PlutusScriptCostErrRefInputNoScript refTxIn) + ReferenceScript _ (ScriptInAnyLang _ script) -> + Right $ Just $ hashScript script + +renderScriptCostsWithScriptHashesMap :: L.Prices -> Map ScriptWitnessIndex ScriptHash -- ^ Initial mapping of script witness index to script hash. @@ -416,12 +396,32 @@ renderScriptCostsWithScriptHashes -- ^ Post execution cost calculation mapping of script witness -- index to execution units. -> Either PlutusScriptCostError [ScriptCostOutput] -renderScriptCostsWithScriptHashes eUnitPrices scriptMapping executionCostMapping = +renderScriptCostsWithScriptHashesMap eUnitPrices scriptMapping = renderScriptCostsWithScriptHashesFunc eUnitPrices scriptMappingFunction + where + scriptMappingFunction witScriptIdx = + maybe + (Left $ PlutusScriptCostErrPlutusScriptNotFound witScriptIdx) + (Right . Just) + (Map.lookup witScriptIdx scriptMapping) + +renderScriptCostsWithScriptHashesFunc + :: L.Prices + -> (ScriptWitnessIndex -> Either PlutusScriptCostError (Maybe ScriptHash)) + -- ^ Initial mapping of script witness index to script hash. + -- We need this in order to know which script corresponds to the + -- calculated execution units. Left is an error, Right Nothing + -- means that the script is not a Plutus script, so it is not meant + -- to be found, Right (Just scriptHash) is the script hash. + -> Map ScriptWitnessIndex (Either ScriptExecutionError ([Text], ExecutionUnits)) + -- ^ Post execution cost calculation mapping of script witness + -- index to execution units. + -> Either PlutusScriptCostError [ScriptCostOutput] +renderScriptCostsWithScriptHashesFunc eUnitPrices scriptMapping executionCostMapping = sequenceA $ Map.foldlWithKey ( \accum sWitInd eExecUnits -> do - case Map.lookup sWitInd scriptMapping of - Just scriptHash -> do + case scriptMapping sWitInd of + Right (Just scriptHash) -> do case eExecUnits of Right (logs, execUnits) -> case calculateExecutionUnitsLovelace eUnitPrices execUnits of @@ -432,7 +432,8 @@ renderScriptCostsWithScriptHashes eUnitPrices scriptMapping executionCostMapping Left (PlutusScriptCostErrRationalExceedsBound logs eUnitPrices execUnits) : accum Left err -> Left (PlutusScriptCostErrExecError sWitInd (Just scriptHash) err) : accum - Nothing -> Left (PlutusScriptCostErrPlutusScriptNotFound sWitInd) : accum + Right Nothing -> accum + Left err -> Left err : accum ) [] executionCostMapping