74 lines
1.5 KiB
Haskell
74 lines
1.5 KiB
Haskell
module Sample.Stake.UnauthorizedMintingExploit (
|
|
Parameters (..),
|
|
exploit,
|
|
mkTestCase,
|
|
) where
|
|
|
|
import Plutarch.Context (
|
|
input,
|
|
mint,
|
|
normalizeValue,
|
|
output,
|
|
script,
|
|
withValue,
|
|
)
|
|
import Plutarch.Extra.AssetClass (assetClassValue)
|
|
import Plutarch.Extra.ScriptContext (scriptHashToTokenName)
|
|
import PlutusLedgerApi.V1.Value qualified as Value
|
|
import Sample.Shared (
|
|
minAda,
|
|
stakeAssetClass,
|
|
stakePolicy,
|
|
stakeScriptHash,
|
|
stakeSymbol,
|
|
)
|
|
import Test.Specification (SpecificationTree, testPolicy)
|
|
import Test.Util (
|
|
CombinableBuilder,
|
|
mkMinting,
|
|
validatorHashes,
|
|
)
|
|
|
|
newtype Parameters = Parameters
|
|
{ inputSST :: Int
|
|
}
|
|
|
|
exploit ::
|
|
forall b.
|
|
CombinableBuilder b =>
|
|
Parameters ->
|
|
b
|
|
exploit (Parameters inputSST) =
|
|
mconcat
|
|
[ input $
|
|
mconcat
|
|
[ script attacker
|
|
, withValue $
|
|
normalizeValue $
|
|
minAda <> fakeSSTValue inputSST
|
|
]
|
|
, mint $ fakeSSTValue $ negate inputSST
|
|
, mint sst
|
|
, output $
|
|
mconcat
|
|
[ script stakeScriptHash
|
|
, withValue $
|
|
normalizeValue $
|
|
minAda <> sst
|
|
]
|
|
]
|
|
where
|
|
attacker = head validatorHashes
|
|
|
|
fakeSSTValue =
|
|
Value.singleton
|
|
stakeSymbol
|
|
(scriptHashToTokenName attacker)
|
|
. fromIntegral
|
|
|
|
sst = assetClassValue stakeAssetClass 1
|
|
|
|
mkTestCase :: String -> Parameters -> SpecificationTree
|
|
mkTestCase name ps =
|
|
testPolicy False name stakePolicy () $
|
|
mkMinting exploit ps stakeSymbol
|