{-# LANGUAGE OverloadedStrings #-}

{- | Threat model for detecting Datum Bloat Attack vulnerabilities.

A Datum Bloat Attack exploits validators that don't limit the size of data
fields within their datums. Unlike the Large Data Attack (which adds extra
constructor fields), this attack inflates /existing/ fields - specifically
lists and byte strings within the datum structure.

== Consequences ==

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

2. __Permanent fund locking__: If a list or bytestring field 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.

== Vulnerable Patterns ==

=== Pattern 1: Unbounded list fields ===

@
type Datum {
  owner: VerificationKeyHash,
  messages: List<ByteArray>  -- No list length limit!
}
@

An attacker can append arbitrarily many items to the messages list,
bloating the datum beyond transaction limits. Caught by 'datumListBloatAttack'.

=== Pattern 2: Unbounded ByteString fields ===

@
type Datum {
  owner: VerificationKeyHash,
  messages: List<ByteArray>  -- No ByteArray SIZE limit!
}
@

An attacker can replace small ByteArrays with huge ones (e.g., "Hello" -> 100KB).
Caught by 'datumByteBloatAttack'.

== Mitigation ==

A secure validator should either:

- Enforce maximum field sizes in the validator logic
- Check list lengths explicitly (e.g., @length messages <= maxMessages@)
- Limit ByteArray sizes (e.g., @lengthOfByteString msg <= maxMsgSize@)
- Hash large data instead of storing it inline

This threat model tests if a script output with an inline datum still validates
when list fields are bloated with additional large items, or when byte string
fields are replaced with much larger ones.
-}
module Convex.ThreatModel.DatumBloat (
  -- * List bloating attacks
  datumListBloatAttack,
  datumListBloatAttackWith,
  bloatLists,

  -- * ByteString inflation attacks
  datumByteBloatAttack,
  datumByteBloatAttackWith,
  inflateBytes,
  inflateFirstListItem,
) where

import Convex.ThreatModel
import Data.ByteString qualified as BS

{- | Check for Datum Bloat vulnerabilities with default parameters.

Appends 5 items of 100 bytes each to every list found in the datum.
If the transaction still validates, the script doesn't limit datum field sizes.
-}
datumListBloatAttack :: ThreatModel ()
datumListBloatAttack :: ThreatModel ()
datumListBloatAttack = Int -> Int -> ThreatModel ()
datumListBloatAttackWith Int
5 Int
100

{- | Check for Datum Bloat vulnerabilities with configurable parameters.

For a transaction with script outputs containing inline datums:

* Recursively find all @ScriptDataList@ fields in the datum
* Append @numItems@ large @ScriptDataBytes@ items to each list
* Each appended item is @itemSize@ bytes of 0x42 ('B')
* If the transaction still validates, the script doesn't enforce
  field size limits - it only checks the fields it expects.

This catches vulnerabilities where validators have unbounded list fields
(like a list of messages or a list of signatures) that can be exploited
to bloat the datum beyond spendable limits.

@
datumListBloatAttackWith 5 100  -- Add 5 items of 100 bytes each
datumListBloatAttackWith 10 500 -- More aggressive: 10 items of 500 bytes
@
-}
datumListBloatAttackWith :: Int -> Int -> ThreatModel ()
datumListBloatAttackWith :: Int -> Int -> ThreatModel ()
datumListBloatAttackWith Int
numItems Int
itemSize = [Char] -> ThreatModel () -> ThreatModel ()
forall a. [Char] -> ThreatModel a -> ThreatModel a
Named ([Char]
"Datum List Bloat Attack (" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
numItems [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" items, " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
itemSize [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" bytes)") (ThreatModel () -> ThreatModel ())
-> ThreatModel () -> ThreatModel ()
forall a b. (a -> b) -> a -> b
$ do
  -- Get all outputs from the transaction
  [Output]
outputs <- ThreatModel [Output]
getTxOutputs

  -- Filter to script outputs with inline datums
  let scriptOutputsWithDatum :: [Output]
scriptOutputsWithDatum = (Output -> Bool) -> [Output] -> [Output]
forall a. (a -> Bool) -> [a] -> [a]
filter Output -> Bool
isScriptOutputWithInlineDatum [Output]
outputs

  -- Precondition: there must be at least one script output with inline datum
  ThreatModel () -> ThreatModel ()
forall a. ThreatModel a -> ThreatModel a
threatPrecondition (ThreatModel () -> ThreatModel ())
-> ThreatModel () -> ThreatModel ()
forall a b. (a -> b) -> a -> b
$ Bool -> ThreatModel ()
ensure (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Output] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Output]
scriptOutputsWithDatum)

  -- Pick a target output
  Output
target <- [Output] -> ThreatModel Output
forall a. Show a => [a] -> ThreatModel a
pickAny [Output]
scriptOutputsWithDatum

  -- Extract the inline datum (we know it exists due to the filter)
  ScriptData
originalDatum <- case Output -> Maybe ScriptData
getInlineDatum Output
target of
    Maybe ScriptData
Nothing -> [Char] -> ThreatModel ScriptData
forall a. [Char] -> ThreatModel a
failPrecondition [Char]
"Script output missing inline datum"
    Just ScriptData
originalDatum' -> ScriptData -> ThreatModel ScriptData
forall a. a -> ThreatModel a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScriptData
originalDatum'

  -- Check if the datum contains any lists to bloat
  Bool -> ThreatModel () -> ThreatModel ()
forall {f :: * -> *}. Applicative f => Bool -> f () -> f ()
unless (ScriptData -> Bool
containsList ScriptData
originalDatum) (ThreatModel () -> ThreatModel ())
-> ThreatModel () -> ThreatModel ()
forall a b. (a -> b) -> a -> b
$
    [Char] -> ThreatModel ()
forall a. [Char] -> ThreatModel a
failPrecondition [Char]
"Datum contains no list fields to bloat"

  let bloatedDatum :: ScriptData
bloatedDatum = Int -> Int -> ScriptData -> ScriptData
bloatLists Int
numItems Int
itemSize ScriptData
originalDatum

  [Char] -> ThreatModel ()
counterexampleTM ([Char] -> ThreatModel ()) -> [Char] -> ThreatModel ()
forall a b. (a -> b) -> a -> b
$
    [[Char]] -> [Char]
paragraph
      [ [Char]
"The transaction contains a script output at index"
      , TxIx -> [Char]
forall a. Show a => a -> [Char]
show (Output -> TxIx
outputIx Output
target)
      , [Char]
"with an inline datum containing list fields."
      ]

  [Char] -> ThreatModel ()
counterexampleTM ([Char] -> ThreatModel ()) -> [Char] -> ThreatModel ()
forall a b. (a -> b) -> a -> b
$
    [[Char]] -> [Char]
paragraph
      [ [Char]
"Testing if the lists can be bloated with"
      , Int -> [Char]
forall a. Show a => a -> [Char]
show Int
numItems
      , [Char]
"items of"
      , Int -> [Char]
forall a. Show a => a -> [Char]
show Int
itemSize
      , [Char]
"bytes each while still passing validation."
      ]

  [Char] -> ThreatModel ()
counterexampleTM ([Char] -> ThreatModel ()) -> [Char] -> ThreatModel ()
forall a b. (a -> b) -> a -> b
$
    [[Char]] -> [Char]
paragraph
      [ [Char]
"If this validates, the script doesn't enforce datum field size limits."
      , [Char]
"An attacker could exploit this to:"
      , [Char]
"1) Inflate the datum beyond transaction size limits"
      , [Char]
"2) Increase execution costs for processing the datum"
      , [Char]
"3) Potentially lock funds permanently if limits are exceeded"
      ]

  -- 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)
 where
  unless :: Bool -> f () -> f ()
