{-# LANGUAGE OverloadedStrings #-}

{- | Threat model for detecting Large Data Attack vulnerabilities.

A Large Data Attack exploits permissive @FromData@ parsers in Plutus validators
that ignore extra members when deserializing @Constr@, @List@ or @Map@ data.
If a validator's datum parser only reads the members it expects and ignores
additional ones, an attacker can "bloat" the datum with extra members while
preserving the validator's interpretation.

== Consequences ==

1. __Increased execution costs__: Processing bloated datums wastes CPU/memory
   execution units, making transactions more expensive.

2. __Permanent fund locking__: If the datum is bloated sufficiently:

   - Deserializing the datum may exceed execution unit limits
   - The transaction required to spend the UTxO may exceed protocol size limits

   In these cases, the UTxO becomes __permanently unspendable__ and funds
   are locked forever with no possibility of recovery.

== Root Cause ==

'unstableMakeIsData' and 'makeIsDataIndexed' generate parsers that use
wildcard patterns for constructor fields:

@
case (index, args) of
  (0, _) -> MyConstructor  -- The "_" ignores ALL extra fields!
@

This means @Constr 0 []@ and @Constr 0 [junk1, junk2, ..., junk10000]@ both
parse to the same value, allowing attackers to inject arbitrary data.

The same hole exists in the other two container shapes. A list-encoded datum
is a @List@ rather than a @Constr@ on-chain: a parser that takes the elements
it expects off the front of the list (@pasList@ plus positional access)
ignores every element after them, so @List [a, b]@ and
@List [a, b, junk1, ..., junk10000]@ also parse to the same value. A @Map@
datum is read by key, and @PlutusTx.AssocMap.lookup@ returns the first
matching entry, so appending entries under unused keys leaves every lookup
answering exactly as it did before.

== Mitigation ==

A secure validator should either:

- Use strict manual @FromData@ instances that check field count exactly
- Validate the datum hash matches an expected value
- Check datum structure explicitly in the validator logic

This threat model tests if a script output with an inline datum still validates
when additional members are appended to the datum's container structure (see
'bloatData'). If it does, the validator has a Large Data Attack
vulnerability. A datum that is a bare atom has nothing to append to, so the
attack is skipped as a failed precondition rather than asserting against an
unmodified transaction.
-}
module Convex.ThreatModel.LargeData (
  largeDataAttack,
  largeDataAttackWith,
  largeDataAttackWithGen,
  bloatData,
) where

import Convex.ThreatModel
import Data.ByteString qualified as BS
import Data.List (minimumBy)
import Data.Maybe (mapMaybe)
import Data.Ord (comparing)
import Test.QuickCheck (Gen, choose)

{- | Default large-data attack. The number of injected fields is drawn per
transaction from a curated range, so QuickCheck explores the parameter space
and shrinks counterexamples toward the smallest triggering value.
-}
largeDataAttack :: ThreatModel ()
largeDataAttack :: ThreatModel ()
largeDataAttack = Gen Int -> ThreatModel ()
largeDataAttackWithGen ((Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
1, Int
1000))

{- | Large-data attack with a fixed field count. Keep using this for
deterministic regression tests and golden seeds.
-}
largeDataAttackWith :: Int -> ThreatModel ()
largeDataAttackWith :: Int -> ThreatModel ()
largeDataAttackWith = Gen Int -> ThreatModel ()
largeDataAttackWithGen (Gen Int -> ThreatModel ())
-> (Int -> Gen Int) -> Int -> ThreatModel ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Gen Int
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

{- | Large-data attack parameterised by a generator for the number of extra
members injected into the target inline datum. This is the primitive the
other two forms delegate to.
-}
largeDataAttackWithGen :: Gen Int -> ThreatModel ()
largeDataAttackWithGen :: Gen Int -> ThreatModel ()
largeDataAttackWithGen Gen Int
fieldsGen =
  [Char] -> ThreatModel () -> ThreatModel ()
forall a. [Char] -> ThreatModel a -> ThreatModel a
Named [Char]
"Large Data Attack" (ThreatModel () -> ThreatModel ())
-> ThreatModel () -> ThreatModel ()
forall a b. (a -> b) -> a -> b
$ do
    Int
n <- Gen Int -> (Int -> [Int]) -> ThreatModel Int
forall a. Show a => Gen a -> (a -> [a]) -> ThreatModel a
forAllTM Gen Int
fieldsGen Int -> [Int]
shrinkPositive

    -- Skip iterations where the draw is too small to be a meaningful attack.
    Bool -> ThreatModel ()
