Replace the Server-Sent Events server with an MCP server

CHANGELOG.md

@@ -1,5 +1,6 @@
 ## Unreleased
 
+* **`--server PORT` now serves MCP instead of Server-Sent Events.** The flag and the `server` config key keep their names, but the protocol behind them has changed: instead of a one-way stream of campaign events, the port serves the Model Context Protocol over HTTP at `http://127.0.0.1:PORT/mcp`, with tools to inspect a running campaign (`status`, `target`, `show_coverage`, `dump_lcov`) and to steer it (`inject_fuzz_transactions`, `clear_fuzz_priorities`, `execute_sequence`, `sample`, `reload_corpus`). Anything consuming the SSE stream will need to move to the MCP `status` tool; the events themselves are unchanged in the text, JSON and UI outputs
 * New `verification` test mode to symbolically verify each function of a contract using a single transaction, instead of configuring the symbolic worker by hand (#1595)
 * Foundry mode now follows Foundry's function naming conventions more closely: `invariant`- and `statefulFuzz`-prefixed functions are stateful invariants, and `testFail`-prefixed tests are expected to revert (#1595)
 * Foundry mode now only calls parameterized `test` functions when `seqLen` is 1, matching Foundry's stateless fuzzing (#1595)

flake.nix

@@ -58,6 +58,25 @@
                   warp-tls = prev.haskell.lib.doJailbreak hprev.warp-tls;
                   tls-session-manager = prev.haskell.lib.doJailbreak hprev.tls-session-manager;
 
+                  # nixpkgs ships mcp-server 0.1.0.19, which answers a
+                  # Streamable HTTP notification with `200 {}` and a
+                  # server-stream GET with a discovery document. 0.2.0.1 is the
+                  # release that follows the spec (202 with no body, and a real
+                  # per-request SSE stream). It needs http-types >= 0.12.6 —
+                  # only that version re-exports `hOrigin` from the umbrella
+                  # `Network.HTTP.Types` module, which mcp-server imports
+                  # unqualified — and http-types has to move for the whole set,
+                  # since wai and warp exchange its `Status` type with
+                  # mcp-server. Everything in the closure accepts 0.12.6.
+                  http-types = hfinal.callHackageDirect {
+                    pkg = "http-types"; ver = "0.12.6";
+                    sha256 = "sha256-bGrVUTZnP1NFVwR0apgNLolKPW3cJdVW4jSBSlV7srg=";
+                  } {};
+                  mcp-server = hfinal.callHackageDirect {
+                    pkg = "mcp-server"; ver = "0.2.0.1";
+                    sha256 = "sha256-Pe0Jdfor8p5Iwj3oV2bNC5SpjHMqEwzMYUpqrvmgvP0=";
+                  } {};
+
                   # callHackageDirect runs the `cabal2nix` tool from this set, and cabal2nix
                   # transitively depends on tls — regenerating tls with it would loop. Pin the
                   # tool to the un-overridden base set to break the cycle (it's build-time only,

lib/Echidna/MCP/Parse.hs

@@ -0,0 +1,109 @@
+-- | The textual syntax an MCP client uses to name a sequence of calls.
+--
+-- A sequence is calls separated by @;@, each written the way it would be in
+-- Solidity, with @?@ standing for an argument left for the fuzzer to fill in:
+--
+-- > transfer(0x10, 100); approve(?, ?)
+--
+-- Parsing deliberately stops at an argument's shape rather than its type: an
+-- integer becomes a @uint256@ and a @0x@-prefixed literal an @address@,
+-- whatever the function's signature says. Calls are checked against the ABI in
+-- 'Echidna.MCP', and only by name and arity — the same way
+-- 'Echidna.Transaction.matchingContracts' resolves a prototype.
+module Echidna.MCP.Parse
+  ( parseArg
+  , parseArray
+  , parseFuzzArg
+  , parseFuzzCall
+  , parseFuzzSequence
+  , parsePrimitive
+  , splitArgs
+  ) where
+
+import Data.Char (isSpace, toLower)
+import Data.List (dropWhileEnd, isPrefixOf, isSuffixOf)
+import Data.List.Split (splitOn)
+import Data.Text (pack)
+import Data.Vector qualified as V
+import Text.Read (readMaybe)
+
+import EVM.ABI (AbiType(..), AbiValue(..), abiValueType)
+
+import Echidna.Types.Signature (SolCallPrototype)
+
+-- | Parse a whole sequence: calls separated by @;@.
+parseFuzzSequence :: String -> Maybe [SolCallPrototype]
+parseFuzzSequence s = mapM (parseFuzzCall . trim) (splitOn ";" s)
+
+-- | Parse one call, leaving @?@ arguments open.
+parseFuzzCall :: String -> Maybe SolCallPrototype
+parseFuzzCall s = do
+  let (fname, rest) = break (== '(') s
+  args <- mapM parseFuzzArg . argList =<< delimited '(' ')' rest
+  pure (pack fname, args)
+
+-- | Parse one argument of a call, @?@ meaning "left for the fuzzer".
+parseFuzzArg :: String -> Maybe (Maybe AbiValue)
+parseFuzzArg s
+  | trim s == "?" = Just Nothing
+  | otherwise = Just <$> parseArg s
+
+-- | Parse a concrete argument, either an array or a primitive.
+parseArg :: String -> Maybe AbiValue
+parseArg s
+  | "[" `isPrefixOf` s' = parseArray s'
+  | otherwise = parsePrimitive s'
+  where s' = trim s
+
+-- | Parse a bracketed list of primitives into a dynamic array. Every element
+-- has to come out the same type, since the array needs one.
+parseArray :: String -> Maybe AbiValue
+parseArray s = do
+  vals <- mapM parsePrimitive . argList =<< delimited '[' ']' (trim s)
+  case vals of
+    -- Nothing in an empty array says what it holds, so it gets the type the
+    -- rest of this parser defaults to.
+    [] -> Just $ AbiArrayDynamic (AbiUIntType 256) V.empty
+    (v:_) | all ((== abiValueType v) . abiValueType) vals ->
+      Just $ AbiArrayDynamic (abiValueType v) (V.fromList vals)
+    _ -> Nothing
+
+-- | Parse a single value: a boolean, a @0x@-prefixed address, or a @uint256@.
+parsePrimitive :: String -> Maybe AbiValue
+parsePrimitive s = case map toLower s' of
+  "true" -> Just (AbiBool True)
+  "false" -> Just (AbiBool False)
+  _ | "0x" `isPrefixOf` s' -> AbiAddress . fromIntegral <$> integer
+    | otherwise -> AbiUInt 256 . fromIntegral <$> integer
+  where
+    s' = trim s
+    integer = readMaybe s' :: Maybe Integer
+
+-- | Split a comma-separated argument list, keeping bracketed groups whole.
+splitArgs :: String -> [String]
+splitArgs = go (0 :: Int) ""
+  where
+    go _ current [] = [reverse current]
+    go depth current (c:cs) = case c of
+      '[' -> go (depth + 1) (c:current) cs
+      ']' -> go (depth - 1) (c:current) cs
+      ',' | depth == 0 -> reverse current : go depth "" cs
+      _ -> go depth (c:current) cs
+
+-- | The contents of a delimited group, or 'Nothing' if that is not what this
+-- is. Checking the closing delimiter is what keeps @foo(1@ from parsing as a
+-- call with no arguments.
+delimited :: Char -> Char -> String -> Maybe String
+delimited open close s
+  | [open] `isPrefixOf` s && [close] `isSuffixOf` s = Just $ drop 1 (init s)
+  | otherwise = Nothing
+
+-- | The arguments in a delimited list. An empty one has no arguments rather
+-- than one empty argument, which is what 'splitArgs' would make of it.
+argList :: String -> [String]
+argList s
+  | all isSpace s = []
+  | otherwise = splitArgs s
+
+trim :: String -> String
+trim = dropWhileEnd isSpace . dropWhile isSpace

lib/Echidna/Output/Source.hs

@@ -90,6 +90,23 @@ coverageFileExtension Lcov = ".lcov"
 coverageFileExtension Html = ".html"
 coverageFileExtension Txt = ".txt"
 
+-- | Write the coverage reached so far as LCOV, and answer with the path it went
+-- to. Separate from 'saveCoverage', which writes the formats the configuration
+-- asked for once the campaign is over, under a name keyed by the seed: this one
+-- is for a client asking mid-campaign, so it is named by the time it was taken
+-- and never overwrites an earlier answer.
+saveLcovSnapshot :: Env -> FilePath -> IO FilePath
+saveLcovSnapshot env d = do
+  coverage <- mergeCoverageMaps env.dapp env.coverageRefInit env.coverageRefRuntime
+  timestamp <- formatTime defaultTimeLocale "%Y%m%d_%H%M%S" <$> getCurrentTime
+  let fn = d </> "covered." <> timestamp <> coverageFileExtension Lcov
+      cs = Map.elems env.dapp.solcByName
+      cc = ppCoveredCode Lcov env.dapp.sources cs coverage Nothing (T.pack timestamp)
+             env.cfg.campaignConf.coverageExcludes
+  createDirectoryIfMissing True d
+  writeFile fn cc
+  pure fn
+
 -- | Pretty-print the covered code
 ppCoveredCode :: CoverageFileType -> SourceCache -> [SolcContract] -> FrozenCoverageMap -> Maybe Text -> Text -> [Text] -> Text
 ppCoveredCode fileType sc cs s projectName timestamp excludePatterns

lib/Echidna/Types/Campaign.hs

@@ -148,7 +148,7 @@ data CampaignConf = CampaignConf
   , workers            :: Maybe Word8
     -- ^ Number of fuzzing workers
   , serverPort         :: Maybe Word16
-    -- ^ Server-Sent Events HTTP port number, if missing server is not ran
+    -- ^ Port to serve MCP on, if missing the server is not ran
   , symExec            :: Bool
     -- ^ Whether to add an additional symbolic execution worker
   , symExecSMTSolver   :: Solver

lib/Echidna/Types/InterWorker.hs

@@ -21,8 +21,9 @@ import Echidna.Types.Signature (SolCallPrototype)
 import Echidna.Types.Tx (Tx)
 import Echidna.Types.Worker (WorkerId)
 
--- | Who sent a message.
-data AgentId = FuzzerId WorkerId | SymbolicId
+-- | Who sent a message. 'ServerId' is the MCP server, standing in for whoever
+-- is driving the campaign from outside it.
+data AgentId = FuzzerId WorkerId | SymbolicId | ServerId
   deriving (Show, Eq, Ord)
 
 -- | The channel a command answers on, filled exactly once by whoever handles

lib/Echidna/UI.hs

@@ -6,7 +6,6 @@ import Brick
 import Brick.BChan
 import Brick.Widgets.Dialog qualified as B
 import Control.Concurrent (killThread, threadDelay)
-import Control.Concurrent.MVar (readMVar)
 import Control.Exception (AsyncException)
 import Control.Monad
 import Control.Monad.Catch
@@ -15,7 +14,7 @@ import Control.Monad.State.Strict hiding (state)
 import Data.ByteString.Lazy qualified as BS
 import Data.List.Split (splitPlaces)
 import Data.Map (Map)
-import Data.Maybe (fromMaybe, isJust, mapMaybe)
+import Data.Maybe (fromMaybe, mapMaybe)
 import Data.Sequence ((|>))
 import Data.Text (Text)
 import Data.Time
@@ -34,9 +33,9 @@ import EVM.Types (Addr, Contract, VM, VMType(Concrete), W256)
 
 import Echidna.ABI
 import Echidna.Agent (runAgent)
+import Echidna.MCP (runMCPServer)
 import Echidna.Output.Corpus (saveCorpusEvent)
 import Echidna.Output.JSON qualified
-import Echidna.Server (runSSEServer)
 import Echidna.SourceAnalysis.Slither (isEmptySlitherInfo)
 import Echidna.Types.Agent (Agent(..), workerTypeOf)
 import Echidna.Types.Campaign
@@ -49,7 +48,8 @@ import Echidna.Types.Worker
 import Echidna.UI.Report
 import Echidna.UI.Widgets
 import Echidna.Utility (timePrefix, getTimestamp)
-import Echidna.Worker (getNWorkers, spawnListener, workerIDToType)
+import Echidna.Worker
+  (getNWorkers, pushCampaignEvent, spawnListener, workerIDToType)
 
 data UIEvent =
   CampaignUpdated LocalTime [EchidnaTest] [WorkerState]
@@ -110,6 +110,16 @@ ui vm dict initialCorpus cliSelectedContract = do
         liftIO $ forM (zip corpusChunks [0..(nworkers-1)]) $
           uncurry (spawnWorker env perWorkerTestLimit)
 
+      -- The MCP server answers for the campaign as it runs, reading worker
+      -- state through the workers' own refs, so it can only be started once
+      -- they exist. It has no shutdown of its own: the campaign ending is what
+      -- takes it down with the process.
+      spawnMCPServer workers = forM_ conf.campaignConf.serverPort $ \port -> do
+        liftIO $ pushCampaignEvent env $ ServerLog $
+          "MCP server listening on http://127.0.0.1:" <> show port <> "/mcp"
+        void $ liftIO $ forkIO $
+          runMCPServer env (map snd workers) (fromIntegral port)
+
   case effectiveMode of
     Interactive -> do
       -- Channel to push events to update UI
@@ -120,6 +130,7 @@ ui vm dict initialCorpus cliSelectedContract = do
       -- events (like startup logs) are not lost by dupChan.
       uiEventsForwarderStopVar <- spawnListener forwardEvent
       workers <- spawnWorkers
+      spawnMCPServer workers
 
       ticker <- liftIO . forkIO . forever $ do
         threadDelay 200_000 -- 200 ms
@@ -186,20 +197,16 @@ ui vm dict initialCorpus cliSelectedContract = do
       pure states
 
     NonInteractive outputFormat -> do
-      serverStopVar <- newEmptyMVar
-
       let forwardEvent ev = putStrLn =<< runReaderT (ppLogLine vm ev) env
       -- Attach the log/event forwarder before workers start so early worker
       -- events (like startup logs) are not lost by dupChan.
       uiEventsForwarderStopVar <- spawnListener forwardEvent
       workers <- spawnWorkers
+      spawnMCPServer workers
 
       -- Handles ctrl-c
       liftIO $ forM_ [sigINT, sigTERM] $ \sig ->
-        let handler _ = do
-              stopWorkers workers
-              void $ tryPutMVar serverStopVar ()
-        in installHandler sig handler
+        installHandler sig (const (stopWorkers workers))
 
       -- Track last update time and gas for delta calculation
       startTime <- liftIO getTimestamp
@@ -212,10 +219,6 @@ ui vm dict initialCorpus cliSelectedContract = do
             putStrLn $ time <> "[status] " <> line
             hFlush stdout
 
-      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
         printStatus
@@ -228,11 +231,6 @@ ui vm dict initialCorpus cliSelectedContract = do
       -- print final status regardless of the last scheduled update
       liftIO printStatus
 
-      when (isJust conf.campaignConf.serverPort) $ do
-        -- wait until we send all SSE events
-        liftIO $ putStrLn "Waiting until all SSE are received..."
-        liftIO $ Control.Concurrent.MVar.readMVar serverStopVar
-
       states <- liftIO $ workerStates workers
 
       case outputFormat of