Hide event server behind config

lib/Echidna/Config.hs

@@ -96,6 +96,7 @@ instance FromJSON EConfigWithUsage where
         <*> v ..:? "mutConsts" ..!= defaultMutationConsts
         <*> v ..:? "coverageFormats" ..!= [Txt,Html,Lcov]
         <*> v ..:? "workers"
+        <*> v ..:? "server"
 
       solConfParser = SolConf
         <$> v ..:? "contractAddr"    ..!= defaultContractAddr

lib/Echidna/SSE.hs → lib/Echidna/Server.hs

@@ -1,11 +1,12 @@
-module Echidna.SSE where
+module Echidna.Server where
 
 import Control.Concurrent
-import Control.Monad (when)
+import Control.Monad (when, void)
 import Data.Aeson
 import Data.Binary.Builder (fromLazyByteString)
 import Data.IORef
 import Data.Time (LocalTime)
+import Data.Word (Word16)
 import Network.Wai.EventSource (ServerEvent(..), eventSourceAppIO)
 import Network.Wai.Handler.Warp (run)
 
@@ -21,10 +22,9 @@ instance ToJSON SSE where
            , "data" .= event
            ]
 
-runSSEServer :: Env -> Int -> IO (MVar ())
-runSSEServer env nworkers = do
+runSSEServer :: MVar () -> Env -> Word16 -> Int -> IO ()
+runSSEServer serverStopVar env port nworkers = do
   aliveRef <- newIORef nworkers
-  sseFinished <- newEmptyMVar
   sseChan <- dupChan env.eventQueue
 
   let sseListener = do
@@ -42,14 +42,13 @@ runSSEServer env nworkers = do
           case campaignEvent of
             WorkerStopped _ -> do
               aliveAfter <- atomicModifyIORef' aliveRef (\n -> (n-1, n-1))
-              when (aliveAfter == 0) $ putMVar sseFinished ()
+              when (aliveAfter == 0) $ putMVar serverStopVar ()
             _ -> pure ()
           pure $ ServerEvent
             { eventName = Just (eventName campaignEvent)
             , eventId = Nothing
             , eventData = [ fromLazyByteString $ encode (SSE event) ]
             }
 
-  _serverTid <- forkIO $ do
-    run 3413 $ eventSourceAppIO sseListener
-  pure sseFinished
+  void . forkIO $ do
+    run (fromIntegral port) $ eventSourceAppIO sseListener

lib/Echidna/Types/Campaign.hs

@@ -4,7 +4,7 @@ import Data.Aeson
 import Data.Map (Map)
 import Data.Text (Text)
 import Data.Text qualified as T
-import Data.Word (Word8)
+import Data.Word (Word8, Word16)
 
 import Echidna.ABI (GenDict, emptyDict, encodeSig)
 import Echidna.Output.Source (CoverageFileType)
@@ -40,6 +40,9 @@ data CampaignConf = CampaignConf
   , coverageFormats :: [CoverageFileType]
     -- ^ List of file formats to save coverage reports
   , workers         :: Maybe Word8
+    -- ^ Number of fuzzing workers
+  , serverPort      :: Maybe Word16
+    -- ^ Server-Sent Events HTTP port number, if missing server is not ran
   }
 
 data CampaignEvent

lib/Echidna/UI.hs

@@ -25,7 +25,7 @@ import Data.Binary.Builder
 import Data.ByteString.Lazy qualified as BS
 import Data.List.Split (chunksOf)
 import Data.Map (Map)
-import Data.Maybe (fromMaybe)
+import Data.Maybe (fromMaybe, isJust)
 import Data.Time
 import UnliftIO
   ( MonadUnliftIO, newIORef, readIORef, hFlush, stdout , writeIORef, timeout)
@@ -36,7 +36,7 @@ import EVM.Types (Addr, Contract, VM, W256)
 import Echidna.ABI
 import Echidna.Campaign (runWorker)
 import Echidna.Output.JSON qualified
