fix sample tests for voting

This commit is contained in:
Hongrui Fang 2022-09-29 20:18:06 +08:00
parent 7a8e067e47
commit b2de61c16c
2 changed files with 448 additions and 181 deletions

View file

@ -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 ( module Sample.Proposal.Vote (
validVoteParameters, ParameterBundle (..),
VoteParameters (..),
StakeParameters (..),
StakeInputParameters (..),
StakeOutputParameters (..),
NumProposals (..),
ProposalParameters (..),
TransactionParameters (..),
Validity (..),
vote,
mkTestTree, mkTestTree,
validVoteAsDelegateParameters, mkValidOwnerVoteBundle,
mkValidDelegateeVoteBundle,
transparentAssets,
transactionNotAuthorized,
voteForNonexistentOutcome,
noProposal,
moreThanOneProposals,
invalidLocks,
destroyStakes,
) where ) where
import Agora.Governor (Governor (..)) import Agora.Governor (Governor (..))
@ -26,91 +36,116 @@ import Agora.Proposal.Time (
) )
import Agora.Scripts (AgoraScripts (..)) import Agora.Scripts (AgoraScripts (..))
import Agora.Stake ( import Agora.Stake (
ProposalLock (..), ProposalLock (Voted),
StakeDatum (..), StakeDatum (..),
StakeRedeemer (PermitVote), StakeRedeemer (Destroy, PermitVote),
) )
import Data.Default (Default (def)) import Data.Default (Default (def))
import Data.Map.Strict qualified as StrictMap import Data.Map.Strict qualified as StrictMap
import Data.Maybe (catMaybes)
import Data.Tagged (untag) import Data.Tagged (untag)
import Plutarch.Context ( import Plutarch.Context (
input, input,
mint,
normalizeValue,
output, output,
script, script,
signedWith, signedWith,
timeRange, timeRange,
txId, withInlineDatum,
withDatum,
withRedeemer, withRedeemer,
withRef, withRef,
withValue, withValue,
) )
import PlutusLedgerApi.V1.Value qualified as Value import PlutusLedgerApi.V1.Value qualified as Value
import PlutusLedgerApi.V2 ( import PlutusLedgerApi.V2 (Credential (PubKeyCredential), PubKeyHash)
Credential (PubKeyCredential), import PlutusLedgerApi.V2.Contexts (TxOutRef (TxOutRef))
PubKeyHash, import Sample.Proposal.Shared (proposalTxRef)
TxOutRef (TxOutRef),
)
import Sample.Proposal.Shared (proposalTxRef, stakeTxRef)
import Sample.Shared ( import Sample.Shared (
agoraScripts, agoraScripts,
governor, governor,
minAda, minAda,
proposalPolicySymbol, proposalPolicySymbol,
proposalValidatorHash, proposalValidatorHash,
signer,
stakeAssetClass, stakeAssetClass,
stakeValidatorHash, stakeValidatorHash,
) )
import Test.Specification ( import Test.Specification (SpecificationTree, group, testValidator)
SpecificationTree,
group,
testValidator,
validatorSucceedsWith,
)
import Test.Util ( import Test.Util (
CombinableBuilder, CombinableBuilder,
closedBoundedInterval, closedBoundedInterval,
mkSpending, mkSpending,
pubKeyHashes, pubKeyHashes,
sortValue,
) )
-- | Reference to the proposal UTXO. data ParameterBundle = ParamerterBundle
proposalRef :: TxOutRef { voteParameters :: VoteParameters
proposalRef = TxOutRef proposalTxRef 0 , stakeParameters :: StakeParameters
, proposalParameters :: ProposalParameters
-- | Reference to the stake UTXO. , transactionParameters :: TransactionParameters
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.
} }
-- | The public key hash of the stake owner. newtype VoteParameters = VoteParameters {voteFor :: ResultTag}
stakeOwner :: PubKeyHash
stakeOwner = signer 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.Map ResultTag Integer
initialVotes = initialVotes =
StrictMap.fromList StrictMap.fromList
[ (ResultTag 0, 42) [ (ResultTag 0, 114)
, (ResultTag 1, 4242) , (ResultTag 1, 514)
] ]
-- | The input proposal datum.
proposalInputDatum :: ProposalDatum proposalInputDatum :: ProposalDatum
proposalInputDatum = proposalInputDatum =
ProposalDatum ProposalDatum
{ proposalId = ProposalId 42 { proposalId = ProposalId 22
, effects = , effects =
StrictMap.fromList StrictMap.fromList
[ (ResultTag 0, StrictMap.empty) [ (ResultTag 0, StrictMap.empty)
@ -124,178 +159,364 @@ proposalInputDatum =
, startingTime = ProposalStartingTime 0 , startingTime = ProposalStartingTime 0
} }
-- | The locks of the input stake. mkProposalRedeemer :: VoteParameters -> ProposalRedeemer
existingLocks :: [ProposalLock] mkProposalRedeemer v = Vote v.voteFor
existingLocks =
[ Voted (ProposalId 0) (ResultTag 0)
, Voted (ProposalId 1) (ResultTag 2)
]
delegate :: PubKeyHash mkProposalRef :: Integer -> TxOutRef
delegate = head pubKeyHashes mkProposalRef = TxOutRef proposalTxRef
{- | Set the 'StakeDatum.stakedAmount' according to the number of votes being numProposals :: NumProposals -> Integer
casted. numProposals NoProposal = 0
-} numProposals OneProposal = 1
mkStakeInputDatum :: Parameters -> StakeDatum numProposals MoreThanOneProposals = 2
--------------------------------------------------------------------------------
mkStakeRedeemer :: StakeOutputParameters -> StakeRedeemer
mkStakeRedeemer params =
if params.burnStakes
then Destroy
else PermitVote
mkStakeInputDatum :: StakeInputParameters -> StakeDatum
mkStakeInputDatum params = mkStakeInputDatum params =
StakeDatum StakeDatum
{ stakedAmount = fromInteger params.voteCount { stakedAmount = fromInteger params.perStakeGTs
, owner = PubKeyCredential stakeOwner , owner = PubKeyCredential stakeOwner
, delegatedTo = , delegatedTo = Just (PubKeyCredential delegatee)
if params.voteAsDelegate , lockedBy =
then Just (PubKeyCredential delegate) [ Voted (ProposalId 0) (ResultTag 0)
else Nothing , Voted (ProposalId 1) (ResultTag 2)
, lockedBy = existingLocks ]
} }
-- | Create the proposal redeemer. In this case @'Vote' _@ will always be used. mkStakeRef :: Integer -> Integer -> TxOutRef
mkProposalRedeemer :: Parameters -> ProposalRedeemer mkStakeRef o i = TxOutRef proposalTxRef $ o + i
mkProposalRedeemer params = Vote params.voteFor
-- | 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 vote :: forall b. CombinableBuilder b => ParameterBundle -> b
'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 params = vote params =
let pst = Value.singleton proposalPolicySymbol "" 1 let pst = Value.singleton proposalPolicySymbol "" 1
sst = Value.assetClassValue stakeAssetClass 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 newLock =
updatedVotes = StrictMap.adjust (+ params.voteCount) params.voteFor initialVotes 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 = proposalOutputDatum =
proposalInputDatum proposalInputDatum
{ votes = ProposalVotes updatedVotes { votes = ProposalVotes updatedVotes
} }
--- proposalRedeemer = mkProposalRedeemer params.voteParameters
-- Off-chain code should do exactly like this: prepend new lock toStatus the list. proposalValue =
updatedLocks :: [ProposalLock] normalizeValue $
updatedLocks = mkNewLock params : existingLocks 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 = validTimeRange =
closedBoundedInterval closedBoundedInterval
((def :: ProposalTimingConfig).draftTime + 1) ((def :: ProposalTimingConfig).draftTime + 1)
((def :: ProposalTimingConfig).votingTime - 1) ((def :: ProposalTimingConfig).votingTime - 1)
--- --------------------------------------------------------------------------
stakeValue = miscBuilder :: b
sortValue $ miscBuilder =
sst mconcat
<> Value.assetClassValue (untag governor.gtClassRef) params.voteCount [ signedWith sig
<> minAda , timeRange validTimeRange
]
signer = --------------------------------------------------------------------------
if params.voteAsDelegate
then delegate
else stakeOwner
builder :: b
builder = builder =
mconcat mconcat
[ txId "827598fb2d69a896bbd9e645bb14c307df907f422b39eecbe4d6329bc30b428c" [ stakeBuilder
, signedWith signer , proposalBuidler
, timeRange validTimeRange , miscBuilder
, 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
]
] ]
in builder in builder
--- --------------------------------------------------------------------------------
-- | Valida parameters that vote on the proposal. mkTestTree :: String -> ParameterBundle -> Validity -> SpecificationTree
validVoteParameters :: Parameters mkTestTree name ps val = group name $ catMaybes [proposal, stake]
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]
where where
spend = mkSpending vote ps spend = mkSpending vote ps
numProposals' = numProposals ps.proposalParameters.numProposals
proposal = proposal =
testValidator case ps.proposalParameters.numProposals of
isValid NoProposal -> Nothing
"proposal" _ ->
agoraScripts.compiledProposalValidator Just $
proposalInputDatum testValidator
(mkProposalRedeemer ps) val.forProposalValidator
(spend proposalRef) "proposal"
agoraScripts.compiledProposalValidator
proposalInputDatum
(mkProposalRedeemer ps.voteParameters)
(spend $ mkProposalRef 1)
stake = stake =
let stakeInputDatum = mkStakeInputDatum ps case ps.stakeParameters.numStakes of
in validatorSucceedsWith 0 -> error "At least one stake"
"stake" _ ->
agoraScripts.compiledStakeValidator let stakeRef = mkStakeRef numProposals' 1
stakeInputDatum in Just $
stakeRedeemer testValidator
(spend stakeRef) 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
}
}
}

View file

@ -12,6 +12,8 @@ import Sample.Proposal.Cosign qualified as Cosign
import Sample.Proposal.Create qualified as Create import Sample.Proposal.Create qualified as Create
import Sample.Proposal.UnlockStake qualified as UnlockStake import Sample.Proposal.UnlockStake qualified as UnlockStake
import Sample.Proposal.Vote qualified as Vote import Sample.Proposal.Vote qualified as Vote
-- import Sample.Proposal.UnlockStake qualified as UnlockStake
import Test.Specification ( import Test.Specification (
SpecificationTree, SpecificationTree,
group, group,
@ -52,7 +54,7 @@ specs =
"invalid stake locks" "invalid stake locks"
Create.addInvalidLocksParameters Create.addInvalidLocksParameters
True True
False True
False False
, Create.mkTestTree , Create.mkTestTree
"has reached maximum proposals limit" "has reached maximum proposals limit"
@ -128,10 +130,54 @@ specs =
"voting" "voting"
[ group [ group
"legal" "legal"
[ Vote.mkTestTree "ordinary" Vote.validVoteParameters True [ group "different number of stakes" $
, Vote.mkTestTree "delegate" Vote.validVoteAsDelegateParameters True 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 , group
"advancing" "advancing"