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

fix winner outcome selection logic and timing

Browse source
This commit is contained in:
fanghr 2022-05-30 21:56:33 +08:00 • committed by Hongrui Fang
parent 70d3c01af4
commit 5326b4cb81
No known key found for this signature in database
GPG key ID: 1C4711FFF64C0254
5 changed files with 113 additions and 58 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -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

94
agora/Agora/Proposal.hs
View file

@ -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

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

@ -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 ())