support more than two effect groups/vote outcomes

agora/Agora/Governor.hs

@@ -47,8 +47,6 @@ import Agora.Proposal (
   PProposalId,
   PProposalStatus (PDraft, PExecutable, PFinished),
   PProposalThresholds,
-  PProposalVotes (PProposalVotes),
-  PResultTag (PResultTag),
   Proposal (..),
   ProposalId,
   ProposalThresholds,
@@ -68,6 +66,7 @@ import Agora.Utils (
   passetClassValueOf',
   pfindTxInByTxOutRef,
   pisDJust,
+  pisJust,
   pisUxtoSpent,
   pownCurrencySymbol,
   psymbolValueOf,
@@ -81,9 +80,13 @@ import Plutarch (popaque)
 import Plutarch.Api.V1 (
   PAddress,
   PCurrencySymbol,
+  PDatumHash,
+  PMap,
   PMintingPolicy,
   PScriptPurpose (PSpending),
+  PTxOut,
   PValidator,
+  PValidatorHash,
   PValue,
   mintingPolicySymbol,
   mkMintingPolicy,
@@ -490,25 +493,36 @@ governorValidator gov =
 
         -- TODO: anything else to check here?
 
-        -- TODO: support more than two effect group.
+        let highestVoteFolder =
+              phoistAcyclic $
+                plam
+                  ( \pair last' ->
+                      pif
+                        (pisJust # last')
+                        ( P.do
+                            PJust last <- pmatch last'
+                            let lastHighestVote = pfromData $ psndBuiltin # last
+                                thisVote = pfromData $ psndBuiltin # pair
+                            pif (lastHighestVote #< thisVote) (pcon $ PJust pair) last'
+                        )
+                        (pcon $ PJust pair)
+                  )
 
-        PProposalVotes votes' <- pmatch $ pfromData inputProposalDatum.votes
+            winner' =
-        votes <- plet votes'
+              pfoldr # highestVoteFolder # (pcon $ PNothing) #$ pto $ pto $ pfromData inputProposalDatum.votes
 
-        let minimumVotes = puntag $ pfromData $ pfield @"execute" # inputProposalDatum.thresholds
+        winner <- plet $ mustBePJust # "Empty votes" # winner'
 
-            yesVotes = plookup' # pyesResultTag # votes
+        let highestVote = pfromData $ psndBuiltin # winner
-            noVotes = plookup' # pnoResultTag # votes
+            minimumVotes = puntag $ pfromData $ pfield @"execute" # inputProposalDatum.thresholds
-            biggerVotes = pif (yesVotes #< noVotes) noVotes yesVotes
 
-        passert "Number of votes doesn't meet the minimum requirement" $
+        passert "Higgest vote doesn't meet the minimum requirement" $ minimumVotes #<= highestVote
-          minimumVotes #< biggerVotes
 
-        let finalResultTag = pif (yesVotes #< noVotes) pnoResultTag pyesResultTag
+        let finalResultTag = pfromData $ pfstBuiltin # winner
 
-        effects <- plet $ plookup' # finalResultTag #$ inputProposalDatum.effects
+        effectGroup <- plet $ plookup' # finalResultTag #$ inputProposalDatum.effects
 
-        gatCount <- plet $ plength #$ pto $ pto effects
+        gatCount <- plet $ plength #$ pto $ pto effectGroup
 
         passert "Required amount of GATs should be minted" $
           psymbolValueOf # pproposalSymbol # txInfo.mint #== gatCount
@@ -516,36 +530,45 @@ governorValidator gov =
         outputsWithGAT <-
           plet $
             pfilter
-              # plam
+              # ( phoistAcyclic $
-                ( \((pfield @"value" #) -> value) ->
+                    plam
-                    0 #< psymbolValueOf # pgatSym # value
+                      ( \((pfield @"value" #) -> value) ->
+                          0 #< psymbolValueOf # pgatSym # value
+                      )
                 )
               #$ pfromData txInfo.outputs
 
         passert "Output GATs is more than minted GATs" $
           plength # outputsWithGAT #== gatCount
 
+        let gatOutputValidator' :: Term s ((PMap PValidatorHash PDatumHash) :--> (PAsData PTxOut) :--> PUnit :--> PUnit)
+            gatOutputValidator' =
+              phoistAcyclic $
+                plam
+                  ( \effects (pfromData -> output') _ -> P.do
+                      output <- pletFields @'["address", "datumHash"] $ output'
+
+                      let scriptHash =
+                            mustBePJust # "GAT receiver is not a script"
+                              #$ scriptHashFromAddress # output.address
+                          datumHash =
+                            mustBePDJust # "Output to effect should have datum"
+                              #$ output.datumHash
+
+                          expectedDatumHash =
+                            mustBePJust # "Receiver is not in the effect list"
+                              #$ plookup # scriptHash # effects
+
+                      passert "GAT must be tagged by the effect hash" $ authorityTokensValidIn # pgatSym # output'
+                      passert "Unexpected datum" $ datumHash #== expectedDatumHash
+                      pconstant ()
+                  )
+
+            gatOutputValidator = gatOutputValidator' # effectGroup
+
         popaque $
           pfoldr
-            # plam
+            # gatOutputValidator
-              ( \(pfromData -> output') _ -> P.do
-                  output <- pletFields @'["address", "datumHash"] $ output'
-
-                  let scriptHash =
-                        mustBePJust # "GAT receiver is not a script"
-                          #$ scriptHashFromAddress # output.address
-                      datumHash =
-                        mustBePDJust # "Output to effect should have datum"
-                          #$ output.datumHash
-
-                      expectedDatumHash =
-                        mustBePJust # "Receiver is not in the effect list"
-                          #$ plookup # scriptHash # effects
-
-                  passert "GAT must be tagged by the effect hash" $ authorityTokensValidIn # pgatSym # output'
-                  passert "Unexpected datum" $ datumHash #== expectedDatumHash
-                  pconstant ()
-              )
             # pconstant ()
             # outputsWithGAT
       PMutateGovernor _ -> P.do
@@ -583,12 +606,6 @@ governorValidator gov =
     pgatSym :: Term s PCurrencySymbol
     pgatSym = phoistAcyclic $ pconstant $ gatSymbol gov
 
-    pyesResultTag :: Term s PResultTag
-    pyesResultTag = phoistAcyclic $ pcon $ PResultTag $ pconstant 1
-
-    pnoResultTag :: Term s PResultTag
-    pnoResultTag = phoistAcyclic $ pcon $ PResultTag $ pconstant 0
-
 --------------------------------------------------------------------------------
 
 -- | Get the assetclass of GST from governor parameters.