unless Bool
False f ()
action = f ()
action
  unless Bool
True f ()
_ = () -> f ()
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

{- | Recursively bloat all list fields in a @ScriptData@ value.

For @ScriptDataList items@, appends @numItems@ copies of
@ScriptDataBytes (BS.replicate itemSize 0x42)@ to the list.

Recursively processes @ScriptDataConstructor@ fields and nested lists.

For other @ScriptData@ variants (Map, Number, Bytes), returns
the value unchanged.
-}
bloatLists :: Int -> Int -> ScriptData -> ScriptData
bloatLists :: Int -> Int -> ScriptData -> ScriptData
bloatLists Int
numItems Int
itemSize = ScriptData -> ScriptData
go
 where
  largeItem :: ScriptData
largeItem = ByteString -> ScriptData
ScriptDataBytes (Int -> Word8 -> ByteString
BS.replicate Int
itemSize Word8
0x42)

  go :: ScriptData -> ScriptData
go (ScriptDataConstructor Integer
idx [ScriptData]
fields) =
    Integer -> [ScriptData] -> ScriptData
ScriptDataConstructor Integer
idx ((ScriptData -> ScriptData) -> [ScriptData] -> [ScriptData]
forall a b. (a -> b) -> [a] -> [b]
map ScriptData -> ScriptData
go [ScriptData]
fields)
  go (ScriptDataList [ScriptData]
items) =
    [ScriptData] -> ScriptData
