diff --git a/agora-specs/Sample/AuthorityToken/UnauthorizedMintingExploit.hs b/agora-specs/Sample/AuthorityToken/UnauthorizedMintingExploit.hs new file mode 100644 index 0000000..62416e3 --- /dev/null +++ b/agora-specs/Sample/AuthorityToken/UnauthorizedMintingExploit.hs @@ -0,0 +1,66 @@ +module Sample.AuthorityToken.UnauthorizedMintingExploit ( + Parameters (..), + exploit, + mkTestCase, +) where + +import Agora.Utils (validatorHashToTokenName) +import Control.Exception (assert) +import Plutarch.Context (input, mint, normalizeValue, output, script, withValue) +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 + (validatorHashToTokenName 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 diff --git a/agora-specs/Spec/AuthorityToken.hs b/agora-specs/Spec/AuthorityToken.hs index 8d5cfc4..d388c02 100644 --- a/agora-specs/Spec/AuthorityToken.hs +++ b/agora-specs/Spec/AuthorityToken.hs @@ -10,7 +10,6 @@ Tests for Authority token functions module Spec.AuthorityToken (specs) where import Agora.AuthorityToken (singleAuthorityTokenBurned) -import Plutarch (ClosedTerm, POpaque, perror, popaque) import Plutarch.Extra.Compile (mustCompile) import Plutarch.Unsafe (punsafeCoerce) import PlutusLedgerApi.V1 ( @@ -29,21 +28,13 @@ import PlutusLedgerApi.V1.Value qualified as Value ( singleton, ) import PlutusTx.AssocMap qualified as AssocMap (empty) +import Sample.AuthorityToken.UnauthorizedMintingExploit qualified as UnauthorizedMintingExploit import Test.Specification ( SpecificationTree, group, scriptFails, scriptSucceeds, ) -import Prelude ( - Maybe (Nothing), - PBool, - Semigroup ((<>)), - fmap, - pconstant, - pif, - ($), - ) currencySymbol :: CurrencySymbol currencySymbol = "deadbeef" @@ -150,4 +141,15 @@ specs = ] ) ] + , group "unauthorized minting exploit" + $ map + ( UnauthorizedMintingExploit.mkTestCase "(negative test)" + . uncurry UnauthorizedMintingExploit.Parameters + ) + $ let l = [1 .. 10] + in [ (burnt, minted) + | burnt <- l + , minted <- l + , minted < burnt + ] ] diff --git a/agora.cabal b/agora.cabal index 853032a..6624690 100644 --- a/agora.cabal +++ b/agora.cabal @@ -192,6 +192,7 @@ library agora-specs exposed-modules: Property.Generator Property.Governor + Sample.AuthorityToken.UnauthorizedMintingExploit Sample.Effect.GovernorMutation Sample.Effect.TreasuryWithdrawal Sample.Governor.Initialize