corpus mutation to remove reverts

Author: samalws-tob

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