diff --git a/agora-specs/Sample/Stake/UnauthorizedMintingExploit.hs b/agora-specs/Sample/Stake/UnauthorizedMintingExploit.hs new file mode 100644 index 0000000..4523713 --- /dev/null +++ b/agora-specs/Sample/Stake/UnauthorizedMintingExploit.hs @@ -0,0 +1,74 @@ +module Sample.Stake.UnauthorizedMintingExploit ( + Parameters (..), + exploit, + mkTestCase, +) where + +import Agora.Utils (validatorHashToTokenName) +import Plutarch.Context ( + input, + mint, + normalizeValue, + output, + script, + withValue, + ) +import Plutarch.Extra.AssetClass (assetClassValue) +import PlutusLedgerApi.V1.Value qualified as Value +import Sample.Shared ( + minAda, + stakeAssetClass, + stakePolicy, + stakeSymbol, + stakeValidatorHash, + ) +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 stakeValidatorHash + , withValue $ + normalizeValue $ + minAda <> sst + ] + ] + where + attacker = head validatorHashes + + fakeSSTValue = + Value.singleton + stakeSymbol + (validatorHashToTokenName attacker) + . fromIntegral + + sst = assetClassValue stakeAssetClass 1 + +mkTestCase :: String -> Parameters -> SpecificationTree +mkTestCase name ps = + testPolicy False name stakePolicy () $ + mkMinting exploit ps stakeSymbol diff --git a/agora-specs/Spec/Stake.hs b/agora-specs/Spec/Stake.hs index ae26e88..7f864b2 100644 --- a/agora-specs/Spec/Stake.hs +++ b/agora-specs/Spec/Stake.hs @@ -29,6 +29,7 @@ import Sample.Stake qualified as Stake ( import Sample.Stake.Create qualified as Create import Sample.Stake.Destroy qualified as Destroy import Sample.Stake.SetDelegate qualified as SetDelegate +import Sample.Stake.UnauthorizedMintingExploit qualified as UnauthorizedMintingExploit import Test.Specification ( SpecificationTree, group, @@ -179,5 +180,13 @@ specs = SetDelegate.invalidOutputStakeDatumParameters False ] + , group + "unauthorized SST minting exploit" + $ map + ( UnauthorizedMintingExploit.mkTestCase + "(negative test)" + . UnauthorizedMintingExploit.Parameters + ) + [1 .. 20] ] ] diff --git a/agora.cabal b/agora.cabal index 6624690..767160d 100644 --- a/agora.cabal +++ b/agora.cabal @@ -209,6 +209,7 @@ library agora-specs Sample.Stake.Create Sample.Stake.Destroy Sample.Stake.SetDelegate + Sample.Stake.UnauthorizedMintingExploit Sample.Treasury Spec.AuthorityToken Spec.Effect.GovernorMutation