diff --git a/lib/Echidna/Async.hs b/lib/Echidna/Async.hs
new file mode 100644
index 000000000..95fe43847
--- /dev/null
+++ b/lib/Echidna/Async.hs
@@ -0,0 +1,46 @@
+module Echidna.Async where
+
+import Control.Concurrent (threadDelay, forkFinally)
+import Control.Monad (void, when)
+import Control.Monad.Reader (MonadReader, asks, ask)
+import Control.Monad.State.Strict (MonadState, gets)
+import Control.Monad.IO.Class (MonadIO, liftIO)
+import Data.IORef (atomicModifyIORef', readIORef)
+import Data.Time (LocalTime)
+
+import Echidna.Types.Campaign (CampaignEvent, WorkerState(..))
+import Echidna.Types.Config (Env(..))
+import Echidna.Utility (getTimestamp)
+
+awaitThreads :: Env -> IO ()
+awaitThreads env = do
+  n <- readIORef env.numUnfinishedThreads
+  when (n > 0) $ threadDelay 10_000 >> awaitThreads env
+
+spawnThread :: Env -> IO () -> IO ()
+spawnThread env io = do
+  atomicModifyIORef' env.numUnfinishedThreads (\n -> (n+1, ()))
+  void $ forkFinally io (const $ atomicModifyIORef' env.numUnfinishedThreads (\n -> (n-1, ())))
+
+addEventHandler
+  :: (MonadReader Env m, MonadIO m)
+  => ((Int, LocalTime, CampaignEvent) -> IO ())
+  -> m ()
+addEventHandler f = do
+  handlersRef <- asks (.eventHandlers)
+  liftIO $ atomicModifyIORef' handlersRef (\l -> (f:l, ()))
+
+pushEvent
+  :: (MonadReader Env m, MonadState WorkerState m, MonadIO m)
+  => CampaignEvent
+  -> m ()
+pushEvent event = do
+  workerId <- gets (.workerId)
+  env <- ask
+  liftIO $ pushEventIO env workerId event
+
+pushEventIO :: Env -> Int -> CampaignEvent -> IO ()
+pushEventIO env workerId event = do
+  time <- liftIO getTimestamp
+  handlers <- readIORef env.eventHandlers
+  mapM_ ($ (workerId, time, event)) handlers
diff --git a/lib/Echidna/Campaign.hs b/lib/Echidna/Campaign.hs
index 3beedb00b..19b63af60 100644
--- a/lib/Echidna/Campaign.hs
+++ b/lib/Echidna/Campaign.hs
@@ -4,7 +4,6 @@ module Echidna.Campaign where
 
 import Optics.Core hiding ((|>))
 
-import Control.Concurrent (writeChan)
 import Control.DeepSeq (force)
 import Control.Monad (replicateM, when, void, forM_)
 import Control.Monad.Catch (MonadCatch(..), MonadThrow(..))
@@ -30,6 +29,7 @@ import EVM.ABI (getAbi, AbiType(AbiAddressType), AbiValue(AbiAddress))
 import EVM.Types (Addr, Expr(ConcreteBuf))
 
 import Echidna.ABI
+import Echidna.Async (pushEvent)
 import Echidna.Exec
 import Echidna.Events (extractEvents)
 import Echidna.Mutator.Corpus
@@ -47,7 +47,6 @@ import Echidna.Types.Test
 import Echidna.Types.Test qualified as Test
 import Echidna.Types.Tx (TxCall(..), Tx(..), call)
 import Echidna.Types.World (World)
-import Echidna.Utility (getTimestamp)
 
 instance MonadThrow m => MonadThrow (RandT g m) where
   throwM = lift . throwM
@@ -242,7 +241,7 @@ callseq vm txSeq = do
 
     cov <- liftIO . readIORef =<< asks (.coverageRef)
     points <- liftIO $ scoveragePoints cov
-    pushEvent (NewCoverage points (length cov) newSize)
+    pushEvent (NewCoverage points (length cov) newSize (fst <$> res))
 
   -- Update the campaign state
   put campaign'
@@ -392,13 +391,3 @@ updateTest vmForShrink (vm, xs) test = do
       -- but requires passing `vmForShrink` and feels a bit wrong.
       shrinkTest vmForShrink test
     _ -> pure Nothing
-
-pushEvent
-  :: (MonadReader Env m, MonadState WorkerState m, MonadIO m)
-  => CampaignEvent
-  -> m ()
-pushEvent event = do
-  workerId <- gets (.workerId)
-  time <- liftIO getTimestamp
-  chan <- asks (.eventQueue)
-  liftIO $ writeChan chan (workerId, time, event)
diff --git a/lib/Echidna/Output/Corpus.hs b/lib/Echidna/Output/Corpus.hs
index c1df732fc..51513fade 100644
--- a/lib/Echidna/Output/Corpus.hs
+++ b/lib/Echidna/Output/Corpus.hs
@@ -1,5 +1,8 @@
 module Echidna.Output.Corpus where
 
+import Control.Monad (unless)
+import Control.Monad.Reader (MonadReader, ask)
+import Control.Monad.IO.Class (MonadIO)
 import Control.Monad.Extra (unlessM)
 import Data.Aeson (ToJSON(..), decodeStrict, encodeFile)
 import Data.ByteString qualified as BS
@@ -8,6 +11,10 @@ import Data.Maybe (catMaybes)
 import System.Directory (createDirectoryIfMissing, makeRelativeToCurrentDirectory, doesFileExist)
 import System.FilePath ((</>), (<.>))
 
+import Echidna.Async (addEventHandler, spawnThread)
+import Echidna.Types.Campaign (CampaignEvent(..), CampaignConf(..))
+import Echidna.Types.Config (Env(..), EConfig(..))
+import Echidna.Types.Test (EchidnaTest(..))
 import Echidna.Types.Tx (Tx)
 import Echidna.Utility (listDirectory, withCurrentDirectory)
 
@@ -26,3 +33,19 @@ loadTxs dir = do
   putStrLn ("Loaded " ++ show (length txSeqs) ++ " transaction sequences from " ++ dir)
   pure txSeqs
   where readCall f = decodeStrict <$> BS.readFile f
+
+-- setup a handler to save to corpus in the background while tests are running
+setupCorpusSaver :: (MonadReader Env m, MonadIO m) => m ()
+setupCorpusSaver = do
+  env <- ask
+  maybe (pure ()) (addEventHandler . saveEvent env) env.cfg.campaignConf.corpusDir
+  where
+    saveEvent env dir (_, _, event) = maybe (pure ()) (saveFile env dir) $ getEventInfo event
+
+    getEventInfo (TestFalsified test)    = Just ("reproducers", test.reproducer)
+    getEventInfo (TestOptimized test)    = Just ("reproducers", test.reproducer)
+    getEventInfo (TestSimplified test)   = Just ("reproducers", test.reproducer)
+    getEventInfo (NewCoverage _ _ _ txs) = Just ("coverage", txs)
+    getEventInfo _ = Nothing
+
+    saveFile env dir (subdir, txs) = unless (null txs) $ spawnThread env $ saveTxs (dir </> subdir) [txs]
diff --git a/lib/Echidna/Shrink.hs b/lib/Echidna/Shrink.hs
index 4a16612a9..ea42e6ac5 100644
--- a/lib/Echidna/Shrink.hs
+++ b/lib/Echidna/Shrink.hs
@@ -11,6 +11,7 @@ import Data.List qualified as List
 
 import EVM (VM)
 
+import Echidna.Async (pushEvent)
 import Echidna.Events (extractEvents)
 import Echidna.Exec
 import Echidna.Transaction
@@ -18,11 +19,11 @@ import Echidna.Types.Solidity (SolConf(..))
 import Echidna.Types.Test (TestValue(..), EchidnaTest(..), TestState(..), isOptimizationTest)
 import Echidna.Types.Tx (Tx(..))
 import Echidna.Types.Config
-import Echidna.Types.Campaign (CampaignConf(..))
+import Echidna.Types.Campaign (CampaignConf(..), CampaignEvent(..), WorkerState(..))
 import Echidna.Test (getResultFromVM, checkETest)
 
 shrinkTest
-  :: (MonadIO m, MonadCatch m, MonadRandom m, MonadReader Env m)
+  :: (MonadIO m, MonadCatch m, MonadRandom m, MonadReader Env m, MonadState WorkerState m)
   => VM
   -> EchidnaTest
   -> m (Maybe EchidnaTest)
@@ -30,7 +31,7 @@ shrinkTest vm test = do
   env <- ask
   case test.state of
     Large i | i >= env.cfg.campaignConf.shrinkLimit && not (isOptimizationTest test) ->
-      pure $ Just test { state = Solved }
+      solvedEvent $ test { state = Solved }
     Large i ->
       if length test.reproducer > 1 || any canShrinkTx test.reproducer then do
         maybeShrunk <- evalStateT (shrinkSeq (checkETest test) test.value test.reproducer) vm
@@ -44,11 +45,13 @@ shrinkTest vm test = do
           Nothing ->
             -- No success with shrinking this time, just bump trials
             Just test { state = Large (i + 1) }
+      else if isOptimizationTest test then
+        pure $ Just test { state = Large (i + 1) }
       else
-        pure $ Just test { state = if isOptimizationTest test
-                                 then Large (i + 1)
-                                 else Solved }
+        solvedEvent $ test { state = Solved }
     _ -> pure Nothing
+  where
+    solvedEvent test' = pushEvent (TestSimplified test') >> pure (Just test')
 
 -- | Given a call sequence that solves some Echidna test, try to randomly
 -- generate a smaller one that still solves that test.
diff --git a/lib/Echidna/Types/Campaign.hs b/lib/Echidna/Types/Campaign.hs
index 85f0ca478..dc3679995 100644
--- a/lib/Echidna/Types/Campaign.hs
+++ b/lib/Echidna/Types/Campaign.hs
@@ -44,7 +44,8 @@ data CampaignConf = CampaignConf
 data CampaignEvent
   = TestFalsified !EchidnaTest
   | TestOptimized !EchidnaTest
-  | NewCoverage !Int !Int !Int
+  | TestSimplified !EchidnaTest
+  | NewCoverage !Int !Int !Int [Tx]
   | TxSequenceReplayed !Int !Int
   | WorkerStopped WorkerStopReason
   -- ^ This is a terminal event. Worker exits and won't push any events after
@@ -62,16 +63,13 @@ data WorkerStopReason
 ppCampaignEvent :: CampaignEvent -> String
 ppCampaignEvent = \case
   TestFalsified test ->
-    let name = case test.testType of
-                 PropertyTest n _ -> n
-                 AssertionTest _ n _ -> encodeSig n
-                 CallTest n _ -> n
-                 _ -> error "impossible"
-    in "Test " <> T.unpack name <> " falsified!"
+    "Test " <> T.unpack (showTest test) <> " falsified!"
   TestOptimized test ->
     let name = case test.testType of OptimizationTest n _ -> n; _ -> error "fixme"
     in "New maximum value of " <> T.unpack name <> ": " <> show test.value
-  NewCoverage points codehashes corpus ->
+  TestSimplified test ->
+    "Test " <> T.unpack (showTest test) <> " simplified."
+  NewCoverage points codehashes corpus _ ->
     "New coverage: " <> show points <> " instr, "
       <> show codehashes <> " contracts, "
       <> show corpus <> " seqs in corpus"
@@ -89,6 +87,12 @@ ppCampaignEvent = \case
     "Crashed:\n\n" <>
     e <>
     "\n\nPlease report it to https://github.com/crytic/echidna/issues"
+  where
+    showTest test = case test.testType of
+      PropertyTest n _ -> n
+      AssertionTest _ n _ -> encodeSig n
+      CallTest n _ -> n
+      _ -> error "impossible"
 
 -- | The state of a fuzzing campaign.
 data WorkerState = WorkerState
diff --git a/lib/Echidna/Types/Config.hs b/lib/Echidna/Types/Config.hs
index 1250129d2..8989632dc 100644
--- a/lib/Echidna/Types/Config.hs
+++ b/lib/Echidna/Types/Config.hs
@@ -1,6 +1,5 @@
 module Echidna.Types.Config where
 
-import Control.Concurrent (Chan)
 import Data.Aeson.Key (Key)
 import Data.IORef (IORef)
 import Data.Map (Map)
@@ -64,9 +63,8 @@ data Env = Env
   { cfg :: EConfig
   , dapp :: DappInfo
 
-  -- | Shared between all workers. Events are fairly rare so contention is
-  -- minimal.
-  , eventQueue :: Chan (Int, LocalTime, CampaignEvent)
+  , eventHandlers :: IORef [(Int, LocalTime, CampaignEvent) -> IO ()]
+  , numUnfinishedThreads :: IORef Int
 
   , testsRef :: IORef [EchidnaTest]
   , coverageRef :: IORef CoverageMap
diff --git a/lib/Echidna/UI.hs b/lib/Echidna/UI.hs
index e8aadcc35..8682a5cd6 100644
--- a/lib/Echidna/UI.hs
+++ b/lib/Echidna/UI.hs
@@ -36,6 +36,7 @@ import EVM (VM, Contract)
 import EVM.Types (Addr, W256)
 
 import Echidna.ABI
+import Echidna.Async (addEventHandler, pushEventIO)
 import Echidna.Campaign (runWorker)
 import Echidna.Output.JSON qualified
 import Echidna.Types.Campaign
@@ -88,16 +89,13 @@ ui vm world dict initialCorpus = do
   workers <- forM (zip corpusChunks [0..(nworkers-1)]) $
     uncurry (spawnWorker env perWorkerTestLimit)
 
-  -- A var used to block and wait for listener to finish
-  listenerStopVar <- newEmptyMVar
-
   case effectiveMode of
 #ifdef INTERACTIVE_UI
     Interactive -> do
       -- Channel to push events to update UI
       uiChannel <- liftIO $ newBChan 1000
       let forwardEvent = writeBChan uiChannel . WorkerEvent
-      liftIO $ spawnListener env forwardEvent nworkers listenerStopVar
+      addEventHandler forwardEvent
 
       ticker <- liftIO . forkIO . forever $ do
         threadDelay 200_000 -- 200 ms
@@ -145,9 +143,6 @@ ui vm world dict initialCorpus = do
       -- Exited from the UI, stop the workers, not needed anymore
       stopWorkers workers
 
-      -- wait for all events to be processed
-      takeMVar listenerStopVar
-
       liftIO $ killThread ticker
 
       states <- workerStates workers
@@ -165,7 +160,7 @@ ui vm world dict initialCorpus = do
         installHandler sig (Catch $ stopWorkers workers) Nothing
 #endif
       let forwardEvent = putStrLn . ppLogLine
-      liftIO $ spawnListener env forwardEvent nworkers listenerStopVar
+      addEventHandler forwardEvent
 
       let printStatus = do
             states <- liftIO $ workerStates workers
@@ -178,9 +173,6 @@ ui vm world dict initialCorpus = do
         threadDelay 3_000_000 -- 3 seconds
         printStatus
 
-      -- wait for all events to be processed
-      takeMVar listenerStopVar
-
       liftIO $ killThread ticker
 
       -- print final status regardless the last scheduled update
@@ -217,8 +209,7 @@ ui vm world dict initialCorpus = do
         , Handler $ \(e :: SomeException)  -> pure $ Crashed (show e)
         ]
 
-      time <- liftIO getTimestamp
-      writeChan env.eventQueue (workerId, time, WorkerStopped stopReason)
+      liftIO $ pushEventIO env workerId (WorkerStopped stopReason)
 
     pure (threadId, stateRef)
 
@@ -226,28 +217,6 @@ ui vm world dict initialCorpus = do
   workerStates workers =
     forM workers $ \(_, stateRef) -> readIORef stateRef
 
--- | Listener reads events and forwards all of them to the UI using the
--- 'forwardEvent' function. It exits after receiving all 'WorkerStopped'
--- events and sets the passed 'MVar' so the parent thread can block on listener
--- until all workers are done.
-spawnListener
-  :: Env
-  -> ((Int, LocalTime, CampaignEvent) -> IO ())
-  -- ^ a function that forwards event to the UI
-  -> Int     -- ^ number of workers
-  -> MVar () -- ^ use to join this thread
-  -> IO ()
-spawnListener env forwardEvent nworkers stopVar =
-  void $ forkFinally (loop nworkers) (const $ putMVar stopVar ())
-  where
-  loop !workersAlive =
-    when (workersAlive > 0) $ do
-      event <- readChan env.eventQueue
-      forwardEvent event
-      case event of
-        (_, _, WorkerStopped _) -> loop (workersAlive - 1)
-        _                       -> loop workersAlive
-
 #ifdef INTERACTIVE_UI
  -- | Order the workers to stop immediately
 stopWorkers :: MonadIO m => [(ThreadId, a)] -> m ()
@@ -283,7 +252,7 @@ monitor = do
         modify' $ \state -> state { workerEvents = state.workerEvents |> event }
 
         case campaignEvent of
-          NewCoverage coverage numCodehashes size ->
+          NewCoverage coverage numCodehashes size _ ->
             modify' $ \state ->
               state { coverage = max state.coverage coverage -- max not really needed
                     , corpusSize = size
diff --git a/src/Main.hs b/src/Main.hs
index 5f4a50887..2558c2f5d 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -4,7 +4,6 @@ module Main where
 
 import Optics.Core (view)
 
-import Control.Concurrent (newChan)
 import Control.Monad (unless, forM_, when)
 import Control.Monad.Reader (runReaderT)
 import Control.Monad.Random (getRandomR)
@@ -41,6 +40,7 @@ import EVM.Solidity (SolcContract(..), SourceCache(..))
 import EVM.Types (Addr, keccak', W256)
 
 import Echidna
+import Echidna.Async (awaitThreads)
 import Echidna.Config
 import Echidna.Types.Buffer (forceBuf)
 import Echidna.Types.Campaign
@@ -92,7 +92,8 @@ main = withUtf8 $ withCP65001 $ do
   cacheSlotsRef <- newIORef $ fromMaybe mempty loadedSlotsCache
   cacheMetaRef <- newIORef mempty
   chainId <- RPC.fetchChainId cfg.rpcUrl
-  eventQueue <- newChan
+  eventHandlers <- newIORef mempty
+  numUnfinishedThreads <- newIORef 0
   coverageRef <- newIORef mempty
   corpusRef <- newIORef mempty
   testsRef <- newIORef mempty
@@ -107,7 +108,8 @@ main = withUtf8 $ withCP65001 $ do
               , fetchContractCache = cacheContractsRef
               , fetchSlotCache = cacheSlotsRef
               , chainId = chainId
-              , eventQueue
+              , eventHandlers
+              , numUnfinishedThreads
               , coverageRef
               , corpusRef
               , testsRef
@@ -118,6 +120,8 @@ main = withUtf8 $ withCP65001 $ do
   (vm, world, dict) <-
     prepareContract env contracts cliFilePath cliSelectedContract seed
 
+  runReaderT setupCorpusSaver env
+
   initialCorpus <- loadInitialCorpus env world
   -- start ui and run tests
   _campaign <- runReaderT (ui vm world dict initialCorpus) env
@@ -127,6 +131,8 @@ main = withUtf8 $ withCP65001 $ do
 
   tests <- readIORef testsRef
 
+  awaitThreads env
+
   -- save corpus
   case cfg.campaignConf.corpusDir of
     Nothing -> pure ()
diff --git a/src/test/Common.hs b/src/test/Common.hs
index b02e99045..339ffb202 100644
--- a/src/test/Common.hs
+++ b/src/test/Common.hs
@@ -54,7 +54,6 @@ import Echidna.Types.Tx (Tx(..), TxCall(..), call)
 
 import EVM.Dapp (dappInfo, emptyDapp)
 import EVM.Solidity (SolcContract(..))
-import Control.Concurrent (newChan)
 import Control.Monad (forM_)
 
 testConfig :: EConfig
@@ -102,7 +101,8 @@ runContract f selectedContract cfg = do
   fetchSlotCache <- newIORef mempty
   coverageRef <- newIORef mempty
   corpusRef <- newIORef mempty
-  eventQueue <- newChan
+  eventHandlers <- newIORef mempty
+  numUnfinishedThreads <- newIORef 0
   testsRef <- newIORef mempty
   let env = Env { cfg = cfg
                 , dapp = dappInfo "/" solcByName sourceCache
@@ -111,7 +111,8 @@ runContract f selectedContract cfg = do
                 , fetchSlotCache
                 , coverageRef
                 , corpusRef
-                , eventQueue
+                , eventHandlers
+                , numUnfinishedThreads
                 , testsRef
                 , chainId = Nothing }
   (vm, world, dict) <- prepareContract env contracts (f :| []) selectedContract seed
@@ -167,7 +168,8 @@ checkConstructorConditions fp as = testCase fp $ do
   coverageRef <- newIORef mempty
   corpusRef <- newIORef mempty
   testsRef <- newIORef mempty
-  eventQueue <- newChan
+  eventHandlers <- newIORef mempty
+  numUnfinishedThreads <- newIORef 0
   let env = Env { cfg = testConfig
                 , dapp = emptyDapp
                 , metadataCache = cacheMeta
@@ -175,7 +177,8 @@ checkConstructorConditions fp as = testCase fp $ do
                 , fetchSlotCache = cacheSlots
                 , coverageRef
                 , corpusRef
-                , eventQueue
+                , eventHandlers
+                , numUnfinishedThreads
                 , testsRef
                 , chainId = Nothing }
   (v, _, t) <- loadSolTests env (fp :| []) Nothing
diff --git a/src/test/Tests/Compile.hs b/src/test/Tests/Compile.hs
index 905b956f1..9ad55e1e9 100644
--- a/src/test/Tests/Compile.hs
+++ b/src/test/Tests/Compile.hs
@@ -13,7 +13,6 @@ import Echidna.Solidity (loadSolTests)
 import Echidna.Types.Config (Env(..))
 import EVM.Dapp (emptyDapp)
 import Data.IORef (newIORef)
-import Control.Concurrent (newChan)
 
 compilationTests :: TestTree
 compilationTests = testGroup "Compilation and loading tests"
@@ -43,7 +42,8 @@ loadFails fp c e p = testCase fp . catch tryLoad $ assertBool e . p where
     cacheMeta <- newIORef mempty
     cacheContracts <- newIORef mempty
     cacheSlots <- newIORef mempty
-    eventQueue <- newChan
+    eventHandlers <- newIORef mempty
+    numUnfinishedThreads <- newIORef 0
     coverageRef <- newIORef mempty
     corpusRef <- newIORef mempty
     testsRef <- newIORef mempty
@@ -53,7 +53,8 @@ loadFails fp c e p = testCase fp . catch tryLoad $ assertBool e . p where
                   , fetchContractCache = cacheContracts
                   , fetchSlotCache = cacheSlots
                   , chainId = Nothing
-                  , eventQueue
+                  , eventHandlers
+                  , numUnfinishedThreads
                   , coverageRef
                   , corpusRef
                   , testsRef