Merge branch 'main' into connor/mutate-governor

agora-test/Spec/Proposal.hs

@@ -13,10 +13,11 @@ module Spec.Proposal (tests) where
 
 import Agora.Proposal (
   Proposal (..),
-  ProposalDatum (ProposalDatum),
+  ProposalDatum (..),
   ProposalId (ProposalId),
-  ProposalRedeemer (Cosign),
-  ProposalStatus (Draft),
+  ProposalRedeemer (Cosign, Vote),
+  ProposalStatus (Draft, VotingReady),
+  ProposalVotes (ProposalVotes),
   ResultTag (ResultTag),
   cosigners,
   effects,
@@ -30,7 +31,11 @@ import Agora.Proposal.Scripts (
   proposalPolicy,
   proposalValidator,
  )
-import Agora.Stake (StakeDatum (StakeDatum), StakeRedeemer (WitnessStake))
+import Agora.Stake (
+  ProposalLock (ProposalLock),
+  StakeDatum (StakeDatum),
+  StakeRedeemer (PermitVote, WitnessStake),
+ )
 import Agora.Stake.Scripts (stakeValidator)
 import Plutarch.SafeMoney (Tagged (Tagged))
 import Plutus.V1.Ledger.Api (ScriptContext (..), ScriptPurpose (..))
@@ -77,6 +82,8 @@ tests =
                           [ (ResultTag 0, AssocMap.empty)
                           , (ResultTag 1, AssocMap.empty)
                           ]
+                  , timingConfig = Shared.proposalTimingConfig
+                  , startingTime = Shared.tmpProposalStartingTime
                   }
               )
               (Cosign [signer2])
@@ -88,5 +95,62 @@ tests =
               WitnessStake
               (ScriptContext (Proposal.cosignProposal [signer2]) (Spending Proposal.stakeRef))
           ]
+      , testGroup
+          "voting"
+          [ validatorSucceedsWith
+              "proposal"
+              (proposalValidator Shared.proposal)
+              ( ProposalDatum
+                  { proposalId = ProposalId 42
+                  , effects =
+                      AssocMap.fromList
+                        [ (ResultTag 0, AssocMap.empty)
+                        , (ResultTag 1, AssocMap.empty)
+                        ]
+                  , status = VotingReady
+                  , cosigners = [signer]
+                  , thresholds = Shared.defaultProposalThresholds
+                  , votes =
+                      ProposalVotes
+                        ( AssocMap.fromList
+                            [ (ResultTag 0, 42)
+                            , (ResultTag 1, 4242)
+                            ]
+                        )
+                  , timingConfig = Shared.proposalTimingConfig
+                  , startingTime = Shared.tmpProposalStartingTime
+                  }
+              )
+              (Vote (ResultTag 0))
+              ( ScriptContext
+                  ( Proposal.voteOnProposal
+                      Proposal.VotingParameters
+                        { Proposal.voteFor = ResultTag 0
+                        , Proposal.voteCount = 27
+                        }
+                  )
+                  (Spending Proposal.proposalRef)
+              )
+          , validatorSucceedsWith
+              "stake"
+              (stakeValidator Shared.stake)
+              ( StakeDatum
+                  (Tagged 27)
+                  signer
+                  [ ProposalLock (ResultTag 0) (ProposalId 0)
+                  , ProposalLock (ResultTag 2) (ProposalId 1)
+                  ]
+              )
+              (PermitVote $ ProposalLock (ResultTag 0) (ProposalId 42))
+              ( ScriptContext
+                  ( Proposal.voteOnProposal
+                      Proposal.VotingParameters
+                        { Proposal.voteFor = ResultTag 0
+                        , Proposal.voteCount = 27
+                        }
+                  )
+                  (Spending Proposal.stakeRef)
+              )
+          ]
       ]
   ]

agora-test/Spec/Utils.hs

@@ -9,17 +9,33 @@ module Spec.Utils (tests) where
 
 --------------------------------------------------------------------------------
 