ScriptDataList ((ScriptData -> ScriptData) -> [ScriptData] -> [ScriptData]
forall a b. (a -> b) -> [a] -> [b]
map ScriptData -> ScriptData
go [ScriptData]
items [ScriptData] -> [ScriptData] -> [ScriptData]
forall a. [a] -> [a] -> [a]
++ Int -> ScriptData -> [ScriptData]
forall a. Int -> a -> [a]
replicate Int
numItems ScriptData
largeItem)
  go (ScriptDataMap [(ScriptData, ScriptData)]
entries) =
    [(ScriptData, ScriptData)] -> ScriptData
ScriptDataMap [(ScriptData -> ScriptData
go ScriptData
k, ScriptData -> ScriptData
go ScriptData
v) | (ScriptData
k, ScriptData
v) <- [(ScriptData, ScriptData)]
entries]
  go ScriptData
other = ScriptData
other

-- | Check if a @ScriptData@ value contains any list fields.
containsList :: ScriptData -> Bool
containsList :: ScriptData -> Bool
containsList (ScriptDataConstructor Integer
_ [ScriptData]
fields) = (ScriptData -> Bool) -> [ScriptData] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ScriptData -> Bool
containsList [ScriptData]
fields
containsList (ScriptDataList [ScriptData]
_) = Bool
True
containsList (ScriptDataMap [(ScriptData, ScriptData)]
entries) = ((ScriptData, ScriptData) -> Bool)
-> [(ScriptData, ScriptData)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(ScriptData
k, ScriptData
v) -> ScriptData -> Bool
containsList ScriptData
k Bool -> Bool -> Bool
|| ScriptData -> Bool
containsList ScriptData
v) [(ScriptData, ScriptData)]
entries
containsList ScriptData
_ = Bool
False

-- | Check if an output is a script output with an inline datum.
isScriptOutputWithInlineDatum :: Output -> Bool
isScriptOutputWithInlineDatum :: Output -> Bool
isScriptOutputWithInlineDatum Output
output =
  Bool -> Bool
not (AddressAny -> Bool
isKeyAddressAny (Output -> AddressAny
forall t. IsInputOrOutput t => t -> AddressAny
addressOf Output
output)) Bool -> Bool -> Bool
&& Output -> Bool
hasInlineDatum Output
output

