From eb2e922bbca087d57fe1bd8eea44097f87a059f3 Mon Sep 17 00:00:00 2001 From: Artur Cygan Date: Thu, 4 Jan 2024 21:47:42 +0100 Subject: [PATCH] Hide event server behind config --- lib/Echidna/Config.hs | 1 + lib/Echidna/{SSE.hs => Server.hs} | 17 ++++++++--------- lib/Echidna/Types/Campaign.hs | 5 ++++- lib/Echidna/UI.hs | 18 +++++++++++------- src/Main.hs | 7 ++++++- 5 files changed, 30 insertions(+), 18 deletions(-) rename lib/Echidna/{SSE.hs => Server.hs} (81%) diff --git a/lib/Echidna/Config.hs b/lib/Echidna/Config.hs index 575b1a1b4..9503f3e94 100644 --- a/lib/Echidna/Config.hs +++ b/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 diff --git a/lib/Echidna/SSE.hs b/lib/Echidna/Server.hs similarity index 81% rename from lib/Echidna/SSE.hs rename to lib/Echidna/Server.hs index 971969ec5..b9e0f851c 100644 --- a/lib/Echidna/SSE.hs +++ b/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,7 +42,7 @@ 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) @@ -50,6 +50,5 @@ runSSEServer env nworkers = do , eventData = [ fromLazyByteString $ encode (SSE event) ] } - _serverTid <- forkIO $ do - run 3413 $ eventSourceAppIO sseListener - pure sseFinished + void . forkIO $ do + run (fromIntegral port) $ eventSourceAppIO sseListener diff --git a/lib/Echidna/Types/Campaign.hs b/lib/Echidna/Types/Campaign.hs index 787065926..c29f2b48f 100644 --- a/lib/Echidna/Types/Campaign.hs +++ b/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 diff --git a/lib/Echidna/UI.hs b/lib/Echidna/UI.hs index d4eab60fa..4c2bfec5b 100644 --- a/lib/Echidna/UI.hs +++ b/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 diff --git a/src/Main.hs b/src/Main.hs index 7645ec055..d3a71894d 100644 --- a/src/Main.hs +++ b/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