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

add someee comments; consistent naming

Browse source
This commit is contained in:
fanghr 2022-05-10 19:55:41 +08:00
parent 25ef9ba926
commit a4ba8501a2
3 changed files with 208 additions and 175 deletions
Download patch file Download diff file Expand all files Collapse all files

14
agora/Agora/Governor.hs
View file

@ -60,7 +60,7 @@ import PlutusTx qualified
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | State datum for the Governor script. -- | Datum for the Governor script.
data GovernorDatum = GovernorDatum data GovernorDatum = GovernorDatum
{ proposalThresholds :: ProposalThresholds { proposalThresholds :: ProposalThresholds
-- ^ Gets copied over upon creation of a 'Agora.Proposal.ProposalDatum'. -- ^ Gets copied over upon creation of a 'Agora.Proposal.ProposalDatum'.
@ -124,7 +124,7 @@ newtype PGovernorDatum (s :: S) = PGovernorDatum
deriving anyclass (Generic) deriving anyclass (Generic)
deriving anyclass (PIsDataRepr) deriving anyclass (PIsDataRepr)
deriving deriving
(PlutusType, PIsData, PDataFields) (PlutusType, PIsData, PDataFields, PEq)
via PIsDataReprInstances PGovernorDatum via PIsDataReprInstances PGovernorDatum
instance PUnsafeLiftDecl PGovernorDatum where type PLifted PGovernorDatum = GovernorDatum instance PUnsafeLiftDecl PGovernorDatum where type PLifted PGovernorDatum = GovernorDatum
@ -179,9 +179,9 @@ governorDatumValid = phoistAcyclic $
foldr1 foldr1
(#&&) (#&&)
[ ptraceIfFalse "Execute threshold larger than 0" $ 0 #<= execute [ ptraceIfFalse "Execute threshold is less than or equal to" $ 0 #<= execute
, ptraceIfFalse "Draft threshold larger than 0" $ 0 #<= draft , ptraceIfFalse "Draft threshold is less than or equal to " $ 0 #<= draft
, ptraceIfFalse "Vote threshold larger than 0" $ 0 #<= vote , ptraceIfFalse "Vote threshold is less than or equal to " $ 0 #<= vote
, ptraceIfFalse "Draft threshold larger than vote threshold" $ draft #<= vote , ptraceIfFalse "Draft threshold is less than vote threshold" $ draft #<= vote
, ptraceIfFalse "Execute threshold larger than vote threshold" $ vote #< execute , ptraceIfFalse "Execute threshold is less than vote threshold" $ vote #< execute
] ]

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

@ -16,7 +16,6 @@ module Agora.Governor.Scripts (
-- * Bridges -- * Bridges
governorSTSymbolFromGovernor, governorSTSymbolFromGovernor,
governorSTAssetClassFromGovernor, governorSTAssetClassFromGovernor,
atSymbolFromGovernor,
proposalSTAssetClassFromGovernor, proposalSTAssetClassFromGovernor,
stakeSTSymbolFromGovernor, stakeSTSymbolFromGovernor,
stakeFromGovernor, stakeFromGovernor,
@ -76,12 +75,12 @@ import Agora.Utils (
mustBePJust, mustBePJust,
mustFindDatum', mustFindDatum',
passert, passert,
pfindDatum,
pfindTxInByTxOutRef, pfindTxInByTxOutRef,
pisDJust, pisDJust,
pisJust, pisJust,
pisUTXOSpent, pisUTXOSpent,
psymbolValueOf, psymbolValueOf,
ptryFindDatum,
ptxSignedBy, ptxSignedBy,
pvalueSpent, pvalueSpent,
scriptHashFromAddress, scriptHashFromAddress,
@ -111,7 +110,6 @@ import Plutarch.Api.V1.Extra (
passetClass, passetClass,
passetClassValueOf, passetClassValueOf,
) )
import Plutarch.Builtin (pforgetData)
import Plutarch.Map.Extra ( import Plutarch.Map.Extra (
pkeys, pkeys,
plookup, plookup,
@ -285,26 +283,29 @@ governorValidator :: Governor -> ClosedTerm PValidator
governorValidator gov = governorValidator gov =
plam $ \datum' redeemer' ctx' -> P.do plam $ \datum' redeemer' ctx' -> P.do
(pfromData -> redeemer, _) <- ptryFrom redeemer' (pfromData -> redeemer, _) <- ptryFrom redeemer'
ctx <- pletFields @'["txInfo", "purpose"] ctx' ctxF <- pletFields @'["txInfo", "purpose"] ctx'
txInfo' <- plet $ pfromData $ ctx.txInfo txInfo' <- plet $ pfromData $ ctxF.txInfo
txInfo <- pletFields @'["mint", "inputs", "outputs", "datums", "signatories"] txInfo' txInfoF <- pletFields @'["mint", "inputs", "outputs", "datums", "signatories"] txInfo'
PSpending ((pfield @"_0" #) -> txOutRef') <- pmatch $ pfromData ctx.purpose PSpending (pfromData . (pfield @"_0" #) -> ownInputRef) <- pmatch $ pfromData ctxF.purpose
let txOutRef = pfromData txOutRef'
PJust ((pfield @"resolved" #) -> ownInput') <- pmatch $ pfindTxInByTxOutRef # txOutRef # txInfo.inputs ((pfield @"resolved" #) -> ownInput) <-
ownInput <- pletFields @'["address", "value"] ownInput' plet $
let selfAddress = pfromData $ ownInput.address mustBePJust # "Own input not found"
#$ pfindTxInByTxOutRef # ownInputRef # txInfoF.inputs
ownInputF <- pletFields @'["address", "value"] ownInput
let ownAddress = pfromData $ ownInputF.address
(pfromData -> (oldParams' :: Term _ PGovernorDatum), _) <- ptryFrom datum' (pfromData -> (oldGovernorDatum :: Term _ PGovernorDatum), _) <- ptryFrom datum'
oldParams <- pletFields @'["proposalThresholds", "nextProposalId"] oldParams' oldGovernorDatumF <- pletFields @'["proposalThresholds", "nextProposalId"] oldGovernorDatum
let ownInputGSTAmount = psymbolValueOf # pgstSymbol # ownInput.value -- Check that GST will be returned to the governor.
let ownInputGSTAmount = psymbolValueOf # pgstSymbol # ownInputF.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.outputs # selfAddress ownOutputs <- plet $ findOutputsToAddress # txInfoF.outputs # ownAddress
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
@ -312,38 +313,42 @@ governorValidator gov =
let ownOuputGSTAmount = psymbolValueOf # pgstSymbol # 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" $
pisDJust # ownOutput.datumHash
let outputGovernorStateDatumHash = mustBePDJust # "Output governor state datum hash not found" # ownOutput.datumHash -- Check that own output have datum of type 'GovernorDatum'.
let outputGovernorStateDatumHash =
newDatumData <- mustBePDJust # "Governor output doesn't have datum" # ownOutput.datumHash
newGovernorDatum <-
plet $ plet $
pforgetData $ pfromData $
pdata $ mustBePJust # "Ouput governor state datum not found"
mustBePJust # "Ouput governor state datum not found" #$ ptryFindDatum # outputGovernorStateDatumHash # txInfoF.datums
#$ pfindDatum # outputGovernorStateDatumHash # txInfo.datums passert "New datum is not valid" $ governorDatumValid # newGovernorDatum
pmatch redeemer $ \case pmatch redeemer $ \case
PCreateProposal _ -> P.do PCreateProposal _ -> P.do
let expectedNextProposalId = pgetNextProposalId # oldParams.nextProposalId -- Check that the transaction advances proposal id.
let expectedNextProposalId = pgetNextProposalId # oldGovernorDatumF.nextProposalId
expectedNewDatum = expectedNewDatum =
mkRecordConstr mkRecordConstr
PGovernorDatum PGovernorDatum
( #proposalThresholds .= oldParams.proposalThresholds ( #proposalThresholds .= oldGovernorDatumF.proposalThresholds
.& #nextProposalId .= pdata expectedNextProposalId .& #nextProposalId .= pdata expectedNextProposalId
) )
passert "Unexpected governor state datum" $ passert "Unexpected governor state datum" $
newDatumData #== pforgetData (pdata expectedNewDatum) newGovernorDatum #== expectedNewDatum
-- Check that exactly one proposal token is being minted.
passert "Exactly one proposal token must be minted" $ passert "Exactly one proposal token must be minted" $
hasOnlyOneTokenOfCurrencySymbol # ppstSymbol # txInfo.mint hasOnlyOneTokenOfCurrencySymbol # ppstSymbol # txInfoF.mint
-- -- Check that a stake is spent to create the propsal,
-- and the value it contains meets the requirement.
inputsFromStakeValidatorWithStateToken <- stakeInput <-
plet $ plet $
pfilter mustBePJust # "Stake input not found" #$ pfind
# phoistAcyclic # phoistAcyclic
( plam $ ( plam $
\((pfield @"resolved" #) -> txOut') -> P.do \((pfield @"resolved" #) -> txOut') -> P.do
@ -352,31 +357,27 @@ governorValidator gov =
txOut.address #== pdata pstakeValidatorAddress txOut.address #== pdata pstakeValidatorAddress
#&& psymbolValueOf # psstSymbol # txOut.value #== 1 #&& psymbolValueOf # psstSymbol # txOut.value #== 1
) )
# pfromData txInfo.inputs # pfromData txInfoF.inputs
passert "Exactly one input from the stake validator" $ stakeInputF <- pletFields @'["datumHash", "value"] $ pfield @"resolved" # stakeInput
plength # inputsFromStakeValidatorWithStateToken #== 1
stakeInput <- passert "Stake input doesn't have datum" $
pletFields @'["datumHash", "value"] $ pisDJust # stakeInputF.datumHash
pfield @"resolved"
#$ phead # inputsFromStakeValidatorWithStateToken
passert "Stake input must have datum" $ let stakeInputDatum = mustFindDatum' @PStakeDatum # stakeInputF.datumHash # txInfoF.datums
pisDJust # stakeInput.datumHash
let stakeInputDatum' = mustFindDatum' @PStakeDatum # stakeInput.datumHash # txInfo.datums stakeInputDatumF <-
pletFields @["stakedAmount", "owner", "lockedBy"] stakeInputDatum
stakeInputDatum <- passert "Required amount of stake GTs should be presented" $
pletFields @["stakedAmount", "owner", "lockedBy"] stakeInputDatum' stakeInputDatumF.stakedAmount #== (pgtValueOf # stakeInputF.value)
passert "Required amount of stake GT should be presented" $
stakeInputDatum.stakedAmount #== (pgtValueOf # stakeInput.value)
-- TODO: Is this required?
passert "Tx should be signed by the stake owner" $ passert "Tx should be signed by the stake owner" $
ptxSignedBy # txInfo.signatories # stakeInputDatum.owner ptxSignedBy # txInfoF.signatories # stakeInputDatumF.owner
-- -- Check that the newly minted PST is sent to the proposal validator,
-- and the datum it carries is legal.
outputsToProposalValidatorWithStateToken <- outputsToProposalValidatorWithStateToken <-
plet $ plet $
@ -389,7 +390,7 @@ governorValidator gov =
txOut.address #== pdata pproposalValidatorAddress txOut.address #== pdata pproposalValidatorAddress
#&& psymbolValueOf # ppstSymbol # txOut.value #== 1 #&& psymbolValueOf # ppstSymbol # txOut.value #== 1
) )
# pfromData txInfo.outputs # pfromData txInfoF.outputs
passert "Exactly one UTXO with proposal state token should be sent to the proposal validator" $ passert "Exactly one UTXO with proposal state token should be sent to the proposal validator" $
plength # outputsToProposalValidatorWithStateToken #== 1 plength # outputsToProposalValidatorWithStateToken #== 1
@ -399,42 +400,46 @@ governorValidator gov =
passert "The utxo paid to the proposal validator must have datum" $ passert "The utxo paid to the proposal validator must have datum" $
pisDJust # outputDatumHash pisDJust # outputDatumHash
outputProposalDatum' <- proposalOutputDatum' <-
plet $ plet $
mustFindDatum' @PProposalDatum mustFindDatum' @PProposalDatum
# outputDatumHash # outputDatumHash
# txInfo.datums # txInfoF.datums
passert "Proposal datum must be valid" $ passert "Proposal datum must be valid" $
proposalDatumValid' # outputProposalDatum' proposalDatumValid' # proposalOutputDatum'
outputProposalDatum <- proposalOutputDatum <-
pletFields pletFields
@'["proposalId", "status", "cosigners", "thresholds", "votes"] @'["proposalId", "status", "cosigners", "thresholds", "votes"]
outputProposalDatum' proposalOutputDatum'
-- Id and thresholds should be copied from the old governor state datum.
passert "Invalid proposal id in proposal datum" $ passert "Invalid proposal id in proposal datum" $
outputProposalDatum.proposalId #== oldParams.nextProposalId proposalOutputDatum.proposalId #== oldGovernorDatumF.nextProposalId
passert "Invalid thresholds in proposal datum" $ passert "Invalid thresholds in proposal datum" $
outputProposalDatum.thresholds #== oldParams.proposalThresholds proposalOutputDatum.thresholds #== oldGovernorDatumF.proposalThresholds
-- The proposal at this point should be in draft state.
passert "Proposal state should be draft" $ passert "Proposal state should be draft" $
outputProposalDatum.status #== pconstantData Draft proposalOutputDatum.status #== pconstantData Draft
passert "Proposal should have only one cosigner" $ passert "Proposal should have only one cosigner" $
plength # pfromData outputProposalDatum.cosigners #== 1 plength # pfromData proposalOutputDatum.cosigners #== 1
let cosigner = phead # pfromData outputProposalDatum.cosigners let cosigner = phead # pfromData proposalOutputDatum.cosigners
passert "Cosigner should be the stake owner" $ passert "Cosigner should be the stake owner" $
pdata stakeInputDatum.owner #== cosigner pdata stakeInputDatumF.owner #== cosigner
-- -- Check the output stake has been proposly updated.
outputToStakeValidatorWithStateToken <- stakeOutput <-
plet $ plet $
pfilter mustBePJust
# "Stake output not found"
#$ pfind
# phoistAcyclic # phoistAcyclic
( plam $ ( plam $
\txOut' -> P.do \txOut' -> P.do
@ -443,27 +448,21 @@ governorValidator gov =
txOut.address #== pdata pstakeValidatorAddress txOut.address #== pdata pstakeValidatorAddress
#&& psymbolValueOf # psstSymbol # txOut.value #== 1 #&& psymbolValueOf # psstSymbol # txOut.value #== 1
) )
# pfromData txInfo.outputs # pfromData txInfoF.outputs
passert "Exactly one UTXO with stake state token should be sent to the stake validator" $ stakeOutputF <- pletFields @'["datumHash", "value"] $ stakeOutput
plength # outputToStakeValidatorWithStateToken #== 1
stakeOutput <-
pletFields @'["datumHash", "value"] $
pfromData $
phead # outputToStakeValidatorWithStateToken
passert "Staked GTs should be sent back to stake validator" $ passert "Staked GTs should be sent back to stake validator" $
stakeInputDatum.stakedAmount #== (pgtValueOf # stakeOutput.value) stakeInputDatumF.stakedAmount #== (pgtValueOf # stakeOutputF.value)
let stakeOutputDatumHash = mustBePDJust # "Stake output should have datum" # stakeOutput.datumHash let stakeOutputDatumHash = mustBePDJust # "Stake output should have datum" # stakeOutputF.datumHash
stakeOutputDatum = stakeOutputDatum =
pforgetData $ mustBePJust # "Stake output not found" #$ ptryFindDatum # stakeOutputDatumHash # txInfoF.datums
pdata $
mustBePJust # "Stake output not found" #$ pfindDatum # stakeOutputDatumHash # txInfo.datums
let possibleVoteResults = pkeys #$ pto $ pfromData outputProposalDatum.votes -- The stake should be locked by the newly created proposal.
let possibleVoteResults = pkeys #$ pto $ pfromData proposalOutputDatum.votes
mkProposalLock :: Term _ (PProposalId :--> PAsData PResultTag :--> PAsData PProposalLock) mkProposalLock :: Term _ (PProposalId :--> PAsData PResultTag :--> PAsData PProposalLock)
mkProposalLock = mkProposalLock =
@ -477,98 +476,103 @@ governorValidator gov =
) )
) )
-- Append new locks to existing locks
expectedProposalLocks = expectedProposalLocks =
pconcat # stakeInputDatum.lockedBy pconcat # stakeInputDatumF.lockedBy
#$ pmap # (mkProposalLock # outputProposalDatum.proposalId) # possibleVoteResults #$ pmap # (mkProposalLock # proposalOutputDatum.proposalId) # possibleVoteResults
expectedOutputDatum = expectedStakeOutputDatum =
pforgetData $ pdata $
pdata $ mkRecordConstr
mkRecordConstr PStakeDatum
PStakeDatum ( #stakedAmount .= stakeInputDatumF.stakedAmount
( #stakedAmount .= stakeInputDatum.stakedAmount .& #owner .= stakeInputDatumF.owner
.& #owner .= stakeInputDatum.owner .& #lockedBy .= pdata expectedProposalLocks
.& #lockedBy .= pdata expectedProposalLocks )
)
passert "Unexpected stake output datum" $ expectedOutputDatum #== stakeOutputDatum passert "Unexpected stake output datum" $ expectedStakeOutputDatum #== stakeOutputDatum
popaque $ pconstant () popaque $ pconstant ()
--------------------------------------------------------------------------
PMintGATs _ -> P.do PMintGATs _ -> P.do
passert "Governor state should not be changed" $ newDatumData #== datum' passert "Governor state should not be changed" $ newGovernorDatum #== oldGovernorDatum
inputsWithProposalStateToken <- -- Filter out proposal inputs and ouputs using PST and the address of proposal validator.
plet $
pfilter
# plam
( \((pfield @"value" #) . (pfield @"resolved" #) -> value) ->
psymbolValueOf # ppstSymbol # value #== 1
)
#$ pfromData txInfo.inputs
outputsWithProposalStateToken <-
plet $
pfilter
# plam
( \((pfield @"value" #) -> value) ->
psymbolValueOf # ppstSymbol # value #== 1
)
#$ 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 (psymbolValueOf # ppstSymbol #$ pvalueSpent # txInfoF.inputs) #== 1
#&& (psymbolValueOf # ppstSymbol #$ pvalueSpent # txInfo.inputs) #== 1
proposalInputTxOut <- proposalInputF <-
pletFields @'["address", "value", "datumHash"] $ pletFields @'["datumHash"] $
pfield @"resolved" #$ phead # inputsWithProposalStateToken pfield @"resolved"
proposalOutputTxOut <- #$ pfromData
pletFields @'["datumHash", "address"] $ $ mustBePJust
phead # outputsWithProposalStateToken # "Proposal input not found"
#$ pfind
# plam
( \((pfield @"resolved" #) -> txOut) -> P.do
txOutF <- pletFields @'["address", "value"] txOut
passert "Proposal state token must be sent back to the proposal validator" $ psymbolValueOf # ppstSymbol # txOutF.value #== 1
proposalOutputTxOut.address #== pdata pproposalValidatorAddress #&& txOutF.address #== pdata pproposalValidatorAddress
)
# pfromData txInfoF.inputs
inputProposalDatum' <- proposalOutputF <-
pletFields @'["datumHash"] $
mustBePJust # "Proposal output not found"
#$ pfind
# plam
( \txOut -> P.do
txOutF <- pletFields @'["address", "value"] txOut
psymbolValueOf # ppstSymbol # txOutF.value #== 1
#&& txOutF.address #== pdata pproposalValidatorAddress
)
# pfromData txInfoF.outputs
proposalInputDatum <-
plet $ plet $
mustFindDatum' @PProposalDatum mustFindDatum' @PProposalDatum
# proposalInputTxOut.datumHash # proposalInputF.datumHash
# txInfo.datums # txInfoF.datums
outputProposalDatum' <- proposalOutputDatum <-
plet $ plet $
mustFindDatum' @PProposalDatum mustFindDatum' @PProposalDatum
# proposalOutputTxOut.datumHash # proposalOutputF.datumHash
# txInfo.datums # txInfoF.datums
passert "Proposal datum must be valid" $ passert "Proposal datum must be valid" $
proposalDatumValid' # inputProposalDatum' proposalDatumValid' # proposalInputDatum
#&& proposalDatumValid' # outputProposalDatum' #&& proposalDatumValid' # proposalOutputDatum
inputProposalDatum <- proposalInputDatumF <-
pletFields @'["proposalId", "effects", "status", "cosigners", "thresholds", "votes"] pletFields @'["proposalId", "effects", "status", "cosigners", "thresholds", "votes"]
inputProposalDatum' proposalInputDatum
-- Check that the proposal state is advanced so that a proposal cannot be executed twice.
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" $
inputProposalDatum.status #== pconstantData Locked proposalInputDatumF.status #== pconstantData Locked
let expectedOutputProposalDatum = let expectedOutputProposalDatum =
pforgetData $ mkRecordConstr
pdata $ PProposalDatum
mkRecordConstr ( #proposalId .= proposalInputDatumF.proposalId
PProposalDatum .& #effects .= proposalInputDatumF.effects
( #proposalId .= inputProposalDatum.proposalId .& #status .= pdata (pcon $ PFinished pdnil)
.& #effects .= inputProposalDatum.effects .& #cosigners .= proposalInputDatumF.cosigners
.& #status .= pdata (pcon $ PFinished pdnil) .& #thresholds .= proposalInputDatumF.thresholds
.& #cosigners .= inputProposalDatum.cosigners .& #votes .= proposalInputDatumF.votes
.& #thresholds .= inputProposalDatum.thresholds )
.& #votes .= inputProposalDatum.votes
)
passert "Unexpected output proposal datum" $ passert "Unexpected output proposal datum" $
pforgetData (pdata outputProposalDatum') #== expectedOutputProposalDatum pdata proposalOutputDatum #== pdata expectedOutputProposalDatum
-- TODO: anything else to check here? -- TODO: anything else to check here?
-- Find the highest votes and the corresponding tag.
let highestVoteFolder = let highestVoteFolder =
phoistAcyclic $ phoistAcyclic $
plam plam
@ -584,27 +588,29 @@ governorValidator gov =
(pcon $ PJust pair) (pcon $ PJust pair)
) )
votesList = pto $ pto $ pfromData inputProposalDatum.votes votesList = pto $ pto $ pfromData proposalInputDatumF.votes
winner' = maybeWinner =
pfoldr # highestVoteFolder # pcon PNothing # votesList pfoldr # highestVoteFolder # pcon PNothing # votesList
winner <- plet $ mustBePJust # "Empty votes" # winner' winner <- plet $ mustBePJust # "No winning outcome" # maybeWinner
let highestVote = pfromData $ psndBuiltin # winner let highestVote = pfromData $ psndBuiltin # winner
minimumVotes = puntag $ pfromData $ pfield @"execute" # inputProposalDatum.thresholds minimumVotes = puntag $ pfromData $ pfield @"execute" # proposalInputDatumF.thresholds
passert "Higgest vote doesn't meet the minimum requirement" $ minimumVotes #<= highestVote passert "Higgest vote doesn't meet the minimum requirement" $ minimumVotes #<= highestVote
let finalResultTag = pfromData $ pfstBuiltin # winner let finalResultTag = pfromData $ pfstBuiltin # winner
effectGroup <- plet $ plookup' # finalResultTag #$ inputProposalDatum.effects -- The effects of the winner outcome.
effectGroup <- plet $ plookup' # finalResultTag #$ proposalInputDatumF.effects
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 # patSymbol # txInfo.mint #== gatCount psymbolValueOf # patSymbol # txInfoF.mint #== gatCount
-- Ensure that every GAT goes to one of the effects in the winner effect group.
outputsWithGAT <- outputsWithGAT <-
plet $ plet $
pfilter pfilter
@ -614,16 +620,16 @@ governorValidator gov =
0 #< psymbolValueOf # patSymbol # value 0 #< psymbolValueOf # patSymbol # value
) )
) )
# pfromData txInfo.outputs # pfromData txInfoF.outputs
passert "Output GATs is more than minted GATs" $ passert "Output GATs is more than minted GATs" $
plength # outputsWithGAT #== gatCount plength # outputsWithGAT #== gatCount
let gatOutputValidator' :: Term s (PMap PValidatorHash PDatumHash :--> PAsData PTxOut :--> PUnit :--> PUnit) let gatOutputValidator' :: Term s (PMap PValidatorHash PDatumHash :--> PAsData PTxOut :--> PBool)
gatOutputValidator' = gatOutputValidator' =
phoistAcyclic $ phoistAcyclic $
plam plam
( \effects (pfromData -> output') _ -> P.do ( \effects (pfromData -> output') -> P.do
output <- pletFields @'["address", "datumHash"] $ output' output <- pletFields @'["address", "datumHash"] $ output'
let scriptHash = let scriptHash =
@ -637,52 +643,72 @@ 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 # patSymbol # output' foldr1
passert "Unexpected datum" $ datumHash #== expectedDatumHash (#&&)
pconstant () [ ptraceIfFalse "GAT must be tagged by the effect hash" $ authorityTokensValidIn # patSymbol # output'
, ptraceIfFalse "Unexpected datum" $ datumHash #== expectedDatumHash
]
) )
gatOutputValidator = gatOutputValidator' # effectGroup gatOutputValidator = gatOutputValidator' # effectGroup
popaque $ popaque $
pfoldr pfoldr
# gatOutputValidator # plam
# pconstant () ( \txOut r ->
# outputsWithGAT let value = pfield @"value" # txOut
atValue = psymbolValueOf # patSymbol # value
in pif (atValue #== 0) r $
pif (atValue #== 1) (r #&& gatOutputValidator # txOut) $ pconstant False
)
# pconstant True
# pfromData txInfoF.outputs
--------------------------------------------------------------------------
PMutateGovernor _ -> P.do PMutateGovernor _ -> P.do
popaque $ singleAuthorityTokenBurned patSymbol ctx.txInfo txInfo.mint -- Check that a GAT is burnt.
popaque $ singleAuthorityTokenBurned patSymbol ctxF.txInfo txInfoF.mint
where where
-- Get th amount of governance tokens in a value.
pgtValueOf :: Term s (PValue :--> PDiscrete GTTag) pgtValueOf :: Term s (PValue :--> PDiscrete GTTag)
pgtValueOf = phoistAcyclic $ pvalueDiscrete' gov.gtClassRef pgtValueOf = phoistAcyclic $ pvalueDiscrete' gov.gtClassRef
-- The currency symbol of authority token.
patSymbol :: Term s PCurrencySymbol patSymbol :: Term s PCurrencySymbol
patSymbol = phoistAcyclic $ pconstant $ atSymbolFromGovernor gov patSymbol = phoistAcyclic $ pconstant $ authorityTokenSymbolFromGovernor gov
-- The currency symbol of the proposal state token.
ppstSymbol :: Term s PCurrencySymbol ppstSymbol :: Term s PCurrencySymbol
ppstSymbol = ppstSymbol =
let AssetClass (sym, _) = proposalSTAssetClassFromGovernor gov let AssetClass (sym, _) = proposalSTAssetClassFromGovernor gov
in phoistAcyclic $ pconstant sym in phoistAcyclic $ pconstant sym
-- Is a proposal state datum valid?
proposalDatumValid' :: Term s (PProposalDatum :--> PBool) proposalDatumValid' :: Term s (PProposalDatum :--> PBool)
proposalDatumValid' = proposalDatumValid' =
let params = proposalFromGovernor gov let params = proposalFromGovernor gov
in phoistAcyclic $ proposalDatumValid params in phoistAcyclic $ proposalDatumValid params
-- The address of the proposal validator.
pproposalValidatorAddress :: Term s PAddress pproposalValidatorAddress :: Term s PAddress
pproposalValidatorAddress = pproposalValidatorAddress =
let vh = proposalValidatorHashFromGovernor gov let vh = proposalValidatorHashFromGovernor gov
in phoistAcyclic $ pconstant $ validatorHashToAddress vh in phoistAcyclic $ pconstant $ validatorHashToAddress vh
-- The address of the stake validator.
pstakeValidatorAddress :: Term s PAddress pstakeValidatorAddress :: Term s PAddress
pstakeValidatorAddress = pstakeValidatorAddress =
let vh = stakeValidatorHashFromGovernor gov let vh = stakeValidatorHashFromGovernor gov
in phoistAcyclic $ pconstant $ validatorHashToAddress vh in phoistAcyclic $ pconstant $ validatorHashToAddress vh
-- The currency symbol of the stake state token.
psstSymbol :: Term s PCurrencySymbol psstSymbol :: Term s PCurrencySymbol
psstSymbol = psstSymbol =
let sym = stakeSTSymbolFromGovernor gov let sym = stakeSTSymbolFromGovernor gov
in phoistAcyclic $ pconstant sym in phoistAcyclic $ pconstant sym
-- The currency symbol of the governor state token.
pgstSymbol :: Term s PCurrencySymbol pgstSymbol :: Term s PCurrencySymbol
pgstSymbol = pgstSymbol =
let sym = governorSTSymbolFromGovernor gov let sym = governorSTSymbolFromGovernor gov
@ -690,28 +716,21 @@ governorValidator gov =
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | Get the 'CurrencySymbol' of GST.
governorSTSymbolFromGovernor :: Governor -> CurrencySymbol governorSTSymbolFromGovernor :: Governor -> CurrencySymbol
governorSTSymbolFromGovernor gov = mintingPolicySymbol policy governorSTSymbolFromGovernor gov = mintingPolicySymbol policy
where where
policy :: MintingPolicy policy :: MintingPolicy
policy = mkMintingPolicy $ governorPolicy gov policy = mkMintingPolicy $ governorPolicy gov
{- | Get the 'AssetClass' of GST from 'Governor'. -- | Get the 'AssetClass' of GST.
TODO: tag GST?
-}
governorSTAssetClassFromGovernor :: Governor -> AssetClass governorSTAssetClassFromGovernor :: Governor -> AssetClass
governorSTAssetClassFromGovernor gov = AssetClass (symbol, "") governorSTAssetClassFromGovernor gov = AssetClass (symbol, "")
where where
symbol :: CurrencySymbol symbol :: CurrencySymbol
symbol = governorSTSymbolFromGovernor gov symbol = governorSTSymbolFromGovernor gov
-- | Get the `CurrencySymbol` of GAT from 'Governor'. -- | Get the 'CurrencySymbol' of the proposal state token.
atSymbolFromGovernor :: Governor -> CurrencySymbol
atSymbolFromGovernor gov = mintingPolicySymbol policy
where
at = AuthorityToken $ governorSTAssetClassFromGovernor gov
policy = mkMintingPolicy $ authorityTokenPolicy at
proposalSTSymbolFromGovernor :: Governor -> CurrencySymbol proposalSTSymbolFromGovernor :: Governor -> CurrencySymbol
proposalSTSymbolFromGovernor gov = symbol proposalSTSymbolFromGovernor gov = symbol
where where
@ -719,16 +738,23 @@ proposalSTSymbolFromGovernor gov = symbol
policy = mkMintingPolicy $ proposalPolicy gstAC policy = mkMintingPolicy $ proposalPolicy gstAC
symbol = mintingPolicySymbol policy symbol = mintingPolicySymbol policy
-- | Get the 'AssetClass' of the proposal state token.
proposalSTAssetClassFromGovernor :: Governor -> AssetClass proposalSTAssetClassFromGovernor :: Governor -> AssetClass
proposalSTAssetClassFromGovernor gov = AssetClass (symbol, "") proposalSTAssetClassFromGovernor gov = AssetClass (symbol, "")
where where
symbol = proposalSTSymbolFromGovernor gov symbol = proposalSTSymbolFromGovernor gov
-- | Get the 'CurrencySymbol' of the stake token/
stakeSTSymbolFromGovernor :: Governor -> CurrencySymbol stakeSTSymbolFromGovernor :: Governor -> CurrencySymbol
stakeSTSymbolFromGovernor gov = mintingPolicySymbol policy stakeSTSymbolFromGovernor gov = mintingPolicySymbol policy
where where
policy = mkMintingPolicy $ stakePolicy gov.gtClassRef policy = mkMintingPolicy $ stakePolicy gov.gtClassRef
{- | Get the 'AssetClass' of the stake token.
Note that the token is tagged with the hash of the stake validator.
See 'Agora.Stake.Script.stakePolicy'.
-}
stakeSTAssetClassFromGovernor :: Governor -> AssetClass stakeSTAssetClassFromGovernor :: Governor -> AssetClass
stakeSTAssetClassFromGovernor gov = AssetClass (symbol, tokenName) stakeSTAssetClassFromGovernor gov = AssetClass (symbol, tokenName)
where where
@ -737,17 +763,20 @@ stakeSTAssetClassFromGovernor gov = AssetClass (symbol, tokenName)
-- Tag with the address where the token is being sent to. -- Tag with the address where the token is being sent to.
tokenName = validatorHashToTokenName $ stakeValidatorHashFromGovernor gov tokenName = validatorHashToTokenName $ stakeValidatorHashFromGovernor gov
-- | Get the 'Stake' parameter, given the 'Governor' parameter.
stakeFromGovernor :: Governor -> Stake stakeFromGovernor :: Governor -> Stake
stakeFromGovernor gov = stakeFromGovernor gov =
Stake gov.gtClassRef $ Stake gov.gtClassRef $
proposalSTAssetClassFromGovernor gov proposalSTAssetClassFromGovernor gov
-- | Get the hash of 'Agora.Stake.Script.stakePolicy'.
stakeValidatorHashFromGovernor :: Governor -> ValidatorHash stakeValidatorHashFromGovernor :: Governor -> ValidatorHash
stakeValidatorHashFromGovernor gov = validatorHash validator stakeValidatorHashFromGovernor gov = validatorHash validator
where where
params = stakeFromGovernor gov params = stakeFromGovernor gov
validator = mkValidator $ stakeValidator params validator = mkValidator $ stakeValidator params
-- | Get the 'Proposal' parameter, given the 'Governor' parameter.
proposalFromGovernor :: Governor -> Proposal proposalFromGovernor :: Governor -> Proposal
proposalFromGovernor gov = Proposal gstAC sstAC mc proposalFromGovernor gov = Proposal gstAC sstAC mc
where where
@ -755,20 +784,24 @@ proposalFromGovernor gov = Proposal gstAC sstAC mc
mc = gov.maximumCosigners mc = gov.maximumCosigners
sstAC = stakeSTAssetClassFromGovernor gov sstAC = stakeSTAssetClassFromGovernor gov
-- | Get the hash of 'Agora.Proposal.proposalPolicy'.
proposalValidatorHashFromGovernor :: Governor -> ValidatorHash proposalValidatorHashFromGovernor :: Governor -> ValidatorHash
proposalValidatorHashFromGovernor gov = validatorHash validator proposalValidatorHashFromGovernor gov = validatorHash validator
where where
params = proposalFromGovernor gov params = proposalFromGovernor gov
validator = mkValidator $ proposalValidator params validator = mkValidator $ proposalValidator params
-- | Get the hash of 'Agora.Proposal.proposalValidator'.
governorValidatorHash :: Governor -> ValidatorHash governorValidatorHash :: Governor -> ValidatorHash
governorValidatorHash gov = validatorHash validator governorValidatorHash gov = validatorHash validator
where where
validator = mkValidator $ governorValidator gov validator = mkValidator $ governorValidator gov
-- | Get the 'AuthorityToken' parameter given the 'Governor' parameter.
authorityTokenFromGovernor :: Governor -> AuthorityToken authorityTokenFromGovernor :: Governor -> AuthorityToken
authorityTokenFromGovernor gov = AuthorityToken $ governorSTAssetClassFromGovernor gov authorityTokenFromGovernor gov = AuthorityToken $ governorSTAssetClassFromGovernor gov
-- | Get the 'CurrencySymbol' of the authority token.
authorityTokenSymbolFromGovernor :: Governor -> CurrencySymbol authorityTokenSymbolFromGovernor :: Governor -> CurrencySymbol
authorityTokenSymbolFromGovernor gov = mintingPolicySymbol policy authorityTokenSymbolFromGovernor gov = mintingPolicySymbol policy
where where

2
agora/Agora/Utils.hs
View file

@ -385,7 +385,7 @@ pisUniq = phoistAcyclic $
pisUniqOrd :: forall list a (s :: S). (POrd a, PIsListLike list a) => Term s (list a :--> PBool) pisUniqOrd :: forall list a (s :: S). (POrd a, PIsListLike list a) => Term s (list a :--> PBool)
pisUniqOrd = phoistAcyclic $ pisUniq # plam (#<) pisUniqOrd = phoistAcyclic $ pisUniq # plam (#<)
-- | 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 $
plam $ \x -> plam $ \x ->