From b4b85e623f7c6f9d1407830d6f13968d10cd30c4 Mon Sep 17 00:00:00 2001
From: Emily Martins <emi@haskell.fyi>
Date: Wed, 18 May 2022 16:28:26 +0200
Subject: [PATCH] add size benchmarking for scripts to `agora-bench`

---
 agora-bench/Bench.hs | 33 +++++++++++++++++++++++++++++++++
 agora-bench/Main.hs  | 42 +++++++++++++++++++++++++++++++++++-------
 agora.cabal          |  5 ++++-
 3 files changed, 72 insertions(+), 8 deletions(-)
 create mode 100644 agora-bench/Bench.hs

diff --git a/agora-bench/Bench.hs b/agora-bench/Bench.hs
new file mode 100644
index 0000000..0539f24
--- /dev/null
+++ b/agora-bench/Bench.hs
@@ -0,0 +1,33 @@
+module Bench (Benchmark (..), benchmarkSize) 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
+
+--------------------------------------------------------------------------------
+
+-- | Represents the benchmark of a plutus script.
+data Benchmark = Benchmark
+  { name :: Text
+  -- ^ Human readable name describing script.
+  , size :: 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
+      }
+
+-- | Compute the size of a script on-chain.
+scriptSize :: Plutus.Script -> Int
+scriptSize = SBS.length . SBS.toShort . LBS.toStrict . serialise
diff --git a/agora-bench/Main.hs b/agora-bench/Main.hs
index 62046f7..95307ca 100644
--- a/agora-bench/Main.hs
+++ b/agora-bench/Main.hs
@@ -1,14 +1,42 @@
 module Main (main) where
 
+import Agora.AuthorityToken (authorityTokenPolicy)
+import Agora.Effect.TreasuryWithdrawal (treasuryWithdrawalValidator)
+import Agora.Governor (Governor (..))
+import Agora.Governor.Scripts (governorPolicy, governorValidator)
+import Agora.Proposal.Scripts (proposalPolicy, proposalValidator)
+import Agora.Stake.Scripts (stakePolicy, stakeValidator)
+import Agora.Treasury (treasuryValidator)
+import Bench
+import Data.Foldable (for_)
+import Plutus.V1.Ledger.Api (CurrencySymbol)
+import Sample.Shared
 import Prelude
 
 --------------------------------------------------------------------------------
 
---------------------------------------------------------------------------------
-
---------------------------------------------------------------------------------
-
---------------------------------------------------------------------------------
-
 main :: IO ()
-main = pure ()
+main = do
+  let benchmarks =
+        mconcat
+          [ -- GATs
+            benchmarkSize "authorityTokenPolicy" $ compile $ authorityTokenPolicy authorityToken
+          , -- Governor
+            benchmarkSize "governorValidator" $ compile $ governorValidator governor
+          , benchmarkSize "governorPolicy" $ compile $ governorPolicy governor
+          , -- Stake
+            benchmarkSize "stakeValidator" $ compile $ stakeValidator stake
+          , benchmarkSize "stakePolicy" $ compile $ stakePolicy governor.gtClassRef
+          , -- Proposal
+            benchmarkSize "proposalValidator" $ compile $ proposalValidator proposal
+          , benchmarkSize "proposalPolicy" $ compile $ proposalPolicy govAssetClass
+          , -- Treasury
+            benchmarkSize "treasuryValidator" $ compile $ treasuryValidator gatCS
+          , -- Effect validators
+            benchmarkSize "treasuryWithdrawalValidator" $ compile $ treasuryWithdrawalValidator gatCS
+          ]
+
+  for_ benchmarks print
+
+gatCS :: CurrencySymbol
+gatCS = "73475cb40a568e8da8a045ced110137e159f890ac4da883b6b17dc651b3a8049" -- arbitrary CS
diff --git a/agora.cabal b/agora.cabal
index c8ce871..6d34d9c 100644
--- a/agora.cabal
+++ b/agora.cabal
@@ -198,8 +198,11 @@ benchmark agora-bench
   import:         lang, deps
   hs-source-dirs: agora-bench
   main-is:        Main.hs
+  other-modules:  Bench
   type:           exitcode-stdio-1.0
-  build-depends:  agora
+  build-depends:
+    , agora
+    , agora-sample
 
 executable agora-purescript-bridge
   import:         lang, deps, exe-opts