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

check cosign stakes while advancing from draft

Browse source
This commit is contained in:
Hongrui Fang 2022-07-02 18:46:14 +08:00
parent 5273f53d46
commit bf4dd91342
4 changed files with 445 additions and 346 deletions
Download patch file Download diff file Expand all files Collapse all files

6
agora/Agora/Proposal.hs
View file

@ -283,6 +283,8 @@ data ProposalDatum = ProposalDatum
-- ^ The status the proposal is in. -- ^ The status the proposal is in.
, cosigners :: [PubKeyHash] , cosigners :: [PubKeyHash]
-- ^ Who created the proposal initially, and who cosigned it later. -- ^ Who created the proposal initially, and who cosigned it later.
--
-- This list should be sorted in **ascending** order.
, thresholds :: ProposalThresholds , thresholds :: ProposalThresholds
-- ^ Thresholds copied over on initialization. -- ^ Thresholds copied over on initialization.
, votes :: ProposalVotes , votes :: ProposalVotes
@ -321,7 +323,9 @@ data ProposalRedeemer
-- --
-- This is particularly used in the 'Draft' 'ProposalStatus', -- This is particularly used in the 'Draft' 'ProposalStatus',
-- where matching 'Agora.Stake.Stake's can be called to advance the proposal, -- where matching 'Agora.Stake.Stake's can be called to advance the proposal,
-- provided enough GT is shared among them. -- provided enough GT is shared among them.
--
-- This list should be sorted in ascending order.
Cosign [PubKeyHash] Cosign [PubKeyHash]
| -- | Allow unlocking one or more stakes with votes towards particular 'ResultTag'. | -- | Allow unlocking one or more stakes with votes towards particular 'ResultTag'.
Unlock ResultTag Unlock ResultTag

699
agora/Agora/Proposal/Scripts.hs
View file

