From 1e01c622186d18cbe6c4c57293b92777e5f8bc49 Mon Sep 17 00:00:00 2001 From: Riley-Kilgore Date: Wed, 11 Dec 2024 07:38:28 -0800 Subject: [PATCH 1/2] Moved fuzzer lib into stdlib --- aiken.toml | 9 +- lib/aiken/fuzz.ak | 1564 ++++++++++++++++++++++++++ lib/aiken/fuzz.test.ak | 321 ++++++ lib/aiken/fuzz/scenario.ak | 441 ++++++++ lib/cardano/fuzz/address.ak | 67 ++ lib/cardano/fuzz/address.test.ak | 42 + lib/cardano/fuzz/assets.ak | 107 ++ lib/cardano/fuzz/assets.test.ak | 166 +++ lib/cardano/fuzz/certificate.ak | 127 +++ lib/cardano/fuzz/certificate.test.ak | 57 + lib/cardano/fuzz/script_context.ak | 11 + lib/cardano/fuzz/transaction.ak | 396 +++++++ 12 files changed, 3301 insertions(+), 7 deletions(-) create mode 100644 lib/aiken/fuzz.ak create mode 100644 lib/aiken/fuzz.test.ak create mode 100644 lib/aiken/fuzz/scenario.ak create mode 100644 lib/cardano/fuzz/address.ak create mode 100644 lib/cardano/fuzz/address.test.ak create mode 100644 lib/cardano/fuzz/assets.ak create mode 100644 lib/cardano/fuzz/assets.test.ak create mode 100644 lib/cardano/fuzz/certificate.ak create mode 100644 lib/cardano/fuzz/certificate.test.ak create mode 100644 lib/cardano/fuzz/script_context.ak create mode 100644 lib/cardano/fuzz/transaction.ak diff --git a/aiken.toml b/aiken.toml index e07c958..9f03552 100644 --- a/aiken.toml +++ b/aiken.toml @@ -1,15 +1,10 @@ name = "aiken-lang/stdlib" version = "main" -compiler = "v1.1.4" +compiler = "v1.1.8" plutus = "v3" description = "The Aiken Standard Library" [repository] user = "aiken-lang" project = "stdlib" -platform = "github" - -[[dependencies]] -name = "aiken-lang/fuzz" -version = "v2" -source = "github" +platform = "github" \ No newline at end of file diff --git a/lib/aiken/fuzz.ak b/lib/aiken/fuzz.ak new file mode 100644 index 0000000..600e424 --- /dev/null +++ b/lib/aiken/fuzz.ak @@ -0,0 +1,1564 @@ +use aiken/builtin +use aiken/collection/list +use aiken/math +use aiken/option + +// ## Constructing +// ### Primitives + +/// Generate a random [`Bool`](https://aiken-lang.github.io/prelude/aiken.html#Bool) value from a +/// uniform distribution. +/// +/// ```aiken +/// test prop_bool(is_true via fuzz.bool()) { +/// is_true || !is_true +/// } +/// ``` +pub fn bool() -> Fuzzer { + rand |> map(fn(n) { n % 2 == 0 }) +} + +/// Create a constant [Fuzzer](https://aiken-lang.github.io/prelude/aiken.html#Fuzzer) from an arbitrary value. +pub fn constant(a: a) -> Fuzzer { + fn(s0) { Some((s0, a)) } +} + +/// Generate a byte uniformly across the range `[0; 255]`. +pub fn byte() -> Fuzzer { + rand +} + +/// Generate a random [`ByteArray`](https://aiken-lang.github.io/prelude/aiken.html#ByteArray) of 32 bytes. +pub fn bytearray() -> Fuzzer { + let lsb <- and_then(rand) + let msb <- map(rand) + if lsb + msb == 0 { + #"0000000000000000000000000000000000000000000000000000000000000000" + } else { + "" + |> builtin.cons_bytearray(lsb, _) + |> builtin.cons_bytearray(msb, _) + |> builtin.blake2b_256 + } +} + +/// Generate a random [`ByteArray`](https://aiken-lang.github.io/prelude/aiken.html#ByteArray) of +/// size within a lower and upper bounds. +pub fn bytearray_between(min: Int, max: Int) -> Fuzzer { + if max < min { + bytearray_between(max, min) + } else if max <= 0 { + constant("") + } else { + expect min >= 0 + let size <- and_then(int_between(min, max)) + bytearray_fixed_inner(size) + } +} + +/// Generate a random [`ByteArray`](https://aiken-lang.github.io/prelude/aiken.html#ByteArray) of `len` bytes. +pub fn bytearray_fixed(len: Int) -> Fuzzer { + expect len >= 0 + bytearray_fixed_inner(len) +} + +fn bytearray_fixed_inner(len: Int) -> Fuzzer { + if len > 32 { + let head <- and_then(bytearray()) + let tail <- map(bytearray_fixed(len - 32)) + builtin.append_bytearray(head, tail) + } else if len < 32 { + map(bytearray(), builtin.slice_bytearray(0, len, _)) + } else { + bytearray() + } +} + +const int_bucket_small: Int = 128 + +const int_bucket_zero: Int = 132 + +const int_bucket_negative: Int = 192 + +/// Generate a random integer value. It favors small values near zero, but +/// generate across the range `[-255; 16383]` with the following distribution: +/// +/// ``` +/// 25.0% [-255; 0[ ████████████ +/// 2.5% 0 █ +/// 50.0% ]0; 255] █████████████████████████ +/// 22.5% [256; 16383] ██████████ +/// ``` +/// +/// The distribution is uniform within those buckets. If you need larger values, use [`int_between`](#int_between). +pub fn int() -> Fuzzer { + fn(prng) { + when prng is { + Seeded { seed, choices } -> { + let fst_choice = builtin.index_bytearray(seed, 0) + + fn(choice, choices) { + Some((Seeded { seed: builtin.blake2b_256(seed), choices }, choice)) + } + |> fn(return) { + if fst_choice < int_bucket_small { + return(fst_choice, builtin.cons_bytearray(fst_choice, choices)) + } else if fst_choice < int_bucket_zero { + return(0, builtin.cons_bytearray(fst_choice, choices)) + } else if fst_choice < int_bucket_negative { + let snd_choice = builtin.index_bytearray(seed, 1) + return( + -snd_choice, + builtin.cons_bytearray( + snd_choice, + builtin.cons_bytearray(fst_choice, choices), + ), + ) + } else { + let snd_choice = builtin.index_bytearray(seed, 1) + return( + u16(fst_choice - int_bucket_negative, snd_choice), + builtin.cons_bytearray( + snd_choice, + builtin.cons_bytearray(fst_choice, choices), + ), + ) + } + } + } + + Replayed { cursor, choices } -> + if cursor >= 1 { + let cursor = cursor - 1 + + let fst_choice = builtin.index_bytearray(choices, cursor) + + if fst_choice < int_bucket_small { + Some((Replayed { choices, cursor }, fst_choice)) + } else if fst_choice < int_bucket_zero { + Some((Replayed { choices, cursor }, 0)) + } else if cursor >= 1 { + let cursor = cursor - 1 + + let snd_choice = builtin.index_bytearray(choices, cursor) + + if fst_choice < int_bucket_negative { + Some((Replayed { choices, cursor }, -snd_choice)) + } else { + Some( + ( + Replayed { choices, cursor }, + u16(fst_choice - int_bucket_negative, snd_choice), + ), + ) + } + } else { + None + } + } else { + None + } + } + } +} + +/// Generate integers values uniformly between a lower and upper bounds (both inclusive). +pub fn int_between(min: Int, max: Int) -> Fuzzer { + if min > max { + int_between(max, min) + } else if min == max { + constant(min) + } else { + let range = max - min + 1 + let log2_floor = log2(range) + let threshold = math.pow2(log2_floor) + let n <- and_then(rand) + if n * range <= max_rand * threshold { + let offset <- map(rand_n(log2_floor, _)) + offset + min + } else { + let offset <- map(int_between(0, range - threshold - 1)) + threshold + offset + min + } + } +} + +/// Generate a random integer which is at least `min`. +pub fn int_at_least(min: Int) -> Fuzzer { + let abs = math.abs(min) + if abs <= max_rand { + int_between(min, max_rand) + } else { + int_between(min, min + 5 * abs) + } +} + +/// Generate a random integer which is at most `max`. +pub fn int_at_most(max: Int) -> Fuzzer { + let abs = math.abs(max) + if abs <= max_rand { + int_between(-max_rand, max) + } else { + int_between(max - 5 * abs, max) + } +} + +// ### Data-structures + +/// Generate a random list of elements from a given fuzzer. The list contains +/// *at most `20`* elements, and has a higher probability of generating smaller lists. +/// +/// For lists of a specific length, use [`list_between`](#list_between). +pub fn list(fuzzer: Fuzzer) -> Fuzzer> { + list_between(fuzzer, 0, 20) +} + +/// Generate a random list of elements with length within specified bounds. The +/// resulting list contains *at least `min`* elements and *at most `max`* +/// elements, with a higher probability of generating smaller lists. +/// +/// More specifically, there's approximately 1/n chance of generating n +/// elements within the range. For example, the distribution when generating a +/// list between 0 and 10 elements resemble the following: +/// +/// ``` +/// 22.7% 0 elements ████████ +/// 19.7% 1 element ███████ +/// 13.5% 2 elements █████ +/// 9.5% 3 elements ███ +/// 6.3% 4 elements ██ +/// 5.6% 5 elements ██ +/// 5.6% 6 elements ██ +/// 4.0% 7 elements █ +/// 3.1% 8 elements █ +/// 2.0% 9 elements █ +/// 8.0% 10 elements ███ +/// ``` +pub fn list_between(fuzzer: Fuzzer, min: Int, max: Int) -> Fuzzer> { + if min > max { + list_between(fuzzer, max, min) + } else if max <= 0 { + constant([]) + } else { + do_list_between( + max - min, + if max == min { + -1 + } else { + log2(max - min) + }, + always(fuzzer, _), + min, + max, + 0, + [], + ) + } +} + +// We generate a list by "flipping a coin" and generating the next element if we +// got 'heads'. +// +// NOTE (2): +// More mathematically, we consider the probability exp(log(1/(n + 1))/n) +// of generating another element, where `n` is the maximum length of the list. +// +// This gives a probability of generating a list of `n` elements of ~ 1/(n+1). +// So for example, for a list of maximum 2 elements, we have 33% chance of +// generating a list with 2 elements, 24% of 1 element, and 42% chances of +// generating an empty list. +// +// We approximate this probability as: n/(n+3) which for values of n >= 0 +// gives us a good enough approximation less expensive to compute. +// +// NOTE (1): +// There are the special cases of 'min' and 'max' which may force us to add an element +// or stop. For those, we still _fake making a choice_ so that even after shrinking the +// choice sequence, we still generate lists that respect the given invariant. +fn do_list_between(p, q, fuzzer, min, max, length, xs) -> Fuzzer> { + if length < min { + let x <- and_then(with_choice(min_rand) |> and_then(always(fuzzer(xs), _))) + do_list_between(p, q, fuzzer, min, max, length + 1, [x, ..xs]) + } else if length == max { + with_choice(max_rand) |> map(fn(_) { xs }) + } else { + expect q != -1 + rand + |> and_then( + fn(n) { + // This is the probability above but rewritten to use only + // multiplications since division on-chain is expensive. + if n * ( p + q ) < max_rand * p { + fuzzer(xs) + |> and_then( + fn(x) { + do_list_between( + p, + q, + fuzzer, + min, + max, + length + 1, + [x, ..xs], + ) + }, + ) + } else { + constant(xs) + } + }, + ) + } +} + +/// Generate a random list of elements from a given fuzzer, with at least `min` elements. +pub fn list_at_least(fuzzer: Fuzzer, min: Int) -> Fuzzer> { + list_between(fuzzer, min, min + 20) +} + +/// Generate a random list of elements from a given fuzzer, with at most `max` elements. +pub fn list_at_most(fuzzer: Fuzzer, max: Int) -> Fuzzer> { + list_between(fuzzer, 0, max) +} + +/// Generate a random list and pick an element from that list. Return both. +pub fn list_with_elem(fuzzer: Fuzzer) -> Fuzzer<(List, a)> { + let xs <- and_then(list_at_least(fuzzer, 1)) + let x <- map(one_of(xs)) + (xs, x) +} + +/// Pick an element from a list, returning its index. +pub fn pick(xs: List) -> Fuzzer<(Int, a)> { + let ix <- map(int_between(0, list.length(xs) - 1)) + expect Some(x) = list.at(xs, ix) + (ix, x) +} + +/// Generate a random list of **unique** elements (a.k.a. a set) from a given fuzzer. +/// The list contains *at most `20`* elements, and has a higher probability of +/// generating smaller lists. +/// +/// **Important:** The specified fuzzer must have a high enough entropy to +/// yield enough unique values to fill the set with the required size! +/// +/// For sets of a specific length, use [`set_between`](#set_between). +pub fn set(fuzzer: Fuzzer) -> Fuzzer> { + set_between(fuzzer, 0, 20) +} + +/// Generate a random list of **unique** elements (a.k.a a set) with length +/// within specified bounds. The resulting set contains *at least `min`* +/// elements and *at most `max`* elements, with a higher probability of +/// generating smaller sets. +/// +/// More specifically, there's approximately 1/n chance of generating n +/// elements within the range. For example, the distribution when generating a +/// set between 0 and 10 elements resemble the following: +/// +/// **Important:** The specified fuzzer must have a high enough entropy to +/// yield enough unique values to fill the set with the required size! +/// +/// ``` +/// 22.7% 0 elements ████████ +/// 19.7% 1 element ███████ +/// 13.5% 2 elements █████ +/// 9.5% 3 elements ███ +/// 6.3% 4 elements ██ +/// 5.6% 5 elements ██ +/// 5.6% 6 elements ██ +/// 4.0% 7 elements █ +/// 3.1% 8 elements █ +/// 2.0% 9 elements █ +/// 8.0% 10 elements ███ +/// ``` +pub fn set_between(fuzzer: Fuzzer, min: Int, max: Int) -> Fuzzer> { + if min > max { + set_between(fuzzer, max, min) + } else if max <= 0 { + constant([]) + } else { + do_list_between( + max - min, + if max == min { + -1 + } else { + log2(max - min) + }, + nub(100, fuzzer, _), + min, + max, + 0, + [], + ) + } +} + +/// Generate a random set of elements from a given fuzzer, with at least `min` elements. +pub fn set_at_least(fuzzer: Fuzzer, min: Int) -> Fuzzer> { + set_between(fuzzer, min, min + 20) +} + +/// Generate a random set of elements from a given fuzzer, with at most `max` elements. +pub fn set_at_most(fuzzer: Fuzzer, max: Int) -> Fuzzer> { + set_between(fuzzer, 0, max) +} + +/// Generate a random set and pick an element from that set. Return both. +pub fn set_with_elem(fuzzer: Fuzzer) -> Fuzzer<(List, a)> { + let xs <- and_then(set_at_least(fuzzer, 1)) + let x <- map(one_of(xs)) + (xs, x) +} + +/// Construct a fuzzer that returns values not present in a given list. +fn nub(n: Int, fuzzer: Fuzzer, st: List) -> Fuzzer { + if n <= 0 { + fail @"gave up trying to find unique values: the fuzzer did not yield any *new* value after many tries!" + } else { + let a <- and_then(fuzzer) + if list.has(st, a) { + nub(n - 1, fuzzer, st) + } else { + constant(a) + } + } +} + +// ## Combining + +/// Combine a [Fuzzer](https://aiken-lang.github.io/prelude/aiken.html#Fuzzer) with the result of a another one. +/// This function works great with [backpassing](https://aiken-lang.org/language-tour/functions#backpassing-). +/// +/// ```aiken +/// pub fn either(left: Fuzzer, right: Fuzzer) -> Fuzzer { +/// let pick_left <- fuzz.and_then(fuzz.bool()) +/// if pick_left { +/// left +/// } else { +/// right +/// } +/// } +/// ``` +pub fn and_then(fuzz_a: Fuzzer, f: fn(a) -> Fuzzer) -> Fuzzer { + fn(s0) { + when fuzz_a(s0) is { + Some((s1, a)) -> f(a)(s1) + None -> None + } + } +} + +/// Combine two fuzzers into a 2-tuple. +pub fn both(left: Fuzzer, right: Fuzzer) -> Fuzzer<(a, b)> { + map2(left, right, fn(l, r) { (l, r) }) +} + +/// Choose either of two fuzzers with an equal probability. +pub fn either(left: Fuzzer, right: Fuzzer) -> Fuzzer { + let pick_left <- and_then(bool()) + if pick_left { + left + } else { + right + } +} + +/// Choose either of three fuzzers with an equal probability. +pub fn either3( + a: Fuzzer, + b: Fuzzer, + c: Fuzzer, +) -> Fuzzer { + let ix <- and_then(byte()) + if ix < 85 { + a + } else if ix < 170 { + b + } else { + c + } +} + +/// Choose either of four fuzzers with an equal probability. +pub fn either4( + a: Fuzzer, + b: Fuzzer, + c: Fuzzer, + d: Fuzzer, +) -> Fuzzer { + let ix <- and_then(byte()) + if ix < 128 { + if ix < 64 { + a + } else { + b + } + } else { + if ix < 192 { + c + } else { + d + } + } +} + +/// Choose either of five fuzzers with an equal probability. +pub fn either5( + a: Fuzzer, + b: Fuzzer, + c: Fuzzer, + d: Fuzzer, + e: Fuzzer, +) -> Fuzzer { + let ix <- and_then(byte()) + if ix < 102 { + if ix < 51 { + a + } else { + b + } + } else if ix < 204 { + if ix < 153 { + c + } else { + d + } + } else { + e + } +} + +/// Choose either of six fuzzers with an equal probability. +pub fn either6( + a: Fuzzer, + b: Fuzzer, + c: Fuzzer, + d: Fuzzer, + e: Fuzzer, + f: Fuzzer, +) -> Fuzzer { + let ix <- and_then(byte()) + if ix < 128 { + if ix < 42 { + a + } else if ix < 85 { + b + } else { + c + } + } else { + if ix < 170 { + d + } else if ix < 212 { + e + } else { + f + } + } +} + +/// Choose either of seven fuzzers with an equal probability. +pub fn either7( + a: Fuzzer, + b: Fuzzer, + c: Fuzzer, + d: Fuzzer, + e: Fuzzer, + f: Fuzzer, + g: Fuzzer, +) -> Fuzzer { + let ix <- and_then(byte()) + if ix < 110 { + if ix < 36 { + a + } else if ix < 72 { + b + } else { + c + } + } else { + if ix < 182 { + if ix < 145 { + d + } else { + e + } + } else { + if ix < 218 { + f + } else { + g + } + } + } +} + +/// Choose either of height fuzzers with an equal probability. +pub fn either8( + a: Fuzzer, + b: Fuzzer, + c: Fuzzer, + d: Fuzzer, + e: Fuzzer, + f: Fuzzer, + g: Fuzzer, + h: Fuzzer, +) -> Fuzzer { + let ix <- and_then(byte()) + if ix < 128 { + if ix < 64 { + if ix < 32 { + a + } else { + b + } + } else { + if ix < 96 { + c + } else { + d + } + } + } else { + if ix < 192 { + if ix < 160 { + e + } else { + f + } + } else { + if ix < 224 { + g + } else { + h + } + } + } +} + +/// Choose either of nine fuzzers with an equal probability. +pub fn either9( + a: Fuzzer, + b: Fuzzer, + c: Fuzzer, + d: Fuzzer, + e: Fuzzer, + f: Fuzzer, + g: Fuzzer, + h: Fuzzer, + i: Fuzzer, +) -> Fuzzer { + let ix <- and_then(byte()) + if ix < 112 { + if ix < 56 { + if ix < 28 { + a + } else { + b + } + } else { + if ix < 84 { + c + } else { + d + } + } + } else { + if ix < 172 { + if ix < 144 { + e + } else { + f + } + } else { + if ix < 200 { + g + } else if ix < 228 { + h + } else { + i + } + } + } +} + +/// Transform the result of a [Fuzzer](https://aiken-lang.github.io/prelude/aiken.html#Fuzzer) using a function. +/// This function works great with [backpassing](https://aiken-lang.org/language-tour/functions#backpassing-). +/// +/// ```aiken +/// fn bool() -> Fuzzer { +/// let n <- map(int_between(1, 100)) +/// n % 2 +/// } +/// ``` +pub fn map(fuzz_a: Fuzzer, f: fn(a) -> b) -> Fuzzer { + fn(s0) { + when fuzz_a(s0) is { + Some((s1, a)) -> Some((s1, f(a))) + None -> None + } + } +} + +/// Combine the results of two [Fuzzer](https://aiken-lang.github.io/prelude/aiken.html#Fuzzer)s. +pub fn map2( + fuzz_0: Fuzzer, + fuzz_1: Fuzzer, + f: fn(t0, t1) -> result, +) -> Fuzzer { + fn(s0) { + when fuzz_0(s0) is { + Some((s1, t0)) -> + when fuzz_1(s1) is { + Some((s2, t1)) -> Some((s2, f(t0, t1))) + None -> None + } + None -> None + } + } +} + +/// Combine the results of three [Fuzzer](https://aiken-lang.github.io/prelude/aiken.html#Fuzzer)s. +pub fn map3( + fuzz_0: Fuzzer, + fuzz_1: Fuzzer, + fuzz_2: Fuzzer, + f: fn(t0, t1, t2) -> result, +) -> Fuzzer { + fn(s0) { + when fuzz_0(s0) is { + Some((s1, t0)) -> + when fuzz_1(s1) is { + Some((s2, t1)) -> + when fuzz_2(s2) is { + Some((s3, t2)) -> Some((s3, f(t0, t1, t2))) + None -> None + } + None -> None + } + None -> None + } + } +} + +/// Combine the results of four [Fuzzer](https://aiken-lang.github.io/prelude/aiken.html#Fuzzer)s. +pub fn map4( + fuzz_0: Fuzzer, + fuzz_1: Fuzzer, + fuzz_2: Fuzzer, + fuzz_3: Fuzzer, + f: fn(t0, t1, t2, t3) -> result, +) -> Fuzzer { + fn(s0) { + when fuzz_0(s0) is { + Some((s1, t0)) -> + when fuzz_1(s1) is { + Some((s2, t1)) -> + when fuzz_2(s2) is { + Some((s3, t2)) -> + when fuzz_3(s3) is { + Some((s4, t3)) -> Some((s4, f(t0, t1, t2, t3))) + None -> None + } + None -> None + } + None -> None + } + None -> None + } + } +} + +/// Combine the results of five [Fuzzer](https://aiken-lang.github.io/prelude/aiken.html#Fuzzer)s. +pub fn map5( + fuzz_0: Fuzzer, + fuzz_1: Fuzzer, + fuzz_2: Fuzzer, + fuzz_3: Fuzzer, + fuzz_4: Fuzzer, + f: fn(t0, t1, t2, t3, t4) -> result, +) -> Fuzzer { + fn(s0) { + when fuzz_0(s0) is { + Some((s1, t0)) -> + when fuzz_1(s1) is { + Some((s2, t1)) -> + when fuzz_2(s2) is { + Some((s3, t2)) -> + when fuzz_3(s3) is { + Some((s4, t3)) -> + when fuzz_4(s4) is { + Some((s5, t4)) -> Some((s5, f(t0, t1, t2, t3, t4))) + None -> None + } + None -> None + } + None -> None + } + None -> None + } + None -> None + } + } +} + +/// Combine the results of six [Fuzzer](https://aiken-lang.github.io/prelude/aiken.html#Fuzzer)s. +pub fn map6( + fuzz_0: Fuzzer, + fuzz_1: Fuzzer, + fuzz_2: Fuzzer, + fuzz_3: Fuzzer, + fuzz_4: Fuzzer, + fuzz_5: Fuzzer, + f: fn(t0, t1, t2, t3, t4, t5) -> result, +) -> Fuzzer { + fn(s0) { + when fuzz_0(s0) is { + Some((s1, t0)) -> + when fuzz_1(s1) is { + Some((s2, t1)) -> + when fuzz_2(s2) is { + Some((s3, t2)) -> + when fuzz_3(s3) is { + Some((s4, t3)) -> + when fuzz_4(s4) is { + Some((s5, t4)) -> + when fuzz_5(s5) is { + Some((s6, t5)) -> + Some((s6, f(t0, t1, t2, t3, t4, t5))) + None -> None + } + None -> None + } + None -> None + } + None -> None + } + None -> None + } + None -> None + } + } +} + +/// Combine the results of seven [Fuzzer](https://aiken-lang.github.io/prelude/aiken.html#Fuzzer)s. +pub fn map7( + fuzz_0: Fuzzer, + fuzz_1: Fuzzer, + fuzz_2: Fuzzer, + fuzz_3: Fuzzer, + fuzz_4: Fuzzer, + fuzz_5: Fuzzer, + fuzz_6: Fuzzer, + f: fn(t0, t1, t2, t3, t4, t5, t6) -> result, +) -> Fuzzer { + fn(s0) { + when fuzz_0(s0) is { + Some((s1, t0)) -> + when fuzz_1(s1) is { + Some((s2, t1)) -> + when fuzz_2(s2) is { + Some((s3, t2)) -> + when fuzz_3(s3) is { + Some((s4, t3)) -> + when fuzz_4(s4) is { + Some((s5, t4)) -> + when fuzz_5(s5) is { + Some((s6, t5)) -> + when fuzz_6(s6) is { + Some((s7, t6)) -> + Some((s7, f(t0, t1, t2, t3, t4, t5, t6))) + None -> None + } + None -> None + } + None -> None + } + None -> None + } + None -> None + } + None -> None + } + None -> None + } + } +} + +/// Combine the results of eight [Fuzzer](https://aiken-lang.github.io/prelude/aiken.html#Fuzzer)s. +pub fn map8( + fuzz_0: Fuzzer, + fuzz_1: Fuzzer, + fuzz_2: Fuzzer, + fuzz_3: Fuzzer, + fuzz_4: Fuzzer, + fuzz_5: Fuzzer, + fuzz_6: Fuzzer, + fuzz_7: Fuzzer, + f: fn(t0, t1, t2, t3, t4, t5, t6, t7) -> result, +) -> Fuzzer { + fn(s0) { + when fuzz_0(s0) is { + Some((s1, t0)) -> + when fuzz_1(s1) is { + Some((s2, t1)) -> + when fuzz_2(s2) is { + Some((s3, t2)) -> + when fuzz_3(s3) is { + Some((s4, t3)) -> + when fuzz_4(s4) is { + Some((s5, t4)) -> + when fuzz_5(s5) is { + Some((s6, t5)) -> + when fuzz_6(s6) is { + Some((s7, t6)) -> + when fuzz_7(s7) is { + Some((s8, t7)) -> + Some( + (s8, f(t0, t1, t2, t3, t4, t5, t6, t7)), + ) + None -> None + } + None -> None + } + None -> None + } + None -> None + } + None -> None + } + None -> None + } + None -> None + } + None -> None + } + } +} + +/// Combine the results of nine [Fuzzer](https://aiken-lang.github.io/prelude/aiken.html#Fuzzer)s. +pub fn map9( + fuzz_0: Fuzzer, + fuzz_1: Fuzzer, + fuzz_2: Fuzzer, + fuzz_3: Fuzzer, + fuzz_4: Fuzzer, + fuzz_5: Fuzzer, + fuzz_6: Fuzzer, + fuzz_7: Fuzzer, + fuzz_8: Fuzzer, + f: fn(t0, t1, t2, t3, t4, t5, t6, t7, t8) -> result, +) -> Fuzzer { + fn(s0) { + when fuzz_0(s0) is { + Some((s1, t0)) -> + when fuzz_1(s1) is { + Some((s2, t1)) -> + when fuzz_2(s2) is { + Some((s3, t2)) -> + when fuzz_3(s3) is { + Some((s4, t3)) -> + when fuzz_4(s4) is { + Some((s5, t4)) -> + when fuzz_5(s5) is { + Some((s6, t5)) -> + when fuzz_6(s6) is { + Some((s7, t6)) -> + when fuzz_7(s7) is { + Some((s8, t7)) -> + when fuzz_8(s8) is { + Some((s9, t8)) -> + Some( + ( + s9, + f( + t0, + t1, + t2, + t3, + t4, + t5, + t6, + t7, + t8, + ), + ), + ) + None -> None + } + None -> None + } + None -> None + } + None -> None + } + None -> None + } + None -> None + } + None -> None + } + None -> None + } + None -> None + } + } +} + +/// Pick a value from a (non-empty!) list with equal probability. +/// +/// ```aiken +/// let any_bool = fuzz.one_of([True, False]) +/// ``` +pub fn one_of(xs: List) -> Fuzzer { + let len = list.length(xs) + expect len > 0 + int_between(0, len - 1) + |> map( + fn(ix: Int) { + expect Some(item) = list.at(xs, ix) + item + }, + ) +} + +/// Choose between `None` or `Some` value with an equal probability. +pub fn option(fuzz_a: Fuzzer) -> Fuzzer> { + bool() + |> and_then( + fn(predicate) { + if predicate { + fuzz_a |> map(Some) + } else { + constant(None) + } + }, + ) +} + +/// Take a random subset from an existing list. +pub fn sublist(xs: List) -> Fuzzer> { + let threshold <- and_then(rand) + when xs is { + [] -> constant([]) + [head, ..tail] -> { + let n <- and_then(rand) + let rest <- map(subset(tail)) + if n < threshold { + [head, ..rest] + } else { + rest + } + } + } +} + +/// Take a random subset from an existing set. +pub fn subset(xs: List) -> Fuzzer> { + sublist(xs) +} + +/// Generate a value that satisfies a given predicate. Beware that this +/// function may heavily impact the performances of your fuzzers. In general, you +/// should prefer constraining the fuzzers beforehand than trying to discard +/// values after the fact! +/// +/// Use with caution. +pub fn such_that(fuzzer: Fuzzer, predicate: fn(a) -> Bool) -> Fuzzer { + do_such_that(fuzzer, predicate, 100) +} + +fn do_such_that( + fuzzer: Fuzzer, + predicate: fn(a) -> Bool, + max_tries: Int, +) -> Fuzzer { + if max_tries <= 0 { + fail @"such_that: couldn't satisfy the predicate after 100 attempts." + } else { + let x <- and_then(fuzzer) + if predicate(x) { + constant(x) + } else { + do_such_that(fuzzer, predicate, max_tries - 1) + } + } +} + +// ## Inspecting + +/// Label a test case. Labels are collected at the end of a property run and a +/// distribution amongst all labels is computed and shown. This is particularly +/// useful to assert that specific scenarios are met or to test your fuzzers. +/// +/// ```aiken +/// test prop_bool_distribution(is_true via bool()) { +/// label( +/// if is_true { +/// @"True" +/// } else { +/// @"False" +/// }, +/// ) +/// +/// True +/// } +/// ``` +pub fn label(str: String) -> Void { + str + |> builtin.append_string(@"\0", _) + |> builtin.debug(Void) +} + +/// Apply a label when a predicate is true, or fallback to a default label. +/// Useful for labelling dichotomies while ensuring that the final label +/// distribution reflects all cases. +/// +/// ```aiken +/// test prop_u16(operands via fuzz.both(byte(), byte())) { +/// let (msb, lsb) = operands +/// fuzz.label_when(msb == 0, @"msb = 0", @"default") +/// fuzz.label_when(lsb == 0, @"lsb = 0", @"default") +/// builtin.bytearray_to_integer( +/// False, +/// "" +/// |> builtin.cons_bytearray(msb, _) +/// |> builtin.cons_bytearray(lsb, _), +/// ) == msb * 256 + lsb +/// } +/// ``` +pub fn label_when(predicate: Bool, str: String, default: String) -> Void { + if predicate { + label(str) + } else { + label(default) + } +} + +/// Apply a label when a predicate is true, or do nothing. Useful for +/// conditionally labelling scenarios in a single line. +/// +/// ```aiken +/// test post_conditions(steps via any_scenario()) { +/// let (is_register, is_reregister, is_unregister, is_forward) = +/// classify_steps(steps) +/// +/// @"contains solo registration" |> label_if(is_register) +/// @"contains re-registration" |> label_if(is_reregister) +/// @"contains solo unregistration" |> label_if(is_unregister) +/// @"contains forward-only" |> label_if(is_forward) +/// } +/// ``` +pub fn label_if(str: String, predicate: Bool) -> Void { + if predicate { + label(str) + } else { + Void + } +} + +// Internal + +const max_rand = 255 + +const min_rand = 0 + +//. A choice made from a Pseudo-random number generator. The generator can come in two shapes: +/// +/// - Either it is `Seeded`, in which case leverage the pseudo-randomness of hashing algorithms to generate a value and a new seed. +/// +/// - Or it is `Replayed` in case where we're trying to shrink a known counter-example. Because a `Replayed` generator has usually been altered, it isn't guaranteed to be a valid sequence. It is possible, for example, that we run out of values to draw from. +/// +/// Either ways, the PRNG's choices are *always* non-negative integers. +fn rand(prng: PRNG) -> Option<(PRNG, Int)> { + when prng is { + Seeded { seed, choices } -> { + let choice = + seed + |> builtin.index_bytearray(0) + + Some( + ( + Seeded { + seed: builtin.blake2b_256(seed), + choices: builtin.cons_bytearray(choice, choices), + }, + choice, + ), + ) + } + + Replayed { cursor, choices } -> + if cursor >= 1 { + let cursor = cursor - 1 + Some( + ( + Replayed { choices, cursor }, + builtin.index_bytearray(choices, cursor), + ), + ) + } else { + None + } + } +} + +fn rand_n(bits: Int, prng: PRNG) -> Option<(PRNG, Int)> { + let (prng, buffer) <- option.map(do_rand_n("", bits, prng)) + (prng, builtin.bytearray_to_integer(True, buffer)) +} + +fn do_rand_n( + buffer: ByteArray, + bits: Int, + prng: PRNG, +) -> Option<(PRNG, ByteArray)> { + let (prng, n) <- option.and_then(rand(prng)) + if bits <= 8 { + Some((prng, builtin.cons_bytearray(n % math.pow2(bits), buffer))) + } else { + do_rand_n(builtin.cons_bytearray(n, buffer), bits - 8, prng) + } +} + +fn rand_n_fixture() -> Fuzzer<(Int, Int)> { + let bits <- + and_then( + either( + constant(1), + either(constant(5), either(constant(8), constant(25))), + ), + ) + let n <- map(rand_n(bits, _)) + (bits, n) +} + +test prop_rand_n(fixture via rand_n_fixture()) { + let (bits, n) = fixture + n >= 0 && n < math.pow2(bits) +} + +test rand_n_distribution_20(n via rand_n(20, _)) { + label( + if n < 256 { + // 256 / 2^20 + @"~ 0.025%" + } else if n < 65536 { + // (2^16 - 2^8) / 2^20 + @"~ 6.225%" + } else { + // (2^20 - 2^16) / 2^20 + @"~ 93.75%" + }, + ) + + True +} + +fn with_choice(choice: Int) -> Fuzzer { + fn(prng) { + when prng is { + Seeded { seed, choices } -> + Some( + ( + Seeded { seed, choices: builtin.cons_bytearray(choice, choices) }, + choice, + ), + ) + Replayed { cursor, choices } -> + if cursor >= 1 { + let cursor = cursor - 1 + let drawn = builtin.index_bytearray(choices, cursor) + if choice == drawn { + Some((Replayed { choices, cursor }, choice)) + } else { + None + } + } else { + None + } + } + } +} + +fn log2(x: Int) -> Int { + expect x > 0 + let s = builtin.integer_to_bytearray(True, 0, x) + let len = builtin.length_of_bytearray(s) + let b = builtin.index_bytearray(s, 0) + len * 8 - if b < 2 { + 8 + } else if b < 4 { + 7 + } else if b < 8 { + 6 + } else if b < 16 { + 5 + } else if b < 32 { + 4 + } else if b < 64 { + 3 + } else if b < 128 { + 2 + } else { + 1 + } +} + +test unit_log2_1() { + and { + log2(1) == 0, + log2(2) == 1, + log2(3) == 1, + log2(4) == 2, + log2(256) == 8, + log2(257) == 8, + log2(511) == 8, + log2(1025) == 10, + } +} + +test prop_log2(n via int_at_least(1)) { + let log2_floor = log2(n) + and { + n >= math.pow2(log2_floor), + n <= math.pow2(log2_floor + 1), + } +} + +/// Construct a larger int from two u8 operands. +/// The most significant part is given first. +fn u16(msb: Int, lsb: Int) -> Int { + msb * 256 + lsb +} + +test prop_u16(operands via both(rand, rand)) { + let (msb, lsb) = operands + label_when(msb == 0, @"msb = 0", @"default") + label_when(lsb == 0, @"lsb = 0", @"default") + let n = + builtin.bytearray_to_integer( + False, + "" + |> builtin.cons_bytearray(msb, _) + |> builtin.cons_bytearray(lsb, _), + ) + u16(msb, lsb) == n +} + +/// Convert a regular Fuzzer to a ScaledFuzzer by ignoring the complexity parameter +pub fn to_scaled_fuzzer(fuzzer: Fuzzer) -> ScaledFuzzer { + fn(prng: PRNG, _complexity: Int) { fuzzer(prng) } +} + +/// Convert a ScaledFuzzer to a regular Fuzzer by using a default complexity of 1 +/// User can also specify a constant complexity +pub fn from_scaled_fuzzer( + scaled_fuzzer: ScaledFuzzer, + complexity: Option, +) -> Fuzzer { + when complexity is { + Some(complexity) -> + fn(prng) { scaled_fuzzer(prng, complexity) } + None -> + fn(prng) { scaled_fuzzer(prng, 1) } + } +} + +/// Create a constant ScaledFuzzer from an arbitrary value +pub fn scaled_constant(a: a) -> ScaledFuzzer { + fn(s0, _complexity) { Some((s0, a)) } +} + +/// Transform the result of a ScaledFuzzer using a function +pub fn scaled_map( + scaled_fuzz_a: ScaledFuzzer, + f: fn(a) -> b, +) -> ScaledFuzzer { + fn(s0, complexity) { + when scaled_fuzz_a(s0, complexity) is { + Some((s1, a)) -> Some((s1, f(a))) + None -> None + } + } +} + +/// Combine a ScaledFuzzer with the result of another one +pub fn scaled_and_then( + scaled_fuzz_a: ScaledFuzzer, + f: fn(a) -> ScaledFuzzer, +) -> ScaledFuzzer { + fn(s0, complexity) { + when scaled_fuzz_a(s0, complexity) is { + Some((s1, a)) -> f(a)(s1, complexity) + None -> None + } + } +} + +/// Generate a random list using a ScaledFuzzer, with length scaled by complexity +pub fn scaled_set(scaled_fuzzer: ScaledFuzzer) -> ScaledFuzzer> { + fn(prng, complexity) { + // Scale the maximum list length based on complexity + let max_len = 20 * complexity + list_between(from_scaled_fuzzer(scaled_fuzzer, None), complexity, max_len)( + prng, + ) + } +} + +/// Generate integers with magnitude scaled by complexity +pub fn scaled_int() -> ScaledFuzzer { + fn(prng, complexity) { + // Scale the range based on complexity + let range = 255 * complexity + int_between(-range, range)(prng) + } +} + +/// Combine two ScaledFuzzers into a 2-tuple +pub fn scaled_both( + left: ScaledFuzzer, + right: ScaledFuzzer, +) -> ScaledFuzzer<(a, b)> { + fn(s0, complexity) { + when left(s0, complexity) is { + Some((s1, a)) -> + when right(s1, complexity) is { + Some((s2, b)) -> Some((s2, (a, b))) + None -> None + } + None -> None + } + } +} + +/// Choose either of two ScaledFuzzers with equal probability +pub fn scaled_either( + left: ScaledFuzzer, + right: ScaledFuzzer, +) -> ScaledFuzzer { + let pick_left <- scaled_and_then(to_scaled_fuzzer(bool())) + if pick_left { + left + } else { + right + } +} + +/// Choose between None or Some value with equal probability for ScaledFuzzers +pub fn scaled_option(scaled_fuzz_a: ScaledFuzzer) -> ScaledFuzzer> { + to_scaled_fuzzer(bool()) + |> scaled_and_then( + fn(predicate) { + if predicate { + scaled_fuzz_a |> scaled_map(Some) + } else { + scaled_constant(None) + } + }, + ) +} + +/// Generate a random ByteArray with size scaled by complexity +pub fn scaled_bytearray() -> ScaledFuzzer { + fn(prng, complexity) { + // Scale the size based on complexity + let size = 32 * complexity + bytearray_fixed(size)(prng) + } +} + +/// Combine the results of two ScaledFuzzers +pub fn scaled_map2( + scaled_fuzz_0: ScaledFuzzer, + scaled_fuzz_1: ScaledFuzzer, + f: fn(t0, t1) -> result, +) -> ScaledFuzzer { + fn(s0, complexity) { + when scaled_fuzz_0(s0, complexity) is { + Some((s1, t0)) -> + when scaled_fuzz_1(s1, complexity) is { + Some((s2, t1)) -> Some((s2, f(t0, t1))) + None -> None + } + None -> None + } + } +} + +/// Generate a random list of elements with length within specified bounds, scaled by complexity +pub fn scaled_list_between( + scaled_fuzzer: ScaledFuzzer, + min: Int, + max: Int, +) -> ScaledFuzzer> { + fn(s0, complexity) { + // Scale max by complexity while preserving minimum + let scaled_max = max * complexity + list_between(from_scaled_fuzzer(scaled_fuzzer, None), min, scaled_max)(s0) + } +} + +/// Choose between three ScaledFuzzers with equal probability +pub fn scaled_either3( + a: ScaledFuzzer, + b: ScaledFuzzer, + c: ScaledFuzzer, +) -> ScaledFuzzer { + fn(s0, complexity) { + if complexity < 85 { + a(s0, complexity) + } else if complexity < 170 { + b(s0, complexity) + } else { + c(s0, complexity) + } + } +} + +/// Generate a value that satisfies a predicate, with complexity-aware retries +pub fn scaled_such_that( + scaled_fuzzer: ScaledFuzzer, + predicate: fn(a) -> Bool, +) -> ScaledFuzzer { + fn(s0, complexity) { + // Scale max tries with complexity + do_scaled_such_that( + scaled_fuzzer, + predicate, + 100 * complexity, + s0, + complexity, + ) + } +} + +fn do_scaled_such_that( + scaled_fuzzer: ScaledFuzzer, + predicate: fn(a) -> Bool, + max_tries: Int, + s0: PRNG, + complexity: Int, +) -> Option<(PRNG, a)> { + if max_tries <= 0 { + fail @"scaled_such_that: couldn't satisfy predicate after maximum attempts" + } else { + when scaled_fuzzer(s0, complexity) is { + Some((s1, x)) -> + if predicate(x) { + Some((s1, x)) + } else { + do_scaled_such_that( + scaled_fuzzer, + predicate, + max_tries - 1, + s1, + complexity, + ) + } + None -> None + } + } +} diff --git a/lib/aiken/fuzz.test.ak b/lib/aiken/fuzz.test.ak new file mode 100644 index 0000000..a6e2e2d --- /dev/null +++ b/lib/aiken/fuzz.test.ak @@ -0,0 +1,321 @@ +use aiken/collection/list +use aiken/fuzz.{ + and_then, bool, constant, either3, either4, either5, either6, either7, either8, + either9, int, int_between, label, list_between, list_with_elem, map, one_of, + set, set_between, sublist, such_that, +} +use aiken/math +use aiken/primitive/bytearray +use aiken/primitive/string + +test prop_int_distribution(n via int()) { + label( + if n < -255 { + fail @"n < -max_u8" + } else if n < 0 { + @"[-255; 0[" + } else if n == 0 { + @"0" + } else if n < 256 { + @"]0; 255]" + } else if n < 16383 { + @"[256; 16383]" + } else { + fail @"n > 16383" + }, + ) + + True +} + +test prop_int_between_distribution(n via int_between(-100, 100)) { + buckets(n, -100, 100, fn(n) { n + 25 }) + n >= -100 && n <= 100 +} + +test prop_int_between_large( + n via int_between(0, 340_282_366_920_938_463_463_374_607_431_768_211_455), +) fail { + n <= 18_446_744_073_709_551_615 +} + +test prop_bytearray_simplify(bytes via fuzz.bytearray()) fail once { + bytes == "" +} + +test prop_bool_distribution(is_true via bool()) { + label( + if is_true { + @"True" + } else { + @"False" + }, + ) + + True +} + +test prop_list_distribution_small(xs via list_between(int(), 0, 10)) { + let len = list.length(xs) + buckets(len, 0, 11, fn(n) { n + 1 }) + len >= 0 && len <= 10 +} + +fn is_even(x: Int) -> Bool { + x % 2 == 0 +} + +test prop_such_that(x via such_that(int(), is_even)) { + is_even(x) +} + +test prop_list_exactly(xs via list_between(int(), 3, 3)) { + list.length(xs) == 3 +} + +fn list_at_least() -> Fuzzer<(Int, List)> { + let min <- and_then(int_between(0, 30)) + let xs <- map(fuzz.list_at_least(int(), min)) + (min, xs) +} + +test prop_list_at_least(params via list_at_least()) { + let (min, xs) = params + list.length(xs) >= min +} + +fn list_at_most() -> Fuzzer<(Int, List)> { + let max <- and_then(int_between(-10, 10)) + let xs <- map(fuzz.list_at_most(int(), max)) + (max, xs) +} + +test prop_list_at_most(params via list_at_most()) { + let (max, xs) = params + list.length(xs) <= math.max(0, max) +} + +fn int_at_least() -> Fuzzer<(Int, Int)> { + let min <- and_then(int()) + let n <- map(fuzz.int_at_least(min)) + (min, n) +} + +test prop_int_at_least(params via int_at_least()) { + let (min, n) = params + n >= min +} + +fn int_at_most() -> Fuzzer<(Int, Int)> { + let max <- and_then(int()) + let n <- map(fuzz.int_at_most(max)) + (max, n) +} + +test prop_int_at_most(params via int_at_most()) { + let (max, n) = params + n <= max +} + +test prop_list_with_elem(xs via list_with_elem(int())) { + let (xs, x) = xs + list.has(xs, x) +} + +fn list_with_sublist() -> Fuzzer<(List, List)> { + let xs <- and_then(fuzz.list(int())) + let sub <- map(sublist(xs)) + (xs, sub) +} + +test prop_list_with_subset(params via list_with_sublist()) { + let (xs, sub) = params + list.all(sub, fn(x) { list.has(xs, x) }) +} + +fn bytearray_between() -> Fuzzer<(Int, Int, ByteArray)> { + let min <- and_then(int_between(0, 50)) + let max <- and_then(int_between(min, 5 * min)) + let bytes <- map(fuzz.bytearray_between(min, max)) + (min, max, bytes) +} + +test prop_bytearray_between(params via bytearray_between()) { + let (min, max, bytes) = params + + let len = bytearray.length(bytes) + + let mid = ( min + max ) / 2 + + label( + if len < min { + @"< min (impossible)" + } else if len <= mid { + @"<= mid (~50%)" + } else if len <= max { + @"<= max (~50%)" + } else { + @"> max (impossible)" + }, + ) + + len >= min && len <= max +} + +test prop_int_between_boundary_up(n via int_between(0, 2)) fail once { + n < 2 +} + +test prop_int_between_smallest_range(n via int_between(0, 1)) { + label( + if n == 0 { + @"= 0" + } else { + @"= 1" + }, + ) + n == 0 || n == 1 +} + +test prop_int_between_boundary_down(n via int_between(0, 10)) fail once { + n > 0 +} + +test prop_one_of_upper(i via one_of([1, 3, 5, 7])) fail once { + i != 7 +} + +test prop_set(xs via set(int())) { + let ys = + list.reduce( + xs, + [], + fn(known, x) { + expect !list.has(known, x) + [x, ..known] + }, + ) + + list.length(ys) == list.length(xs) +} + +test prop_set_between_distribution(n via set_between(int_between(0, 50), 3, 13)) { + let len = n |> list.length + label(len |> string.from_int) + True +} + +// This property simply illustrate a case where the `set` +// fuzzer would fail and not loop forever after not being +// able to satisfy the demand (not enough entropy in the +// input domain). +// +// test prop_set_exhausted(xs via set(int_between(0, 3))) { +// True +// } + +test prop_either3( + lbl via either3(constant(@"a"), constant(@"b"), constant(@"c")), +) { + label(lbl) +} + +test prop_either4( + lbl via either4( + constant(@"a"), + constant(@"b"), + constant(@"c"), + constant(@"d"), + ), +) { + label(lbl) +} + +test prop_either5( + lbl via either5( + constant(@"a"), + constant(@"b"), + constant(@"c"), + constant(@"d"), + constant(@"e"), + ), +) { + label(lbl) +} + +test prop_either6( + lbl via either6( + constant(@"a"), + constant(@"b"), + constant(@"c"), + constant(@"d"), + constant(@"e"), + constant(@"f"), + ), +) { + label(lbl) +} + +test prop_either7( + lbl via either7( + constant(@"a"), + constant(@"b"), + constant(@"c"), + constant(@"d"), + constant(@"e"), + constant(@"f"), + constant(@"g"), + ), +) { + label(lbl) +} + +test prop_either8( + lbl via either8( + constant(@"a"), + constant(@"b"), + constant(@"c"), + constant(@"d"), + constant(@"e"), + constant(@"f"), + constant(@"g"), + constant(@"h"), + ), +) { + label(lbl) +} + +test prop_either9( + lbl via either9( + constant(@"a"), + constant(@"b"), + constant(@"c"), + constant(@"d"), + constant(@"e"), + constant(@"f"), + constant(@"g"), + constant(@"h"), + constant(@"i"), + ), +) { + label(lbl) +} + +/// A small function for automatically labelling a range of ints. +fn buckets(n, start, end, increment) -> Void { + expect n >= start + let next = increment(start) + if next >= end { + label( + [string.from_int(start), @"->", string.from_int(end)] + |> string.join(@" "), + ) + } else if n < next { + label( + [string.from_int(start), @"->", string.from_int(next)] + |> string.join(@" "), + ) + } else { + buckets(n, next, end, increment) + } +} diff --git a/lib/aiken/fuzz/scenario.ak b/lib/aiken/fuzz/scenario.ak new file mode 100644 index 0000000..b50c0d5 --- /dev/null +++ b/lib/aiken/fuzz/scenario.ak @@ -0,0 +1,441 @@ +//// This Source Code Form is subject to the terms of the Mozilla Public +//// License, v. 2.0. If a copy of the MPL was not distributed with this +//// file, You can obtain one at http://mozilla.org/MPL/2.0/. +//// This is a modified distribution of https://github.com/CardanoSolutions/zhuli/blob/main/lib/aiken/fuzz/scenario.ak + +use aiken/cbor.{serialise} +use aiken/collection/dict +use aiken/collection/list +use aiken/collection/pairs +use aiken/crypto.{ScriptHash, blake2b_256} +use aiken/fuzz.{and_then, byte, constant, map} +use cardano/address.{Credential, Script} +use cardano/assets.{PolicyId} +use cardano/certificate.{ + AuthorizeConstitutionalCommitteeProxy, Certificate, DelegateCredential, + RegisterAndDelegateCredential, RegisterDelegateRepresentative, + RetireFromConstitutionalCommittee, UnregisterCredential, + UnregisterDelegateRepresentative, UpdateDelegateRepresentative, +} +use cardano/governance.{ + ConstitutionalCommitteeMember, DelegateRepresentative, Voter, +} +use cardano/script_context.{ + Minting, Publishing, ScriptContext, Spending, Voting, Withdrawing, +} +use cardano/transaction.{ + DatumHash, InlineDatum, Input, Mint, NoDatum, OutputReference, Publish, Spend, + Transaction, Vote, Withdraw, +} + +const max_tries: Int = 50 + +const max_byte: Int = 255 + +pub type Label = + String + +pub type Scenario { + Done + Scenario(List, + branch: fn() -> Fuzzer, +) -> Fuzzer { + let toss <- and_then(byte()) + if toss < pivot { + main() + } else { + branch() + } +} + +pub fn fork2( + pivot: Int, + main: fn() -> Fuzzer, + branch1: fn() -> Fuzzer, + branch2: fn() -> Fuzzer, +) -> Fuzzer { + let toss <- and_then(byte()) + let step = ( max_byte - pivot ) / 2 + if toss < pivot { + main() + } else if toss < pivot + step { + branch1() + } else { + branch2() + } +} + +pub fn fork3( + pivot: Int, + main: fn() -> Fuzzer, + branch1: fn() -> Fuzzer, + branch2: fn() -> Fuzzer, + branch3: fn() -> Fuzzer, +) -> Fuzzer { + let toss <- and_then(byte()) + let step = ( max_byte - pivot ) / 3 + if toss < pivot { + main() + } else if toss < pivot + step { + branch1() + } else if toss < pivot + 2 * step { + branch2() + } else { + branch3() + } +} + +pub fn fork4( + pivot: Int, + main: Fuzzer, + branch1: Fuzzer, + branch2: Fuzzer, + branch3: Fuzzer, + branch4: Fuzzer, +) -> Fuzzer { + let toss <- and_then(byte()) + let step = ( max_byte - pivot ) / 4 + if toss < pivot { + main + } else if toss < pivot + step { + branch1 + } else if toss < pivot + 2 * step { + branch2 + } else if toss < pivot + 3 * step { + branch3 + } else { + branch4 + } +} diff --git a/lib/cardano/fuzz/address.ak b/lib/cardano/fuzz/address.ak new file mode 100644 index 0000000..d5fb774 --- /dev/null +++ b/lib/cardano/fuzz/address.ak @@ -0,0 +1,67 @@ +use aiken/fuzz.{and_then, bool, bytearray_between, int_between, map, map2} +use cardano/address.{Address, Credential, Inline, Script, VerificationKey} + +/// Generate a random Credential +pub fn any_credential() -> Fuzzer { + map2( + bool(), + bytearray_between(28, 28), + fn(coin_flip, key_hash) { + if coin_flip { + VerificationKey(key_hash) + } else { + Script(key_hash) + } + }, + ) +} + +pub fn any_address() -> Fuzzer
{ + let address_type <- and_then(int_between(0, 5)) + when address_type is { + 0 -> { + let payment <- map(bytearray_between(28, 28)) + Address { + payment_credential: VerificationKey(payment), + stake_credential: None, + } + } + 1 -> { + let payment <- map(bytearray_between(28, 28)) + Address { payment_credential: Script(payment), stake_credential: None } + } + 2 -> { + let payment <- and_then(bytearray_between(28, 28)) + let stake <- map(bytearray_between(28, 28)) + Address { + payment_credential: VerificationKey(payment), + stake_credential: Some(Inline(VerificationKey(stake))), + } + } + 3 -> { + let payment <- and_then(bytearray_between(28, 28)) + let stake <- map(bytearray_between(28, 28)) + Address { + payment_credential: VerificationKey(payment), + stake_credential: Some(Inline(Script(stake))), + } + } + 4 -> { + let payment <- and_then(bytearray_between(28, 28)) + let stake <- map(bytearray_between(28, 28)) + Address { + payment_credential: Script(payment), + stake_credential: Some(Inline(VerificationKey(stake))), + } + } + 5 -> { + let payment <- and_then(bytearray_between(28, 28)) + let stake <- map(bytearray_between(28, 28)) + Address { + payment_credential: Script(payment), + stake_credential: Some(Inline(Script(stake))), + } + } + _ -> fail @"unexpected address type" + } +} diff --git a/lib/cardano/fuzz/address.test.ak b/lib/cardano/fuzz/address.test.ak new file mode 100644 index 0000000..30567ce --- /dev/null +++ b/lib/cardano/fuzz/address.test.ak @@ -0,0 +1,42 @@ +use aiken/fuzz.{label} +use cardano/address.{Address, Inline, Script, VerificationKey} +use cardano/fuzz/address.{any_address, any_credential} as fuzz_address + +test prop_any_credential(c via any_credential()) { + label( + when c is { + Script(_) -> @"Script" + VerificationKey(_) -> @"VerificationKey" + }, + ) + True +} + +test prop_any_address(a via any_address()) { + label( + when a is { + Address { payment_credential: VerificationKey(_), stake_credential: None } -> + @"VerificationKey_NoStake" + Address { payment_credential: Script(_), stake_credential: None } -> + @"Script_NoStake" + Address { + payment_credential: VerificationKey(_), + stake_credential: Some(Inline(VerificationKey(_))), + } -> @"VerificationKey_InlineVerificationKey" + Address { + payment_credential: VerificationKey(_), + stake_credential: Some(Inline(Script(_))), + } -> @"VerificationKey_InlineScript" + Address { + payment_credential: Script(_), + stake_credential: Some(Inline(VerificationKey(_))), + } -> @"Script_InlineVerificationKey" + Address { + payment_credential: Script(_), + stake_credential: Some(Inline(Script(_))), + } -> @"Script_InlineScript" + _ -> fail @"Unexpected Address from any_address" + }, + ) + True +} diff --git a/lib/cardano/fuzz/assets.ak b/lib/cardano/fuzz/assets.ak new file mode 100644 index 0000000..ac106c0 --- /dev/null +++ b/lib/cardano/fuzz/assets.ak @@ -0,0 +1,107 @@ +use aiken/collection/list +use aiken/fuzz.{ + and_then, bytearray_between, constant, int_at_least, int_between, list_between, + map, +} +use cardano/assets.{AssetName, PolicyId, Value, ada_asset_name, ada_policy_id} + +pub fn any_asset_name() -> Fuzzer { + bytearray_between(0, 32) +} + +pub fn any_policy_id() -> Fuzzer { + bytearray_between(28, 28) +} + +pub fn any_ada_only_value() -> Fuzzer { + map(int_at_least(1), assets.from_lovelace) +} + +pub fn any_assets(policy_id: PolicyId, value: Value) -> Fuzzer { + let names <- and_then(list_between(any_asset_name(), 1, 3)) + list.foldr( + names, + constant(value), + fn(asset_name, step) { + let value <- and_then(step) + let quantity <- map(int_at_least(1)) + value |> assets.add(policy_id, asset_name, quantity) + }, + ) +} + +pub fn any_value_with(forced_policy_id: PolicyId) -> Fuzzer { + let value <- and_then(any_ada_only_value()) + let policies <- and_then(list_between(any_policy_id(), 0, 2)) + list.foldr( + [forced_policy_id, ..policies], + constant(value), + fn(policy_id, step) { + let value <- and_then(step) + any_assets(policy_id, value) + }, + ) +} + +pub fn any_value() -> Fuzzer { + let value <- and_then(any_ada_only_value()) + let policies <- and_then(list_between(any_policy_id(), 0, 2)) + list.foldr( + policies, + constant(value), + fn(policy_id, step) { + let value <- and_then(step) + any_assets(policy_id, value) + }, + ) +} + +pub fn any_value_extending(value: Value) -> Fuzzer { + let extra_lovelace <- and_then(int_at_least(1)) + let policies <- and_then(list_between(any_policy_id(), 0, 2)) + list.foldr( + policies, + constant(assets.add(value, ada_policy_id, ada_asset_name, extra_lovelace)), + fn(policy_id, step) { + let value <- and_then(step) + any_assets(policy_id, value) + }, + ) +} + +// Helper function to generate constrained assets for a single policy +fn any_constrained_assets( + policy_id: PolicyId, + asset_constraints: List>>, + initial_value: Value, +) -> Fuzzer { + list.foldr( + asset_constraints, + constant(initial_value), + fn(asset_constraint, step) { + let current_value <- and_then(step) + let asset_name = asset_constraint.1st + let min_quantity = asset_constraint.2nd.1st + let max_quantity = asset_constraint.2nd.2nd + let quantity <- map(int_between(min_quantity, max_quantity)) + current_value |> assets.add(policy_id, asset_name, quantity) + }, + ) +} + +// Updated any_constrained_value function using any_constrained_assets +pub fn any_constrained_value( + constraints: List>>>>, +) -> Fuzzer { + let base_value <- and_then(any_ada_only_value()) + list.foldr( + constraints, + constant(base_value), + fn(constraint, step) { + let value <- and_then(step) + let policy_id = constraint.1st + let asset_constraints = constraint.2nd + any_constrained_assets(policy_id, asset_constraints, value) + }, + ) +} diff --git a/lib/cardano/fuzz/assets.test.ak b/lib/cardano/fuzz/assets.test.ak new file mode 100644 index 0000000..6b2e1ba --- /dev/null +++ b/lib/cardano/fuzz/assets.test.ak @@ -0,0 +1,166 @@ +use aiken/collection/dict +use aiken/collection/list +use aiken/fuzz.{and_then, int_at_least, int_between, list_between, map} +use cardano/assets.{AssetName, PolicyId, Value} +use cardano/fuzz/assets.{ + any_asset_name, any_constrained_value, any_policy_id, any_value, + any_value_extending, any_value_with, +} as fuzz_assets + +fn help_prop_any_value_with() -> Fuzzer<(assets.PolicyId, assets.Value)> { + let policy <- and_then(any_policy_id()) + map(any_value_with(policy), fn(b) { (policy, b) }) +} + +test prop_any_value_with((policy, value) via help_prop_any_value_with()) { + assets.tokens(value, policy) != dict.empty +} + +fn help_prop_any_value_extending() -> Fuzzer<(assets.Value, assets.Value)> { + let v <- and_then(any_value()) + map(any_value_extending(v), fn(ve) { (v, ve) }) +} + +test prop_any_value_extending( + (value, value_extended) via help_prop_any_value_extending(), +) { + assets.reduce( + value, + True, + fn(p, a, i, r) { r && assets.quantity_of(value_extended, p, a) >= i }, + ) +} + +/// Helper function to generate asset constraints for a single policy +fn any_asset_constraint() -> Fuzzer>> { + let min_quantity <- and_then(int_at_least(0)) + let max_quantity <- and_then(int_between(min_quantity, min_quantity + 100)) + map(any_asset_name(), fn(a) { Pair(a, Pair(min_quantity, max_quantity)) }) +} + +/// Helper function to generate constraints for a single policy +fn any_policy_constraints() -> Fuzzer< + Pair>>>, +> { + let asset_constraints <- and_then(list_between(any_asset_constraint(), 1, 10)) + map(any_policy_id(), fn(p) { Pair(p, asset_constraints) }) +} + +/// Helper function to generate a list of policy constraints +fn any_constraints() -> Fuzzer< + List>>>>, +> { + list_between(any_policy_constraints(), 1, 5) +} + +/// Fuzzer to generate constraints along with a constrained value +fn help_prop_any_constrained_value() -> Fuzzer< + Pair>>>>, Value>, +> { + let constraints <- and_then(any_constraints()) + let merged = merge_policy_constraints(constraints) + let a_c_v = any_constrained_value(merged) + map(a_c_v, fn(v) { Pair(merged, v) }) +} + +/// +/// Function to merge multiple constraints for the same asset within the same policy +fn merge_asset_constraints( + asset_constraints: List>>, +) -> List>> { + let grouped = + list.foldr( + asset_constraints, + dict.empty, + fn(pair, acc) { + let Pair(asset_name, Pair(min, max)) = pair + when dict.pop(acc, asset_name) is { + (Some(Pair(existing_min, existing_max)), acc) -> { + let new_min = + if min < existing_min { + min + } else { + existing_min + } + let new_max = + if max > existing_max { + max + } else { + existing_max + } + dict.insert(acc, asset_name, Pair(new_min, new_max)) + } + (None, acc) -> dict.insert(acc, asset_name, Pair(min, max)) + } + }, + ) + dict.to_pairs(grouped) +} + +/// Function to merge multiple PolicyIds and their asset constraints into unique PolicyIds with merged asset constraints +fn merge_policy_constraints( + constraints: List>>>>, +) -> List>>>> { + // Group all asset constraints by PolicyId + let grouped_policies = + list.foldr( + constraints, + dict.empty, + fn(pair, acc) { + let Pair(policy_id, asset_constraints) = pair + when dict.pop(acc, policy_id) is { + (Some(existing_constraints), acc) -> + dict.insert( + acc, + policy_id, + list.concat(asset_constraints, existing_constraints), + ) + (None, acc) -> dict.insert(acc, policy_id, asset_constraints) + } + }, + ) + + // For each PolicyId, merge its asset constraints + // let l_acc: List>>>> = [] + let merged_policies = + dict.foldr( + grouped_policies, + [], + fn(policy_id, asset_constraints, acc) { + let merged_assets = merge_asset_constraints(asset_constraints) + list.push(acc, Pair(policy_id, merged_assets)) + }, + ) + merged_policies +} + +/// +fn verify_constraints( + constraints: List>>>>, + value: Value, +) -> Bool { + list.all( + constraints, + fn(constraint) { + let Pair(policy_id, asset_constraints) = constraint + let tokens = assets.tokens(value, policy_id) + list.all( + asset_constraints, + fn(asset_constraint) { + let Pair(asset_name, Pair(min, max)) = asset_constraint + when dict.get(tokens, asset_name) is { + Some(quantity) -> quantity >= min && quantity <= max + None -> min <= 0 + } + }, + ) + }, + ) +} + +test prop_any_constrained_value( + Pair(constraints, value) via help_prop_any_constrained_value(), +) { + // Assert that all constraints are satisfied + verify_constraints(constraints, value) +} diff --git a/lib/cardano/fuzz/certificate.ak b/lib/cardano/fuzz/certificate.ak new file mode 100644 index 0000000..1ca3fca --- /dev/null +++ b/lib/cardano/fuzz/certificate.ak @@ -0,0 +1,127 @@ +use aiken/fuzz.{ + and_then, bytearray_between, constant, int, int_between, map, map2, map3, +} +use cardano/certificate.{ + AlwaysAbstain, AlwaysNoConfidence, AuthorizeConstitutionalCommitteeProxy, + Certificate, Delegate, DelegateBlockProduction, DelegateBoth, + DelegateCredential, DelegateRepresentative, DelegateVote, + RegisterAndDelegateCredential, RegisterCredential, + RegisterDelegateRepresentative, RegisterStakePool, Registered, + RetireFromConstitutionalCommittee, RetireStakePool, UnregisterCredential, + UnregisterDelegateRepresentative, UpdateDelegateRepresentative, +} +use cardano/fuzz/address.{any_credential} + +pub fn any_certificate() -> Fuzzer { + let choice <- and_then(int_between(0, 10)) + when choice is { + 0 -> any_register_cert() + 1 -> any_unregister_cert() + 2 -> any_delegate_cert() + 3 -> any_reg_and_delegate_cert() + 4 -> any_register_drep_cert() + 5 -> any_update_drep_cert() + 6 -> any_unregister_drep_cert() + 7 -> any_register_pool_cert() + 8 -> any_retire_pool_cert() + 9 -> any_authorize_cc_cert() + 10 -> any_retire_cc_cert() + _ -> fail @"Fail" + } +} + +pub fn any_register_cert() -> Fuzzer { + map( + any_credential(), + fn(credential) { RegisterCredential(credential, Never) }, + ) +} + +pub fn any_unregister_cert() -> Fuzzer { + map( + any_credential(), + fn(credential) { UnregisterCredential(credential, Never) }, + ) +} + +pub fn any_delegate_cert() -> Fuzzer { + map2(any_credential(), any_delegate(), fn(c, d) { DelegateCredential(c, d) }) +} + +pub fn any_reg_and_delegate_cert() -> Fuzzer { + map3( + any_credential(), + any_delegate(), + int(), + fn(c, d, i) { RegisterAndDelegateCredential(c, d, i) }, + ) +} + +pub fn any_register_drep_cert() -> Fuzzer { + map2( + any_credential(), + int(), + fn(c, i) { RegisterDelegateRepresentative(c, i) }, + ) +} + +pub fn any_update_drep_cert() -> Fuzzer { + map(any_credential(), fn(c) { UpdateDelegateRepresentative(c) }) +} + +pub fn any_unregister_drep_cert() -> Fuzzer { + map2( + any_credential(), + int(), + fn(c, i) { UnregisterDelegateRepresentative(c, i) }, + ) +} + +pub fn any_register_pool_cert() -> Fuzzer { + map2( + bytearray_between(32, 32), + bytearray_between(32, 32), + fn(b, b2) { RegisterStakePool(b, b2) }, + ) +} + +pub fn any_retire_pool_cert() -> Fuzzer { + map2(bytearray_between(32, 32), int(), fn(b, i) { RetireStakePool(b, i) }) +} + +pub fn any_authorize_cc_cert() -> Fuzzer { + map2( + any_credential(), + any_credential(), + fn(c, c2) { AuthorizeConstitutionalCommitteeProxy(c, c2) }, + ) +} + +pub fn any_retire_cc_cert() -> Fuzzer { + map(any_credential(), fn(c) { RetireFromConstitutionalCommittee(c) }) +} + +pub fn any_delegate() -> Fuzzer { + let choice <- and_then(int_between(0, 2)) + when choice is { + 0 -> map(bytearray_between(32, 32), fn(b) { DelegateBlockProduction(b) }) + 1 -> map(any_drep(), fn(drep) { DelegateVote(drep) }) + 2 -> + map2( + bytearray_between(32, 32), + any_drep(), + fn(b, drep) { DelegateBoth(b, drep) }, + ) + _ -> fail + } +} + +pub fn any_drep() -> Fuzzer { + let choice <- and_then(int_between(0, 2)) + when choice is { + 0 -> map(any_credential(), fn(c) { Registered(c) }) + 1 -> constant(AlwaysAbstain) + 2 -> constant(AlwaysNoConfidence) + _ -> fail + } +} diff --git a/lib/cardano/fuzz/certificate.test.ak b/lib/cardano/fuzz/certificate.test.ak new file mode 100644 index 0000000..ec9adc5 --- /dev/null +++ b/lib/cardano/fuzz/certificate.test.ak @@ -0,0 +1,57 @@ +use aiken/fuzz.{label} +use cardano/certificate.{ + AlwaysAbstain, AlwaysNoConfidence, AuthorizeConstitutionalCommitteeProxy, + DelegateBlockProduction, DelegateBoth, DelegateCredential, DelegateVote, + RegisterAndDelegateCredential, RegisterCredential, + RegisterDelegateRepresentative, RegisterStakePool, Registered, + RetireFromConstitutionalCommittee, RetireStakePool, UnregisterCredential, + UnregisterDelegateRepresentative, UpdateDelegateRepresentative, +} +use cardano/fuzz/certificate.{any_certificate, + any_delegate, any_drep} as fuzz_cert + +test prop_any_certificate(c via any_certificate()) { + label( + when c is { + RegisterCredential(_, _) -> @"RegisterCredential" + UnregisterCredential(_, _) -> @"UnregisterCredential" + DelegateCredential(_, _) -> @"DelegateCredential" + RegisterAndDelegateCredential(_, _, _) -> @"RegisterAndDelegateCredential" + RegisterDelegateRepresentative(_, _) -> @"RegisterDelegateRepresentative" + UpdateDelegateRepresentative(_) -> @"UpdateDelegateRepresentative" + UnregisterDelegateRepresentative(_, _) -> + @"UnregisterDelegateRepresentative" + RegisterStakePool(_, _) -> @"RegisterStakePool" + RetireStakePool(_, _) -> @"RetireStakePool" + AuthorizeConstitutionalCommitteeProxy(_, _) -> + @"AuthorizeConstitutionalCommitteeProxy" + RetireFromConstitutionalCommittee(_) -> + @"RetireFromConstitutionalCommittee" + }, + ) + True +} + +/// Test for any_delegate generator +test prop_any_delegate(d via any_delegate()) { + label( + when d is { + DelegateBlockProduction(_) -> @"DelegateBlockProduction" + DelegateVote(_) -> @"DelegateVote" + DelegateBoth(_, _) -> @"DelegateBoth" + }, + ) + True +} + +/// Test for any_drep (DelegateRepresentative) generator +test prop_any_drep(drep via any_drep()) { + label( + when drep is { + Registered(_) -> @"Registered" + AlwaysAbstain -> @"AlwaysAbstain" + AlwaysNoConfidence -> @"AlwaysNoConfidence" + }, + ) + True +} diff --git a/lib/cardano/fuzz/script_context.ak b/lib/cardano/fuzz/script_context.ak new file mode 100644 index 0000000..c193145 --- /dev/null +++ b/lib/cardano/fuzz/script_context.ak @@ -0,0 +1,11 @@ +use aiken/fuzz.{map3} +use cardano/script_context.{ScriptContext, ScriptInfo} +use cardano/transaction.{Redeemer, Transaction} + +pub fn constrained_script_context( + tx: Fuzzer, + rdmr: Fuzzer, + info: Fuzzer, +) -> Fuzzer { + map3(tx, rdmr, info, fn(t, r, i) { ScriptContext(t, r, i) }) +} diff --git a/lib/cardano/fuzz/transaction.ak b/lib/cardano/fuzz/transaction.ak new file mode 100644 index 0000000..9c1661b --- /dev/null +++ b/lib/cardano/fuzz/transaction.ak @@ -0,0 +1,396 @@ +use aiken/collection/dict +use aiken/collection/list +use aiken/crypto.{ScriptHash, VerificationKeyHash} +use aiken/fuzz.{ + and_then, bytearray_between, constant, int, int_between, list_between, map, + map2, map7, option, +} +use aiken/interval +use cardano/address.{Credential} +use cardano/address/credential +use cardano/assets.{ + AssetName, Lovelace, PolicyId, Value, ada_asset_name, ada_policy_id, +} +use cardano/certificate.{Certificate} +use cardano/fuzz/address.{any_address, any_credential} as fuzz_address +use cardano/fuzz/assets.{any_constrained_value, any_value} as fuzz_assets +use cardano/transaction.{ + Datum, DatumHash, InlineDatum, Input, NoDatum, Output, OutputReference, + Transaction, +} + +// > [!IMPORTANT] +// The following fields on the transaction are not handled within our library. +// redeemers: Pairs, +// datums: Dict, +// id: TransactionId, +// votes: Pairs>, +// proposal_procedures: List, +// current_treasury_amount: Option, +// treasury_donation: Option, + +pub fn any_datum() -> Fuzzer { + let variant <- and_then(int_between(0, 2)) + when variant is { + 0 -> constant(NoDatum) + 1 -> { + let hash <- map(bytearray_between(32, 32)) + DatumHash(hash) + } + 2 -> { + let i <- map(int()) + InlineDatum(i) + } + _ -> fail @"unexpected datum variant" + } +} + +pub fn any_reference_script() -> Fuzzer> { + option(bytearray_between(28, 28)) +} + +pub fn any_output() -> Fuzzer { + let address <- and_then(any_address()) + let value <- and_then(any_value()) + let datum <- and_then(any_datum()) + let reference_script <- map(any_reference_script()) + Output { address, value, datum, reference_script } +} + +pub fn any_zero_output() -> Fuzzer { + let address <- and_then(any_address()) + let datum <- and_then(any_datum()) + let reference_script <- map(any_reference_script()) + Output { address, value: assets.zero, datum, reference_script } +} + +// The any_constrained_output function remains the same +pub fn any_constrained_output( + constraints: List>>>>, + datum: Fuzzer, +) -> Fuzzer { + let address <- and_then(any_address()) + let value <- and_then(any_constrained_value(constraints)) + let datum <- and_then(datum) + let reference_script <- map(any_reference_script()) + Output { address, value, datum, reference_script } +} + +pub fn any_constrained_outputs( + constraints: List>>>>, + datum: Fuzzer, + min_outs: Int, + max_outs: Int, +) -> Fuzzer> { + let non_normalized <- + and_then(list_between(int_between(1, 100), min_outs, max_outs)) + let sum_nn = list.foldr(non_normalized, 0, fn(e, acc) { acc + e }) + let normalized = list.map(non_normalized, fn(e) { 100 * e / sum_nn }) + list.foldr( + normalized, + constant([]), + fn(e, acc) { + let sub_constraints = + list.map( + constraints, + fn(constraint) { + let Pair(policy_id, asset_constraints) = constraint + let updated_asset_constraints = + list.map( + asset_constraints, + fn(asset_constraint) { + let Pair(asset_name, Pair(min, max)) = asset_constraint + let sub_min = min * e / 100 + let sub_max = max * e / 100 + Pair(asset_name, Pair(sub_min, sub_max)) + }, + ) + Pair(policy_id, updated_asset_constraints) + }, + ) + map2( + any_constrained_output(sub_constraints, datum), + acc, + fn(no, a) { [no, ..a] }, + ) + }, + ) +} + +pub fn any_output_reference() -> Fuzzer { + let transaction_id <- and_then(bytearray_between(32, 32)) + let output_index <- map(int_between(0, 300)) + OutputReference { transaction_id, output_index } +} + +pub fn any_input() -> Fuzzer { + let output_reference <- and_then(any_output_reference()) + let output <- map(any_output()) + Input { output_reference, output } +} + +pub fn any_constrained_input( + constraints: List>>>>, + datum: Fuzzer, +) -> Fuzzer { + let output_reference <- and_then(any_output_reference()) + let output <- map(any_constrained_output(constraints, datum)) + Input { output_reference, output } +} + +/// Generate Withdrawals +pub fn any_withdrawals() -> Fuzzer> { + map( + list_between( + map2( + any_credential(), + int_between(0, 200000000000), + fn(c, i) { + let l: Lovelace = i + Pair(c, l) + }, + ), + 0, + 5, + ), + fn(l) { + let ps: Pairs = + list.sort(l, fn(e1, e2) { credential.compare(e1.1st, e2.1st) }) + ps + }, + ) +} + +pub fn any_withdrawals_extending( + with: Pairs, +) -> Fuzzer> { + map( + any_withdrawals(), + fn(w) { + list.sort( + list.concat(w, with), + fn(e1, e2) { credential.compare(e1.1st, e2.1st) }, + ) + }, + ) +} + +// Transaction stuffz + +pub fn add_fuzz_input( + self: Transaction, + input: Fuzzer, +) -> Fuzzer { + map( + input, + fn(in) { Transaction { ..self, inputs: [in, ..self.reference_inputs] } }, + ) +} + +pub fn add_fuzz_inputs( + self: Transaction, + ins: Fuzzer>, +) -> Fuzzer { + map( + ins, + fn(ins) { Transaction { ..self, inputs: list.concat(ins, self.inputs) } }, + ) +} + +pub fn add_fuzz_ref_input( + self: Transaction, + input: Fuzzer, +) -> Fuzzer { + map( + input, + fn(in) { + Transaction { ..self, reference_inputs: [in, ..self.reference_inputs] } + }, + ) +} + +pub fn add_fuzz_ref_inputs( + self: Transaction, + inputs: Fuzzer>, +) -> Fuzzer { + map( + inputs, + fn(ins) { + Transaction { + ..self, + reference_inputs: list.concat(ins, self.reference_inputs), + } + }, + ) +} + +pub fn add_fuzz_output( + self: Transaction, + output: Fuzzer, +) -> Fuzzer { + map( + output, + fn(out) { Transaction { ..self, outputs: [out, ..self.outputs] } }, + ) +} + +pub fn add_fuzz_outputs( + self: Transaction, + outs: Fuzzer>, +) -> Fuzzer { + map( + outs, + fn(os) { Transaction { ..self, outputs: list.concat(os, self.outputs) } }, + ) +} + +pub fn add_fuzz_mint( + self: Transaction, + mint: Fuzzer, +) -> Fuzzer { + map(mint, fn(m) { Transaction { ..self, mint: m } }) +} + +pub fn add_fuzz_cert( + self: Transaction, + cert: Fuzzer, +) -> Fuzzer { + map( + cert, + fn(c) { Transaction { ..self, certificates: [c, ..self.certificates] } }, + ) +} + +pub fn add_fuzz_withdrawals( + self: Transaction, + withdraws: Fuzzer>, +) -> Fuzzer { + map( + withdraws, + fn(w) { + Transaction { ..self, withdrawals: list.concat(w, self.withdrawals) } + }, + ) +} + +pub fn add_fuzz_signers( + self: Transaction, + signers: Fuzzer>, +) -> Fuzzer { + map( + signers, + fn(s) { + Transaction { + ..self, + extra_signatories: list.concat(s, self.extra_signatories), + } + }, + ) +} + +pub fn base_tx() -> Transaction { + Transaction( + [], + [], + [], + 0, + assets.zero, + [], + [], + interval.empty, + [], + [], + dict.empty, + #"", + [], + [], + None, + None, + ) +} + +pub fn any_generic_tx() -> Fuzzer { + let tx = base_tx() + let tx <- fuzz.and_then(add_fuzz_inputs(tx, fuzz.list(any_input()))) + add_fuzz_outputs(tx, fuzz.list(any_output())) +} + +// TODO - Rewrite this handling separate parts of the tx separately. +// We also need to add test(s) for this. +/// > [!IMPORTANT] +/// This function does not consider certificates. +/// It only pays attention to withdrawals, inputs, +/// outputs, and the current fee. +pub fn balance_tx(self: Transaction) -> Fuzzer { + let Transaction { inputs, withdrawals, outputs, fee, .. } = self + let input_total = + list.foldr( + inputs, + assets.zero, + fn(in, v) { assets.merge(in.output.value, v) }, + ) + let withdrawals_total = + list.foldr( + withdrawals, + 0, + fn(p, acc) { + let Pair(_, i) = p + acc + i + }, + ) + let total_in = + assets.add( + input_total, + ada_policy_id, + ada_asset_name, + fee + withdrawals_total, + ) + let output_total = + list.foldr(outputs, assets.zero, fn(out, v) { assets.merge(out.value, v) }) + let added_input_value = + assets.reduce( + output_total, + assets.zero, + fn(p, a, i, r) { + let res = i - assets.quantity_of(total_in, p, a) + if res > 0 { + assets.add(r, p, a, res) + } else { + r + } + }, + ) + |> assets.add(ada_policy_id, ada_asset_name, 1) + let added_output_value = + assets.reduce( + total_in, + assets.zero, + fn(p, a, i, r) { + let res = i - assets.quantity_of(output_total, p, a) + if res > 0 { + assets.add(r, p, a, res) + } else { + r + } + }, + ) + |> assets.add(ada_policy_id, ada_asset_name, 1) + map7( + any_output_reference(), + any_address(), + any_address(), + any_datum(), + any_datum(), + any_reference_script(), + any_reference_script(), + fn(o_ref, a1, a2, d1, d2, r1, r2) { + let new_input = Input(o_ref, Output(a1, added_input_value, d1, r1)) + let new_output = Output(a2, added_output_value, d2, r2) + Transaction { + ..self, + inputs: [new_input, ..self.inputs], + outputs: [new_output, ..self.outputs], + } + }, + ) +} From a54adb864f3290d2c88f2b019319471385edb203 Mon Sep 17 00:00:00 2001 From: Riley-Kilgore Date: Wed, 11 Dec 2024 09:18:47 -0800 Subject: [PATCH 2/2] Adjusted Changelog --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 950cb4b..c506330 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -6,6 +6,7 @@ - [`aiken/cbor.{deserialise}`](https://aiken-lang.github.io/stdlib/aiken/cbor.html#deserialise): to recover `Data` from CBOR bytes. - [`aiken/collection/pairs.{insert_with_by_ascending_key}`](https://aiken-lang.github.io/stdlib/aiken/collection/pairs.html#insert_with_by_ascending_key): for inserting in pairs while specifying how to combine values on key conflict. +- Added `aiken/fuzz` and `cardano/fuzz` to stdlib, adds ScaledFuzzers and requires Aiken v1.1.8. ## v2.1.0 - 2024-09-14