Merge pull request #94 from Liqwid-Labs/seungheonoh/genericSpecInterface

Specs for benchmarking
2022-05-26 10:25:02 -05:00 · 2022-05-26 10:25:02 -05:00 · ae91b9157b
commit ae91b9157b
parent c51b8fa9de 53e48843c9
17 changed files with 505 additions and 330 deletions
--- a/agora-bench/Bench.hs
+++ b/agora-bench/Bench.hs
@ -1,12 +1,29 @@
-module Bench (Benchmark (..), benchmarkSize) where
+{-# LANGUAGE RecordWildCards #-}
+
+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.Csv (DefaultOrdered, ToNamedRecord, header, headerOrder, namedRecord, toNamedRecord, (.=))
+import Data.List (intercalate)
+import Data.Maybe (fromJust)
+import Data.Text (Text, pack)
+import GHC.Generics (Generic)
+import Plutus.V1.Ledger.Api (
+  ExBudget (ExBudget),
+  ExCPU (..),
+  ExMemory (..),
+  Script,
+ )
+import Plutus.V1.Ledger.Api qualified as Plutus
+import Prettyprinter (Pretty (pretty), indent, vsep)
+
+import Spec.Specification (
+  Specification (Specification),
+  SpecificationExpectation (Success),
+  SpecificationTree (..),
+ )

 --------------------------------------------------------------------------------

@ -14,20 +31,59 @@ import Plutus.V1.Ledger.Scripts qualified as Plutus
 data Benchmark = Benchmark
  { name :: Text
  -- ^ Human readable name describing script.
-  , size :: Int
+  , cpuBudget :: ExCPU
+  -- ^ The on-chain execution cost of a script.
+  , memoryBudget :: ExMemory
+  -- ^ The on-chain memory budget of a script.
+  , scriptSize :: Int
  -- ^ The on-chain size of a script.
  }
-  deriving stock (Show, Eq, Ord)
+  deriving stock (Show, Eq, Ord, Generic)

-- | 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
-      }
+instance Pretty Benchmark where
+  pretty (Benchmark name (ExCPU (toInteger -> cpu)) (ExMemory (toInteger -> mem)) size) =
+    vsep
+      [ pretty name
+      , indent 4 $
+          vsep
+            [ "CPU: " <> pretty cpu
+            , "MEM: " <> pretty mem
+            , "SIZE: " <> pretty size
+            ]
+      ]

-- | Compute the size of a script on-chain.
-scriptSize :: Plutus.Script -> Int
-scriptSize = SBS.length . SBS.toShort . LBS.toStrict . serialise
+instance ToNamedRecord Benchmark where
+  toNamedRecord (Benchmark {..}) =
+    namedRecord
+      [ "name" .= name
+      , "cpu" .= cpuBudget
+      , "mem" .= memoryBudget
+      , "size" .= scriptSize
+      ]
+
+instance DefaultOrdered Benchmark where
+  headerOrder _ = header ["name", "cpu", "mem", "size"]
+
+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
+
+    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
--- a/agora-bench/Main.hs
+++ b/agora-bench/Main.hs
@ -1,42 +1,43 @@
 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 Bench (specificationTreeToBenchmarks)
+import Data.Csv (encodeDefaultOrderedByName)
+import Data.Text.Lazy.Encoding (decodeUtf8)
+import Data.Text.Lazy.IO as I (writeFile)
+import Prettyprinter (defaultLayoutOptions, layoutPretty, pretty)
+import Prettyprinter.Render.String (renderString)
+import Spec.AuthorityToken qualified as AuthorityToken
+import Spec.Effect.GovernorMutation qualified as GovernorMutation
+import Spec.Effect.TreasuryWithdrawal qualified as TreasuryWithdrawal
+import Spec.Governor qualified as Governor
+import Spec.Proposal qualified as Proposal
+import Spec.Specification (group)
+import Spec.Stake qualified as Stake
+import Spec.Treasury qualified as Treasury
 import Prelude

 --------------------------------------------------------------------------------

 main :: IO ()
 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
+  I.writeFile "bench.csv" $
+    (decodeUtf8 . encodeDefaultOrderedByName) res
+
+  mapM_ (putStrLn . renderString . layoutPretty defaultLayoutOptions . pretty) res
+  where
+    res =
+      specificationTreeToBenchmarks $
+        group
+          "Agora"
+          [ group
+              "Effects"
+              [ group "Treasury Withdrawal Effect" TreasuryWithdrawal.specs
+              , group "Governor Mutation Effect" GovernorMutation.specs
+              ]
+          , group "Stake" Stake.specs
+          , group "Proposal" Proposal.specs
+          , group "AuthorityToken" AuthorityToken.specs
+          , group "Treasury" Treasury.specs
+          , group "AuthorityToken" AuthorityToken.specs
+          , group "Governor" Governor.specs
          ]
