add docstrings for some crucial test facilities

This commit is contained in:
Hongrui Fang 2022-07-22 21:15:09 +08:00
parent 23cc230968
commit fec3b2f13b
No known key found for this signature in database
GPG key ID: 1E0454204FC7D755
4 changed files with 157 additions and 14 deletions

View file

@ -56,14 +56,25 @@ import Sample.Shared qualified as Shared
import Test.Specification (SpecificationTree, testPolicy)
import Test.Util (CombinableBuilder, mkMinting, pubKeyHashes, sortValue)
-- | The parameters that control the generation of the transaction.
data Parameters = Parameters
{ datumThresholdsValid :: Bool
-- ^ Whether the 'GovernorDatum.proposalThresholds' field of the output
-- governor datum is valid or not.
, datumMaxTimeRangeWidthValid :: Bool
-- ^ Whether the 'GovernorDatum.maximumProposalsPerStake'field of the
-- output governor datum is valid or not.
, datumTimingConfigValid :: Bool
-- ^ Whether the 'GovernorDatum.proposalTimings'field of the output
-- governor datum is valid or not.
, withGovernorDatum :: Bool
, presentWitness :: Bool
, mintMoreThanOneStateToken :: Bool
, mintStateTokenWithName :: Bool
, -- Whether the output GST UTxO will carry the governor datum.
presentWitness :: Bool
, -- Whether to spend the UTxO referenced by 'Governor.gstOutRef'.
mintMoreThanOneStateToken :: Bool
, -- More than one GST will be minted if this is set to true.
mintStateTokenWithName :: Bool
-- The token name of the GST won't be empty if this is set to true.
}
--------------------------------------------------------------------------------
@ -126,9 +137,18 @@ mintGST ps = builder
---
governorOutputDatum =
let th = if ps.datumThresholdsValid then def else invalidProposalThresholds
trw = if ps.datumMaxTimeRangeWidthValid then def else invalidMaxTimeRangeWidth
ptc = if ps.datumTimingConfigValid then def else invalidProposalTimings
let th =
if ps.datumThresholdsValid
then def
else invalidProposalThresholds
trw =
if ps.datumMaxTimeRangeWidthValid
then def
else invalidMaxTimeRangeWidth
ptc =
if ps.datumTimingConfigValid
then def
else invalidProposalTimings
in validGovernorOutputDatum
{ proposalThresholds = th
, proposalTimings = ptc
@ -237,6 +257,9 @@ mintGSTWithNoneEmptyNameParameters =
--------------------------------------------------------------------------------
{- | Create a test tree that runs the governor policy to test the initialization
of the governor.
-}
mkTestCase :: String -> Parameters -> Bool -> SpecificationTree
mkTestCase name ps valid =
testPolicy

View file

@ -53,6 +53,7 @@ import Test.Util (CombinableBuilder, mkSpending, pubKeyHashes, sortValue, valida
--------------------------------------------------------------------------------
-- | Represent the validity property of the governor output datum.
data GovernorOutputDatumValidity
= DatumValid
| ValueInvalid
@ -60,6 +61,7 @@ data GovernorOutputDatumValidity
| NoDatum
deriving stock (Bounded, Enum)
-- | Represent the validity property of the authority token UTxO.
data GATValidity
= GATValid
| WrongTag
@ -69,11 +71,13 @@ data GATValidity
data GovernorParameters = GovernorParameters
{ governorOutputDatumValidity :: GovernorOutputDatumValidity
, stealGST :: Bool
-- ^ Send the GST to somewhere else other than the govenor validator.
}
data MockEffectParameters = MockEffectParameters
{ gatValidity :: GATValidity
, burnGAT :: Bool
-- ^ Whether to burn the GAT in the transaction or not.
}
data ParameterBundle = ParameterBundle
@ -201,6 +205,7 @@ mutate pb =
--------------------------------------------------------------------------------
-- | Run the governor to test the mutation functionality.
mkTestCase :: String -> ParameterBundle -> Validity -> SpecificationTree
mkTestCase name pb (Validity forGov) =
testValidator
@ -213,6 +218,7 @@ mkTestCase name pb (Validity forGov) =
--------------------------------------------------------------------------------
-- | The only one valid combination of all the parameters.
totallyValidBundle :: ParameterBundle
totallyValidBundle =
ParameterBundle
@ -230,6 +236,9 @@ totallyValidBundle =
--------------------------------------------------------------------------------
{- | All the invalid combination of the parameters.
TODO: use 'Gen'?
-}
invalidBundles :: [ParameterBundle]
invalidBundles = do
gdv <- enumFrom ValueInvalid

View file

@ -139,19 +139,36 @@ import Test.Util (
validatorHashes,
)
{- | A bunch of parameters that control the generation of the transaction
context.
-}
data ParameterBundle = ParameterBundle
{ proposalParameters :: ProposalParameters
-- ^ Parameters related to the the advancing proposal.
, stakeParameters :: StakeParameters
-- ^ Parameters related to stakes.
, governorParameters :: Maybe GovernorParameters
-- ^ Parameters related to GST moving. If set to 'Nothing', the GST won't
-- be moved, thus the governor validator won't be run in 'mkTestTree'.
, authorityTokenParameters :: Maybe AuthorityTokenParameters
-- ^ Parameters related to GAT minting. If set to 'Nothing', no GAT will
-- be minted, thus the GAT minting policy won't be run in 'mkTestTree'.
, transactionTimeRange :: POSIXTimeRange
-- ^ The value of 'TxInfo.txInfoValidRange', valid range of the generated
-- transaction.
, extraSignature :: Maybe PubKeyHash
-- ^ An extra signator. Intended to be used when
-- 'StakeParametersstakeParameters.transactionSignedByOwners' is set to
-- false.
}
-- | Everything about the generated governor stuff.
newtype GovernorParameters = GovernorParameters
{ invalidGovernorOutputDatum :: Bool
-- ^ The output governor datum will be changed.
}
-- | Everything about the generated authority token stuff.
data AuthorityTokenParameters = forall
(datum :: Type)
(pdatum :: S -> Type).
@ -161,21 +178,40 @@ data AuthorityTokenParameters = forall
) =>
AuthorityTokenParameters
{ mintGATsFor :: [ValidatorHash]
-- ^ GATs will be minted and sent to the given group of effects.
, carryDatum :: Maybe datum
-- ^ The datum that GAT UTxOs will be carrying.
, invalidTokenName :: Bool
-- ^ If set to true, GATs won't be tagged by their corresponding effect
-- hashes.
}
data Winner = EffectAt Index | All
-- | Represent the winning effect group(s).
data Winner
= -- | Only one effect at the given index has the highest votes.
EffectAt Index
| -- | All the effects have the same highest votes.
All
-- | Everything about the generated proposal stuff.
data ProposalParameters = ProposalParameters
{ fromStatus :: ProposalStatus
-- ^ What status is the proposal advancing from
, toStatus :: ProposalStatus
-- ^ What status is the proposal advancing to
, effectList :: [AssocMap.Map ValidatorHash DatumHash]
-- ^ The effect groups of the proposal. A neutral effect group is not
-- required here.
, winnerAndVotes :: Maybe (Winner, Integer)
-- ^ Specify the effect group(s) that have the highest votes, and the value
-- of the highest votes.
, numCosigners :: NumStake
-- ^ The number of cosigners.
, invalidProposalOutputDatum :: Bool
-- ^ Whether to make the proposal output datum invalid or not.
}
-- | Everything about the generated stake stuff.
data StakeParameters = StakeParameters
{ numStake :: NumStake
, perStakeGTs :: Integer
@ -183,9 +219,15 @@ data StakeParameters = StakeParameters
, invalidStakeOutputDatum :: Bool
}
-- | Represent the number of stakes or the number of the cosigners.
type NumStake = Int
-- | Represent an index.
type Index = Int
{- | The validity of the generated transacrion for variuos componets.
'True' means valid, 'False' means invalid.
-}
data Validity = Validity
{ forProposalValidator :: Bool
, forStakeValidator :: Bool
@ -197,12 +239,15 @@ data Validity = Validity
-- * Proposal
-- | Mock cosigners.
mkCosigners :: NumStake -> [PubKeyHash]
mkCosigners = sort . flip take pubKeyHashes
-- | Allocate the result tag for the effect at the given index.
outcomeIdxToResultTag :: Index -> ResultTag
outcomeIdxToResultTag = ResultTag . fromIntegral
-- | Add a neutral effect group and allocate result tags for the effect groups.
mkEffects ::
ProposalParameters ->
AssocMap.Map ResultTag (AssocMap.Map ValidatorHash DatumHash)
@ -212,6 +257,7 @@ mkEffects ps =
finalEffects = ps.effectList <> [neutralEffect]
in AssocMap.fromList $ zip resultTags finalEffects
-- | Set the votes of the winning group(s).
setWinner :: (Winner, Integer) -> ProposalVotes -> ProposalVotes
setWinner (All, votes) (ProposalVotes m) =
ProposalVotes $ AssocMap.mapMaybe (const $ Just votes) m
@ -219,6 +265,7 @@ setWinner (EffectAt winnerIdx, votes) (ProposalVotes m) =
let winnerResultTag = outcomeIdxToResultTag winnerIdx
in ProposalVotes $ updateMap (const $ Just votes) winnerResultTag m
-- | Mock votes for the proposal, given the parameters.
mkVotes ::
ProposalParameters ->
ProposalVotes
@ -227,9 +274,11 @@ mkVotes ps =
emptyVotes = emptyVotesFor effects
in maybe emptyVotes (`setWinner` emptyVotes) (ps.winnerAndVotes)
-- | The starting time of every generated proposal.
proposalStartingTime :: POSIXTime
proposalStartingTime = 0
-- | Create the input proposal datum given the parameters.
mkProposalInputDatum :: ProposalParameters -> ProposalDatum
mkProposalInputDatum ps =
let effects = mkEffects ps
@ -246,6 +295,7 @@ mkProposalInputDatum ps =
, startingTime = st
}
-- | Create the output proposal datum given the parameters.
mkProposalOutputDatum :: ProposalParameters -> ProposalDatum
mkProposalOutputDatum ps =
let inputDatum = mkProposalInputDatum ps
@ -262,6 +312,9 @@ mkProposalOutputDatum ps =
proposalRef :: TxOutRef
proposalRef = TxOutRef proposalTxRef 1
{- | Create a context builder that contains all the information about the
input/output of the proposal validator, given the paramters.
-}
mkProposalBuilder :: forall b. CombinableBuilder b => ProposalParameters -> b
mkProposalBuilder ps =
let pst = Value.singleton proposalPolicySymbol "" 1
@ -288,6 +341,7 @@ proposalRedeemer = AdvanceProposal
-- * Stake
-- Mock owners of the stakes.
mkStakeOwners :: NumStake -> [PubKeyHash]
mkStakeOwners = mkCosigners
@ -303,6 +357,7 @@ mkStakeInputDatums ps =
in (\owner -> template {owner = owner})
<$> mkStakeOwners ps.numStake
-- | Create the output stake datums given the parameters.
mkStakeOutputDatums :: StakeParameters -> [StakeDatum]
mkStakeOutputDatums ps =
let inputDatums = mkStakeInputDatums ps
@ -314,6 +369,9 @@ mkStakeOutputDatums ps =
modify inp = inp {stakedAmount = outputStakedAmount}
in modify <$> inputDatums
{- | Get the input stake datum given the index. The range of the index is
@[0, 'StakeParameters.numStake - 1']@
-}
getStakeInputDatumAt :: StakeParameters -> Index -> StakeDatum
getStakeInputDatumAt ps = (!!) (mkStakeInputDatums ps)
@ -321,6 +379,9 @@ getStakeInputDatumAt ps = (!!) (mkStakeInputDatums ps)
mkStakeRef :: Index -> TxOutRef
mkStakeRef = TxOutRef stakeTxRef . (+ 3) . fromIntegral
{- | Create a context builder that contains all the inputs/outputs of the
stake validator.
-}
mkStakeBuilder :: forall b. CombinableBuilder b => StakeParameters -> b
mkStakeBuilder ps =
let perStakeValue =
@ -364,6 +425,7 @@ stakeRedeemer = WitnessStake
-- * Governor
-- | The input governor datum.
governorInputDatum :: GovernorDatum
governorInputDatum =
GovernorDatum
@ -374,6 +436,7 @@ governorInputDatum =
, maximumProposalsPerStake = 3
}
-- | Create the output governor datum given the parameters.
mkGovernorOutputDatum :: GovernorParameters -> GovernorDatum
mkGovernorOutputDatum ps =
if ps.invalidGovernorOutputDatum
@ -384,6 +447,9 @@ mkGovernorOutputDatum ps =
governorRef :: TxOutRef
governorRef = TxOutRef governorTxRef 2
{- | Create a context builder that contains the input and the output of the
governor validator.
-}
mkGovernorBuilder :: forall b. CombinableBuilder b => GovernorParameters -> b
mkGovernorBuilder ps =
let gst = Value.assetClassValue govAssetClass 1
@ -411,7 +477,14 @@ governorRedeemer = MintGATs
-- * Authority Token
mkAuthorityTokenBuilder :: forall b. CombinableBuilder b => AuthorityTokenParameters -> b
{- | Create a context builder that contains the infomation about the minted
authority tokens and where they're sent to.
-}
mkAuthorityTokenBuilder ::
forall b.
CombinableBuilder b =>
AuthorityTokenParameters ->
b
mkAuthorityTokenBuilder (AuthorityTokenParameters es mdt invalidTokenName) =
foldMap perEffect es
where
@ -432,6 +505,7 @@ mkAuthorityTokenBuilder (AuthorityTokenParameters es mdt invalidTokenName) =
. withValue value
]
-- | The redeemer used while running the authority token policy.
authorityTokenRedeemer :: ()
authorityTokenRedeemer = ()
@ -456,8 +530,8 @@ advance pb =
--------------------------------------------------------------------------------
{- | Create a test tree that runs the stake validator and proposal validator to
test the advancing functionalities.
{- | Create a test tree that runs the relavant componets to test the advancing
functionalities.
-}
mkTestTree ::
String ->
@ -512,6 +586,9 @@ mkTestTree name pb val =
(mint authorityTokenSymbol)
<$ (pb.authorityTokenParameters)
{- | Create a test tree that runs a bunch of parameter bundles. These bundles
should have the same validity.
-}
mkTestTree' ::
String ->
(ParameterBundle -> String) ->
@ -626,6 +703,7 @@ getNextState = \case
Locked -> Finished
Finished -> error "Cannot advance 'Finished' proposal"
-- | Calculate the number of GTs per stake in order to exceed the minimum limit.
compPerStakeGTsForDraft :: NumStake -> Integer
compPerStakeGTsForDraft nCosigners =
untag (def :: ProposalThresholds).vote
@ -637,6 +715,7 @@ dummyDatum = ()
dummyDatumHash :: DatumHash
dummyDatumHash = datumHash $ toDatum dummyDatum
-- | Create given number of effect groups. Each group will have 3 effects.
mkMockEffects :: Int -> [AssocMap.Map ValidatorHash DatumHash]
mkMockEffects =
flip
@ -646,11 +725,21 @@ mkMockEffects =
<$> groupsOfN 3 validatorHashes
)
numberOfVotesThatExceedsTheMinimumRequirement :: Integer
numberOfVotesThatExceedsTheMinimumRequirement =
untag (def @ProposalThresholds).execute + 1
mkWinnerVotes :: Index -> (Winner, Integer)
mkWinnerVotes idx = (EffectAt idx, untag (def @ProposalThresholds).execute + 1)
mkWinnerVotes idx =
( EffectAt idx
, numberOfVotesThatExceedsTheMinimumRequirement
)
ambiguousWinnerVotes :: (Winner, Integer)
ambiguousWinnerVotes = (All, untag (def @ProposalThresholds).execute + 1)
ambiguousWinnerVotes =
( All
, numberOfVotesThatExceedsTheMinimumRequirement
)
--------------------------------------------------------------------------------
@ -663,7 +752,19 @@ ambiguousWinnerVotes = (All, untag (def @ProposalThresholds).execute + 1)
defaultWinnerIdx :: Index
defaultWinnerIdx = 0
mkValidToNextStateBundle :: Word -> Word -> ProposalStatus -> ParameterBundle
{- | Advance a proposal to the next state, perfectly valid for all the
componets.
-}
mkValidToNextStateBundle ::
-- | Number of cosigners.
Word ->
-- | Number of effects
Word ->
-- | The initial proposal state, should not be 'Finished'.
ProposalStatus ->
ParameterBundle
mkValidToNextStateBundle _ _ Finished =
error "Cannot advance from Finished"
mkValidToNextStateBundle nCosigners nEffects from =
let next = getNextState from
effects = mkMockEffects $ fromIntegral nEffects
@ -695,6 +796,7 @@ mkValidToNextStateBundle nCosigners nEffects from =
, extraSignature = Just signer
}
-- This is my favourite part of the test suite, lol.
modifyTemplate = do
when (from == Draft) $
modify $ \b ->
@ -889,7 +991,8 @@ mkAmbiguousWinnerBundle nCosigners nEffects =
-- * From Locked
mkValidFromLockedBundle :: Word -> Word -> ParameterBundle
mkValidFromLockedBundle nCosigners nEffects = mkValidToNextStateBundle nCosigners nEffects Locked
mkValidFromLockedBundle nCosigners nEffects =
mkValidToNextStateBundle nCosigners nEffects Locked
mkMintGATsForWrongEffectsBundle ::
Word ->