-import Agora.Utils (phalve, pisUniq, pmergeBy, pmsort, pnubSort)
+import Agora.Utils (phalve, pisUniq, pmergeBy, pmsort, pnubSort, pupdate)
 
 --------------------------------------------------------------------------------
 
 import Data.List (nub, sort)
-import Data.Set as S
+import Data.Map qualified as M
+import Data.Set qualified as S
 
 --------------------------------------------------------------------------------
 
+import Control.Monad.Cont (cont, runCont)
 import Test.Tasty (TestTree)
-import Test.Tasty.QuickCheck (testProperty)
+import Test.Tasty.QuickCheck (
+  Arbitrary (arbitrary),
+  Property,
+  Testable (property),
+  elements,
+  forAll,
+  suchThat,
+  testProperty,
+  (.&&.),
+ )
+import Test.Util (updateMap)
+
+--------------------------------------------------------------------------------
+
+import PlutusTx.AssocMap qualified as AssocMap
 
 --------------------------------------------------------------------------------
 
@@ -30,6 +46,7 @@ tests =
   , testProperty "'phalve' splits a list in half as expected" prop_halveCorrect
   , testProperty "'pnubSort' sorts a list and remove duplicate elements" prop_nubSortProperly
   , testProperty "'pisUniq' can tell whether all elements in a list are unique" prop_uniqueList
+  , testProperty "'pupdate' updates assoc maps as 'updateMap' does" prop_updateAssocMapParity
   ]
 
 --------------------------------------------------------------------------------
@@ -142,3 +159,68 @@ prop_uniqueList l = isUnique == expected
     --
 
     isUnique = plift $ pisUniq # pconstant l
+
+{- | Test the parity between 'updateMap' and 'pupdate',
+     also ensure they both work correctly.
+-}
+prop_updateAssocMapParity :: Property
+prop_updateAssocMapParity =
+  runCont
+    ( do
+        -- Generate a bunch unique keys.
+        keys <-
+          cont $
+            forAll $
+              arbitrary @(S.Set Integer) `suchThat` (not . S.null)
+
+        -- Generate key-value pairs.
+        kvPairs <- cont $ forAll $ mapM (\k -> (k,) <$> (arbitrary @Integer)) $ S.toList keys
+
+        let initialMap = AssocMap.fromList kvPairs
+
+            pinitialMap :: Term _ _
+            pinitialMap = phoistAcyclic $ pconstant initialMap
+
+            referenceMap = M.fromList kvPairs
+
+        let pupdatedValue :: Maybe Integer -> Term _ (PMaybe PInteger)
+            pupdatedValue updatedValue = phoistAcyclic $ case updatedValue of
+              Nothing -> pcon PNothing
+              Just v -> pcon $ PJust $ pconstant v
+
+            -- Given the key and the updated value, test the parity
+            parity key updatedValue =
+              let native = updateMap (const updatedValue) key initialMap
+
+                  plutarch :: AssocMap.Map Integer Integer
+                  plutarch =
+                    plift $
+                      pupdate
+                        # plam (\_ -> pupdatedValue updatedValue)
+                        # pconstant key
+                        # pinitialMap
+
+                  expected =
+                    AssocMap.fromList $
+                      M.toList $
+                        M.update (const updatedValue) key referenceMap
+               in expected == native
+                    && expected == plutarch
+
+        -- Select a key, generate a maybe value.
+        -- The value at the key should be set to the new value or removed.
+        (targetKey, _) <- cont $ forAll $ elements kvPairs
+        updatedValue <- cont $ forAll $ arbitrary @(Maybe Integer)
+
+        -- Now what if the key doesn't exist in our map?
+        nonexistentKey <-
+          cont $
+            forAll $
+              arbitrary @Integer `suchThat` (\k -> not $ S.member k keys)
+
+        pure
+          ( property (parity targetKey updatedValue)
+              .&&. property (parity nonexistentKey updatedValue)
+          )
+    )
+    id