Fix critical exploit

[colll78]

Fix an exploit that allows burning >2 legitimate GATs from faulty effect validators to mint 1 (or more) illegitimate GAT.

[chfanghr]

Minting a GAT would require the GST to be moved, thus requiring a valid proposal. Can you give us a minimum example of how the attack will work?

[colll78]

Minting a GAT would require the GST to be moved, thus requiring a valid proposal. Can you give us a minimum example of how the attack will work?

As a malicious user, I create a proposal with multiple non-malicious but malformed effects (ie the effects don't use makeEffect that checks that exactly 1 GAT is spent in the transaction inputs) , the proposal passes and authority tokens are issued to the effects. Now the user spends 2 or more GATs from the effects that passed from the legitimate proposal, and mints 1 or more illegitimate GATs because the GAT minting policy validates if (psymbolValueOf # ownSymbol # mintedValue #< 0) which is still the case if 2 GATs are burned while 1 GAT is minted.

[chfanghr]

I see. Let's say we have m legit GATs to be burnt, and n GATs to be minted. This is possible cause these two sets of GATs have different token names. If m>n, m-n<0 will be true, so the validation will pass and allow n GATs to be minted.

[chfanghr]

So only allowing one GAT to be burnt at a time won't be sufficient. Also, it would be great if we can keep the ability to burn multiple GATs in one tx.

[colll78]

So only allowing one GAT to be burnt at a time won't be sufficient. Also, it would be great if we can keep the ability to burn multiple GATs in on tx.

Yes, my proposed solution uses the singleAuthorityTokenBurned which insures that only 1 GAT was included in the transaction inputs (and thus at most 1 can be burned) thus making this exploit impossible. However, I agree that it would be better if a solution could fix this while still allowing multiple GATs to be burned in the same transaction. Perhaps instead of using singleAuthorityTokenBurned I can simply check pall # plam (\i -> i #< 0) # flattenedMintedValues (ie you cannot mint and burn GATs in the same transaction, so if you are burning then all the amounts in mintedValue must be negative)

[chfanghr]

What I have in mind:

diff --git a/agora/Agora/AuthorityToken.hs b/agora/Agora/AuthorityToken.hs
index 9de629d..d3f245b 100644
--- a/agora/Agora/AuthorityToken.hs
+++ b/agora/Agora/AuthorityToken.hs
@@ -11,6 +11,7 @@ module Agora.AuthorityToken (
   singleAuthorityTokenBurned,
 ) where
 
+import Agora.Utils (passert, pnegativeSymbolValueOf, ppositiveSymbolValueOf)
 import Plutarch.Api.V1 (
   PCredential (..),
   PCurrencySymbol (..),
@@ -35,6 +36,7 @@ import Plutarch.Extra.Sum (PSum (PSum))
 import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC, pmatchC)
 import Plutarch.Extra.Traversable (pfoldMap)
 import Plutarch.Extra.Value (psymbolValueOf)
+import Plutarch.Num (pnegate)
 
 --------------------------------------------------------------------------------
 
@@ -140,30 +142,29 @@ authorityTokenPolicy =
       PTxInfo txInfo' <- pmatchC $ pfromData ctx.txInfo
       txInfo <- pletFieldsC @'["inputs", "mint", "outputs"] txInfo'
       let inputs = txInfo.inputs
-          mintedValue = pfromData txInfo.mint
           govTokenSpent = pisTokenSpent # (ptoScottEncoding # atAssetClass) # inputs
 
       PMinting ownSymbol' <- pmatchC $ pfromData ctx.purpose
 
       let ownSymbol = pfromData $ pfield @"_0" # ownSymbol'
-          mintedATs =
-            psymbolValueOf
-              # ownSymbol
-              # mintedValue
+
+      applySymbolValueOf <- pletC $ plam $ \f -> f # ownSymbol # txInfo.mint
+
+      let mintedATs = applySymbolValueOf # ppositiveSymbolValueOf
+          burntATs = applySymbolValueOf # pnegativeSymbolValueOf
 
       pure $
-        pif
-          (0 #< mintedATs)
-          ( unTermCont $ do
-              pguardC "Parent token did not move in minting GATs" govTokenSpent
-              pguardC "All outputs only emit valid GATs" $
-                pall
-                  # plam
-                    (authorityTokensValidIn # ownSymbol #)
-                  # txInfo.outputs
-              pure $ popaque $ pconstant ()
-          )
-          (pif (singleAuthorityTokenBurned # ownSymbol # inputs # mintedValue) 
-            (popaque $ pconstant ())
-            perror
+        popaque $
+          pif
+            (0 #< mintedATs)
+            ( unTermCont $ do
+                pguardC "No GAT burnt" $ burntATs #== 0
+                pguardC "Parent token did not move in minting GATs" govTokenSpent
+                pguardC "All outputs only emit valid GATs" $
+                  pall
+                    # plam
+                      (authorityTokensValidIn # ownSymbol #)
+                    # txInfo.outputs
+                pure $ pconstant ()
             )
+            (passert "No GAT minted" (0 #== mintedATs) (pconstant ()))
diff --git a/agora/Agora/Utils.hs b/agora/Agora/Utils.hs
index be892d7..b6daa3e 100644
--- a/agora/Agora/Utils.hs
+++ b/agora/Agora/Utils.hs
@@ -31,16 +31,20 @@ module Agora.Utils (
   pinsertUniqueBy,
   ptryFromRedeemer,
   passert,
+  ppositiveSymbolValueOf,
+  pnegativeSymbolValueOf,
 ) where
 
 import Plutarch.Api.V1 (KeyGuarantees (Unsorted), PPOSIXTime, PRedeemer, PTokenName, PValidatorHash)
 import Plutarch.Api.V1.AssocMap (PMap, plookup)
-import Plutarch.Api.V2 (PScriptHash, PScriptPurpose)
+import Plutarch.Api.V2 (AmountGuarantees, PCurrencySymbol, PMap (PMap), PScriptHash, PScriptPurpose, PValue (PValue))
 import Plutarch.Extra.Applicative (PApplicative (ppure))
 import Plutarch.Extra.Category (PCategory (pidentity))
 import Plutarch.Extra.Functor (PFunctor (PSubcategory, pfmap))
-import Plutarch.Extra.Maybe (pjust, pnothing)
+import "liqwid-plutarch-extra" Plutarch.Extra.List (plookupAssoc)
+import Plutarch.Extra.Maybe (pexpectJustC, pjust, pnothing)
 import Plutarch.Extra.Ord (PComparator, POrdering (PLT), pcompareBy, pequateBy)
+import "liqwid-plutarch-extra" Plutarch.Extra.TermCont (pmatchC)
 import Plutarch.Extra.Time (PCurrentTime (PCurrentTime))
 import Plutarch.Unsafe (punsafeCoerce)
 import PlutusLedgerApi.V2 (
@@ -385,3 +389,59 @@ passert ::
   Term s a ->
   Term s a
 passert msg cond x = pif cond x $ ptraceError msg
+
+psymbolValueOfHelper ::
+  forall
+    (keys :: KeyGuarantees)
+    (amounts :: AmountGuarantees)
+    (s :: S).
+  Term
+    s
+    ( (PInteger :--> PBool)
+        :--> PCurrencySymbol
+        :--> ( PValue keys amounts
+                :--> PInteger
+             )
+    )
+psymbolValueOfHelper =
+  phoistAcyclic $
+    plam $ \cond sym value'' -> unTermCont $ do
+      PValue value' <- pmatchC value''
+      PMap value <- pmatchC value'
+      m' <-
+        pexpectJustC
+          0
+          ( plookupAssoc # pfstBuiltin
+              # psndBuiltin
+              # pdata sym
+              # value
+          )
+      PMap m <- pmatchC (pfromData m')
+      pure $
+        pfoldr
+          # plam
+            ( \x v ->
+                plet (pfromData $ psndBuiltin # x) $ \q ->
+                  pif
+                    (cond # q)
+                    (q + v)
+                    v
+            )
+          # 0
+          # m
+
+ppositiveSymbolValueOf ::
+  forall
+    (keys :: KeyGuarantees)
+    (amounts :: AmountGuarantees)
+    (s :: S).
+  Term s (PCurrencySymbol :--> (PValue keys amounts :--> PInteger))
+ppositiveSymbolValueOf = phoistAcyclic $ psymbolValueOfHelper #$ plam (0 #<)
+
+pnegativeSymbolValueOf ::
+  forall
+    (keys :: KeyGuarantees)
+    (amounts :: AmountGuarantees)
+    (s :: S).
+  Term s (PCurrencySymbol :--> (PValue keys amounts :--> PInteger))
+pnegativeSymbolValueOf = phoistAcyclic $ psymbolValueOfHelper #$ plam (#< 0)

[colll78]

I like this solution. Can you push them to this branch so we can merge? I will also coordinate with liqwid-plutarch-extra to see if it would be possible to get those functions upstreamed.

[chfanghr]

Yep, 2f7f17a. Feel free to cherry pick. The solution is not very efficient(ideally we traverse minted value only once) but will do for now. Also, version doc strings need to be added.

EDIT: 467fa73

EDIT again: Sorry for not reading your comment carefully. I don't think I can push to your branch. By the way, it would be nice if you can clean up the git history a little bit afterward.

[chfanghr]

The same attack may also apply to other scripts, which is a huge issue. I will take a closer look tomorrow. cc @emiflake.

[colll78]

Okay, it should be good to go.

[colll78]

It looks like the other place that might have this issue is:
https://github.com/Liqwid-Labs/agora/blob/staging/agora/Agora/Stake/Scripts.hs

It would only be possible here if it were possible to somehow get more than 1 ST on a single UTXO (which at first glance does not appear possible).

    let burning = unTermCont $ do
          let numStakeInputs =
                pto $
                  pfoldMap @_ @_ @(PSum PInteger)
                    # plam
                      ( \((pfield @"resolved" #) -> txOut) -> unTermCont $ do
                          txOutF <- pletFieldsC @'["value", "datum"] txOut

                          let isStakeUTxO =
                                psymbolValueOf # ownSymbol # txOutF.value #== 1

                          pmatchC isStakeUTxO
                            >>= \case
                              PTrue -> do
                                let datum =
                                      pfromData $
                                        pfromOutputDatum @(PAsData PStakeDatum)
                                          # txOutF.datum
                                          # txInfoF.datums

                                pguardC "Stake is unlocked" $
                                  pnot # (pstakeLocked # datum)

                                pure $ pcon $ PSum 1
                              PFalse -> pure mempty
                      )
                    # pfromData txInfoF.inputs

          pguardC "ST burned" $
            mintedST #== pnegate # numStakeInputs
                    # pfromData txInfoF.inputs

          pguardC "ST burned" $
            mintedST #== pnegate # numStakeInputs

Assures that psymbolValueOf # ownSymbol # txInfoF.mint is equal to pnegate # numStakeInputs and numStakeInputs is the total number of outputs in txOutputs that contain exactly 1 GAT. If it were possible to somehow get 2 STs in one UTXO, then it would not be counted in numStakeInputs thus allowing them to mint 1 (or more) STs while burning others.

[chfanghr]

This would do for now. Thanks for bringing this up @colll78. The fix for stake scripts and regression tests will be included in an upcoming pr.

[chfanghr]

For stake scripts, the attack vector would be:

1. Create a legitimate stake.
2. Destroy the stake, mint some SSTs in the same tx, and send them to some credentials controlled by the attacker.
3. Burn SSTs minted in step 2, mint some SSTs with the correct tag(hash of the stake validator) in the same tx. Attach bad stake datum and send those dire stakes to the stake validator.
4. Profit.

[lukipuki]

For stake scripts, the attack vector would be:

1. Create a legitimate stake.
2. Destroy the stake, mint some SSTs in the same tx, and send them to some credentials controlled by the attacker.

Your PR #200 forbids minting of SSTs when PDestroy redeemer is used, so this attack should not be possible once #200 is merged.

[chfanghr]

No, it will still work. PDestroy asserts that the output stake list is empty, which is filtered out by the assetclass of valid SST(tagged with the hash of the stake validator). The thing is, getStakeDatum won't error out if a SST is not properly tagged.

[chfanghr]

So, essentially, as long as the newly minted SSTs have different names, the attack will still work. The mint field of txInfo would look something like this

txInfoF.mint =
  Value $
    Map.fromList
      [
        ( sstSymbol
        , Map.fromList
            [ (validatoHashToTokenName stakeValidatorHash, negate m)
            , ("some invalid junk", n)
            ]
        )
      ]

[lukipuki]

Right, so the refactoring introduces asset class which ironically makes it less secure than the previous usage only of sstSymbol.

[chfanghr]

Hmm, I wouldn't say that. In fact, using only sstSymbol allows the attack as well 😅

[cptmikx]

I guess using psymbolValueOf anywhere where there's not only 1 fixed token name possible is pretty dangerous. We should take a close look on every single usage of psymbolValueOf and tighten the logic

[cptmikx]

For stake scripts, the attack vector would be:

1. Create a legitimate stake.

2. Destroy the stake, mint some SSTs in the same tx, and send them to some credentials controlled by the attacker.

3. Burn SSTs minted in step 2, mint some SSTs with the correct tag(hash of the stake validator) in the same tx. Attach bad stake datum and send those dire stakes to the stake validator.

4. Profit.

Yeah, you can even skip the stake validator there:

1. Mint 1 stake ST with a token name to an attacker controlled credential. I will call this token F for fake. I will call valid stake ST (with correct token name) as T.
2. Repeat point 1. a few times. The result is having 4 F across 4 attacker-controlled UTxOs, 1F each.
3. Accumulate 2 F tokens into 1 UTxO. The result is having 4 F in 3 UTxOs = {1F, 1F, 2F}
4. We construct a transaction spending the UTxOs from point 3., burning 3 F tokens and minting 1 T token. numOfStakeInputs = 2 (it skips 2F UTxO). psymbolValueOf # ownSymbol # mintedValue #== -2 (-3F + 1T = -2).
5. You just minted a valid stake ST into whatever UTxO. You can add malicious datum and profit.

Similar fix to above should work here.

[chfanghr]

I am closing this as ci refused to pick it up. But don't worry; the changes have been included in #203 and will merge alongside the SST fix. Thanks again for your contribution, @colll78 :D