{-# LANGUAGE OverloadedStrings #-}

{- | Threat model for detecting duplicate list entry vulnerabilities.

A Duplicate List Entry Attack exploits validators that don't check for uniqueness
in list fields. The attack duplicates entries in list fields within the datum,
which may reveal that the validator allows duplicate entries where uniqueness
should be enforced.

== Consequences ==

1. __Signature bypassing__: In a multisig contract with @signed_users@ list,
   an attacker can sign once and duplicate their entry to fill all required
   signature slots, bypassing the multi-party requirement.

2. __Vote manipulation__: In a voting contract, a single voter could have their
   vote counted multiple times if the voter list isn't checked for duplicates.

3. __Reward gaming__: In reward distribution, a single participant could claim
   multiple reward shares by appearing multiple times in a beneficiary list.

== Vulnerable Patterns ==

=== Pattern: No uniqueness check on signed_users ===

@
// Vulnerable: only checks length, not uniqueness!
expect list.length(output.signed_users) >= required_signatures
@

An attacker who is allowed to sign can sign once, then intercept the transaction
and duplicate their signature to fill all slots.

=== Pattern: Prepend-only list update without duplicate check ===

@
// Vulnerable: just prepends without checking if already in list
let new_signed = list.push(input.signed_users, signer)
expect output.signed_users == new_signed
@

The validator checks that the signer was prepended correctly, but doesn't check
if the signer was already in the list. Multiple Sign transactions with the same
signer create duplicates.

== Mitigation ==

A secure validator should:

- Check for uniqueness before adding to lists: @!list.has(signed_users, new_signer)@
- Validate that list entries are unique in the output datum
- Use sets instead of lists where uniqueness is required

This threat model tests if a script output with an inline datum still validates
when list entries are duplicated.
-}
module Convex.ThreatModel.DuplicateListEntry (
  -- * Duplicate list entry attack
  duplicateListEntryAttack,
  duplicateFirstEntry,
) where

import Convex.ThreatModel

{- | Check for missing uniqueness checks in list fields.

For a transaction with script outputs containing inline datums:

* Recursively find all non-empty @ScriptDataList@ fields in the datum
* Duplicate the first entry of each list
* If the transaction still validates, the script doesn't enforce
  uniqueness in list fields.

This catches vulnerabilities where validators allow duplicate entries
in lists like @signed_users@, @voters@, or @beneficiaries@ where
uniqueness should be enforced.

@
duplicateListEntryAttack  -- Duplicate first entry in all lists
@
-}
duplicateListEntryAttack :: ThreatModel ()
duplicateListEntryAttack :: ThreatModel ()
duplicateListEntryAttack = String -> ThreatModel () -> ThreatModel ()
forall a. String -> ThreatModel a -> ThreatModel a
Named String
"Duplicate List Entry Attack" (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 -> String -> ThreatModel ScriptData
forall a. String -> ThreatModel a
failPrecondition String
"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 modifiedDatum :: ScriptData
modifiedDatum = ScriptData -> ScriptData
duplicateFirstEntry ScriptData
originalDatum

  -- Only proceed if something actually changed (datum has non-empty lists)
  ThreatModel () -> ThreatModel ()
forall a. ThreatModel a -> ThreatModel a
threatPrecondition (ThreatModel () -> ThreatModel ())
-> ThreatModel () -> ThreatModel ()
forall a b. (a -> b) -> a -> b
$ Bool -> ThreatModel ()
ensure (ScriptData
modifiedDatum ScriptData -> ScriptData -> Bool
forall a. Eq a => a -> a -> Bool
/= ScriptData
originalDatum)

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

  String -> ThreatModel ()
counterexampleTM (String -> ThreatModel ()) -> String -> ThreatModel ()
forall a b. (a -> b) -> a -> b
$
    [String] -> String
paragraph
      [ String
"Testing if duplicating the first entry in list fields"
      , String
"still passes validation."
      ]

  String -> ThreatModel ()
counterexampleTM (String -> ThreatModel ()) -> String -> ThreatModel ()
forall a b. (a -> b) -> a -> b
$
    [String] -> String
paragraph
      [ String
"If this validates, the script doesn't enforce list uniqueness."
      , String
"An attacker could exploit this to:"
      , String
"1) Bypass multisig requirements by signing once and duplicating"
      , String
"2) Manipulate votes by duplicating voter entries"
      , String
"3) Claim multiple rewards by duplicating beneficiary entries"
      ]

  -- Try to validate with the modified 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
modifiedDatum)

{- | Recursively duplicate the first entry in all non-empty list fields.

For @ScriptDataList (x:xs)@, returns @ScriptDataList (x:x:xs)@ - duplicating
the first entry.

Recursively processes @ScriptDataConstructor@ fields, nested lists, and maps.

For other @ScriptData@ variants (Number, Bytes) and empty lists, returns
the value unchanged.

This simulates an attack where:
- A user signs a multisig, adding their PKH to @signed_users = [pkh]@
- The attacker duplicates to @signed_users = [pkh, pkh]@, filling 2 slots with 1 signature
-}
duplicateFirstEntry :: ScriptData -> ScriptData
duplicateFirstEntry :: ScriptData -> ScriptData
duplicateFirstEntry (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
duplicateFirstEntry [ScriptData]
fields)
duplicateFirstEntry (ScriptDataList (ScriptData
x : [ScriptData]
xs)) =
  [ScriptData] -> ScriptData
ScriptDataList (ScriptData
x ScriptData -> [ScriptData] -> [ScriptData]
forall a. a -> [a] -> [a]
: ScriptData
x ScriptData -> [ScriptData] -> [ScriptData]
forall a. a -> [a] -> [a]
: [ScriptData]
xs) -- duplicate first entry!
duplicateFirstEntry (ScriptDataList []) =
  [ScriptData] -> ScriptData
ScriptDataList []
duplicateFirstEntry (ScriptDataMap [(ScriptData, ScriptData)]
entries) =
  [(ScriptData, ScriptData)] -> ScriptData
ScriptDataMap [(ScriptData -> ScriptData
duplicateFirstEntry ScriptData
k, ScriptData -> ScriptData
duplicateFirstEntry ScriptData
v) | (ScriptData
k, ScriptData
v) <- [(ScriptData, ScriptData)]
entries]
duplicateFirstEntry ScriptData
x = ScriptData
x -- bytes, numbers unchanged

-- | 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)