-import Echidna.SSE (runSSEServer)
+import Echidna.Server (runSSEServer)
 import Echidna.Types.Campaign
 import Echidna.Types.Config
 import Echidna.Types.Corpus (corpusSize)
@@ -158,10 +158,11 @@ ui vm world dict initialCorpus = do
 #endif
 
     NonInteractive outputFormat -> do
+      serverStopVar <- newEmptyMVar
 #ifdef INTERACTIVE_UI
       -- Handles ctrl-c, TODO: this doesn't work on Windows
       liftIO $ forM_ [sigINT, sigTERM] $ \sig ->
-        installHandler sig (Catch $ stopWorkers workers) Nothing
+        installHandler sig (Catch $ stopWorkers workers >> putMVar serverStopVar ()) Nothing
 #endif
       let forwardEvent = putStrLn . ppLogLine
       liftIO $ spawnListener env forwardEvent nworkers listenerStopVar
@@ -173,7 +174,9 @@ ui vm world dict initialCorpus = do
             putStrLn $ time <> "[status] " <> line
             hFlush stdout
 
-      sseFinished <- liftIO $ runSSEServer env nworkers
+      case conf.campaignConf.serverPort of
+        Just port -> liftIO $ runSSEServer serverStopVar env port nworkers
+        Nothing -> pure ()
 
       ticker <- liftIO . forkIO . forever $ do
         threadDelay 3_000_000 -- 3 seconds
@@ -187,9 +190,10 @@ ui vm world dict initialCorpus = do
       -- print final status regardless the last scheduled update
       liftIO printStatus
 
-      -- wait until we send all SSE events
-      liftIO $ putStrLn "Waiting until all SSE are received..."
-      readMVar sseFinished
+      when (isJust conf.campaignConf.serverPort) $ do
+        -- wait until we send all SSE events
+        liftIO $ putStrLn "Waiting until all SSE are received..."
+        readMVar serverStopVar
 
       states <- liftIO $ workerStates workers
 

src/Main.hs

@@ -24,7 +24,7 @@ import Data.Text (Text)
 import Data.Time.Clock.System (getSystemTime, systemSeconds)
 import Data.Vector qualified as Vector
 import Data.Version (showVersion)
-import Data.Word (Word8)
+import Data.Word (Word8, Word16)
 import Main.Utf8 (withUtf8)
 import Options.Applicative
 import Paths_echidna (version)
@@ -225,6 +225,7 @@ readFileIfExists path = do
 data Options = Options
   { cliFilePath         :: NE.NonEmpty FilePath
   , cliWorkers          :: Maybe Word8
+  , cliServerPort       :: Maybe Word16
   , cliSelectedContract :: Maybe Text
   , cliConfigFilepath   :: Maybe FilePath
   , cliOutputFormat     :: Maybe OutputFormat
@@ -255,6 +256,9 @@ options = Options
   <*> optional (option auto $ long "workers"
     <> metavar "N"
     <> help "Number of workers to run")
+  <*> optional (option auto $ long "server"
+    <> metavar "PORT"
+    <> help "Run events server on the given port")
   <*> optional (option str $ long "contract"
     <> metavar "CONTRACT"
     <> help "Contract to analyze")
@@ -339,6 +343,7 @@ overrideConfig config Options{..} = do
       , seqLen = fromMaybe campaignConf.seqLen cliSeqLen
       , seed = cliSeed <|> campaignConf.seed
       , workers = cliWorkers <|> campaignConf.workers
+      , serverPort = cliServerPort <|> campaignConf.serverPort
       }
 
     overrideSolConf solConf = solConf

src/test/Tests/Seed.hs

@@ -33,6 +33,7 @@ seedTests =
         , mutConsts = defaultMutationConsts
         , coverageFormats = [Txt,Html,Lcov]
         , workers = Nothing
+        , serverPort = Nothing
         }
       }
       & overrideQuiet

tests/solidity/basic/default.yaml

@@ -89,3 +89,5 @@ rpcUrl: null
 rpcBlock: null
 # number of workers
 workers: 1
+# events server port
+server: null