Merge pull request IntersectMBO#3953 from input-output-hk/mpj/return-remaining-budget

SCP-2772: Teach evaluateScriptRestricting to return the used budget

Author: michaelpj

cabal.project

@@ -185,7 +185,7 @@ source-repository-package
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/cardano-ledger-specs
-  tag: 8efcfc755faae4db3a64ad45343235fce3ed5c47
+  tag: 6b884673ab0bfa120b63a30fb4dc255e3f3a02bc
   subdir:
     byron/chain/executable-spec
     byron/crypto

nix/pkgs/haskell/haskell.nix

@@ -48,7 +48,7 @@ let
       "https://github.com/shmish111/servant-purescript.git"."a76104490499aa72d40c2790d10e9383e0dbde63" = "11nxxmi5bw66va7psvrgrw7b7n85fvqgfp58yva99w3v9q3a50v9";
       "https://github.com/input-output-hk/cardano-base"."46502694f6a9f0498f822068008b232b3837a9e9" = "04bvsvghkrjhfjb3phh0s5yfb37fishglrrlcwbvcv48y2in1dcz";
       "https://github.com/input-output-hk/cardano-crypto.git"."07397f0e50da97eaa0575d93bee7ac4b2b2576ec" = "06sdx5ndn2g722jhpicmg96vsrys89fl81k8290b3lr6b1b0w4m3";
-      "https://github.com/input-output-hk/cardano-ledger-specs"."8efcfc755faae4db3a64ad45343235fce3ed5c47" = "13mj8nqk4jglyl96d6zm3dbjmx2qn5gwn06g7cmanxiwfkfm7bi1";
+      "https://github.com/input-output-hk/cardano-ledger-specs"."6b884673ab0bfa120b63a30fb4dc255e3f3a02bc" = "1lpr35zpp4sqy4lqra24wswwkmaryvgj4rlbkn5n3z79f83jqgz4";
       "https://github.com/input-output-hk/cardano-prelude"."fd773f7a58412131512b9f694ab95653ac430852" = "02jddik1yw0222wd6q0vv10f7y8rdgrlqaiy83ph002f9kjx7mh6";
       "https://github.com/input-output-hk/goblins"."cde90a2b27f79187ca8310b6549331e59595e7ba" = "17c88rbva3iw82yg9srlxjv2ia5wjb9cyqw44hik565f5v9svnyg";
       "https://github.com/input-output-hk/iohk-monitoring-framework"."46f994e216a1f8b36fe4669b47b2a7011b0e153c" = "1il8fx3misp3650ryj368b3x95ksz01zz3x0z9k00807j93d0ka0";

plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/ExBudget.hs

@@ -137,6 +137,7 @@ possible to adjust them at runtime.
 
 module PlutusCore.Evaluation.Machine.ExBudget
     ( ExBudget(..)
+    , minusExBudget
     , ExBudgetBuiltin(..)
     , ExRestrictingBudget(..)
     , LowerIntialCharacter
@@ -178,6 +179,10 @@ data ExBudget = ExBudget { exBudgetCPU :: ExCPU, exBudgetMemory :: ExMemory }
     deriving (FromJSON, ToJSON) via CustomJSON '[FieldLabelModifier LowerIntialCharacter] ExBudget
     -- LowerIntialCharacter won't actually do anything here, but let's have it in case we change the field names.
 
+-- | Subract one 'ExBudget' from another. Does not guarantee that the result is positive.
+minusExBudget :: ExBudget -> ExBudget -> ExBudget
+minusExBudget (ExBudget c1 m1) (ExBudget c2 m2) = ExBudget (c1-c2) (m1-m2)
+
 -- These functions are performance critical, so we can't use GenericSemigroupMonoid, and we insist that they be inlined.
 instance Semigroup ExBudget where
     {-# INLINE (<>) #-}

plutus-ledger-api/src/Plutus/V1/Ledger/Api.hs

@@ -220,24 +220,25 @@ mkTermToEvaluate bs args = do
     pure t
 
 -- | Evaluates a script, with a cost model and a budget that restricts how many
--- resources it can use according to the cost model.  There's a default cost
--- model in  'UPLC.defaultBuiltinCostModel' and a budget called 'enormousBudget' in
--- 'UntypedPlutusCore.Evaluation.Machine.Cek.ExBudgetMode' which should be large
--- enough to evaluate any sensible program.
+-- resources it can use according to the cost model. Also returns the budget that
+-- was actually used.
+--
+-- Can be used to calculate budgets for scripts, but even in this case you must give
+-- a limit to guard against scripts that run for a long time or loop.
 evaluateScriptRestricting
     :: VerboseMode     -- ^ Whether to produce log output
     -> CostModelParams -- ^ The cost model to use
     -> ExBudget        -- ^ The resource budget which must not be exceeded during evaluation
     -> SerializedScript          -- ^ The script to evaluate
     -> [PLC.Data]          -- ^ The arguments to the script
-    -> (LogOutput, Either EvaluationError ())
+    -> (LogOutput, Either EvaluationError ExBudget)
 evaluateScriptRestricting verbose cmdata budget p args = swap $ runWriter @LogOutput $ runExceptT $ do
     appliedTerm <- mkTermToEvaluate p args
     model <- case applyCostModelParams PLC.defaultCekCostModel cmdata of
         Just model -> pure model
         Nothing    -> throwError CostModelParameterMismatch
 
-    let (res, _, logs) =
+    let (res, UPLC.RestrictingSt (PLC.ExRestrictingBudget final), logs) =
             UPLC.runCek
                 (toMachineParameters model)
                 (UPLC.restricting $ PLC.ExRestrictingBudget budget)
@@ -246,9 +247,12 @@ evaluateScriptRestricting verbose cmdata budget p args = swap $ runWriter @LogOu
 
     tell logs
     liftEither $ first CekError $ void res
+    pure (budget `PLC.minusExBudget` final)
 
 -- | Evaluates a script, returning the minimum budget that the script would need
--- to evaluate successfully.
+-- to evaluate successfully. This will take as long as the script takes, if you need to
+-- limit the execution time of the script also, you can use 'evaluateScriptRestricting', which
+-- also returns the used budget.
 evaluateScriptCounting
     :: VerboseMode     -- ^ Whether to produce log output
     -> CostModelParams -- ^ The cost model to use