fix sample tests for voting
This commit is contained in:
parent
7a8e067e47
commit
b2de61c16c
2 changed files with 448 additions and 181 deletions
|
|
@ -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
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
|
||||||
|
|
@ -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"
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue