66 lines
1.8 KiB
Haskell
66 lines
1.8 KiB
Haskell
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
|