Drain campaign event queue to fix root-cursor memory leak

lib/Echidna.hs

@@ -1,6 +1,8 @@
 module Echidna where
 
-import Control.Concurrent (newChan)
+import Control.Concurrent (forkIO, newChan, readChan)
+import Control.Exception (SomeException, handle)
+import Control.Monad (forever, void)
 import Control.Monad.Catch (MonadThrow(..))
 import Control.Monad.IO.Class (liftIO)
 import Data.IORef (newIORef)
@@ -125,6 +127,11 @@ mkEnv cfg buildOutput tests world slitherInfo = do
   codehashMap <- newIORef mempty
   chainId <- Onchain.fetchChainIdFrom cfg.rpcUrl
   eventQueue <- newChan
+  -- Consumers read events from their own 'dupChan', so this original read end
+  -- is never advanced and would otherwise pin every event ever written. Drain
+  -- it from a dedicated thread so the GC can reclaim delivered events.
+  void $ forkIO $ handle (\(_ :: SomeException) -> pure ()) $
+    forever $ void $ readChan eventQueue
   coverageRefInit <- newIORef mempty
   coverageRefRuntime <- newIORef mempty
   corpusRef <- newIORef mempty

lib/Echidna/Campaign.hs

@@ -651,7 +651,10 @@ updateOpenTest vm reproducer test = do
                            , result
                            , workerId
                            }
-          pushWorkerEvent (TestFalsified test')
+          -- Publish a VM-free copy, forced strict so the event can't retain the
+          -- VM through a thunk. testRefs keeps the full 'test'' for shrinking.
+          let !vmFreeTest = test' { Test.vm = Nothing }
+          pushWorkerEvent (TestFalsified vmFreeTest)
           pure $ Just test'
 
         IntValue value' | value' > value -> do
@@ -660,7 +663,9 @@ updateOpenTest vm reproducer test = do
                            , vm = Just vm
                            , result
                            }
-          pushWorkerEvent (TestOptimized test')
+          -- VM-free copy, as in the TestFalsified case above.
+          let !vmFreeTest = test' { Test.vm = Nothing }
+          pushWorkerEvent (TestOptimized vmFreeTest)
           pure $ Just test'
           where
           value =