{-# LANGUAGE OverloadedStrings #-}

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

A Large Value Attack exploits validators that don't properly validate the
structure of @Value@ in their outputs. If a validator allows spending from
a script output without checking what tokens are present in the output's value,
an attacker can "bloat" the value with additional junk tokens.

== Consequences ==

1. __Increased min-UTxO requirements__: Each unique token in a UTxO increases
   the minimum Ada required. Adding many junk tokens forces the victim to
   lock more Ada than intended.

2. __Serialization costs__: Large values increase transaction size, consuming
   more of the victim's fee budget when spending the UTxO.

3. __Permanent fund locking__: If the value is bloated sufficiently:

   - The transaction required to spend the UTxO may exceed protocol size limits
   - The serialized output may exceed the max-value-size protocol parameter

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

== Root Cause ==

Validators that don't check the @Value@ structure of outputs being created.
For example, a validator that only checks:

@
traceIfFalse "insufficient payment" (valuePaidTo pkh >= expectedAmount)
@

This allows an attacker to include @expectedAmount + junkTokens@, satisfying
the check while bloating the output.

== Mitigation ==

A secure validator should either:

- Whitelist expected tokens (only allow known policy IDs)
- Check the token count (e.g., @length (flattenValue v) <= maxTokens@)
- Require exact value match (not just @>=@ comparison)
- Validate that outputs contain only expected assets

This threat model tests if a script output can have arbitrary tokens added
to its value via minting. If the transaction still validates, the validator
has a Large Value Attack vulnerability.
-}
module Convex.ThreatModel.LargeValue (
  largeValueAttack,
  largeValueAttackWith,
) where

import Cardano.Api qualified as C
import Convex.ThreatModel
import Convex.ThreatModel.TxModifier (addPlutusScriptMint, alwaysSucceedsMintingPolicy)
import Data.ByteString.Char8 qualified as BS
import GHC.Exts (fromList)

{- | Check for Large Value Attack vulnerabilities with 50 junk tokens.

This is the default configuration that mints 50 unique tokens and adds them
to a script output. If the transaction still validates, the script doesn't
properly validate the value structure of its outputs.
-}
largeValueAttack :: ThreatModel ()
largeValueAttack :: ThreatModel ()
largeValueAttack = Int -> ThreatModel ()
largeValueAttackWith Int
50

{- | Check for Large Value Attack vulnerabilities with a configurable number
of junk tokens.

For a transaction with script outputs:

* Mint @n@ unique junk tokens using an always-succeeds minting policy
* Add these tokens to a script output's value
* If the transaction still validates, the script doesn't validate
  the structure of values being created - it may only check amounts.

This catches a vulnerability where validators use permissive value checks
like @valuePaidTo addr >= expected@ instead of exact matching, allowing
attackers to inflate UTxO min-Ada requirements or lock funds permanently.
-}
largeValueAttackWith :: Int -> ThreatModel ()
largeValueAttackWith :: Int -> ThreatModel ()
largeValueAttackWith Int
numTokens = [Char] -> ThreatModel () -> ThreatModel ()
forall a. [Char] -> ThreatModel a -> ThreatModel a
Named ([Char]
"Large Value Attack (" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
numTokens [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" tokens)") (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 (NOT key addresses)
  let scriptOutputs :: [Output]
scriptOutputs = (Output -> Bool) -> [Output] -> [Output]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Output -> Bool) -> Output -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AddressAny -> Bool
isKeyAddressAny (AddressAny -> Bool) -> (Output -> AddressAny) -> Output -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Output -> AddressAny
forall t. IsInputOrOutput t => t -> AddressAny
addressOf) [Output]
outputs

  -- Precondition: there must be at least one script output
  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]
scriptOutputs)

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

  -- Create junk tokens by minting with the always-succeeds policy
  let policyId :: PolicyId
policyId = ScriptHash -> PolicyId
C.PolicyId (ScriptHash -> PolicyId) -> ScriptHash -> PolicyId
forall a b. (a -> b) -> a -> b
$ Script PlutusScriptV2 -> ScriptHash
forall lang. Script lang -> ScriptHash
hashScript (PlutusScriptVersion PlutusScriptV2
-> PlutusScript PlutusScriptV2 -> Script PlutusScriptV2
forall lang.
IsPlutusScriptLanguage lang =>
PlutusScriptVersion lang -> PlutusScript lang -> Script lang
C.PlutusScript PlutusScriptVersion PlutusScriptV2
C.PlutusScriptV2 PlutusScript PlutusScriptV2
alwaysSucceedsMintingPolicy)
      junkTokens :: [(AssetName, Quantity)]
junkTokens =
        [ (ByteString -> AssetName
C.UnsafeAssetName (ByteString -> AssetName) -> ByteString -> AssetName
forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
BS.pack ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ [Char]
"junk" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i, Integer -> Quantity
C.Quantity Integer
1)
        | Int
i <- [Int
1 .. Int
numTokens]
        ]
      junkValue :: Value
junkValue =
        [Item Value] -> Value
forall l. IsList l => [Item l] -> l
fromList
          [ (PolicyId -> AssetName -> AssetId
C.AssetId PolicyId
policyId AssetName
name, Quantity
qty)
          | (AssetName
name, Quantity
qty) <- [(AssetName, Quantity)]
junkTokens
          ]
      bloatedValue :: Value
bloatedValue = Output -> Value
forall t. IsInputOrOutput t => t -> Value
valueOf Output
target Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
junkValue

  [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]
"."
      ]

  [Char] -> ThreatModel ()
counterexampleTM ([Char] -> ThreatModel ()) -> [Char] -> ThreatModel ()
forall a b. (a -> b) -> a -> b
$
    [[Char]] -> [Char]
paragraph
      [ [Char]
"Testing if"
      , Int -> [Char]
forall a. Show a => a -> [Char]
show Int
numTokens
      , [Char]
"junk tokens can be minted and added to the output's value"
      , [Char]
"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's value validation is permissive."
      , [Char]
"An attacker could exploit this to:"
      , [Char]
"1) Increase min-UTxO requirements, locking victim's Ada"
      , [Char]
"2) Inflate transaction sizes, increasing spending costs"
      , [Char]
"3) Potentially lock funds permanently if size limits are exceeded"
      ]

  -- Create mint modifiers for all junk tokens
  let mintModifiers :: TxModifier
mintModifiers =
        [TxModifier] -> TxModifier
forall a. Monoid a => [a] -> a
mconcat
          [ PlutusScript PlutusScriptV2
-> AssetName -> Quantity -> ScriptData -> TxModifier
forall lang.
IsPlutusScriptInEra lang =>
PlutusScript lang
-> AssetName -> Quantity -> ScriptData -> TxModifier
addPlutusScriptMint PlutusScript PlutusScriptV2
alwaysSucceedsMintingPolicy AssetName
name Quantity
qty (() -> ScriptData
forall a. ToData a => a -> ScriptData
toScriptData ())
          | (AssetName
name, Quantity
qty) <- [(AssetName, Quantity)]
junkTokens
          ]

  -- This SHOULD fail - if it validates, the contract is vulnerable
  -- The attack: mint junk tokens AND add them to the target output
  TxModifier -> ThreatModel ()
shouldNotValidate (TxModifier -> ThreatModel ()) -> TxModifier -> ThreatModel ()
forall a b. (a -> b) -> a -> b
$
    Output -> Value -> TxModifier
forall t. IsInputOrOutput t => t -> Value -> TxModifier
changeValueOf Output
target Value
bloatedValue
      TxModifier -> TxModifier -> TxModifier
forall a. Semigroup a => a -> a -> a
<> TxModifier
mintModifiers