From c562f6ae87c95dbf771506abda32a869e81314c1 Mon Sep 17 00:00:00 2001
From: fanghr <chfanghr@gmail.com>
Date: Tue, 19 Apr 2022 17:16:42 +0800
Subject: [PATCH] implement governor state token minting policy

* parameterize the policy and the validator with a utxo
---
 agora/Agora/Governor.hs | 63 +++++++++++++++++++++++++++++++++++------
 agora/Agora/Utils.hs    | 17 +++++++++++
 2 files changed, 72 insertions(+), 8 deletions(-)

diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs
index 57c30c9..6b0297d 100644
--- a/agora/Agora/Governor.hs
+++ b/agora/Agora/Governor.hs
@@ -12,6 +12,7 @@ module Agora.Governor (
   GovernorDatum (..),
   GovernorRedeemer (..),
   Governor (..),
+  governorStateTokenName,
 
   -- * Plutarch-land
   PGovernorDatum (..),
@@ -20,6 +21,9 @@ module Agora.Governor (
   -- * Scripts
   governorPolicy,
   governorValidator,
+
+  -- * Utilities
+  governorStateTokenAssetClass,
 ) where
 
 --------------------------------------------------------------------------------
@@ -42,9 +46,12 @@ import Agora.Utils (
   findOutputsToAddress,
   findTxOutDatum,
   passert,
+  passetClassValueOf,
   passetClassValueOf',
   pfindTxInByTxOutRef,
   pisDJust,
+  pisUxtoSpent,
+  pownCurrencySymbol,
   psymbolValueOf,
  )
 
@@ -57,7 +64,10 @@ import Plutarch.Api.V1 (
   PScriptPurpose (PSpending),
   PValidator,
   PValue,
+  mintingPolicySymbol,
+  mkMintingPolicy,
  )
+import Plutarch.Api.V1.Extra (pownMintValue)
 import Plutarch.DataRepr (
   DerivePConstantViaData (..),
   PDataFields,
@@ -69,7 +79,8 @@ import Plutarch.Unsafe (punsafeCoerce)
 
 --------------------------------------------------------------------------------
 
-import Plutus.V1.Ledger.Value (AssetClass, CurrencySymbol)
+import Plutus.V1.Ledger.Api (MintingPolicy, TxOutRef)
+import Plutus.V1.Ledger.Value (AssetClass (..), CurrencySymbol, TokenName (..))
 import PlutusTx qualified
 
 --------------------------------------------------------------------------------
@@ -112,12 +123,15 @@ PlutusTx.makeIsDataIndexed
 
 -- | Parameters for creating Governor scripts.
 data Governor = Governor
-  { datumNFT :: AssetClass
-  -- ^ NFT that identifies the governor datum.
+  { stORef :: TxOutRef
+  -- ^ The state token that identifies the governor datum will be minted using this utxo.
   , gatSymbol :: CurrencySymbol
-  -- ^ The symbol of Governance Authority Token
+  -- ^ The symbol of the Governance Authority Token.
   }
 
+governorStateTokenName :: TokenName
+governorStateTokenName = TokenName ""
+
 --------------------------------------------------------------------------------
 
 -- | Plutarch-level datum for the Governor script.
@@ -158,10 +172,32 @@ deriving via (DerivePConstantViaData GovernorRedeemer PGovernorRedeemer) instanc
 
 --------------------------------------------------------------------------------
 
--- | Policy for Governors.
+{- | Policy for Governors.
+   This policy mints a state token for the 'governorValidator'.
+   It will check:
+
+    - The utxo specified in the Governor parameter is spent.
+    - Only one token is minted.
+    - Ensure the token name is "".
+-}
 governorPolicy :: Governor -> ClosedTerm PMintingPolicy
-governorPolicy _ =
-  plam $ \_redeemer _ctx' -> P.do
+governorPolicy params =
+  plam $ \_ ctx' -> P.do
+    ctx <- pletFields @'["txInfo", "purpose"] ctx'
+    let oref = pconstant params.stORef
+        ownSymbol = pownCurrencySymbol # ctx'
+
+    mintValue <- plet $ pownMintValue # ctx'
+
+    passert "Referenced utxo should be spent" $ pisUxtoSpent # oref # ctx.txInfo
+
+    passert "Exactly one token should be minted" $
+      psymbolValueOf # ownSymbol # mintValue #== 1
+        #&& passetClassValueOf # ownSymbol # pconstant governorStateTokenName # mintValue #== 1
+
+    passert "Nothing is minted other than the state token" $
+      (plength #$ pto $ pto $ pto mintValue) #== 1
+
     popaque (pconstant ())
 
 -- | Validator for Governors.
@@ -239,7 +275,18 @@ governorValidator params =
         popaque $ pconstant ()
   where
     datumNFTValueOf :: Term s (PValue :--> PInteger)
-    datumNFTValueOf = passetClassValueOf' params.datumNFT
+    datumNFTValueOf = passetClassValueOf' $ governorStateTokenAssetClass params
 
     gatS :: Term s PCurrencySymbol
     gatS = pconstant params.gatSymbol
+
+--------------------------------------------------------------------------------
+
+governorStateTokenAssetClass :: Governor -> AssetClass
+governorStateTokenAssetClass gov = AssetClass (symbol, governorStateTokenName)
+  where
+    policy :: MintingPolicy
+    policy = mkMintingPolicy $ governorPolicy gov
+
+    symbol :: CurrencySymbol
+    symbol = mintingPolicySymbol policy
diff --git a/agora/Agora/Utils.hs b/agora/Agora/Utils.hs
index 9241769..8b3b85b 100644
--- a/agora/Agora/Utils.hs
+++ b/agora/Agora/Utils.hs
@@ -30,6 +30,8 @@ module Agora.Utils (
   pnub,
   pisUniq,
   pisDJust,
+  pownCurrencySymbol,
+  pisUxtoSpent,
 
   -- * Functions which should (probably) not be upstreamed
   anyOutput,
@@ -66,6 +68,8 @@ import Plutarch.Api.V1 (
   PMintingPolicy,
   PPubKeyHash,
   PTokenName (PTokenName),
+  PScriptContext,
+  PScriptPurpose (PMinting),
   PTuple,
   PTxInInfo (PTxInInfo),
   PTxInfo,
@@ -370,6 +374,19 @@ pisDJust = phoistAcyclic $
           _ -> pconstant False
       )
 
+-- | The 'CurrencySymbol' of the current minting policy.
+pownCurrencySymbol :: Term s (PScriptContext :--> PCurrencySymbol)
+pownCurrencySymbol = phoistAcyclic $
+  plam $ \ctx -> P.do
+    PMinting m <- pmatch $ pfield @"purpose" # ctx
+    pfield @"_0" # m
+
+-- | Determines if a given utxo is spent.
+pisUxtoSpent :: Term s (PTxOutRef :--> PTxInfo :--> PBool)
+pisUxtoSpent = phoistAcyclic $
+  plam $ \oref info -> P.do
+    pisJust #$ pfindTxInByTxOutRef # oref # info
+
 --------------------------------------------------------------------------------
 {- Functions which should (probably) not be upstreamed
    All of these functions are quite inefficient.