From 5ad157a67bcc74412d4370931b89905c415a597e Mon Sep 17 00:00:00 2001 From: Sam Alws Date: Thu, 12 Sep 2024 17:43:52 -0400 Subject: [PATCH] corpus mutation to remove reverts --- lib/Echidna/Campaign.hs | 12 ++++----- lib/Echidna/Mutator/Corpus.hs | 42 ++++++++++++++++++++++--------- lib/Echidna/Types.hs | 2 +- tests/solidity/basic/default.yaml | 2 +- 4 files changed, 38 insertions(+), 20 deletions(-) diff --git a/lib/Echidna/Campaign.hs b/lib/Echidna/Campaign.hs index dad687231..438bc121a 100644 --- a/lib/Echidna/Campaign.hs +++ b/lib/Echidna/Campaign.hs @@ -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'. @@ -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 @@ -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 diff --git a/lib/Echidna/Mutator/Corpus.hs b/lib/Echidna/Mutator/Corpus.hs index 757044c4e..eef37a20b 100644 --- a/lib/Echidna/Mutator/Corpus.hs +++ b/lib/Echidna/Mutator/Corpus.hs @@ -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 @@ -28,6 +34,7 @@ data CorpusMutation = RandomAppend TxsMutation | RandomPrepend TxsMutation | RandomSplice | RandomInterleave + | RemoveReverting deriving (Eq, Ord, Show) mutator :: MonadRandom m => TxsMutation -> [Tx] -> m [Tx] @@ -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), @@ -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), diff --git a/lib/Echidna/Types.hs b/lib/Echidna/Types.hs index f21232d59..f9898bcae 100644 --- a/lib/Echidna/Types.hs +++ b/lib/Echidna/Types.hs @@ -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 diff --git a/tests/solidity/basic/default.yaml b/tests/solidity/basic/default.yaml index fc52ab1cc..6e2091629 100644 --- a/tests/solidity/basic/default.yaml +++ b/tests/solidity/basic/default.yaml @@ -80,7 +80,7 @@ corpusDir: null # list of file formats to save coverage reports in; default is all possible formats coverageFormats: ["txt","html","lcov"] # constants for corpus mutations (for experimentation only) -mutConsts: [1, 1, 1, 1] +mutConsts: [1, 1, 1, 1, 1] # maximum value to send to payable functions maxValue: 100000000000000000000 # 100 eth # URL to fetch contracts over RPC