-- | Check if an output has an inline datum.
hasInlineDatum :: Output -> Bool
hasInlineDatum :: Output -> Bool
hasInlineDatum Output
output =
  case TxOut CtxTx Era -> Datum
forall ctx. TxOut ctx Era -> TxOutDatum ctx Era
datumOfTxOut (Output -> TxOut CtxTx Era
outputTxOut Output
output) of
    TxOutDatumInline{} -> Bool
True
    Datum
_ -> Bool
False

-- | Extract the inline datum from an output if present.
getInlineDatum :: Output -> Maybe ScriptData
getInlineDatum :: Output -> Maybe ScriptData
getInlineDatum Output
output =
  case TxOut CtxTx Era -> Datum
forall ctx. TxOut ctx Era -> TxOutDatum ctx Era
datumOfTxOut (Output -> TxOut CtxTx Era
outputTxOut Output
output) of
    TxOutDatumInline BabbageEraOnwards Era
_ HashableScriptData
hashableData -> ScriptData -> Maybe ScriptData
forall a. a -> Maybe a
Just (HashableScriptData -> ScriptData
getScriptData HashableScriptData
hashableData)
    Datum
_ -> Maybe ScriptData
forall a. Maybe a
Nothing

-- | Convert a @ScriptData@ to an inline @Datum@ (TxOutDatum CtxTx Era).
toInlineDatum :: ScriptData -> Datum
toInlineDatum :: ScriptData -> Datum
toInlineDatum ScriptData
sd =
  BabbageEraOnwards Era -> HashableScriptData -> Datum
forall era ctx.
BabbageEraOnwards era -> HashableScriptData -> TxOutDatum ctx era
TxOutDatumInline BabbageEraOnwards Era
BabbageEraOnwardsConway (ScriptData -> HashableScriptData
unsafeHashableScriptData ScriptData
sd)

-- ----------------------------------------------------------------------------
-- ByteString Inflation Attack
-- ----------------------------------------------------------------------------

