mirror of https://github.com/crytic/echidna
You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
104 lines
3.5 KiB
104 lines
3.5 KiB
module Echidna.Mutator.Corpus where
|
|
|
|
import Control.Monad.State.Strict (MonadState(..))
|
|
import Control.Monad.Random.Strict (MonadRandom, getRandomR, weighted)
|
|
import Data.Has (Has(..))
|
|
import Data.Set qualified as DS
|
|
|
|
import Echidna.ABI (GenDict)
|
|
import Echidna.Mutator.Array
|
|
import Echidna.Transaction (mutateTx, shrinkTx)
|
|
import Echidna.Types.Tx (Tx)
|
|
import Echidna.Types.Corpus
|
|
|
|
type MutationConsts a = (a, a, a, a)
|
|
defaultMutationConsts :: Num a => MutationConsts a
|
|
defaultMutationConsts = (1, 1, 1, 1)
|
|
|
|
fromConsts :: Num a => MutationConsts Integer -> MutationConsts a
|
|
fromConsts (a, b, c, d) = let fi = fromInteger in (fi a, fi b, fi c, fi d)
|
|
|
|
data TxsMutation = Identity
|
|
| Shrinking
|
|
| Mutation
|
|
| Expansion
|
|
| Swapping
|
|
| Deletion
|
|
deriving (Eq, Ord, Show)
|
|
|
|
data CorpusMutation = RandomAppend TxsMutation
|
|
| RandomPrepend TxsMutation
|
|
| RandomSplice
|
|
| RandomInterleave
|
|
deriving (Eq, Ord, Show)
|
|
|
|
mutator :: MonadRandom m => TxsMutation -> [Tx] -> m [Tx]
|
|
mutator Identity = return
|
|
mutator Shrinking = mapM shrinkTx
|
|
mutator Mutation = mapM mutateTx
|
|
mutator Expansion = expandRandList
|
|
mutator Swapping = swapRandList
|
|
mutator Deletion = deleteRandList
|
|
|
|
selectAndMutate :: MonadRandom m
|
|
=> ([Tx] -> m [Tx]) -> Corpus -> m [Tx]
|
|
selectAndMutate f ctxs = do
|
|
rtxs <- weighted $ map (\(i, txs) -> (txs, fromInteger i)) $ DS.toDescList ctxs
|
|
k <- getRandomR (0, length rtxs - 1)
|
|
f $ take k rtxs
|
|
|
|
selectAndCombine :: MonadRandom m
|
|
=> ([Tx] -> [Tx] -> m [Tx]) -> Int -> Corpus -> [Tx] -> m [Tx]
|
|
selectAndCombine f ql ctxs gtxs = do
|
|
rtxs1 <- selectFromCorpus
|
|
rtxs2 <- selectFromCorpus
|
|
txs <- f rtxs1 rtxs2
|
|
return . take ql $ txs ++ gtxs
|
|
where selectFromCorpus = weighted $ map (\(i, txs) -> (txs, fromInteger i)) $ DS.toDescList ctxs
|
|
|
|
getCorpusMutation :: (MonadRandom m, Has GenDict x, MonadState x m)
|
|
=> CorpusMutation -> (Int -> Corpus -> [Tx] -> m [Tx])
|
|
getCorpusMutation (RandomAppend m) = mut (mutator m)
|
|
where mut f ql ctxs gtxs = do
|
|
rtxs' <- selectAndMutate f ctxs
|
|
return . take ql $ rtxs' ++ gtxs
|
|
getCorpusMutation (RandomPrepend m) = mut (mutator m)
|
|
where mut f ql ctxs gtxs = do
|
|
rtxs' <- selectAndMutate f ctxs
|
|
k <- getRandomR (0, ql - 1)
|
|
return . take ql $ take k gtxs ++ rtxs'
|
|
getCorpusMutation RandomSplice = selectAndCombine spliceAtRandom
|
|
getCorpusMutation RandomInterleave = selectAndCombine interleaveAtRandom
|
|
|
|
seqMutatorsStateful :: MonadRandom m => MutationConsts Rational -> m CorpusMutation
|
|
seqMutatorsStateful (c1, c2, c3, c4) = weighted
|
|
[(RandomAppend Identity, 800),
|
|
(RandomPrepend Identity, 200),
|
|
|
|
(RandomAppend Shrinking, c1),
|
|
(RandomAppend Mutation, c2),
|
|
(RandomAppend Expansion, c3),
|
|
(RandomAppend Swapping, c3),
|
|
(RandomAppend Deletion, c3),
|
|
|
|
(RandomPrepend Shrinking, c1),
|
|
(RandomPrepend Mutation, c2),
|
|
(RandomPrepend Expansion, c3),
|
|
(RandomPrepend Swapping, c3),
|
|
(RandomPrepend Deletion, c3),
|
|
|
|
(RandomSplice, c4),
|
|
(RandomInterleave, c4)
|
|
]
|
|
|
|
seqMutatorsStateless :: MonadRandom m => MutationConsts Rational -> m CorpusMutation
|
|
seqMutatorsStateless (c1, c2, _, _) = weighted
|
|
[(RandomAppend Identity, 800),
|
|
(RandomPrepend Identity, 200),
|
|
|
|
(RandomAppend Shrinking, c1),
|
|
(RandomAppend Mutation, c2),
|
|
|
|
(RandomPrepend Shrinking, c1),
|
|
(RandomPrepend Mutation, c2)
|
|
]
|
|
|