Skip to content

Commit

Permalink
corpus mutation to remove reverts
Browse files Browse the repository at this point in the history
  • Loading branch information
samalws-tob committed Sep 12, 2024
1 parent 73819e3 commit c6f7aab
Show file tree
Hide file tree
Showing 3 changed files with 37 additions and 19 deletions.
12 changes: 6 additions & 6 deletions lib/Echidna/Campaign.hs
Original file line number Diff line number Diff line change
Expand Up @@ -275,7 +275,7 @@ runFuzzWorker callback vm dict workerId initialCorpus testLimit = do
| otherwise ->
lift callback >> pure TestLimitReached

fuzz = randseq vm.env.contracts >>= fmap fst . callseq vm
fuzz = randseq vm >>= fmap fst . callseq vm

-- To avoid contention we only shrink tests that were falsified by this
-- worker. Tests are marked with a worker in 'updateOpenTest'.
Expand All @@ -293,10 +293,10 @@ runFuzzWorker callback vm dict workerId initialCorpus testLimit = do
-- | Generate a new sequences of transactions, either using the corpus or with
-- randomly created transactions
randseq
:: (MonadRandom m, MonadReader Env m, MonadState WorkerState m, MonadIO m)
=> Map (Expr 'EAddr) Contract
:: (MonadRandom m, MonadReader Env m, MonadState WorkerState m, MonadIO m, MonadThrow m)
=> VM Concrete RealWorld
-> m [Tx]
randseq deployedContracts = do
randseq vm = do
env <- ask
let world = env.world

Expand All @@ -308,12 +308,12 @@ randseq deployedContracts = do
--let rs = filter (not . null) $ map (.testReproducer) $ ca._tests

-- Generate new random transactions
randTxs <- replicateM seqLen (genTx world deployedContracts)
randTxs <- replicateM seqLen (genTx world vm.env.contracts)
-- Generate a random mutator
cmut <- if seqLen == 1 then seqMutatorsStateless (fromConsts mutConsts)
else seqMutatorsStateful (fromConsts mutConsts)
-- Fetch the mutator
let mut = getCorpusMutation cmut
let mut = getCorpusMutation vm cmut
corpus <- liftIO $ readIORef env.corpusRef
if null corpus
then pure randTxs -- Use the generated random transactions
Expand Down
42 changes: 30 additions & 12 deletions lib/Echidna/Mutator/Corpus.hs
Original file line number Diff line number Diff line change
@@ -1,20 +1,26 @@
module Echidna.Mutator.Corpus where

import Control.Monad.Catch (MonadThrow)
import Control.Monad.Random.Strict (MonadRandom, getRandomR, weighted)
import Control.Monad.Reader (MonadReader, MonadIO)
import Control.Monad.ST (RealWorld)
import Data.Set (Set)
import Data.Set qualified as Set
import EVM.Types (VM, VMResult(..), VMType(..))

import Echidna.Mutator.Array
import Echidna.Transaction (mutateTx, shrinkTx)
import Echidna.Types (MutationConsts)
import Echidna.Types.Tx (Tx)
import Echidna.Types.Config (Env)
import Echidna.Types.Corpus
import Echidna.Exec (execTx)
import Echidna.Types.Tx (Tx)

defaultMutationConsts :: Num a => MutationConsts a
defaultMutationConsts = (1, 1, 1, 1)
defaultMutationConsts = (1, 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)
fromConsts (a, b, c, d, e) = let fi = fromInteger in (fi a, fi b, fi c, fi d, fi e)

data TxsMutation = Identity
| Shrinking
Expand All @@ -28,6 +34,7 @@ data CorpusMutation = RandomAppend TxsMutation
| RandomPrepend TxsMutation
| RandomSplice
| RandomInterleave
| RemoveReverting
deriving (Eq, Ord, Show)

mutator :: MonadRandom m => TxsMutation -> [Tx] -> m [Tx]
Expand Down Expand Up @@ -69,28 +76,37 @@ selectFromCorpus =
weighted . map (\(i, txs) -> (txs, fromIntegral i)) . Set.toDescList

getCorpusMutation
:: MonadRandom m
=> CorpusMutation
:: (MonadRandom m, MonadIO m, MonadReader Env m, MonadThrow m)
=> VM Concrete RealWorld
-> CorpusMutation
-> (Int -> Corpus -> [Tx] -> m [Tx])
getCorpusMutation (RandomAppend m) = mut (mutator m)
getCorpusMutation _ (RandomAppend m) = mut (mutator m)
where
mut f ql ctxs gtxs = do
rtxs' <- selectAndMutate f ctxs
pure . take ql $ rtxs' ++ gtxs
getCorpusMutation (RandomPrepend m) = mut (mutator m)
getCorpusMutation _ (RandomPrepend m) = mut (mutator m)
where
mut f ql ctxs gtxs = do
rtxs' <- selectAndMutate f ctxs
k <- getRandomR (0, ql - 1)
pure . take ql $ take k gtxs ++ rtxs'
getCorpusMutation RandomSplice = selectAndCombine spliceAtRandom
getCorpusMutation RandomInterleave = selectAndCombine interleaveAtRandom
getCorpusMutation _ RandomSplice = selectAndCombine spliceAtRandom
getCorpusMutation _ RandomInterleave = selectAndCombine interleaveAtRandom
getCorpusMutation vmInitial RemoveReverting = const . const $ filterOutTxs vmInitial where
filterOutTxs _ [] = pure []
filterOutTxs vm (tx:rest) = do
((result, _), vm') <- execTx vm tx
let append = case result of
VMSuccess _ -> [tx]
_ -> []
(append <>) <$> filterOutTxs vm' rest

seqMutatorsStateful
:: MonadRandom m
=> MutationConsts Rational
-> m CorpusMutation
seqMutatorsStateful (c1, c2, c3, c4) = weighted
seqMutatorsStateful (c1, c2, c3, c4, c5) = weighted
[(RandomAppend Identity, 800),
(RandomPrepend Identity, 200),

Expand All @@ -107,14 +123,16 @@ seqMutatorsStateful (c1, c2, c3, c4) = weighted
(RandomPrepend Deletion, c3),

(RandomSplice, c4),
(RandomInterleave, c4)
(RandomInterleave, c4),

(RemoveReverting, c5)
]

seqMutatorsStateless
:: MonadRandom m
=> MutationConsts Rational
-> m CorpusMutation
seqMutatorsStateless (c1, c2, _, _) = weighted
seqMutatorsStateless (c1, c2, _, _, _) = weighted
[(RandomAppend Identity, 800),
(RandomPrepend Identity, 200),

Expand Down
2 changes: 1 addition & 1 deletion lib/Echidna/Types.hs
Original file line number Diff line number Diff line change
Expand Up @@ -31,7 +31,7 @@ instance Exception ExecException

type Gas = Word64

type MutationConsts a = (a, a, a, a)
type MutationConsts a = (a, a, a, a, a)

-- | Transform an EVM action from HEVM to our MonadState VM
fromEVM :: (MonadIO m, MonadState (VM Concrete RealWorld) m) => EVM Concrete RealWorld r -> m r
Expand Down

0 comments on commit c6f7aab

Please sign in to comment.