content: module Sample.AuthorityToken.UnauthorizedMintingExploit (
    Parameters (..),
    exploit,
    mkTestCase,
  ) where
  
  import Control.Exception (assert)
  import Plutarch.Context (input, mint, normalizeValue, output, script, withValue)
  import Plutarch.Extra.ScriptContext (scriptHashToTokenName)
  import PlutusLedgerApi.V1.Value qualified as Value
  import Sample.Shared (authorityTokenPolicy, authorityTokenSymbol, minAda)
  import Test.Specification (SpecificationTree, testPolicy)
  import Test.Util (CombinableBuilder, mkMinting, validatorHashes)
  
  data Parameters = Parameters
    { burntGAT :: Int
    , mintedGAT :: Int
    }
  
  exploit ::
    forall b.
    CombinableBuilder b =>
    Parameters ->
    b
  exploit (Parameters burntGAT mintedGAT) =
    assert (burntGAT > mintedGAT && mintedGAT > 0) $
      effectInputBuilder <> maliciousGATOutputBuilder
    where
      (effectScriptHashes, rest) = splitAt burntGAT validatorHashes
      maliciousScripts = take mintedGAT rest
  
      gatValue hash =
        Value.singleton
          authorityTokenSymbol
          (scriptHashToTokenName hash)
  
      mkGATUTxO hash =
        mconcat
          [ script hash
          , withValue $ normalizeValue $ minAda <> gatValue hash 1
          ]
  
      effectInputBuilder =
        foldMap
          ( \effectHash ->
              mconcat
                [ mint $ gatValue effectHash $ negate 1
                , input $ mkGATUTxO effectHash
                ]
          )
          effectScriptHashes
  
      maliciousGATOutputBuilder =
        foldMap
          ( \scriptHash ->
              mconcat
                [ mint $ gatValue scriptHash 1
                , output $ mkGATUTxO scriptHash
                ]
          )
          maliciousScripts
  
  mkTestCase :: String -> Parameters -> SpecificationTree
  mkTestCase name ps =
    testPolicy False name authorityTokenPolicy () $
      mkMinting exploit ps authorityTokenSymbol
  