Validate corpus while replaying (#1177)

lib/Echidna.hs

@@ -90,7 +90,7 @@ prepareContract env solFiles specifiedContract seed = do
   writeIORef env.testsRef echidnaTests
   pure (vm, world, dict)
 
-loadInitialCorpus :: Env -> World -> IO [[Tx]]
+loadInitialCorpus :: Env -> World -> IO [(FilePath, [Tx])]
 loadInitialCorpus env world = do
   -- load transactions from init sequence (if any)
   let sigs = Set.fromList $ concatMap NE.toList (Map.elems world.highSignatureMap)
@@ -99,7 +99,7 @@ loadInitialCorpus env world = do
       Nothing -> pure []
       Just dir -> do
         ethenos <- loadEtheno dir
-        pure [extractFromEtheno ethenos sigs]
+        pure [(dir, extractFromEtheno ethenos sigs)]
 
   persistedCorpus <-
     case env.cfg.campaignConf.corpusDir of

lib/Echidna/Campaign.hs

@@ -47,6 +47,7 @@ import Echidna.Types.Test qualified as Test
 import Echidna.Types.Tx (TxCall(..), Tx(..), call)
 import Echidna.Types.World (World)
 import Echidna.Utility (getTimestamp)
+import qualified Data.List as List
 
 instance MonadThrow m => MonadThrow (RandT g m) where
   throwM = lift . throwM
@@ -63,12 +64,17 @@ isSuccessful =
 replayCorpus
   :: (MonadIO m, MonadThrow m, MonadRandom m, MonadReader Env m, MonadState WorkerState m)
   => VM RealWorld -- ^ VM to start replaying from
-  -> [[Tx]] -- ^ corpus to replay
+  -> [(FilePath, [Tx])] -- ^ corpus to replay
   -> m ()
 replayCorpus vm txSeqs =
-  forM_ (zip [1..] txSeqs) $ \(i, txSeq) -> do
-    _ <- callseq vm txSeq
-    pushWorkerEvent (TxSequenceReplayed i (length txSeqs))
+  forM_ (zip [1..] txSeqs) $ \(i, (file, txSeq)) -> do
+    let maybeFaultyTx = List.find (\tx -> LitAddr tx.dst `notElem` Map.keys vm.env.contracts) txSeq
+    case maybeFaultyTx of
+      Nothing -> do
+        _ <- callseq vm txSeq
+        pushWorkerEvent (TxSequenceReplayed file i (length txSeqs))
+      Just faultyTx ->
+        pushWorkerEvent (TxSequenceReplayFailed file faultyTx)
 
 -- | Run a fuzzing campaign given an initial universe state, some tests, and an
 -- optional dictionary to generate calls with. Return the 'Campaign' state once
@@ -81,7 +87,8 @@ runWorker
   -> World   -- ^ Initial world state
   -> GenDict -- ^ Generation dictionary
   -> Int     -- ^ Worker id starting from 0
-  -> [[Tx]]  -- ^ Initial corpus of transactions
+  -> [(FilePath, [Tx])]
+  -- ^ Initial corpus of transactions
   -> Int     -- ^ Test limit for this worker
   -> m (WorkerStopReason, WorkerState)
 runWorker callback vm world dict workerId initialCorpus testLimit = do

lib/Echidna/Output/Corpus.hs

@@ -25,11 +25,11 @@ saveTxs dir = mapM_ saveTxSeq where
     let file = dir </> (show . abs . hash . show) txSeq <.> "txt"
     unlessM (doesFileExist file) $ encodeFile file (toJSON txSeq)
 
-loadTxs :: FilePath -> IO [[Tx]]
+loadTxs :: FilePath -> IO [(FilePath, [Tx])]
 loadTxs dir = do
   createDirectoryIfMissing True dir
   files <- listDirectory dir
-  css <- mapM readCall <$> mapM makeRelativeToCurrentDirectory files
+  css <- mapM (\file -> fmap (file,) <$> readCall file) <$> mapM makeRelativeToCurrentDirectory files
   txSeqs <- catMaybes <$> withCurrentDirectory dir css
   putStrLn ("Loaded " ++ show (length txSeqs) ++ " transaction sequences from " ++ dir)
   pure txSeqs

lib/Echidna/Server.hs

@@ -43,7 +43,8 @@ runSSEServer serverStopVar env port nworkers = do
                     TestFalsified _ -> "test_falsified"
                     TestOptimized _ -> "test_optimized"
                     NewCoverage {} -> "new_coverage"
-                    TxSequenceReplayed _ _ -> "tx_sequence_replayed"
+                    TxSequenceReplayed {} -> "tx_sequence_replayed"
+                    TxSequenceReplayFailed {} -> "tx_sequence_replay_failed"
                     WorkerStopped _ -> "worker_stopped"
                 Failure _err -> "failure"
           case campaignEvent of

lib/Echidna/Types/Campaign.hs

@@ -55,7 +55,8 @@ data WorkerEvent
   = TestFalsified !EchidnaTest
   | TestOptimized !EchidnaTest
   | NewCoverage { points :: !Int, numCodehashes :: !Int, corpusSize :: !Int, transactions :: [Tx] }
-  | TxSequenceReplayed !Int !Int
+  | TxSequenceReplayed FilePath !Int !Int
+  | TxSequenceReplayFailed FilePath Tx
   | WorkerStopped WorkerStopReason
   -- ^ This is a terminal event. Worker exits and won't push any events after
   -- this one
@@ -67,7 +68,10 @@ instance ToJSON WorkerEvent where
     TestOptimized test -> toJSON test
     NewCoverage { points, numCodehashes, corpusSize } ->
       object [ "coverage" .= points, "contracts" .= numCodehashes, "corpus_size" .= corpusSize]
-    TxSequenceReplayed current total -> object [ "current" .= current, "total" .= total ]
+    TxSequenceReplayed file current total ->
+      object [ "file" .= file, "current" .= current, "total" .= total ]
+    TxSequenceReplayFailed file tx ->
+      object [ "file" .= file, "tx" .= tx ]
     WorkerStopped reason -> object [ "reason" .= show reason ]
 
 data WorkerStopReason
@@ -94,8 +98,12 @@ ppWorkerEvent = \case
     "New coverage: " <> show points <> " instr, "
       <> show numCodehashes <> " contracts, "
       <> show corpusSize <> " seqs in corpus"
-  TxSequenceReplayed current total ->
-    "Sequence replayed from corpus (" <> show current <> "/" <> show total <> ")"
+  TxSequenceReplayed file current total ->
+    "Sequence replayed from corpus file " <> file <> " (" <> show current <> "/" <> show total <> ")"
+  TxSequenceReplayFailed file tx ->
+    "WARNING: Sequence replay from corpus file " <> file <> " failed. " <>
+    "The destination contract is not deployed for this transaction: " <> show tx <> ". " <>
+    "Remove the file or the transaction to fix the issue."
   WorkerStopped TestLimitReached ->
     "Test limit reached. Stopping."
   WorkerStopped TimeLimitReached ->

lib/Echidna/UI.hs

@@ -60,7 +60,7 @@ ui
   => VM RealWorld -- ^ Initial VM state
   -> World   -- ^ Initial world state
   -> GenDict
-  -> [[Tx]]
+  -> [(FilePath, [Tx])]
   -> m [WorkerState]
 ui vm world dict initialCorpus = do
   env <- ask

lib/Echidna/UI/Widgets.hs

@@ -107,7 +107,7 @@ campaignStatus uiState = do
   where
   mainbox inner underneath = do
     env <- ask
-    pure $ hCenter . hLimit 120 $
+    pure $ hCenter . hLimit 160 $
       joinBorders $ borderWithLabel echidnaTitle $
       summaryWidget env uiState
       <=>