corpus mutation to remove reverts

lib/Echidna/Campaign.hs

@@ -315,7 +315,7 @@ randseq deployedContracts = do
  -- Fetch the mutator
  let mut = getCorpusMutation cmut
  corpus <- liftIO $ readIORef env.corpusRef
- if null corpus
+ if null (fst corpus)
  then pure randTxs -- Use the generated random transactions
  else mut seqLen corpus randTxs -- Apply the mutator
 
@@ -420,9 +420,14 @@ callseq vm txSeq = do
 
  -- | Add transactions to the corpus discarding reverted ones
  addToCorpus :: Int -> [(Tx, (VMResult Concrete RealWorld, Gas))] -> Corpus -> Corpus
- addToCorpus n res corpus =
- if null rtxs then corpus else Set.insert (n, rtxs) corpus
- where rtxs = fst <$> res
+ addToCorpus n res corpus@(corpusTxs, revertingTxSet) =
+ forceBoth $ if null rtxs then corpus else (Set.insert (n, rtxs) corpusTxs, Set.union revertingTxSet $ Set.fromList revertingTxsHere)
+ where
+ rtxs = fst <$> res
+ revertingTxsHere = fst <$> filter (not . isSuccess . fst . snd) res
+ isSuccess (VMSuccess _) = True
+ isSuccess _ = False
+ forceBoth both@(a,b) = a `seq` b `seq` both -- TODO not sure whether I need to do this; comment above mentions that this needs to be strict
 
 -- | Execute a transaction, capturing the PC and codehash of each instruction
 -- executed, saving the transaction if it finds new coverage.

lib/Echidna/Mutator/Corpus.hs

@@ -1,7 +1,6 @@
 module Echidna.Mutator.Corpus where
 
 import Control.Monad.Random.Strict (MonadRandom, getRandomR, weighted)
-import Data.Set (Set)
 import Data.Set qualified as Set
 
 import Echidna.Mutator.Array
@@ -11,10 +10,10 @@ import Echidna.Types.Tx (Tx)
 import Echidna.Types.Corpus
 
 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 +27,7 @@ data CorpusMutation = RandomAppend TxsMutation
  | RandomPrepend TxsMutation
  | RandomSplice
  | RandomInterleave
+ | RemoveReverts
  deriving (Eq, Ord, Show)
 
 mutator :: MonadRandom m => TxsMutation -> [Tx] -> m [Tx]
@@ -63,10 +63,10 @@ selectAndCombine f ql corpus gtxs = do
 
 selectFromCorpus
  :: MonadRandom m
- => Set (Int, [Tx])
+ => Corpus
  -> m [Tx]
 selectFromCorpus =
- weighted . map (\(i, txs) -> (txs, fromIntegral i)) . Set.toDescList
+ weighted . map (\(i, txs) -> (txs, fromIntegral i)) . Set.toDescList . fst
 
 getCorpusMutation
  :: MonadRandom m
@@ -85,12 +85,13 @@ getCorpusMutation (RandomPrepend m) = mut (mutator m)
  pure . take ql $ take k gtxs ++ rtxs'
 getCorpusMutation RandomSplice = selectAndCombine spliceAtRandom
 getCorpusMutation RandomInterleave = selectAndCombine interleaveAtRandom
+getCorpusMutation RemoveReverts = \_ (_, revertingTxs) txs -> pure $ filter (not . flip Set.member revertingTxs) txs
 
 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 +108,16 @@ seqMutatorsStateful (c1, c2, c3, c4) = weighted
  (RandomPrepend Deletion, c3),
 
  (RandomSplice, c4),
- (RandomInterleave, c4)
+ (RandomInterleave, c4),
+
+ (RemoveReverts, 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

lib/Echidna/Types/Corpus.hs

@@ -3,7 +3,8 @@ module Echidna.Types.Corpus where
 import Data.Set (Set, size)
 import Echidna.Types.Tx (Tx)
 
-type Corpus = Set (Int, [Tx])
+-- (set of transaction sequences in corpus, set of transactions that cause reverts (used for RemoveReverts))
+type Corpus = (Set (Int, [Tx]), Set Tx)
 
 corpusSize :: Corpus -> Int
-corpusSize = size
+corpusSize = size . fst

src/Main.hs

@@ -95,7 +95,7 @@ main = withUtf8 $ withCP65001 $ do
  liftIO $ writeFile file (ppTestName test <> ": " <> txsPrinted)
 
  measureIO cfg.solConf.quiet "Saving corpus" $ do
- corpus <- readIORef env.corpusRef
+ (corpus, _) <- readIORef env.corpusRef
  saveTxs env (dir </> "coverage") (snd <$> Set.toList corpus)
 
  -- TODO: We use the corpus dir to save coverage reports which is confusing.

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