-
Notifications
You must be signed in to change notification settings - Fork 86
/
Main.hs
64 lines (57 loc) · 2.36 KB
/
Main.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wno-type-defaults #-}
import Hydra.Prelude
import Control.Exception (ErrorCall)
import qualified Data.ByteString as BS
import Data.Maybe (fromJust)
import Plutus.MerkleTree (rootHash)
import qualified Plutus.MerkleTree as MT
import Plutus.MerkleTreeValidator (merkleTreeValidator, mtBuilderValidator)
import qualified PlutusTx.Builtins as Plutus
import Test.Plutus.Validator (
ExUnits (ExUnits),
defaultMaxExecutionUnits,
evaluateScriptExecutionUnits,
)
import Test.QuickCheck (generate, vectorOf)
main :: IO ()
main =
forM_ ([1 .. 10] <> [20, 30 .. 100] <> [120, 140 .. 500]) $ \numElems -> do
utxo <- fmap Plutus.toBuiltin <$> genFakeUtxos numElems
let (memberMem, memberCpu) = executionCostForMember utxo
ExUnits (fromIntegral @_ @Double -> maxMem) (fromIntegral @_ @Double -> maxCpu) =
defaultMaxExecutionUnits
(builderMem, builderCpu) = executionCostForBuilder utxo
putText $
show numElems
<> "\t"
<> show (100 * fromIntegral (fromIntegral memberMem `div` numElems) / maxMem)
<> "\t"
<> show (100 * fromIntegral (fromIntegral memberCpu `div` numElems) / maxCpu)
putTextLn
( "\t"
<> show (100 * fromIntegral builderMem / maxMem)
<> "\t"
<> show (100 * fromIntegral builderCpu / maxCpu)
)
`catch` \(_ :: ErrorCall) ->
-- NOTE builder validator is likely to fail and thus raise an exception at low values
-- of numElems, so we put 0 instead
putTextLn "\t0\t0"
where
-- NOTE: assume size of a UTXO is around 60 bytes
genFakeUtxos numElems = generate (vectorOf numElems $ BS.pack <$> vectorOf 60 arbitrary)
executionCostForMember :: [Plutus.BuiltinByteString] -> (Natural, Natural)
executionCostForMember utxo =
let tree = MT.fromList utxo
accumulateCost e (curMem, curCpu) =
let proof = fromJust $ MT.mkProof e tree
ExUnits mem cpu = evaluateScriptExecutionUnits merkleTreeValidator (e, MT.rootHash tree, proof)
in (mem + curMem, cpu + curCpu)
in foldr accumulateCost (0, 0) utxo
executionCostForBuilder :: [Plutus.BuiltinByteString] -> (Natural, Natural)
executionCostForBuilder utxo =
let tree = MT.fromList utxo
root = rootHash tree
ExUnits mem cpu = evaluateScriptExecutionUnits mtBuilderValidator (utxo, root)
in (mem, cpu)