add new tests for creating proposals

This commit is contained in:
Hongrui Fang 2022-07-09 03:39:54 +08:00
parent 5eee3127b2
commit 79eb0772c3
11 changed files with 593 additions and 173 deletions

View file

@ -1,115 +0,0 @@
{- |
Module : Sample.Proposal
Maintainer : emi@haskell.fyi
Description: Sample based testing for Proposal utxos
This module tests primarily the happy path for Proposal interactions
-}
module Sample.Proposal (
-- * Script contexts
proposalCreation,
) where
import Agora.Governor (GovernorDatum (..))
import Agora.Proposal (
Proposal (..),
ProposalDatum (..),
ProposalId (..),
ProposalStatus (..),
ResultTag (..),
emptyVotesFor,
)
import Data.Default.Class (Default (def))
import Plutarch.Context (
MintingBuilder,
buildMintingUnsafe,
input,
mint,
output,
script,
signedWith,
txId,
withDatum,
withTxId,
withValue,
)
import PlutusLedgerApi.V1 (
ScriptContext (..),
)
import PlutusLedgerApi.V1.Value qualified as Value (
assetClassValue,
singleton,
)
import PlutusTx.AssocMap qualified as AssocMap
import Sample.Shared (
govValidatorHash,
proposal,
proposalPolicySymbol,
proposalStartingTimeFromTimeRange,
proposalValidatorHash,
signer,
)
import Test.Util (
closedBoundedInterval,
)
proposalCreation :: ScriptContext
proposalCreation =
let st = Value.singleton proposalPolicySymbol "" 1 -- Proposal ST
effects =
AssocMap.fromList
[ (ResultTag 0, AssocMap.empty)
, (ResultTag 1, AssocMap.empty)
]
proposalDatum :: ProposalDatum
proposalDatum =
ProposalDatum
{ proposalId = ProposalId 0
, effects = effects
, status = Draft
, cosigners = [signer]
, thresholds = def
, votes = emptyVotesFor effects
, timingConfig = def
, startingTime = proposalStartingTimeFromTimeRange validTimeRange
}
govBefore :: GovernorDatum
govBefore =
GovernorDatum
{ proposalThresholds = def
, nextProposalId = ProposalId 0
, proposalTimings = def
, createProposalTimeRangeMaxWidth = def
, maximumProposalsPerStake = 3
}
govAfter :: GovernorDatum
govAfter = govBefore {nextProposalId = ProposalId 1}
validTimeRange = closedBoundedInterval 10 15
builder :: MintingBuilder
builder =
mconcat
[ txId "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be"
, signedWith signer
, mint st
, input $
script govValidatorHash
. withValue (Value.assetClassValue proposal.governorSTAssetClass 1)
. withDatum govBefore
. withTxId "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be"
, output $
script proposalValidatorHash
. withValue (st <> Value.singleton "" "" 10_000_000)
. withDatum proposalDatum
, output $
script govValidatorHash
. withValue
( Value.assetClassValue proposal.governorSTAssetClass 1
<> Value.singleton "" "" 10_000_000
)
. withDatum govAfter
]
in buildMintingUnsafe builder

View file

