Refactor transaction build to use `renderScriptCostsWithScriptHashe…

…sMap`
IntersectMBO · Jan 31, 2025 · 8bd3765 · 8bd3765
1 parent 146976f
commit 8bd3765
Show file tree

Hide file tree

Showing 3 changed files with 17 additions and 66 deletions.
diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal
@@ -214,7 +214,9 @@ library
     cardano-crypto-wrapper ^>=1.5.1,
     cardano-data >=1.1,
     cardano-git-rev ^>=0.2.2,
+    cardano-ledger-alonzo,
     cardano-ledger-api,
+    cardano-ledger-core,
     cardano-ping ^>=0.7,
     cardano-prelude,
     cardano-slotting ^>=0.2.0.0,

diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs
@@ -64,7 +64,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, renderScriptCostsWithScriptHashesMap)
+import           Cardano.CLI.Types.Output (renderScriptCostsWithScriptHashesMap)
 import           Cardano.CLI.Types.TxFeature
 import           Cardano.Ledger.Api (allInputsTxBodyF, bodyTxL)
 import           Cardano.Prelude (putLByteString)
@@ -361,15 +361,18 @@ runTransactionBuildCmd
                 txEraUtxo
                 balancedTxBody
 
-        let mScriptWits = forEraInEon era' [] $ \sbe -> collectTxBodyScriptWitnesses sbe txBodyContent
+        scriptHashes <-
+          monoidForEraInEon @AlonzoEraOnwards
+            era'
+            (\aeo -> pure $ collectPlutusScriptHashes aeo balancedTxBody txEraUtxo)
+            & hoistMaybe (TxCmdAlonzoEraOnwardsRequired era')
 
         scriptCostOutput <-
           firstExceptT TxCmdPlutusScriptCostErr $
             hoistEither $
-              renderScriptCosts
-                txEraUtxo
+              renderScriptCostsWithScriptHashesMap
                 executionUnitPrices
-                mScriptWits
+                scriptHashes
                 scriptExecUnitsMap
         liftIO $ LBS.writeFile (unFile fp) $ encodePretty scriptCostOutput
       OutputTxBodyOnly fpath -> do
@@ -1720,7 +1723,9 @@ runTransactionCalculatePlutusScriptCostCmd
       -> ExceptT TxCmdError IO ()
     calculatePlutusScriptsCosts era' systemStart eraHistory pparams txEraUtxo txBody = do
       scriptHashes <-
-        monoidForEraInEon @AlonzoEraOnwards era' (\aeo -> pure $ collectScriptHashes aeo txBody txEraUtxo)
+        monoidForEraInEon @AlonzoEraOnwards
+          era'
+          (\aeo -> pure $ collectPlutusScriptHashes aeo txBody txEraUtxo)
           & hoistMaybe (TxCmdAlonzoEraOnwardsRequired era')
 
       executionUnitPrices <-

diff --git a/cardano-cli/src/Cardano/CLI/Types/Output.hs b/cardano-cli/src/Cardano/CLI/Types/Output.hs
@@ -13,7 +13,6 @@ module Cardano.CLI.Types.Output
   , QueryTipLocalStateOutput (..)
   , ScriptCostOutput (..)
   , createOpCertIntervalInfo
-  , renderScriptCosts
   , renderScriptCostsWithScriptHashesMap
   )
 where
@@ -352,40 +351,6 @@ instance Error PlutusScriptCostError where
     PlutusScriptCostErrRefInputNotInUTxO txin ->
       "Reference input was not found in utxo: " <> pretty (renderTxIn txin)
 
-renderScriptCosts
-  :: UTxO era
-  -> L.Prices
-  -> [(ScriptWitnessIndex, AnyScriptWitness era)]
-  -- ^ Initial mapping of script witness index to actual script.
-  -- We need this in order to know which script corresponds to the
-  -- calculated execution units.
-  -> Map ScriptWitnessIndex (Either ScriptExecutionError ([Text], ExecutionUnits))
-  -- ^ Post execution cost calculation mapping of script witness
-  -- index to execution units.
-  -> Either PlutusScriptCostError [ScriptCostOutput]
-renderScriptCosts (UTxO utxo) eUnitPrices scriptMapping =
-  renderScriptCostsWithScriptHashesFunc eUnitPrices getHashForScriptWitnessIndex
- where
-  getHashForScriptWitnessIndex
-    :: ScriptWitnessIndex -> Either PlutusScriptCostError (Maybe ScriptHash)
-  getHashForScriptWitnessIndex sWitInd =
-    maybe (Left $ PlutusScriptCostErrPlutusScriptNotFound sWitInd) anyScriptWitnessToHash $
-      lookup sWitInd scriptMapping
-
-  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
@@ -396,32 +361,12 @@ renderScriptCostsWithScriptHashesMap
   -- ^ Post execution cost calculation mapping of script witness
   -- index to execution units.
   -> Either PlutusScriptCostError [ScriptCostOutput]
-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 =
+renderScriptCostsWithScriptHashesMap eUnitPrices scriptMap executionCostMapping =
   sequenceA $
     Map.foldlWithKey
       ( \accum sWitInd eExecUnits -> do
-          case scriptMapping sWitInd of
-            Right (Just scriptHash) -> do
+          case Map.lookup sWitInd scriptMap of
+            Just scriptHash -> do
               case eExecUnits of
                 Right (logs, execUnits) ->
                   case calculateExecutionUnitsLovelace eUnitPrices execUnits of
@@ -432,8 +377,7 @@ renderScriptCostsWithScriptHashesFunc eUnitPrices scriptMapping executionCostMap
                       Left (PlutusScriptCostErrRationalExceedsBound logs eUnitPrices execUnits)
                         : accum
                 Left err -> Left (PlutusScriptCostErrExecError sWitInd (Just scriptHash) err) : accum
-            Right Nothing -> accum
-            Left err -> Left err : accum
+            Nothing -> Left (PlutusScriptCostErrPlutusScriptNotFound sWitInd) : accum
       )
       []
       executionCostMapping