-
-  for_ benchmarks print
-
-gatCS :: CurrencySymbol
-gatCS = "73475cb40a568e8da8a045ced110137e159f890ac4da883b6b17dc651b3a8049" -- arbitrary CS
--- a/agora-spec/Spec/AuthorityToken.hs
+++ b/agora-spec/Spec/AuthorityToken.hs
@ -7,13 +7,12 @@ Description: Tests for Authority token functions

 Tests for Authority token functions
 -}
-module Spec.AuthorityToken (tests) where
+module Spec.AuthorityToken (specs) where

 --------------------------------------------------------------------------------

 import Agora.AuthorityToken (singleAuthorityTokenBurned)
 import Plutarch
-import Test.Tasty (TestTree, testGroup)
 import Prelude

 --------------------------------------------------------------------------------
@ -33,7 +32,12 @@ import Plutus.V1.Ledger.Api (
 import Plutus.V1.Ledger.Interval qualified as Interval
 import Plutus.V1.Ledger.Value qualified as Value
 import PlutusTx.AssocMap qualified as AssocMap
-import Test.Util (scriptFails, scriptSucceeds)
+import Spec.Specification (
+  SpecificationTree,
+  group,
+  scriptFails,
+  scriptSucceeds,
+ )

 currencySymbol :: CurrencySymbol
 currencySymbol = "deadbeef"
@ -65,10 +69,10 @@ singleAuthorityTokenBurnedTest mint outs =
          perror
   in compile s

-tests :: [TestTree]
-tests =
+specs :: [SpecificationTree]
+specs =
  [ -- This is better suited for plutarch-test
-    testGroup
+    group
      "singleAuthorityTokenBurned"
      [ scriptSucceeds
          "Correct simple"
--- a/agora-spec/Spec/Effect/GovernorMutation.hs
+++ b/agora-spec/Spec/Effect/GovernorMutation.hs
@ -1,4 +1,4 @@
-module Spec.Effect.GovernorMutation (tests) where
+module Spec.Effect.GovernorMutation (specs) where

 import Agora.Effect.GovernorMutation (mutateGovernorValidator)
 import Agora.Governor (GovernorDatum (..), GovernorRedeemer (MutateGovernor))
@ -15,14 +15,20 @@ import Sample.Effect.GovernorMutation (
  validNewGovernorDatum,
 )
 import Sample.Shared qualified as Shared
-import Test.Tasty (TestTree, testGroup)
-import Test.Util (effectFailsWith, effectSucceedsWith, validatorFailsWith, validatorSucceedsWith)
+import Spec.Specification (
+  SpecificationTree,
+  effectFailsWith,
+  effectSucceedsWith,
+  group,
+  validatorFailsWith,
+  validatorSucceedsWith,
+ )

-tests :: [TestTree]
-tests =
-  [ testGroup
+specs :: [SpecificationTree]
+specs =
+  [ group
      "validator"
-      [ testGroup
+      [ group
          "valid new governor datum"
          [ validatorSucceedsWith
              "governor validator should pass"
@ -44,7 +50,7 @@ tests =
              (mkEffectDatum validNewGovernorDatum)
              (ScriptContext (mkEffectTxInfo validNewGovernorDatum) (Spending effectRef))
          ]
-      , testGroup
+      , group
          "invalid new governor datum"
          [ validatorFailsWith
              "governor validator should fail"
--- a/agora-spec/Spec/Effect/TreasuryWithdrawal.hs
+++ b/agora-spec/Spec/Effect/TreasuryWithdrawal.hs
@ -3,9 +3,9 @@ Module     : Spec.Effect.TreasuryWithdrawalEffect
 Maintainer : seungheon.ooh@gmail.com
 Description: Sample based testing for Treasury Withdrawal Effect

-This module tests the Treasury Withdrawal Effect.
+This module specs the Treasury Withdrawal Effect.
 -}
-module Spec.Effect.TreasuryWithdrawal (tests) where
+module Spec.Effect.TreasuryWithdrawal (specs) where

 import Agora.Effect.TreasuryWithdrawal (
  TreasuryWithdrawalDatum (TreasuryWithdrawalDatum),
@ -25,12 +25,16 @@ import Sample.Effect.TreasuryWithdrawal (
  treasuries,
  users,
 )
-import Test.Tasty (TestTree, testGroup)
-import Test.Util (effectFailsWith, effectSucceedsWith)
+import Spec.Specification (
+  SpecificationTree,
+  effectFailsWith,
+  effectSucceedsWith,
+  group,
+ )

-tests :: [TestTree]
-tests =
-  [ testGroup
+specs :: [SpecificationTree]
+specs =
+  [ group
      "effect"
      [ effectSucceedsWith
          "Simple"
--- a/agora-spec/Spec/Governor.hs
+++ b/agora-spec/Spec/Governor.hs
@ -3,7 +3,7 @@ Module     : Spec.Governor
 Maintainer : connor@mlabs.city
 Description: Tests for Agora governor.

-Thie module exports `tests`, a list of `TestTree`s, which ensure
+Thie module exports `specs`, a list of `TestTree`s, which ensure
 that Agora's governor component workds as intended.

 Tests should pass when the validator or policy is given one of the
@ -11,7 +11,7 @@ valid script contexts, which are defined in 'Agora.Sample.Governor'.

 TODO: Add negative test cases, see [#76](https://github.com/Liqwid-Labs/agora/issues/76).
 -}
-module Spec.Governor (tests) where
+module Spec.Governor (specs) where

 import Agora.Governor (GovernorDatum (..), GovernorRedeemer (..))
 import Agora.Governor.Scripts (governorPolicy, governorValidator)
@ -19,14 +19,18 @@ import Agora.Proposal (ProposalId (..))
 import Data.Default.Class (Default (def))
 import Sample.Governor (createProposal, mintGATs, mintGST, mutateState)
 import Sample.Shared qualified as Shared
-import Test.Tasty (TestTree, testGroup)
-import Test.Util (policySucceedsWith, validatorSucceedsWith)
+import Spec.Specification (
+  SpecificationTree,
+  group,
+  policySucceedsWith,
+  validatorSucceedsWith,
+ )

 --------------------------------------------------------------------------------

-tests :: [TestTree]
-tests =
-  [ testGroup
+specs :: [SpecificationTree]
+specs =
+  [ group
      "policy"
      [ policySucceedsWith
          "GST minting"
@ -34,7 +38,7 @@ tests =
          ()
          mintGST
      ]
-  , testGroup
+  , group
      "validator"
      [ validatorSucceedsWith
          "proposal creation"
--- a/agora-spec/Spec/Model/MultiSig.hs
+++ b/agora-spec/Spec/Model/MultiSig.hs
--- a/agora-spec/Spec/Proposal.hs
+++ b/agora-spec/Spec/Proposal.hs
@ -7,7 +7,7 @@ Description: Tests for Proposal policy and validator

 Tests for Proposal policy and validator
 -}
-module Spec.Proposal (tests) where
+module Spec.Proposal (specs) where

 --------------------------------------------------------------------------------

@ -45,15 +45,19 @@ import PlutusTx.AssocMap qualified as AssocMap
 import Sample.Proposal qualified as Proposal
 import Sample.Shared (signer, signer2)
 import Sample.Shared qualified as Shared
-import Test.Tasty (TestTree, testGroup)
-import Test.Util (policySucceedsWith, validatorSucceedsWith)
+import Spec.Specification (
+  SpecificationTree,
+  group,
+  policySucceedsWith,
+  validatorSucceedsWith,
+ )

 --------------------------------------------------------------------------------

-- | Stake tests.
-tests :: [TestTree]
-tests =
-  [ testGroup
+-- | Stake specs.
+specs :: [SpecificationTree]
+specs =
+  [ group
      "policy"
      [ policySucceedsWith
          "proposalCreation"
@ -61,9 +65,9 @@ tests =
          ()
          Proposal.proposalCreation
      ]
-  , testGroup
+  , group
      "validator"
-      [ testGroup
+      [ group
          "cosignature"
          [ validatorSucceedsWith
              "proposal"
@ -97,7 +101,7 @@ tests =
              WitnessStake
              (ScriptContext (Proposal.cosignProposal [signer2]) (Spending Proposal.stakeRef))
          ]
-      , testGroup
+      , group
          "voting"
          [ validatorSucceedsWith
              "proposal"
--- a/agora-spec/Spec/Specification.hs
+++ b/agora-spec/Spec/Specification.hs
@ -0,0 +1,255 @@
+{- |
+Module     : Spec.Specification
+Maintainer : seungheon.ooh@gmail.com
+Description: Helpers to build Specification for testing and bench-marking
+
+Constructors for building a specification for Plutarch scripts:
+
+  - 'policySucceedsWith': checks that a minting policy succeeds.
+
+  - 'policyFailsWith': checks that a minting policy fails.
+
+  - 'validatorSucceedsWith': checks that validator succeeds.
+
+  - 'validatorFailsWith': checks that validator fails.
+
+  - 'effectSucceedsWith': checks that effect succeeds.
+
+  - 'effectFailsWith': checks that effect fails.
+
+  - 'scriptSucceeds': checks that an arbitrary script does not
+    `perror`.
+
+  - 'scriptFails': checks that an arbitrary script `perror`s out.
+-}
+module Spec.Specification (
+  -- * Structures
+  Specification (..),
+  SpecificationExpectation (..),
+  SpecificationTree (..),
+
+  -- * Spec helpers
+  group,
+  getSpecification,
+  getSpecificationTree,
+
+  -- * Spec builders
+  scriptSucceeds,
+  scriptFails,
+  policySucceedsWith,
+  policyFailsWith,
+  validatorSucceedsWith,
+  validatorFailsWith,
+  effectSucceedsWith,
+  effectFailsWith,
+
+  -- * Converters
+  toTestTree,
+) where
+
+import Plutarch.Api.V1 (PMintingPolicy, PValidator)
+import Plutarch.Builtin (pforgetData)
+import Plutarch.Evaluate (evalScript)
+import Plutarch.Lift (PUnsafeLiftDecl (PLifted))
+import Plutus.V1.Ledger.Api (Script, ScriptContext)
+import PlutusTx.IsData qualified as PlutusTx (ToData)
+import Test.Tasty (TestTree, testGroup)
+import Test.Tasty.HUnit (assertFailure, testCase)
+
+{- | Expectations upon execution of script
+ @Success@ indicates a successful execution.
+ @Failure@ inidcates a faulty execution.
+ @FailureWith@ indicates a faulty execution but with expected reason for failure.
+-}
+data SpecificationExpectation
+  = Success
+  | Failure
+  | FailureWith String
+  deriving stock (Show)
+
+{- | Unit of specification. @Specification@ holds name, expectation, and
+  script to be tested or executed later on.
+-}
+data Specification = Specification
+  { sName :: String
+  , sExpectation :: SpecificationExpectation
+  , sScript :: Script
+  }
+  deriving stock (Show)
+
+-- | Tree-structure to group alike specifications--modeled after @TestTree@ from tasty.
+data SpecificationTree
+  = Terminal Specification
+  | Group String [SpecificationTree]
+  deriving stock (Show)
+
+{- | Checks if given name exists in @SpecificationTree@ as either
+ group name or specification name.
+-}
+exists :: String -> SpecificationTree -> Bool
+exists s (Terminal (Specification name _ _)) = s == name
+exists s (Group name st) = or (exists s <$> st) || s == name
+
+-- | Groups alike @SpecificationTree@s into a bigger tree.
+group :: String -> [SpecificationTree] -> SpecificationTree
+group name st
+  | or $ exists name <$> st = error $ "Name already exists: " <> name
+  | otherwise = Group name st
+
+-- | Query specific @Specification@ from a tree.
+getSpecification :: String -> SpecificationTree -> [Specification]
+getSpecification name (Terminal spec@(Specification sn _ _))
+  | name == sn = [spec]
+  | otherwise = []
+getSpecification name (Group _ st) = mconcat $ getSpecification name <$> st
+
+-- | Query specific @SpecificationTree@ from a tree.
+getSpecificationTree :: String -> SpecificationTree -> [SpecificationTree]
+getSpecificationTree name specTree@(Group gn st)
+  | gn == name = [specTree]
+  | otherwise = mconcat $ getSpecificationTree name <$> st
+getSpecificationTree _ _ = []
+
+-- | Convert @SpecificationTree@ into @TestTree@ to be used as a unit test.
+toTestTree :: SpecificationTree -> TestTree
+toTestTree (Group name st) = testGroup name $ toTestTree <$> st
+toTestTree (Terminal (Specification name expectation script)) =
+  testCase name $ do
+    case expectation of
+      Success -> onSuccess
+      Failure -> onFailure
+      FailureWith s -> onFailureWith s
+  where
+    (res, _budget, traces) = evalScript script
+    ts = " Traces: " <> show traces
+    onSuccess = case res of
+      Left e ->
+        assertFailure $
+          show e <> ts
+      _ -> pure ()
+    onFailure = case res of
+      Right v ->
+        assertFailure $
+          "Expected failure, but succeeded. "
+            <> show v
+            <> ts
+      _ -> pure ()
+    onFailureWith _s = case res of -- TODO: check Trace for this
+      Right v ->
+        assertFailure $
+          "Expected failure, but succeeded. "
+            <> show v
+            <> ts
+      _ -> pure ()
+
+-- | Check that an arbitrary script doesn't error when evaluated, given a name.
+scriptSucceeds :: String -> Script -> SpecificationTree
+scriptSucceeds name script = Terminal $ Specification name Success script
+
+-- | Check that an arbitrary script **does** error when evaluated, given a name.
+scriptFails :: String -> Script -> SpecificationTree
+scriptFails name script = Terminal $ Specification name Failure script
+
+-- | Check that a policy script succeeds, given a name and arguments.
+policySucceedsWith ::
+  ( PLift redeemer
+  , PlutusTx.ToData (PLifted redeemer)
+  ) =>
+  String ->
+  ClosedTerm PMintingPolicy ->
+  PLifted redeemer ->
+  ScriptContext ->
+  SpecificationTree
+policySucceedsWith tag policy redeemer scriptContext =
+  scriptSucceeds tag $
+    compile
+      ( policy
+          # pforgetData (pconstantData redeemer)
+          # pconstant scriptContext
+      )
+
+-- | Check that a policy script fails, given a name and arguments.
+policyFailsWith ::
+  ( PLift redeemer
+  , PlutusTx.ToData (PLifted redeemer)
+  ) =>
+  String ->
+  ClosedTerm PMintingPolicy ->
+  PLifted redeemer ->
+  ScriptContext ->
+  SpecificationTree
+policyFailsWith tag policy redeemer scriptContext =
+  scriptFails tag $
+    compile
+      ( policy
+          # pforgetData (pconstantData redeemer)
+          # pconstant scriptContext
+      )
+
+-- | Check that a validator script succeeds, given a name and arguments.
+validatorSucceedsWith ::
+  ( PLift datum
+  , PlutusTx.ToData (PLifted datum)
+  , PLift redeemer
+  , PlutusTx.ToData (PLifted redeemer)
+  ) =>
+  String ->
+  ClosedTerm PValidator ->
+  PLifted datum ->
+  PLifted redeemer ->
+  ScriptContext ->
+  SpecificationTree
+validatorSucceedsWith tag validator datum redeemer scriptContext =
+  scriptSucceeds tag $
+    compile
+      ( validator
+          # pforgetData (pconstantData datum)
+          # pforgetData (pconstantData redeemer)
+          # pconstant scriptContext
+      )
+
+-- | Check that a validator script fails, given a name and arguments.
+validatorFailsWith ::
+  ( PLift datum
+  , PlutusTx.ToData (PLifted datum)
+  , PLift redeemer
+  , PlutusTx.ToData (PLifted redeemer)
+  ) =>
+  String ->
+  ClosedTerm PValidator ->
+  PLifted datum ->
+  PLifted redeemer ->
+  ScriptContext ->
+  SpecificationTree
+validatorFailsWith tag validator datum redeemer scriptContext =
+  scriptFails tag $
+    compile
+      ( validator
+          # pforgetData (pconstantData datum)
+          # pforgetData (pconstantData redeemer)
+          # pconstant scriptContext
+      )
+
+-- | Check that an effect succeeds, given a name and argument.
+effectSucceedsWith ::
+  ( PLift datum
+  , PlutusTx.ToData (PLifted datum)
+  ) =>
+  String ->
+  ClosedTerm PValidator ->
+  PLifted datum ->
+  ScriptContext ->
+  SpecificationTree
+effectSucceedsWith tag eff datum = validatorSucceedsWith tag eff datum ()
+
+-- | Check that an effect fails, given a name and argument.
+effectFailsWith ::
+  ( PLift datum
+  , PlutusTx.ToData (PLifted datum)
+  ) =>
+  String ->
+  ClosedTerm PValidator ->
+  PLifted datum ->
+  ScriptContext ->
+  SpecificationTree
+effectFailsWith tag eff datum = validatorFailsWith tag eff datum ()
--- a/agora-spec/Spec/Stake.hs
+++ b/agora-spec/Spec/Stake.hs
@ -7,7 +7,7 @@ Description: Tests for Stake policy and validator

 Tests for Stake policy and validator
 -}
-module Spec.Stake (tests) where
+module Spec.Stake (specs) where

 --------------------------------------------------------------------------------

@ -15,10 +15,6 @@ import Prelude

 --------------------------------------------------------------------------------

-import Test.Tasty (TestTree, testGroup)
-
--------------------------------------------------------------------------------
-
 import Agora.Stake (Stake (..), StakeDatum (StakeDatum), StakeRedeemer (DepositWithdraw))
 import Agora.Stake.Scripts (stakePolicy, stakeValidator)

@ -26,14 +22,21 @@ import Agora.Stake.Scripts (stakePolicy, stakeValidator)

 import Sample.Stake (DepositWithdrawExample (DepositWithdrawExample, delta, startAmount), signer)
 import Sample.Stake qualified as Stake
-import Test.Util (policyFailsWith, policySucceedsWith, toDatum, validatorFailsWith, validatorSucceedsWith)
+import Spec.Specification (
+  SpecificationTree,
+  group,
+  policyFailsWith,
+  policySucceedsWith,
+  validatorFailsWith,
+  validatorSucceedsWith,
+ )
+import Test.Util (toDatum)

 --------------------------------------------------------------------------------

-- | Stake tests.
-tests :: [TestTree]
-tests =
-  [ testGroup
+specs :: [SpecificationTree]
+specs =
+  [ group
      "policy"
      [ policySucceedsWith
          "stakeCreation"
@ -51,7 +54,7 @@ tests =
          ()
          Stake.stakeCreationUnsigned
      ]
-  , testGroup
+  , group
      "validator"
      [ validatorSucceedsWith
          "stakeDepositWithdraw deposit"
--- a/agora-spec/Spec/Treasury.hs
+++ b/agora-spec/Spec/Treasury.hs
@ -5,7 +5,7 @@ Module: Spec.Treasury
 Description: Tests for Agora treasury.
 Maintainer: jack@mlabs.city

-This module exports `tests`, a list of `TestTree`s, which ensure
+This module exports `specs`, a list of `TestTree`s, which ensure
 that Agora's treasury component works as desired.

 Tests need to fail when:
@ -19,7 +19,7 @@ Tests need to fail when:
      ii. A script has a GAT, the token name for which does /not/
          match the script's validator hash.
 -}
-module Spec.Treasury (tests) where
+module Spec.Treasury (specs) where

 import Agora.Treasury (
  TreasuryRedeemer (SpendTreasuryGAT),
@ -48,14 +48,18 @@ import Sample.Treasury (
  validCtx,
  walletIn,
 )
-import Test.Tasty (TestTree, testGroup)
-import Test.Util (validatorFailsWith, validatorSucceedsWith)
+import Spec.Specification (
+  SpecificationTree,
+  group,
+  validatorFailsWith,
+  validatorSucceedsWith,
+ )

-tests :: [TestTree]
-tests =
-  [ testGroup
+specs :: [SpecificationTree]
+specs =
+  [ group
      "Validator"
-      [ testGroup
+      [ group
          "Positive"
          [ validatorSucceedsWith
              "Allows for effect changes"
@ -64,9 +68,9 @@ tests =
              SpendTreasuryGAT
              validCtx
          ]
-      , testGroup
+      , group
          "Negative"
-          [ testGroup
+          [ group
              "Fails with ScriptPurpose not Minting"
              [ validatorFailsWith
                  "Spending"
--- a/agora-spec/Spec/Utils.hs
+++ b/agora-spec/Spec/Utils.hs
--- a/agora-test/README.org
+++ b/agora-test/README.org
@ -1,11 +0,0 @@
-#+Title: Agora Test
-This folder is the test suite for Agora governance system.
-
- =/Spec= contains different tests for different elements of Agora.
- =/Spec/Model= contain =apropos-tx= model for logical suite
-  generation and tests.
- =/Spec/Sample= contains primitive hand-made example values.
- =Util.hs= contains helper functions
-
-Currently, planning to introduce =plutarch-test= for unit tests,
-benchmarks, and golden tests.
--- a/agora-test/Spec.hs
+++ b/agora-test/Spec.hs
@ -2,6 +2,7 @@ import Prelude

 --------------------------------------------------------------------------------

+import GHC.IO.Encoding (setLocaleEncoding, utf8)
 import Test.Tasty (defaultMain, testGroup)

 --------------------------------------------------------------------------------
@ -16,39 +17,26 @@ import Spec.Stake qualified as Stake
 import Spec.Treasury qualified as Treasury
 import Spec.Utils qualified as Utils

+import Spec.Specification (group, toTestTree)
+
 -- | The Agora test suite.
 main :: IO ()
-main =
+main = do
+  setLocaleEncoding utf8
  defaultMain $
    testGroup
      "test suite"
      [ testGroup
          "Effects"
-          [ testGroup
-              "Treasury Withdrawal Effect"
-              TreasuryWithdrawal.tests
-          , testGroup
-              "Governor Mutation Effect"
-              GovernorMutation.tests
+          [ toTestTree $ group "Treasury Withdrawal Effect" TreasuryWithdrawal.specs
+          , toTestTree $ group "Governor Mutation Effect" GovernorMutation.specs
          ]
-      , testGroup
-          "Stake tests"
-          Stake.tests
-      , testGroup
-          "Proposal tests"
-          Proposal.tests
-      , testGroup
-          "AuthorityToken tests"
-          AuthorityToken.tests
-      , testGroup
-          "Treasury tests"
-          Treasury.tests
-      , testGroup
-          "AuthorityToken tests"
-          AuthorityToken.tests
-      , testGroup
-          "Governor tests"
-          Governor.tests
+      , toTestTree $ group "Stake tests" Stake.specs
+      , toTestTree $ group "Proposal tests" Proposal.specs
+      , toTestTree $ group "AuthorityToken tests" AuthorityToken.specs
+      , toTestTree $ group "Treasury tests" Treasury.specs
+      , toTestTree $ group "AuthorityToken tests" AuthorityToken.specs
+      , toTestTree $ group "Governor tests" Governor.specs
      , testGroup
          "Utility tests"
          Utils.tests
--- a/agora-testlib/Test/Util.hs
+++ b/agora-testlib/Test/Util.hs
@ -2,37 +2,8 @@
 Module     : Test.Util
 Maintainer : emi@haskell.fyi
 Description: Utility functions for testing Plutarch scripts with ScriptContext
-
-Utility functions for testing Plutarch scripts with ScriptContext:
-
-  - 'policySucceedsWith': checks that a minting policy succeeds.
-
-  - 'policyFailsWith': checks that a minting policy fails.
-
-  - 'validatorSucceedsWith': checks that validator succeeds.
-
-  - 'validatorFailsWith': checks that validator fails.
-
-  - 'effectSucceedsWith': checks that effect succeeds.
-
-  - 'effectFailsWith': checks that effect fails.
-
-  - 'scriptSucceeds': checks that an arbitrary script does not
-    `perror`.
-
-  - 'scriptFails': checks that an arbitrary script `perror`s out.
 -}
 module Test.Util (
-  -- * Testing utils
-  scriptSucceeds,
-  scriptFails,
-  policySucceedsWith,
-  policyFailsWith,
-  validatorSucceedsWith,
-  validatorFailsWith,
-  effectSucceedsWith,
-  effectFailsWith,
-
  -- * Plutus-land utils
  datumHash,
  toDatum,
@ -53,19 +24,9 @@ import Data.ByteString.Lazy qualified as ByteString.Lazy

 --------------------------------------------------------------------------------

-import Test.Tasty (TestTree)
-import Test.Tasty.HUnit (assertFailure, testCase)
-
--------------------------------------------------------------------------------
-
-import Plutarch.Api.V1 (PMintingPolicy, PValidator)
-import Plutarch.Builtin (pforgetData)
 import Plutarch.Crypto (pblake2b_256)
-import Plutarch.Evaluate (evalScript)
-import Plutarch.Lift (PUnsafeLiftDecl (PLifted))
-import Plutus.V1.Ledger.Contexts (ScriptContext)
 import Plutus.V1.Ledger.Interval as PlutusTx
-import Plutus.V1.Ledger.Scripts (Datum (Datum), DatumHash (DatumHash), Script)
+import Plutus.V1.Ledger.Scripts (Datum (Datum), DatumHash (DatumHash))
 import PlutusTx.AssocMap qualified as AssocMap
 import PlutusTx.Builtins qualified as PlutusTx
 import PlutusTx.IsData qualified as PlutusTx
@ -73,140 +34,6 @@ import PlutusTx.Ord qualified as PlutusTx

 --------------------------------------------------------------------------------

-- | Check that a policy script succeeds, given a name and arguments.
-policySucceedsWith ::
-  ( PLift redeemer
-  , PlutusTx.ToData (PLifted redeemer)
-  ) =>
-  String ->
-  ClosedTerm PMintingPolicy ->
-  PLifted redeemer ->
-  ScriptContext ->
-  TestTree
-policySucceedsWith tag policy redeemer scriptContext =
-  scriptSucceeds tag $
-    compile
-      ( policy
-          # pforgetData (pconstantData redeemer)
-          # pconstant scriptContext
-      )
-
-- | Check that a policy script fails, given a name and arguments.
-policyFailsWith ::
-  ( PLift redeemer
-  , PlutusTx.ToData (PLifted redeemer)
-  ) =>
-  String ->
-  ClosedTerm PMintingPolicy ->
-  PLifted redeemer ->
-  ScriptContext ->
-  TestTree
-policyFailsWith tag policy redeemer scriptContext =
-  scriptFails tag $
-    compile
-      ( policy
-          # pforgetData (pconstantData redeemer)
-          # pconstant scriptContext
-      )
-
-- | Check that a validator script succeeds, given a name and arguments.
-validatorSucceedsWith ::
-  ( PLift datum
-  , PlutusTx.ToData (PLifted datum)
-  , PLift redeemer
-  , PlutusTx.ToData (PLifted redeemer)
-  ) =>
-  String ->
-  ClosedTerm PValidator ->
-  PLifted datum ->
-  PLifted redeemer ->
-  ScriptContext ->
-  TestTree
-validatorSucceedsWith tag validator datum redeemer scriptContext =
-  scriptSucceeds tag $
-    compile
-      ( validator
-          # pforgetData (pconstantData datum)
-          # pforgetData (pconstantData redeemer)
-          # pconstant scriptContext
-      )
-
-- | Check that a validator script fails, given a name and arguments.
-validatorFailsWith ::
-  ( PLift datum
-  , PlutusTx.ToData (PLifted datum)
-  , PLift redeemer
-  , PlutusTx.ToData (PLifted redeemer)
-  ) =>
-  String ->
-  ClosedTerm PValidator ->
-  PLifted datum ->
-  PLifted redeemer ->
-  ScriptContext ->
-  TestTree
-validatorFailsWith tag validator datum redeemer scriptContext =
-  scriptFails tag $
-    compile
-      ( validator
-          # pforgetData (pconstantData datum)
-          # pforgetData (pconstantData redeemer)
-          # pconstant scriptContext
-      )
-
-{- | Check that a validator script succeeds, given a name and arguments.
-     TODO: Change docstring.
-}
-effectSucceedsWith ::
-  ( PLift datum
-  , PlutusTx.ToData (PLifted datum)
-  ) =>
-  String ->
-  ClosedTerm PValidator ->
-  PLifted datum ->
-  ScriptContext ->
-  TestTree
-effectSucceedsWith tag eff datum = validatorSucceedsWith tag eff datum ()
-
-- TODO: Change docstring.
-
-{- | Check that a validator script fails, given a name and arguments.
-     TODO: Change docstring.
-}
-effectFailsWith ::
-  ( PLift datum
-  , PlutusTx.ToData (PLifted datum)
-  ) =>
-  String ->
-  ClosedTerm PValidator ->
-  PLifted datum ->
-  ScriptContext ->
-  TestTree
-effectFailsWith tag eff datum = validatorFailsWith tag eff datum ()
-
-- | Check that an arbitrary script doesn't error when evaluated, given a name.
-scriptSucceeds :: String -> Script -> TestTree
-scriptSucceeds name script = testCase name $ do
-  let (res, _budget, traces) = evalScript script
-  case res of
-    Left e -> do
-      assertFailure $
-        show e <> " Traces: " <> show traces
-    Right _v ->
-      pure ()
-
-- | Check that an arbitrary script **does** error when evaluated, given a name.
-scriptFails :: String -> Script -> TestTree
-scriptFails name script = testCase name $ do
-  let (res, _budget, traces) = evalScript script
-  case res of
-    Left _e ->
-      pure ()
-    Right v ->
-      assertFailure $
-        "Expected failure, but succeeded. " <> show v <> " Traces: " <> show traces
-
--------------------------------------------------------------------------------
-
 {- | Create a pair from data for use in 'txInfoData'.

   Example:
--- a/agora.cabal
+++ b/agora.cabal
@ -179,26 +179,35 @@ library agora-sample
  hs-source-dirs:  agora-sample
  build-depends:   agora-testlib

-test-suite agora-test
-  import:         lang, deps, test-deps
-  type:           exitcode-stdio-1.0
-  main-is:        Spec.hs
-  hs-source-dirs: agora-test
-  other-modules:
+library agora-spec
+  import:          lang, deps, test-deps
+  exposed-modules:
    Spec.AuthorityToken
    Spec.Effect.GovernorMutation
    Spec.Effect.TreasuryWithdrawal
    Spec.Governor
    Spec.Model.MultiSig
    Spec.Proposal
+    Spec.Specification
    Spec.Stake
    Spec.Treasury
    Spec.Utils

+  hs-source-dirs:  agora-spec
  build-depends:
    , agora-sample
    , agora-testlib

+test-suite agora-test
+  import:         lang, deps, test-deps
+  type:           exitcode-stdio-1.0
+  main-is:        Spec.hs
+  hs-source-dirs: agora-test
+  build-depends:
+    , agora-sample
+    , agora-spec
+    , agora-testlib
+
 benchmark agora-bench
  import:         lang, deps
  hs-source-dirs: agora-bench
@ -208,6 +217,8 @@ benchmark agora-bench
  build-depends:
    , agora
    , agora-sample
+    , agora-spec
+    , cassava

 executable agora-scripts
  import:         lang, deps, exe-opts
--- a/bench.csv
+++ b/bench.csv
@ -1,4 +1,23 @@
 name,cpu,mem,size
-full_scripts:authorityTokenPolicy,1756707,6000,841
-full_scripts:stakePolicy,3751498,12700,1610
-full_scripts:stakeValidator,3126265,10600,1500
+Agora/Effects/Treasury Withdrawal Effect/effect/Simple,340268715,724428,3050
+Agora/Effects/Treasury Withdrawal Effect/effect/Simple with multiple treasuries ,570029812,1211300,3377
+Agora/Effects/Treasury Withdrawal Effect/effect/Mixed Assets,502351827,1071087,3242
+Agora/Effects/Governor Mutation Effect/validator/valid new governor datum/governor validator should pass,103651824,228328,7681
+Agora/Effects/Governor Mutation Effect/validator/valid new governor datum/effect validator should pass,126986096,263635,3357
+Agora/Stake/policy/stakeCreation,60250773,128585,2144
+Agora/Stake/validator/stakeDepositWithdraw deposit,275919558,599033,4063
+Agora/Stake/validator/stakeDepositWithdraw withdraw,275919558,599033,4055
+Agora/Proposal/policy/proposalCreation,34571405,70066,1585
+Agora/Proposal/validator/cosignature/proposal,240007066,509127,4892
+Agora/Proposal/validator/cosignature/stake,185913543,402497,4600
+Agora/Proposal/validator/voting/proposal,238383906,489848,4900
+Agora/Proposal/validator/voting/stake,153804848,328239,4653
+Agora/AuthorityToken/singleAuthorityTokenBurned/Correct simple,25177457,55883,806
+Agora/AuthorityToken/singleAuthorityTokenBurned/Correct many inputs,40266637,88241,900
+Agora/Treasury/Validator/Positive/Allows for effect changes,37343572,79744,1841
+Agora/AuthorityToken/singleAuthorityTokenBurned/Correct simple,25177457,55883,806
+Agora/AuthorityToken/singleAuthorityTokenBurned/Correct many inputs,40266637,88241,900
+Agora/Governor/policy/GST minting,57648280,119961,1851
+Agora/Governor/validator/proposal creation,329287002,679689,8196
+Agora/Governor/validator/GATs minting,430385143,929607,8319
+Agora/Governor/validator/mutate governor state,100840784,222602,7738