Sulkta-OSS/agora
3
0
Fork 0
Code Issues 1 Pull requests Projects Releases Packages Wiki Activity Actions

fix compilation errors introduced by new util functions

Browse source 
... and export a bunch of bridge functions from the governor
This commit is contained in:
fanghr 2022-04-29 21:27:31 +08:00
parent 07a498641c
commit 926b1f3727
4 changed files with 188 additions and 128 deletions
Download patch file Download diff file Expand all files Collapse all files

2
agora/Agora/AuthorityToken.hs
View file

@ -24,11 +24,11 @@ import Plutarch.Api.V1 (
PTxOut (..), PTxOut (..),
) )
import Plutarch.Api.V1.AssocMap (PMap (PMap)) import Plutarch.Api.V1.AssocMap (PMap (PMap))
import Plutarch.Api.V1.Extra (passetClass, passetClassValueOf)
import Plutarch.Api.V1.Value (PValue (PValue)) import Plutarch.Api.V1.Value (PValue (PValue))
import Plutarch.Builtin (pforgetData) import Plutarch.Builtin (pforgetData)
import Plutarch.Monadic qualified as P import Plutarch.Monadic qualified as P
import Plutus.V1.Ledger.Value (AssetClass (AssetClass)) import Plutus.V1.Ledger.Value (AssetClass (AssetClass))
import Plutarch.Api.V1.Extra (passetClass, passetClassValueOf)
import Prelude import Prelude

21
agora/Agora/Governor.hs
View file

@ -16,6 +16,9 @@ module Agora.Governor (
-- * Plutarch-land -- * Plutarch-land
PGovernorDatum (..), PGovernorDatum (..),
PGovernorRedeemer (..), PGovernorRedeemer (..),
-- * Plutus Utilities
pgetNextProposalId,
) where ) where
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@ -27,7 +30,7 @@ import Generics.SOP (Generic, I (I))
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
import Agora.Proposal ( import Agora.Proposal (
PProposalId , PProposalId (..),
PProposalThresholds, PProposalThresholds,
ProposalId, ProposalId,
ProposalThresholds, ProposalThresholds,
@ -41,7 +44,7 @@ import Plutarch.DataRepr (
PDataFields, PDataFields,
PIsDataReprInstances (PIsDataReprInstances), PIsDataReprInstances (PIsDataReprInstances),
) )
import Plutarch.Lift (PUnsafeLiftDecl (..)) import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (..))
import Plutarch.SafeMoney (Tagged (..)) import Plutarch.SafeMoney (Tagged (..))
import Plutarch.TryFrom (PTryFrom (..)) import Plutarch.TryFrom (PTryFrom (..))
import Plutarch.Unsafe (punsafeCoerce) import Plutarch.Unsafe (punsafeCoerce)
@ -95,6 +98,10 @@ data Governor = Governor
{ gstOutRef :: TxOutRef { gstOutRef :: TxOutRef
-- ^ Referenced utxo will be spent to mint the GST. -- ^ Referenced utxo will be spent to mint the GST.
, gtClassRef :: Tagged GTTag AssetClass , gtClassRef :: Tagged GTTag AssetClass
-- ^ Governance token of the system.
, maximumCosigners :: Integer
-- ^ Arbitrary limit for maximum amount of cosigners on a proposal.
-- See `Agora.Proposal.proposalDatumValid`.
} }
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@ -118,7 +125,7 @@ newtype PGovernorDatum (s :: S) = PGovernorDatum
via PIsDataReprInstances PGovernorDatum via PIsDataReprInstances PGovernorDatum
instance PUnsafeLiftDecl PGovernorDatum where type PLifted PGovernorDatum = GovernorDatum instance PUnsafeLiftDecl PGovernorDatum where type PLifted PGovernorDatum = GovernorDatum
deriving via (DerivePConstantViaData GovernorDatum PGovernorDatum) instance (PConstant GovernorDatum) deriving via (DerivePConstantViaData GovernorDatum PGovernorDatum) instance (PConstantDecl GovernorDatum)
-- FIXME: derive this via 'PIsDataReprInstances' -- FIXME: derive this via 'PIsDataReprInstances'
-- Blocked by: PProposalThresholds -- Blocked by: PProposalThresholds
@ -140,6 +147,12 @@ data PGovernorRedeemer (s :: S)
via PIsDataReprInstances PGovernorRedeemer via PIsDataReprInstances PGovernorRedeemer
instance PUnsafeLiftDecl PGovernorRedeemer where type PLifted PGovernorRedeemer = GovernorRedeemer instance PUnsafeLiftDecl PGovernorRedeemer where type PLifted PGovernorRedeemer = GovernorRedeemer
deriving via (DerivePConstantViaData GovernorRedeemer PGovernorRedeemer) instance (PConstant GovernorRedeemer) deriving via (DerivePConstantViaData GovernorRedeemer PGovernorRedeemer) instance (PConstantDecl GovernorRedeemer)
deriving via PAsData (PIsDataReprInstances PGovernorRedeemer) instance PTryFrom PData (PAsData PGovernorRedeemer) deriving via PAsData (PIsDataReprInstances PGovernorRedeemer) instance PTryFrom PData (PAsData PGovernorRedeemer)
--------------------------------------------------------------------------------
-- | Get next proposal id.
pgetNextProposalId :: Term s (PProposalId :--> PProposalId)
pgetNextProposalId = phoistAcyclic $ plam $ \(pto -> pid) -> pcon $ PProposalId $ pid + 1

