{-# LANGUAGE OverloadedStrings #-}

{- | Threat model for detecting Token Forgery vulnerabilities.

A Token Forgery Attack exploits minting policies that are too permissive.
If a minting policy allows tokens to be minted under weak conditions (e.g.,
just requiring any signature), an attacker can mint unauthorized tokens.

== Vulnerability Pattern ==

A vulnerable minting policy might only check:

@
MintValidation -> {
  // VULNERABLE: Anyone who signs can mint!
  list.length(self.extra_signatories) > 0
}
@

This is trivially satisfied by ANY signed transaction, allowing anyone to
forge tokens that should be restricted.

== Consequences ==

1. __Validation token bypass__: If a validator requires a "validation token"
   to prove authorization, attackers can mint their own tokens.

2. __Asset theft__: Forged tokens can be used to satisfy validator checks,
   potentially draining funds.

3. __Protocol manipulation__: In DeFi protocols, forged governance or
   utility tokens can manipulate voting, rewards, or access control.

== Mitigation ==

A secure minting policy should:

- Require specific authorized signers (not just "any signature")
- Check that minting is authorized by a governance mechanism
- Verify minting is part of a valid protocol operation
- Use one-shot minting for unique tokens (NFTs, thread tokens)

This threat model tests if additional tokens can be minted using the same
minting policy that the transaction already uses. If the transaction still
validates with extra minted tokens, the minting policy may be too permissive.
-}
module Convex.ThreatModel.TokenForgery (
  -- * Threat models
  tokenForgeryAttack,
  tokenForgeryAttackWith,

  -- * Helpers
  simpleAlwaysSucceedsMintingPolicyV2,
  simpleTestAssetName,
) 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)
import PlutusLedgerApi.Test.Examples (alwaysSucceedingNAryFunction)

{- | Check for Token Forgery vulnerabilities with a Plutus V2 minting policy.

Given a minting policy and asset name, this threat model attempts to mint
additional tokens with that policy. If the transaction still validates,
the minting policy is too permissive.

Usage:
@
  threatPrecondition $ tokenForgeryAttack mintingPolicy assetName
@

The redeemer used is @Constr 0 []@ (unit), which is common for simple
minting policies. Use 'tokenForgeryAttackWith' for custom redeemers.
-}
tokenForgeryAttack
  :: (IsPlutusScriptInEra lang)
  => C.PlutusScript lang
  -- ^ The minting policy to test
  -> C.AssetName
  -- ^ The asset name to mint
  -> ThreatModel ()
tokenForgeryAttack :: forall lang.
IsPlutusScriptInEra lang =>
PlutusScript lang -> AssetName -> ThreatModel ()
tokenForgeryAttack = ScriptData -> PlutusScript lang -> AssetName -> ThreatModel ()
forall lang.
IsPlutusScriptInEra lang =>
ScriptData -> PlutusScript lang -> AssetName -> ThreatModel ()
tokenForgeryAttackWith ScriptData
unitRedeemer
 where
  unitRedeemer :: ScriptData
unitRedeemer = Integer -> [ScriptData] -> ScriptData
C.ScriptDataConstructor Integer
0 []

{- | Check for Token Forgery vulnerabilities with a custom redeemer.

This variant allows specifying the redeemer to use when attempting to
mint additional tokens. This is useful when the minting policy expects
a specific redeemer format.

@
  -- Test with MintValidation redeemer (Constr 0 [])
  tokenForgeryAttackWith (ScriptDataConstructor 0 []) mintingPolicy assetName

  -- Test with custom redeemer
  tokenForgeryAttackWith myRedeemer mintingPolicy assetName
@
-}
tokenForgeryAttackWith
  :: (IsPlutusScriptInEra lang)
  => C.ScriptData
  -- ^ Redeemer for the minting policy
  -> C.PlutusScript lang
  -- ^ The minting policy to test
  -> C.AssetName
  -- ^ The asset name to mint
  -> ThreatModel ()