@ -69,7 +69,7 @@ import PlutusLedgerApi.V1 (
)
import PlutusLedgerApi.V1.Value qualified as Value
import PlutusTx.AssocMap qualified as AssocMap
import Sample.Proposal.Shared (proposalTxRef, stakeTxRef, testFunc)
import Sample.Proposal.Shared (proposalTxRef, stakeTxRef)
import Sample.Shared (
minAda,
proposalPolicySymbol,
@ -79,7 +79,7 @@ import Sample.Shared (
stakeValidatorHash,
)
import Sample.Shared qualified as Shared
import Test.Specification (SpecificationTree, group)
import Test.Specification (SpecificationTree, group, testValidator)
import Test.Util (closedBoundedInterval, pubKeyHashes, sortValue, updateMap)
-- | Parameters for state transition of proposals.
@ -512,7 +512,7 @@ mkTestTree name ps isValidForProposalValidator = group name [proposal, stake]
proposal =
let proposalInputDatum = mkProposalInputDatum ps
in testFunc
in testValidator
isValidForProposalValidator
"propsoal"
(proposalValidator Shared.proposal)
@ -527,7 +527,7 @@ mkTestTree name ps isValidForProposalValidator = group name [proposal, stake]
let idx = 0
stakeInputDatum = mkStakeInputDatums ps !! idx
isValid = not $ ps.alterOutputStakes
in testFunc
in testValidator
isValid
"stake"
(stakeValidator Shared.stake)

View file

@ -57,7 +57,7 @@ import PlutusLedgerApi.V1 (
)
import PlutusLedgerApi.V1.Value qualified as Value
import PlutusTx.AssocMap qualified as AssocMap
import Sample.Proposal.Shared (proposalTxRef, stakeTxRef, testFunc)
import Sample.Proposal.Shared (proposalTxRef, stakeTxRef)
import Sample.Shared (
minAda,
proposalPolicySymbol,
@ -71,6 +71,7 @@ import Sample.Shared qualified as Shared
import Test.Specification (
SpecificationTree,
group,
testValidator,
)
import Test.Util (closedBoundedInterval, pubKeyHashes, sortValue)
@ -317,7 +318,7 @@ mkTestTree name ps isValid = group name [proposal, stake]
proposal =
let proposalInputDatum = mkProposalInputDatum ps
in testFunc
in testValidator
isValid
"propsoal"
(proposalValidator Shared.proposal)
@ -332,7 +333,7 @@ mkTestTree name ps isValid = group name [proposal, stake]
let idx = 0
stakeInputDatum = mkStakeInputDatums ps !! idx
isValid = not ps.alterOutputStakes
in testFunc
in testValidator
isValid
"stake"
(stakeValidator Shared.stake)

View file

@ -0,0 +1,454 @@
module Sample.Proposal.Create (
Parameters (..),
mkTestTree,
totallyValidParameters,
invalidOutputGovernorDatumParameters,
useStakeOwnBySomeoneElseParameters,
invalidOutputStakeParameters,
addInvalidLocksParameters,
exceedMaximumProposalsParameters,
timeRangeNotTightParameters,
timeRangeNotClosedParameters,
invalidProposalStatusParameters,
) where
import Agora.Governor (
GovernorDatum (..),
GovernorRedeemer (CreateProposal),
)
import Agora.Governor.Scripts (governorValidator)
import Agora.Proposal (
Proposal (governorSTAssetClass),
ProposalDatum (..),
ProposalId (ProposalId),
ProposalStatus (..),
ResultTag (ResultTag),
emptyVotesFor,
)
import Agora.Proposal.Scripts (proposalPolicy)
import Agora.Proposal.Time (MaxTimeRangeWidth (MaxTimeRangeWidth), ProposalStartingTime (..))
import Agora.Stake (
ProposalLock (..),
Stake (gtClassRef),
StakeDatum (..),
StakeRedeemer (PermitVote),
)
import Agora.Stake.Scripts (stakeValidator)
import Data.Coerce (coerce)
import Data.Default (Default (def))
import Data.Tagged (Tagged, untag)
import Plutarch.Context (
BaseBuilder,
buildTxInfoUnsafe,
input,
mint,
output,
script,
signedWith,
timeRange,
txId,
withDatum,
withOutRef,
withValue,
)
import PlutusLedgerApi.V1 (
DatumHash,
POSIXTime (POSIXTime),
POSIXTimeRange,
PubKeyHash,
ScriptContext (ScriptContext),
ScriptPurpose (Minting, Spending),
TxInfo,
TxOutRef (TxOutRef),
ValidatorHash,
always,
)
import PlutusLedgerApi.V1.Value qualified as Value
import PlutusTx.AssocMap qualified as AssocMap
import Sample.Proposal.Shared (stakeTxRef)
import Sample.Shared (
govValidatorHash,
minAda,
proposal,
proposalPolicySymbol,
proposalStartingTimeFromTimeRange,
proposalValidatorHash,
signer,
signer2,
stake,
stakeAssetClass,
stakeValidatorHash,
)
import Sample.Shared qualified as Shared
import Test.Specification (SpecificationTree, group, testPolicy, testValidator)
import Test.Util (closedBoundedInterval, sortValue)
-- | Parameters for creating a proposal.
data Parameters = Parameters
{ advanceNextProposalId :: Bool
-- ^ Whether to advance 'GovernorDatum.nextProposalId'.
, createdMoreThanMaximumProposals :: Bool
-- ^ Try creating more than maximum amount of proposals.
, stakeOwnerSignsTheTransaction :: Bool
-- ^ Should the stake owner sign the transaction?
, invalidNewLocks :: Bool
-- ^ Place invalid new locks on the output stake.
, alterOutputStakeOwner :: Bool
-- ^ Whether to change the 'owner' field of the output stake datum.
, timeRangeTightEnough :: Bool
-- ^ Is 'TxInfo.validTimeRange' tight enough?
, timeRangeClosed :: Bool
-- ^ Is 'TxInfo.validTimeRange' closed?
, proposalStatus :: ProposalStatus
-- ^ The status of the newly created proposal.
}
--------------------------------------------------------------------------------
-- | See 'GovernorDatum.maximumProposalsPerStake'.
maxProposalPerStake :: Integer
maxProposalPerStake = 3
-- | The id of the proposal we are creating.
thisProposalId :: ProposalId
thisProposalId = ProposalId 25
-- | The arbitrary staked amount. Doesn;t really matter in this case.
stakedGTs :: Tagged _ Integer
stakedGTs = 5
-- | The owner of the stake.
stakeOwner :: PubKeyHash
stakeOwner = signer
{- | The invalid stake owner. If the 'alterOutputStakeOwner' is set to true,
the output stake owner will be set to this.
-}
alteredStakeOwner :: PubKeyHash
alteredStakeOwner = signer2
-- | Locks the stake that the input stake already has.
defLocks :: [ProposalLock]
defLocks = [Created (ProposalId 0)]
-- | The effect of the newly created proposal.
defEffects :: AssocMap.Map ResultTag (AssocMap.Map ValidatorHash DatumHash)
defEffects =
AssocMap.fromList
[ (ResultTag 0, AssocMap.empty)
, (ResultTag 1, AssocMap.empty)
]
--------------------------------------------------------------------------------
-- | The governor input datum.
governorInputDatum :: GovernorDatum
governorInputDatum =
GovernorDatum
{ proposalThresholds = def
, nextProposalId = thisProposalId
, proposalTimings = def
, createProposalTimeRangeMaxWidth = def
, maximumProposalsPerStake = maxProposalPerStake
}
-- | Create governor output datum given the parameters.
mkGovernorOutputDatum :: Parameters -> GovernorDatum
mkGovernorOutputDatum ps =
let nextPid =
if ps.advanceNextProposalId
then ProposalId $ coerce thisProposalId + 1
else thisProposalId
in GovernorDatum
{ proposalThresholds = def
, nextProposalId = nextPid
, proposalTimings = def
, createProposalTimeRangeMaxWidth = def
, maximumProposalsPerStake = maxProposalPerStake
}
--------------------------------------------------------------------------------
-- | Create the stake input datum given the parameters.
mkStakeInputDatum :: Parameters -> StakeDatum
mkStakeInputDatum ps =
let locks =
if ps.createdMoreThanMaximumProposals
then
Created . ProposalId
<$> take
(fromInteger maxProposalPerStake)
[1 ..]
else defLocks
in StakeDatum
{ stakedAmount = stakedGTs
, owner = stakeOwner
, lockedBy = locks
}
-- | Create the stake output datum given the parameters.
mkStakeOutputDatum :: Parameters -> StakeDatum
mkStakeOutputDatum ps =
let inputDatum = mkStakeInputDatum ps
newLocks =
if ps.invalidNewLocks
then
[ Voted thisProposalId (ResultTag 0)
, Voted thisProposalId (ResultTag 1)
]
else [Created thisProposalId]
locks = newLocks <> inputDatum.lockedBy
newOwner = mkOwner ps
in inputDatum
{ owner = newOwner
, lockedBy = locks
}
--------------------------------------------------------------------------------
{- | Create the proposal datum for the newly created proposal, given the
parameters.
-}
mkProposalOutputDatum :: Parameters -> ProposalDatum
mkProposalOutputDatum ps =
ProposalDatum
{ proposalId = thisProposalId
, effects = defEffects
, status = ps.proposalStatus
, cosigners = [mkOwner ps]
, thresholds = def
, votes = emptyVotesFor defEffects
, timingConfig = def
, startingTime = mkProposalStartingTime ps
}
--------------------------------------------------------------------------------
-- | Create time range for 'TxInfo.validTimeRange'.
mkTimeRange :: Parameters -> POSIXTimeRange
mkTimeRange ps =
if ps.timeRangeClosed
then
let s = 0
di :: POSIXTime = coerce (def @MaxTimeRangeWidth)
o = if ps.timeRangeTightEnough then (-1) else 1
in closedBoundedInterval s $ o + di
else always
-- | Get the starting time of the propsoal.
mkProposalStartingTime :: Parameters -> ProposalStartingTime
mkProposalStartingTime ps =
if ps.timeRangeClosed
then proposalStartingTimeFromTimeRange $ mkTimeRange ps
else ProposalStartingTime 0
-- | Who should be the 'owner' of the output stake.
mkOwner :: Parameters -> PubKeyHash
mkOwner ps =
if ps.alterOutputStakeOwner
then alteredStakeOwner
else stakeOwner
--------------------------------------------------------------------------------
-- | Reference to the input stake UTXO.
stakeRef :: TxOutRef
stakeRef = TxOutRef stakeTxRef 1
-- | Reference to the input governor UTXO.
governorRef :: TxOutRef
governorRef = TxOutRef "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" 3
--------------------------------------------------------------------------------
-- | Create a 'TxInfo' that spends a stake to create a new proposal.
createProposal :: Parameters -> TxInfo
createProposal ps = buildTxInfoUnsafe builder
where
pst = Value.singleton proposalPolicySymbol "" 1
sst = Value.assetClassValue stakeAssetClass 1
gst = Value.assetClassValue proposal.governorSTAssetClass 1
---
governorValue = sortValue $ gst <> minAda
stakeValue =
sortValue $
sortValue $
sst
<> Value.assetClassValue (untag stake.gtClassRef) (untag stakedGTs)
<> minAda
proposalValue = sortValue $ pst <> minAda
---
withSig =
if ps.stakeOwnerSignsTheTransaction
then signedWith stakeOwner
else mempty
---
builder :: BaseBuilder
builder =
mconcat
[ txId "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be"
, ---
withSig
, ---
mint pst
, ---
timeRange $ mkTimeRange ps
, input $
script govValidatorHash
. withValue governorValue
. withDatum governorInputDatum
. withOutRef governorRef
, output $
script govValidatorHash
. withValue governorValue
. withDatum (mkGovernorOutputDatum ps)
, ---
input $
script stakeValidatorHash
. withValue stakeValue
. withDatum (mkStakeInputDatum ps)
. withOutRef stakeRef
, output $
script stakeValidatorHash
. withValue stakeValue
. withDatum (mkStakeOutputDatum ps)
, ---
output $
script proposalValidatorHash
. withValue proposalValue
. withDatum (mkProposalOutputDatum ps)
]
--------------------------------------------------------------------------------
-- | Spend the stake with the 'PermitVote' redeemer.
stakeRedeemer :: StakeRedeemer
stakeRedeemer = PermitVote
-- | Spend the governor with the 'CreateProposal' redeemer.
governorRedeemer :: GovernorRedeemer
governorRedeemer = CreateProposal
-- | Mint the PST with an arbitrary redeemer. Doesn't really matter.
proposalPolicyRedeemer :: ()
proposalPolicyRedeemer = ()
--------------------------------------------------------------------------------
totallyValidParameters :: Parameters
totallyValidParameters =
Parameters
{ advanceNextProposalId = True
, createdMoreThanMaximumProposals = False
, stakeOwnerSignsTheTransaction = True
, invalidNewLocks = False
, alterOutputStakeOwner = False
, timeRangeTightEnough = True
, timeRangeClosed = True
, proposalStatus = Draft
}
invalidOutputGovernorDatumParameters :: Parameters
invalidOutputGovernorDatumParameters =
totallyValidParameters
{ advanceNextProposalId = False
}
useStakeOwnBySomeoneElseParameters :: Parameters
useStakeOwnBySomeoneElseParameters =
totallyValidParameters
{ stakeOwnerSignsTheTransaction = False
}
invalidOutputStakeParameters :: Parameters
invalidOutputStakeParameters =
totallyValidParameters
{ alterOutputStakeOwner = True
}
addInvalidLocksParameters :: Parameters
addInvalidLocksParameters =
totallyValidParameters
{ invalidNewLocks = True
}
exceedMaximumProposalsParameters :: Parameters
exceedMaximumProposalsParameters =
totallyValidParameters
{ createdMoreThanMaximumProposals = True
}
timeRangeNotTightParameters :: Parameters
timeRangeNotTightParameters =
totallyValidParameters
{ timeRangeTightEnough = False
}
timeRangeNotClosedParameters :: Parameters
timeRangeNotClosedParameters =
totallyValidParameters
{ timeRangeClosed = False
}
invalidProposalStatusParameters :: [Parameters]
invalidProposalStatusParameters =
map
( \st ->
totallyValidParameters {proposalStatus = st}
)
[VotingReady, Locked, Finished]
--------------------------------------------------------------------------------
{- | Create a test tree that runs the propsoal minting policy, the governor
validator and the stake validator to test the functionalities of creting
proposals
-}
mkTestTree :: String -> Parameters -> Bool -> Bool -> Bool -> SpecificationTree
mkTestTree
name
ps
validForProposalPolicy
validForGovernorValidator
validForStakeValidator =
group name [proposalTest, governorTest, stakeTest]
where
txInfo = createProposal ps
proposalTest =
testPolicy
validForProposalPolicy
"proposal"
(proposalPolicy Shared.proposal.governorSTAssetClass)
proposalPolicyRedeemer
(ScriptContext txInfo (Minting proposalPolicySymbol))
governorTest =
testValidator
validForGovernorValidator
"governor"
(governorValidator Shared.governor)
governorInputDatum
governorRedeemer
( ScriptContext
txInfo
(Spending governorRef)
)
stakeTest =
testValidator
validForStakeValidator
"stake"
(stakeValidator Shared.stake)
(mkStakeInputDatum ps)
stakeRedeemer
( ScriptContext
txInfo
(Spending stakeRef)
)

View file

@ -1,13 +1,6 @@
module Sample.Proposal.Shared (proposalTxRef, stakeTxRef, testFunc) where
module Sample.Proposal.Shared (proposalTxRef, stakeTxRef) where
import Plutarch.Api.V1 (PValidator)
import Plutarch.Lift (PUnsafeLiftDecl (..))
import PlutusLedgerApi.V1 (ScriptContext, ToData, TxId)
import Test.Specification (
SpecificationTree,
validatorFailsWith,
validatorSucceedsWith,
)
import PlutusLedgerApi.V1 (TxId)
-- | 'TxId' of all the propsoal inputs in the samples.
proposalTxRef :: TxId
@ -16,24 +9,3 @@ proposalTxRef = "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be"
-- | 'TxId' of all the stake inputs in the samples.
stakeTxRef :: TxId
stakeTxRef = "0ca36f3a357bc69579ab2531aecd1e7d3714d993c7820f40b864be15"
-- | Get the test function given whether a test case is valid.
testFunc ::
forall {datum :: PType} {redeemer :: PType}.
( PUnsafeLiftDecl datum
, PUnsafeLiftDecl redeemer
, ToData (PLifted datum)
, ToData (PLifted redeemer)
) =>
-- | Should the validator pass?
Bool ->
String ->
ClosedTerm PValidator ->
PLifted datum ->
PLifted redeemer ->
ScriptContext ->
SpecificationTree
testFunc isValid =
if isValid
then validatorSucceedsWith
else validatorFailsWith

View file

@ -55,7 +55,7 @@ import PlutusLedgerApi.V1 (
)
import PlutusLedgerApi.V1.Value qualified as Value
import PlutusTx.AssocMap qualified as AssocMap
import Sample.Proposal.Shared (stakeTxRef, testFunc)
import Sample.Proposal.Shared (stakeTxRef)
import Sample.Shared (
minAda,
proposalPolicySymbol,
@ -66,7 +66,7 @@ import Sample.Shared (
stakeValidatorHash,
)
import Sample.Shared qualified as Shared
import Test.Specification (SpecificationTree, group)
import Test.Specification (SpecificationTree, group, testValidator)
import Test.Util (sortValue, updateMap)
--------------------------------------------------------------------------------
@ -519,7 +519,7 @@ mkTestTree name ps isValid = group name [stake, proposal]
txInfo = unlockStake ps
stake =
testFunc
testValidator
(not ps.alterOutputStake)
"stake"
(stakeValidator Shared.stake)
@ -531,7 +531,7 @@ mkTestTree name ps isValid = group name [stake, proposal]
let idx = 0
pid = ProposalId $ fromIntegral idx
ref = mkProposalRef idx
in testFunc
in testValidator
isValid
"propsoal"
(proposalValidator Shared.proposal)

View file

@ -47,7 +47,7 @@ import PlutusLedgerApi.V1 (
)
import PlutusLedgerApi.V1.Value qualified as Value
import PlutusTx.AssocMap qualified as AssocMap
import Sample.Proposal.Shared (proposalTxRef, stakeTxRef, testFunc)
import Sample.Proposal.Shared (proposalTxRef, stakeTxRef)
import Sample.Shared (
minAda,
proposalPolicySymbol,
@ -61,6 +61,7 @@ import Sample.Shared qualified as Shared
import Test.Specification (
SpecificationTree,
group,
testValidator,
validatorSucceedsWith,
)
import Test.Util (closedBoundedInterval, sortValue, updateMap)
@ -243,7 +244,7 @@ mkTestTree name ps isValid = group name [proposal, stake]
txInfo = vote ps
proposal =
testFunc
testValidator
isValid
"propsoal"
(proposalValidator Shared.proposal)