add validation logic for GAT minting; add doc string for MintGATs

agora/Agora/AuthorityToken.hs

@@ -16,12 +16,12 @@ import Plutarch.Api.V1 (
   PAddress (..),
   PCredential (..),
   PCurrencySymbol (..),
+  PMintingPolicy,
   PScriptContext (..),
   PScriptPurpose (..),
   PTxInInfo (PTxInInfo),
   PTxInfo (..),
   PTxOut (..),
-  PMintingPolicy
  )
 import Plutarch.Api.V1.AssocMap (PMap (PMap))
 import Plutarch.Api.V1.Value (PValue (PValue))

agora/Agora/Governor.hs

@@ -36,6 +36,7 @@ import Generics.SOP (Generic, I (I))
 import Agora.AuthorityToken (
   AuthorityToken (..),
   authorityTokenPolicy,
+  authorityTokensValidIn,
   singleAuthorityTokenBurned,
  )
 import Agora.Proposal (
@@ -43,10 +44,12 @@ import Agora.Proposal (
   PProposalId,
   PProposalStatus (PDraft),
   PProposalThresholds,
+  PResultTag,
   Proposal (..),
   ProposalId,
   ProposalThresholds,
   pnextProposalId,
+  proposalDatumValid,
   proposalPolicy,
   proposalValidator,
  )
@@ -61,18 +64,24 @@ import Agora.Utils (
   pfindTxInByTxOutRef,
   pisDJust,
   pisUxtoSpent,
+  plookup,
   pownCurrencySymbol,
   psymbolValueOf,
+  scriptHashFromAddress,
  )
 
 --------------------------------------------------------------------------------
 
 import Plutarch (popaque)
 import Plutarch.Api.V1 (
+  PAddress,
   PCurrencySymbol,
+  PDatumHash,
+  PMaybeData (PDJust),
   PMintingPolicy,
   PScriptPurpose (PSpending),
   PValidator,
+  PValidatorHash,
   PValue,
   mintingPolicySymbol,
   mkMintingPolicy,
@@ -91,7 +100,7 @@ import Plutarch.Unsafe (punsafeCoerce)
 
 --------------------------------------------------------------------------------
 
-import Plutarch.Builtin (pforgetData)
+import Plutarch.Builtin (PBuiltinMap, pforgetData)
 import Plutus.V1.Ledger.Api (
   Address (Address),
   Credential (ScriptCredential),
@@ -240,11 +249,12 @@ governorPolicy params =
 
    For 'MintGATs' redeemer, it will check:
     - State datum is not changed.
-    - Exactly one GAT is minted.
+    - Exactly one proposal is being processed.
-    - The GAT is properly tagged. (Should we do this?)
+    - Mint one GAT for every effect.
-    - The GAT is sent to the appropraite effect. (Should we do this?)
+    - The GATs is properly tagged. (Should we do this?)
+    - The GATs are sent to the appropraite effects. (Should we do this?)
 
-   For 'PMutateGovernor', it will check:
+   For 'MutateGovernor', it will check:
     - A GAT is burnt.
     - Said GAT must be tagged by the effect that is spending it.
 -}
@@ -255,12 +265,13 @@ governorValidator params =
     redeemer <- pmatch $ pfromData @PGovernorRedeemer $ punsafeCoerce redeemer'
     ctx <- pletFields @'["txInfo", "purpose"] ctx'
 
-    txInfo <- plet $ pfromData $ ctx.txInfo
+    txInfo' <- plet $ pfromData $ ctx.txInfo
+    txInfo <- pletFields @'["mint", "inputs", "outputs"] txInfo'
 
     PSpending ((pfield @"_0" #) -> txOutRef') <- pmatch $ pfromData ctx.purpose
     let txOutRef = pfromData txOutRef'
 
-    PJust ((pfield @"resolved" #) -> ownInput') <- pmatch $ pfindTxInByTxOutRef # txOutRef # txInfo
+    PJust ((pfield @"resolved" #) -> ownInput') <- pmatch $ pfindTxInByTxOutRef # txOutRef # txInfo'
     ownInput <- pletFields @'["address", "value"] ownInput'
     let selfAddress = pfromData $ ownInput.address
 
@@ -272,7 +283,7 @@ governorValidator params =
     passert "Own input should have exactly one state token" $
       ownInputDatumNFTAmount #== 1
 
-    ownOutputs <- plet $ findOutputsToAddress # txInfo # selfAddress
+    ownOutputs <- plet $ findOutputsToAddress # txInfo' # selfAddress
     passert "Exactly one utxo should be sent to the governor" $
       plength # ownOutputs #== 1
 
@@ -287,17 +298,13 @@ governorValidator params =
     newDatum' <- plet $ mustFindDatum' @PGovernorDatum # ownOutput.datumHash # ctx.txInfo
     newParams <- pletFields @'["proposalThresholds", "nextProposalId"] newDatum'
 
-    mint <- plet $ pfromData $ pfield @"mint" # txInfo
-
     case redeemer of
       PCreateProposal _ -> P.do
-        pSym <- plet $ pconstant proposalSymbol
-
         passert "Proposal id should be advanced by 1" $
           pnextProposalId # oldParams.nextProposalId #== newParams.nextProposalId
 
         passert "Exactly one proposal token must be minted" $
-          hasOnlyOneTokenOfCurrencySymbol # pSym # mint
+          hasOnlyOneTokenOfCurrencySymbol # pProposalSym # txInfo.mint
 
         outputs <- plet $ findOutputsToAddress # ctx.txInfo # pconstant proposalValidatorAddress
         passert "Exactly one utxo should be sent to the proposal validator" $
@@ -305,7 +312,7 @@ governorValidator params =
 
         output <- pletFields @'["value", "datumHash"] $ phead # outputs
         passert "The proposal state token must be sent to the proposal validator" $
-          psymbolValueOf # pSym # output.value #== 1
+          psymbolValueOf # pProposalSym # output.value #== 1
 
         passert "The utxo paid to the proposal validator must have datum" $
           pisDJust # output.datumHash
@@ -335,8 +342,8 @@ governorValidator params =
             PDraft _ -> pconstant True
             _ -> pconstant False
 
-        passert "Initial proposal cosigners should be empty" $
+        passert "Proposal datum must be valid" $
-          pnull #$ pfromData proposalParams.cosigners
+          proposalDatumValid # proposalDatum'
 
         -- TODO: proposal impl not done yet
         ptraceError "Not implemented yet"
@@ -345,23 +352,95 @@ governorValidator params =
           -- FIXME: There should be a better way to do this
           (pforgetData $ pdata newDatum') #== datum'
 
-        passert "Exactly one GAT should be minted" $
-          hasOnlyOneTokenOfCurrencySymbol # pGATSym # mint
-
-        passert "No token should be minted other than GAT" $
-          containsSingleCurrencySymbol # mint
-
         -- TODO: any need to check the proposal datum here?
 
-        -- check exactly one(?) authority token is minted
+        inputsWithProposalStateToken <-
+          plet $
+            pfilter
+              # ( plam $ \(((pfield @"value" #) . (pfield @"resolved" #)) -> value) ->
+                    0 #< psymbolValueOf # pProposalSym # value
+                )
+              #$ pfromData txInfo.inputs
 
-        -- TODO: waiting for impl of proposal
+        passert "One proposal at a time" $
-        ptraceError "Not implemented yet"
+          plength # inputsWithProposalStateToken #== 1
+
+        proposalInputTxOut <-
+          pletFields @'["address", "value", "datumHash"] $
+            pfield @"resolved" #$ phead # inputsWithProposalStateToken
+
+        proposalDatum' <- plet $ mustFindDatum' @PProposalDatum # proposalInputTxOut.datumHash # txInfo'
+
+        passert "Proposal datum must be valid" $
+          proposalDatumValid # proposalDatum'
+
+        proposalDatum <- pletFields @'["id", "effects", "status", "cosigners", "thresholds", "votes"] proposalDatum'
+
+        let effects' :: Term _ (PBuiltinMap PResultTag (PBuiltinMap PValidatorHash PDatumHash))
+            effects' = punsafeCoerce proposalDatum.effects
+
+        effectMapList <-
+          plet $
+            pfoldr
+              # ( plam $ \m l -> P.do
+                    let theMap = pfromData $ psndBuiltin # m
+                    pconcat # theMap # l
+                )
+              # pcon PNil
+              # effects'
+
+        gatCount <- plet $ plength # effectMapList
+
+        passert "Required amount of GATs should be minted" $
+          psymbolValueOf # pProposalSym # txInfo.mint #== gatCount
+
+        passert "No token should be minted other than GAT" $
+          containsSingleCurrencySymbol # txInfo.mint
+
+        outputsWithGAT <-
+          plet $
+            pfilter
+              # ( plam $ \((pfield @"value" #) -> value) ->
+                    0 #< psymbolValueOf # pGATSym # value
+                )
+              #$ pfromData txInfo.outputs
+
+        passert "Minted GAT amount should equal to amount of output GAT" $
+          plength # outputsWithGAT #== gatCount
+
+        passert "All GAT must be properly tagged" $
+          pall
+            # ( plam $ \(pfromData -> outInfo) ->
+                  authorityTokensValidIn # pGATSym # outInfo
+              )
+            # outputsWithGAT
+
+        popaque $
+          pfoldr
+            # ( plam $ \(pfromData -> outputInfo') _ -> P.do
+                  outputInfo <- pletFields @'["address", "datumHash"] $ outputInfo'
+                  passert "GAT must be properly tagged" $ authorityTokensValidIn # pGATSym # outputInfo'
+                  passert "Output to the effect should have datum" $ pisDJust # outputInfo.datumHash
+                  PDJust ((pfield @"_0" #) -> datumHash) <- pmatch outputInfo.datumHash
+                  let scriptHash = scriptHashFromAddress' # outputInfo.address
+                  expectedDatumHash' <- pmatch $ plookup # (pdata scriptHash) # effectMapList
+                  case expectedDatumHash' of
+                    PJust expectedDatumHash ->
+                      passert "An unexpected datum hash is found sent to the effect" $
+                        datumHash #== expectedDatumHash
+                    _ -> passert "A GAT is not sent to an effect" $ pconstant False
+                  pconstant ()
+              )
+            # pconstant ()
+            # outputsWithGAT
+
+      -- TODO: check proposal votes and timing
+      -- TODO: waiting for impl of proposal
       PMutateGovernor _ -> P.do
         passert "No token should be burnt other than GAT" $
-          containsSingleCurrencySymbol # mint
+          containsSingleCurrencySymbol # txInfo.mint
 
-        popaque $ singleAuthorityTokenBurned pGATSym ctx.txInfo mint
+        popaque $ singleAuthorityTokenBurned pGATSym ctx.txInfo txInfo.mint
   where
     stateTokenAssetClass :: AssetClass
     stateTokenAssetClass = governorStateTokenAssetClass params
@@ -378,6 +457,9 @@ governorValidator params =
         policy :: MintingPolicy
         policy = mkMintingPolicy $ proposalPolicy proposalParams
 
+    pProposalSym :: Term s PCurrencySymbol
+    pProposalSym = phoistAcyclic $ pconstant proposalSymbol
+
     proposalValidatorAddress :: Address
     proposalValidatorAddress = Address (ScriptCredential hash) Nothing
       where
@@ -405,6 +487,14 @@ governorValidator params =
     pGATSym :: Term s PCurrencySymbol
     pGATSym = phoistAcyclic $ pconstant authorityTokenSymbol
 
+    scriptHashFromAddress' :: Term s (PAddress :--> PValidatorHash)
+    scriptHashFromAddress' = phoistAcyclic $
+      plam $ \addr -> P.do
+        mh <- pmatch $ scriptHashFromAddress # addr
+        case mh of
+          PJust vh -> vh
+          _ -> ptraceError "Not a valid validator address"
+
 --------------------------------------------------------------------------------
 
 governorStateTokenAssetClass :: Governor -> AssetClass

agora/Agora/Utils.hs

@@ -47,7 +47,7 @@ module Agora.Utils (
   hasOnlyOneTokenOfAssetClass',
   hasOnlyOneTokenOfCurrencySymbol,
   mustFindDatum',
-  containsSingleCurrencySymbol
+  containsSingleCurrencySymbol,
 ) where
 
 --------------------------------------------------------------------------------
@@ -553,5 +553,6 @@ mustFindDatum' = phoistAcyclic $
     pfromData $ punsafeCoerce dt
 
 containsSingleCurrencySymbol :: Term s (PValue :--> PBool)
-containsSingleCurrencySymbol = phoistAcyclic $ plam $ \v -> P.do
+containsSingleCurrencySymbol = phoistAcyclic $
-   (plength #$ pto $ pto $ pto v) #== 1
+  plam $ \v -> P.do
+    (plength #$ pto $ pto $ pto v) #== 1