{- | Test if ByteString fields in the datum can be inflated.

This catches validators that don't limit the size of individual
ByteString fields (e.g., messages, names, arbitrary data).

The attack replaces every @ScriptDataBytes@ field found at any depth
(except the first field of the top-level constructor, typically an owner hash)
with a much larger ByteString.

For a tipjar datum @Con0(owner_hash, [\"Hello\"])@:

* @owner_hash@ is preserved (first field must match for validation)
* @\"Hello\"@ inside the list gets inflated to 10KB of @0x42@
* Result: @Con0(owner_hash, [<10KB bytes>])@
* The validator checks: @list.push([], <10KB bytes>) == [<10KB bytes>]@ → True!

This enables a DoS attack where an attacker can:

1. Create a valid transaction with a small message
2. Intercept/frontrun and replace the message with a huge ByteArray
3. The bloated datum may exceed transaction limits for future spending

Default inflation size is 10,000 bytes (10KB).
-}
datumByteBloatAttack :: ThreatModel ()
datumByteBloatAttack :: ThreatModel ()
datumByteBloatAttack = Int -> ThreatModel ()
datumByteBloatAttackWith Int
10000

{- | Check for ByteString inflation vulnerabilities with configurable size.

This attack is specifically designed to catch validators like tipjar that:
1. Allow adding items to a list
2. Check that @list.push(old_items, new_item) == new_items@
3. But DON'T limit the SIZE of @new_item@

The attack inflates only the FIRST item in lists (typically the newly-added
item), leaving existing items unchanged so the structural check passes.

@
datumByteBloatAttackWith 10000   -- Inflate first list item to 10KB
datumByteBloatAttackWith 50000   -- More aggressive: 50KB
@
-}
datumByteBloatAttackWith :: Int -> ThreatModel ()
datumByteBloatAttackWith :: Int -> ThreatModel ()
datumByteBloatAttackWith Int
inflatedSize = [Char] -> ThreatModel () -> ThreatModel ()
forall a. [Char] -> ThreatModel a -> ThreatModel a
Named ([Char]
"Datum Byte Bloat Attack (" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
inflatedSize [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" bytes)") (ThreatModel () -> ThreatModel ())
-> ThreatModel () -> ThreatModel ()
forall a b. (a -> b) -> a -> b
$ do
  [Output]
outputs <- ThreatModel [Output]
getTxOutputs
  let scriptOutputsWithDatum :: [Output]
scriptOutputsWithDatum = (Output -> Bool) -> [Output] -> [Output]
forall a. (a -> Bool) -> [a] -> [a]
filter Output -> Bool
isScriptOutputWithInlineDatum [Output]
outputs
  ThreatModel () -> ThreatModel ()
forall a. ThreatModel a -> ThreatModel a
threatPrecondition (ThreatModel () -> ThreatModel ())
-> ThreatModel () -> ThreatModel ()
forall a b. (a -> b) -> a -> b
$ Bool -> ThreatModel ()
ensure (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Output] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Output]
scriptOutputsWithDatum)
  Output
target <- [Output] -> ThreatModel Output
forall a. Show a => [a] -> ThreatModel a
pickAny [Output]
scriptOutputsWithDatum

  ScriptData
originalDatum <- case Output -> Maybe ScriptData
getInlineDatum Output
target of
    Maybe ScriptData
Nothing -> [Char] -> ThreatModel ScriptData
forall a. [Char] -> ThreatModel a
failPrecondition [Char]
"Script output missing inline datum"
    Just ScriptData
originalDatum' -> ScriptData -> ThreatModel ScriptData
forall a. a -> ThreatModel a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScriptData
originalDatum'

  let bloatedDatum :: ScriptData
bloatedDatum = Int -> ScriptData -> ScriptData
inflateFirstListItem Int
inflatedSize ScriptData
originalDatum

  -- Only proceed if something actually changed (datum has list with items to inflate)
  ThreatModel () -> ThreatModel ()
forall a. ThreatModel a -> ThreatModel a
threatPrecondition (ThreatModel () -> ThreatModel ())
-> ThreatModel () -> ThreatModel ()
forall a b. (a -> b) -> a -> b
$ Bool -> ThreatModel ()
ensure (ScriptData
bloatedDatum ScriptData -> ScriptData -> Bool
forall a. Eq a => a -> a -> Bool
/= ScriptData
originalDatum)

  [Char] -> ThreatModel ()
counterexampleTM ([Char] -> ThreatModel ()) -> [Char] -> ThreatModel ()
forall a b. (a -> b) -> a -> b
$
    [[Char]] -> [Char]
paragraph
      [ [Char]
"The transaction contains a script output with an inline datum."
      , [Char]
"Testing if the first item in list fields can be inflated to"
      , Int -> [Char]
forall a. Show a => a -> [Char]
show Int
inflatedSize
      , [Char]
"bytes while still passing validation."
      ]

  [Char] -> ThreatModel ()
counterexampleTM ([Char] -> ThreatModel ()) -> [Char] -> ThreatModel ()
forall a b. (a -> b) -> a -> b
$
    [[Char]] -> [Char]
paragraph
      [ [Char]
"If this validates, the script doesn't limit ByteString field sizes,"
      , [Char]
"enabling a datum bloat DoS attack where an attacker can add"
      , [Char]
"a huge message/data item to bloat the datum beyond spendable limits."
      ]

  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)

{- | Replace all @ScriptDataBytes@ with inflated versions.

Preserves the first field of the top-level constructor (typically an
owner/address hash that must match exactly for validation).

Inflates all other @ScriptDataBytes@ found at any depth with a ByteString
of the given size filled with @0x42@ ('B').

For the tipjar use case, this inflates EVERY message in the list, which
changes the structure too much. For validators that do structural checks
like @list.push(old_msgs, new_msg) == new_msgs@, this will fail.

Use 'inflateFirstListItem' for a more targeted attack that only inflates
the first (newest) message in a list.
-}
inflateBytes :: Int -> ScriptData -> ScriptData
inflateBytes :: Int -> ScriptData -> ScriptData
inflateBytes Int
size = ScriptData -> ScriptData
goTop
 where
  largeBytes :: ByteString
