implement governor state token minting policy

* parameterize the policy and the validator with a utxo
This commit is contained in:
fanghr 2022-04-19 17:16:42 +08:00
parent afc48aa9f8
commit 18bfa25fcb
2 changed files with 72 additions and 8 deletions

View file

@ -12,6 +12,7 @@ module Agora.Governor (
GovernorDatum (..), GovernorDatum (..),
GovernorRedeemer (..), GovernorRedeemer (..),
Governor (..), Governor (..),
governorStateTokenName,
-- * Plutarch-land -- * Plutarch-land
PGovernorDatum (..), PGovernorDatum (..),
@ -20,6 +21,9 @@ module Agora.Governor (
-- * Scripts -- * Scripts
governorPolicy, governorPolicy,
governorValidator, governorValidator,
-- * Utilities
governorStateTokenAssetClass,
) where ) where
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@ -42,9 +46,12 @@ import Agora.Utils (
findOutputsToAddress, findOutputsToAddress,
findTxOutDatum, findTxOutDatum,
passert, passert,
passetClassValueOf,
passetClassValueOf', passetClassValueOf',
pfindTxInByTxOutRef, pfindTxInByTxOutRef,
pisDJust, pisDJust,
pisUxtoSpent,
pownCurrencySymbol,
psymbolValueOf, psymbolValueOf,
) )
@ -57,7 +64,10 @@ import Plutarch.Api.V1 (
PScriptPurpose (PSpending), PScriptPurpose (PSpending),
PValidator, PValidator,
PValue, PValue,
mintingPolicySymbol,
mkMintingPolicy,
) )
import Plutarch.Api.V1.Extra (pownMintValue)
import Plutarch.DataRepr ( import Plutarch.DataRepr (
DerivePConstantViaData (..), DerivePConstantViaData (..),
PDataFields, 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 import PlutusTx qualified
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@ -112,12 +123,15 @@ PlutusTx.makeIsDataIndexed
-- | Parameters for creating Governor scripts. -- | Parameters for creating Governor scripts.
data Governor = Governor data Governor = Governor
{ datumNFT :: AssetClass { stORef :: TxOutRef
-- ^ NFT that identifies the governor datum. -- ^ The state token that identifies the governor datum will be minted using this utxo.
, gatSymbol :: CurrencySymbol , 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. -- | 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 :: Governor -> ClosedTerm PMintingPolicy
governorPolicy _ = governorPolicy params =
plam $ \_redeemer _ctx' -> P.do 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 ()) popaque (pconstant ())
-- | Validator for Governors. -- | Validator for Governors.
@ -239,7 +275,18 @@ governorValidator params =
popaque $ pconstant () popaque $ pconstant ()
where where
datumNFTValueOf :: Term s (PValue :--> PInteger) datumNFTValueOf :: Term s (PValue :--> PInteger)
datumNFTValueOf = passetClassValueOf' params.datumNFT datumNFTValueOf = passetClassValueOf' $ governorStateTokenAssetClass params
gatS :: Term s PCurrencySymbol gatS :: Term s PCurrencySymbol
gatS = pconstant params.gatSymbol gatS = pconstant params.gatSymbol
--------------------------------------------------------------------------------
governorStateTokenAssetClass :: Governor -> AssetClass
governorStateTokenAssetClass gov = AssetClass (symbol, governorStateTokenName)
where
policy :: MintingPolicy
policy = mkMintingPolicy $ governorPolicy gov
symbol :: CurrencySymbol
symbol = mintingPolicySymbol policy

View file

@ -30,6 +30,8 @@ module Agora.Utils (
pnub, pnub,
pisUniq, pisUniq,
pisDJust, pisDJust,
pownCurrencySymbol,
pisUxtoSpent,
-- * Functions which should (probably) not be upstreamed -- * Functions which should (probably) not be upstreamed
anyOutput, anyOutput,
@ -66,6 +68,8 @@ import Plutarch.Api.V1 (
PMintingPolicy, PMintingPolicy,
PPubKeyHash, PPubKeyHash,
PTokenName (PTokenName), PTokenName (PTokenName),
PScriptContext,
PScriptPurpose (PMinting),
PTuple, PTuple,
PTxInInfo (PTxInInfo), PTxInInfo (PTxInInfo),
PTxInfo, PTxInfo,
@ -370,6 +374,19 @@ pisDJust = phoistAcyclic $
_ -> pconstant False _ -> 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 {- Functions which should (probably) not be upstreamed
All of these functions are quite inefficient. All of these functions are quite inefficient.