Add script size and budget calculation (#25)

* Move around

* add ScriptSize, and remove duplicate code

* run in bench

Author: srid

README.md

@@ -15,6 +15,8 @@ Pluton is intended to:
 - Enrich [Plutarch](https://github.com/Plutonomicon/plutarch) to enable a more ergonomic DSL for writing smart contracts. It is a staging ground for these features to eventually be upstreamed to Plutarch. 
 - Benchmark (script size, cpu/mem cost) functions and smart contracts written in Haskell, Plutarch and [Pluto](https://github.com/Plutonomicon/pluto), and use that as a guide for enrichment.
 
+See [Project board](https://github.com/orgs/Plutonomicon/projects/2/views/1) for planned tasks.
+
 ## Developing
 
 `nix develop` should get a dev environment with Haskell Language Server support and ghcid.

bench/Bench.hs

@@ -2,6 +2,10 @@ module Main (main) where
 
 import Criterion.Main
 import Criterion.Types
+import Example.Contract.Gift.Validator.Haskell qualified as Gift
+import Example.Contract.Gift.Validator.Plutarch qualified as Gift
+import Example.Contract.Gift.Validator.Pluto qualified as Gift
+import Pluton.Run qualified as Run
 
 -- TODO: placeholder only for https://github.com/Plutonomicon/pluton/issues/9
 --
@@ -17,7 +21,8 @@ fib m
     go n = go (n -1) + go (n -2)
 
 main :: IO ()
-main =
+main = do
+  exampleContractGift
   defaultMainWith
     cfg
     [ bgroup
@@ -36,3 +41,10 @@ main =
           jsonFile = Just "bench.json",
           csvFile = Just "bench.csv"
         }
+
+exampleContractGift :: IO ()
+exampleContractGift = do
+  putStrLn "\n== Sample contract - Gift: sizes (haskell; pluto; plutarch) == "
+  print $ Run.validatorSize Gift.haskellValidator
+  print $ Run.validatorSize Gift.plutoValidator
+  print $ Run.validatorSize Gift.plutarchValidator

examples/Example/Contract/Gift/Validator/Pluto.hs

@@ -10,7 +10,7 @@ import PlutusCore.Assembler.Types.AST qualified as Pluto
 -- FIXME: This is known to trigger a HLS bug with symbol resolution
 -- See https://github.com/haskell/haskell-language-server/issues/1737#issuecomment-825516365
 plutoValidatorProg :: Pluto.Program ()
-plutoValidatorProg = $(PlutoFFI.load "src/Pluton/Sample/Validator/validator.pluto")
+plutoValidatorProg = $(PlutoFFI.load "examples/Example/Contract/Gift/Validator/validator.pluto")
 
 plutoValidator :: Validator
 plutoValidator =

exe/Main.hs

@@ -2,13 +2,23 @@
 
 module Main (main) where
 
-import Pluton qualified as Pluton
-import Example.Contract.Gift.Test qualified as SampleTest
-import Example.Contract.Gift.Validator.Plutarch qualified as Sample
+import Example.Contract.Gift.Test qualified as GiftTest
+import Example.Contract.Gift.Validator.Haskell qualified as Gift
+import Example.Contract.Gift.Validator.Plutarch qualified as Gift
+import Example.Contract.Gift.Validator.Pluto qualified as Gift
+import Pluton qualified
+import Pluton.Run qualified as Run
 import Plutus.Trace.Emulator qualified as Em
 
 main :: IO ()
 main = do
   Pluton.smoke
-  Em.runEmulatorTraceIO $ SampleTest.smokeTrace Sample.plutarchValidator
-  SampleTest.tests
+  -- Gift contract example
+  putStrLn "\n== Sample contract - Gift: sizes (haskell; pluto; plutarch) == "
+  print $ Run.validatorSize Gift.haskellValidator
+  print $ Run.validatorSize Gift.plutoValidator
+  print $ Run.validatorSize Gift.plutarchValidator
+  putStrLn "\n== Sample contract - Gift: emulator == "
+  Em.runEmulatorTraceIO $ GiftTest.smokeTrace Gift.plutarchValidator
+  putStrLn "\n== Sample contract - Gift: tests == "
+  GiftTest.tests

pluton.cabal

@@ -35,7 +35,9 @@ library
   hs-source-dirs:  src
   exposed-modules:
     Pluton
-    Pluton.Evaluate
+    Pluton.Run
+    Pluton.Run.Evaluate
+    Pluton.Run.ScriptSize
     Pluton.Types.Builtin
     Pluton.Types.Builtin.Data
     Pluton.Types.Builtin.Fun
@@ -47,14 +49,16 @@ library
   build-depends:
     , base
     , bytestring
+    , cardano-api
+    , cardano-ledger-alonzo
     , containers
     , fin
     , freer-extras
     , hashable
     , hedgehog
     , lens
     , mtl
-    , plutarch           >=1.0
+    , plutarch               >=1.0
     , pluto
     , plutus-contract
     , plutus-core
@@ -63,6 +67,7 @@ library
     , plutus-tx
     , plutus-tx-plugin
     , QuickCheck
+    , serialise
     , shower
     , tasty
     , tasty-hedgehog
@@ -150,5 +155,6 @@ benchmark perf
     , base
     , criterion
     , pluton
+    , pluton-examples
     , plutus-contract
     , plutus-core

src/Pluton.hs

@@ -6,7 +6,8 @@ import Plutarch qualified
 import Plutarch qualified as PLC
 import Plutarch.Bool as X
 import Plutarch.Integer as X
-import Pluton.Evaluate qualified as Smoke
+import Pluton.Run qualified as Run
+import Pluton.Run.Evaluate qualified as Smoke
 import Pluton.Types.Builtin as X
 import Pluton.Types.Builtin.Data ()
 import Pluton.Types.Builtin.List qualified as BL
@@ -32,7 +33,9 @@ fibs = phoistAcyclic $
 smoke :: IO ()
 smoke = do
   let eval :: ClosedTerm a -> IO ()
-      eval p = print $ Smoke.evalPlutarch p
+      eval p = do
+        print $ Smoke.evalPlutarch p
+        print $ Run.scriptSize $ Run.compile p
       fourtyTwo = 42 :: Term s PInteger
       intNil =
         Plutarch.punsafeConstant $

src/Pluton/Run.hs

@@ -0,0 +1,4 @@
+module Pluton.Run (module X) where
+
+import Pluton.Run.Evaluate as X
+import Pluton.Run.ScriptSize as X

src/Pluton/Evaluate.hs renamed to src/Pluton/Run/Evaluate.hs

@@ -1,10 +1,7 @@
-module Pluton.Evaluate
-  ( -- * General evaluation of UPLC
-    eval,
-    evalWithArgs,
-
-    -- * Evaluation of Plutarch eDSL
+module Pluton.Run.Evaluate
+  ( -- * Evaluation of Plutarch eDSL
     evalPlutarch,
+    Plutarch.compile,
   )
 where
 
@@ -41,8 +38,8 @@ evalPlutarch p =
 eval :: Script -> Either Error (ExBudget, [Text], Term Name DefaultUni DefaultFun ())
 eval = evaluateScript @(Either Error)
 
-evalWithArgs :: [PLC.Data] -> Script -> Either Error (ExBudget, [Text], Term Name DefaultUni DefaultFun ())
-evalWithArgs args =
+_evalWithArgs :: [PLC.Data] -> Script -> Either Error (ExBudget, [Text], Term Name DefaultUni DefaultFun ())
+_evalWithArgs args =
   evaluateScript @(Either Error)
     . flip Scripts.applyArguments args
 

src/Pluton/Run/ScriptSize.hs

@@ -0,0 +1,37 @@
+module Pluton.Run.ScriptSize
+  ( scriptSize,
+    validatorSize,
+  )
+where
+
+import Codec.Serialise (serialise)
+import Control.Arrow ((&&&))
+import Data.ByteString.Lazy qualified as LB
+import Data.ByteString.Short qualified as SBS
+import Data.Maybe (fromJust)
+import GHC.Stack (HasCallStack)
+import Ledger.Scripts (Script, Validator)
+import Plutus.V1.Ledger.Api qualified as Plutus
+
+-- (ExBudget {exBudgetCPU = ExCPU 327603, exBudgetMemory = ExMemory 1200},336)
+
+-- | Return the script size in bytes along with execution budget.
+validatorSize :: Validator -> (Plutus.ExBudget, Int)
+validatorSize = (evalScriptCounting &&& SBS.length) . serialiseValidator
+
+scriptSize :: Script -> (Plutus.ExBudget, Int)
+scriptSize = (evalScriptCounting &&& SBS.length) . serialiseScript
+
+serialiseScript :: Script -> SBS.ShortByteString
+serialiseScript = SBS.toShort . LB.toStrict . serialise
+
+serialiseValidator :: Validator -> SBS.ShortByteString
+serialiseValidator = SBS.toShort . LB.toStrict . serialise
+
+evalScriptCounting :: HasCallStack => Plutus.SerializedScript -> Plutus.ExBudget
+evalScriptCounting script = do
+  let costModel = fromJust Plutus.defaultCostModelParams
+      (_logout, e) = Plutus.evaluateScriptCounting Plutus.Verbose costModel script []
+   in case e of
+        Left evalErr -> error ("Eval Error: " <> show evalErr)
+        Right exbudget -> exbudget