tokenForgeryAttackWith :: forall lang.
IsPlutusScriptInEra lang =>
ScriptData -> PlutusScript lang -> AssetName -> ThreatModel ()
tokenForgeryAttackWith ScriptData
redeemer PlutusScript lang
mintScript AssetName
assetName = [Char] -> ThreatModel () -> ThreatModel ()
forall a. [Char] -> ThreatModel a -> ThreatModel a
Named [Char]
"Token Forgery Attack" (ThreatModel () -> ThreatModel ())
-> ThreatModel () -> ThreatModel ()
forall a b. (a -> b) -> a -> b
$ do
  -- Find an output to add the minted tokens to
  -- Prefer a key address output (like the change output)
  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)

  [Char] -> ThreatModel ()
counterexampleTM ([Char] -> ThreatModel ()) -> [Char] -> ThreatModel ()
forall a b. (a -> b) -> a -> b
$
    [[Char]] -> [Char]
paragraph
      [ [Char]
"Testing Token Forgery vulnerability:"
      , [Char]
"Attempting to mint additional tokens using the provided minting policy."
      , [Char]
"Adding minted tokens to output at " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Doc -> [Char]
forall a. Show a => a -> [Char]
show (AddressAny -> Doc
prettyAddress (AddressAny -> Doc) -> AddressAny -> Doc
forall a b. (a -> b) -> a -> b
$ Output -> AddressAny
forall t. IsInputOrOutput t => t -> AddressAny
addressOf Output
output) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"."
      ]

  [Char] -> ThreatModel ()
counterexampleTM ([Char] -> ThreatModel ()) -> [Char] -> ThreatModel ()
forall a b. (a -> b) -> a -> b
$
    [[Char]] -> [Char]
paragraph
      [ [Char]
"If this validates, the minting policy is too permissive."
      , [Char]
"An attacker could forge tokens to:"
      , [Char]
"1) Bypass validation token requirements"
      , [Char]
"2) Steal assets protected by token checks"
      , [Char]
"3) Manipulate protocol state"
      ]

  -- Calculate the minted asset value
  let scriptHash :: ScriptHash
scriptHash = Script lang -> ScriptHash
forall lang. Script lang -> ScriptHash
C.hashScript (Script lang -> ScriptHash) -> Script lang -> ScriptHash
forall a b. (a -> b) -> a -> b
$ 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
mintScript
      policyId :: PolicyId
policyId = ScriptHash -> PolicyId
C.PolicyId ScriptHash
scriptHash
      mintedValue :: Value
mintedValue = [Item Value] -> Value
forall l. IsList l => [Item l] -> l
fromList [(PolicyId -> AssetName -> AssetId
C.AssetId PolicyId
policyId AssetName
assetName, Quantity
1)]
      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

  -- Try to mint one additional token with the given policy and add it to the output
  -- This SHOULD fail - if it validates, the policy 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
mintScript AssetName
assetName (Integer -> Quantity
C.Quantity Integer
1) ScriptData
redeemer

-- ============================================================================
-- Helper functions for threat model usage
-- ============================================================================

{- | A simple Plutus minting policy that always validates (for testing).

This provides a reusable always-succeeds minting policy suitable for
testing token forgery vulnerabilities. It's commonly used to create
throwaway minting policies when testing spending validators.

Usage:
@
  threatModels = [ tokenForgeryAttack simpleAlwaysSucceedsMintingPolicyV3 simpleTestAssetName ]
@
-}
simpleAlwaysSucceedsMintingPolicyV2 :: C.PlutusScript C.PlutusScriptV2
simpleAlwaysSucceedsMintingPolicyV2 :: PlutusScript PlutusScriptV2
simpleAlwaysSucceedsMintingPolicyV2 =
  ShortByteString -> PlutusScript PlutusScriptV2
forall lang. ShortByteString -> PlutusScript lang
C.PlutusScriptSerialised (ShortByteString -> PlutusScript PlutusScriptV2)
-> ShortByteString -> PlutusScript PlutusScriptV2
forall a b. (a -> b) -> a -> b
$
    Natural -> ShortByteString
alwaysSucceedingNAryFunction Natural
2

{- | A simple asset name for testing (empty string).

This provides a basic asset name for use with token forgery attacks
and other threat model testing where the asset name is not critical.

The empty asset name is a common convention for test tokens.
-}
simpleTestAssetName :: C.AssetName
simpleTestAssetName :: AssetName
simpleTestAssetName = ByteString -> AssetName
C.UnsafeAssetName ByteString
""