fix sample tests for voting

agora-specs/Sample/Proposal/Vote.hs

@@ -1,14 +1,24 @@
-{- |
-Module     : Sample.Proposal.Vote
-Maintainer : connor@mlabs.city
-Description: Generate sample data for testing the functionalities of voting on proposals.
-
-Sample and utilities for testing the functionalities of voting on proposals.
--}
 module Sample.Proposal.Vote (
-  validVoteParameters,
+  ParameterBundle (..),
+  VoteParameters (..),
+  StakeParameters (..),
+  StakeInputParameters (..),
+  StakeOutputParameters (..),
+  NumProposals (..),
+  ProposalParameters (..),
+  TransactionParameters (..),
+  Validity (..),
+  vote,
   mkTestTree,
-  validVoteAsDelegateParameters,
+  mkValidOwnerVoteBundle,
+  mkValidDelegateeVoteBundle,
+  transparentAssets,
+  transactionNotAuthorized,
+  voteForNonexistentOutcome,
+  noProposal,
+  moreThanOneProposals,
+  invalidLocks,
+  destroyStakes,
 ) where
 
 import Agora.Governor (Governor (..))
@@ -26,91 +36,116 @@ import Agora.Proposal.Time (
  )
 import Agora.Scripts (AgoraScripts (..))
 import Agora.Stake (
-  ProposalLock (..),
+  ProposalLock (Voted),
   StakeDatum (..),
-  StakeRedeemer (PermitVote),
+  StakeRedeemer (Destroy, PermitVote),
  )
 import Data.Default (Default (def))
 import Data.Map.Strict qualified as StrictMap
+import Data.Maybe (catMaybes)
 import Data.Tagged (untag)
 import Plutarch.Context (
   input,
+  mint,
+  normalizeValue,
   output,
   script,
   signedWith,
   timeRange,
-  txId,
-  withDatum,
+  withInlineDatum,
   withRedeemer,
   withRef,
   withValue,
  )
 import PlutusLedgerApi.V1.Value qualified as Value
-import PlutusLedgerApi.V2 (
-  Credential (PubKeyCredential),
-  PubKeyHash,
-  TxOutRef (TxOutRef),
- )
-import Sample.Proposal.Shared (proposalTxRef, stakeTxRef)
+import PlutusLedgerApi.V2 (Credential (PubKeyCredential), PubKeyHash)
+import PlutusLedgerApi.V2.Contexts (TxOutRef (TxOutRef))
+import Sample.Proposal.Shared (proposalTxRef)
 import Sample.Shared (
   agoraScripts,
   governor,
   minAda,
   proposalPolicySymbol,
   proposalValidatorHash,
-  signer,
   stakeAssetClass,
   stakeValidatorHash,
  )
-import Test.Specification (
-  SpecificationTree,
-  group,
-  testValidator,
-  validatorSucceedsWith,
- )
+import Test.Specification (SpecificationTree, group, testValidator)
 import Test.Util (
   CombinableBuilder,
   closedBoundedInterval,
   mkSpending,
   pubKeyHashes,
-  sortValue,
  )
 
