{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

{- | Threat model for detecting Redeemer Asset Substitution vulnerabilities.

= What vulnerability this detects

A Redeemer Asset Substitution Attack exploits validators that trust asset
identifiers (policy IDs or token names) provided in the redeemer without
proper validation against the datum or transaction context.

= Attack scenario

Consider a validator that accepts a redeemer like:

@
SellRedeemer { sold_policy_id: ByteArray, sold_token_name: ByteArray }
@

And only checks:

@
\/\/ VULNERABLE: Trusts redeemer-provided asset without datum cross-check
let token = find_token_in_inputs(redeemer.sold_policy_id, redeemer.sold_token_name)
expect token.quantity > 0
@

Without verifying that the provided asset matches what was actually intended
(e.g., a specific token name stored in the datum).

__Real-world example: Purchase Offer CTF__

The @purchase_offer@ CTF contract stores a desired policy ID and an optional
token name in the datum:

@
Datum { owner: Address, desired_policy_id: PolicyId, desired_token_name: Option\<ByteArray\> }
@

When @desired_token_name@ is @None@, the validator accepts ANY token from
that policy. An attacker can:

1. See an offer for a valuable NFT (e.g., \"RareNFT\") from policy P
2. Acquire a worthless token \"WorthlessJunk\" under the same policy P
3. Fulfill the offer with \"WorthlessJunk\" instead of \"RareNFT\"
4. Claim the locked ADA, leaving the victim with a worthless token

= How this threat model works

This threat model uses a \"swappable pair\" approach that is Phase 1 valid:

1. __Find a script input__ — a non-key address input being spent
2. __Get its redeemer__ — extract the ScriptData redeemer
3. __Extract ByteString fields__ — these are potential token names
4. __Get all transaction outputs__
5. __Find the first output__ with a token @(policyP, originalName)@ where
   @originalName@ matches one of the redeemer ByteStrings
6. __Find a second output__ (different from the first) containing a DIFFERENT
   token @(policyP, otherName)@ from the SAME policy where @otherName \/= originalName@
7. __Swap the tokens__ between the two outputs:
   - Output1: remove @(policyP, originalName)@, add @(policyP, otherName)@
   - Output2: remove @(policyP, otherName)@, add @(policyP, originalName)@
8. __Substitute the redeemer__: replace @originalName@ ByteString with @otherName@ in the redeemer
9. __Check validation__: the modified transaction should NOT validate

If the modified transaction validates (accepting the swapped token names),
the validator is vulnerable because it accepts any token name without
cross-checking the datum.

= Why Phase 1 validity matters

Cardano transactions go through two phases of validation:

- __Phase 1__: Ledger rules checking (value preservation, signatures, etc.)
- __Phase 2__: Script execution (Plutus validators)

Phase 1 enforces that total value in = total value out + fees. A transaction
that claims to send a token that doesn't exist in any input would be rejected
at Phase 1 before the validator script even runs.

By swapping EXISTING tokens between outputs (rather than inventing non-existent
tokens), this threat model creates transactions that pass Phase 1 and actually
reach the validator for Phase 2 execution. This tests the real attack scenario
where an attacker possesses a worthless token from the same collection.

= Preconditions required

The transaction must contain at least two different tokens from the same policy
in different outputs. This naturally happens when:

- The wallet holds multiple tokens from the same policy (e.g., a valuable NFT
  and a worthless one from the same collection)
- Coin selection includes a UTxO containing extra tokens from the same policy
- The fulfill transaction sends one token to the contract owner and returns
  another as change

= How to satisfy preconditions in TestingInterface

When writing a 'Convex.ThreatModel.TestingInterface.TestingInterface' instance,
the @perform@ action for the relevant scenario should ensure the wallet holds
multiple tokens from the same policy.

Example approach:

1. In the setup\/mint action, mint BOTH a \"valuable\" token AND a \"worthless\"
   token from the same policy to the attacker's wallet
2. When the attacker calls @perform@ on the fulfill action, coin selection will
   naturally include the UTxO containing both tokens
3. The fulfill transaction will have one token going to the contract owner's
   output and the other in the change output
4. The threat model can now find the swappable pair and test the vulnerability

This mirrors the real attack scenario: the attacker legitimately possesses a
worthless token from the same NFT collection and uses it to fraudulently
fulfill an offer meant for a valuable token.

= Consequences of the vulnerability

1. __Asset theft__: Attackers fulfill offers with worthless tokens
2. __Protocol manipulation__: Wrong assets can satisfy contract conditions
3. __Value extraction__: Locked funds can be drained with substitute tokens

= Mitigation

A secure validator should:

- Store specific asset identifiers (including token name) in the datum
- Always validate redeemer-provided values against datum or script context
- Never trust attacker-controlled redeemer data for asset identification
- Use token name in datum when specificity is required
-}
module Convex.ThreatModel.RedeemerAssetSubstitution (
  -- * Threat models
  redeemerAssetSubstitution,
) where

import Cardano.Api qualified as C
import Convex.ThreatModel
import Data.ByteString qualified as BS
import Data.Maybe (listToMaybe)
import GHC.Exts (fromList, toList)

{- | Check for Redeemer Asset Substitution vulnerabilities using the swappable-pair approach.

This threat model:

1. Finds a script input and extracts its redeemer
2. Extracts ByteString fields from the redeemer (potential token names)
3. For each ByteString, interprets it as an 'C.AssetName' and looks for an output
   containing a token @(policyP, originalName)@ matching that ByteString
4. Searches for a SECOND output (different from the first) containing a DIFFERENT
   token @(policyP, otherName)@ from the SAME policy
5. Swaps the tokens between the two outputs (preserving total value)
6. Substitutes the redeemer ByteString with the other token's name
7. Checks that the modified transaction does NOT validate

== Precondition failure

If no swappable pair is found, the threat model calls 'failPrecondition' with
a message explaining what's needed. This results in the test being SKIPPED
(not failed) because the transaction doesn't have the structure needed to
test this particular vulnerability.

To satisfy the precondition, ensure the transaction has at least two different
tokens from the same policy in different outputs. See the module documentation
for strategies to achieve this in 'TestingInterface'.

== Example: Before and After

__Before swap:__

@
Output 0: 50 ADA + 1 (PolicyX, \"ValuableNFT\")    -- to contract owner
Output 1: 10 ADA + 1 (PolicyX, \"WorthlessJunk\")  -- change output
Redeemer: SellRedeemer { token_name: \"ValuableNFT\" }
@

__After swap:__

@
Output 0: 50 ADA + 1 (PolicyX, \"WorthlessJunk\")  -- swapped!
Output 1: 10 ADA + 1 (PolicyX, \"ValuableNFT\")    -- swapped!
Redeemer: SellRedeemer { token_name: \"WorthlessJunk\" }  -- substituted!
@

If the validator accepts this modified transaction, it is vulnerable because
it didn't verify that \"WorthlessJunk\" matches what the datum specified.

Usage:

@
threatPrecondition $ redeemerAssetSubstitution
@
-}
redeemerAssetSubstitution :: ThreatModel ()
redeemerAssetSubstitution :: ThreatModel ()
redeemerAssetSubstitution = [Char] -> ThreatModel () -> ThreatModel ()
forall a. [Char] -> ThreatModel a -> ThreatModel a
Named [Char]
"Redeemer Asset Substitution" (ThreatModel () -> ThreatModel ())
-> ThreatModel () -> ThreatModel ()
forall a b. (a -> b) -> a -> b
$ do
  -- Step 1: Find a script input (non-key address input)
  Input
scriptInput <- (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)

  -- Step 2: Get the redeemer for this script input
  Redeemer
redeemer <-
    Input -> ThreatModel (Maybe Redeemer)
getRedeemer Input
scriptInput ThreatModel (Maybe Redeemer)
-> (Maybe Redeemer -> ThreatModel Redeemer) -> ThreatModel Redeemer
forall a b. ThreatModel a -> (a -> ThreatModel b) -> ThreatModel b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe Redeemer
Nothing -> [Char] -> ThreatModel Redeemer
forall a. [Char] -> ThreatModel a
failPrecondition [Char]
"No redeemer found for script input"
      Just Redeemer
redeemer' -> Redeemer -> ThreatModel Redeemer
forall a. a -> ThreatModel a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Redeemer
redeemer'

  -- Step 3: Extract all ByteStrings from the redeemer (potential token names)
  let redeemerByteStrings :: [ByteString]
redeemerByteStrings = Redeemer -> [ByteString]
extractByteStrings Redeemer
redeemer

  -- Filter to valid token name candidates (non-empty, <= 32 bytes per Cardano spec)
  let validByteStrings :: [ByteString]
validByteStrings = (ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
filter (\ByteString
bs -> Bool -> Bool
not (ByteString -> Bool
BS.null ByteString
bs) Bool -> Bool -> Bool
&& ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
32) [ByteString]
redeemerByteStrings

  -- Fail precondition if no valid ByteStrings found in redeemer
  [ByteString]
_ <- case [ByteString]
validByteStrings of
    [] -> [Char] -> ThreatModel [ByteString]
forall a. [Char] -> ThreatModel a
failPrecondition [Char]
"No valid ByteStrings found in redeemer (empty or too long)"
    [ByteString]
xs -> [ByteString] -> ThreatModel [ByteString]
forall a. a -> ThreatModel a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ByteString]
xs

  -- Step 4: Get all transaction outputs
  [Output]
outputs <- ThreatModel [Output]
getTxOutputs

  -- Step 5 & 6: Find a swappable pair
  -- For each redeemer ByteString, find:
  --   (a) An output containing token (policyP, originalName) where originalName matches the ByteString
  --   (b) A DIFFERENT output containing token (policyP, otherName) from the SAME policy
  let swappablePairs :: [(Output, Output, PolicyId, AssetName, AssetName, Quantity,
  Quantity, ByteString)]
swappablePairs = [ByteString]
-> [Output]
-> [(Output, Output, PolicyId, AssetName, AssetName, Quantity,
     Quantity, ByteString)]
findSwappablePairs [ByteString]
validByteStrings [Output]
outputs

  -- Pick the first valid swappable pair, or fail precondition
  (Output
output1, Output
output2, PolicyId
policyId, AssetName
origAssetName, AssetName
otherAssetName, Quantity
origQty, Quantity
otherQty, ByteString
origBs) <-
    case [(Output, Output, PolicyId, AssetName, AssetName, Quantity,
  Quantity, ByteString)]
-> Maybe
     (Output, Output, PolicyId, AssetName, AssetName, Quantity,
      Quantity, ByteString)
forall a. [a] -> Maybe a
listToMaybe [(Output, Output, PolicyId, AssetName, AssetName, Quantity,
  Quantity, ByteString)]
swappablePairs of
      Maybe
  (Output, Output, PolicyId, AssetName, AssetName, Quantity,
   Quantity, ByteString)
Nothing ->
        [Char]
-> ThreatModel
     (Output, Output, PolicyId, AssetName, AssetName, Quantity,
      Quantity, ByteString)
forall a. [Char] -> ThreatModel a
failPrecondition ([Char]
 -> ThreatModel
      (Output, Output, PolicyId, AssetName, AssetName, Quantity,
       Quantity, ByteString))
-> [Char]
-> ThreatModel
     (Output, Output, PolicyId, AssetName, AssetName, Quantity,
      Quantity, ByteString)
forall a b. (a -> b) -> a -> b
$
          [Char]
"No swappable token pair found. The transaction needs at least two different "
            [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"tokens from the same policy in different outputs. This naturally happens when "
            [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"the wallet holds multiple tokens from the same policy and coin selection "
            [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"includes them in the transaction."
      Just (Output, Output, PolicyId, AssetName, AssetName, Quantity,
 Quantity, ByteString)
pair -> (Output, Output, PolicyId, AssetName, AssetName, Quantity,
 Quantity, ByteString)
-> ThreatModel
     (Output, Output, PolicyId, AssetName, AssetName, Quantity,
      Quantity, ByteString)
forall a. a -> ThreatModel a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Output, Output, PolicyId, AssetName, AssetName, Quantity,
 Quantity, ByteString)
pair

  -- Step 7: Build the swapped values for both outputs
  -- Output1: remove originalName, add otherName
  -- Output2: remove otherName, add originalName
  let newValue1 :: Value
newValue1 = PolicyId
-> AssetName -> AssetName -> Quantity -> Quantity -> Value -> Value
swapToken PolicyId
policyId AssetName
origAssetName AssetName
otherAssetName Quantity
origQty Quantity
otherQty (Output -> Value
forall t. IsInputOrOutput t => t -> Value
valueOf Output
output1)
      newValue2 :: Value
newValue2 = PolicyId
-> AssetName -> AssetName -> Quantity -> Quantity -> Value -> Value
swapToken PolicyId
policyId AssetName
otherAssetName AssetName
origAssetName Quantity
otherQty Quantity
origQty (Output -> Value
forall t. IsInputOrOutput t => t -> Value
valueOf Output
output2)

  -- Step 8: Build the modified redeemer (substitute originalName with otherName)
  let C.UnsafeAssetName ByteString
otherBs = AssetName
otherAssetName
      modifiedRedeemer :: Redeemer
modifiedRedeemer = ByteString -> ByteString -> Redeemer -> Redeemer
substituteByteString ByteString
origBs ByteString
otherBs Redeemer
redeemer

  -- Log counterexample information for debugging
  [Char] -> ThreatModel ()
counterexampleTM ([Char] -> ThreatModel ()) -> [Char] -> ThreatModel ()
forall a b. (a -> b) -> a -> b
$
    [[Char]] -> [Char]
paragraph
      [ [Char]
"Testing Redeemer Asset Substitution vulnerability (swappable-pair approach):"
      , [Char]
"Found two outputs with different tokens from the same policy."
      , [Char]
"Swapping tokens between outputs and substituting redeemer."
      ]

  [Char] -> ThreatModel ()
counterexampleTM ([Char] -> ThreatModel ()) -> [Char] -> ThreatModel ()
forall a b. (a -> b) -> a -> b
$
    [[Char]] -> [Char]
paragraph
      [ [Char]
"Policy: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ PolicyId -> [Char]
forall a. Show a => a -> [Char]
show PolicyId
policyId
      , [Char]
"Original token (from redeemer): " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ AssetName -> [Char]
forall a. Show a => a -> [Char]
show AssetName
origAssetName
      , [Char]
"Other token (for swap): " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ AssetName -> [Char]
forall a. Show a => a -> [Char]
show AssetName
otherAssetName
      ]

  [Char] -> ThreatModel ()
counterexampleTM ([Char] -> ThreatModel ()) -> [Char] -> ThreatModel ()
forall a b. (a -> b) -> a -> b
$
    [[Char]] -> [Char]
paragraph
      [ [Char]
"Output 1 original value: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Value -> [Char]
forall a. Show a => a -> [Char]
show (Output -> Value
forall t. IsInputOrOutput t => t -> Value
valueOf Output
output1)
      , [Char]
"Output 1 new value: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Value -> [Char]
forall a. Show a => a -> [Char]
show Value
newValue1
      , [Char]
"Output 2 original value: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Value -> [Char]
forall a. Show a => a -> [Char]
show (Output -> Value
forall t. IsInputOrOutput t => t -> Value
valueOf Output
output2)
      , [Char]
"Output 2 new value: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Value -> [Char]
forall a. Show a => a -> [Char]
show Value
newValue2
      ]

  [Char] -> ThreatModel ()
counterexampleTM ([Char] -> ThreatModel ()) -> [Char] -> ThreatModel ()
forall a b. (a -> b) -> a -> b
$
    [[Char]] -> [Char]
paragraph
      [ [Char]
"Original redeemer: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Redeemer -> [Char]
forall a. Show a => a -> [Char]
show Redeemer
redeemer
      , [Char]
"Modified redeemer: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Redeemer -> [Char]
forall a. Show a => a -> [Char]
show Redeemer
modifiedRedeemer
      ]

  [Char] -> ThreatModel ()
counterexampleTM ([Char] -> ThreatModel ()) -> [Char] -> ThreatModel ()
forall a b. (a -> b) -> a -> b
$
    [[Char]] -> [Char]
paragraph
      [ [Char]
"If this validates, the validator trusts redeemer-provided"
      , [Char]
"asset identifiers without cross-checking the datum."
      , [Char]
"An attacker could substitute worthless tokens for valuable ones."
      ]

  -- Step 9 & 10: Compose modifications and check validation
  -- The modified transaction should NOT validate
  -- If it does validate, the contract is vulnerable
  TxModifier -> ThreatModel ()
shouldNotValidate (TxModifier -> ThreatModel ()) -> TxModifier -> ThreatModel ()
forall a b. (a -> b) -> a -> b
$
    Input -> Redeemer -> TxModifier
changeRedeemerOf Input
scriptInput Redeemer
modifiedRedeemer
      TxModifier -> TxModifier -> TxModifier
forall a. Semigroup a => a -> a -> a
<> Output -> Value -> TxModifier
forall t. IsInputOrOutput t => t -> Value -> TxModifier
changeValueOf Output
output1 Value
newValue1
      TxModifier -> TxModifier -> TxModifier
forall a. Semigroup a => a -> a -> a
<> Output -> Value -> TxModifier
forall t. IsInputOrOutput t => t -> Value -> TxModifier
changeValueOf Output
output2 Value
newValue2

{- | Find all swappable pairs in the transaction.

Returns list of tuples:
(output1, output2, policyId, origAssetName, otherAssetName, origQty, otherQty, origBs)
-}
findSwappablePairs
  :: [BS.ByteString]
  -> [Output]
  -> [(Output, Output, C.PolicyId, C.AssetName, C.AssetName, C.Quantity, C.Quantity, BS.ByteString)]
findSwappablePairs :: [ByteString]
-> [Output]
-> [(Output, Output, PolicyId, AssetName, AssetName, Quantity,
     Quantity, ByteString)]
findSwappablePairs [ByteString]
validBs [Output]
outputs = do
  -- For each valid ByteString from the redeemer
  ByteString
bs <- [ByteString]
validBs
  let targetAssetName :: AssetName
targetAssetName = ByteString -> AssetName
C.UnsafeAssetName ByteString
bs

  -- Find output1: an output containing a token whose name matches the ByteString
  Output
output1 <- [Output]
outputs
  let out1Value :: Value
out1Value = Output -> Value
forall t. IsInputOrOutput t => t -> Value
valueOf Output
output1
      out1Assets :: [Item Value]
out1Assets = Value -> [Item Value]
forall l. IsList l => l -> [Item l]
toList Value
out1Value
  -- Find matching asset in output1
  (C.AssetId PolicyId
policyId AssetName
assetName1, Quantity
qty1) <- [(AssetId, Quantity)]
out1Assets
  Bool -> [()]
guard (AssetName
assetName1 AssetName -> AssetName -> Bool
forall a. Eq a => a -> a -> Bool
== AssetName
targetAssetName Bool -> Bool -> Bool
&& Quantity
qty1 Quantity -> Quantity -> Bool
forall a. Ord a => a -> a -> Bool
> Quantity
0)

  -- Find output2: a DIFFERENT output with a DIFFERENT token from the SAME policy
  Output
output2 <- [Output]
outputs
  -- Must be different output (comparing by TxIx)
  Bool -> [()]
guard (Output -> TxIx
outputIx Output
output1 TxIx -> TxIx -> Bool
forall a. Eq a => a -> a -> Bool
/= Output -> TxIx
outputIx Output
output2)
  let out2Value :: Value
out2Value = Output -> Value
forall t. IsInputOrOutput t => t -> Value
valueOf Output
output2
  -- Find a different token from the same policy in output2
  case PolicyId -> AssetName -> Value -> Maybe (AssetName, Quantity)
findDifferentTokenFromPolicy PolicyId
policyId AssetName
assetName1 Value
out2Value of
    Maybe (AssetName, Quantity)
Nothing -> []
    Just (AssetName
assetName2, Quantity
qty2) ->
      (Output, Output, PolicyId, AssetName, AssetName, Quantity,
 Quantity, ByteString)
-> [(Output, Output, PolicyId, AssetName, AssetName, Quantity,
     Quantity, ByteString)]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Output
output1, Output
output2, PolicyId
policyId, AssetName
assetName1, AssetName
assetName2, Quantity
qty1, Quantity
qty2, ByteString
bs)

-- | Find a token from the given policy with a different name than the excluded one.
findDifferentTokenFromPolicy
  :: C.PolicyId
  -> C.AssetName
  -- ^ Excluded asset name
  -> C.Value
  -> Maybe (C.AssetName, C.Quantity)
findDifferentTokenFromPolicy :: PolicyId -> AssetName -> Value -> Maybe (AssetName, Quantity)
findDifferentTokenFromPolicy PolicyId
targetPolicy AssetName
excludedName Value
value =
  let assets :: [Item Value]
assets = Value -> [Item Value]
forall l. IsList l => l -> [Item l]
toList Value
value
      candidates :: [(AssetName, Quantity)]
candidates =
        [ (AssetName
name, Quantity
qty)
        | (C.AssetId PolicyId
policy AssetName
name, Quantity
qty) <- [(AssetId, Quantity)]
assets
        , PolicyId
policy PolicyId -> PolicyId -> Bool
forall a. Eq a => a -> a -> Bool
== PolicyId
targetPolicy
        , AssetName
name AssetName -> AssetName -> Bool
forall a. Eq a => a -> a -> Bool
/= AssetName
excludedName
        , Quantity
qty Quantity -> Quantity -> Bool
forall a. Ord a => a -> a -> Bool
> Quantity
0
        ]
   in [(AssetName, Quantity)] -> Maybe (AssetName, Quantity)
forall a. [a] -> Maybe a
listToMaybe [(AssetName, Quantity)]
candidates

{- | Swap a token in a Value: remove one asset and add another from the same policy.

Removes @(policy, removeAsset)@ with @removeQty@ and adds @(policy, addAsset)@ with @addQty@.
-}
swapToken
  :: C.PolicyId
  -> C.AssetName
  -- ^ Asset to remove
  -> C.AssetName
  -- ^ Asset to add
  -> C.Quantity
  -- ^ Quantity to remove
  -> C.Quantity
  -- ^ Quantity to add
  -> C.Value
  -> C.Value
swapToken :: PolicyId
-> AssetName -> AssetName -> Quantity -> Quantity -> Value -> Value
swapToken PolicyId
policyId AssetName
removeAsset AssetName
addAsset Quantity
removeQty Quantity
addQty Value
value =
  Value
value
    Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value -> Value
C.negateValue ([Item Value] -> Value
forall l. IsList l => [Item l] -> l
fromList [(PolicyId -> AssetName -> AssetId
C.AssetId PolicyId
policyId AssetName
removeAsset, Quantity
removeQty)])
    Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> [Item Value] -> Value
forall l. IsList l => [Item l] -> l
fromList [(PolicyId -> AssetName -> AssetId
C.AssetId PolicyId
policyId AssetName
addAsset, Quantity
addQty)]

{- | Extract all ByteStrings from a ScriptData structure.

Recursively traverses the ScriptData and returns all ByteString values found.
These are potential token names that the validator might be trusting from the redeemer.
-}
extractByteStrings :: C.ScriptData -> [BS.ByteString]
extractByteStrings :: Redeemer -> [ByteString]
extractByteStrings = Redeemer -> [ByteString]
go
 where
  go :: C.ScriptData -> [BS.ByteString]
  go :: Redeemer -> [ByteString]
go Redeemer
sd = case Redeemer
sd of
    C.ScriptDataBytes ByteString
bs -> [ByteString
bs]
    C.ScriptDataConstructor Integer
_ [Redeemer]
fields -> (Redeemer -> [ByteString]) -> [Redeemer] -> [ByteString]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Redeemer -> [ByteString]
go [Redeemer]
fields
    C.ScriptDataList [Redeemer]
items -> (Redeemer -> [ByteString]) -> [Redeemer] -> [ByteString]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Redeemer -> [ByteString]
go [Redeemer]
items
    C.ScriptDataMap [(Redeemer, Redeemer)]
pairs -> ((Redeemer, Redeemer) -> [ByteString])
-> [(Redeemer, Redeemer)] -> [ByteString]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Redeemer
k, Redeemer
v) -> Redeemer -> [ByteString]
go Redeemer
k [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ Redeemer -> [ByteString]
go Redeemer
v) [(Redeemer, Redeemer)]
pairs
    C.ScriptDataNumber Integer
_ -> []

{- | Substitute a specific ByteString with a new value in ScriptData.

Replaces ALL occurrences of the target ByteString with the replacement.
This is used to modify the redeemer to use the swapped token name.
-}
substituteByteString :: BS.ByteString -> BS.ByteString -> C.ScriptData -> C.ScriptData
substituteByteString :: ByteString -> ByteString -> Redeemer -> Redeemer
substituteByteString ByteString
target ByteString
replacement = Redeemer -> Redeemer
go
 where
  go :: C.ScriptData -> C.ScriptData
  go :: Redeemer -> Redeemer
go Redeemer
sd = case Redeemer
sd of
    C.ScriptDataBytes ByteString
bs
      | ByteString
bs ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
target -> ByteString -> Redeemer
C.ScriptDataBytes ByteString
replacement
      | Bool
otherwise -> Redeemer
sd
    C.ScriptDataConstructor Integer
n [Redeemer]
fields ->
      Integer -> [Redeemer] -> Redeemer
C.ScriptDataConstructor Integer
n ((Redeemer -> Redeemer) -> [Redeemer] -> [Redeemer]
forall a b. (a -> b) -> [a] -> [b]
map Redeemer -> Redeemer
go [Redeemer]
fields)
    C.ScriptDataList [Redeemer]
items ->
      [Redeemer] -> Redeemer
C.ScriptDataList ((Redeemer -> Redeemer) -> [Redeemer] -> [Redeemer]
forall a b. (a -> b) -> [a] -> [b]
map Redeemer -> Redeemer
go [Redeemer]
items)
    C.ScriptDataMap [(Redeemer, Redeemer)]
pairs ->
      [(Redeemer, Redeemer)] -> Redeemer
C.ScriptDataMap [(Redeemer -> Redeemer
go Redeemer
k, Redeemer -> Redeemer
go Redeemer
v) | (Redeemer
k, Redeemer
v) <- [(Redeemer, Redeemer)]
pairs]
    C.ScriptDataNumber Integer
_ -> Redeemer
sd

-- | Guard helper for list comprehensions
guard :: Bool -> [()]
guard :: Bool -> [()]
guard Bool
True = [()]
guard Bool
False = []