drshade · drshade · Aug 1, 2026 · Aug 1, 2026
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -1,5 +1,22 @@
 # Revision history for mcp-server
 
+## 0.2.1.0 - ???
+
+* The HTTP transport's WAI application is now exported (`mcpApplication`,
+  re-exported from `MCP.Server`), so the MCP endpoint can be embedded into
+  an existing WAI stack — your own Warp settings, TLS, middleware or router
+  — instead of `transportRunHttp` running its own server. `httpPort`/
+  `httpHost` are ignored when embedding; everything else (endpoint path,
+  Origin validation, bearer auth, `subscriptions/listen` streaming) applies
+  as usual.
+* The golden wire fixtures are now a self-describing, API-agnostic
+  conformance corpus: each case under `test/golden/` is a
+  `.request.json`/`.response.json` pair on disk, enumerated by
+  `manifest.json`, with the reference server documented in
+  `test/golden/README.md`. Other MCP implementations can replay the
+  requests and diff the responses without touching any Haskell; the
+  fixtures themselves are unchanged.
+
 ## 0.2.0.0 - 2026-07-31
 
 A major overhaul of the handler API. The headline changes: the handler

diff --git a/README.md b/README.md
@@ -348,6 +348,39 @@ application; the library only threads the identity through:
 - Origin validation via `httpAllowedOrigins`
 - Cacheability hints for modern list/read results via `httpCacheHints`
 
