From 8d25e6414f5033e84f1e727e7d3fb8ecda7109a7 Mon Sep 17 00:00:00 2001
From: Sam Alws <sam.alws@trailofbits.com>
Date: Fri, 14 Jun 2024 16:54:27 -0400
Subject: [PATCH] emit saved reproducer log message as event rather than
 putstrln

---
 lib/Echidna/Output/Corpus.hs  | 7 ++++---
 lib/Echidna/Server.hs         | 5 +++++
 lib/Echidna/Types/Campaign.hs | 2 ++
 src/Main.hs                   | 4 ++--
 4 files changed, 13 insertions(+), 5 deletions(-)

diff --git a/lib/Echidna/Output/Corpus.hs b/lib/Echidna/Output/Corpus.hs
index 258041197..4151d14b3 100644
--- a/lib/Echidna/Output/Corpus.hs
+++ b/lib/Echidna/Output/Corpus.hs
@@ -18,12 +18,13 @@ import Echidna.Types.Test (EchidnaTest(..))
 import Echidna.Types.Tx (Tx)
 import Echidna.Utility (listDirectory, withCurrentDirectory)
 
-saveTxs :: FilePath -> [[Tx]] -> IO ()
-saveTxs dir = mapM_ saveTxSeq where
+saveTxs :: Env -> FilePath -> [[Tx]] -> IO ()
+saveTxs env dir = mapM_ saveTxSeq where
   saveTxSeq txSeq = do
     createDirectoryIfMissing True dir
     let file = dir </> (show . abs . hash . show) txSeq <.> "txt"
     unlessM (doesFileExist file) $ encodeFile file (toJSON txSeq)
+    pushCampaignEvent env (ReproducerSaved file)
 
 loadTxs :: FilePath -> IO [(FilePath, [Tx])]
 loadTxs dir = do
@@ -58,7 +59,7 @@ saveCorpusEvent env (_time, campaignEvent) = do
 
     saveFile dir (subdir, txs) =
       unless (null txs) $
-        handle exceptionHandler $ saveTxs (dir </> subdir) [txs]
+        handle exceptionHandler $ saveTxs env (dir </> subdir) [txs]
 
     exceptionHandler (e :: IOException) =
       pushCampaignEvent env (Failure $ "Problem while writing to file: " ++ show e)
diff --git a/lib/Echidna/Server.hs b/lib/Echidna/Server.hs
index 73d4592f6..6827f790c 100644
--- a/lib/Echidna/Server.hs
+++ b/lib/Echidna/Server.hs
@@ -30,6 +30,10 @@ instance ToJSON SSE where
     object [ "timestamp" .= time
            , "data" .= reason
            ]
+  toJSON (SSE (time, ReproducerSaved filename)) =
+    object [ "timestamp" .= time
+           , "filename" .= filename
+           ]
 
 runSSEServer :: MVar () -> Env -> Word16 -> Int -> IO ()
 runSSEServer serverStopVar env port nworkers = do
@@ -53,6 +57,7 @@ runSSEServer serverStopVar env port nworkers = do
                     TxSequenceReplayFailed {} -> "tx_sequence_replay_failed"
                     WorkerStopped _ -> "worker_stopped"
                 Failure _err -> "failure"
+                ReproducerSaved _ -> "saved_reproducer"
           case campaignEvent of
             WorkerEvent _ _ (WorkerStopped _) -> do
               aliveAfter <- atomicModifyIORef' aliveRef (\n -> (n-1, n-1))
diff --git a/lib/Echidna/Types/Campaign.hs b/lib/Echidna/Types/Campaign.hs
index 6a9a1521a..b59815bd3 100644
--- a/lib/Echidna/Types/Campaign.hs
+++ b/lib/Echidna/Types/Campaign.hs
@@ -72,6 +72,7 @@ type WorkerId = Int
 data CampaignEvent
   = WorkerEvent WorkerId WorkerType WorkerEvent
   | Failure String
+  | ReproducerSaved String -- filename
 
 data WorkerEvent
   = TestFalsified !EchidnaTest
@@ -111,6 +112,7 @@ ppCampaignEvent :: CampaignEvent -> String
 ppCampaignEvent = \case
   WorkerEvent _ _ e -> ppWorkerEvent e
   Failure err -> err
+  ReproducerSaved f -> "Saved reproducer to " <> f
 
 ppWorkerEvent :: WorkerEvent -> String
 ppWorkerEvent = \case
diff --git a/src/Main.hs b/src/Main.hs
index 36e33665c..d64f4023a 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -81,7 +81,7 @@ main = withUtf8 $ withCP65001 $ do
     Nothing -> pure ()
     Just dir -> do
       measureIO cfg.solConf.quiet "Saving test reproducers" $
-        saveTxs (dir </> "reproducers") (filter (not . null) $ (.reproducer) <$> tests)
+        saveTxs env (dir </> "reproducers") (filter (not . null) $ (.reproducer) <$> tests)
 
       saveTracesEnabled <- lookupEnv "ECHIDNA_SAVE_TRACES"
       when (isJust saveTracesEnabled) $ do
@@ -98,7 +98,7 @@ main = withUtf8 $ withCP65001 $ do
 
       measureIO cfg.solConf.quiet "Saving corpus" $ do
         corpus <- readIORef env.corpusRef
-        saveTxs (dir </> "coverage") (snd <$> Set.toList corpus)
+        saveTxs env (dir </> "coverage") (snd <$> Set.toList corpus)
 
       -- TODO: We use the corpus dir to save coverage reports which is confusing.
       -- Add config option to pass dir for saving coverage report and decouple it