ensure (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1)

    (Output
target, ScriptData
originalDatum) <- ThreatModel (Output, ScriptData)
anyGuardedOutputWithInlineDatum

    let bloatedDatum :: ScriptData
bloatedDatum = Int -> ScriptData -> ScriptData
bloatData Int
n ScriptData
originalDatum

    {- A datum shape 'bloatData' cannot grow - today an atom, which has no
    members to append to - would leave the transaction byte-for-byte
    unchanged. Asserting 'shouldNotValidate' on an untouched transaction is
    vacuous: that transaction comes from a passing positive test, so it
    validates, and the attack would report a "vulnerability" for every
    contract whose datum it never actually bloated. Compare the result rather
    than enumerating the shapes here, so a shape 'bloatData' stops handling
    cannot reintroduce that. -}
    if ScriptData
bloatedDatum ScriptData -> ScriptData -> Bool
forall a. Eq a => a -> a -> Bool
== ScriptData
originalDatum
      then
        [Char] -> ThreatModel ()
forall a. [Char] -> ThreatModel a
failPrecondition ([Char] -> ThreatModel ()) -> [Char] -> ThreatModel ()
forall a b. (a -> b) -> a -> b
$
          [[Char]] -> [Char]
unwords
            [ [Char]
"Large data attack cannot bloat a"
            , ScriptData -> [Char]
datumShape ScriptData
originalDatum
            , [Char]
"datum: the modification would be a no-op"
            ]
      else () -> ThreatModel ()
forall a. a -> ThreatModel a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

    [Char] -> ThreatModel ()
counterexampleTM ([Char] -> ThreatModel ()) -> [Char] -> ThreatModel ()
forall a b. (a -> b) -> a -> b
$
      [[Char]] -> [Char]
paragraph
        [ [Char]
"Injecting " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n
        , [Char]
"extra members into the inline datum of output"
        , TxIx -> [Char]
forall a. Show a => a -> [Char]
show (Output -> TxIx
outputIx Output
target)
        , [Char]
"and asserting the transaction no longer validates."
        ]
    [Char] -> [[Char]] -> ThreatModel ()
tabulateTM [Char]
"fields injected" [Int -> [Char]
bucket Int
n]

    -- Try to validate with the bloated datum
    TxModifier -> ThreatModel ()
shouldNotValidate (TxModifier -> ThreatModel ()) -> TxModifier -> ThreatModel ()
forall a b. (a -> b) -> a -> b
$ Output -> Datum -> TxModifier
forall t. IsInputOrOutput t => t -> Datum -> TxModifier
changeDatumOf Output
target (ScriptData -> Datum
toInlineDatum ScriptData
bloatedDatum)

{- | Shrink a positive integer toward 1 (the smallest meaningful value),
never reaching 0.
-}

-- | Coarse bucket for the parameter distribution report.
bucket :: Int -> String
bucket :: Int -> [Char]
bucket Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
10 = [Char]
"001-010"
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
100 = [Char]
"011-100"
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
500 = [Char]
"101-500"
  | Bool
otherwise = [Char]
"501-1000"

{- | Bloat a @ScriptData@ value by appending @n@ extra members to it.

Every container shape is handled, because each one is read on-chain by a
parser that can ignore trailing members:

- @ScriptDataConstructor idx fields@ - what 'unstableMakeIsData' and
  'makeIsDataIndexed' produce, parsed via @Constr@ pattern matching. The junk
  fields are @ScriptDataNumber 42@: a generated parser either matches a
  fixed-length prefix and ignores the rest, or matches the exact field list
  and fails, so the junk's type cannot change the verdict (and a record's
  fields are heterogeneous, so there is no "matching" type to mirror).
- @ScriptDataList xs@ - what a homogeneous list datum produces, and what a
  list-encoded record produces (e.g. plutus-tx's @makeIsDataAsList@, or an
  Aiken type declared as a list), parsed via @pasList@ plus element access. A
  parser that reads the first /k/ elements ignores every element after them.
- @ScriptDataMap kvs@ - parsed via @pasMap@ plus key lookup. Appending
  entries whose keys do not already occur preserves every existing lookup,
  because @PlutusTx.AssocMap.lookup@ returns the /first/ match and neither
  @FromData@ nor @UnsafeFromData@ for @Map@ validates key uniqueness,
  ordering, or size.