266
agora/Agora/Governor/Scripts.hs
View file

@ -13,17 +13,21 @@ module Agora.Governor.Scripts (
governorPolicy, governorPolicy,
governorValidator, governorValidator,
-- * Utilities -- * Bridges
gstAssetClass, governorSTSymbolFromGovernor,
gatSymbol, governorSTAssetClassFromGovernor,
pgetNextProposalId, atSymbolFromGovernor,
proposalSTAssetClassFromGovernor,
stakeSTSymbolFromGovernor,
stakeFromGovernor,
stakeValidatorHashFromGovernor,
proposalFromGovernor,
proposalValidatorHashFromGovernor,
) where ) where
import Agora.Governor ( --------------------------------------------------------------------------------
Governor (gstOutRef, gtClassRef),
PGovernorDatum (PGovernorDatum), import Data.Coerce (coerce)
PGovernorRedeemer (PCreateProposal, PMintGATs, PMutateGovernor),
)
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@ -33,6 +37,12 @@ import Agora.AuthorityToken (
authorityTokensValidIn, authorityTokensValidIn,
singleAuthorityTokenBurned, singleAuthorityTokenBurned,
) )
import Agora.Governor (
Governor (gstOutRef, gtClassRef, maximumCosigners),
PGovernorDatum (PGovernorDatum),
PGovernorRedeemer (PCreateProposal, PMintGATs, PMutateGovernor),
pgetNextProposalId,
)
import Agora.Proposal ( import Agora.Proposal (
PProposalDatum (..), PProposalDatum (..),
PProposalId (..), PProposalId (..),
@ -41,6 +51,8 @@ import Agora.Proposal (
Proposal (..), Proposal (..),
ProposalStatus (Draft, Locked), ProposalStatus (Draft, Locked),
proposalDatumValid, proposalDatumValid,
)
import Agora.Proposal.Scripts (
proposalPolicy, proposalPolicy,
proposalValidator, proposalValidator,
) )
@ -49,6 +61,8 @@ import Agora.Stake (
PProposalLock (..), PProposalLock (..),
PStakeDatum (..), PStakeDatum (..),
Stake (..), Stake (..),
)
import Agora.Stake.Scripts (
stakePolicy, stakePolicy,
stakeValidator, stakeValidator,
) )
@ -59,8 +73,6 @@ import Agora.Utils (
mustBePJust, mustBePJust,
mustFindDatum', mustFindDatum',
passert, passert,
passetClassValueOf,
passetClassValueOf',
pfindDatum, pfindDatum,
pfindTxInByTxOutRef, pfindTxInByTxOutRef,
pisDJust, pisDJust,
@ -70,11 +82,11 @@ import Agora.Utils (
ptxSignedBy, ptxSignedBy,
pvalueSpent, pvalueSpent,
scriptHashFromAddress, scriptHashFromAddress,
validatorHashToAddress,
) )
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
import Plutarch (popaque)
import Plutarch.Api.V1 ( import Plutarch.Api.V1 (
PAddress, PAddress,
PCurrencySymbol, PCurrencySymbol,
@ -92,7 +104,8 @@ import Plutarch.Api.V1 (
validatorHash, validatorHash,
) )
import Plutarch.Api.V1.Extra ( import Plutarch.Api.V1.Extra (
pownMintValue, passetClass,
passetClassValueOf,
) )
import Plutarch.Builtin (pforgetData) import Plutarch.Builtin (pforgetData)
import Plutarch.Map.Extra ( import Plutarch.Map.Extra (
@ -104,18 +117,18 @@ import Plutarch.Monadic qualified as P
import Plutarch.SafeMoney ( import Plutarch.SafeMoney (
PDiscrete, PDiscrete,
puntag, puntag,
pvalueDiscrete, pvalueDiscrete',
) )
import Plutarch.TryFrom (ptryFrom) import Plutarch.TryFrom (ptryFrom)
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
import Plutus.V1.Ledger.Api ( import Plutus.V1.Ledger.Api (
Address (Address),
Credential (ScriptCredential),
CurrencySymbol (..), CurrencySymbol (..),
MintingPolicy, MintingPolicy,
TokenName (..),
) )
import Plutus.V1.Ledger.Scripts (ValidatorHash (..))
import Plutus.V1.Ledger.Value ( import Plutus.V1.Ledger.Value (
AssetClass (..), AssetClass (..),
) )
@ -123,13 +136,13 @@ import Plutus.V1.Ledger.Value (
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
{- $gst {- $gst
Governance state token, aka. GST, is an NFT that identifies a UTXO that Governance state token, aka. GST, is an NFT that identifies a UTXO that
carries the state datum of the Governance script. carries the state datum of the Governance script.
This token is minted by a one-shot monetary policy 'governorPolicy', This token is minted by a one-shot monetary policy 'governorPolicy',
meaning that the token has guaranteed uniqueness. meaning that the token has guaranteed uniqueness.
The 'governorValidator' ensures that exactly one GST stays The 'governorValidator' ensures that exactly one GST stays
at the address of itself forever. at the address of itself forever.
-} -}
@ -152,15 +165,17 @@ governorPolicy gov =
let oref = pconstant gov.gstOutRef let oref = pconstant gov.gstOutRef
PMinting ((pfield @"_0" #) -> ownSymbol) <- pmatch (pfromData $ pfield @"purpose" # ctx') PMinting ((pfield @"_0" #) -> ownSymbol) <- pmatch (pfromData $ pfield @"purpose" # ctx')
let ownAssetClass = passetClass # ownSymbol # pconstant ""
txInfo = pfromData $ pfield @"txInfo" # ctx'
mintValue <- plet $ pownMintValue # ctx' txInfoF <- pletFields @'["mint", "inputs"] txInfo
passert "Referenced utxo should be spent" $ passert "Referenced utxo should be spent" $
pisUTXOSpent # oref #$ pfield @"txInfo" # ctx' pisUTXOSpent # oref # txInfoF.inputs
passert "Exactly one token should be minted" $ passert "Exactly one token should be minted" $
psymbolValueOf # ownSymbol # mintValue #== 1 psymbolValueOf # ownSymbol # txInfoF.mint #== 1
#&& passetClassValueOf # ownSymbol # pconstant "" # mintValue #== 1 #&& passetClassValueOf # txInfoF.mint # ownAssetClass #== 1
popaque (pconstant ()) popaque (pconstant ())
@ -255,32 +270,30 @@ governorValidator gov =
ctx <- pletFields @'["txInfo", "purpose"] ctx' ctx <- pletFields @'["txInfo", "purpose"] ctx'
txInfo' <- plet $ pfromData $ ctx.txInfo txInfo' <- plet $ pfromData $ ctx.txInfo
txInfo <- pletFields @'["mint", "inputs", "outputs"] txInfo' txInfo <- pletFields @'["mint", "inputs", "outputs", "datums", "signatories"] txInfo'
datums <- plet $ pfromData $ pfield @"data" # txInfo' valueSpent <- plet $ pvalueSpent # txInfo.inputs
valueSpent <- plet $ pvalueSpent # txInfo'
PSpending ((pfield @"_0" #) -> txOutRef') <- pmatch $ pfromData ctx.purpose PSpending ((pfield @"_0" #) -> txOutRef') <- pmatch $ pfromData ctx.purpose
let txOutRef = pfromData txOutRef' let txOutRef = pfromData txOutRef'
PJust ((pfield @"resolved" #) -> ownInput') <- pmatch $ pfindTxInByTxOutRef # txOutRef # txInfo' PJust ((pfield @"resolved" #) -> ownInput') <- pmatch $ pfindTxInByTxOutRef # txOutRef # txInfo.inputs
ownInput <- pletFields @'["address", "value"] ownInput' ownInput <- pletFields @'["address", "value"] ownInput'
let selfAddress = pfromData $ ownInput.address let selfAddress = pfromData $ ownInput.address
(pfromData -> (oldParams' :: Term _ PGovernorDatum), _) <- ptryFrom datum' (pfromData -> (oldParams' :: Term _ PGovernorDatum), _) <- ptryFrom datum'
oldParams <- pletFields @'["proposalThresholds", "nextProposalId"] oldParams' oldParams <- pletFields @'["proposalThresholds", "nextProposalId"] oldParams'
let ownInputGSTAmount = stateTokenValueOf # ownInput.value let ownInputGSTAmount = psymbolValueOf # pgstSymbol # ownInput.value
passert "Own input should have exactly one state token" $ passert "Own input should have exactly one state token" $
ownInputGSTAmount #== 1 ownInputGSTAmount #== 1
ownOutputs <- plet $ findOutputsToAddress # txInfo' # selfAddress ownOutputs <- plet $ findOutputsToAddress # txInfo.outputs # selfAddress
passert "Exactly one utxo should be sent to the governor" $ passert "Exactly one utxo should be sent to the governor" $
plength # ownOutputs #== 1 plength # ownOutputs #== 1
ownOutput <- pletFields @'["value", "datumHash"] $ phead # ownOutputs ownOutput <- pletFields @'["value", "datumHash"] $ phead # ownOutputs
let ownOuputGSTAmount = stateTokenValueOf # ownOutput.value let ownOuputGSTAmount = psymbolValueOf # pgstSymbol # ownOutput.value
passert "State token should stay at governor's address" $ passert "State token should stay at governor's address" $
ownOuputGSTAmount #== 1 ownOuputGSTAmount #== 1
passert "Output utxo to governor should have datum" $ passert "Output utxo to governor should have datum" $
@ -293,7 +306,7 @@ governorValidator gov =
pforgetData $ pforgetData $
pdata $ pdata $
mustBePJust # "Ouput governor state datum not found" mustBePJust # "Ouput governor state datum not found"
#$ pfindDatum # outputGovernorStateDatumHash # txInfo' #$ pfindDatum # outputGovernorStateDatumHash # txInfo.datums
pmatch redeemer $ \case pmatch redeemer $ \case
PCreateProposal _ -> P.do PCreateProposal _ -> P.do
@ -308,7 +321,7 @@ governorValidator gov =
newDatumData #== pforgetData (pdata expectedNewDatum) newDatumData #== pforgetData (pdata expectedNewDatum)
passert "Exactly one proposal token must be minted" $ passert "Exactly one proposal token must be minted" $
hasOnlyOneTokenOfCurrencySymbol # pproposalSymbol # txInfo.mint hasOnlyOneTokenOfCurrencySymbol # ppstSymbol # txInfo.mint
-- --
@ -321,7 +334,7 @@ governorValidator gov =
txOut <- pletFields @'["address", "value"] txOut' txOut <- pletFields @'["address", "value"] txOut'
txOut.address #== pdata pstakeValidatorAddress txOut.address #== pdata pstakeValidatorAddress
#&& psymbolValueOf # pstakeStateSymbol # txOut.value #== 1 #&& psymbolValueOf # psstSymbol # txOut.value #== 1
) )
# pfromData txInfo.inputs # pfromData txInfo.inputs
@ -337,7 +350,7 @@ governorValidator gov =
passert "Stake input must have datum" $ passert "Stake input must have datum" $
pisDJust # stakeInputDatumHash pisDJust # stakeInputDatumHash
let stakeInputDatum' = mustFindDatum' @PStakeDatum # stakeInputDatumHash # datums let stakeInputDatum' = mustFindDatum' @PStakeDatum # stakeInputDatumHash # txInfo.datums
stakeInputDatum <- stakeInputDatum <-
pletFields @["stakedAmount", "owner", "lockedBy"] stakeInputDatum' pletFields @["stakedAmount", "owner", "lockedBy"] stakeInputDatum'
@ -346,7 +359,7 @@ governorValidator gov =
stakeInputDatum.stakedAmount #< (pgtValueOf # valueSpent) stakeInputDatum.stakedAmount #< (pgtValueOf # valueSpent)
passert "Tx should be signed by the stake owner" $ passert "Tx should be signed by the stake owner" $
ptxSignedBy # txInfo' # stakeInputDatum.owner ptxSignedBy # txInfo.signatories # stakeInputDatum.owner
-- --
@ -359,7 +372,7 @@ governorValidator gov =
txOut <- pletFields @'["address", "value"] txOut' txOut <- pletFields @'["address", "value"] txOut'
txOut.address #== pdata pproposalValidatorAddress txOut.address #== pdata pproposalValidatorAddress
#&& psymbolValueOf # pproposalSymbol # txOut.value #== 1 #&& psymbolValueOf # ppstSymbol # txOut.value #== 1
) )
# pfromData txInfo.outputs # pfromData txInfo.outputs
@ -375,18 +388,18 @@ governorValidator gov =
plet $ plet $
mustFindDatum' @PProposalDatum mustFindDatum' @PProposalDatum
# outputDatumHash # outputDatumHash
# datums # txInfo.datums
passert "Proposal datum must be valid" $ passert "Proposal datum must be valid" $
proposalDatumValid # outputProposalDatum' proposalDatumValid' # outputProposalDatum'
outputProposalDatum <- outputProposalDatum <-
pletFields pletFields
@'["id", "status", "cosigners", "thresholds", "votes"] @'["proposalId", "status", "cosigners", "thresholds", "votes"]
outputProposalDatum' outputProposalDatum'
passert "Invalid proposal id in proposal datum" $ passert "Invalid proposal id in proposal datum" $
outputProposalDatum.id #== oldParams.nextProposalId outputProposalDatum.proposalId #== oldParams.nextProposalId
passert "Invalid thresholds in proposal datum" $ passert "Invalid thresholds in proposal datum" $
outputProposalDatum.thresholds #== oldParams.proposalThresholds outputProposalDatum.thresholds #== oldParams.proposalThresholds
@ -416,7 +429,7 @@ governorValidator gov =
txOut <- pletFields @'["address", "value"] txOut' txOut <- pletFields @'["address", "value"] txOut'
txOut.address #== pdata pstakeValidatorAddress txOut.address #== pdata pstakeValidatorAddress
#&& psymbolValueOf # pstakeStateSymbol # txOut.value #== 1 #&& psymbolValueOf # psstSymbol # txOut.value #== 1
) )
# pfromData txInfo.outputs # pfromData txInfo.outputs
@ -433,7 +446,7 @@ governorValidator gov =
stakeOutputDatum = stakeOutputDatum =
pforgetData $ pforgetData $
pdata $ pdata $
mustBePJust # "Stake output not found" #$ pfindDatum # stakeOutputDatumHash # txInfo' mustBePJust # "Stake output not found" #$ pfindDatum # stakeOutputDatumHash # txInfo.datums
let possibleVoteResults = pkeys #$ pto $ pfromData outputProposalDatum.votes let possibleVoteResults = pkeys #$ pto $ pfromData outputProposalDatum.votes
@ -450,7 +463,7 @@ governorValidator gov =
expectedProposalLocks = expectedProposalLocks =
pconcat # stakeInputDatum.lockedBy pconcat # stakeInputDatum.lockedBy
#$ pmap # (mkProposalLock # outputProposalDatum.id) # possibleVoteResults #$ pmap # (mkProposalLock # outputProposalDatum.proposalId) # possibleVoteResults
expectedOutputDatum = expectedOutputDatum =
pforgetData $ pforgetData $
@ -472,7 +485,7 @@ governorValidator gov =
pfilter pfilter
# plam # plam
( \((pfield @"value" #) . (pfield @"resolved" #) -> value) -> ( \((pfield @"value" #) . (pfield @"resolved" #) -> value) ->
psymbolValueOf # pproposalSymbol # value #== 1 psymbolValueOf # ppstSymbol # value #== 1
) )
#$ pfromData txInfo.inputs #$ pfromData txInfo.inputs
@ -481,13 +494,13 @@ governorValidator gov =
pfilter pfilter
# plam # plam
( \((pfield @"value" #) -> value) -> ( \((pfield @"value" #) -> value) ->
psymbolValueOf # pproposalSymbol # value #== 1 psymbolValueOf # ppstSymbol # value #== 1
) )
#$ pfromData txInfo.outputs #$ pfromData txInfo.outputs
passert "The governor can only process one proposal at a time" $ passert "The governor can only process one proposal at a time" $
plength # inputsWithProposalStateToken #== 1 plength # inputsWithProposalStateToken #== 1
#&& (psymbolValueOf # pproposalSymbol #$ pvalueSpent # txInfo') #== 1 #&& (psymbolValueOf # ppstSymbol #$ pvalueSpent # txInfo.inputs) #== 1
proposalInputTxOut <- proposalInputTxOut <-
pletFields @'["address", "value", "datumHash"] $ pletFields @'["address", "value", "datumHash"] $
@ -503,19 +516,19 @@ governorValidator gov =
plet $ plet $
mustFindDatum' @PProposalDatum mustFindDatum' @PProposalDatum
# proposalInputTxOut.datumHash # proposalInputTxOut.datumHash
# datums # txInfo.datums
outputProposalDatum' <- outputProposalDatum' <-
plet $ plet $
mustFindDatum' @PProposalDatum mustFindDatum' @PProposalDatum
# proposalOutputTxOut.datumHash # proposalOutputTxOut.datumHash
# datums # txInfo.datums
passert "Proposal datum must be valid" $ passert "Proposal datum must be valid" $
proposalDatumValid # inputProposalDatum' proposalDatumValid' # inputProposalDatum'
#&& proposalDatumValid # outputProposalDatum' #&& proposalDatumValid' # outputProposalDatum'
inputProposalDatum <- inputProposalDatum <-
pletFields @'["id", "effects", "status", "cosigners", "thresholds", "votes"] pletFields @'["proposalId", "effects", "status", "cosigners", "thresholds", "votes"]
inputProposalDatum' inputProposalDatum'
passert "Proposal must be in locked(executable) state in order to execute effects" $ passert "Proposal must be in locked(executable) state in order to execute effects" $
@ -526,7 +539,7 @@ governorValidator gov =
pdata $ pdata $
pcon $ pcon $
PProposalDatum $ PProposalDatum $
pdcons @"id" # inputProposalDatum.id pdcons @"proposalId" # inputProposalDatum.proposalId
#$ pdcons @"effects" # inputProposalDatum.effects #$ pdcons @"effects" # inputProposalDatum.effects
#$ pdcons @"status" # pdata (pcon $ PFinished pdnil) #$ pdcons @"status" # pdata (pcon $ PFinished pdnil)
#$ pdcons @"cosigners" # inputProposalDatum.cosigners #$ pdcons @"cosigners" # inputProposalDatum.cosigners
@ -572,7 +585,7 @@ governorValidator gov =
gatCount <- plet $ plength #$ pto $ pto effectGroup gatCount <- plet $ plength #$ pto $ pto effectGroup
passert "Required amount of GATs should be minted" $ passert "Required amount of GATs should be minted" $
psymbolValueOf # pproposalSymbol # txInfo.mint #== gatCount psymbolValueOf # ppstSymbol # txInfo.mint #== gatCount
outputsWithGAT <- outputsWithGAT <-
plet $ plet $
@ -580,7 +593,7 @@ governorValidator gov =
# phoistAcyclic # phoistAcyclic
( plam ( plam
( \((pfield @"value" #) -> value) -> ( \((pfield @"value" #) -> value) ->
0 #< psymbolValueOf # pgatSymbol # value 0 #< psymbolValueOf # patSymbol # value
) )
) )
# pfromData txInfo.outputs # pfromData txInfo.outputs
@ -606,7 +619,7 @@ governorValidator gov =
mustBePJust # "Receiver is not in the effect list" mustBePJust # "Receiver is not in the effect list"
#$ plookup # scriptHash # effects #$ plookup # scriptHash # effects
passert "GAT must be tagged by the effect hash" $ authorityTokensValidIn # pgatSymbol # output' passert "GAT must be tagged by the effect hash" $ authorityTokensValidIn # patSymbol # output'
passert "Unexpected datum" $ datumHash #== expectedDatumHash passert "Unexpected datum" $ datumHash #== expectedDatumHash
pconstant () pconstant ()
) )
@ -619,82 +632,111 @@ governorValidator gov =
# pconstant () # pconstant ()
# outputsWithGAT # outputsWithGAT
PMutateGovernor _ -> P.do PMutateGovernor _ -> P.do
popaque $ singleAuthorityTokenBurned pgatSymbol ctx.txInfo txInfo.mint popaque $ singleAuthorityTokenBurned patSymbol ctx.txInfo txInfo.mint
where where
stateTokenAssetClass :: AssetClass pgtValueOf :: Term s (PValue :--> PDiscrete GTTag)
stateTokenAssetClass = gstAssetClass gov pgtValueOf = phoistAcyclic $ pvalueDiscrete' gov.gtClassRef
outputProposalDatum :: Proposal patSymbol :: Term s PCurrencySymbol
outputProposalDatum = patSymbol = phoistAcyclic $ pconstant $ atSymbolFromGovernor gov
Proposal
{ governorSTAssetClass = stateTokenAssetClass
}
proposalSymbol :: CurrencySymbol ppstSymbol :: Term s PCurrencySymbol
proposalSymbol = mintingPolicySymbol policy ppstSymbol =
where let AssetClass (sym, _) = proposalSTAssetClassFromGovernor gov
policy = mkMintingPolicy $ proposalPolicy outputProposalDatum in phoistAcyclic $ pconstant sym
pproposalSymbol :: Term s PCurrencySymbol proposalDatumValid' :: Term s (PProposalDatum :--> PBool)
pproposalSymbol = phoistAcyclic $ pconstant proposalSymbol proposalDatumValid' =
let params = proposalFromGovernor gov
proposalValidatorAddress :: Address in phoistAcyclic $ proposalDatumValid params
proposalValidatorAddress = Address (ScriptCredential hash) Nothing
where
hash = validatorHash validator
validator = mkValidator $ proposalValidator outputProposalDatum
pproposalValidatorAddress :: Term s PAddress pproposalValidatorAddress :: Term s PAddress
pproposalValidatorAddress = phoistAcyclic $ pconstant proposalValidatorAddress pproposalValidatorAddress =
let vh = proposalValidatorHashFromGovernor gov
stateTokenValueOf :: Term s (PValue :--> PInteger) in phoistAcyclic $ pconstant $ validatorHashToAddress vh
stateTokenValueOf = passetClassValueOf' stateTokenAssetClass
pgatSymbol :: Term s PCurrencySymbol
pgatSymbol = phoistAcyclic $ pconstant $ gatSymbol gov
stakeParameters :: Stake
stakeParameters = Stake gov.gtClassRef
stakeValidatorAddress :: Address
stakeValidatorAddress = Address (ScriptCredential hash) Nothing
where
validator = mkValidator $ stakeValidator stakeParameters
hash = validatorHash validator
stakeStateSymbol :: CurrencySymbol
stakeStateSymbol = mintingPolicySymbol policy
where
policy = mkMintingPolicy $ stakePolicy stakeParameters
pstakeValidatorAddress :: Term s PAddress pstakeValidatorAddress :: Term s PAddress
pstakeValidatorAddress = phoistAcyclic $ pconstant stakeValidatorAddress pstakeValidatorAddress =
let vh = stakeValidatorHashFromGovernor gov
in phoistAcyclic $ pconstant $ validatorHashToAddress vh
pstakeStateSymbol :: Term s PCurrencySymbol psstSymbol :: Term s PCurrencySymbol
pstakeStateSymbol = phoistAcyclic $ pconstant stakeStateSymbol psstSymbol =
let sym = stakeSTSymbolFromGovernor gov
in phoistAcyclic $ pconstant sym
pgtValueOf :: Term s (PValue :--> PDiscrete GTTag) pgstSymbol :: Term s PCurrencySymbol
pgtValueOf = pvalueDiscrete gov.gtClassRef pgstSymbol =
let sym = governorSTSymbolFromGovernor gov
in phoistAcyclic $ pconstant sym
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | Get the 'AssetClass' of GST from 'Governor'. governorSTSymbolFromGovernor :: Governor -> CurrencySymbol
gstAssetClass :: Governor -> AssetClass governorSTSymbolFromGovernor gov = mintingPolicySymbol policy
gstAssetClass gov = AssetClass (symbol, "")
where where
policy :: MintingPolicy policy :: MintingPolicy
policy = mkMintingPolicy $ governorPolicy gov policy = mkMintingPolicy $ governorPolicy gov
{- | Get the 'AssetClass' of GST from 'Governor'.
TODO: tag GST?
-}
governorSTAssetClassFromGovernor :: Governor -> AssetClass
governorSTAssetClassFromGovernor gov = AssetClass (symbol, "")
where
symbol :: CurrencySymbol symbol :: CurrencySymbol
symbol = mintingPolicySymbol policy symbol = governorSTSymbolFromGovernor gov
-- | Get the `CurrencySymbol` of GAT from 'Governor'. -- | Get the `CurrencySymbol` of GAT from 'Governor'.
gatSymbol :: Governor -> CurrencySymbol atSymbolFromGovernor :: Governor -> CurrencySymbol
gatSymbol gov = mintingPolicySymbol policy atSymbolFromGovernor gov = mintingPolicySymbol policy
where where
at = AuthorityToken $ gstAssetClass gov at = AuthorityToken $ governorSTAssetClassFromGovernor gov
policy = mkMintingPolicy $ authorityTokenPolicy at policy = mkMintingPolicy $ authorityTokenPolicy at
-- | Get next proposal id. proposalSTAssetClassFromGovernor :: Governor -> AssetClass
pgetNextProposalId :: Term s (PProposalId :--> PProposalId) proposalSTAssetClassFromGovernor gov = AssetClass (symbol, "")
pgetNextProposalId = phoistAcyclic $ plam $ \(pto -> pid) -> pcon $ PProposalId $ pid + 1 where
gstAC = governorSTAssetClassFromGovernor gov
-- JUSTIFICATIONL: the PST policy doesn't care about the following two fields at all.
-- FIXME: refactor PST policy, parameterize it only with GST assetclass or something.
sstAC = AssetClass ("", "")
mc = -1
params = Proposal gstAC sstAC mc
policy = mkMintingPolicy $ proposalPolicy params
symbol = mintingPolicySymbol policy
stakeSTSymbolFromGovernor :: Governor -> CurrencySymbol
stakeSTSymbolFromGovernor gov = mintingPolicySymbol policy
where
policy = mkMintingPolicy $ stakePolicy gov.gtClassRef
stakeFromGovernor :: Governor -> Stake
stakeFromGovernor gov =
Stake gov.gtClassRef $
proposalSTAssetClassFromGovernor gov
stakeValidatorHashFromGovernor :: Governor -> ValidatorHash
stakeValidatorHashFromGovernor gov = validatorHash validator
where
params = stakeFromGovernor gov
validator = mkValidator $ stakeValidator params
proposalFromGovernor :: Governor -> Proposal
proposalFromGovernor gov = Proposal gstAC sstAC mc
where
gstAC = governorSTAssetClassFromGovernor gov
mc = gov.maximumCosigners
sstS = stakeSTSymbolFromGovernor gov
-- The stake state token is tagged with the address which it's sent to.
sstTN :: TokenName
sstTN = coerce $ stakeValidatorHashFromGovernor gov
sstAC = AssetClass (sstS, sstTN)
proposalValidatorHashFromGovernor :: Governor -> ValidatorHash
proposalValidatorHashFromGovernor gov = validatorHash validator
where
params = proposalFromGovernor gov
validator = mkValidator $ proposalValidator params

27
agora/Agora/Utils.hs
View file

@ -47,6 +47,7 @@ module Agora.Utils (
mustFindDatum', mustFindDatum',
mustBePJust, mustBePJust,
mustBePDJust, mustBePDJust,
validatorHashToAddress,
) where ) where
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@ -55,6 +56,8 @@ import Plutus.V1.Ledger.Api (
CurrencySymbol, CurrencySymbol,
TokenName (..), TokenName (..),
ValidatorHash (..), ValidatorHash (..),
Credential(..),
Address(..),
) )
import Plutus.V1.Ledger.Value (AssetClass (..)) import Plutus.V1.Ledger.Value (AssetClass (..))
@ -71,8 +74,6 @@ import Plutarch.Api.V1 (
PMintingPolicy, PMintingPolicy,
PPubKeyHash, PPubKeyHash,
PTokenName (PTokenName), PTokenName (PTokenName),
PScriptContext,
PScriptPurpose (PMinting),
PTuple, PTuple,
PTxInInfo (PTxInInfo), PTxInInfo (PTxInInfo),
PTxInfo, PTxInfo,
@ -86,7 +87,7 @@ import Plutarch.Api.V1 (
import Plutarch.Api.V1.AssocMap (PMap (PMap)) import Plutarch.Api.V1.AssocMap (PMap (PMap))
import Plutarch.Api.V1.Extra (PAssetClass, passetClassValueOf, pvalueOf) import Plutarch.Api.V1.Extra (PAssetClass, passetClassValueOf, pvalueOf)
import Plutarch.Api.V1.Value (PValue (PValue)) import Plutarch.Api.V1.Value (PValue (PValue))
import Plutarch.Builtin (ppairDataBuiltin) import Plutarch.Builtin (pforgetData, ppairDataBuiltin)
import Plutarch.Map.Extra (pkeys) import Plutarch.Map.Extra (pkeys)
import Plutarch.Monadic qualified as P import Plutarch.Monadic qualified as P
import Plutarch.TryFrom (PTryFrom, ptryFrom) import Plutarch.TryFrom (PTryFrom, ptryFrom)
@ -365,7 +366,7 @@ pisUniq =
#&& (self # xs) #&& (self # xs)
) )
(const $ pcon PTrue) (const $ pcon PTrue)
-- | Yield True if a given PMaybeData is of form PDJust _. -- | Yield True if a given PMaybeData is of form PDJust _.
pisDJust :: Term s (PMaybeData a :--> PBool) pisDJust :: Term s (PMaybeData a :--> PBool)
pisDJust = phoistAcyclic $ pisDJust = phoistAcyclic $
@ -377,12 +378,13 @@ pisDJust = phoistAcyclic $
_ -> pconstant False _ -> pconstant False
) )
-- | Determines if a given UTXO is spent. {- | Determines if a given UTXO is spent.
-- TODO: no need to pass the whole TxInfo here. TODO: no need to pass the whole TxInfo here.
pisUTXOSpent :: Term s (PTxOutRef :--> PTxInfo :--> PBool) -}
pisUTXOSpent :: Term s (PTxOutRef :--> PBuiltinList (PAsData PTxInInfo) :--> PBool)
pisUTXOSpent = phoistAcyclic $ pisUTXOSpent = phoistAcyclic $
plam $ \oref info -> P.do plam $ \oref inputs -> P.do
pisJust #$ pfindTxInByTxOutRef # oref # info pisJust #$ pfindTxInByTxOutRef # oref # inputs
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
{- Functions which should (probably) not be upstreamed {- Functions which should (probably) not be upstreamed
@ -526,7 +528,7 @@ hasOnlyOneTokenOfCurrencySymbol = phoistAcyclic $
-- | Find datum given a maybe datum hash -- | Find datum given a maybe datum hash
mustFindDatum' :: mustFindDatum' ::
forall (datum :: PType). forall (datum :: PType).
(PIsData datum, PTryFrom PData (PAsData datum))=> (PIsData datum, PTryFrom PData (PAsData datum)) =>
forall s. forall s.
Term Term
s s
@ -538,7 +540,7 @@ mustFindDatum' = phoistAcyclic $
plam $ \mdh datums -> P.do plam $ \mdh datums -> P.do
let dh = mustBePDJust # "Given TxOut dones't have a datum" # mdh let dh = mustBePDJust # "Given TxOut dones't have a datum" # mdh
dt = mustBePJust # "Datum not found in the transaction" #$ plookupTuple # dh # datums dt = mustBePJust # "Datum not found in the transaction" #$ plookupTuple # dh # datums
(d, _ ) <- ptryFrom $ pforgetData $ pdata dt (d, _) <- ptryFrom $ pforgetData $ pdata dt
pfromData d pfromData d
{- | Extract the value stored in a PMaybe container. {- | Extract the value stored in a PMaybe container.
@ -558,3 +560,6 @@ mustBePDJust = phoistAcyclic $
plam $ \emsg mv' -> pmatch mv' $ \case plam $ \emsg mv' -> pmatch mv' $ \case
PDJust ((pfield @"_0" #) -> v) -> v PDJust ((pfield @"_0" #) -> v) -> v
_ -> ptraceError emsg _ -> ptraceError emsg
validatorHashToAddress :: ValidatorHash -> Address
validatorHashToAddress vh = Address (ScriptCredential vh) Nothing