From 68f7f82e8a67e414c8c0037fa9d45355085e041b Mon Sep 17 00:00:00 2001 From: Hongrui Fang Date: Thu, 29 Sep 2022 20:18:06 +0800 Subject: [PATCH] fix sample tests for voting --- agora-specs/Sample/Proposal/Vote.hs | 575 +++++++++++++++++++--------- agora-specs/Spec/Proposal.hs | 54 ++- 2 files changed, 448 insertions(+), 181 deletions(-) diff --git a/agora-specs/Sample/Proposal/Vote.hs b/agora-specs/Sample/Proposal/Vote.hs index 56a0dd4..2246894 100644 --- a/agora-specs/Sample/Proposal/Vote.hs +++ b/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 + } + } + } diff --git a/agora-specs/Spec/Proposal.hs b/agora-specs/Spec/Proposal.hs index 597ebcf..4a30c7f 100644 --- a/agora-specs/Spec/Proposal.hs +++ b/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"