For a list or a map the junk is derived from what is already there - a
member of the list, or an existing value under a fresh key of the same shape
as the existing keys (see 'junkMemberLike' and 'junkEntriesFor'). That
matters because the two parser flavours walk a different distance: the
permissive @UnsafeFromData@ instance builds its list lazily, so junk past the
member being read is never even forced, but the strict @FromData@ instance
traverses every member and yields @Nothing@ if one fails to parse - which
would make the validator reject the datum outright and have the attack report
a /secure/ contract for the wrong reason. Junk shaped like a member already
in the datum parses by construction.

The mirroring only pays off where the container is homogeneous - a
@[ByteString]@, a @Map PubKeyHash Integer@ - which is where the strict
instance is @FromData [a]@ or @FromData (Map k v)@ and does traverse
everything. A list encoding a heterogeneous record (@makeIsDataAsList@) is
read positionally like a @Constr@ instead: a fixed-length pattern rejects any
appended member whatever its type, and a prefix pattern never forces one, so
no choice of junk changes that verdict. Mirroring is never worse than a
constant, so both cases take the same path. (An empty list or map gives
nothing to mirror, so the junk falls back to @ScriptDataNumber 42@ and a
strict parser expecting some other member type will reject it.)

The atoms @ScriptDataNumber@ and @ScriptDataBytes@ are returned unchanged -
they have no members to append to. 'largeDataAttackWithGen' fails its
precondition on an unchanged result, so those shapes are reported as skipped
rather than silently asserted against an untouched transaction.
-}
bloatData :: Int -> ScriptData -> ScriptData
bloatData :: Int -> ScriptData -> ScriptData
bloatData Int
n ScriptData
sd = case ScriptData
sd of
  ScriptDataConstructor Integer
idx [ScriptData]
fields ->
    Integer -> [ScriptData] -> ScriptData
ScriptDataConstructor Integer
idx ([ScriptData]
fields [ScriptData] -> [ScriptData] -> [ScriptData]
forall a. [a] -> [a] -> [a]
++ Int -> ScriptData -> [ScriptData]
forall a. Int -> a -> [a]
replicate Int
n (Integer -> ScriptData
ScriptDataNumber Integer
42))
  ScriptDataList [ScriptData]
xs ->
    [ScriptData] -> ScriptData
ScriptDataList ([ScriptData]
xs [ScriptData] -> [ScriptData] -> [ScriptData]
forall a. [a] -> [a] -> [a]
++ Int -> ScriptData -> [ScriptData]
forall a. Int -> a -> [a]
replicate Int
n ([ScriptData] -> ScriptData
junkMemberLike [ScriptData]
xs))
  ScriptDataMap [(ScriptData, ScriptData)]
kvs ->
    [(ScriptData, ScriptData)] -> ScriptData
ScriptDataMap ([(ScriptData, ScriptData)]
kvs [(ScriptData, ScriptData)]
-> [(ScriptData, ScriptData)] -> [(ScriptData, ScriptData)]
forall a. [a] -> [a] -> [a]
++ Int -> [(ScriptData, ScriptData)] -> [(ScriptData, ScriptData)]
forall a. Int -> [a] -> [a]
take Int
n ([(ScriptData, ScriptData)] -> [(ScriptData, ScriptData)]
junkEntriesFor [(ScriptData, ScriptData)]
kvs))
  -- Atoms: nothing to append to, return unchanged
  ScriptData
_ -> ScriptData
sd

{- | Junk member for a list or a map, derived from the members already there
so that it parses as their type by construction (see 'bloatData').

Two refinements on "copy a member":

- The /smallest/ member is copied, not the first. The junk is replicated up
  to 'largeDataAttack''s 1000 times, so copying a large member could push the
  rebuilt transaction past @maxTxSize@ or the output under its min-UTxO
  deposit. That comes back as a Phase 1 skip, which is only a warning - a
  vulnerable contract would quietly go unreported.
- A member bigger than 'junkSizeBudget' is shrunk rather than copied whole: a
  byte string is truncated and a number replaced outright, both staying the
  same 'ScriptData' shape, so they still parse as the member type while
  making the junk's size independent of the datum's. A container has no such
  safe shrink - dropping its members can break a strict parser for /its/
  type - so a large container member is still copied as is.
-}
junkMemberLike :: [ScriptData] -> ScriptData
junkMemberLike :: [ScriptData] -> ScriptData
junkMemberLike [] = Integer -> ScriptData
ScriptDataNumber Integer
42
junkMemberLike [ScriptData]
xs
  | Int
smallestSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
junkSizeBudget = ScriptData
smallest
  | Bool
otherwise = ScriptData -> ScriptData
shrink ScriptData
smallest
 where
  -- Decorated, so each member is walked once rather than once per comparison.
  (Int
smallestSize, ScriptData
smallest) = ((Int, ScriptData) -> (Int, ScriptData) -> Ordering)
-> [(Int, ScriptData)] -> (Int, ScriptData)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy (((Int, ScriptData) -> Int)
-> (Int, ScriptData) -> (Int, ScriptData) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Int, ScriptData) -> Int
forall a b. (a, b) -> a
fst) [(ScriptData -> Int
dataSize ScriptData
x, ScriptData
x) | ScriptData
x <- [ScriptData]
xs]
  shrink :: ScriptData -> ScriptData
shrink (ScriptDataBytes ByteString
bs) = ByteString -> ScriptData
ScriptDataBytes (Int -> ByteString -> ByteString
BS.take Int
junkSizeBudget ByteString
bs)
  shrink (ScriptDataNumber Integer
_) = Integer -> ScriptData
ScriptDataNumber Integer
42
  shrink ScriptData
other = ScriptData
other

{- | Size at which a mirrored member is shrunk instead of copied. Small
enough that 1000 copies stay well inside @maxTxSize@, large enough that an
ordinary member (a hash, a small number) is mirrored verbatim.
-}
junkSizeBudget :: Int
junkSizeBudget :: Int
junkSizeBudget = Int
8

-- | Rough serialised size of a datum, to compare members by.
dataSize :: ScriptData -> Int
dataSize :: ScriptData -> Int
dataSize ScriptData
sd = case ScriptData
sd of
  ScriptDataNumber Integer
_ -> Int
1
  ScriptDataBytes ByteString
bs -> Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteString -> Int
BS.length ByteString
bs
  ScriptDataList [ScriptData]
xs -> Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((ScriptData -> Int) -> [ScriptData] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ScriptData -> Int
dataSize [ScriptData]
xs)
  ScriptDataConstructor Integer
_ [ScriptData]
fields -> Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((ScriptData -> Int) -> [ScriptData] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ScriptData -> Int
dataSize [ScriptData]
fields)
  ScriptDataMap [(ScriptData, ScriptData)]
kvs -> Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [ScriptData -> Int
dataSize ScriptData
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ScriptData -> Int
dataSize ScriptData
v | (ScriptData
k, ScriptData
v) <- [(ScriptData, ScriptData)]
kvs]

{- | An unbounded supply of junk map entries whose keys do not already occur
in the map and have the same shape as the keys that do - both properties are
needed: a colliding key could change what an existing lookup answers, and a
key of the wrong shape makes a strict @FromData@ reject the whole datum (see
'bloatData').

A fresh key is the first existing key with one leaf perturbed past every leaf
of its kind anywhere in the key list: larger, for a number, or longer, for a
byte string. Such a key cannot equal an existing one, because that key either
has a different structure at the perturbed position or a smaller (shorter)
leaf there. Perturbing a leaf of a copied key - rather than minting a key of
some shape of our own - is what keeps the shape parseable for a key type of
any shape, including a @Constr@ (e.g. @Map AssetClass Integer@) or a nested
container.

A key built entirely from empty containers has no leaf to perturb, and no
type-correct fresh key can be derived from it; the empty result then leaves
the datum unchanged, which 'largeDataAttackWithGen' reports as a skip rather
than asserting against an untouched transaction.
-}
junkEntriesFor :: [(ScriptData, ScriptData)] -> [(ScriptData, ScriptData)]
junkEntriesFor :: [(ScriptData, ScriptData)] -> [(ScriptData, ScriptData)]
junkEntriesFor [(ScriptData, ScriptData)]
kvs = (ScriptData -> (ScriptData, ScriptData))
-> [ScriptData] -> [(ScriptData, ScriptData)]
forall a b. (a -> b) -> [a] -> [b]
map (\ScriptData
k -> (ScriptData
k, ScriptData
junkValue)) [ScriptData]
freshKeys
 where
  keys :: [ScriptData]
keys = ((ScriptData, ScriptData) -> ScriptData)
-> [(ScriptData, ScriptData)] -> [ScriptData]
forall a b. (a -> b) -> [a] -> [b]
map (ScriptData, ScriptData) -> ScriptData
forall a b. (a, b) -> a
fst [(ScriptData, ScriptData)]
kvs
  junkValue :: ScriptData
junkValue = [ScriptData] -> ScriptData
junkMemberLike (((ScriptData, ScriptData) -> ScriptData)
-> [(ScriptData, ScriptData)] -> [ScriptData]
forall a b. (a -> b) -> [a] -> [b]
map (ScriptData, ScriptData) -> ScriptData
forall a b. (a, b) -> b
snd [(ScriptData, ScriptData)]
kvs)

  freshKeys :: [ScriptData]
freshKeys = case [ScriptData]
keys of
    -- No key to mirror the shape of, so a number is as good a guess as any.
    [] -> (Integer -> ScriptData) -> [Integer] -> [ScriptData]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> ScriptData
ScriptDataNumber [Integer
0 ..]
    ScriptData
template : [ScriptData]
_ ->
      -- Whether a leaf can be perturbed at all does not depend on the index,
      -- so one probe settles it - and guards the 'mapMaybe' below against an
      -- infinitely unproductive traversal.
      case Int -> ScriptData -> Maybe ScriptData
perturb Int
0 ScriptData
template of
        Maybe ScriptData
Nothing -> []
        Just ScriptData
_ -> (Int -> Maybe ScriptData) -> [Int] -> [ScriptData]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\Int
i -> Int -> ScriptData -> Maybe ScriptData
perturb Int
i ScriptData
template) [Int
0 ..]

  bytesPad :: ByteString
bytesPad = Int -> Word8 -> ByteString
BS.replicate (Int
maxBytesLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word8
0
  perturb :: Int -> ScriptData -> Maybe ScriptData
perturb Int
i = (ScriptData -> ScriptData) -> ScriptData -> Maybe ScriptData
replaceFirstLeaf ((ScriptData -> ScriptData) -> ScriptData -> Maybe ScriptData)
-> (ScriptData -> ScriptData) -> ScriptData -> Maybe ScriptData
forall a b. (a -> b) -> a -> b
$ \ScriptData
leaf -> case ScriptData
leaf of
    ScriptDataBytes ByteString
_ -> ByteString -> ScriptData
ScriptDataBytes (ByteString
bytesPad ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> ByteString
word32BE Int
i)
    ScriptData
_ -> Integer -> ScriptData
ScriptDataNumber (Integer
maxNumber Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
i)

  keyLeaves :: [ScriptData]
keyLeaves = (ScriptData -> [ScriptData]) -> [ScriptData] -> [ScriptData]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ScriptData -> [ScriptData]
leaves [ScriptData]
keys
  maxNumber :: Integer
maxNumber = [Integer] -> Integer
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Integer
0 Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: [Integer
i | ScriptDataNumber Integer
i <- [ScriptData]
keyLeaves])
  maxBytesLen :: Int
maxBytesLen = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Int
0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [ByteString -> Int
BS.length ByteString
bs | ScriptDataBytes ByteString
bs <- [ScriptData]
keyLeaves])

{- | Apply a function to the first number or byte-string leaf of a datum, in
left-to-right order, keeping the surrounding structure. 'Nothing' when the
datum contains no leaf at all.
-}
replaceFirstLeaf :: (ScriptData -> ScriptData) -> ScriptData -> Maybe ScriptData
replaceFirstLeaf :: (ScriptData -> ScriptData) -> ScriptData -> Maybe ScriptData
replaceFirstLeaf ScriptData -> ScriptData
f ScriptData
sd = case ScriptData
sd of
  ScriptDataNumber{} -> ScriptData -> Maybe ScriptData
forall a. a -> Maybe a
Just (ScriptData -> ScriptData
f ScriptData
sd)
  ScriptDataBytes{} -> ScriptData -> Maybe ScriptData
forall a. a -> Maybe a
Just (ScriptData -> ScriptData
f ScriptData
sd)
  ScriptDataList [ScriptData]
xs -> [ScriptData] -> ScriptData
ScriptDataList ([ScriptData] -> ScriptData)
-> Maybe [ScriptData] -> Maybe ScriptData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ScriptData] -> Maybe [ScriptData]
inFirst [ScriptData]
xs
  ScriptDataConstructor Integer
idx [ScriptData]
fields -> Integer -> [ScriptData] -> ScriptData
ScriptDataConstructor Integer
idx ([ScriptData] -> ScriptData)
-> Maybe [ScriptData] -> Maybe ScriptData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ScriptData] -> Maybe [ScriptData]
inFirst [ScriptData]
fields
  ScriptDataMap [(ScriptData, ScriptData)]
