add size benchmarking for scripts to agora-bench
This commit is contained in:
parent
d61595e2f9
commit
bc3c99711f
3 changed files with 72 additions and 8 deletions
33
agora-bench/Bench.hs
Normal file
33
agora-bench/Bench.hs
Normal file
|
|
@ -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
|
||||||
|
|
@ -1,14 +1,42 @@
|
||||||
module Main (main) where
|
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
|
import Prelude
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
|
||||||
|
|
||||||
main :: IO ()
|
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
|
||||||
|
|
|
||||||
|
|
@ -198,8 +198,11 @@ benchmark agora-bench
|
||||||
import: lang, deps
|
import: lang, deps
|
||||||
hs-source-dirs: agora-bench
|
hs-source-dirs: agora-bench
|
||||||
main-is: Main.hs
|
main-is: Main.hs
|
||||||
|
other-modules: Bench
|
||||||
type: exitcode-stdio-1.0
|
type: exitcode-stdio-1.0
|
||||||
build-depends: agora
|
build-depends:
|
||||||
|
, agora
|
||||||
|
, agora-sample
|
||||||
|
|
||||||
executable agora-purescript-bridge
|
executable agora-purescript-bridge
|
||||||
import: lang, deps, exe-opts
|
import: lang, deps, exe-opts
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue