Added basic functionality for tracking inputs that get a high amount of unique coverage.

lib/Echidna/Exec.hs

@@ -1,7 +1,7 @@
 {-# LANGUAGE FlexibleContexts, KindSignatures, LambdaCase, StrictData #-}
 
 module Echidna.Exec (
-    Coverage
+    ExecEnv(..)
   , checkETest
   , eCommand
   , eCommandCoverage
@@ -10,12 +10,14 @@ module Echidna.Exec (
   , execCall
   , execCallCoverage
   , fuzz
+  , mutateGoodInputs
   , module Echidna.Internal.Runner
   ) where
 
 import Control.Concurrent.MVar    (MVar, takeMVar, putMVar)
+import Control.Concurrent.Chan    (Chan, writeChan, readChan)
 import Control.Lens               ((^.), (.=), use)
-import Control.Monad              (forM_, replicateM)
+import Control.Monad              (forM_, replicateM, forever)
 import Control.Monad.Catch        (MonadCatch)
 import Control.Monad.IO.Class     (MonadIO, liftIO)
 import Control.Monad.State.Strict (MonadState, StateT, evalState, evalStateT, execState, runState)
@@ -23,7 +25,7 @@ import Control.Monad.Reader       (MonadReader, ReaderT, runReaderT, ask)
 import Data.IORef                 (IORef, modifyIORef', newIORef, readIORef)
 import Data.List                  (intercalate)
 import Data.Maybe                 (listToMaybe)
-import Data.MultiSet              (MultiSet, insert, union)
+import Data.Set                   (Set, insert, union, size, difference)
 import Data.Text                  (Text)
 import Data.Typeable              (Typeable)
 import Data.Vector                (fromList)
@@ -44,9 +46,35 @@ import EVM.Exec     (exec)
 import Echidna.ABI (SolCall, SolSignature, displayAbiCall, encodeSig, genInteractions)
 import Echidna.Internal.Runner
 
-type Coverage = MultiSet Int
+  
+data ExecEnv = ExecEnv
+  { coverage :: Coverage --Cumulative coverage accross all tests
+  , recent   :: [Int] -- Coverage for previous 10 tests
+  , avg      :: Float -- Moving average of coverage for prior tests
+  }  
+
+type Coverage    = Set Int      
 type CoverageRef = IORef Coverage
 
+--This doesn't do anything right now... but it will be a thread that processes inputs
+--deemed interesting from a channel
+mutateGoodInputs :: Chan [SolSignature] -> IO ()
+mutateGoodInputs c = forever $ do
+  input <- readChan c
+  return ()
+
+updateExecEnv :: ExecEnv -> Coverage -> ExecEnv
+updateExecEnv ExecEnv{coverage = c, recent = r, avg = a} cov = ExecEnv { coverage = c', recent = r', avg = a'}
+  where c' = union c cov
+        r' = (size cov) : (take 5 r)
+        a' = fromIntegral $ (sum r) `div` (length r)
+
+-- Use to determine if input is worth handing off to the "good input" pool for mutation
+-- Currently just sees if current input has higher than avg new pc's
+isInteresting :: ExecEnv -> Coverage -> Bool
+isInteresting e c = if fromIntegral (size new) > avg e then True else False
+  where new = coverage e `difference` c
+
 execCallUsing :: MonadState VM m => m VMResult -> SolCall -> m VMResult
 execCallUsing m (t,vs) = cleanUp >> (state . calldata .= cd >> m) where
   cd = B . abiCalldata (encodeSig t $ abiValueType <$> vs) $ fromList vs
@@ -146,21 +174,23 @@ ePropertySeq :: (VM -> Bool)   -- Predicate to fuzz for violations of
 ePropertySeq p ts = ePropertyUsing (eCommand p ts) id             
 
 
-ePropertySeqCoverage :: MVar Coverage
+ePropertySeqCoverage :: MVar ExecEnv
+                     -> Chan [SolSignature]
                      -> (VM -> Bool)
                      -> [SolSignature]
                      -> VM
                      -> Int
                      -> Property
-ePropertySeqCoverage globalCovRef p ts v = ePropertyUsing (eCommandCoverage p ts) writeCoverage v where
+ePropertySeqCoverage execEnvRef goodInputs p ts v = ePropertyUsing (eCommandCoverage p ts) writeCoverage v where
   writeCoverage :: MonadIO m => ReaderT CoverageRef (StateT VM m) a -> m a
   writeCoverage m = do
     threadCovRef <- liftIO $ newIORef mempty
     let s = runReaderT m threadCovRef
-    a            <- evalStateT s v
-    threadCov    <- liftIO $ readIORef threadCovRef
-    globalCov    <- liftIO $ takeMVar globalCovRef
-    liftIO $ putMVar globalCovRef (union threadCov globalCov)
+    a          <- evalStateT s v
+    threadCov  <- liftIO $ readIORef threadCovRef
+    execEnv    <- liftIO $ takeMVar execEnvRef
+    liftIO $ if isInteresting execEnv threadCov then writeChan goodInputs ts else return ()
+    liftIO $ putMVar execEnvRef (updateExecEnv execEnv threadCov)
     return a
   
 

src/Main.hs

@@ -2,9 +2,12 @@
 
 module Main where
 
+import Control.Concurrent      (forkIO)
 import Control.Concurrent.MVar (takeMVar, newMVar)
+import Control.Concurrent.Chan (newChan)
 import Data.Maybe              (listToMaybe)
-import Data.MultiSet           (distinctSize)
+import Data.Set                (size)
+--import Data.MultiSet           (distinctSize)
 import Data.Text               (pack)
 import System.Environment      (getArgs)
 
@@ -18,12 +21,14 @@ main :: IO ()
 main = getArgs >>= \case
   []  -> putStrLn "Please provide a solidity file to analyze"
   filepath:args -> do
-    (v,a,ts) <- loadSolidity filepath $ pack <$> listToMaybe args
-    r        <- newMVar (mempty :: Coverage)
+    (v,a,ts)   <- loadSolidity filepath $ pack <$> listToMaybe args
+    execEnvRef <- newMVar $ ExecEnv {coverage = mempty, recent = [0,0,0,0,0,0], avg = 0}
+    goodInputs <- newChan
+    _          <- forkIO $ mutateGoodInputs goodInputs
     let prop t = (PropertyName $ show t
-                 , ePropertySeqCoverage r (flip checkETest t) a v 10
+                 , ePropertySeqCoverage execEnvRef goodInputs (flip checkETest t) a v 10
                  )
     _ <- checkParallel . Group (GroupName filepath) $ map prop ts
-    l <- distinctSize <$> takeMVar r
+    l <- size . coverage <$> takeMVar execEnvRef
     putStrLn $ "Coverage: " ++ show l ++ " unique PCs"
     return ()