From 5326b4cb81fa2ef6adee473ed5ed14fcea230d05 Mon Sep 17 00:00:00 2001 From: fanghr Date: Mon, 30 May 2022 21:56:33 +0800 Subject: [PATCH] fix winner outcome selection logic and timing --- agora-sample/Sample/Proposal.hs | 14 +++-- agora/Agora/Governor/Scripts.hs | 15 ++---- agora/Agora/Proposal.hs | 94 +++++++++++++++++++++++++++------ agora/Agora/Proposal/Scripts.hs | 24 ++++----- bench.csv | 24 ++++----- 5 files changed, 113 insertions(+), 58 deletions(-) diff --git a/agora-sample/Sample/Proposal.hs b/agora-sample/Sample/Proposal.hs index 9af01ce..9b9f3dc 100644 --- a/agora-sample/Sample/Proposal.hs +++ b/agora-sample/Sample/Proposal.hs @@ -554,16 +554,19 @@ advanceProposalSuccess params = closedBoundedInterval (proposalStartingTime + 1) (proposalStartingTime + (def :: ProposalTimingConfig).draftTime - 1) - -- [S + D + 1, S + D + V - 1] + -- [S + D + V + 1, S + D + V + L - 1] VotingReady -> closedBoundedInterval ( proposalStartingTime + (def :: ProposalTimingConfig).draftTime + + (def :: ProposalTimingConfig).votingTime + 1 ) ( proposalStartingTime + (def :: ProposalTimingConfig).draftTime - + (def :: ProposalTimingConfig).votingTime - 1 + + (def :: ProposalTimingConfig).votingTime + + (def :: ProposalTimingConfig).lockingTime + - 1 ) -- [S + D + V + L + 1, S + + D + V + L + E - 1] Locked -> @@ -633,18 +636,21 @@ advanceProposalFailureTimeout params = + (def :: ProposalTimingConfig).draftTime + (def :: ProposalTimingConfig).votingTime - 1 ) - -- [S + D + V + 1, S + D + V + L -1] + -- [S + D + V + L + 1, S + D + V + L + E -1] VotingReady -> closedBoundedInterval ( proposalStartingTime + (def :: ProposalTimingConfig).draftTime + (def :: ProposalTimingConfig).votingTime + + (def :: ProposalTimingConfig).lockingTime + 1 ) ( proposalStartingTime + (def :: ProposalTimingConfig).draftTime + (def :: ProposalTimingConfig).votingTime - + (def :: ProposalTimingConfig).lockingTime - 1 + + (def :: ProposalTimingConfig).lockingTime + + (def :: ProposalTimingConfig).executingTime + - 1 ) -- [S + D + V + L + E + 1, S + D + V + L + E + 100] Locked -> diff --git a/agora/Agora/Governor/Scripts.hs b/agora/Agora/Governor/Scripts.hs index c484ccf..e42c28c 100644 --- a/agora/Agora/Governor/Scripts.hs +++ b/agora/Agora/Governor/Scripts.hs @@ -52,6 +52,7 @@ import Agora.Proposal ( Proposal (..), ProposalStatus (Draft, Locked), pemptyVotesFor, + pneutralOption, proposalDatumValid, pwinner, ) @@ -114,13 +115,11 @@ import Plutarch.Api.V1.AssetClass ( passetClass, passetClassValueOf, ) -import Plutarch.Extra.Comonad (pextract) import Plutarch.Extra.Map ( pkeys, plookup, plookup', ) -import Plutarch.Extra.TermCont (pmatchC) import Plutarch.SafeMoney (PDiscrete (..), pvalueDiscrete') import Plutarch.TryFrom () @@ -605,15 +604,9 @@ governorValidator gov = -- TODO: anything else to check here? -- Find the highest votes and the corresponding tag. - winner <- tclet $ mustBePJust # "No winning outcome" #$ pwinner # proposalInputDatumF.votes - - PDiscrete minimumVotes' <- pmatchC $ pfromData $ pfield @"execute" # proposalInputDatumF.thresholds - let highestVote = pfromData $ psndBuiltin # winner - minimumVotes = pextract # minimumVotes' - - tcassert "Higgest vote doesn't meet the minimum requirement" $ minimumVotes #<= highestVote - - let finalResultTag = pfromData $ pfstBuiltin # winner + let quorum = pto $ pto $ pfromData $ pfield @"execute" # proposalInputDatumF.thresholds + neutralOption = pneutralOption # proposalInputDatumF.effects + finalResultTag = pwinner # proposalInputDatumF.votes # quorum # neutralOption -- The effects of the winner outcome. effectGroup <- tclet $ plookup' # finalResultTag #$ proposalInputDatumF.effects diff --git a/agora/Agora/Proposal.hs b/agora/Agora/Proposal.hs index ba17a25..7c893a5 100644 --- a/agora/Agora/Proposal.hs +++ b/agora/Agora/Proposal.hs @@ -32,6 +32,7 @@ module Agora.Proposal ( proposalDatumValid, pemptyVotesFor, pwinner, + pneutralOption, ) where import GHC.Generics qualified as GHC @@ -49,7 +50,7 @@ import PlutusTx.AssocMap qualified as AssocMap import Agora.Proposal.Time (PProposalStartingTime, PProposalTimingConfig, ProposalStartingTime, ProposalTimingConfig) import Agora.SafeMoney (GTTag) -import Agora.Utils (pkeysEqual, pmapMap, pnotNull) +import Agora.Utils (mustBePJust, pkeysEqual, pmapMap, pnotNull, tclet) import Control.Applicative (Const) import Control.Arrow (first) import Data.Tagged (Tagged) @@ -450,17 +451,63 @@ proposalDatumValid proposal = , ptraceIfFalse "Proposal votes and effects are compatible with each other" $ pkeysEqual # datum.effects # pto (pfromData datum.votes) ] -{- | Find the winning outcome (and the corresponding vote count) given the votes. +{- Find the winner result tag, given the votes, the quorum the "neutral" result tag. - FIXME: What if two or more outcomes have the exact same vote count? + The winner should be unambiguous, meaning that if two options have the same highest votes, + the "neutral" option will be the winner. -} pwinner :: Term s ( PProposalVotes - :--> PMaybe (PBuiltinPair (PAsData PResultTag) (PAsData PInteger)) + :--> PInteger + :--> PResultTag + :--> PResultTag ) pwinner = phoistAcyclic $ + plam $ \votes quorum neutral -> unTermCont $ do + winner <- tclet $ phighestVotes # votes + winnerResultTag <- tclet $ pfromData $ pfstBuiltin # winner + highestVotes <- tclet $ pfromData $ psndBuiltin # winner + + let l :: Term _ (PBuiltinList _) + l = pto $ pto votes + + f :: + Term + _ + ( PBuiltinPair (PAsData PResultTag) (PAsData PInteger) + :--> PInteger + :--> PInteger + ) + f = plam $ \(pfromData . (psndBuiltin #) -> thisVotes) i -> + pif + (thisVotes #== highestVotes) + (i + 1) + i + + noDuplicateHighestVotes = + ptraceIfFalse "Ambiguous winner" $ + pfoldr # f # 0 # l #== 1 + + exceedQuorum = + ptraceIfFalse "Highest vote count should exceed the minimum threshold" $ + quorum #< highestVotes + + pure $ + pif + (noDuplicateHighestVotes #&& exceedQuorum) + winnerResultTag + neutral + +-- | Find the winning outcome (and the corresponding vote count) given the votes. +phighestVotes :: + Term + s + ( PProposalVotes + :--> PBuiltinPair (PAsData PResultTag) (PAsData PInteger) + ) +phighestVotes = phoistAcyclic $ plam $ \votes -> let l :: Term _ (PBuiltinList _) l = pto $ pto votes @@ -469,17 +516,32 @@ pwinner = phoistAcyclic $ Term _ ( PBuiltinPair (PAsData PResultTag) (PAsData PInteger) - :--> PMaybe (PBuiltinPair (PAsData PResultTag) (PAsData PInteger)) - :--> PMaybe (PBuiltinPair (PAsData PResultTag) (PAsData PInteger)) + :--> PBuiltinPair (PAsData PResultTag) (PAsData PInteger) + :--> PBuiltinPair (PAsData PResultTag) (PAsData PInteger) ) f = phoistAcyclic $ - plam $ \this maybeLast -> pmatch maybeLast $ \case - PNothing -> pcon $ PJust this - PJust last -> - let lastVotes = pfromData $ psndBuiltin # last - thisVotes = pfromData $ psndBuiltin # this - in pif - (lastVotes #< thisVotes) - (pcon $ PJust this) - maybeLast - in pfoldr # f # pcon PNothing # l + plam $ \this last -> + let lastVotes = pfromData $ psndBuiltin # last + thisVotes = pfromData $ psndBuiltin # this + in pif (lastVotes #< thisVotes) this last + in pfoldr # f # (phead # l) # l + +-- | Find the "neutral" option (a dummy outcome with no effect) given the effects. +pneutralOption :: + Term + s + ( PMap PResultTag (PMap PValidatorHash PDatumHash) + :--> PResultTag + ) +pneutralOption = phoistAcyclic $ + plam $ \effects -> + let l :: Term _ (PBuiltinList (PBuiltinPair (PAsData PResultTag) _)) + l = pto effects + + f :: Term _ (PBuiltinPair (PAsData PResultTag) (PAsData (PMap _ _)) :--> PBool) + f = phoistAcyclic $ + plam $ \((pfromData . (psndBuiltin #) -> el)) -> + let el' :: Term _ (PBuiltinList _) + el' = pto el + in pnull # el' + in pfromData $ pfstBuiltin #$ mustBePJust # "No neutral option" #$ pfind # f # l diff --git a/agora/Agora/Proposal/Scripts.hs b/agora/Agora/Proposal/Scripts.hs index 685238e..1a592fb 100644 --- a/agora/Agora/Proposal/Scripts.hs +++ b/agora/Agora/Proposal/Scripts.hs @@ -17,7 +17,6 @@ import Agora.Proposal ( PProposalVotes (PProposalVotes), Proposal (governorSTAssetClass, stakeSTAssetClass), ProposalStatus (..), - pwinner, ) import Agora.Proposal.Time ( currentProposalTime, @@ -382,8 +381,6 @@ proposalValidator proposal = currentTime <- tclet $ currentProposalTime # txInfoF.validRange proposalOutStatus <- tclet $ pfield @"status" # proposalOut - thresholdsF <- tcont $ pletFields @'["execute", "draft", "vote"] proposalF.thresholds - let -- Only the status of proposals should be updated in this case. templateProposalOut = mkRecordConstr @@ -411,11 +408,18 @@ proposalValidator proposal = notTooLate = pmatch (pfromData proposalF.status) $ \case PDraft _ -> inDraftPeriod - PVotingReady _ -> inVotingPeriod + -- Can only advance after the voting period is over. + PVotingReady _ -> inLockedPeriod PLocked _ -> inExecutionPeriod _ -> pconstant False - tcassert "Finished proposals cannnot be advanced" $ pnot # isFinished + notTooEarly = pmatch (pfromData proposalF.status) $ \case + PVotingReady _ -> pnot # inVotingPeriod + PLocked _ -> pnot # inLockedPeriod + _ -> pconstant True + + tcassert "Cannot advance ahead of time" notTooEarly + tcassert "Finished proposals cannot be advanced" $ pnot # isFinished pure $ pif @@ -435,22 +439,12 @@ proposalValidator proposal = tcassert "Proposal status set to Locked" $ proposalOutStatus #== pconstantData Locked - -- Check that the highest votes meet the minimum requirement. - let winner = mustBePJust # "Highest votes not found" #$ pwinner # proposalF.votes - highestVotes = pfromData $ psndBuiltin # winner - - tcassert "Highest vote count should exceed the threshold" $ - pto (pto $ pfromData thresholdsF.execute) #< highestVotes - pure $ popaque (pconstant ()) PLocked _ -> unTermCont $ do -- 'Locked' -> 'Finished' tcassert "Proposal status set to Finished" $ proposalOutStatus #== pconstantData Finished - tcassert "Can only unlock after the locking period" $ - pnot # inLockedPeriod - -- TODO: Perform other necessary checks. pure $ popaque (pconstant ()) _ -> popaque (pconstant ()) diff --git a/bench.csv b/bench.csv index a3efd41..360f86f 100644 --- a/bench.csv +++ b/bench.csv @@ -2,28 +2,28 @@ name,cpu,mem,size Agora/Effects/Treasury Withdrawal Effect/effect/Simple,340268715,724428,3050 Agora/Effects/Treasury Withdrawal Effect/effect/Simple with multiple treasuries ,570029812,1211300,3377 Agora/Effects/Treasury Withdrawal Effect/effect/Mixed Assets,502351827,1071087,3242 -Agora/Effects/Governor Mutation Effect/validator/valid new governor datum/governor validator should pass,103830462,228928,7532 +Agora/Effects/Governor Mutation Effect/validator/valid new governor datum/governor validator should pass,103830462,228928,7629 Agora/Effects/Governor Mutation Effect/validator/valid new governor datum/effect validator should pass,127968605,266935,3358 Agora/Stake/policy/stakeCreation,59776675,126049,2116 Agora/Stake/validator/stakeDepositWithdraw deposit,276249331,599197,4024 Agora/Stake/validator/stakeDepositWithdraw withdraw,276249331,599197,4016 Agora/Proposal/policy/proposalCreation,34784356,68894,1523 -Agora/Proposal/validator/cosignature/proposal,241651391,511819,5772 +Agora/Proposal/validator/cosignature/proposal,241651391,511819,5644 Agora/Proposal/validator/cosignature/stake,186332635,402961,4561 -Agora/Proposal/validator/voting/proposal,240181636,491168,5780 +Agora/Proposal/validator/voting/proposal,240181636,491168,5652 Agora/Proposal/validator/voting/stake,154223940,328703,4614 -Agora/Proposal/validator/advancing/successfully advance to next state/Draft -> VotringReady,129146959,254742,5158 -Agora/Proposal/validator/advancing/successfully advance to next state/VotingReady -> Locked,138455315,275396,5166 -Agora/Proposal/validator/advancing/successfully advance to next state/Locked -> Finished,131138537,260050,5167 -Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Draft -> Finished,127634992,252012,5160 -Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/VotingReady -> Finished,128625282,254416,5167 -Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Locked -> Finished,128130137,253214,5167 +Agora/Proposal/validator/advancing/successfully advance to next state/Draft -> VotringReady,131365724,260351,5030 +Agora/Proposal/validator/advancing/successfully advance to next state/VotingReady -> Locked,130643392,258848,5039 +Agora/Proposal/validator/advancing/successfully advance to next state/Locked -> Finished,132128827,262454,5039 +Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Draft -> Finished,129853757,257621,5032 +Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/VotingReady -> Finished,128636280,254916,5039 +Agora/Proposal/validator/advancing/successfully advance to failed state: timeout/Locked -> Finished,129626570,257320,5039 Agora/AuthorityToken/singleAuthorityTokenBurned/Correct simple,25177457,55883,806 Agora/AuthorityToken/singleAuthorityTokenBurned/Correct many inputs,40266637,88241,900 Agora/Treasury/Validator/Positive/Allows for effect changes,37343572,79744,1841 Agora/AuthorityToken/singleAuthorityTokenBurned/Correct simple,25177457,55883,806 Agora/AuthorityToken/singleAuthorityTokenBurned/Correct many inputs,40266637,88241,900 Agora/Governor/policy/GST minting,57978053,120125,1833 -Agora/Governor/validator/proposal creation,330344593,681815,8047 -Agora/Governor/validator/GATs minting,431297108,932207,8170 -Agora/Governor/validator/mutate governor state,101019422,223202,7589 +Agora/Governor/validator/proposal creation,330344593,681815,8145 +Agora/Governor/validator/GATs minting,442720585,955552,8268 +Agora/Governor/validator/mutate governor state,101019422,223202,7686