Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Hydra.Chain.Direct.Contract.Mutation
Description
Provides building blocks for Mutation testing of Contracts.
Introduction
Traditional Mutation testing is a testing technique that introduces small modifications like changing a comparison operator, or modifying constants, into a program and checks whether or not the existing tests "kill" the produced mutants, eg. fail. Mutation testing requires somewhat complex tooling because it needs to modify the source code, in limited and semantically meaningful ways in order to generate code that won't be rejected by the compiler.
Recall that Plutus eUTxO validators are boolean expressions of the form:
validator : Datum -> Redeemer -> ScriptContext -> Bool
All things being equal, "mutating" a validator so that it returns False
instead of True
can be done:
- Either by mutating the code of the
validator
implementation, - Or by mutating its arguments.
This simple idea lead to the following strategy to test-drive validator scripts:
- Start with a validator that always return
True
, - Write a positive property test checking valid transactions are accepted by the validator(s),
- Write a negative property test checking invalid transactions are rejected. This is where mutations are introduced, each different mutation type representing some possible "attack",
- Watch one or the other properties fail and enhance the validators code to make them pass,
- Rinse and repeat.
Generic Property and Mutations
Given a transaction with some UTxO context, and a function that generates SomeMutation
from a valid
transaction and context pair, the generic propMutation
property checks applying any generated mutation
makes the mutated (hence expectedly invalid) transaction fail the validation stage.
propMutation :: (Tx, Utxo) -> ((Tx, Utxo) -> Gen SomeMutation) -> Property
propMutation (tx, utxo) genMutation =
forAll _
Property (genMutation (tx, utxo)) $ SomeMutation{label, mutation} ->
(tx, utxo)
& applyMutation mutation
& propTransactionFailsPhase2
To this basic property definition we add a checkCoverage
that ensures the set of generated mutations
covers a statistically significant share of each of the various possible mutations classified by their label
.
The SomeMutation
type is simply a wrapper that attaches a label
to a proper Mutation
which is the interesting bit here.
The Mutation
type enumerates various possible "atomic" mutations which preserve the structural correctness of the transaction but should make a validator fail.
data Mutation = ChangeHeadRedeemer Head.Input | ChangeInputHeadDatum Head.State ... | Changes [Mutation]
The constructors should hopefully be self-explaining but for the last one. Some interesting mutations we want
to make require more than one "atomic" change to represent a possible validator failure. For example,
we wanted to check that the Commit
validator, in the context of a CollectCom
transaction, verifies the
state (Input
) of the Head
validator is correct. But to be interesting, this mutation needs to ensure the
transition verified by the Head
state machine is valid, which requires changing both the datum and the
redeemer of the consumed head output.
Transaction-specific Mutations
To be run the propMutation
requires a starting "healthy" (valid) transaction and a specialised generating
function. It is instantiated in the test runner by providing these two elements. For example, the ContractSpec
module has the following property check:
describe CollectCom $ do prop "does not survive random adversarial mutations" $ propMutation healthyCollectComTx genCollectComMutation
The interesting part is the genCollectComMutation
(details of the Mutation
generators are omitted):
genCollectComMutation :: (Tx, Utxo) -> Gen SomeMutation genCollectComMutation (tx, utxo) = oneof [ SomeMutation Nothing MutateOpenOutputValue . ChangeOutput ... , SomeMutation Nothing MutateOpenUtxoHash . ChangeOutput ... , SomeMutation Nothing MutateHeadTransition $ do changeRedeemer ChangeHeadRedeemer <$ ... changeDatum ChangeInputHeadDatum <$ ... pure $ Changes [changeRedeemer, changeDatum] ]
Here we have defined four different type of mutations that are interesting for the CollectCom transaction and represent possible attack vectors:
- Changing the
Head
output's value, which would imply some of the committed funds could be "stolen" by the party posting the transaction, - Tampering with the content of the UTxO committed to the Head,
- Trying to collect commits without running the
Head
validator, - Trying to collect commits in another Head state machine transition.
Running Properties
When such a property test succeeds we get the following report which shows the distribution of the various mutations that were tested.
Hydra.Chain.Direct.Contract CollectCom does not survive random adversarial mutations +++ OK, passed 200 tests. CollectComMutation (100 in total): 23% MutateNumberOfParties 22% MutateHeadTransition 21% MutateHeadId 19% MutateOpenUTxOHash 15% MutateRequiredSigner Finished in 18.1146 seconds
In the case of a failure we get a detailed report on the context of the failure.
Synopsis
- propMutation :: (Tx, UTxO) -> ((Tx, UTxO) -> Gen SomeMutation) -> Property
- propTransactionFailsPhase2 :: Maybe Text -> (Tx, UTxO) -> Property
- propTransactionEvaluates :: (Tx, UTxO) -> Property
- propTransactionFailsEvaluation :: (Tx, UTxO) -> Property
- data SomeMutation = forall lbl.(Typeable lbl, Enum lbl, Bounded lbl, Show lbl) => SomeMutation {
- expectedError :: Maybe Text
- label :: lbl
- mutation :: Mutation
- data Mutation
- = ChangeHeadRedeemer Input
- | ChangeInputHeadDatum State
- | PrependOutput (TxOut CtxTx)
- | AppendOutput (TxOut CtxTx)
- | RemoveOutput Word
- | RemoveInput TxIn
- | AddInput TxIn (TxOut CtxUTxO) (Maybe HashableScriptData)
- | ChangeInput TxIn (TxOut CtxUTxO) (Maybe HashableScriptData)
- | ChangeOutput Word (TxOut CtxTx)
- | ChangeMintedValue Value
- | ChangeRequiredSigners [Hash PaymentKey]
- | ChangeValidityInterval (TxValidityLowerBound, TxValidityUpperBound)
- | ChangeValidityLowerBound TxValidityLowerBound
- | ChangeValidityUpperBound TxValidityUpperBound
- | ChangeMintingPolicy PlutusScript
- | Changes [Mutation]
- applyMutation :: Mutation -> (Tx, UTxO) -> (Tx, UTxO)
- isHeadOutput :: TxOut CtxUTxO -> Bool
- addDatum :: TxOutDatum CtxTx -> TxBodyScriptData -> TxBodyScriptData
- changeHeadOutputDatum :: (State -> State) -> TxOut CtxTx -> TxOut CtxTx
- addParticipationTokens :: [Party] -> TxOut CtxUTxO -> TxOut CtxUTxO
- ensureDatums :: [TxOut CtxTx] -> TxBodyScriptData -> TxBodyScriptData
- alterRedeemers :: (RdmrPtr -> (Data LedgerEra, ExUnits) -> (Data LedgerEra, ExUnits)) -> TxBodyScriptData -> TxBodyScriptData
- alterTxIns :: ([(TxIn, Maybe HashableScriptData)] -> [(TxIn, Maybe HashableScriptData)]) -> Tx -> Tx
- alterTxOuts :: ([TxOut CtxTx] -> [TxOut CtxTx]) -> Tx -> Tx
- anyPayToPubKeyTxOut :: Gen (TxOut ctx)
- headTxIn :: UTxO -> TxIn
- changeMintedValueQuantityFrom :: Tx -> Integer -> Gen Mutation
- changeMintedTokens :: Tx -> Value -> Gen Mutation
- addPTWithQuantity :: Tx -> Quantity -> Gen Mutation
- replacePolicyIdWith :: PolicyId -> PolicyId -> TxOut a -> TxOut a
- replacePolicyInValue :: PolicyId -> PolicyId -> Value -> Value
- replaceSnapshotNumber :: SnapshotNumber -> State -> State
- replaceParties :: [Party] -> State -> State
- replaceUtxoHash :: Hash -> State -> State
- replaceContestationDeadline :: POSIXTime -> State -> State
- replaceContestationPeriod :: ContestationPeriod -> State -> State
- replaceHeadId :: CurrencySymbol -> State -> State
- replaceContesters :: [PubKeyHash] -> State -> State
Properties
propMutation :: (Tx, UTxO) -> ((Tx, UTxO) -> Gen SomeMutation) -> Property Source #
A Property
checking a mutation is not validated.
This property takes an initial (transaction, UTxO) pair that is supposedly valid,
passes it to a generator that produces some mutations, then assert the resulting
(transaction', UTxO') pair fails the validation process.
Note that only "level 2" validation is run, e.g the transaction is assume to be structurally valid and having passed "level 1" checks.
propTransactionFailsPhase2 :: Maybe Text -> (Tx, UTxO) -> Property Source #
Expect a phase-2 evaluation failure of given Tx
and UTxO'
.
propTransactionEvaluates :: (Tx, UTxO) -> Property Source #
Expect a given Tx
and UTxO'
to pass evaluation.
propTransactionFailsEvaluation :: (Tx, UTxO) -> Property Source #
Expect a given Tx
and UTxO'
to fail phase 1 or phase 2 evaluation.
Mutations
data SomeMutation Source #
Existential wrapper SomeMutation
and some label type.
This type is useful to provide a "generic" classification of mutation
that is controlled by some custom type. The $sel:label:SomeMutation
field can be passed
to the genericCoverTable
function to construct and display a coverage
table showing the percentage of each mutation that's been applied and
ensure significant coverage of all possible mutations using checkCoverage
.
Constructors
forall lbl.(Typeable lbl, Enum lbl, Bounded lbl, Show lbl) => SomeMutation | |
Fields
|
Instances
Show SomeMutation Source # | |
Defined in Hydra.Chain.Direct.Contract.Mutation |
Basic mutations
Constructors
ChangeHeadRedeemer Input | Changes the |
ChangeInputHeadDatum State | Changes the spent |
PrependOutput (TxOut CtxTx) | Adds given output as first transaction output. |
AppendOutput (TxOut CtxTx) | Adds given output as last transaction output. |
RemoveOutput Word | Removes given output from the transaction's outputs. |
RemoveInput TxIn | Drops the given input from the transaction's inputs |
AddInput TxIn (TxOut CtxUTxO) (Maybe HashableScriptData) | Adds given UTxO to the transaction's inputs and UTxO context. |
ChangeInput TxIn (TxOut CtxUTxO) (Maybe HashableScriptData) | Change an input's This expects XXX: This is likely incomplete as it can not add the datum for given txout. |
ChangeOutput Word (TxOut CtxTx) | Change the transaction's output at given index to something else. |
ChangeMintedValue Value | Change the transaction's minted values if it is actually minting
something. NOTE: If |
ChangeRequiredSigners [Hash PaymentKey] | Change required signers on a transaction' |
ChangeValidityInterval (TxValidityLowerBound, TxValidityUpperBound) | Change the validity interval of the transaction. |
ChangeValidityLowerBound TxValidityLowerBound | |
ChangeValidityUpperBound TxValidityUpperBound | |
ChangeMintingPolicy PlutusScript | Change the included minting policy (the first minted policy) and update minted/burned and output values of this policy. |
Changes [Mutation] | Applies several mutations as a single atomic |
Instances
applyMutation :: Mutation -> (Tx, UTxO) -> (Tx, UTxO) Source #
Apply a single Mutation
to the given (transaction, UTxO) pair.
''NOTE''
: This function is partial, it can raise error
when some preconditions
are not met by the transaction or UTxO set, for example if there's no
Head script input or no datums in the transaction.
Orphans
Helpers
isHeadOutput :: TxOut CtxUTxO -> Bool Source #
Identify Head script's output.
addDatum :: TxOutDatum CtxTx -> TxBodyScriptData -> TxBodyScriptData Source #
Adds given Datum
and corresponding hash to the transaction's scripts.
TODO: As we are creating the TxOutDatum
from a known datum, passing a TxOutDatum
is
pointless and requires more work than needed to check impossible variants.
changeHeadOutputDatum :: (State -> State) -> TxOut CtxTx -> TxOut CtxTx Source #
addParticipationTokens :: [Party] -> TxOut CtxUTxO -> TxOut CtxUTxO Source #
ensureDatums :: [TxOut CtxTx] -> TxBodyScriptData -> TxBodyScriptData Source #
Ensures the included datums of given TxOut
s are included in the transactions' TxBodyScriptData
.
alterRedeemers :: (RdmrPtr -> (Data LedgerEra, ExUnits) -> (Data LedgerEra, ExUnits)) -> TxBodyScriptData -> TxBodyScriptData Source #
Alter a transaction's redeemers map given some mapping function.
alterTxIns :: ([(TxIn, Maybe HashableScriptData)] -> [(TxIn, Maybe HashableScriptData)]) -> Tx -> Tx Source #
Alter the tx inputs in such way that redeemer pointer stay consistent. A
value of Nothing
for the redeemr means that this is not a script input.
NOTE: This will reset all the execution budgets to 0.
alterTxOuts :: ([TxOut CtxTx] -> [TxOut CtxTx]) -> Tx -> Tx Source #
Apply some mapping function over a transaction's outputs.
anyPayToPubKeyTxOut :: Gen (TxOut ctx) Source #
Generates an output that pays to some arbitrary pubkey.
headTxIn :: UTxO -> TxIn Source #
Finds the Head script's input in given UTxO'
set.
''NOTE''
: This function is partial, it assumes the UTxO'
set contains a
Head script output.
changeMintedValueQuantityFrom :: Tx -> Integer -> Gen Mutation Source #
A Mutation
that changes the minted/burnt quantity of all tokens to a
non-zero value different than the given one.
changeMintedTokens :: Tx -> Value -> Gen Mutation Source #
A Mutation
that changes the minted/burned quantity of tokens like this:
- when no value is being minted/burned -> add a value
- when tx is minting or burning values -> add more values on top of that
addPTWithQuantity :: Tx -> Quantity -> Gen Mutation Source #
A Mutation
that adds an Arbitrary
participation token with some quantity.
As usual the quantity can be positive for minting, or negative for burning.
replacePolicyIdWith :: PolicyId -> PolicyId -> TxOut a -> TxOut a Source #
Replace first given PolicyId
with the second argument in the whole TxOut
value.
replacePolicyInValue :: PolicyId -> PolicyId -> Value -> Value Source #
Replace first given PolicyId
with the second argument in the whole Value
.
replaceSnapshotNumber :: SnapshotNumber -> State -> State Source #
replaceParties :: [Party] -> State -> State Source #
replaceUtxoHash :: Hash -> State -> State Source #
replaceContestationDeadline :: POSIXTime -> State -> State Source #
replaceContestationPeriod :: ContestationPeriod -> State -> State Source #
replaceHeadId :: CurrencySymbol -> State -> State Source #
replaceContesters :: [PubKeyHash] -> State -> State Source #