corpus mutation to remove reverts

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

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),
 

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