@ -36,6 +36,8 @@ import Agora.Utils (
getMintingPolicySymbol, getMintingPolicySymbol,
mustBePJust, mustBePJust,
mustFindDatum', mustFindDatum',
pisUniq',
pltAsData,
) )
import Plutarch.Api.V1 ( import Plutarch.Api.V1 (
PDatumHash, PDatumHash,
@ -56,7 +58,7 @@ import Plutarch.Api.V1.ScriptContext (
import "liqwid-plutarch-extra" Plutarch.Api.V1.Value (psymbolValueOf) import "liqwid-plutarch-extra" Plutarch.Api.V1.Value (psymbolValueOf)
import Plutarch.Extra.Comonad (pextract) import Plutarch.Extra.Comonad (pextract)
import Plutarch.Extra.IsData (pmatchEnum) import Plutarch.Extra.IsData (pmatchEnum)
import Plutarch.Extra.List (pisUniqBy, pmapMaybe, pmsortBy) import Plutarch.Extra.List (pmapMaybe, pmergeBy, pmsortBy)
import Plutarch.Extra.Map (plookup, pupdate) import Plutarch.Extra.Map (plookup, pupdate)
import Plutarch.Extra.Maybe (pfromDJust, pfromJust, pisJust) import Plutarch.Extra.Maybe (pfromDJust, pfromJust, pisJust)
import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=)) import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=))
@ -192,6 +194,10 @@ proposalValidator proposal =
ownAddress <- pletC $ txOutF.address ownAddress <- pletC $ txOutF.address
thresholdsF <- pletFieldsC @'["execute", "create", "vote"] proposalF.thresholds
currentStatus <- pletC $ pfromData $ proposalF.status
let stCurrencySymbol = let stCurrencySymbol =
pconstant $ getMintingPolicySymbol (proposalPolicy proposal.governorSTAssetClass) pconstant $ getMintingPolicySymbol (proposalPolicy proposal.governorSTAssetClass)
@ -237,6 +243,29 @@ proposalValidator proposal =
proposalUnchanged <- pletC $ proposalOut #== proposalDatum proposalUnchanged <- pletC $ proposalOut #== proposalDatum
proposalOutStatus <-
pletC $
pfromData $
pfield @"status" # proposalOut
onlyStatusChanged <-
pletC $
-- Only the status of proposals is updated.
-- Only the status of proposals is updated.
proposalOut
#== mkRecordConstr
PProposalDatum
( #proposalId .= proposalF.proposalId
.& #effects .= proposalF.effects
.& #status .= pdata proposalOutStatus
.& #cosigners .= proposalF.cosigners
.& #thresholds .= proposalF.thresholds
.& #votes .= proposalF.votes
.& #timingConfig .= proposalF.timingConfig
.& #startingTime .= proposalF.startingTime
)
-------------------------------------------------------------------------- --------------------------------------------------------------------------
-- Find the stake inputs/outputs by SST. -- Find the stake inputs/outputs by SST.
@ -274,369 +303,387 @@ proposalValidator proposal =
pguardC "Every stake input should have a correspoding output" $ pguardC "Every stake input should have a correspoding output" $
stakeInputNum #== plength # stakeOutputDatumHashes stakeInputNum #== plength # stakeOutputDatumHashes
-------------------------------------------------------------------------- ----------------------------------------------------------------------------
let acceptMultipleStakes = pmatch proposalRedeemer $ \case
PCosign _ -> pconstant True
PAdvanceProposal _ ->
currentStatus #== pconstant Draft
_ -> pconstant False
pure $ pure $
pmatch proposalRedeemer $ \case popaque $
PCosign r -> unTermCont $ do pif
pguardC "Should be in draft state" $ acceptMultipleStakes
proposalF.status #== pconstant Draft ( unTermCont $ do
-- The following code ensures that all the stake datums are not
-- changed.
--
-- TODO: This is quite inefficient (O(nlogn)) but for now we don't
-- have a nice way to check this. In plutus v2 we'll have map of
-- (Script -> Redeemer) in ScriptContext, which should be the
-- straight up solution.
let sortDatumHashes = phoistAcyclic $ pmsortBy # pltAsData
newSigs <- pletC $ pfield @"newCosigners" # r sortedStakeInputDatumHashes =
sortDatumHashes # stakeInputDatumHashes
pguardC "Signed by all new cosigners" $ sortedStakeOutputDatumHashes =
pall # signedBy # newSigs sortDatumHashes # stakeOutputDatumHashes
pguardC "As many new cosigners as stake datums" $ pguardC "All stake datum are unchanged" $
plength # stakeInputDatumHashes #== plength # newSigs plistEquals
# sortedStakeInputDatumHashes
# sortedStakeOutputDatumHashes
updatedSigs <- pletC $ pconcat # newSigs # proposalF.cosigners PPair totalStakedAmount stakeOwners <-
pmatchC $
-- Cannot cosign a proposal with a single stake more than once. pfoldl
pguardC "Cosigners are unique" $
pisUniqBy
# phoistAcyclic (plam (#==))
# phoistAcyclic
( plam
( \(pfromData -> x)
(pfromData -> y) -> x #< y
)
)
# updatedSigs
let inputStakeOwners =
pmap
# plam
( \(pfromData -> dh) ->
pfield @"owner"
#$ pfromJust
#$ ptryFindDatum
@(PAsData PStakeDatum)
# dh
# txInfoF.datums
)
# stakeInputDatumHashes
pguardC "All new cosigners are witnessed by their Stake datums" $
pall
# plam (\sig -> pelem # sig # inputStakeOwners)
# newSigs
let expectedDatum =
mkRecordConstr
PProposalDatum
( #proposalId .= proposalF.proposalId
.& #effects .= proposalF.effects
.& #status .= proposalF.status
.& #cosigners .= pdata updatedSigs
.& #thresholds .= proposalF.thresholds
.& #votes .= proposalF.votes
.& #timingConfig .= proposalF.timingConfig
.& #startingTime .= proposalF.startingTime
)
pguardC "Signatures are correctly added to cosignature list" $
proposalOut #== expectedDatum
-- The following code ensures that all the stake datums are not
-- changed.
--
-- TODO: This is quite inefficient (O(nlogn)) but for now we don't
-- have a nice way to check this. In plutus v2 we'll have map of
-- (Script -> Redeemer) in ScriptContext, which should be the
-- straight up solution.
let sortDatumHashes =
phoistAcyclic $
pmsortBy
# phoistAcyclic
( plam
( \(pfromData -> l)
(pfromData -> r) -> l #< r
)
)
sortedStakeInputDatumHashes =
sortDatumHashes # stakeInputDatumHashes
sortedStakeOutputDatumHashes =
sortDatumHashes # stakeOutputDatumHashes
pguardC "All stake datum are unchanged" $
plistEquals
# sortedStakeInputDatumHashes
# sortedStakeOutputDatumHashes
pure $ popaque (pconstant ())
------------------------------------------------------------------------
_ -> unTermCont $ do
pguardC "Can only deal with one stake" $
stakeInputNum #== 1
let stakeInputHash = pfromData $ phead # stakeInputDatumHashes
stakeOutputHash = pfromData $ phead # stakeOutputDatumHashes
stakeIn :: Term _ PStakeDatum <-
pletC $
pfromData $
pfromJust #$ ptryFindDatum # stakeInputHash # txInfoF.datums
stakeInF <- pletFieldsC @'["stakedAmount", "lockedBy", "owner"] stakeIn
stakeOut :: Term _ PStakeDatum <-
pletC $
pfromData $
pfromJust #$ ptryFindDatum # stakeOutputHash # txInfoF.datums
----------------------------------------------------------------------
pure $
pmatch proposalRedeemer $ \case
PVote r -> unTermCont $ do
pguardC "Input proposal must be in VotingReady state" $
proposalF.status #== pconstant VotingReady
pguardC "Proposal time should be wthin the voting period" $
isVotingPeriod # proposalF.timingConfig
# proposalF.startingTime
# currentTime
-- Ensure the transaction is voting to a valid 'ResultTag'(outcome).
PProposalVotes voteMap <- pmatchC proposalF.votes
voteFor <- pletC $ pfromData $ pfield @"resultTag" # r
pguardC "Vote option should be valid" $
pisJust #$ plookup # voteFor # voteMap
-- Ensure that no lock with the current proposal id has been put on the stake.
pguardC "Same stake shouldn't vote on the same proposal twice" $
pnot #$ pany
# plam # plam
( \((pfield @"proposalTag" #) . pfromData -> pid) -> ( \l dh -> unTermCont $ do
pid #== proposalF.proposalId let stake =
pfromData $
pfromJust
#$ ptryFindDatum
@(PAsData PStakeDatum)
# pfromData dh
# txInfoF.datums
stakeF <- pletFieldsC @'["stakedAmount", "owner"] stake
PPair amount owners <- pmatchC l
let newAmount = amount + punsafeCoerce (pfromData stakeF.stakedAmount)
updatedOwners = pcons # stakeF.owner # owners
pure $ pcon $ PPair newAmount updatedOwners
) )
# pfromData stakeInF.lockedBy # pcon (PPair (0 :: Term _ PInteger) (pnil @PBuiltinList))
# stakeInputDatumHashes
let -- The amount of new votes should be the 'stakedAmount'. sortedStakeOwners <- pletC $ pmsortBy # pltAsData # stakeOwners
-- Update the vote counter of the proposal, and leave other stuff as is.
expectedNewVotes = pmatch (pfromData proposalF.votes) $ \(PProposalVotes m) ->
pcon $
PProposalVotes $
pupdate
# plam
( \votes -> unTermCont $ do
PDiscrete v <- pmatchC stakeInF.stakedAmount
pure $ pcon $ PJust $ votes + (pextract # v)
)
# voteFor
# m
expectedProposalOut =
mkRecordConstr
PProposalDatum
( #proposalId .= proposalF.proposalId
.& #effects .= proposalF.effects
.& #status .= proposalF.status
.& #cosigners .= proposalF.cosigners
.& #thresholds .= proposalF.thresholds
.& #votes .= pdata expectedNewVotes
.& #timingConfig .= proposalF.timingConfig
.& #startingTime .= proposalF.startingTime
)
pguardC "Output proposal should be valid" $ proposalOut #== expectedProposalOut redeemer <- pmatchC proposalRedeemer
-- We validate the output stake datum here as well: We need the vote option case redeemer of
-- to create a valid 'ProposalLock', however the vote option is encoded PCosign r -> do
-- in the proposal redeemer, which is invisible for the stake validator. pguardC "Should be in draft state" $
currentStatus #== pconstant Draft
let newProposalLock = newSigs <- pletC $ pfield @"newCosigners" # r
mkRecordConstr
PProposalLock
( #vote .= pdata voteFor
.& #proposalTag .= proposalF.proposalId
)
-- Prepend the new lock to existing locks
expectedProposalLocks =
pcons
# pdata newProposalLock
# pfromData stakeInF.lockedBy
expectedStakeOut =
mkRecordConstr
PStakeDatum
( #stakedAmount .= stakeInF.stakedAmount
.& #owner .= stakeInF.owner
.& #lockedBy .= pdata expectedProposalLocks
)
pguardC "Output stake should be locked by the proposal" $ expectedStakeOut #== stakeOut pguardC "Signed by all new cosigners" $
pall # signedBy # newSigs
pure $ popaque (pconstant ()) updatedSigs <-
-------------------------------------------------------------------------- pletC $
pmergeBy # pltAsData
# newSigs
# proposalF.cosigners
PUnlock r -> unTermCont $ do pguardC "Cosigners are unique" $
-- At draft stage, the votes should be empty. pisUniq' # updatedSigs
pguardC "Shouldn't retract votes from a draft proposal" $
pnot #$ proposalF.status #== pconstantData Draft
-- This is the vote option we're retracting from. pguardC "All new cosigners are witnessed by their Stake datums" $
retractFrom <- pletC $ pfield @"resultTag" # r plistEquals # sortedStakeOwners # newSigs
-- Determine if the input stake is actually locked by this proposal. let expectedDatum =
stakeUsage <- pletC $ pgetStakeUsage # stakeInF.lockedBy # proposalF.proposalId mkRecordConstr
PProposalDatum
( #proposalId .= proposalF.proposalId
.& #effects .= proposalF.effects
.& #status .= proposalF.status
.& #cosigners .= pdata updatedSigs
.& #thresholds .= proposalF.thresholds
.& #votes .= proposalF.votes
.& #timingConfig .= proposalF.timingConfig
.& #startingTime .= proposalF.startingTime
)
pguardC "Stake input relevant" $ pguardC "Signatures are correctly added to cosignature list" $
pmatch stakeUsage $ \case proposalOut #== expectedDatum
PDidNothing ->
ptraceIfFalse "Stake should be relevant" $
pconstant False
PCreated ->
ptraceIfFalse "Removing creator's locks means status is Finished" $
proposalF.status #== pconstantData Finished
PVotedFor rt ->
ptraceIfFalse "Result tag should match the one given in the redeemer" $
rt #== retractFrom
-- The count of removing votes is equal to the 'stakeAmount' of input stake. pure $ pconstant ()
retractCount <-
pletC $
pmatch stakeInF.stakedAmount $ \(PDiscrete v) -> pextract # v
-- The votes can only change when the proposal still allows voting. ------------------------------------------------------------------
let shouldUpdateVotes =
proposalF.status #== pconstantData VotingReady
#&& pnot # (pcon PCreated #== stakeUsage)
pguardC "Proposal output correct" $ PAdvanceProposal _ -> do
pif inDraftPeriod <-
shouldUpdateVotes pletC $
( let -- Remove votes and leave other parts of the proposal as it. isDraftPeriod # proposalF.timingConfig # proposalF.startingTime # currentTime
expectedVotes = pretractVotes # retractFrom # retractCount # proposalF.votes
expectedProposalOut = pure $
mkRecordConstr pif
PProposalDatum inDraftPeriod
( #proposalId .= proposalF.proposalId ( unTermCont $ do
.& #effects .= proposalF.effects pguardC "More cosigns than minimum amount" $
.& #status .= proposalF.status punsafeCoerce (pfromData thresholdsF.vote) #< totalStakedAmount
.& #cosigners .= proposalF.cosigners
.& #thresholds .= proposalF.thresholds
.& #votes .= pdata expectedVotes
.& #timingConfig .= proposalF.timingConfig
.& #startingTime .= proposalF.startingTime
)
in ptraceIfFalse "Update votes" $
expectedProposalOut #== proposalOut
)
-- No change to the proposal is allowed.
$ ptraceIfFalse "Proposal unchanged" proposalUnchanged
-- At last, we ensure that all locks belong to this proposal will be removed. pguardC "All new cosigners are witnessed by their Stake datums" $
stakeOutputLocks <- pletC $ pfield @"lockedBy" # stakeOut plistEquals # sortedStakeOwners # proposalF.cosigners
let templateStakeOut =
mkRecordConstr
PStakeDatum
( #stakedAmount .= stakeInF.stakedAmount
.& #owner .= stakeInF.owner
.& #lockedBy .= stakeOutputLocks
)
pguardC "Only locks updated in the output stake" $
templateStakeOut #== stakeOut
pguardC "All relevant locks removed from the stake" $
pgetStakeUsage # pfromData stakeOutputLocks
# proposalF.proposalId #== pcon PDidNothing
pure $ popaque (pconstant ())
------------------------------------------------------------------
PAdvanceProposal _ -> unTermCont $ do
pguardC "Stake should not change" $
stakeInputHash #== stakeOutputHash
proposalOutStatus <- pletC $ pfield @"status" # proposalOut
let -- Only the status of proposals should be updated in this case.
templateProposalOut =
mkRecordConstr
PProposalDatum
( #proposalId .= proposalF.proposalId
.& #effects .= proposalF.effects
.& #status .= proposalOutStatus
.& #cosigners .= proposalF.cosigners
.& #thresholds .= proposalF.thresholds
.& #votes .= proposalF.votes
.& #timingConfig .= proposalF.timingConfig
.& #startingTime .= proposalF.startingTime
)
pguardC "Only status changes in the output proposal" $
templateProposalOut #== proposalOut
inDraftPeriod <- pletC $ isDraftPeriod # proposalF.timingConfig # proposalF.startingTime # currentTime
inVotingPeriod <- pletC $ isVotingPeriod # proposalF.timingConfig # proposalF.startingTime # currentTime
inLockedPeriod <- pletC $ isLockingPeriod # proposalF.timingConfig # proposalF.startingTime # currentTime
inExecutionPeriod <- pletC $ isExecutionPeriod # proposalF.timingConfig # proposalF.startingTime # currentTime
proposalStatus <- pletC $ pto $ pfromData proposalF.status
-- Check the timings.
let isFinished = proposalF.status #== pconstantData Finished
notTooLate = pmatchEnum proposalStatus $ \case
Draft -> inDraftPeriod
-- Can only advance after the voting period is over.
VotingReady -> inLockedPeriod
Locked -> inExecutionPeriod
_ -> pconstant False
notTooEarly = pmatchEnum (pto $ pfromData proposalF.status) $ \case
VotingReady -> pnot # inVotingPeriod
Locked -> pnot # inLockedPeriod
_ -> pconstant True
pguardC "Cannot advance ahead of time" notTooEarly
pguardC "Finished proposals cannot be advanced" $ pnot # isFinished
thresholdsF <- pletFieldsC @'["execute"] proposalF.thresholds
pure $
pif
notTooLate
-- On time: advance to next status.
( pmatchEnum proposalStatus $ \case
Draft -> unTermCont $ do
-- TODO: Perform other necessary checks.
-- 'Draft' -> 'VotingReady' -- 'Draft' -> 'VotingReady'
pguardC "Proposal status set to VotingReady" $ pguardC "Proposal status set to VotingReady" $
proposalOutStatus #== pconstantData VotingReady proposalOutStatus #== pconstant VotingReady
pure $ popaque (pconstant ()) pure $ pconstant ()
)
( unTermCont $ do
pguardC "Advance to failed state" $ proposalOutStatus #== pconstant Finished
pure $ pconstant ()
)
------------------------------------------------------------------
_ -> pure $ pconstant ()
)
( unTermCont $ do
pguardC "Can only deal with one stake" $
stakeInputNum #== 1
let stakeInputHash = pfromData $ phead # stakeInputDatumHashes
stakeOutputHash = pfromData $ phead # stakeOutputDatumHashes
stakeIn :: Term _ PStakeDatum <-
pletC $
pfromData $
pfromJust #$ ptryFindDatum # stakeInputHash # txInfoF.datums
stakeInF <- pletFieldsC @'["stakedAmount", "lockedBy", "owner"] stakeIn
stakeOut :: Term _ PStakeDatum <-
pletC $
pfromData $
pfromJust #$ ptryFindDatum # stakeOutputHash # txInfoF.datums
redeemer <- pmatchC proposalRedeemer
case redeemer of
PVote r -> do
pguardC "Input proposal must be in VotingReady state" $
currentStatus #== pconstant VotingReady
pguardC "Proposal time should be wthin the voting period" $
isVotingPeriod # proposalF.timingConfig
# proposalF.startingTime
# currentTime
-- Ensure the transaction is voting to a valid 'ResultTag'(outcome).
PProposalVotes voteMap <- pmatchC proposalF.votes
voteFor <- pletC $ pfromData $ pfield @"resultTag" # r
pguardC "Vote option should be valid" $
pisJust #$ plookup # voteFor # voteMap
-- Ensure that no lock with the current proposal id has been put on the stake.
pguardC "Same stake shouldn't vote on the same proposal twice" $
pnot #$ pany
# plam
( \((pfield @"proposalTag" #) . pfromData -> pid) ->
pid #== proposalF.proposalId
)
# pfromData stakeInF.lockedBy
let -- The amount of new votes should be the 'stakedAmount'.
-- Update the vote counter of the proposal, and leave other stuff as is.
expectedNewVotes = pmatch (pfromData proposalF.votes) $ \(PProposalVotes m) ->
pcon $
PProposalVotes $
pupdate
# plam
( \votes -> unTermCont $ do
PDiscrete v <- pmatchC stakeInF.stakedAmount
pure $ pcon $ PJust $ votes + (pextract # v)
)
# voteFor
# m
expectedProposalOut =
mkRecordConstr
PProposalDatum
( #proposalId .= proposalF.proposalId
.& #effects .= proposalF.effects
.& #status .= proposalF.status
.& #cosigners .= proposalF.cosigners
.& #thresholds .= proposalF.thresholds
.& #votes .= pdata expectedNewVotes
.& #timingConfig .= proposalF.timingConfig
.& #startingTime .= proposalF.startingTime
)
pguardC "Output proposal should be valid" $ proposalOut #== expectedProposalOut
-- We validate the output stake datum here as well: We need the vote option
-- to create a valid 'ProposalLock', however the vote option is encoded
-- in the proposal redeemer, which is invisible for the stake validator.
let newProposalLock =
mkRecordConstr
PProposalLock
( #vote .= pdata voteFor
.& #proposalTag .= proposalF.proposalId
)
-- Prepend the new lock to existing locks
expectedProposalLocks =
pcons
# pdata newProposalLock
# pfromData stakeInF.lockedBy
expectedStakeOut =
mkRecordConstr
PStakeDatum
( #stakedAmount .= stakeInF.stakedAmount
.& #owner .= stakeInF.owner
.& #lockedBy .= pdata expectedProposalLocks
)
pguardC "Output stake should be locked by the proposal" $ expectedStakeOut #== stakeOut
pure $ pconstant ()
------------------------------------------------------------------
PUnlock r -> do
-- At draft stage, the votes should be empty.
pguardC "Shouldn't retract votes from a draft proposal" $
pnot #$ currentStatus #== pconstant Draft
-- This is the vote option we're retracting from.
retractFrom <- pletC $ pfield @"resultTag" # r
-- Determine if the input stake is actually locked by this proposal.
stakeUsage <- pletC $ pgetStakeUsage # stakeInF.lockedBy # proposalF.proposalId
pguardC "Stake input relevant" $
pmatch stakeUsage $ \case
PDidNothing ->
ptraceIfFalse "Stake should be relevant" $
pconstant False
PCreated ->
ptraceIfFalse "Removing creator's locks means status is Finished" $
currentStatus #== pconstant Finished
PVotedFor rt ->
ptraceIfFalse "Result tag should match the one given in the redeemer" $
rt #== retractFrom
-- The count of removing votes is equal to the 'stakeAmount' of input stake.
retractCount <-
pletC $
pmatch stakeInF.stakedAmount $ \(PDiscrete v) -> pextract # v
-- The votes can only change when the proposal still allows voting.
let shouldUpdateVotes =
currentStatus #== pconstant VotingReady
#&& pnot # (pcon PCreated #== stakeUsage)
pguardC "Proposal output correct" $
pif
shouldUpdateVotes
( let -- Remove votes and leave other parts of the proposal as it.
expectedVotes = pretractVotes # retractFrom # retractCount # proposalF.votes
expectedProposalOut =
mkRecordConstr
PProposalDatum
( #proposalId .= proposalF.proposalId
.& #effects .= proposalF.effects
.& #status .= proposalF.status
.& #cosigners .= proposalF.cosigners
.& #thresholds .= proposalF.thresholds
.& #votes .= pdata expectedVotes
.& #timingConfig .= proposalF.timingConfig
.& #startingTime .= proposalF.startingTime
)
in ptraceIfFalse "Update votes" $
expectedProposalOut #== proposalOut
)
-- No change to the proposal is allowed.
$ ptraceIfFalse "Proposal unchanged" proposalUnchanged
-- At last, we ensure that all locks belong to this proposal will be removed.
stakeOutputLocks <- pletC $ pfield @"lockedBy" # stakeOut
let templateStakeOut =
mkRecordConstr
PStakeDatum
( #stakedAmount .= stakeInF.stakedAmount
.& #owner .= stakeInF.owner
.& #lockedBy .= stakeOutputLocks
)
pguardC "Only locks updated in the output stake" $
templateStakeOut #== stakeOut
pguardC "All relevant locks removed from the stake" $
pgetStakeUsage # pfromData stakeOutputLocks
# proposalF.proposalId #== pcon PDidNothing
pure $ pconstant ()
------------------------------------------------------------------
PAdvanceProposal _ -> do
pguardC "Stake should not change" $
stakeInputHash #== stakeOutputHash
pguardC
"Only status changes in the output proposal"
onlyStatusChanged
inVotingPeriod <- pletC $ isVotingPeriod # proposalF.timingConfig # proposalF.startingTime # currentTime
inLockedPeriod <- pletC $ isLockingPeriod # proposalF.timingConfig # proposalF.startingTime # currentTime
inExecutionPeriod <- pletC $ isExecutionPeriod # proposalF.timingConfig # proposalF.startingTime # currentTime
proposalStatus <- pletC $ pto $ pfromData proposalF.status
-- Check the timings.
let isFinished = currentStatus #== pconstant Finished
notTooLate = pmatchEnum proposalStatus $ \case
-- Can only advance after the voting period is over.
VotingReady -> inLockedPeriod
Locked -> inExecutionPeriod
_ -> pconstant False
notTooEarly = pmatchEnum (pto $ pfromData proposalF.status) $ \case
VotingReady -> pnot # inVotingPeriod
Locked -> pnot # inLockedPeriod
_ -> pconstant True
pguardC "Cannot advance ahead of time" notTooEarly
pguardC "Finished proposals cannot be advanced" $ pnot # isFinished
let toFailedState = unTermCont $ do
pguardC "Proposal should fail: not on time" $
proposalOutStatus #== pconstant Finished
-- TODO: Should check that the GST is not moved
-- if the proposal is in 'Locked' state.
pure $ pconstant ()
toNextState = pmatchEnum proposalStatus $ \case
VotingReady -> unTermCont $ do VotingReady -> unTermCont $ do
-- 'VotingReady' -> 'Locked' -- 'VotingReady' -> 'Locked'
pguardC "Proposal status set to Locked" $ pguardC "Proposal status set to Locked" $
proposalOutStatus #== pconstantData Locked proposalOutStatus #== pconstant Locked
pguardC "Winner outcome not found" $ pguardC "Winner outcome not found" $
pisJust #$ pwinner' # proposalF.votes pisJust #$ pwinner' # proposalF.votes
#$ punsafeCoerce #$ punsafeCoerce
$ pfromData thresholdsF.execute $ pfromData thresholdsF.execute
pure $ popaque (pconstant ()) pure $ pconstant ()
Locked -> unTermCont $ do Locked -> unTermCont $ do
-- 'Locked' -> 'Finished' -- 'Locked' -> 'Finished'
pguardC "Proposal status set to Finished" $ pguardC "Proposal status set to Finished" $
proposalOutStatus #== pconstantData Finished proposalOutStatus #== pconstant Finished
-- TODO: Perform other necessary checks. -- TODO: Perform other necessary checks.
pure $ popaque (pconstant ()) pure $ pconstant ()
_ -> popaque (pconstant ()) _ -> pconstant ()
)
-- Too late: failed proposal, status set to 'Finished'. pure $
( popaque $ pif
ptraceIfFalse "Proposal should fail: not on time" $ notTooLate
proposalOutStatus #== pconstantData Finished -- On time: advance to next status.
-- TODO: Should check that the GST is not moved toNextState
-- if the proposal is in 'Locked' state. -- Too late: failed proposal, status set to 'Finished'.
) toFailedState
_ -> popaque (pconstant ()) _ -> pure $ pconstant ()
)

48
agora/Agora/Utils.hs
View file

@ -19,6 +19,9 @@ module Agora.Utils (
validatorHashToAddress, validatorHashToAddress,
isScriptAddress, isScriptAddress,
isPubKey, isPubKey,
pltAsData,
pisUniqBy',
pisUniq',
) where ) where
import Plutarch.Api.V1 ( import Plutarch.Api.V1 (
@ -193,3 +196,48 @@ mustBePDJust = phoistAcyclic $
-} -}
validatorHashToAddress :: ValidatorHash -> Address validatorHashToAddress :: ValidatorHash -> Address
validatorHashToAddress vh = Address (ScriptCredential vh) Nothing validatorHashToAddress vh = Address (ScriptCredential vh) Nothing
{- | Compare two 'PAsData' value, return true if the first one is less than the second one.
@since 0.2.0
-}
pltAsData ::
forall (a :: PType) (s :: S).
(POrd a, PIsData a) =>
Term s (PAsData a :--> PAsData a :--> PBool)
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

38
bench.csv
View file

@ -8,24 +8,24 @@ Agora/Stake/policy/stakeCreation,50939580,148729,2387
Agora/Stake/validator/stakeDepositWithdraw deposit,181581435,493259,4413 Agora/Stake/validator/stakeDepositWithdraw deposit,181581435,493259,4413
Agora/Stake/validator/stakeDepositWithdraw withdraw,181581435,493259,4401 Agora/Stake/validator/stakeDepositWithdraw withdraw,181581435,493259,4401
Agora/Proposal/policy/proposalCreation,23140177,69194,1515 Agora/Proposal/policy/proposalCreation,23140177,69194,1515
Agora/Proposal/validator/cosignature/proposal,242933842,689669,8224 Agora/Proposal/validator/cosignature/proposal,240482868,674626,8525
Agora/Proposal/validator/cosignature/stake,124072228,314923,4942 Agora/Proposal/validator/cosignature/stake,125315872,312659,4942
Agora/Proposal/validator/voting/proposal,236945537,666233,8142 Agora/Proposal/validator/voting/proposal,243946100,678901,8443
Agora/Proposal/validator/voting/stake,131045998,349073,4899 Agora/Proposal/validator/voting/stake,120122971,320497,4899
Agora/Proposal/validator/advancing/successfully advance to next state/Draft -> VotringReady,237984765,667020,8049 Agora/Proposal/validator/advancing/successfully advance to next state/Draft -> VotringReady,219342631,620576,8350
Agora/Proposal/validator/advancing/successfully advance to next state/VotingReady -> Locked,253273240,708960,8058 Agora/Proposal/validator/advancing/successfully advance to next state/VotingReady -> Locked,247748475,699343,8359
Agora/Proposal/validator/advancing/successfully advance to next state/Locked -> Finished,241665255,675133,8058 Agora/Proposal/validator/advancing/successfully advance to next state/Locked -> Finished,236509366,666512,8359
Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Draft -> Finished,237488276,666118,8051 Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Draft -> Finished,214287939,609855,8352
Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/VotingReady -> Finished,238906810,669423,8052 Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/VotingReady -> Finished,233681921,660502,8353
Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Locked -> Finished,240037788,671827,8052 Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Locked -> Finished,234812899,662906,8353
"Agora/Proposal/validator/unlocking/legal/1 proposals, voter, unlock stake + retract votes, VotingReady",240815652,676043,8102 "Agora/Proposal/validator/unlocking/legal/1 proposals, voter, unlock stake + retract votes, VotingReady",245987595,688711,8403
"Agora/Proposal/validator/unlocking/legal/1 proposals, creator, unlock stake, Finished",211095003,600275,8104 "Agora/Proposal/validator/unlocking/legal/1 proposals, creator, unlock stake, Finished",215263333,612711,8405
"Agora/Proposal/validator/unlocking/legal/voter unlocks stake after voting/1 proposals, voter, unlock stake, Finished",207388671,591954,8106 "Agora/Proposal/validator/unlocking/legal/voter unlocks stake after voting/1 proposals, voter, unlock stake, Finished",212560614,604622,8407
"Agora/Proposal/validator/unlocking/legal/voter unlocks stake after voting/1 proposals, voter, unlock stake, Locked",207388671,591954,8106 "Agora/Proposal/validator/unlocking/legal/voter unlocks stake after voting/1 proposals, voter, unlock stake, Locked",212560614,604622,8407
"Agora/Proposal/validator/unlocking/legal/42 proposals, voter, unlock stake + retract votes, VotingReady",1770480224,5186822,29209 "Agora/Proposal/validator/unlocking/legal/42 proposals, voter, unlock stake + retract votes, VotingReady",1775652167,5199490,29510
"Agora/Proposal/validator/unlocking/legal/42 proposals, creator, unlock stake, Finished",1444125436,4305527,29393 "Agora/Proposal/validator/unlocking/legal/42 proposals, creator, unlock stake, Finished",1448293766,4317963,29694
"Agora/Proposal/validator/unlocking/legal/voter unlocks stake after voting/42 proposals, voter, unlock stake, Finished",1335481449,3965762,29377 "Agora/Proposal/validator/unlocking/legal/voter unlocks stake after voting/42 proposals, voter, unlock stake, Finished",1340653392,3978430,29678
"Agora/Proposal/validator/unlocking/legal/voter unlocks stake after voting/42 proposals, voter, unlock stake, Locked",1335481449,3965762,29377 "Agora/Proposal/validator/unlocking/legal/voter unlocks stake after voting/42 proposals, voter, unlock stake, Locked",1340653392,3978430,29678
Agora/AuthorityToken/singleAuthorityTokenBurned/Correct simple,21017788,55883,806 Agora/AuthorityToken/singleAuthorityTokenBurned/Correct simple,21017788,55883,806
Agora/AuthorityToken/singleAuthorityTokenBurned/Correct many inputs,33204186,88241,900 Agora/AuthorityToken/singleAuthorityTokenBurned/Correct many inputs,33204186,88241,900
Agora/Treasury/Validator/Positive/Allows for effect changes,31556709,81546,1452 Agora/Treasury/Validator/Positive/Allows for effect changes,31556709,81546,1452
@ -33,5 +33,5 @@ Agora/AuthorityToken/singleAuthorityTokenBurned/Correct simple,21017788,55883,80
Agora/AuthorityToken/singleAuthorityTokenBurned/Correct many inputs,33204186,88241,900 Agora/AuthorityToken/singleAuthorityTokenBurned/Correct many inputs,33204186,88241,900
Agora/Governor/policy/GST minting,51007235,144191,2034 Agora/Governor/policy/GST minting,51007235,144191,2034
Agora/Governor/validator/proposal creation,309689999,834675,9064 Agora/Governor/validator/proposal creation,309689999,834675,9064
Agora/Governor/validator/GATs minting,421016677,1141838,9187 Agora/Governor/validator/GATs minting,418560845,1137908,9187
Agora/Governor/validator/mutate governor state,88986020,248491,8662 Agora/Governor/validator/mutate governor state,88986020,248491,8662

1 name cpu mem size
8 Agora/Stake/validator/stakeDepositWithdraw deposit 181581435 493259 4413
9 Agora/Stake/validator/stakeDepositWithdraw withdraw 181581435 493259 4401
10 Agora/Proposal/policy/proposalCreation 23140177 69194 1515
11 Agora/Proposal/validator/cosignature/proposal 242933842 240482868 689669 674626 8224 8525
12 Agora/Proposal/validator/cosignature/stake 124072228 125315872 314923 312659 4942
13 Agora/Proposal/validator/voting/proposal 236945537 243946100 666233 678901 8142 8443
14 Agora/Proposal/validator/voting/stake 131045998 120122971 349073 320497 4899
15 Agora/Proposal/validator/advancing/successfully advance to next state/Draft -> VotringReady 237984765 219342631 667020 620576 8049 8350
16 Agora/Proposal/validator/advancing/successfully advance to next state/VotingReady -> Locked 253273240 247748475 708960 699343 8058 8359
17 Agora/Proposal/validator/advancing/successfully advance to next state/Locked -> Finished 241665255 236509366 675133 666512 8058 8359
18 Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Draft -> Finished 237488276 214287939 666118 609855 8051 8352
19 Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/VotingReady -> Finished 238906810 233681921 669423 660502 8052 8353
20 Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Locked -> Finished 240037788 234812899 671827 662906 8052 8353
21 Agora/Proposal/validator/unlocking/legal/1 proposals, voter, unlock stake + retract votes, VotingReady 240815652 245987595 676043 688711 8102 8403
22 Agora/Proposal/validator/unlocking/legal/1 proposals, creator, unlock stake, Finished 211095003 215263333 600275 612711 8104 8405
23 Agora/Proposal/validator/unlocking/legal/voter unlocks stake after voting/1 proposals, voter, unlock stake, Finished 207388671 212560614 591954 604622 8106 8407
24 Agora/Proposal/validator/unlocking/legal/voter unlocks stake after voting/1 proposals, voter, unlock stake, Locked 207388671 212560614 591954 604622 8106 8407
25 Agora/Proposal/validator/unlocking/legal/42 proposals, voter, unlock stake + retract votes, VotingReady 1770480224 1775652167 5186822 5199490 29209 29510
26 Agora/Proposal/validator/unlocking/legal/42 proposals, creator, unlock stake, Finished 1444125436 1448293766 4305527 4317963 29393 29694
27 Agora/Proposal/validator/unlocking/legal/voter unlocks stake after voting/42 proposals, voter, unlock stake, Finished 1335481449 1340653392 3965762 3978430 29377 29678
28 Agora/Proposal/validator/unlocking/legal/voter unlocks stake after voting/42 proposals, voter, unlock stake, Locked 1335481449 1340653392 3965762 3978430 29377 29678
29 Agora/AuthorityToken/singleAuthorityTokenBurned/Correct simple 21017788 55883 806
30 Agora/AuthorityToken/singleAuthorityTokenBurned/Correct many inputs 33204186 88241 900
31 Agora/Treasury/Validator/Positive/Allows for effect changes 31556709 81546 1452
33 Agora/AuthorityToken/singleAuthorityTokenBurned/Correct many inputs 33204186 88241 900
34 Agora/Governor/policy/GST minting 51007235 144191 2034
35 Agora/Governor/validator/proposal creation 309689999 834675 9064
36 Agora/Governor/validator/GATs minting 421016677 418560845 1141838 1137908 9187
37 Agora/Governor/validator/mutate governor state 88986020 248491 8662