fix winner outcome selection logic and timing

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

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

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

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

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