regression tests for SST exploit

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

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]
       ]
   ]

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