{-# LANGUAGE OverloadedStrings #-}

{- | Threat model for detecting Invalid Script Purpose vulnerabilities.

An Invalid Script Purpose Attack reuses a spending validator as a minting
policy. If the script does not strictly check its purpose, it may validate
under @MintingScript@ context even though it was intended to run only under
@SpendingScript@ context.

== Consequences ==

1. __Authorization bypass__: Spending-specific checks may be skipped when the
   same script is executed under minting purpose.

2. __Unexpected code paths__: Purpose-dependent logic can be triggered in ways
   that were never intended by contract authors.

== Mitigation ==

A secure spending validator should explicitly reject non-spending purposes,
for example by matching only on @SpendingScript@ and failing otherwise.

This threat model mutates a valid transaction by adding a mint action that
executes the provided Plutus V3 script as a minting policy. If the modified
transaction still validates, the script may be vulnerable to purpose confusion.
-}
module Convex.ThreatModel.InvalidScriptPurpose (
  invalidScriptPurposeAttack,
  invalidScriptPurposeAttackWith,
) where

import Cardano.Api qualified as C
import Convex.ThreatModel
import Convex.ThreatModel.Cardano.Api (IsPlutusScriptInEra)
import Convex.ThreatModel.TxModifier (addPlutusScriptMint)
import GHC.Exts (fromList)

{- | Default Invalid Script Purpose attack for Plutus V3 scripts.

Uses a unit-style redeemer (@Constr 0 []@), mints quantity 1, and uses a test
asset name @"deadbeef"@.
-}
invalidScriptPurposeAttack
  :: (IsPlutusScriptInEra lang)
  => C.PlutusScript lang
  -> ThreatModel ()
invalidScriptPurposeAttack :: forall lang.
IsPlutusScriptInEra lang =>
PlutusScript lang -> ThreatModel ()
invalidScriptPurposeAttack =
  ScriptData
-> AssetName -> Quantity -> PlutusScript lang -> ThreatModel ()
forall lang.
IsPlutusScriptInEra lang =>
ScriptData
-> AssetName -> Quantity -> PlutusScript lang -> ThreatModel ()
invalidScriptPurposeAttackWith
    (Integer -> [ScriptData] -> ScriptData
C.ScriptDataConstructor Integer
0 [])
    (ByteString -> AssetName
C.UnsafeAssetName ByteString
"deadbeef")
    (Integer -> Quantity
C.Quantity Integer
1)

{- | Invalid Script Purpose attack with configurable redeemer/asset/quantity.

Given a script intended for spending validation, this threat model:

1. Requires that the transaction spends at least one script input
2. Selects a key-address output as recipient for minted tokens
3. Adds minting under the provided script (forcing @MintingScript@ purpose)
4. Updates the selected output value to include minted tokens
5. Expects the modified transaction to fail validation

If it validates, the contract may accept an unintended script purpose.
-}
invalidScriptPurposeAttackWith
  :: (IsPlutusScriptInEra lang)
  => C.ScriptData
  -> C.AssetName
  -> C.Quantity
  -> C.PlutusScript lang
  -> ThreatModel ()
invalidScriptPurposeAttackWith :: forall lang.
IsPlutusScriptInEra lang =>
ScriptData
-> AssetName -> Quantity -> PlutusScript lang -> ThreatModel ()
invalidScriptPurposeAttackWith ScriptData
redeemer AssetName
assetName Quantity
quantity PlutusScript lang
spendingValidator = String -> ThreatModel () -> ThreatModel ()
forall a. String -> ThreatModel a -> ThreatModel a
Named String
"Invalid Script Purpose Attack" (ThreatModel () -> ThreatModel ())
-> ThreatModel () -> ThreatModel ()
forall a b. (a -> b) -> a -> b
$ do
  -- Precondition: at least one script input must be spent so a script validator runs.
  Input
_ <- (Input -> Bool) -> ThreatModel Input
anyInputSuchThat (Bool -> Bool
not (Bool -> Bool) -> (Input -> Bool) -> Input -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AddressAny -> Bool
isKeyAddressAny (AddressAny -> Bool) -> (Input -> AddressAny) -> Input -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Input -> AddressAny
forall t. IsInputOrOutput t => t -> AddressAny
addressOf)

  -- Prefer a key-address output to receive minted test tokens.
  Output
output <- (Output -> Bool) -> ThreatModel Output
anyOutputSuchThat (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)

  let policyId :: PolicyId
policyId = ScriptHash -> PolicyId
C.PolicyId (ScriptHash -> PolicyId) -> ScriptHash -> PolicyId
forall a b. (a -> b) -> a -> b
$ Script lang -> ScriptHash
forall lang. Script lang -> ScriptHash
hashScript (PlutusScriptVersion lang -> PlutusScript lang -> Script lang
forall lang.
IsPlutusScriptLanguage lang =>
PlutusScriptVersion lang -> PlutusScript lang -> Script lang
C.PlutusScript PlutusScriptVersion lang
forall lang.
IsPlutusScriptLanguage lang =>
PlutusScriptVersion lang
plutusScriptVersion PlutusScript lang
spendingValidator)
      mintedValue :: Value
mintedValue = [Item Value] -> Value
forall l. IsList l => [Item l] -> l
fromList [(PolicyId -> AssetName -> AssetId
C.AssetId PolicyId
policyId AssetName
assetName, Quantity
quantity)]
      newValue :: Value
newValue = Output -> Value
forall t. IsInputOrOutput t => t -> Value
valueOf Output
output Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
mintedValue

  String -> ThreatModel ()
counterexampleTM (String -> ThreatModel ()) -> String -> ThreatModel ()
forall a b. (a -> b) -> a -> b
$
    [String] -> String
paragraph
      [ String
"Testing script-purpose confusion by executing a spending validator"
      , String
"as a minting policy in the same transaction."
      ]

  String -> ThreatModel ()
counterexampleTM (String -> ThreatModel ()) -> String -> ThreatModel ()
forall a b. (a -> b) -> a -> b
$
    [String] -> String
paragraph
      [ String
"If this validates, the script accepted MintingScript context where"
      , String
"SpendingScript was expected. This can lead to authorization bypass"
      , String
"or unintended purpose-dependent behavior."
      ]

  -- This SHOULD fail. If it validates, the script is vulnerable.
  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
output Value
newValue
      TxModifier -> TxModifier -> TxModifier
forall a. Semigroup a => a -> a -> a
<> PlutusScript lang
-> AssetName -> Quantity -> ScriptData -> TxModifier
forall lang.
IsPlutusScriptInEra lang =>
PlutusScript lang
-> AssetName -> Quantity -> ScriptData -> TxModifier
addPlutusScriptMint PlutusScript lang
spendingValidator AssetName
assetName Quantity
quantity ScriptData
redeemer