--- | Reference to the proposal UTXO.
-proposalRef :: TxOutRef
-proposalRef = TxOutRef proposalTxRef 0
-
--- | Reference to the stake UTXO.
-stakeRef :: TxOutRef
-stakeRef = TxOutRef stakeTxRef 1
-
--- | Parameters for creating a voting transaction.
-data Parameters = Parameters
-  { voteFor :: ResultTag
-  -- ^ The outcome the transaction is voting for.
-  , voteCount :: Integer
-  -- ^ The count of votes.
-  , voteAsDelegate :: Bool
-  -- ^ Delegate the stake and use it to vote.
+data ParameterBundle = ParamerterBundle
+  { voteParameters :: VoteParameters
+  , stakeParameters :: StakeParameters
+  , proposalParameters :: ProposalParameters
+  , transactionParameters :: TransactionParameters
   }
 
--- | The public key hash of the stake owner.
-stakeOwner :: PubKeyHash
-stakeOwner = signer
+newtype VoteParameters = VoteParameters {voteFor :: ResultTag}
+
+data StakeParameters = StakeParameters
+  { numStakes :: Integer
+  , stakeInputParameters :: StakeInputParameters
+  , stakeOutputParameters :: StakeOutputParameters
+  }
+
+newtype StakeInputParameters = StakeInputParameters
+  { perStakeGTs :: Integer
+  }
+
+data StakeOutputParameters = StakeOutputParameters
+  { burnStakes :: Bool
+  , dontAddNewLock :: Bool
+  , changeGTAmount :: Bool
+  , changeAdaAmount :: Bool
+  }
+
+data NumProposals = NoProposal | OneProposal | MoreThanOneProposals
+
+data ProposalParameters = ProposalParameters
+  { wrongAddedVotes :: Bool
+  , numProposals :: NumProposals
+  }
+
+data SignedBy = Owner | Delegatee | Unknown
+
+newtype TransactionParameters = TransactionParameters
+  { signedBy :: SignedBy
+  }
+
+data Validity = Validity
+  { forProposalValidator :: Bool
+  , forStakeValidator :: Bool
+  }
+
+--------------------------------------------------------------------------------
+
+stakeOwner :: PubKeyHash
+stakeOwner = head pubKeyHashes
+
+delegatee :: PubKeyHash
+delegatee = pubKeyHashes !! 1
+
+unknownSig :: PubKeyHash
+unknownSig = pubKeyHashes !! 2
+
+--------------------------------------------------------------------------------
 
--- | The votes of the input proposals.
 initialVotes :: StrictMap.Map ResultTag Integer
 initialVotes =
   StrictMap.fromList
-    [ (ResultTag 0, 42)
-    , (ResultTag 1, 4242)
+    [ (ResultTag 0, 114)
+    , (ResultTag 1, 514)
     ]
 
--- | The input proposal datum.
 proposalInputDatum :: ProposalDatum
 proposalInputDatum =
   ProposalDatum
-    { proposalId = ProposalId 42
+    { proposalId = ProposalId 22
     , effects =
         StrictMap.fromList
           [ (ResultTag 0, StrictMap.empty)
@@ -124,178 +159,364 @@ proposalInputDatum =
     , startingTime = ProposalStartingTime 0
     }
 
--- | The locks of the input stake.
-existingLocks :: [ProposalLock]
-existingLocks =
-  [ Voted (ProposalId 0) (ResultTag 0)
-  , Voted (ProposalId 1) (ResultTag 2)
-  ]
+mkProposalRedeemer :: VoteParameters -> ProposalRedeemer
+mkProposalRedeemer v = Vote v.voteFor
 
-delegate :: PubKeyHash
-delegate = head pubKeyHashes
+mkProposalRef :: Integer -> TxOutRef
+mkProposalRef = TxOutRef proposalTxRef
 
-{- | Set the 'StakeDatum.stakedAmount' according to the number of votes being
-      casted.
--}
-mkStakeInputDatum :: Parameters -> StakeDatum
+numProposals :: NumProposals -> Integer
+numProposals NoProposal = 0
+numProposals OneProposal = 1
+numProposals MoreThanOneProposals = 2
+
+--------------------------------------------------------------------------------
+
+mkStakeRedeemer :: StakeOutputParameters -> StakeRedeemer
+mkStakeRedeemer params =
+  if params.burnStakes
+    then Destroy
+    else PermitVote
+
+mkStakeInputDatum :: StakeInputParameters -> StakeDatum
 mkStakeInputDatum params =
   StakeDatum
-    { stakedAmount = fromInteger params.voteCount
+    { stakedAmount = fromInteger params.perStakeGTs
     , owner = PubKeyCredential stakeOwner
-    , delegatedTo =
-        if params.voteAsDelegate
-          then Just (PubKeyCredential delegate)
-          else Nothing
-    , lockedBy = existingLocks
+    , delegatedTo = Just (PubKeyCredential delegatee)
+    , lockedBy =
+        [ Voted (ProposalId 0) (ResultTag 0)
+        , Voted (ProposalId 1) (ResultTag 2)
+        ]
     }
 
--- | Create the proposal redeemer. In this case @'Vote' _@ will always be used.
-mkProposalRedeemer :: Parameters -> ProposalRedeemer
-mkProposalRedeemer params = Vote params.voteFor
+mkStakeRef :: Integer -> Integer -> TxOutRef
+mkStakeRef o i = TxOutRef proposalTxRef $ o + i
 
--- | Place new proposal locks on the stake.
-mkNewLock :: Parameters -> ProposalLock
-mkNewLock params = Voted proposalInputDatum.proposalId params.voteFor
+--------------------------------------------------------------------------------
 
-{- | The stake redeemer that is used in 'mkTestTree'. In this case it'll always be
-      'PermitVote'.
--}
-stakeRedeemer :: StakeRedeemer
-stakeRedeemer = PermitVote
-
--- | Create a valid transaction that votes on a propsal, given the parameters.
-vote :: forall b. CombinableBuilder b => Parameters -> b
+vote :: forall b. CombinableBuilder b => ParameterBundle -> b
 vote params =
   let pst = Value.singleton proposalPolicySymbol "" 1
       sst = Value.assetClassValue stakeAssetClass 1
 
       ---
 
-      stakeInputDatum = mkStakeInputDatum params
+      stakeInputDatum =
+        mkStakeInputDatum
+          params.stakeParameters.stakeInputParameters
 
-      ---
+      stakeInputValue =
+        normalizeValue $
+          sst
+            <> Value.assetClassValue
+              (untag governor.gtClassRef)
+              params.stakeParameters.stakeInputParameters.perStakeGTs
+            <> minAda
 
-      updatedVotes :: StrictMap.Map ResultTag Integer
-      updatedVotes = StrictMap.adjust (+ params.voteCount) params.voteFor initialVotes
+      newLock =
+        Voted
+          proposalInputDatum.proposalId
+          params.voteParameters.voteFor
 
-      ---
+      updatedLocks =
+        if params.stakeParameters.stakeOutputParameters.dontAddNewLock
+          then stakeInputDatum.lockedBy
+          else newLock : stakeInputDatum.lockedBy
+
+      stakeOutputDatum = stakeInputDatum {lockedBy = updatedLocks}
+
+      stakeOutputValue =
+        let changeAmount cond = if cond then (* 100) else id
+            gtAmount =
+              changeAmount
+                params.stakeParameters.stakeOutputParameters.changeGTAmount
+                params.stakeParameters.stakeInputParameters.perStakeGTs
+            adaAmount =
+              changeAmount
+                params.stakeParameters.stakeOutputParameters.changeAdaAmount
+                10_000_000
+         in normalizeValue $
+              sst
+                <> Value.assetClassValue
+                  (untag governor.gtClassRef)
+                  gtAmount
+                <> minAda
+                <> Value.singleton "" "" adaAmount
+
+      stakeRedeemer =
+        mkStakeRedeemer params.stakeParameters.stakeOutputParameters
+
+      stakeBuilder :: b
+      stakeBuilder =
+        foldMap
+          ( \i ->
+              mconcat
+                [ input $
+                    mconcat
+                      [ script stakeValidatorHash
+                      , withValue stakeInputValue
+                      , withInlineDatum stakeInputDatum
+                      , withRedeemer stakeRedeemer
+                      , withRef $ mkStakeRef numProposals' i
+                      ]
+                , if params.stakeParameters.stakeOutputParameters.burnStakes
+                    then mint $ Value.assetClassValue stakeAssetClass (-1)
+                    else
+                      output $
+                        mconcat
+                          [ script stakeValidatorHash
+                          , withValue stakeOutputValue
+                          , withInlineDatum stakeOutputDatum
+                          ]
+                ]
+          )
+          [1 .. params.stakeParameters.numStakes]
+
+      --------------------------------------------------------------------------
+
+      numProposals' = numProposals params.proposalParameters.numProposals
+
+      updatedVotes =
+        StrictMap.adjust
+          ( ( if params.proposalParameters.wrongAddedVotes
+                then (* 10)
+                else id
+            )
+              . ( +
+                    params.stakeParameters.stakeInputParameters.perStakeGTs
+                      * params.stakeParameters.numStakes
+                )
+          )
+          params.voteParameters.voteFor
+          initialVotes
 
-      proposalOutputDatum :: ProposalDatum
       proposalOutputDatum =
         proposalInputDatum
           { votes = ProposalVotes updatedVotes
           }
 
-      ---
+      proposalRedeemer = mkProposalRedeemer params.voteParameters
 
-      -- Off-chain code should do exactly like this: prepend new lock toStatus the list.
-      updatedLocks :: [ProposalLock]
-      updatedLocks = mkNewLock params : existingLocks
+      proposalValue =
+        normalizeValue $
+          pst
+            <> minAda
 
-      ---
+      proposalBuidler :: b
+      proposalBuidler =
+        foldMap
+          ( \i ->
+              mconcat
+                [ input $
+                    mconcat
+                      [ script proposalValidatorHash
+                      , withValue proposalValue
+                      , withRedeemer proposalRedeemer
+                      , withInlineDatum proposalInputDatum
+                      , withRef $ mkProposalRef i
+                      ]
+                , output $
+                    mconcat
+                      [ script proposalValidatorHash
+                      , withValue proposalValue
+                      , withInlineDatum proposalOutputDatum
+                      ]
+                ]
+          )
+          [1 .. numProposals']
 
-      stakeOutputDatum :: StakeDatum
-      stakeOutputDatum =
-        stakeInputDatum
-          { lockedBy = updatedLocks
-          }
+      --------------------------------------------------------------------------
 
-      ---
+      sig = case params.transactionParameters.signedBy of
+        Owner -> stakeOwner
+        Delegatee -> delegatee
+        Unknown -> unknownSig
+
+      --------------------------------------------------------------------------
 
       validTimeRange =
         closedBoundedInterval
           ((def :: ProposalTimingConfig).draftTime + 1)
           ((def :: ProposalTimingConfig).votingTime - 1)
 
-      ---
+      --------------------------------------------------------------------------
 
-      stakeValue =
-        sortValue $
-          sst
-            <> Value.assetClassValue (untag governor.gtClassRef) params.voteCount
-            <> minAda
+      miscBuilder :: b
+      miscBuilder =
+        mconcat
+          [ signedWith sig
+          , timeRange validTimeRange
+          ]
 
-      signer =
-        if params.voteAsDelegate
-          then delegate
-          else stakeOwner
+      --------------------------------------------------------------------------
 
+      builder :: b
       builder =
         mconcat
-          [ txId "827598fb2d69a896bbd9e645bb14c307df907f422b39eecbe4d6329bc30b428c"
-          , signedWith signer
-          , timeRange validTimeRange
-          , input $
-              mconcat
-                [ script proposalValidatorHash
-                , withValue pst
-                , withDatum proposalInputDatum
-                , withRef proposalRef
-                , withRedeemer $ mkProposalRedeemer params
-                ]
-          , input $
-              mconcat
-                [ script stakeValidatorHash
-                , withValue stakeValue
-                , withDatum stakeInputDatum
-                , withRef stakeRef
-                ]
-          , output $
-              mconcat
-                [ script proposalValidatorHash
-                , withValue pst
-                , withDatum proposalOutputDatum
-                ]
-          , output $
-              mconcat
-                [ script stakeValidatorHash
-                , withValue stakeValue
-                , withDatum stakeOutputDatum
-                ]
+          [ stakeBuilder
+          , proposalBuidler
+          , miscBuilder
           ]
    in builder
 
----
+--------------------------------------------------------------------------------
 
--- | Valida parameters that vote on the proposal.
-validVoteParameters :: Parameters
-validVoteParameters =
-  Parameters
-    { voteFor = ResultTag 0
-    , voteCount = 27
-    , voteAsDelegate = False
-    }
-
-validVoteAsDelegateParameters :: Parameters
-validVoteAsDelegateParameters =
-  validVoteParameters
-    { voteAsDelegate = True
-    }
-
----
-
-{- | Create a test tree that runs the stake validator and proposal validator to
-      test the voting functionalities.
--}
-mkTestTree :: String -> Parameters -> Bool -> SpecificationTree
-mkTestTree name ps isValid = group name [proposal, stake]
+mkTestTree :: String -> ParameterBundle -> Validity -> SpecificationTree
+mkTestTree name ps val = group name $ catMaybes [proposal, stake]
   where
     spend = mkSpending vote ps
 
+    numProposals' = numProposals ps.proposalParameters.numProposals
+
     proposal =
-      testValidator
-        isValid
-        "proposal"
-        agoraScripts.compiledProposalValidator
-        proposalInputDatum
-        (mkProposalRedeemer ps)
-        (spend proposalRef)
+      case ps.proposalParameters.numProposals of
+        NoProposal -> Nothing
+        _ ->
+          Just $
+            testValidator
+              val.forProposalValidator
+              "proposal"
+              agoraScripts.compiledProposalValidator
+              proposalInputDatum
+              (mkProposalRedeemer ps.voteParameters)
+              (spend $ mkProposalRef 1)
 
     stake =
-      let stakeInputDatum = mkStakeInputDatum ps
-       in validatorSucceedsWith
-            "stake"
-            agoraScripts.compiledStakeValidator
-            stakeInputDatum
-            stakeRedeemer
-            (spend stakeRef)
+      case ps.stakeParameters.numStakes of
+        0 -> error "At least one stake"
+        _ ->
+          let stakeRef = mkStakeRef numProposals' 1
+           in Just $
+                testValidator
+                  val.forStakeValidator
+                  "stake"
+                  agoraScripts.compiledStakeValidator
+                  (mkStakeInputDatum ps.stakeParameters.stakeInputParameters)
+                  (mkStakeRedeemer ps.stakeParameters.stakeOutputParameters)
+                  (spend stakeRef)
+
+--------------------------------------------------------------------------------
+
+-- TODO(Connor) Use optics
+
+mkValidOwnerVoteBundle :: Integer -> ParameterBundle
+mkValidOwnerVoteBundle stakes =
+  ParamerterBundle
+    { voteParameters =
+        VoteParameters
+          { voteFor = ResultTag 0
+          }
+    , stakeParameters =
+        StakeParameters
+          { numStakes = stakes
+          , stakeInputParameters =
+              StakeInputParameters
+                { perStakeGTs = 114514
+                }
+          , stakeOutputParameters =
+              StakeOutputParameters
+                { burnStakes = False
+                , dontAddNewLock = False
+                , changeGTAmount = False
+                , changeAdaAmount = False
+                }
+          }
+    , proposalParameters =
+        ProposalParameters
+          { wrongAddedVotes = False
+          , numProposals = OneProposal
+          }
+    , transactionParameters =
+        TransactionParameters
+          { signedBy = Owner
+          }
+    }
+
+mkValidDelegateeVoteBundle :: Integer -> ParameterBundle
+mkValidDelegateeVoteBundle stakes =
+  let template = mkValidOwnerVoteBundle stakes
+   in template
+        { transactionParameters =
+            template.transactionParameters
+              { signedBy = Delegatee
+              }
+        }
+
+ownerVoteWithSignleStake :: ParameterBundle
+ownerVoteWithSignleStake = mkValidOwnerVoteBundle 1
+
+transparentAssets :: ParameterBundle
+transparentAssets =
+  ownerVoteWithSignleStake
+    { stakeParameters =
+        ownerVoteWithSignleStake.stakeParameters
+          { stakeOutputParameters =
+              ownerVoteWithSignleStake.stakeParameters.stakeOutputParameters
+                { changeAdaAmount = True
+                }
+          }
+    }
+
+transactionNotAuthorized :: ParameterBundle
+transactionNotAuthorized =
+  ownerVoteWithSignleStake
+    { transactionParameters =
+        ownerVoteWithSignleStake.transactionParameters
+          { signedBy = Unknown
+          }
+    }
+
+voteForNonexistentOutcome :: ParameterBundle
+voteForNonexistentOutcome =
+  ownerVoteWithSignleStake
+    { voteParameters =
+        ownerVoteWithSignleStake.voteParameters
+          { voteFor = ResultTag 1919810
+          }
+    }
+
+noProposal :: ParameterBundle
+noProposal =
+  ownerVoteWithSignleStake
+    { proposalParameters =
+        ownerVoteWithSignleStake.proposalParameters
+          { numProposals = NoProposal
+          }
+    }
+
+moreThanOneProposals :: ParameterBundle
+moreThanOneProposals =
+  ownerVoteWithSignleStake
+    { proposalParameters =
+        ownerVoteWithSignleStake.proposalParameters
+          { numProposals = MoreThanOneProposals
+          }
+    }
+
+ownerVoteWithMultipleStakes :: ParameterBundle
+ownerVoteWithMultipleStakes = mkValidOwnerVoteBundle 5
+
+invalidLocks :: ParameterBundle
+invalidLocks =
+  ownerVoteWithMultipleStakes
+    { stakeParameters =
+        ownerVoteWithMultipleStakes.stakeParameters
+          { stakeOutputParameters =
+              ownerVoteWithMultipleStakes.stakeParameters.stakeOutputParameters
+                { dontAddNewLock = True
+                }
+          }
+    }
+
+destroyStakes :: ParameterBundle
+destroyStakes =
+  ownerVoteWithMultipleStakes
+    { stakeParameters =
+        ownerVoteWithMultipleStakes.stakeParameters
+          { stakeOutputParameters =
+              ownerVoteWithMultipleStakes.stakeParameters.stakeOutputParameters
+                { burnStakes = True
+                }
+          }
+    }

agora-specs/Spec/Proposal.hs

@@ -12,6 +12,8 @@ import Sample.Proposal.Cosign qualified as Cosign
 import Sample.Proposal.Create qualified as Create
 import Sample.Proposal.UnlockStake qualified as UnlockStake
 import Sample.Proposal.Vote qualified as Vote
+
+-- import Sample.Proposal.UnlockStake qualified as UnlockStake
 import Test.Specification (
   SpecificationTree,
   group,
@@ -52,7 +54,7 @@ specs =
               "invalid stake locks"
               Create.addInvalidLocksParameters
               True
-              False
+              True
               False
           , Create.mkTestTree
               "has reached maximum proposals limit"
@@ -128,10 +130,54 @@ specs =
           "voting"
           [ group
               "legal"
-              [ Vote.mkTestTree "ordinary" Vote.validVoteParameters True
-              , Vote.mkTestTree "delegate" Vote.validVoteAsDelegateParameters True
+              [ group "different number of stakes" $
+                  map
+                    ( \s ->
+                        group
+                          (unwords [show s, "stakes"])
+                          [ Vote.mkTestTree
+                              "by owner"
+                              (Vote.mkValidOwnerVoteBundle s)
+                              (Vote.Validity True True)
+                          , Vote.mkTestTree
+                              "by delegatee"
+                              (Vote.mkValidDelegateeVoteBundle s)
+                              (Vote.Validity True True)
+                          ]
+                    )
+                    [1, 3, 5, 7, 9]
+              , Vote.mkTestTree
+                  "transparent non-GT tokens"
+                  Vote.transparentAssets
+                  (Vote.Validity True True)
+              ]
+          , group
+              "illegal"
+              [ Vote.mkTestTree
+                  "vote for nonexistent outcome"
+                  Vote.voteForNonexistentOutcome
+                  (Vote.Validity False True)
+              , Vote.mkTestTree
+                  "unauthorized tx"
+                  Vote.transactionNotAuthorized
+                  (Vote.Validity True False)
+              , Vote.mkTestTree
+                  "no proposal"
+                  Vote.noProposal
+                  (Vote.Validity False False)
+              , Vote.mkTestTree
+                  "more than one proposals"
+                  Vote.voteForNonexistentOutcome
+                  (Vote.Validity False True)
+              , Vote.mkTestTree
+                  "locks not added"
+                  Vote.invalidLocks
+                  (Vote.Validity True False)
+              , Vote.mkTestTree
+                  "attempt to burn stakes"
+                  Vote.destroyStakes
+                  (Vote.Validity True False)
               ]
-              -- TODO: add negative test cases
           ]
       , group
           "advancing"