Skip to content

Commit 2f9932b

Browse files
committed
feat: implement comprehensive Value benchmarking framework
Creates Values.hs benchmark module with systematic test generation for lookupCoin, valueContains, valueData, and unValueData operations. Includes value generation utilities, individual benchmark functions, and edge case testing with empty values. Enables data collection for accurate cost model parameter fitting.
1 parent 6f8f633 commit 2f9932b

File tree

2 files changed

+401
-0
lines changed

2 files changed

+401
-0
lines changed
Lines changed: 399 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,399 @@
1+
{-# LANGUAGE BlockArguments #-}
2+
{-# LANGUAGE ImportQualifiedPost #-}
3+
{-# LANGUAGE NumericUnderscores #-}
4+
5+
module Benchmarks.Values (makeBenchmarks) where
6+
7+
import Prelude
8+
9+
import Common
10+
import Control.Monad (replicateM)
11+
import Control.Monad.State.Strict (State)
12+
import Criterion.Main (Benchmark)
13+
import Data.ByteString (ByteString)
14+
import Data.ByteString qualified as BS
15+
import PlutusCore (DefaultFun (LookupCoin, UnValueData, ValueContains, ValueData))
16+
import PlutusCore.Evaluation.Machine.ExMemoryUsage (ValueOuterOrMaxInner (..), ValueTotalSize (..))
17+
import PlutusCore.Value (Value)
18+
import PlutusCore.Value qualified as Value
19+
import System.Random.Stateful (StatefulGen, StdGen, runStateGen_, uniformByteStringM, uniformRM)
20+
21+
----------------------------------------------------------------------------------------------------
22+
-- Benchmarks --------------------------------------------------------------------------------------
23+
24+
makeBenchmarks :: StdGen -> [Benchmark]
25+
makeBenchmarks gen =
26+
[ lookupCoinBenchmark gen
27+
, valueContainsBenchmark gen
28+
, valueDataBenchmark gen
29+
, unValueDataBenchmark gen
30+
]
31+
32+
----------------------------------------------------------------------------------------------------
33+
-- LookupCoin --------------------------------------------------------------------------------------
34+
35+
lookupCoinBenchmark :: StdGen -> Benchmark
36+
lookupCoinBenchmark gen =
37+
createThreeTermBuiltinBenchElementwiseWithWrappers
38+
(id, id, ValueOuterOrMaxInner) -- Wrap Value argument to report outer/max inner size
39+
LookupCoin -- the builtin fun
40+
[] -- no type arguments needed (monomorphic builtin)
41+
(lookupCoinArgs gen) -- the argument combos to generate benchmarks for
42+
43+
lookupCoinArgs :: StdGen -> [(ByteString, ByteString, Value)]
44+
lookupCoinArgs gen = runStateGen_ gen $ \(g :: g) -> do
45+
let
46+
-- Use common test values and add search keys
47+
testValues = generateTestValues gen
48+
49+
-- Also include additional random tests specific to lookupCoin
50+
additionalTests = runStateGen_ gen $ \g' -> do
51+
let keySizes = [0, 1, 30, 100, 1_000, 10_000, 20_000]
52+
sequence $
53+
concat
54+
[ -- Key size impact tests with large keys
55+
[ generateLookupTest g' policySize tokenSize 100 10
56+
| policySize <- keySizes
57+
, tokenSize <- [0, 30, 1_000, 20_000]
58+
]
59+
, -- Budget-constrained tests (at 30KB limit)
60+
[ generateBudgetTest g' policySize tokenSize 30_000
61+
| (policySize, tokenSize) <-
62+
[ (20_000, 1) -- Huge policy, tiny token
63+
, (1, 20_000) -- Tiny policy, huge token
64+
, (10_000, 10_000) -- Both large
65+
, (1, 1) -- Both tiny (max entries)
66+
, (0, 0) -- Empty keys (pathological)
67+
]
68+
]
69+
, -- Additional random tests for parameter spread
70+
replicate 50 (generateRandomLookupTest g')
71+
]
72+
73+
-- Add search keys to common test values
74+
75+
-- Add search keys to a value for lookup testing
76+
-- Generates random keys that may or may not exist in the value
77+
addSearchKeysToValue :: Value -> State StdGen (ByteString, ByteString, Value)
78+
addSearchKeysToValue value = do
79+
-- Generate search keys with varying sizes (mostly 30 bytes for consistency)
80+
let keySize = 30 -- Standard key size used in most tests
81+
searchPolicyId <- generatePolicyId keySize g
82+
searchTokenName <- generateTokenName keySize g
83+
pure (searchPolicyId, searchTokenName, value)
84+
85+
commonWithKeys <- sequence [addSearchKeysToValue value | value <- testValues]
86+
87+
pure $ commonWithKeys ++ additionalTests
88+
89+
-- | Generate lookup test with specified parameters
90+
generateLookupTest
91+
:: (StatefulGen g m)
92+
=> g
93+
-> Int -- Policy ID byte size
94+
-> Int -- Token name byte size
95+
-> Int -- Number of policies
96+
-> Int -- Tokens per policy
97+
-> m (ByteString, ByteString, Value)
98+
generateLookupTest
99+
g
100+
policyIdBytes
101+
tokenNameBytes
102+
numPolicies
103+
tokensPerPolicy = do
104+
value <-
105+
generateConstrainedValue
106+
numPolicies
107+
tokensPerPolicy
108+
policyIdBytes
109+
tokenNameBytes
110+
g
111+
-- Generate lookup keys (may or may not exist in value)
112+
searchPolicyId <- generatePolicyId policyIdBytes g
113+
searchTokenName <- generateTokenName tokenNameBytes g
114+
pure (searchPolicyId, searchTokenName, value)
115+
116+
-- | Generate budget-constrained test
117+
generateBudgetTest
118+
:: (StatefulGen g m)
119+
=> g
120+
-> Int -- Policy ID byte size
121+
-> Int -- Token name byte size
122+
-> Int -- Total budget
123+
-> m (ByteString, ByteString, Value)
124+
generateBudgetTest g policyIdBytes tokenNameBytes budget = do
125+
value <- generateValueWithBudget policyIdBytes tokenNameBytes budget g
126+
searchPolicyId <- generatePolicyId policyIdBytes g
127+
searchTokenName <- generateTokenName tokenNameBytes g
128+
pure (searchPolicyId, searchTokenName, value)
129+
130+
-- | Generate random lookup test with varied parameters for better spread
131+
generateRandomLookupTest :: (StatefulGen g m) => g -> m (ByteString, ByteString, Value)
132+
generateRandomLookupTest g = do
133+
policyIdBytes <- uniformRM (0, 20_000) g -- 0-20KB policy ID
134+
tokenNameBytes <- uniformRM (0, 20_000) g -- 0-20KB token name
135+
numPolicies <- uniformRM (1, 2_000) g -- 1-2000 policies
136+
tokensPerPolicy <- uniformRM (1, 1_000) g -- 1-1000 tokens per policy
137+
138+
-- Generate value with random parameters
139+
value <- generateConstrainedValue numPolicies tokensPerPolicy policyIdBytes tokenNameBytes g
140+
141+
-- Generate search keys
142+
searchPolicyId <- uniformByteStringM policyIdBytes g
143+
searchTokenName <- uniformByteStringM tokenNameBytes g
144+
145+
pure (searchPolicyId, searchTokenName, value)
146+
147+
----------------------------------------------------------------------------------------------------
148+
-- ValueContains -----------------------------------------------------------------------------------
149+
150+
valueContainsBenchmark :: StdGen -> Benchmark
151+
valueContainsBenchmark gen =
152+
createTwoTermBuiltinBenchElementwiseWithWrappers
153+
(ValueOuterOrMaxInner, ValueTotalSize)
154+
-- Container: outer/maxInner, Contained: totalSize
155+
ValueContains -- the builtin fun
156+
[] -- no type arguments needed (monomorphic builtin)
157+
(valueContainsArgs gen) -- the argument combos to generate benchmarks for
158+
159+
valueContainsArgs :: StdGen -> [(Value, Value)]
160+
valueContainsArgs gen = runStateGen_ gen \g -> do
161+
let
162+
baseKeySizes = [0, 30, 1_000, 10_000]
163+
baseValueSizes = [1, 10, 100, 1_000]
164+
165+
sequence $
166+
concat
167+
[ -- Standard key tests with varying value sizes (original Size-based tests)
168+
[ generateContainsTest g containerSize containedSize 30
169+
| containerSize <- baseValueSizes
170+
, containedSize <- baseValueSizes
171+
, containedSize <= containerSize
172+
]
173+
, -- Key size impact tests
174+
[ generateContainsTest g 100 10 keySize
175+
| keySize <- baseKeySizes
176+
]
177+
, -- Budget-constrained tests
178+
[ generateContainsBudgetTest g 30_000 keySize
179+
| keySize <- [0, 30, 3_000, 20_000]
180+
]
181+
, -- Edge cases
182+
[ generateEmptyContainedTest g containerSize 30
183+
| containerSize <- [0, 10, 100, 1_000]
184+
]
185+
, -- Random tests for parameter spread (100 combinations)
186+
replicate 100 (generateRandomContainsTest g)
187+
]
188+
189+
-- | Generate valueContains test with specified parameters
190+
generateContainsTest
191+
:: (StatefulGen g m)
192+
=> g
193+
-> Int -- Container value size
194+
-> Int -- Contained value size
195+
-> Int -- Key byte size (for both policy and token)
196+
-> m (Value, Value)
197+
generateContainsTest g containerSize containedSize keySize = do
198+
-- Generate container value
199+
container <- generateConstrainedValue containerSize 10 keySize keySize g
200+
201+
-- Generate contained as subset of container (for true contains relationship)
202+
let containerList = Value.toList container
203+
containedEntries = take containedSize containerList
204+
205+
let contained =
206+
Value.fromList $
207+
[ (policyId, take (containedSize `div` max 1 (length containerList)) tokens)
208+
| (policyId, tokens) <- containedEntries
209+
]
210+
211+
pure (container, contained)
212+
213+
-- | Generate budget-constrained contains test
214+
generateContainsBudgetTest
215+
:: (StatefulGen g m)
216+
=> g
217+
-> Int -- Total budget
218+
-> Int -- Key size
219+
-> m (Value, Value)
220+
generateContainsBudgetTest g budget keySize = do
221+
container <- generateValueWithBudget keySize keySize budget g
222+
-- Generate smaller contained value (subset)
223+
let containerList = Value.toList container
224+
containedEntries = take (length containerList `div` 2) containerList
225+
pure (container, Value.fromList containedEntries)
226+
227+
-- | Generate test with empty contained value
228+
generateEmptyContainedTest
229+
:: (StatefulGen g m)
230+
=> g
231+
-> Int -- Container size
232+
-> Int -- Key size
233+
-> m (Value, Value)
234+
generateEmptyContainedTest g containerSize keySize = do
235+
container <- generateConstrainedValue containerSize 10 keySize keySize g
236+
pure (container, Value.empty)
237+
238+
-- | Generate random valueContains test with varied parameters for better spread
239+
generateRandomContainsTest :: (StatefulGen g m) => g -> m (Value, Value)
240+
generateRandomContainsTest g = do
241+
-- Generate random parameters with good spread
242+
containerEntries <- uniformRM (1, 5_000) g -- 1-5000 container entries
243+
containedEntries <- uniformRM (1, containerEntries) g -- 1-container count
244+
keyBytes <- uniformRM (1, 5_000) g -- 1-5000 byte keys
245+
246+
-- Generate container value with exact entry count
247+
container <- generateRandomValueForContains containerEntries keyBytes g
248+
249+
-- Generate contained as subset of container entries
250+
let containerList = Value.toList container
251+
containedList = take containedEntries containerList
252+
contained = Value.fromList containedList
253+
254+
pure (container, contained)
255+
256+
-- | Generate Value for contains tests with exact entry count
257+
generateRandomValueForContains
258+
:: (StatefulGen g m)
259+
=> Int -- Entry count
260+
-> Int -- Key byte size
261+
-> g
262+
-> m Value
263+
generateRandomValueForContains entryCount keyBytes g = do
264+
-- Generate policies and tokens with exact entry count
265+
policyIds <- replicateM entryCount (uniformByteStringM keyBytes g)
266+
tokenNames <- replicateM entryCount (uniformByteStringM keyBytes g)
267+
268+
let
269+
-- Create amounts (1 to 1000000)
270+
amounts = [fromIntegral (1 + i `mod` 1_000_000) | i <- [0 .. entryCount - 1]]
271+
272+
pure $
273+
Value.fromList
274+
[ (policy, [(token, amount)])
275+
| (policy, token, amount) <- zip3 policyIds tokenNames amounts
276+
]
277+
278+
----------------------------------------------------------------------------------------------------
279+
-- ValueData ---------------------------------------------------------------------------------------
280+
281+
valueDataBenchmark :: StdGen -> Benchmark
282+
valueDataBenchmark gen = createOneTermBuiltinBench ValueData [] (generateTestValues gen)
283+
284+
----------------------------------------------------------------------------------------------------
285+
-- UnValueData -------------------------------------------------------------------------------------
286+
287+
unValueDataBenchmark :: StdGen -> Benchmark
288+
unValueDataBenchmark gen =
289+
createOneTermBuiltinBench UnValueData [] (Value.valueData <$> generateTestValues gen)
290+
291+
----------------------------------------------------------------------------------------------------
292+
-- Value Generators --------------------------------------------------------------------------------
293+
294+
-- | Generate common test values for benchmarking
295+
generateTestValues :: StdGen -> [Value]
296+
generateTestValues gen = runStateGen_ gen \g -> do
297+
let
298+
baseValueSizes = [1, 10, 50, 100, 500, 1_000]
299+
keySizes = [0, 30, 100, 1_000, 10_000]
300+
301+
sequence $
302+
concat
303+
[ -- Empty value as edge case (first test cbase)
304+
[pure Value.empty]
305+
, -- Standard value sizes with varying key sizes
306+
[ generateConstrainedValue valueSize 10 keySize keySize g
307+
| valueSize <- baseValueSizes
308+
, keySize <- [30, 1_000]
309+
]
310+
, -- Key size impact tests (fixed value structure, varying key sizes)
311+
[ generateConstrainedValue 100 10 keySize keySize g
312+
| keySize <- keySizes
313+
]
314+
, -- Budget-constrained tests
315+
[ generateValueWithBudget keySize keySize budget g
316+
| keySize <- [0, 30, 1_000, 10_000]
317+
, budget <- [1_000, 10_000, 30_000]
318+
]
319+
, -- Random tests for parameter spread (50 combinations)
320+
replicate 50 $ do
321+
numPolicies <- uniformRM (1, 1_000) g
322+
tokensPerPolicy <- uniformRM (1, 500) g
323+
policyIdBytes <- uniformRM (0, 10_000) g
324+
tokenNameBytes <- uniformRM (0, 10_000) g
325+
generateConstrainedValue numPolicies tokensPerPolicy policyIdBytes tokenNameBytes g
326+
]
327+
328+
-- | Generate constrained Value with total size budget
329+
generateConstrainedValue
330+
:: (StatefulGen g m)
331+
=> Int -- Number of policies
332+
-> Int -- Number of tokens per policy
333+
-> Int -- Policy ID byte length
334+
-> Int -- Token name byte length
335+
-> g
336+
-> m Value
337+
generateConstrainedValue numPolicies tokensPerPolicy policyIdBytes tokenNameBytes g = do
338+
policyIds <- -- Generate policy IDs of specified size
339+
replicateM numPolicies (generatePolicyId policyIdBytes g)
340+
341+
tokenNames <- -- Generate token names of specified size
342+
replicateM tokensPerPolicy (generateTokenName tokenNameBytes g)
343+
344+
-- Generate positive quantities (1 to 1000000)
345+
let quantity :: Int -> Int -> Integer
346+
quantity policyIndex tokenIndex =
347+
fromIntegral (1 + (policyIndex * 1_000 + tokenIndex) `mod` 1_000_000)
348+
349+
nestedMap :: [(ByteString, [(ByteString, Integer)])]
350+
nestedMap =
351+
[ ( policyId
352+
, [ (tokenName, quantity policyIndex tokenIndex)
353+
| (tokenIndex, tokenName) <- zip [0 ..] tokenNames
354+
]
355+
)
356+
| (policyIndex, policyId) <- zip [0 ..] policyIds
357+
]
358+
pure $ Value.fromList nestedMap
359+
360+
-- | Generate Value within total size budget
361+
generateValueWithBudget
362+
:: (StatefulGen g m)
363+
=> Int -- Policy ID byte length
364+
-> Int -- Token name byte length
365+
-> Int -- Target total size budget
366+
-> g
367+
-> m Value
368+
generateValueWithBudget policyIdBytes tokenNameBytes budget g = do
369+
let
370+
overhead = 8 -- bytes per amount
371+
372+
-- Calculate maximum possible entries
373+
bytesPerEntry = policyIdBytes + tokenNameBytes + overhead
374+
maxEntries =
375+
if bytesPerEntry > 0
376+
then min (budget `div` bytesPerEntry) budget
377+
else budget -- Handle 0 case
378+
379+
-- Simple distribution: try to balance policies and tokens
380+
numPolicies = max 1 (floor (sqrt (fromIntegral maxEntries :: Double)))
381+
tokensPerPolicy = if numPolicies > 0 then maxEntries `div` numPolicies else 0
382+
383+
generateConstrainedValue numPolicies tokensPerPolicy policyIdBytes tokenNameBytes g
384+
385+
----------------------------------------------------------------------------------------------------
386+
-- Other Generators --------------------------------------------------------------------------------
387+
388+
-- | Generate policy ID of specified size
389+
generatePolicyId :: (StatefulGen g m) => Int -> g -> m ByteString
390+
generatePolicyId = generateByteString
391+
392+
-- | Generate token name of specified size
393+
generateTokenName :: (StatefulGen g m) => Int -> g -> m ByteString
394+
generateTokenName = generateByteString
395+
396+
-- | Generate ByteString of specified size
397+
generateByteString :: (StatefulGen g m) => Int -> g -> m ByteString
398+
generateByteString 0 _ = pure BS.empty
399+
generateByteString l g = uniformByteStringM l g

0 commit comments

Comments
 (0)