implement governor state token minting policy
* parameterize the policy and the validator with a utxo
This commit is contained in:
parent
afc48aa9f8
commit
18bfa25fcb
2 changed files with 72 additions and 8 deletions
|
|
@ -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
|
||||||
|
|
|
||||||
|
|
@ -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.
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue