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 13, 2024
1 parent 73819e3 commit f40bce1
Show file tree
Hide file tree
Showing 6 changed files with 26 additions and 17 deletions.
13 changes: 9 additions & 4 deletions lib/Echidna/Campaign.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down Expand Up @@ -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.
Expand Down
19 changes: 11 additions & 8 deletions lib/Echidna/Mutator/Corpus.hs
Original file line number Diff line number Diff line change
@@ -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
Expand All @@ -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
Expand All @@ -28,6 +27,7 @@ data CorpusMutation = RandomAppend TxsMutation
| RandomPrepend TxsMutation
| RandomSplice
| RandomInterleave
| RemoveReverts
deriving (Eq, Ord, Show)

mutator :: MonadRandom m => TxsMutation -> [Tx] -> m [Tx]
Expand Down Expand Up @@ -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
Expand All @@ -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),

Expand All @@ -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),

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
5 changes: 3 additions & 2 deletions lib/Echidna/Types/Corpus.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
2 changes: 1 addition & 1 deletion src/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand Down
2 changes: 1 addition & 1 deletion tests/solidity/basic/default.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down

0 comments on commit f40bce1

Please sign in to comment.