diff --git a/agora-bench/Bench.hs b/agora-bench/Bench.hs index 0539f24..f6dc480 100644 --- a/agora-bench/Bench.hs +++ b/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 diff --git a/agora-bench/Main.hs b/agora-bench/Main.hs index 95307ca..c0dcc3f 100644 --- a/agora-bench/Main.hs +++ b/agora-bench/Main.hs @@ -1,42 +1,33 @@ 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 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.Spec (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 - ] - - for_ benchmarks print - -gatCS :: CurrencySymbol -gatCS = "73475cb40a568e8da8a045ced110137e159f890ac4da883b6b17dc651b3a8049" -- arbitrary CS + mapM_ print $ + specificationTreeToBenchmarks $ + group + "Benchmark" + [ 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 + ] diff --git a/agora.cabal b/agora.cabal index 1e1eb81..8b86acb 100644 --- a/agora.cabal +++ b/agora.cabal @@ -217,6 +217,7 @@ benchmark agora-bench build-depends: , agora , agora-sample + , agora-spec executable agora-scripts import: lang, deps, exe-opts