largeBytes = Int -> Word8 -> ByteString
BS.replicate Int
size Word8
0x42

  -- At top level, preserve first field of constructor
  goTop :: ScriptData -> ScriptData
goTop (ScriptDataConstructor Integer
idx [ScriptData]
fields) =
    case [ScriptData]
fields of
      (ScriptData
first : [ScriptData]
rest) -> Integer -> [ScriptData] -> ScriptData
ScriptDataConstructor Integer
idx (ScriptData
first ScriptData -> [ScriptData] -> [ScriptData]
forall a. a -> [a] -> [a]
: (ScriptData -> ScriptData) -> [ScriptData] -> [ScriptData]
forall a b. (a -> b) -> [a] -> [b]
map ScriptData -> ScriptData
go [ScriptData]
rest)
      [] -> Integer -> [ScriptData] -> ScriptData
ScriptDataConstructor Integer
idx []
  goTop ScriptData
other = ScriptData -> ScriptData
go ScriptData
other

  -- Recursive case: inflate all ByteStrings
  go :: ScriptData -> ScriptData
go (ScriptDataConstructor Integer
idx [ScriptData]
fields) = Integer -> [ScriptData] -> ScriptData
ScriptDataConstructor Integer
idx ((ScriptData -> ScriptData) -> [ScriptData] -> [ScriptData]
forall a b. (a -> b) -> [a] -> [b]
map ScriptData -> ScriptData
go [ScriptData]
fields)
  go (ScriptDataList [ScriptData]
items) = [ScriptData] -> ScriptData
ScriptDataList ((ScriptData -> ScriptData) -> [ScriptData] -> [ScriptData]
forall a b. (a -> b) -> [a] -> [b]
map ScriptData -> ScriptData
go [ScriptData]
items)
  go (ScriptDataMap [(ScriptData, ScriptData)]
entries) = [(ScriptData, ScriptData)] -> ScriptData
ScriptDataMap [(ScriptData -> ScriptData
go ScriptData
k, ScriptData -> ScriptData
go ScriptData
v) | (ScriptData
k, ScriptData
v) <- [(ScriptData, ScriptData)]
entries]
  go (ScriptDataBytes ByteString
_) = ByteString -> ScriptData
ScriptDataBytes ByteString
largeBytes
  go ScriptData
other = ScriptData
other

