improve performance of the governor validator
This commit is contained in:
Hongrui Fang
parent
a19bbce198
commit
b6fb23975c
13 changed files with 166 additions and 319 deletions
|
|
@ -62,8 +62,6 @@ data GovernorDatumCases
|
|||
= ExecuteLE0
|
||||
| CreateLE0
|
||||
| VoteLE0
|
||||
| CreateLEVote
|
||||
| ExecuteLVote
|
||||
| Correct
|
||||
deriving stock (Eq, Show)
|
||||
|
||||
|
|
@ -72,8 +70,6 @@ instance Universe GovernorDatumCases where
|
|||
[ ExecuteLE0
|
||||
, CreateLE0
|
||||
, VoteLE0
|
||||
, CreateLEVote
|
||||
, ExecuteLVote
|
||||
, Correct
|
||||
]
|
||||
|
||||
|
|
@ -94,8 +90,6 @@ governorDatumValidProperty =
|
|||
| e < 0 = ExecuteLE0
|
||||
| c < 0 = CreateLE0
|
||||
| v < 0 = VoteLE0
|
||||
| c > v = CreateLEVote
|
||||
| v >= e = ExecuteLVote
|
||||
| otherwise = Correct
|
||||
|
||||
expected :: GovernorDatum -> Maybe Bool
|
||||
|
|
@ -127,16 +121,6 @@ governorDatumValidProperty =
|
|||
VoteLE0 ->
|
||||
-- vote < 0
|
||||
return $ ProposalThresholds execute create le0
|
||||
CreateLEVote -> do
|
||||
-- c > vote
|
||||
nv <- taggedInteger (0, untag create - 1)
|
||||
ne <- taggedInteger (untag nv + 1, 1000000000)
|
||||
return $ ProposalThresholds ne create nv
|
||||
ExecuteLVote -> do
|
||||
-- vote >= execute
|
||||
ne <- taggedInteger (0, untag vote)
|
||||
nc <- taggedInteger (0, untag vote)
|
||||
return $ ProposalThresholds ne nc vote
|
||||
Correct -> do
|
||||
-- c <= vote < execute
|
||||
nv <- taggedInteger (0, untag execute - 1)
|
||||
|
|
|
|||
|
|
@ -11,19 +11,18 @@ module Spec.AuthorityToken (specs) where
|
|||
|
||||
import Agora.AuthorityToken (singleAuthorityTokenBurned)
|
||||
import Plutarch (ClosedTerm, POpaque, compile, perror, popaque)
|
||||
import Plutarch.Unsafe (punsafeCoerce)
|
||||
import PlutusLedgerApi.V1 (
|
||||
Address (Address),
|
||||
Credential (PubKeyCredential, ScriptCredential),
|
||||
CurrencySymbol,
|
||||
Script,
|
||||
TxInInfo (TxInInfo),
|
||||
TxInfo (..),
|
||||
TxOut (TxOut),
|
||||
TxOutRef (TxOutRef),
|
||||
ValidatorHash (ValidatorHash),
|
||||
Value,
|
||||
)
|
||||
import PlutusLedgerApi.V1.Interval qualified as Interval (always)
|
||||
import PlutusLedgerApi.V1.Value qualified as Value (
|
||||
Value (Value),
|
||||
singleton,
|
||||
|
|
@ -36,37 +35,25 @@ import Test.Specification (
|
|||
scriptSucceeds,
|
||||
)
|
||||
import Prelude (
|
||||
Functor (fmap),
|
||||
Maybe (Nothing),
|
||||
PBool,
|
||||
Semigroup ((<>)),
|
||||
fmap,
|
||||
pconstant,
|
||||
pconstantData,
|
||||
pif,
|
||||
($),
|
||||
)
|
||||
|
||||
currencySymbol :: CurrencySymbol
|
||||
currencySymbol = "deadbeef"
|
||||
|
||||
mkTxInfo :: Value -> [TxOut] -> TxInfo
|
||||
mkTxInfo mint outs =
|
||||
TxInfo
|
||||
{ txInfoInputs = fmap (TxInInfo (TxOutRef "" 0)) outs
|
||||
, txInfoOutputs = []
|
||||
, txInfoFee = Value.singleton "" "" 1000
|
||||
, txInfoMint = mint
|
||||
, txInfoDCert = []
|
||||
, txInfoWdrl = []
|
||||
, txInfoValidRange = Interval.always
|
||||
, txInfoSignatories = []
|
||||
, txInfoData = []
|
||||
, txInfoId = ""
|
||||
}
|
||||
mkInputs :: [TxOut] -> [TxInInfo]
|
||||
mkInputs = fmap (TxInInfo (TxOutRef "" 0))
|
||||
|
||||
singleAuthorityTokenBurnedTest :: Value -> [TxOut] -> Script
|
||||
singleAuthorityTokenBurnedTest mint outs =
|
||||
let actual :: ClosedTerm PBool
|
||||
actual = singleAuthorityTokenBurned (pconstant currencySymbol) (pconstantData (mkTxInfo mint outs)) (pconstant mint)
|
||||
actual = singleAuthorityTokenBurned (pconstant currencySymbol) (punsafeCoerce $ pconstant $ mkInputs outs) (pconstant mint)
|
||||
s :: ClosedTerm POpaque
|
||||
s =
|
||||
pif
|
||||
|
|
|
|||
|
|
@ -40,7 +40,7 @@ specs =
|
|||
"use other's stake"
|
||||
Create.useStakeOwnBySomeoneElseParameters
|
||||
True
|
||||
False
|
||||
True
|
||||
False
|
||||
, Create.mkTestTree
|
||||
"altered stake"
|
||||
|
|
|
|||
|
|
@ -100,20 +100,18 @@ authorityTokensValidIn = phoistAcyclic $
|
|||
|
||||
{- | Assert that a single authority token has been burned.
|
||||
|
||||
@since 0.1.0
|
||||
@since 0.2.0
|
||||
-}
|
||||
singleAuthorityTokenBurned ::
|
||||
forall (keys :: KeyGuarantees) (amounts :: AmountGuarantees) (s :: S).
|
||||
Term s PCurrencySymbol ->
|
||||
Term s (PAsData PTxInfo) ->
|
||||
Term s (PBuiltinList (PAsData PTxInInfo)) ->
|
||||
Term s (PValue keys amounts) ->
|
||||
Term s PBool
|
||||
singleAuthorityTokenBurned gatCs txInfo mint = unTermCont $ do
|
||||
singleAuthorityTokenBurned gatCs inputs mint = unTermCont $ do
|
||||
let gatAmountMinted :: Term _ PInteger
|
||||
gatAmountMinted = psymbolValueOf # gatCs # mint
|
||||
|
||||
txInfoF <- pletFieldsC @'["inputs"] $ txInfo
|
||||
|
||||
pure $
|
||||
foldr1
|
||||
(#&&)
|
||||
|
|
@ -126,7 +124,7 @@ singleAuthorityTokenBurned gatCs txInfo mint = unTermCont $ do
|
|||
let txOut' = pfield @"resolved" # txInInfo
|
||||
pure $ authorityTokensValidIn # gatCs # pfromData txOut'
|
||||
)
|
||||
# txInfoF.inputs
|
||||
# inputs
|
||||
]
|
||||
|
||||
{- | Policy given 'AuthorityToken' params.
|
||||
|
|
|
|||
|
|
@ -30,7 +30,6 @@ makeEffect ::
|
|||
makeEffect gatCs' f =
|
||||
plam $ \datum _redeemer ctx' -> unTermCont $ do
|
||||
ctx <- pletFieldsC @'["txInfo", "purpose"] ctx'
|
||||
txInfo' <- pletC ctx.txInfo
|
||||
|
||||
-- convert input datum, PData, into desierable type
|
||||
-- the way this conversion is performed should be defined
|
||||
|
|
@ -42,14 +41,14 @@ makeEffect gatCs' f =
|
|||
txOutRef' <- pletC (pfield @"_0" # txOutRef)
|
||||
|
||||
-- fetch minted values to ensure single GAT is burned
|
||||
txInfo <- pletFieldsC @'["mint"] txInfo'
|
||||
txInfo <- pletFieldsC @'["mint", "inputs"] ctx.txInfo
|
||||
let mint :: Term _ (PValue _ _)
|
||||
mint = txInfo.mint
|
||||
|
||||
-- fetch script context
|
||||
gatCs <- pletC $ pconstant gatCs'
|
||||
|
||||
pguardC "A single authority token has been burned" $ singleAuthorityTokenBurned gatCs txInfo' mint
|
||||
pguardC "A single authority token has been burned" $ singleAuthorityTokenBurned gatCs txInfo.inputs mint
|
||||
|
||||
-- run effect function
|
||||
pure $ f gatCs datum' txOutRef' txInfo'
|
||||
pure $ f gatCs datum' txOutRef' ctx.txInfo
|
||||
|
|
|
|||
|
|
@ -260,6 +260,4 @@ governorDatumValid = phoistAcyclic $
|
|||
[ ptraceIfFalse "Execute threshold is less than or equal to" $ 0 #<= execute
|
||||
, ptraceIfFalse "Draft threshold is less than or equal to " $ 0 #<= draft
|
||||
, ptraceIfFalse "Vote threshold is less than or equal to " $ 0 #<= vote
|
||||
, ptraceIfFalse "Draft threshold is less than vote threshold" $ draft #<= vote
|
||||
, ptraceIfFalse "Execute threshold is less than vote threshold" $ vote #< execute
|
||||
]
|
||||
|
|
|
|||
|
|
@ -47,10 +47,11 @@ import Agora.Governor (
|
|||
import Agora.Proposal (
|
||||
PProposalDatum (..),
|
||||
Proposal (..),
|
||||
ProposalStatus (Draft, Finished, Locked),
|
||||
pemptyVotesFor,
|
||||
ProposalStatus (Draft, Locked),
|
||||
phasNeutralEffect,
|
||||
pisEffectsVotesCompatible,
|
||||
pisVotesEmpty,
|
||||
pneutralOption,
|
||||
proposalDatumValid,
|
||||
pwinner,
|
||||
)
|
||||
import Agora.Proposal.Scripts (
|
||||
|
|
@ -58,7 +59,6 @@ import Agora.Proposal.Scripts (
|
|||
proposalValidator,
|
||||
)
|
||||
import Agora.Proposal.Time (createProposalStartingTime)
|
||||
import Agora.SafeMoney (GTTag)
|
||||
import Agora.Stake (
|
||||
PProposalLock (..),
|
||||
PStakeDatum (..),
|
||||
|
|
@ -79,10 +79,6 @@ import Agora.Utils (
|
|||
validatorHashToAddress,
|
||||
validatorHashToTokenName,
|
||||
)
|
||||
import Plutarch.Extra.Record
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
import Plutarch.Api.V1 (
|
||||
PAddress,
|
||||
PCurrencySymbol,
|
||||
|
|
@ -93,7 +89,6 @@ import Plutarch.Api.V1 (
|
|||
PTxOut,
|
||||
PValidator,
|
||||
PValidatorHash,
|
||||
PValue,
|
||||
mintingPolicySymbol,
|
||||
mkMintingPolicy,
|
||||
mkValidator,
|
||||
|
|
@ -103,19 +98,18 @@ import Plutarch.Api.V1.AssetClass (
|
|||
passetClass,
|
||||
passetClassValueOf,
|
||||
)
|
||||
import Plutarch.Api.V1.ScriptContext (pfindTxInByTxOutRef, pisUTXOSpent, ptryFindDatum, ptxSignedBy, pvalueSpent)
|
||||
import Plutarch.Api.V1.ScriptContext (pfindTxInByTxOutRef, pisUTXOSpent, ptryFindDatum, pvalueSpent)
|
||||
import "liqwid-plutarch-extra" Plutarch.Api.V1.Value (psymbolValueOf)
|
||||
import Plutarch.Extra.Field (pletAllC)
|
||||
import Plutarch.Extra.IsData (pmatchEnumFromData)
|
||||
import Plutarch.Extra.List (pfirstJust)
|
||||
import Plutarch.Extra.Map (
|
||||
plookup,
|
||||
plookup',
|
||||
)
|
||||
import Plutarch.Extra.Maybe (pisDJust)
|
||||
import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=))
|
||||
import Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC, pmatchC, ptryFromC)
|
||||
import Plutarch.SafeMoney (PDiscrete (..), pvalueDiscrete')
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
import PlutusLedgerApi.V1 (
|
||||
CurrencySymbol (..),
|
||||
MintingPolicy,
|
||||
|
|
@ -277,7 +271,7 @@ governorPolicy gov =
|
|||
governorValidator :: Governor -> ClosedTerm PValidator
|
||||
governorValidator gov =
|
||||
plam $ \datum' redeemer' ctx' -> unTermCont $ do
|
||||
ctxF <- pletFieldsC @'["txInfo", "purpose"] ctx'
|
||||
ctxF <- pletAllC ctx'
|
||||
|
||||
txInfo' <- pletC $ pfromData $ ctxF.txInfo
|
||||
txInfoF <- pletFieldsC @'["mint", "inputs", "outputs", "datums", "signatories", "validRange"] txInfo'
|
||||
|
|
@ -292,15 +286,7 @@ governorValidator gov =
|
|||
let ownAddress = pfromData $ ownInputF.address
|
||||
|
||||
(pfromData -> (oldGovernorDatum :: Term _ PGovernorDatum), _) <- ptryFromC datum'
|
||||
oldGovernorDatumF <-
|
||||
pletFieldsC
|
||||
@'[ "proposalThresholds"
|
||||
, "nextProposalId"
|
||||
, "proposalTimings"
|
||||
, "createProposalTimeRangeMaxWidth"
|
||||
, "maximumProposalsPerStake"
|
||||
]
|
||||
oldGovernorDatum
|
||||
oldGovernorDatumF <- pletAllC oldGovernorDatum
|
||||
|
||||
-- Check that GST will be returned to the governor.
|
||||
let ownInputGSTAmount = psymbolValueOf # pgstSymbol # ownInputF.value
|
||||
|
|
@ -354,20 +340,21 @@ governorValidator gov =
|
|||
-- Check that a stake is spent to create the propsal,
|
||||
-- and the value it contains meets the requirement.
|
||||
|
||||
stakeInput <-
|
||||
stakeInputs <-
|
||||
pletC $
|
||||
mustBePJust # "Stake input not found" #$ pfind
|
||||
pfilter
|
||||
# phoistAcyclic
|
||||
( plam $
|
||||
\((pfield @"resolved" #) -> txOut') -> unTermCont $ do
|
||||
txOut <- pletFieldsC @'["address", "value"] txOut'
|
||||
|
||||
pure $
|
||||
txOut.address #== pdata pstakeValidatorAddress
|
||||
#&& psymbolValueOf # psstSymbol # txOut.value #== 1
|
||||
\((pfield @"value" #) . (pfield @"resolved" #) -> value) ->
|
||||
psymbolValueOf # psstSymbol # value #== 1
|
||||
)
|
||||
# pfromData txInfoF.inputs
|
||||
|
||||
pguardC "Can process only one stake" $
|
||||
plength # stakeInputs #== 1
|
||||
|
||||
stakeInput <- pletC $ phead # stakeInputs
|
||||
|
||||
stakeInputF <- pletFieldsC @'["datumHash", "value"] $ pfield @"resolved" # stakeInput
|
||||
|
||||
pguardC "Stake input doesn't have datum" $
|
||||
|
|
@ -375,20 +362,12 @@ governorValidator gov =
|
|||
|
||||
let stakeInputDatum = mustFindDatum' @PStakeDatum # stakeInputF.datumHash # txInfoF.datums
|
||||
|
||||
stakeInputDatumF <-
|
||||
pletFieldsC @["stakedAmount", "owner", "lockedBy"] stakeInputDatum
|
||||
stakeInputDatumF <- pletAllC stakeInputDatum
|
||||
|
||||
pguardC "Proposals created by the stake must not exceed the number stored in the governor." $
|
||||
pnumCreatedProposals # stakeInputDatumF.lockedBy
|
||||
#< oldGovernorDatumF.maximumProposalsPerStake
|
||||
|
||||
pguardC "Required amount of stake GTs should be presented" $
|
||||
stakeInputDatumF.stakedAmount #== (pgtValueOf # stakeInputF.value)
|
||||
|
||||
-- TODO: Is this required?
|
||||
pguardC "Tx should be signed by the stake 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.
|
||||
|
||||
|
|
@ -417,92 +396,79 @@ governorValidator gov =
|
|||
# outputDatumHash
|
||||
# txInfoF.datums
|
||||
|
||||
pguardC "Proposal datum must be valid" $
|
||||
proposalDatumValid' # proposalOutputDatum'
|
||||
proposalOutputDatum <- pletAllC proposalOutputDatum'
|
||||
|
||||
proposalOutputDatum <-
|
||||
pletFieldsC
|
||||
@'["effects", "cosigners", "proposalId", "votes"]
|
||||
proposalOutputDatum'
|
||||
|
||||
pguardC "Proposal should have only one cosigner" $
|
||||
plength # pfromData proposalOutputDatum.cosigners #== 1
|
||||
|
||||
let -- Votes should be empty at this point
|
||||
expectedVotes = pemptyVotesFor # pfromData proposalOutputDatum.effects
|
||||
expectedStartingTime =
|
||||
let expectedStartingTime =
|
||||
createProposalStartingTime
|
||||
# oldGovernorDatumF.createProposalTimeRangeMaxWidth
|
||||
# txInfoF.validRange
|
||||
-- Id, thresholds and timings should be copied from the old governor state datum.
|
||||
expectedProposalOut =
|
||||
mkRecordConstr
|
||||
PProposalDatum
|
||||
( #proposalId .= oldGovernorDatumF.nextProposalId
|
||||
.& #effects .= proposalOutputDatum.effects
|
||||
.& #status .= pconstantData Draft
|
||||
.& #cosigners .= proposalOutputDatum.cosigners
|
||||
.& #thresholds .= oldGovernorDatumF.proposalThresholds
|
||||
.& #votes .= pdata expectedVotes
|
||||
.& #timingConfig .= oldGovernorDatumF.proposalTimings
|
||||
.& #startingTime .= pdata expectedStartingTime
|
||||
)
|
||||
|
||||
pguardC "Datum correct" $ expectedProposalOut #== proposalOutputDatum'
|
||||
expectedCosigners = psingleton @PBuiltinList # stakeInputDatumF.owner
|
||||
|
||||
let cosigner = phead # pfromData proposalOutputDatum.cosigners
|
||||
|
||||
pguardC "Cosigner should be the stake owner" $
|
||||
pdata stakeInputDatumF.owner #== cosigner
|
||||
pguardC "Proposal datum correct" $
|
||||
foldl1
|
||||
(#&&)
|
||||
[ ptraceIfFalse "has neutral effect" $
|
||||
phasNeutralEffect # proposalOutputDatum.effects
|
||||
, ptraceIfFalse "votes have valid shape" $
|
||||
pisEffectsVotesCompatible # proposalOutputDatum.effects # proposalOutputDatum.votes
|
||||
, ptraceIfFalse "votes are empty" $
|
||||
pisVotesEmpty # proposalOutputDatum.votes
|
||||
, ptraceIfFalse "id correct" $
|
||||
proposalOutputDatum.proposalId #== oldGovernorDatumF.nextProposalId
|
||||
, ptraceIfFalse "status is Draft" $
|
||||
proposalOutputDatum.status #== pconstantData Draft
|
||||
, ptraceIfFalse "cosigners correct" $
|
||||
plistEquals # pfromData proposalOutputDatum.cosigners # expectedCosigners
|
||||
, ptraceIfFalse "starting time correct" $
|
||||
proposalOutputDatum.startingTime #== expectedStartingTime
|
||||
, ptraceIfFalse "copy over configurations" $
|
||||
proposalOutputDatum.thresholds #== oldGovernorDatumF.proposalThresholds
|
||||
#&& proposalOutputDatum.timingConfig #== oldGovernorDatumF.proposalTimings
|
||||
]
|
||||
|
||||
-- Check the output stake has been proposly updated.
|
||||
let stakeOutputDatumHash =
|
||||
mustBePJust # "Output stake should be presented"
|
||||
#$ pfirstJust
|
||||
# phoistAcyclic
|
||||
( plam
|
||||
( \txOut -> unTermCont $ do
|
||||
txOutF <- pletFieldsC @'["datumHash", "value"] txOut
|
||||
|
||||
stakeOutput <-
|
||||
pletC $
|
||||
mustBePJust
|
||||
# "Stake output not found"
|
||||
#$ pfind
|
||||
# phoistAcyclic
|
||||
( plam $
|
||||
\txOut' -> unTermCont $ do
|
||||
txOut <- pletFieldsC @'["address", "value"] txOut'
|
||||
|
||||
pure $
|
||||
txOut.address #== pdata pstakeValidatorAddress
|
||||
#&& psymbolValueOf # psstSymbol # txOut.value #== 1
|
||||
)
|
||||
# pfromData txInfoF.outputs
|
||||
|
||||
stakeOutputF <- pletFieldsC @'["datumHash", "value"] $ stakeOutput
|
||||
|
||||
pguardC "Staked GTs should be sent back to stake validator" $
|
||||
stakeInputDatumF.stakedAmount #== (pgtValueOf # stakeOutputF.value)
|
||||
|
||||
let stakeOutputDatumHash = mustBePDJust # "Stake output should have datum" # stakeOutputF.datumHash
|
||||
pure $
|
||||
pif
|
||||
(psymbolValueOf # psstSymbol # txOutF.value #== 1)
|
||||
( pcon $
|
||||
PJust $
|
||||
mustBePDJust # "Output stake datum should be presented"
|
||||
# txOutF.datumHash
|
||||
)
|
||||
(pcon PNothing)
|
||||
)
|
||||
)
|
||||
# pfromData txInfoF.outputs
|
||||
|
||||
stakeOutputDatum =
|
||||
mustBePJust # "Stake output not found" #$ ptryFindDatum # stakeOutputDatumHash # txInfoF.datums
|
||||
mustBePJust @(PAsData PStakeDatum) # "Stake output datum presented"
|
||||
#$ ptryFindDatum # stakeOutputDatumHash # txInfoF.datums
|
||||
|
||||
-- The stake should be locked by the newly created proposal.
|
||||
let newLock =
|
||||
stakeOutputLocks =
|
||||
pfromData $ pfield @"lockedBy" # stakeOutputDatum
|
||||
|
||||
-- The stake should be locked by the newly created proposal.
|
||||
newLock =
|
||||
mkRecordConstr
|
||||
PCreated
|
||||
( #created .= oldGovernorDatumF.nextProposalId
|
||||
)
|
||||
|
||||
-- Append new locks to existing locks
|
||||
expectedProposalLocks = pcons # pdata newLock # stakeInputDatumF.lockedBy
|
||||
expectedProposalLocks =
|
||||
pcons # pdata newLock # stakeInputDatumF.lockedBy
|
||||
|
||||
expectedStakeOutputDatum =
|
||||
pdata $
|
||||
mkRecordConstr
|
||||
PStakeDatum
|
||||
( #stakedAmount .= stakeInputDatumF.stakedAmount
|
||||
.& #owner .= stakeInputDatumF.owner
|
||||
.& #lockedBy .= pdata expectedProposalLocks
|
||||
)
|
||||
|
||||
pguardC "Unexpected stake output datum" $ expectedStakeOutputDatum #== stakeOutputDatum
|
||||
pguardC "Stake output locks correct" $
|
||||
plistEquals # stakeOutputLocks # expectedProposalLocks
|
||||
|
||||
pure $ popaque $ pconstant ()
|
||||
|
||||
|
|
@ -533,36 +499,14 @@ governorValidator gov =
|
|||
)
|
||||
# pfromData txInfoF.inputs
|
||||
|
||||
proposalOutputF <-
|
||||
pletFieldsC @'["datumHash"] $
|
||||
mustBePJust # "Proposal output not found"
|
||||
#$ pfind
|
||||
# plam
|
||||
( \txOut -> unTermCont $ do
|
||||
txOutF <- pletFieldsC @'["address", "value"] txOut
|
||||
pure $
|
||||
psymbolValueOf # ppstSymbol # txOutF.value #== 1
|
||||
#&& txOutF.address #== pdata pproposalValidatorAddress
|
||||
)
|
||||
# pfromData txInfoF.outputs
|
||||
|
||||
proposalInputDatum <-
|
||||
pletC $
|
||||
mustFindDatum' @PProposalDatum
|
||||
# proposalInputF.datumHash
|
||||
# txInfoF.datums
|
||||
proposalOutputDatum <-
|
||||
pletC $
|
||||
mustFindDatum' @PProposalDatum
|
||||
# proposalOutputF.datumHash
|
||||
# txInfoF.datums
|
||||
|
||||
pguardC "Proposal datum must be valid" $
|
||||
proposalDatumValid' # proposalInputDatum
|
||||
#&& proposalDatumValid' # proposalOutputDatum
|
||||
|
||||
proposalInputDatumF <-
|
||||
pletFieldsC @'["proposalId", "effects", "status", "cosigners", "thresholds", "votes", "timingConfig", "startingTime"]
|
||||
pletFieldsC @'["effects", "status", "thresholds", "votes"]
|
||||
proposalInputDatum
|
||||
|
||||
-- Check that the proposal state is advanced so that a proposal cannot be executed twice.
|
||||
|
|
@ -570,22 +514,6 @@ governorValidator gov =
|
|||
pguardC "Proposal must be in locked(executable) state in order to execute effects" $
|
||||
proposalInputDatumF.status #== pconstantData Locked
|
||||
|
||||
let expectedOutputProposalDatum =
|
||||
mkRecordConstr
|
||||
PProposalDatum
|
||||
( #proposalId .= proposalInputDatumF.proposalId
|
||||
.& #effects .= proposalInputDatumF.effects
|
||||
.& #status .= pconstantData Finished
|
||||
.& #cosigners .= proposalInputDatumF.cosigners
|
||||
.& #thresholds .= proposalInputDatumF.thresholds
|
||||
.& #votes .= proposalInputDatumF.votes
|
||||
.& #timingConfig .= proposalInputDatumF.timingConfig
|
||||
.& #startingTime .= proposalInputDatumF.startingTime
|
||||
)
|
||||
|
||||
pguardC "Unexpected output proposal datum" $
|
||||
pdata proposalOutputDatum #== pdata expectedOutputProposalDatum
|
||||
|
||||
-- TODO: anything else to check here?
|
||||
|
||||
-- Find the highest votes and the corresponding tag.
|
||||
|
|
@ -661,15 +589,11 @@ governorValidator gov =
|
|||
|
||||
Just MutateGovernor -> unTermCont $ do
|
||||
-- Check that a GAT is burnt.
|
||||
pure $ popaque $ singleAuthorityTokenBurned patSymbol ctxF.txInfo txInfoF.mint
|
||||
pure $ popaque $ singleAuthorityTokenBurned patSymbol txInfoF.inputs txInfoF.mint
|
||||
|
||||
--------------------------------------------------------------------------
|
||||
Nothing -> ptraceError "Unknown redeemer"
|
||||
where
|
||||
-- Get th amount of governance tokens in a value.
|
||||
pgtValueOf :: Term s (PValue _ _ :--> PDiscrete GTTag)
|
||||
pgtValueOf = phoistAcyclic $ pvalueDiscrete' gov.gtClassRef
|
||||
|
||||
-- The currency symbol of authority token.
|
||||
patSymbol :: Term s PCurrencySymbol
|
||||
patSymbol = phoistAcyclic $ pconstant $ authorityTokenSymbolFromGovernor gov
|
||||
|
|
@ -680,24 +604,12 @@ governorValidator gov =
|
|||
let AssetClass (sym, _) = proposalSTAssetClassFromGovernor gov
|
||||
in phoistAcyclic $ pconstant sym
|
||||
|
||||
-- Is a proposal state datum valid?
|
||||
proposalDatumValid' :: Term s (PProposalDatum :--> PBool)
|
||||
proposalDatumValid' =
|
||||
let params = proposalFromGovernor gov
|
||||
in phoistAcyclic $ proposalDatumValid params
|
||||
|
||||
-- The address of the proposal validator.
|
||||
pproposalValidatorAddress :: Term s PAddress
|
||||
pproposalValidatorAddress =
|
||||
let vh = proposalValidatorHashFromGovernor gov
|
||||
in phoistAcyclic $ pconstant $ validatorHashToAddress vh
|
||||
|
||||
-- The address of the stake validator.
|
||||
pstakeValidatorAddress :: Term s PAddress
|
||||
pstakeValidatorAddress =
|
||||
let vh = stakeValidatorHashFromGovernor gov
|
||||
in phoistAcyclic $ pconstant $ validatorHashToAddress vh
|
||||
|
||||
-- The currency symbol of the stake state token.
|
||||
psstSymbol :: Term s PCurrencySymbol
|
||||
psstSymbol =
|
||||
|
|
|
|||
|
|
@ -29,8 +29,9 @@ module Agora.Proposal (
|
|||
PResultTag (..),
|
||||
|
||||
-- * Plutarch helpers
|
||||
proposalDatumValid,
|
||||
pemptyVotesFor,
|
||||
phasNeutralEffect,
|
||||
pisEffectsVotesCompatible,
|
||||
pisVotesEmpty,
|
||||
pwinner,
|
||||
pwinner',
|
||||
pneutralOption,
|
||||
|
|
@ -50,6 +51,7 @@ import Plutarch.Api.V1 (
|
|||
PPubKeyHash,
|
||||
PValidatorHash,
|
||||
)
|
||||
import Plutarch.Api.V1.AssocMap qualified as PAssocMap
|
||||
import Plutarch.DataRepr (DerivePConstantViaData (..), PDataFields, PIsDataReprInstances (..))
|
||||
import Plutarch.Extra.IsData (
|
||||
DerivePConstantViaDataList (..),
|
||||
|
|
@ -57,11 +59,10 @@ import Plutarch.Extra.IsData (
|
|||
EnumIsData (..),
|
||||
ProductIsData (ProductIsData),
|
||||
)
|
||||
import Plutarch.Extra.List (pnotNull)
|
||||
import Plutarch.Extra.Map qualified as PM
|
||||
import Plutarch.Extra.Map.Unsorted qualified as PUM
|
||||
import Plutarch.Extra.Other (DerivePNewtype' (..))
|
||||
import Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC)
|
||||
import Plutarch.Extra.TermCont (pguardC, pletC)
|
||||
import Plutarch.Lift (
|
||||
DerivePConstantViaNewtype (..),
|
||||
PConstantDecl,
|
||||
|
|
@ -597,19 +598,6 @@ deriving via
|
|||
instance
|
||||
(PConstantDecl ProposalVotes)
|
||||
|
||||
{- | Plutarch-level version of 'emptyVotesFor'.
|
||||
|
||||
@since 0.1.0
|
||||
-}
|
||||
pemptyVotesFor :: forall s a. (PIsData a) => Term s (PMap 'Unsorted PResultTag a :--> PProposalVotes)
|
||||
pemptyVotesFor =
|
||||
phoistAcyclic $
|
||||
plam
|
||||
( \m ->
|
||||
pcon $
|
||||
PProposalVotes $ PM.pmap # plam (const $ pconstant 0) # m
|
||||
)
|
||||
|
||||
{- | Plutarch-level version of 'ProposalDatum'.
|
||||
|
||||
@since 0.1.0
|
||||
|
|
@ -712,27 +700,50 @@ deriving via (DerivePConstantViaData ProposalRedeemer PProposalRedeemer) instanc
|
|||
|
||||
@since 0.1.0
|
||||
-}
|
||||
proposalDatumValid :: Proposal -> Term s (Agora.Proposal.PProposalDatum :--> PBool)
|
||||
proposalDatumValid proposal =
|
||||
phoistAcyclic $
|
||||
plam $ \datum' -> unTermCont $ do
|
||||
datum <- pletFieldsC @'["effects", "cosigners", "votes"] $ datum'
|
||||
|
||||
let atLeastOneNegativeResult =
|
||||
pany
|
||||
# phoistAcyclic
|
||||
(plam $ \m -> pnull #$ pto $ pfromData $ psndBuiltin # m)
|
||||
#$ pto
|
||||
$ pfromData datum.effects
|
||||
{- | Return true if the effect list contains at least one neutral outcome.
|
||||
|
||||
pure $
|
||||
foldr1
|
||||
(#&&)
|
||||
[ ptraceIfFalse "Proposal has at least one ResultTag has no effects" atLeastOneNegativeResult
|
||||
, ptraceIfFalse "Proposal has at least one cosigner" $ pnotNull # pfromData datum.cosigners
|
||||
, ptraceIfFalse "Proposal has fewer cosigners than the limit" $ plength # pfromData datum.cosigners #<= pconstant proposal.maximumCosigners
|
||||
, ptraceIfFalse "Proposal votes and effects are compatible with each other" $ PUM.pkeysEqual # datum.effects # pto (pfromData datum.votes)
|
||||
]
|
||||
@since 0.2.0
|
||||
-}
|
||||
phasNeutralEffect ::
|
||||
forall (s :: S).
|
||||
Term
|
||||
s
|
||||
( PMap 'Unsorted PResultTag (PMap 'Unsorted PValidatorHash PDatumHash)
|
||||
:--> PBool
|
||||
)
|
||||
phasNeutralEffect = phoistAcyclic $ PAssocMap.pany # PAssocMap.pnull
|
||||
|
||||
{- | Return true if votes and effects of the proposal have the same key set.
|
||||
|
||||
@since 0.2.0
|
||||
-}
|
||||
pisEffectsVotesCompatible ::
|
||||
forall (s :: S).
|
||||
Term
|
||||
s
|
||||
( PMap 'Unsorted PResultTag (PMap 'Unsorted PValidatorHash PDatumHash)
|
||||
:--> PProposalVotes
|
||||
:--> PBool
|
||||
)
|
||||
pisEffectsVotesCompatible = phoistAcyclic $
|
||||
plam $ \m (pto -> v :: Term _ (PMap _ _ _)) ->
|
||||
PUM.pkeysEqual # m # v
|
||||
|
||||
{- | Retutns true if vote counts of /all/ the options are zero.
|
||||
|
||||
@since 0.2.0
|
||||
-}
|
||||
pisVotesEmpty ::
|
||||
forall (s :: S).
|
||||
Term
|
||||
s
|
||||
( PProposalVotes
|
||||
:--> PBool
|
||||
)
|
||||
pisVotesEmpty = phoistAcyclic $
|
||||
plam $ \(pto -> m :: Term _ (PMap _ _ _)) ->
|
||||
PAssocMap.pall # plam (#== 0) # m
|
||||
|
||||
{- | Wrapper for 'pwinner''. When the winner cannot be found,
|
||||
the 'neutral' option will be returned.
|
||||
|
|
|
|||
|
|
@ -40,7 +40,6 @@ import Agora.Utils (
|
|||
getMintingPolicySymbol,
|
||||
mustBePJust,
|
||||
mustFindDatum',
|
||||
pisUniq',
|
||||
pltAsData,
|
||||
)
|
||||
import Plutarch.Api.V1 (
|
||||
|
|
@ -63,7 +62,7 @@ import Plutarch.Api.V1.ScriptContext (
|
|||
import "liqwid-plutarch-extra" Plutarch.Api.V1.Value (psymbolValueOf)
|
||||
import Plutarch.Extra.Comonad (pextract)
|
||||
import Plutarch.Extra.IsData (pmatchEnum)
|
||||
import Plutarch.Extra.List (pmapMaybe, pmergeBy, pmsortBy)
|
||||
import Plutarch.Extra.List (pisUniq', pmapMaybe, pmergeBy, pmsortBy)
|
||||
import Plutarch.Extra.Map (plookup, pupdate)
|
||||
import Plutarch.Extra.Maybe (pfromDJust, pfromJust, pisJust)
|
||||
import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=))
|
||||
|
|
|
|||
|
|
@ -51,13 +51,14 @@ import Plutarch.Extra.IsData (
|
|||
)
|
||||
import Plutarch.Extra.List (pnotNull)
|
||||
import Plutarch.Extra.Other (DerivePNewtype' (..))
|
||||
import Plutarch.Extra.Sum (PSum (..))
|
||||
import Plutarch.Extra.Traversable (pfoldMap)
|
||||
import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (..))
|
||||
import Plutarch.SafeMoney (PDiscrete)
|
||||
import Plutarch.Show (PShow (..))
|
||||
import PlutusLedgerApi.V1 (PubKeyHash)
|
||||
import PlutusLedgerApi.V1.Value (AssetClass)
|
||||
import PlutusTx qualified
|
||||
import Prelude ((+))
|
||||
import Prelude hiding (Num (..))
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
|
@ -396,21 +397,14 @@ pnumCreatedProposals :: Term s (PBuiltinList (PAsData PProposalLock) :--> PInteg
|
|||
pnumCreatedProposals =
|
||||
phoistAcyclic $
|
||||
plam $ \l ->
|
||||
pfoldl
|
||||
# phoistAcyclic
|
||||
( plam
|
||||
( \c (pfromData -> lock) ->
|
||||
c
|
||||
+ pmatch
|
||||
lock
|
||||
( \case
|
||||
PCreated _ -> 1
|
||||
_ -> 0
|
||||
)
|
||||
)
|
||||
)
|
||||
# 0
|
||||
# l
|
||||
pto $
|
||||
pfoldMap
|
||||
# plam
|
||||
( \(pfromData -> lock) -> pmatch lock $ \case
|
||||
PCreated _ -> pcon $ PSum 1
|
||||
_ -> mempty
|
||||
)
|
||||
# l
|
||||
|
||||
{- | The role of a stake for a particular proposal. Scott-encoded.
|
||||
|
||||
|
|
|
|||
|
|
@ -114,14 +114,13 @@ treasuryValidator gatCs' = plam $ \_datum redeemer ctx' -> unTermCont $ do
|
|||
redeemer #== pforgetData (pconstantData SpendTreasuryGAT)
|
||||
|
||||
-- Get the minted value from txInfo.
|
||||
txInfo' <- pletC ctx.txInfo
|
||||
txInfo <- pletFieldsC @'["mint"] txInfo'
|
||||
txInfo <- pletFieldsC @'["mint", "inputs"] ctx.txInfo
|
||||
let mint :: Term _ (PValue _ _)
|
||||
mint = txInfo.mint
|
||||
|
||||
gatCs <- pletC $ pconstant gatCs'
|
||||
|
||||
pguardC "A single authority token has been burned" $
|
||||
singleAuthorityTokenBurned gatCs txInfo' mint
|
||||
singleAuthorityTokenBurned gatCs txInfo.inputs mint
|
||||
|
||||
pure . popaque $ pconstant ()
|
||||
|
|
|
|||
|
|
@ -20,8 +20,6 @@ module Agora.Utils (
|
|||
isScriptAddress,
|
||||
isPubKey,
|
||||
pltAsData,
|
||||
pisUniqBy',
|
||||
pisUniq',
|
||||
) where
|
||||
|
||||
import Plutarch.Api.V1 (
|
||||
|
|
@ -208,36 +206,3 @@ pltAsData ::
|
|||
pltAsData = phoistAcyclic $
|
||||
plam $
|
||||
\(pfromData -> l) (pfromData -> r) -> l #< r
|
||||
|
||||
{- | Special version of 'pisUniq'', the list elements should have 'PEq' instance.
|
||||
|
||||
@since 0.2.0
|
||||
-}
|
||||
pisUniq' ::
|
||||
forall (l :: PType -> PType) (a :: PType) (s :: S).
|
||||
(PEq a, PIsListLike l a) =>
|
||||
Term s (l a :--> PBool)
|
||||
pisUniq' = phoistAcyclic $ pisUniqBy' # phoistAcyclic (plam (#==))
|
||||
|
||||
{- | Return true if all the elements in the given list are unique, given the equalator function.
|
||||
The list is assumed to be ordered.
|
||||
|
||||
@since 0.2.0
|
||||
-}
|
||||
pisUniqBy' ::
|
||||
forall (l :: PType -> PType) (a :: PType) (s :: S).
|
||||
(PIsListLike l a) =>
|
||||
Term s ((a :--> a :--> PBool) :--> l a :--> PBool)
|
||||
pisUniqBy' = phoistAcyclic $
|
||||
plam $ \eq l ->
|
||||
pif (pnull # l) (pconstant True) $
|
||||
go # eq # (phead # l) # (ptail # l)
|
||||
where
|
||||
go :: Term _ ((a :--> a :--> PBool) :--> a :--> l a :--> PBool)
|
||||
go = phoistAcyclic $
|
||||
pfix #$ plam $ \self' eq x xs ->
|
||||
plet (self' # eq) $ \self ->
|
||||
pif (pnull # xs) (pconstant True) $
|
||||
plet (phead # xs) $ \x' ->
|
||||
pif (eq # x # x') (pconstant False) $
|
||||
self # x' #$ ptail # xs
|
||||
|
|
|
|||
31
bench.csv
31
bench.csv
|
|
@ -1,18 +1,19 @@
|
|||
name,cpu,mem,size
|
||||
Agora/Effects/Treasury Withdrawal Effect/effect/Simple,333327612,830203,3674
|
||||
Agora/Effects/Treasury Withdrawal Effect/effect/Simple with multiple treasuries ,492387542,1197315,3986
|
||||
Agora/Effects/Treasury Withdrawal Effect/effect/Mixed Assets,456007605,1104500,3859
|
||||
Agora/Effects/Governor Mutation Effect/validator/valid new governor datum/governor validator should pass,88940927,246756,8891
|
||||
Agora/Effects/Governor Mutation Effect/validator/valid new governor datum/effect validator should pass,107090537,296185,3627
|
||||
Agora/Effects/Treasury Withdrawal Effect/effect/Simple,333137234,829671,3674
|
||||
Agora/Effects/Treasury Withdrawal Effect/effect/Simple with multiple treasuries ,492197164,1196783,3986
|
||||
Agora/Effects/Treasury Withdrawal Effect/effect/Mixed Assets,455817227,1103968,3859
|
||||
Agora/Effects/Governor Mutation Effect/validator/valid new governor datum/governor validator should pass,84914023,233054,7949
|
||||
Agora/Effects/Governor Mutation Effect/validator/valid new governor datum/effect validator should pass,104760131,289547,3491
|
||||
Agora/Stake/policy/stakeCreation,51008580,149029,2522
|
||||
Agora/Stake/validator/stakeDepositWithdraw deposit,183506412,498838,4745
|
||||
Agora/Stake/validator/stakeDepositWithdraw withdraw,183506412,498838,4733
|
||||
Agora/Proposal/policy (proposal creation)/legal/proposal,34975627,103548,2117
|
||||
Agora/Proposal/policy (proposal creation)/legal/governor,327971301,871386,9370
|
||||
Agora/Proposal/policy (proposal creation)/legal/governor,316600184,838411,8429
|
||||
Agora/Proposal/policy (proposal creation)/legal/stake,152415805,398403,5404
|
||||
Agora/Proposal/policy (proposal creation)/illegal/invalid next proposal id/proposal,34975627,103548,2117
|
||||
Agora/Proposal/policy (proposal creation)/illegal/invalid next proposal id/stake,152415805,398403,5404
|
||||
Agora/Proposal/policy (proposal creation)/illegal/use other's stake/proposal,34975627,103548,2086
|
||||
Agora/Proposal/policy (proposal creation)/illegal/use other's stake/governor,316600184,838411,8398
|
||||
Agora/Proposal/policy (proposal creation)/illegal/altered stake/proposal,34975627,103548,2117
|
||||
Agora/Proposal/policy (proposal creation)/illegal/invalid stake locks/proposal,34975627,103548,2125
|
||||
Agora/Proposal/policy (proposal creation)/illegal/invalid stake locks/stake,157849465,413053,5412
|
||||
|
|
@ -223,12 +224,12 @@ Agora/Proposal/validator/unlocking/illegal/with 42 proposals/remove creator too
|
|||
Agora/Proposal/validator/unlocking/illegal/with 42 proposals/remove creator too early/status: VotingReady/stake,1674013803,4194887,26590
|
||||
Agora/Proposal/validator/unlocking/illegal/with 42 proposals/remove creator too early/status: Locked/stake,1674013803,4194887,26590
|
||||
Agora/Proposal/validator/unlocking/illegal/with 42 proposals/creator: retract votes/stake,1674013803,4194887,26506
|
||||
Agora/AuthorityToken/singleAuthorityTokenBurned/Correct simple,21017788,55883,806
|
||||
Agora/AuthorityToken/singleAuthorityTokenBurned/Correct many inputs,33204186,88241,900
|
||||
Agora/Treasury/Validator/Positive/Allows for effect changes,31556709,81546,1452
|
||||
Agora/AuthorityToken/singleAuthorityTokenBurned/Correct simple,21017788,55883,806
|
||||
Agora/AuthorityToken/singleAuthorityTokenBurned/Correct many inputs,33204186,88241,900
|
||||
Agora/Governor/policy/GST minting,51480023,145787,2048
|
||||
Agora/Governor/validator/proposal creation,303114849,813451,9390
|
||||
Agora/Governor/validator/GATs minting,422654153,1147158,9516
|
||||
Agora/Governor/validator/mutate governor state,90087778,252215,8991
|
||||
Agora/AuthorityToken/singleAuthorityTokenBurned/Correct simple,20570665,54655,725
|
||||
Agora/AuthorityToken/singleAuthorityTokenBurned/Correct many inputs,32757063,87013,825
|
||||
Agora/Treasury/Validator/Positive/Allows for effect changes,31277082,80782,1450
|
||||
Agora/AuthorityToken/singleAuthorityTokenBurned/Correct simple,20570665,54655,725
|
||||
Agora/AuthorityToken/singleAuthorityTokenBurned/Correct many inputs,32757063,87013,825
|
||||
Agora/Governor/policy/GST minting,49408995,139981,1910
|
||||
Agora/Governor/validator/proposal creation,294638205,791763,8449
|
||||
Agora/Governor/validator/GATs minting,249873031,663031,8575
|
||||
Agora/Governor/validator/mutate governor state,86060874,238513,8049
|
||||
|
|
|
|||
|
Loading…
Add table
Add a link
Reference in a new issue