View file

@ -166,6 +166,7 @@ scriptCredentials = ScriptCredential <$> validatorHashes
--------------------------------------------------------------------------------
-- | Turn the given list in to groups which have the given length.
groupsOfN :: Int -> [a] -> [[a]]
groupsOfN _ [] = []
groupsOfN n xs =
@ -181,6 +182,7 @@ groupsOfN n xs =
--------------------------------------------------------------------------------
-- | Optionally apply a modifier to the given 'UTXO'.
withOptional ::
(a -> UTXO -> UTXO) ->
Maybe a ->
@ -189,6 +191,9 @@ withOptional ::
withOptional f (Just b) = f b
withOptional _ _ = id
{- | Given the builder generator and the parameters, create a 'ScriptContext'
that spends the UTXO that referenced by the given 'TxOutRef'.
-}
mkSpending ::
forall ps.
(forall b. (Monoid b, Builder b) => ps -> b) ->
@ -199,6 +204,9 @@ mkSpending mkBuilder ps oref =
buildSpendingUnsafe $
mkBuilder ps <> withSpendingOutRef oref
{- | Given the builder generator and the parameters, create a 'ScriptContext'
that mints the token of the given currency symbol.
-}
mkMinting ::
forall ps.
(forall b. (Monoid b, Builder b) => ps -> b) ->