+### Embedding in an existing WAI stack
+
+`runMcpServerHttp` starts its own Warp server, but the MCP endpoint is a
+plain [WAI](https://hackage.haskell.org/package/wai) application underneath,
+and it is exported — so you can mount it inside whatever you already run
+(your own Warp settings, TLS, middleware, or a larger router):
+
+```haskell
+import MCP.Server (mcpApplication, defaultHttpConfig)
+import qualified Network.Wai.Handler.Warp as Warp
+
+main :: IO ()
+main = Warp.runSettings mySettings $ \req respond ->
+    -- route /mcp to the MCP endpoint, everything else to your app
+    mcpApplication defaultHttpConfig serverInfo handlers req respond
+```
+
+`httpPort`/`httpHost` are ignored when embedding (they only configure the
+server `runMcpServerHttp` starts); the endpoint path, Origin validation,
+bearer auth and `subscriptions/listen` streaming all apply as usual.
+
+## Conformance corpus
+
+The wire-format fixtures under
+[`test/golden/`](test/golden/README.md) double as an **API-agnostic MCP
+conformance corpus**: each case is a raw JSON-RPC `.request.json` and the
+exact `.response.json` a reference server answers, per protocol era
+(legacy `initialize`-negotiated revisions and the stateless `2026-07-28`
+revision), enumerated by a `manifest.json`. Nothing in the corpus is
+Haskell-specific — any MCP server implementation that reproduces the small
+reference server described in the corpus README can replay the requests and
+diff the responses. Contributions of new cases are welcome.
+
 ## Examples
 
 The library includes several examples:

diff --git a/mcp-server.cabal b/mcp-server.cabal
@@ -15,7 +15,7 @@ name: mcp-server
 -- PVP summary:     +-+------- breaking API changes
 --                  | | +----- non-breaking API additions
 --                  | | | +--- code changes with no API change
-version: 0.2.0.0
+version: 0.2.1.0
 -- A short (one-line) description of the package.
 synopsis: Library for building Model Context Protocol (MCP) servers
 -- A longer description of the package.
@@ -53,6 +53,8 @@ tested-with: GHC == 9.6.7
 
 -- Extra source files to be distributed with the package, such as examples, or a tutorial module.
 extra-source-files:
+  test/golden/README.md
+  test/golden/manifest.json
   test/golden/legacy/*.json
   test/golden/modern/*.json
 -- Source repository information

diff --git a/src/MCP/Server.hs b/src/MCP/Server.hs
@@ -13,6 +13,7 @@ module MCP.Server
   , defaultStdioConfig
   , HttpConfig(..)
   , defaultHttpConfig
+  , mcpApplication
 
     -- * Change Notifications
   , McpNotifier(..)
@@ -28,7 +29,8 @@ import           MCP.Server.Notifications (McpNotifier (..), NotificationSource,
 import           MCP.Server.Transport.Stdio (StdioConfig (..), defaultStdioConfig,
                                              transportRunStdio,
                                              transportRunStdioWithConfig)
-import           MCP.Server.Transport.Http (HttpConfig(..), transportRunHttp, defaultHttpConfig)
+import           MCP.Server.Transport.Http (HttpConfig(..), transportRunHttp, defaultHttpConfig,
+                                            mcpApplication)
 import           MCP.Server.Types
 
 -- | Run an MCP server using STDIO transport

diff --git a/src/MCP/Server/Transport/Http.hs b/src/MCP/Server/Transport/Http.hs
@@ -6,6 +6,7 @@ module MCP.Server.Transport.Http
     HttpConfig(..)
   , transportRunHttp
   , defaultHttpConfig
+  , mcpApplication
 
     -- * Request validation (exposed for testing)
   , BodyPeek(..)
@@ -113,7 +114,17 @@ transportRunHttp config serverInfo handlers = do
   putStrLn $ "Starting MCP HTTP server on " ++ httpHost config ++ ":" ++ show (httpPort config) ++ httpEndpoint config
   Warp.runSettings settings (mcpApplication config serverInfo handlers)
 
--- | WAI Application for MCP over HTTP
+-- | The MCP endpoint as a plain WAI 'Wai.Application', for embedding into
+-- an existing WAI stack (your own Warp settings, TLS, middleware, or a
+-- larger router) instead of letting 'transportRunHttp' run its own server.
+--
+-- When embedding, 'httpPort' and 'httpHost' are ignored — they only
+-- configure the server 'transportRunHttp' starts. Everything else applies
+-- as usual: requests are served only on the 'httpEndpoint' path (any other
+-- path gets 404, so mount accordingly or match the path in your router),
+-- Origin validation and bearer authentication run per 'httpAllowedOrigins'
+-- and 'httpAuthorize', and @subscriptions\/listen@ streams work as long as
+-- the surrounding stack does not buffer streaming responses.
 mcpApplication :: HttpConfig -> McpServerInfo -> McpServerHandlers -> Wai.Application
 mcpApplication config serverInfo handlers req respond0 = do
   -- Log the request

diff --git a/test/Spec/GoldenWire.hs b/test/Spec/GoldenWire.hs
@@ -1,30 +1,37 @@
 {-# LANGUAGE OverloadedStrings #-}
 
--- | Golden wire-format fixtures: a canned request set is run through
--- 'handleMcpMessage' and each response is compared against a checked-in
--- fixture under @test/golden/@.
+-- | Golden wire-format conformance corpus: @test/golden/@ holds, per case,
+-- a JSON-RPC request (@\<name\>.request.json@) and the reference server's
+-- exact response (@\<name\>.response.json@), enumerated by
+-- @test/golden/manifest.json@. This spec replays every request through
+-- 'handleMcpMessage' and compares the response against the fixture.
 --
--- The legacy fixtures were generated from @main@ at v0.2.0 (commit
--- @7bd1bcc@), so they anchor the promise that dual-era support leaves
--- legacy responses unchanged. The modern fixtures pin the 2026-07-28
--- envelope introduced by this revision of the library.
+-- The corpus is deliberately API-agnostic — request and response are plain
+-- wire bytes, so any MCP implementation that reproduces the reference
+-- server described in @test/golden/README.md@ can consume it. Within this
+-- library it pins two promises: the legacy fixtures were generated from
+-- @main@ at v0.2.0 (commit @7bd1bcc@), anchoring "dual-era support leaves
+-- legacy responses unchanged", and the modern fixtures pin the 2026-07-28
+-- envelope.
 --
 -- Responses are compared as parsed 'Value's, not raw bytes: aeson's object
 -- key order depends on the aeson\/hashable versions in the build plan, which
 -- vary across the CI matrix, while 'Value' equality is stable and still
 -- catches every added, removed, renamed or changed field.
 --
--- To create a fixture for a new case, run the suite with @GOLDEN_ACCEPT=1@:
--- missing fixture files are then written from the current output. Existing
--- fixtures are never overwritten — delete one first to regenerate it, and
--- never regenerate the legacy fixtures from a branch that intends to keep
--- legacy output unchanged.
+-- To add a case: write the @.request.json@ by hand, add its manifest entry,
+-- and run the suite with @GOLDEN_ACCEPT=1@ — a missing response fixture is
+-- then written from the current output. Existing fixtures are never
+-- overwritten — delete one first to regenerate it, and never regenerate the
+-- legacy fixtures from a branch that intends to keep legacy output
+-- unchanged.
 module Spec.GoldenWire (spec) where
 
 import Control.Monad (forM_)
 import Data.Aeson
 import qualified Data.ByteString.Lazy as BSL
 import qualified Data.Map as Map
+import Data.Text (Text)
 import qualified Data.Text as T
 import MCP.Server
 import MCP.Server.Handlers (handleMcpMessage)
@@ -41,7 +48,8 @@ goldenServerInfo = McpServerInfo
   }
 
 -- Deterministic manual handlers (no Template Haskell): one prompt, one
--- resource, one happy tool, one failing tool.
+-- resource, one happy tool, one failing tool. Documented for external
+-- consumers in test/golden/README.md — keep the two in sync.
 goldenHandlers :: McpServerHandlers
 goldenHandlers = noHandlers
   { prompts = Just (promptList, promptGet)
@@ -91,82 +99,64 @@ extendedHandlers = goldenHandlers
       completionResult (filter (T.isPrefixOf partial) ["alpha", "beta"])
   }
 
--- | (fixture path, raw request). The raw requests are written out verbatim
--- so the fixtures capture the full request->response wire behavior.
-cases :: [(FilePath, BSL.ByteString)]
-cases =
-  -- Legacy era: no _meta; served under the initialize-negotiated revision.
-  [ ("legacy/initialize",         "{\"jsonrpc\":\"2.0\",\"id\":1,\"method\":\"initialize\",\"params\":{\"protocolVersion\":\"2025-06-18\",\"capabilities\":{},\"clientInfo\":{\"name\":\"golden-client\",\"version\":\"1.0\"}}}")
-  , ("legacy/ping",               "{\"jsonrpc\":\"2.0\",\"id\":2,\"method\":\"ping\"}")
-  , ("legacy/tools-list",         "{\"jsonrpc\":\"2.0\",\"id\":3,\"method\":\"tools/list\"}")
-  , ("legacy/tools-call-echo",    "{\"jsonrpc\":\"2.0\",\"id\":4,\"method\":\"tools/call\",\"params\":{\"name\":\"echo\",\"arguments\":{\"text\":\"hi\"}}}")
-  , ("legacy/tools-call-unknown", "{\"jsonrpc\":\"2.0\",\"id\":5,\"method\":\"tools/call\",\"params\":{\"name\":\"nope\",\"arguments\":{}}}")
-  , ("legacy/tools-call-boom",    "{\"jsonrpc\":\"2.0\",\"id\":6,\"method\":\"tools/call\",\"params\":{\"name\":\"boom\",\"arguments\":{}}}")
-  , ("legacy/prompts-list",       "{\"jsonrpc\":\"2.0\",\"id\":7,\"method\":\"prompts/list\"}")
-  , ("legacy/prompts-get",        "{\"jsonrpc\":\"2.0\",\"id\":8,\"method\":\"prompts/get\",\"params\":{\"name\":\"greet\",\"arguments\":{\"name\":\"World\"}}}")
-  , ("legacy/resources-list",     "{\"jsonrpc\":\"2.0\",\"id\":9,\"method\":\"resources/list\"}")
-  , ("legacy/resources-read",     "{\"jsonrpc\":\"2.0\",\"id\":10,\"method\":\"resources/read\",\"params\":{\"uri\":\"resource://info\"}}")
+-- | One manifest entry: which case, and which reference-server variant
+-- answers it.
+data GoldenCase = GoldenCase
+  { caseName          :: FilePath
+  , caseHandlers      :: Text  -- ^ "base" or "extended"
+  , caseNotifications :: Bool
+  }
 
-  -- Modern era: _meta declares 2026-07-28; responses carry the modern
-  -- envelope (resultType, serverInfo _meta, cacheability on list/read).
-  , ("modern/server-discover",     "{\"jsonrpc\":\"2.0\",\"id\":21,\"method\":\"server/discover\",\"params\":{" <> meta <> "}}")
-  , ("modern/tools-list",          "{\"jsonrpc\":\"2.0\",\"id\":22,\"method\":\"tools/list\",\"params\":{" <> meta <> "}}")
-  , ("modern/tools-call-echo",     "{\"jsonrpc\":\"2.0\",\"id\":23,\"method\":\"tools/call\",\"params\":{\"name\":\"echo\",\"arguments\":{\"text\":\"hi\"}," <> meta <> "}}")
-  , ("modern/prompts-get",         "{\"jsonrpc\":\"2.0\",\"id\":24,\"method\":\"prompts/get\",\"params\":{\"name\":\"greet\",\"arguments\":{\"name\":\"World\"}," <> meta <> "}}")
-  , ("modern/resources-read",      "{\"jsonrpc\":\"2.0\",\"id\":25,\"method\":\"resources/read\",\"params\":{\"uri\":\"resource://info\"," <> meta <> "}}")
-  , ("modern/unsupported-version", "{\"jsonrpc\":\"2.0\",\"id\":26,\"method\":\"tools/list\",\"params\":{\"_meta\":{\"io.modelcontextprotocol/protocolVersion\":\"2099-01-01\"}}}")
-  , ("modern/initialize",          "{\"jsonrpc\":\"2.0\",\"id\":27,\"method\":\"initialize\",\"params\":{\"protocolVersion\":\"2026-07-28\",\"capabilities\":{},\"clientInfo\":{\"name\":\"golden-client\",\"version\":\"1.0\"}," <> meta <> "}}")
-  , ("modern/ping",                "{\"jsonrpc\":\"2.0\",\"id\":28,\"method\":\"ping\",\"params\":{" <> meta <> "}}")
-  ]
+instance FromJSON GoldenCase where
+  parseJSON = withObject "GoldenCase" $ \o -> GoldenCase
+    <$> o .: "name"
+    <*> o .: "handlers"
+    <*> o .: "notifications"
 
--- Methods introduced after v0.2.0: their fixtures originate on the branch
--- that added the method (there is no earlier behavior to anchor to).
-extendedCases :: [(FilePath, BSL.ByteString)]
-extendedCases =
-  [ ("legacy/resources-templates-list", "{\"jsonrpc\":\"2.0\",\"id\":11,\"method\":\"resources/templates/list\"}")
-  , ("legacy/completion-complete",      "{\"jsonrpc\":\"2.0\",\"id\":12,\"method\":\"completion/complete\",\"params\":{\"ref\":{\"type\":\"ref/prompt\",\"name\":\"greet\"},\"argument\":{\"name\":\"name\",\"value\":\"al\"}}}")
-  , ("modern/resources-templates-list", "{\"jsonrpc\":\"2.0\",\"id\":29,\"method\":\"resources/templates/list\",\"params\":{" <> meta <> "}}")
-  , ("modern/completion-complete",      "{\"jsonrpc\":\"2.0\",\"id\":30,\"method\":\"completion/complete\",\"params\":{\"ref\":{\"type\":\"ref/prompt\",\"name\":\"greet\"},\"argument\":{\"name\":\"name\",\"value\":\"al\"}," <> meta <> "}}")
-  ]
+newtype Manifest = Manifest [GoldenCase]
 
-meta :: BSL.ByteString
-meta = "\"_meta\":{\"io.modelcontextprotocol/protocolVersion\":\"2026-07-28\",\"io.modelcontextprotocol/clientInfo\":{\"name\":\"golden-client\",\"version\":\"1.0\"},\"io.modelcontextprotocol/clientCapabilities\":{}}"
+instance FromJSON Manifest where
+  parseJSON = withObject "Manifest" $ \o -> Manifest <$> o .: "cases"
 
--- Capability fixtures for a transport that delivers notifications (stdio
--- with a configured source: legacy push + modern listen)
-notifyingCases :: [(FilePath, BSL.ByteString)]
-notifyingCases =
-  [ ("legacy/initialize-notifying", "{\"jsonrpc\":\"2.0\",\"id\":13,\"method\":\"initialize\",\"params\":{\"protocolVersion\":\"2025-06-18\",\"capabilities\":{},\"clientInfo\":{\"name\":\"golden-client\",\"version\":\"1.0\"}}}")
-  , ("modern/server-discover-notifying", "{\"jsonrpc\":\"2.0\",\"id\":31,\"method\":\"server/discover\",\"params\":{" <> meta <> "}}")
-  ]
+-- | The corpus enumeration, read while hspec constructs the spec tree.
+loadManifest :: IO [GoldenCase]
+loadManifest = do
+  bytes <- BSL.readFile "test/golden/manifest.json"
+  case eitherDecode bytes of
+    Left err            -> fail ("test/golden/manifest.json does not parse: " ++ err)
+    Right (Manifest cs) -> pure cs
 
-runCase :: NotificationSupport -> McpServerHandlers -> BSL.ByteString -> IO Value
-runCase support handlers raw = do
+runCase :: GoldenCase -> BSL.ByteString -> IO Value
+runCase gc raw = do
   jsonValue <- either (fail . ("request does not parse: " ++)) pure (eitherDecode raw)
   message <- either (fail . ("request is not JSON-RPC: " ++)) pure (parseJsonRpcMessage jsonValue)
+  let handlers = if caseHandlers gc == "extended" then extendedHandlers else goldenHandlers
+      support = if caseNotifications gc
+        then NotificationSupport { supportsLegacyPush = True, supportsListen = True }
+        else noNotificationSupport
   maybeResponse <- handleMcpMessage goldenServerInfo defaultCacheHints support handlers anonymousContext message
   case maybeResponse of
     Just responseMsg -> pure $ encodeJsonRpcMessage responseMsg
     Nothing          -> fail "expected a response"
 
-goldenCase :: NotificationSupport -> McpServerHandlers -> (FilePath, BSL.ByteString) -> Spec
-goldenCase support handlers (name, raw) =
-  it name $ do
-    actual <- runCase support handlers raw
-    let path = "test/golden/" ++ name ++ ".json"
-    exists <- doesFileExist path
+goldenCase :: GoldenCase -> Spec
+goldenCase gc =
+  it (caseName gc) $ do
+    let requestPath = "test/golden/" ++ caseName gc ++ ".request.json"
+        responsePath = "test/golden/" ++ caseName gc ++ ".response.json"
+    raw <- BSL.readFile requestPath
+    actual <- runCase gc raw
+    exists <- doesFileExist responsePath
     accept <- lookupEnv "GOLDEN_ACCEPT"
     if not exists && accept /= Nothing
-      then BSL.writeFile path (encode actual)
+      then BSL.writeFile responsePath (encode actual)
       else do
-        fixtureBytes <- BSL.readFile path
+        fixtureBytes <- BSL.readFile responsePath
         case eitherDecode fixtureBytes :: Either String Value of
           Left err      -> expectationFailure $ "fixture does not parse: " ++ err
           Right fixture -> actual `shouldBe` fixture
 
 spec :: Spec
 spec = describe "Golden wire-format fixtures" $ do
-  forM_ cases (goldenCase noNotificationSupport goldenHandlers)
-  forM_ extendedCases (goldenCase noNotificationSupport extendedHandlers)
-  forM_ notifyingCases
-    (goldenCase (NotificationSupport { supportsLegacyPush = True, supportsListen = True }) goldenHandlers)
+  cases <- runIO loadManifest
+  forM_ cases goldenCase