kvs ->
    -- Flatten to a member list and rebuild, so that a nested map's key is
    -- itself a candidate leaf position.
    [(ScriptData, ScriptData)] -> ScriptData
ScriptDataMap ([(ScriptData, ScriptData)] -> ScriptData)
-> ([ScriptData] -> [(ScriptData, ScriptData)])
-> [ScriptData]
-> ScriptData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ScriptData] -> [(ScriptData, ScriptData)]
forall {b}. [b] -> [(b, b)]
pairs ([ScriptData] -> ScriptData)
-> Maybe [ScriptData] -> Maybe ScriptData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ScriptData] -> Maybe [ScriptData]
inFirst ([(ScriptData, ScriptData)] -> [ScriptData]
forall {a}. [(a, a)] -> [a]
unpairs [(ScriptData, ScriptData)]
kvs)
 where
  inFirst :: [ScriptData] -> Maybe [ScriptData]
inFirst [] = Maybe [ScriptData]
forall a. Maybe a
Nothing
  inFirst (ScriptData
x : [ScriptData]
xs) = case (ScriptData -> ScriptData) -> ScriptData -> Maybe ScriptData
replaceFirstLeaf ScriptData -> ScriptData
f ScriptData
x of
    Just ScriptData
x' -> [ScriptData] -> Maybe [ScriptData]
forall a. a -> Maybe a
Just (ScriptData
x' ScriptData -> [ScriptData] -> [ScriptData]
forall a. a -> [a] -> [a]
: [ScriptData]
xs)
    Maybe ScriptData
Nothing -> (ScriptData
x ScriptData -> [ScriptData] -> [ScriptData]
forall a. a -> [a] -> [a]
:) ([ScriptData] -> [ScriptData])
-> Maybe [ScriptData] -> Maybe [ScriptData]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ScriptData] -> Maybe [ScriptData]
inFirst [ScriptData]
xs

  unpairs :: [(a, a)] -> [a]
unpairs [(a, a)]
ps = [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[a
k, a
v] | (a
k, a
v) <- [(a, a)]
ps]
  pairs :: [b] -> [(b, b)]
pairs (b
k : b
v : [b]
rest) = (b
k, b
v) (b, b) -> [(b, b)] -> [(b, b)]
forall a. a -> [a] -> [a]
: [b] -> [(b, b)]
pairs [b]
rest
  pairs [b]
_ = []

-- | Every number and byte-string leaf of a datum.
leaves :: ScriptData -> [ScriptData]
leaves :: ScriptData -> [ScriptData]
leaves ScriptData
sd = case ScriptData
sd of
  ScriptDataNumber{} -> [ScriptData
sd]
  ScriptDataBytes{} -> [ScriptData
sd]
  ScriptDataList [ScriptData]
xs -> (ScriptData -> [ScriptData]) -> [ScriptData] -> [ScriptData]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ScriptData -> [ScriptData]
leaves [ScriptData]
xs
  ScriptDataConstructor Integer
_ [ScriptData]
fields -> (ScriptData -> [ScriptData]) -> [ScriptData] -> [ScriptData]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ScriptData -> [ScriptData]
leaves [ScriptData]
fields
  ScriptDataMap [(ScriptData, ScriptData)]
kvs -> [[ScriptData]] -> [ScriptData]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ScriptData -> [ScriptData]
leaves ScriptData
k [ScriptData] -> [ScriptData] -> [ScriptData]
forall a. Semigroup a => a -> a -> a
<> ScriptData -> [ScriptData]
leaves ScriptData
v | (ScriptData
k, ScriptData
v) <- [(ScriptData, ScriptData)]
kvs]

-- | Big-endian 4-byte encoding, to make each generated key distinct.
word32BE :: Int -> BS.ByteString
word32BE :: Int -> ByteString
word32BE Int
i = [Word8] -> ByteString
BS.pack [Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
d Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
256) | Int
d <- [Int
16777216, Int
65536, Int
256, Int
1]]

{- | Name of a @ScriptData@ constructor, for the skip reason reported when
'bloatData' cannot bloat a datum.
-}
datumShape :: ScriptData -> String
datumShape :: ScriptData -> [Char]
datumShape ScriptData
sd = case ScriptData
sd of
  ScriptDataConstructor{} -> [Char]
"Constr"
  ScriptDataList{} -> [Char]
"List"
  ScriptDataMap{} -> [Char]
"Map"
  ScriptDataNumber{} -> [Char]
"Number"
  ScriptDataBytes{} -> [Char]
"Bytes"