diff --git a/agora/Agora/Proposal.hs b/agora/Agora/Proposal.hs index 3390fbf..5a2b400 100644 --- a/agora/Agora/Proposal.hs +++ b/agora/Agora/Proposal.hs @@ -32,6 +32,7 @@ module Agora.Proposal ( proposalDatumValid, pemptyVotesFor, pwinner, + pwinner', pneutralOption, pretractVotes, ) where @@ -709,10 +710,8 @@ proposalDatumValid proposal = , ptraceIfFalse "Proposal votes and effects are compatible with each other" $ PUM.pkeysEqual # datum.effects # pto (pfromData datum.votes) ] -{- | Find the winner result tag, given the votes, the quorum the "neutral" result tag. - - The winner should be unambiguous, meaning that if two options have the same highest votes, - the "neutral" option will be the winner. +{- | Wrapper for 'pwinner''. When the winner cannot be found, + the 'neutral' option will be returned. @since 0.1.0 -} @@ -725,7 +724,26 @@ pwinner :: :--> PResultTag ) pwinner = phoistAcyclic $ - plam $ \votes quorum neutral -> unTermCont $ do + plam $ \votes quorum neutral -> pmatch (pwinner' # votes # quorum) $ \case + PNothing -> neutral + PJust winner -> winner + +{- | Find the winner result tag, given the votes and the quorum. + + The winner should be unambiguous, meaning that if two options have the same highest votes, + the function will return 'PNothing'. + + @since 0.1.0 +-} +pwinner' :: + Term + s + ( PProposalVotes + :--> PInteger + :--> PMaybe PResultTag + ) +pwinner' = phoistAcyclic $ + plam $ \votes quorum -> unTermCont $ do winner <- pletC $ phighestVotes # votes winnerResultTag <- pletC $ pfromData $ pfstBuiltin # winner highestVotes <- pletC $ pfromData $ psndBuiltin # winner @@ -757,10 +775,10 @@ pwinner = phoistAcyclic $ pure $ pif (noDuplicateHighestVotes #&& exceedQuorum) - winnerResultTag - neutral + (pcon $ PJust winnerResultTag) + (pcon PNothing) -{- | Find the winning outcome (and the corresponding vote count) given the votes. +{- | Find the outcome with the highest vote count given the votes. @since 0.1.0 -} diff --git a/agora/Agora/Proposal/Scripts.hs b/agora/Agora/Proposal/Scripts.hs index 6d92604..6a3df7f 100644 --- a/agora/Agora/Proposal/Scripts.hs +++ b/agora/Agora/Proposal/Scripts.hs @@ -18,6 +18,7 @@ import Agora.Proposal ( Proposal (governorSTAssetClass, stakeSTAssetClass), ProposalStatus (..), pretractVotes, + pwinner', ) import Agora.Proposal.Time ( currentProposalTime, @@ -66,6 +67,7 @@ import Plutarch.Extra.TermCont ( ptryFromC, ) import Plutarch.SafeMoney (PDiscrete (..)) +import Plutarch.Unsafe (punsafeCoerce) import PlutusLedgerApi.V1.Value (AssetClass (AssetClass)) {- | Policy for Proposals. @@ -528,6 +530,8 @@ proposalValidator proposal = pguardC "Cannot advance ahead of time" notTooEarly pguardC "Finished proposals cannot be advanced" $ pnot # isFinished + thresholdsF <- pletFieldsC @'["execute"] proposalF.thresholds + pure $ pif notTooLate @@ -546,6 +550,11 @@ proposalValidator proposal = pguardC "Proposal status set to Locked" $ proposalOutStatus #== pconstantData Locked + pguardC "Winner outcome not found" $ + pisJust #$ pwinner' # proposalF.votes + #$ punsafeCoerce + $ pfromData thresholdsF.execute + pure $ popaque (pconstant ()) PLocked _ -> unTermCont $ do -- 'Locked' -> 'Finished'