diff --git a/src/Agora/AuthorityToken.hs b/src/Agora/AuthorityToken.hs index 64dcfc7..fbdd438 100644 --- a/src/Agora/AuthorityToken.hs +++ b/src/Agora/AuthorityToken.hs @@ -7,16 +7,23 @@ Tokens acting as redeemable proofs of DAO authority. -} module Agora.AuthorityToken ( authorityTokenPolicy, + authorityTokensValidIn, AuthorityToken (..), ) where import Plutarch.Api.V1 ( + PAddress (..), + PCredential (..), + PCurrencySymbol (..), + PMap (..), PScriptContext (..), PScriptPurpose (..), PTxInInfo (..), PTxInfo (..), PTxOut (..), + PValue (..), ) +import Plutarch.Builtin (pforgetData) import Plutarch.List (pfoldr') import Plutarch.Monadic qualified as P import Plutus.V1.Ledger.Value (AssetClass) @@ -25,7 +32,7 @@ import Prelude -------------------------------------------------------------------------------- -import Agora.Utils (passert, passetClassValueOf, passetClassValueOf') +import Agora.Utils (passert, passetClassValueOf, passetClassValueOf', plookup) -------------------------------------------------------------------------------- @@ -42,6 +49,41 @@ newtype AuthorityToken = AuthorityToken -------------------------------------------------------------------------------- +{- | Check that all GATs are valid in a particular TxOut. + How this is checked: an AuthorityToken should never leave + the Effect it was initially sent to, so we simply check that + the script address the token resides in matches the TokenName. + Since the TokenName was tagged upon mint with the Effect script + it was sent to, this is enough to prove validity. + + In other words, check that all assets of a particular currency symbol + are tagged with a TokenName that matches where they live. +-} +authorityTokensValidIn :: Term s (PCurrencySymbol :--> PTxOut :--> PBool) +authorityTokensValidIn = phoistAcyclic $ + plam $ \authorityTokenSym txOut'' -> P.do + PTxOut txOut' <- pmatch txOut'' + txOut <- pletFields @'["address", "value"] $ txOut' + PAddress address <- pmatch txOut.address + PValue value' <- pmatch txOut.value + PMap value <- pmatch value' + pmatch (plookup # pdata authorityTokenSym # value) $ \case + PJust (pfromData -> tokenMap') -> + pmatch (pfield @"credential" # address) $ \case + PPubKeyCredential _ -> + -- GATs should only be sent to Effect validators + pconstant False + PScriptCredential ((pfromData . (pfield @"_0" #)) -> cred) -> P.do + PMap tokenMap <- pmatch tokenMap' + pall + # ( plam $ \pair -> + pforgetData (pfstBuiltin # pair) #== pforgetData (pdata cred) + ) + # tokenMap + PNothing -> + -- No GATs exist at this output! + pconstant True + -- | Policy given 'AuthorityToken' params. authorityTokenPolicy :: AuthorityToken -> diff --git a/src/Agora/Treasury.hs b/src/Agora/Treasury.hs index 3fb0b33..279da4a 100644 --- a/src/Agora/Treasury.hs +++ b/src/Agora/Treasury.hs @@ -8,7 +8,7 @@ treasury. -} module Agora.Treasury (module Agora.Treasury) where -import Agora.Utils (passetClassValueOf) +import Agora.Utils (passert, passetClassValueOf) import GHC.Generics qualified as GHC import Generics.SOP import Plutarch.Api.V1.Contexts (PScriptContext, PScriptPurpose (PMinting)) @@ -52,10 +52,9 @@ treasuryV cs tn = plam $ \_d r ctx' -> P.do gatAmountMinted :: Term s PInteger gatAmountMinted = passetClassValueOf # pconstant cs # pconstant tn # mint - pif - (gatAmountMinted #== -1) -- If the amount of GATS burned is not one, ... - (ptraceError "GAT not burned.") -- ... then error. - (pconstant ()) -- ... else success. + passert "GAT not burned." $ gatAmountMinted #== -1 + + pconstant () {- | Plutarch level type representing datum of the treasury. Contains: