From 0ce867686074846c7bbef80e39e7a49f042ab519 Mon Sep 17 00:00:00 2001
From: Emily Martins <emi@haskell.fyi>
Date: Wed, 27 Apr 2022 15:18:07 +0200
Subject: [PATCH] add effect and votes shape check on `proposalDatumValid`

---
 agora/Agora/Proposal.hs |  5 +++--
 agora/Agora/Utils.hs    | 13 +++++++++++++
 2 files changed, 16 insertions(+), 2 deletions(-)

diff --git a/agora/Agora/Proposal.hs b/agora/Agora/Proposal.hs
index d7c6e35..fef4c71 100644
--- a/agora/Agora/Proposal.hs
+++ b/agora/Agora/Proposal.hs
@@ -44,7 +44,7 @@ import PlutusTx.AssocMap qualified as AssocMap
 
 --------------------------------------------------------------------------------
 import Agora.SafeMoney (GTTag)
-import Agora.Utils (pnotNull)
+import Agora.Utils (pkeysEqual, pnotNull)
 import Control.Applicative (Const)
 import Control.Arrow (first)
 import Plutarch.Builtin (PBuiltinMap)
@@ -406,7 +406,7 @@ proposalDatumValid :: Proposal -> Term s (Agora.Proposal.PProposalDatum :--> PBo
 proposalDatumValid proposal =
   phoistAcyclic $
     plam $ \datum' -> P.do
-      datum <- pletFields @'["effects", "cosigners"] $ datum'
+      datum <- pletFields @'["effects", "cosigners", "votes"] $ datum'
 
       let effects :: Term _ (PBuiltinMap Agora.Proposal.PResultTag (PBuiltinMap Plutarch.Api.V1.PValidatorHash Plutarch.Api.V1.PDatumHash))
           effects =
@@ -425,4 +425,5 @@ proposalDatumValid proposal =
         [ ptraceIfFalse "Proposal has at least one ResultTag has no effects" atLeastOneNegativeResult
         , ptraceIfFalse "Proposal has at least one cosigner" $ pnotNull # pfromData datum.cosigners
         , ptraceIfFalse "Proposal has at most five cosigners" $ plength # (pfromData datum.cosigners) #<= pconstant proposal.maximumCosigners
+        , ptraceIfFalse "Proposal votes and effects are compatible with eachother" $ pkeysEqual # datum.effects # pto (pfromData datum.votes)
         ]
diff --git a/agora/Agora/Utils.hs b/agora/Agora/Utils.hs
index 0f60dde..0affea1 100644
--- a/agora/Agora/Utils.hs
+++ b/agora/Agora/Utils.hs
@@ -27,6 +27,7 @@ module Agora.Utils (
   pnotNull,
   pisJust,
   ptokenSpent,
+  pkeysEqual,
 
   -- * Functions which should (probably) not be upstreamed
   anyOutput,
@@ -68,6 +69,7 @@ import Plutarch.Api.V1.Extra (PAssetClass, passetClassValueOf, pvalueOf)
 import Plutarch.Api.V1.Value (PValue (PValue))
 import Plutarch.Builtin (ppairDataBuiltin)
 import Plutarch.Internal (punsafeCoerce)
+import Plutarch.Map.Extra (pkeys)
 import Plutarch.Monadic qualified as P
 import Plutarch.TryFrom (PTryFrom, ptryFrom)
 
@@ -317,6 +319,17 @@ ptokenSpent =
         # 0
         # inputs
 
+{- | True if both maps have exactly the same keys.
+     Using @'#=='@ is not sufficient, because keys returned are not ordered.
+-}
+pkeysEqual :: forall (s :: S) k a b. Term s (PMap k a :--> PMap k b :--> PBool)
+pkeysEqual = phoistAcyclic $
+  plam $ \p q -> P.do
+    pks <- plet $ pkeys # p
+    qks <- plet $ pkeys # q
+    pall # plam (\pk -> pelem # pk # qks) # pks
+      #&& pall # plam (\qk -> pelem # qk # pks) # qks
+
 --------------------------------------------------------------------------------
 {- Functions which should (probably) not be upstreamed
    All of these functions are quite inefficient.