{- | Inflate only the FIRST @ScriptDataBytes@ found in lists.

This is a more targeted attack for validators like tipjar that check:
@list.push(input_messages, new_msg) == output_messages@

The validator only cares that the NEW message (head of the list) was
correctly prepended. It doesn't check the SIZE of that message.

For a tipjar datum @Con0(owner_hash, [\"New\", \"Old1\", \"Old2\"])@:

* @owner_hash@ is preserved
* @\"New\"@ (first/newest message) gets inflated to 10KB
* @\"Old1\"@, @\"Old2\"@ are left unchanged (must match input)
* Result: @Con0(owner_hash, [<10KB>, \"Old1\", \"Old2\"])@

The validator check:
* Input: @[\"Old1\", \"Old2\"]@
* @list.push([\"Old1\", \"Old2\"], <10KB>) = [<10KB>, \"Old1\", \"Old2\"]@
* This equals the output! Vulnerability exploited.
-}
inflateFirstListItem :: Int -> ScriptData -> ScriptData
inflateFirstListItem :: Int -> ScriptData -> ScriptData
inflateFirstListItem Int
size = ScriptData -> ScriptData
goTop
 where
  largeBytes :: ByteString
largeBytes = Int -> Word8 -> ByteString
BS.replicate Int
size Word8
0x42

  -- At top level, preserve first field of constructor (owner hash)
  goTop :: ScriptData -> ScriptData
goTop (ScriptDataConstructor Integer
idx [ScriptData]
fields) =
    case [ScriptData]
fields of
      (ScriptData
first : [ScriptData]
rest) -> Integer -> [ScriptData] -> ScriptData
ScriptDataConstructor Integer
idx (ScriptData
first ScriptData -> [ScriptData] -> [ScriptData]
forall a. a -> [a] -> [a]
: (ScriptData -> ScriptData) -> [ScriptData] -> [ScriptData]
forall a b. (a -> b) -> [a] -> [b]
map ScriptData -> ScriptData
goList [ScriptData]
rest)
      [] -> Integer -> [ScriptData] -> ScriptData
ScriptDataConstructor Integer
idx []
  goTop ScriptData
other = ScriptData -> ScriptData
goList ScriptData
other

  -- Find lists and inflate only the first item
  goList :: ScriptData -> ScriptData
goList (ScriptDataConstructor Integer
idx [ScriptData]
fields) = Integer -> [ScriptData] -> ScriptData
ScriptDataConstructor Integer
idx ((ScriptData -> ScriptData) -> [ScriptData] -> [ScriptData]
forall a b. (a -> b) -> [a] -> [b]
map ScriptData -> ScriptData
goList [ScriptData]
fields)
  goList (ScriptDataList (ScriptData
firstItem : [ScriptData]
restItems)) =
    -- Inflate only the first item in the list, leave rest unchanged
    [ScriptData] -> ScriptData
ScriptDataList (ScriptData -> ScriptData
inflateItem ScriptData
firstItem ScriptData -> [ScriptData] -> [ScriptData]
forall a. a -> [a] -> [a]
: [ScriptData]
restItems)
  goList (ScriptDataList []) = [ScriptData] -> ScriptData
ScriptDataList []
  goList (ScriptDataMap [(ScriptData, ScriptData)]
entries) = [(ScriptData, ScriptData)] -> ScriptData
ScriptDataMap [(ScriptData -> ScriptData
goList ScriptData
k, ScriptData -> ScriptData
goList ScriptData
v) | (ScriptData
k, ScriptData
v) <- [(ScriptData, ScriptData)]
entries]
  goList ScriptData
other = ScriptData
other

  -- Inflate a single item (recursively inflate all ByteStrings in it)
  inflateItem :: ScriptData -> ScriptData
inflateItem (ScriptDataBytes ByteString
_) = ByteString -> ScriptData
ScriptDataBytes ByteString
largeBytes
  inflateItem (ScriptDataConstructor Integer
idx [ScriptData]
fields) =
    Integer -> [ScriptData] -> ScriptData
ScriptDataConstructor Integer
idx ((ScriptData -> ScriptData) -> [ScriptData] -> [ScriptData]
forall a b. (a -> b) -> [a] -> [b]
map ScriptData -> ScriptData
inflateItem [ScriptData]
fields)
  inflateItem (ScriptDataList [ScriptData]
items) = [ScriptData] -> ScriptData
ScriptDataList ((ScriptData -> ScriptData) -> [ScriptData] -> [ScriptData]
forall a b. (a -> b) -> [a] -> [b]
map ScriptData -> ScriptData
inflateItem [ScriptData]
items)
  inflateItem (ScriptDataMap [(ScriptData, ScriptData)]
entries) =
    [(ScriptData, ScriptData)] -> ScriptData
ScriptDataMap [(ScriptData -> ScriptData
inflateItem ScriptData
k, ScriptData -> ScriptData
inflateItem ScriptData
v) | (ScriptData
k, ScriptData
v) <- [(ScriptData, ScriptData)]
entries]
  inflateItem ScriptData
other = ScriptData
other