benchmarking

agora-bench/Bench.hs

@@ -1,12 +1,24 @@
-module Bench (Benchmark (..), benchmarkSize) where
+module Bench (Benchmark (..), benchmarkScript, specificationTreeToBenchmarks) where
 
 import Codec.Serialise (serialise)
 import Data.ByteString.Lazy qualified as LBS
 import Data.ByteString.Short qualified as SBS
-import Data.Set (Set)
-import Data.Set qualified as Set
-import Data.Text (Text)
-import Plutus.V1.Ledger.Scripts qualified as Plutus
+import Data.List (intercalate)
+import Data.Maybe (fromJust)
+import Data.Text (Text, pack)
+import Plutus.V1.Ledger.Api (
+  ExBudget (ExBudget),
+  ExCPU,
+  ExMemory,
+  Script,
+ )
+import Plutus.V1.Ledger.Api qualified as Plutus
+
+import Spec.Spec (
+  Specification (Specification),
+  SpecificationExpectation (Success),
+  SpecificationTree (..),
+ )
 
 --------------------------------------------------------------------------------
 
@@ -14,20 +26,35 @@ import Plutus.V1.Ledger.Scripts qualified as Plutus
 data Benchmark = Benchmark
   { name :: Text
   -- ^ Human readable name describing script.
-  , size :: Int
+  , bCPUBudget :: ExCPU
+  -- ^ The on-chain execution cost of a script.
+  , bMemoryBudget :: ExMemory
+  -- ^ The on-chain memory budget of a script.
+  , bScriptSize :: Int
   -- ^ The on-chain size of a script.
   }
   deriving stock (Show, Eq, Ord)
 
--- | Create a benchmark containing only the size of the script.
-benchmarkSize :: Text -> Plutus.Script -> Set Benchmark
-benchmarkSize name script =
-  Set.singleton $
-    Benchmark
-      { name = name
-      , size = scriptSize script
-      }
+benchmarkScript :: String -> Script -> Benchmark
+benchmarkScript name script = Benchmark (pack name) cpu mem size
+  where
+    (ExBudget cpu mem) = evalScriptCounting . serialiseScriptShort $ script
+    size = SBS.length . SBS.toShort . LBS.toStrict . serialise $ script
 
--- | Compute the size of a script on-chain.
-scriptSize :: Plutus.Script -> Int
-scriptSize = SBS.length . SBS.toShort . LBS.toStrict . serialise
+    serialiseScriptShort :: Script -> SBS.ShortByteString
+    serialiseScriptShort = SBS.toShort . LBS.toStrict . serialise -- Using `flat` here breaks `evalScriptCounting`
+    evalScriptCounting :: Plutus.SerializedScript -> Plutus.ExBudget
+    evalScriptCounting script =
+      let costModel = fromJust Plutus.defaultCostModelParams
+          (_logout, e) = Plutus.evaluateScriptCounting Plutus.Verbose costModel script []
+       in case e of
+            Left evalError -> error ("Eval Error: " <> show evalError)
+            Right exbudget -> exbudget
+
+specificationTreeToBenchmarks :: SpecificationTree -> [Benchmark]
+specificationTreeToBenchmarks = go []
+  where
+    go names (Terminal ((Specification n ex s))) = case ex of
+      Success -> [benchmarkScript (intercalate "/" (names <> [n])) s]
+      _ -> []
+    go names (Group gn tree) = mconcat $ go (names <> [gn]) <$> tree