Add MCP example

Inspired by https://github.com/dpella/mcp/blob/main/mcp-server/example.
This commit is contained in:
George Thomas 2026-03-19 15:49:51 +00:00
parent da55b457ec
commit 73c0df9396
8 changed files with 1558 additions and 3 deletions

202
SKILL.md Normal file
View File

@ -0,0 +1,202 @@
# Example MCP Server — Build & Test Skill
This skill explains how to build, run, and test the example MCP server that
demonstrates the `mcp` Haskell library.
## Prerequisites
- GHC 9.12.2 and cabal-install
- The project root is at the repository root (where `cabal.project` lives)
## Build
```bash
cabal build mcp-example
```
This compiles the example server along with its dependencies (`mcp-types` and
`mcp`).
## Run
```bash
cabal run mcp-example
```
The server starts on **http://localhost:8080/mcp** and prints a JWT bearer token
to stdout. Copy this token — you need it for all requests.
## Test with curl
Replace `$TOKEN` with the token printed by the server.
### 1. Initialize the session
```bash
curl -s -X POST http://localhost:8080/mcp \
-H 'Content-Type: application/json' \
-H "Authorization: Bearer $TOKEN" \
-d '{"jsonrpc":"2.0","id":1,"method":"initialize","params":{"protocolVersion":"2025-06-18","capabilities":{},"clientInfo":{"name":"curl","version":"1.0"}}}'
```
### 2. Send initialized notification
```bash
curl -s -X POST http://localhost:8080/mcp \
-H 'Content-Type: application/json' \
-H "Authorization: Bearer $TOKEN" \
-d '{"jsonrpc":"2.0","method":"notifications/initialized","params":null}'
```
### 3. List tools
```bash
curl -s -X POST http://localhost:8080/mcp \
-H 'Content-Type: application/json' \
-H "Authorization: Bearer $TOKEN" \
-d '{"jsonrpc":"2.0","id":2,"method":"tools/list","params":{}}'
```
### 4. Call the echo tool
```bash
curl -s -X POST http://localhost:8080/mcp \
-H 'Content-Type: application/json' \
-H "Authorization: Bearer $TOKEN" \
-d '{"jsonrpc":"2.0","id":3,"method":"tools/call","params":{"name":"echo","arguments":{"message":"Hello from MCP!"}}}'
```
### 5. Call the add tool
```bash
curl -s -X POST http://localhost:8080/mcp \
-H 'Content-Type: application/json' \
-H "Authorization: Bearer $TOKEN" \
-d '{"jsonrpc":"2.0","id":4,"method":"tools/call","params":{"name":"add","arguments":{"a":17,"b":25}}}'
```
### 6. Call the current-time tool
```bash
curl -s -X POST http://localhost:8080/mcp \
-H 'Content-Type: application/json' \
-H "Authorization: Bearer $TOKEN" \
-d '{"jsonrpc":"2.0","id":5,"method":"tools/call","params":{"name":"current-time","arguments":{}}}'
```
### 7. List resources
```bash
curl -s -X POST http://localhost:8080/mcp \
-H 'Content-Type: application/json' \
-H "Authorization: Bearer $TOKEN" \
-d '{"jsonrpc":"2.0","id":6,"method":"resources/list","params":{}}'
```
### 8. Read a resource
```bash
curl -s -X POST http://localhost:8080/mcp \
-H 'Content-Type: application/json' \
-H "Authorization: Bearer $TOKEN" \
-d '{"jsonrpc":"2.0","id":7,"method":"resources/read","params":{"uri":"resource://example/readme"}}'
```
### 9. List resource templates
```bash
curl -s -X POST http://localhost:8080/mcp \
-H 'Content-Type: application/json' \
-H "Authorization: Bearer $TOKEN" \
-d '{"jsonrpc":"2.0","id":8,"method":"resources/templates/list","params":{}}'
```
### 10. Read a templated resource
```bash
curl -s -X POST http://localhost:8080/mcp \
-H 'Content-Type: application/json' \
-H "Authorization: Bearer $TOKEN" \
-d '{"jsonrpc":"2.0","id":9,"method":"resources/read","params":{"uri":"resource://example/users/42"}}'
```
### 11. List prompts
```bash
curl -s -X POST http://localhost:8080/mcp \
-H 'Content-Type: application/json' \
-H "Authorization: Bearer $TOKEN" \
-d '{"jsonrpc":"2.0","id":10,"method":"prompts/list","params":{}}'
```
### 12. Get a prompt
```bash
curl -s -X POST http://localhost:8080/mcp \
-H 'Content-Type: application/json' \
-H "Authorization: Bearer $TOKEN" \
-d '{"jsonrpc":"2.0","id":11,"method":"prompts/get","params":{"name":"summarize","arguments":{"text":"The MCP protocol enables AI models to interact with external tools."}}}'
```
### 13. Request completions
```bash
curl -s -X POST http://localhost:8080/mcp \
-H 'Content-Type: application/json' \
-H "Authorization: Bearer $TOKEN" \
-d '{"jsonrpc":"2.0","id":12,"method":"completion/complete","params":{"ref":{"type":"ref/prompt","name":"summarize"},"argument":{"name":"text","value":"Hel"}}}'
```
### 14. Set log level
```bash
curl -s -X POST http://localhost:8080/mcp \
-H 'Content-Type: application/json' \
-H "Authorization: Bearer $TOKEN" \
-d '{"jsonrpc":"2.0","id":13,"method":"logging/setLevel","params":{"level":"debug"}}'
```
### 15. Ping
```bash
curl -s -X POST http://localhost:8080/mcp \
-H 'Content-Type: application/json' \
-H "Authorization: Bearer $TOKEN" \
-d '{"jsonrpc":"2.0","id":14,"method":"ping","params":{}}'
```
## Available Features
| Feature | Methods |
|----------------------|----------------------------------------------|
| Tools | `tools/list`, `tools/call` |
| Resources | `resources/list`, `resources/read` |
| Resource Templates | `resources/templates/list` |
| Prompts | `prompts/list`, `prompts/get` |
| Completions | `completion/complete` |
| Logging | `logging/setLevel` |
| Lifecycle | `initialize`, `notifications/initialized` |
| Health | `ping` |
## Run the agent test (Claude Agent SDK)
A Node.js test in `test/` uses the Claude Agent SDK to start the server and
exercise every tool endpoint through a Claude agent.
```bash
cd mcp-server/example/test
pnpm install
pnpm test # requires ANTHROPIC_API_KEY
```
The script starts the server, captures its JWT token, connects a Claude agent,
and verifies that all 3 tool checks pass (echo, add, current-time).
See `test/README.md` for details.
## Run the library tests
```bash
cabal test all
```
This runs the full integration test suite (42 tests) for the `mcp` library.

View File

@ -1,4 +1,610 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{- | An example MCP server demonstrating the full feature set of the @mcp@ library.
= Quick start
@
cabal run mcp-example -- HTTP with JWT auth
cabal run mcp-example -- --simple-http -- HTTP without auth (local only)
cabal run mcp-example -- --stdio -- stdio transport
@
In HTTP mode (default) the server starts on @http:\/\/localhost:8080\/mcp@ and
prints a JWT bearer token to stdout. In simple-http mode no authentication
is performed use this only locally or behind an authenticating proxy.
= Features demonstrated
This single-file example covers every major capability of the library:
* __JWT authentication__ a fresh key is generated on startup and a sample
token is printed so you can test immediately.
* __Tools__ (via 'ToolHandler' \/ 'withToolHandlers') @echo@, @add@, and
@current-time@ show text results, structured output, and IO in handlers.
* __Resources__ static text and JSON resources served by URI.
* __Resource templates__ a @resource:\/\/example\/users\/{userId}@ URI template
that dynamically generates user profiles.
* __Prompts__ a @summarize@ prompt with a required @text@ argument, returning
a multi-message conversation.
* __Completions__ auto-complete suggestions for prompt argument values.
* __Logging__ the server declares @LoggingCapability@ and supports
@logging\/setLevel@.
* __Lifecycle hooks__ @handleInit@ and @handleFinalize@ show how to run
setup\/teardown logic around each session and request.
* __Server instructions__ a free-text string sent to clients on initialization.
= Architecture overview
1. Define your user type (@ExampleUser@) and per-session state (@ExampleState@).
2. Wire them into the library via type family instances:
@type instance MCPHandlerState = ExampleState@ and
@type instance MCPHandlerUser = ExampleUser@.
3. Build a 'ProcessHandlers' record start from 'defaultProcessHandlers' and
override the capabilities you need. Use 'withToolHandlers' for a convenient
tool-registration API.
4. Create an 'MCPServerState' via 'initMCPServerState', wrap it in an 'MVar',
and serve it with @serveWithContext (Proxy \@MCPAPI) ctx (mcpAPI stateVar)@
for JWT auth, or @simpleHttpApp stateVar@ for unauthenticated local use.
-}
module Main where
import Control.Concurrent.MVar (newMVar)
import Control.Monad.IO.Class (liftIO)
import Data.Aeson (Value, object, toJSON, (.=))
import Data.Aeson qualified as Aeson
import Data.ByteString.Lazy qualified as BSL
import Data.Map.Strict qualified as Map
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.Encoding qualified as TE
import Data.Time.Clock (getCurrentTime)
import GHC.Generics (Generic)
import MCP.Server
import Network.Wai.Handler.Warp qualified as Warp
import Servant (Context (..), Proxy (..), serveWithContext)
import Servant.Auth.Server qualified as AuthServer
import System.Environment (getArgs, lookupEnv)
import System.IO (hSetBuffering, stderr, stdin, stdout, BufferMode (..))
-- ---------------------------------------------------------------------------
-- User and state types
-- ---------------------------------------------------------------------------
-- | The authenticated user carried inside JWT claims.
--
-- The library requires instances of 'AuthServer.ToJWT' and 'AuthServer.FromJWT'
-- so it can encode\/decode your user in bearer tokens. Deriving 'Generic' plus
-- 'Aeson.ToJSON' \/ 'Aeson.FromJSON' gives you those for free via the default
-- methods.
data ExampleUser = ExampleUser
{ userId :: Text
, userName :: Text
}
deriving (Eq, Show, Generic)
instance Aeson.ToJSON ExampleUser
instance Aeson.FromJSON ExampleUser
instance AuthServer.ToJWT ExampleUser
instance AuthServer.FromJWT ExampleUser
-- | Per-session handler state.
--
-- This is threaded through every 'MCPServerT' handler via 'StateT'. You can
-- put anything you need here — database connections, caches, etc. For this
-- example we just track which user is active.
newtype ExampleState = ExampleState
{ currentUser :: Maybe Text
}
-- | Wire the type families so the library knows our concrete types.
--
-- Every application using @mcp@ must provide exactly one instance for each.
-- @MCPHandlerState@ is the state available in handlers, and @MCPHandlerUser@
-- is the user type decoded from JWT tokens.
type instance MCPHandlerState = ExampleState
type instance MCPHandlerUser = ExampleUser
-- ---------------------------------------------------------------------------
-- Tools
-- ---------------------------------------------------------------------------
-- | All tools provided by the example server.
--
-- We use the 'toolHandler' smart constructor for convenience — it fills in
-- optional fields (title, output schema, annotations, metadata) with 'Nothing'.
-- Then 'withToolHandlers' wires them into a 'ProcessHandlers' record,
-- automatically generating the @tools\/list@ and @tools\/call@ dispatch logic.
exampleTools :: [ToolHandler]
exampleTools = [echoTool, addTool, currentTimeTool]
-- | A simple tool that echoes its input back.
--
-- Demonstrates 'toolTextResult' — the simplest way to return text from a tool.
echoTool :: ToolHandler
echoTool =
toolHandler
"echo"
(Just "Echoes the input message back to the caller")
(InputSchema "object" (Just $ Map.fromList [("message", object ["type" .= ("string" :: Text)])]) (Just ["message"]))
$ \args -> do
let msg = args >>= Map.lookup "message" >>= asText
case msg of
Just txt -> return $ ProcessSuccess $ toolTextResult [txt]
Nothing -> return $ ProcessSuccess $ toolTextError "Missing or invalid 'message' argument"
-- | A tool that adds two numbers.
--
-- Demonstrates returning structured output via 'CallToolResult' with a
-- 'structuredContent' map alongside the human-readable text content.
addTool :: ToolHandler
addTool =
toolHandler
"add"
(Just "Adds two numbers and returns the sum")
( InputSchema
"object"
( Just $
Map.fromList
[ ("a", object ["type" .= ("number" :: Text)])
, ("b", object ["type" .= ("number" :: Text)])
]
)
(Just ["a", "b"])
)
$ \args -> do
let ma = args >>= Map.lookup "a" >>= asNumber
let mb = args >>= Map.lookup "b" >>= asNumber
case (ma, mb) of
(Just a, Just b) -> do
let s = a + b
return $
ProcessSuccess $
CallToolResult
{ content = [TextBlock $ TextContent "text" ("The sum is: " <> T.pack (show s)) Nothing Nothing]
, structuredContent = Just $ Map.fromList [("result", toJSON s)]
, isError = Just False
, _meta = Nothing
}
_ -> return $ ProcessSuccess $ toolTextError "Arguments 'a' and 'b' must be numbers"
-- | A tool that returns the current UTC time.
--
-- Demonstrates performing IO inside a tool handler via 'liftIO'.
currentTimeTool :: ToolHandler
currentTimeTool =
toolHandler
"current-time"
(Just "Returns the current UTC time")
(InputSchema "object" Nothing Nothing)
$ \_ -> do
now <- liftIO getCurrentTime
return $ ProcessSuccess $ toolTextResult [T.pack (show now)]
-- ---------------------------------------------------------------------------
-- Resources
-- ---------------------------------------------------------------------------
-- | Static resources advertised by the server.
--
-- Clients discover these via @resources\/list@ and fetch their content with
-- @resources\/read@. Each resource has a stable URI, a human-readable name,
-- and an optional MIME type.
exampleResources :: [Resource]
exampleResources =
[ Resource
{ uri = "resource://example/readme"
, name = "readme"
, title = Just "Example README"
, description = Just "A sample text document"
, mimeType = Just "text/plain"
, size = Nothing
, annotations = Nothing
, _meta = Nothing
}
, Resource
{ uri = "resource://example/config"
, name = "config"
, title = Just "Example Configuration"
, description = Just "A sample JSON configuration"
, mimeType = Just "application/json"
, size = Nothing
, annotations = Nothing
, _meta = Nothing
}
]
-- | Handle @resources\/read@ requests.
--
-- Routes by URI to return the appropriate content. Unknown URIs get a 404
-- error via 'ProcessRPCError'. URIs matching the @resource:\/\/example\/users\/{id}@
-- template are handled dynamically.
readResource :: ReadResourceParams -> MCPServerT (ProcessResult ReadResourceResult)
readResource (ReadResourceParams req_uri) =
case req_uri of
"resource://example/readme" ->
ok req_uri "text/plain" "This is the example MCP server README.\nIt demonstrates tools, resources, prompts, and more."
"resource://example/config" ->
ok req_uri "application/json" (T.pack $ show $ object ["version" .= ("1.0" :: Text), "debug" .= False])
_ ->
-- Handle resource template matches (see exampleResourceTemplates)
case T.stripPrefix "resource://example/users/" req_uri of
Just uid | not (T.null uid) ->
ok req_uri "application/json" (T.pack $ show $ object ["userId" .= uid, "name" .= ("User " <> uid)])
_ -> return $ ProcessRPCError 404 "Resource not found"
where
ok u mime txt =
return $
ProcessSuccess $
ReadResourceResult
{ contents = [TextResource $ TextResourceContents u txt (Just mime) Nothing]
, _meta = Nothing
}
-- ---------------------------------------------------------------------------
-- Resource Templates
-- ---------------------------------------------------------------------------
-- | Resource templates advertised by the server.
--
-- Templates use RFC 6570 URI syntax (e.g. @{userId}@). Clients can discover
-- them via @resources\/templates\/list@ and then construct concrete URIs to pass
-- to @resources\/read@.
exampleResourceTemplates :: [ResourceTemplate]
exampleResourceTemplates =
[ ResourceTemplate
{ name = "user-profile"
, title = Just "User Profile"
, uriTemplate = "resource://example/users/{userId}"
, description = Just "Returns a JSON profile for a given user ID"
, mimeType = Just "application/json"
, annotations = Nothing
, _meta = Nothing
}
]
-- ---------------------------------------------------------------------------
-- Prompts
-- ---------------------------------------------------------------------------
-- | Prompt templates advertised by the server.
--
-- Prompts are reusable conversation starters. Each prompt declares its
-- arguments (name, description, required flag) so clients can present a form
-- and fill in the values before calling @prompts\/get@.
examplePrompts :: [Prompt]
examplePrompts =
[ Prompt
{ name = "summarize"
, title = Just "Summarize Text"
, description = Just "Asks the LLM to produce a concise summary of the provided text"
, arguments =
Just
[ PromptArgument
{ name = "text"
, title = Just "Text to summarize"
, description = Just "The text content to summarize"
, required = Just True
}
]
, _meta = Nothing
}
]
-- | Handle @prompts\/get@ requests.
--
-- Returns a list of 'PromptMessage' values that form a conversation.
-- The 'User' message includes the argument value; the 'Assistant' message
-- primes the model with a helpful starting response.
getPrompt :: GetPromptParams -> MCPServerT (ProcessResult GetPromptResult)
getPrompt = \case
GetPromptParams{name = "summarize", arguments = Just args} -> do
let txt = Map.findWithDefault "" "text" args
let msgs =
[ PromptMessage
{ role = User
, content = TextBlock $ TextContent "text" ("Please summarize the following text:\n\n" <> txt) Nothing Nothing
}
, PromptMessage
{ role = Assistant
, content = TextBlock $ TextContent "text" "I'll provide a concise summary of the text." Nothing Nothing
}
]
return $
ProcessSuccess $
GetPromptResult
{ description = Just "A prompt to summarize text"
, messages = msgs
, _meta = Nothing
}
_ -> return $ ProcessRPCError 404 "Prompt not found"
-- ---------------------------------------------------------------------------
-- Completions
-- ---------------------------------------------------------------------------
-- | Handle @completion\/complete@ requests.
--
-- Returns auto-complete suggestions for prompt argument values. The client
-- sends the argument name and a partial value; the server responds with
-- matching completions. Here we return a fixed set of suggestions for the
-- @text@ argument of the @summarize@ prompt.
handleComplete :: CompleteParams -> MCPServerT (ProcessResult CompleteResult)
handleComplete (CompleteParams _ref (CompletionArgument arg_name _) _ctx) =
case arg_name of
"text" ->
return $
ProcessSuccess $
CompleteResult
{ completion =
CompletionResult
{ values = ["Hello world", "Lorem ipsum dolor sit amet", "The quick brown fox"]
, total = Just 3
, hasMore = Just False
}
, _meta = Nothing
}
_ ->
return $
ProcessSuccess $
CompleteResult
{ completion = CompletionResult{values = [], total = Just 0, hasMore = Just False}
, _meta = Nothing
}
-- ---------------------------------------------------------------------------
-- Process handlers
-- ---------------------------------------------------------------------------
-- | Assemble all handlers into a single 'ProcessHandlers' record.
--
-- Start from 'defaultProcessHandlers' (all fields 'Nothing'), override the
-- capabilities you want, then apply 'withToolHandlers' to wire up tool
-- listing and dispatch automatically.
--
-- Note that 'withToolHandlers' overwrites @listToolsHandler@ and
-- @callToolHandler@, so it should be the outermost wrapper.
exampleHandlers :: ProcessHandlers
exampleHandlers =
withToolHandlers exampleTools $
defaultProcessHandlers
{ listResourcesHandler = Just $ \_ ->
return $
ProcessSuccess $
ListResourcesResult
{ resources = exampleResources
, nextCursor = Nothing
, _meta = Nothing
}
, readResourceHandler = Just readResource
, listPromptsHandler = Just $ \_ ->
return $
ProcessSuccess $
ListPromptsResult
{ prompts = examplePrompts
, nextCursor = Nothing
, _meta = Nothing
}
, getPromptHandler = Just getPrompt
, listResourceTemplatesHandler = Just $ \_ ->
return $
ProcessSuccess $
ListResourceTemplatesResult
{ resourceTemplates = exampleResourceTemplates
, nextCursor = Nothing
, _meta = Nothing
}
, completeHandler = Just handleComplete
}
-- ---------------------------------------------------------------------------
-- Server capabilities
-- ---------------------------------------------------------------------------
-- | Declare which MCP capabilities this server supports.
--
-- The client receives these during the @initialize@ handshake so it knows
-- which methods are available. Setting a capability to 'Nothing' means the
-- server does not support it; setting @listChanged = Just True@ advertises
-- that the server may send @notifications\/tools\/list_changed@ at runtime.
exampleCapabilities :: ServerCapabilities
exampleCapabilities =
ServerCapabilities
{ logging = Just LoggingCapability
, prompts = Just PromptsCapability{listChanged = Nothing}
, resources = Just ResourcesCapability{listChanged = Nothing, subscribe = Nothing}
, tools = Just ToolsCapability{listChanged = Just True}
, completions = Just CompletionsCapability
, experimental = Nothing
}
-- ---------------------------------------------------------------------------
-- Lifecycle hooks
-- ---------------------------------------------------------------------------
-- | Called once when the client sends @initialize@.
--
-- Use this to set up per-session state — open database connections, load
-- configuration, etc. The authenticated user is provided so you can
-- personalise the session.
handleInit :: ExampleUser -> ExampleState -> IO ExampleState
handleInit user st = do
putStrLn $ "Session initialized for user: " <> T.unpack (userId user)
return st{currentUser = Just (userId user)}
-- | Called after every request.
--
-- Use this for cleanup — close cursors, flush buffers, etc. In this example
-- we simply clear the current user.
handleFinalize :: ExampleState -> IO ExampleState
handleFinalize st = return st{currentUser = Nothing}
-- ---------------------------------------------------------------------------
-- Main
-- ---------------------------------------------------------------------------
-- | Entry point.
--
-- Supports three modes:
--
-- * __HTTP mode__ (default): starts a Warp server with JWT authentication.
-- * __Simple HTTP mode__ (@--simple-http@): starts a Warp server without
-- authentication. Only use locally or behind an authenticating proxy.
-- * __Stdio mode__ (@--stdio@): reads JSON-RPC from stdin, writes to stdout.
-- No authentication is needed. Debug output goes to stderr.
--
-- @
-- cabal run mcp-example # HTTP with JWT on port 8080
-- cabal run mcp-example -- --simple-http # HTTP without auth on port 8080
-- cabal run mcp-example -- --stdio # stdio transport
-- @
main :: IO ()
main = putStrLn "Hello, Haskell!"
main = do
args <- getArgs
if "--stdio" `elem` args
then mainStdio
else
if "--simple-http" `elem` args
then mainSimpleHTTP
else mainHTTP
-- | Run in stdio transport mode.
--
-- Reads JSON-RPC messages from stdin and writes responses to stdout.
-- There is no JWT authentication — the caller is trusted.
-- Debug/log output goes to stderr so it doesn't interfere with the protocol.
mainStdio :: IO ()
mainStdio = do
hSetBuffering stderr LineBuffering
let impl = Implementation "mcp-example" "0.1.0" (Just "Example MCP Server")
let server_instructions = Just "This is an example MCP server. It provides echo, add, and current-time tools, sample resources, a summarize prompt, and completions."
let initial_state =
(initMCPServerState
(ExampleState Nothing) -- initial handler state
Nothing -- no handler init in stdio mode (no JWT user)
(Just handleFinalize) -- lifecycle: after each request
exampleCapabilities -- what we support
impl -- server name + version
server_instructions -- instructions for clients
exampleHandlers -- all our handlers
){mcp_log_level = Just Debug}
serveStdio stdin stdout initial_state
-- | Run in simple HTTP mode without authentication.
--
-- No JWT or servant-auth. This transport should only be used locally or
-- behind a reverse proxy that handles authentication.
--
-- @
-- cabal run mcp-example -- --simple-http
-- @
mainSimpleHTTP :: IO ()
mainSimpleHTTP = do
hSetBuffering stdout LineBuffering
port <- maybe 8080 read <$> lookupEnv "PORT"
let impl = Implementation "mcp-example" "0.1.0" (Just "Example MCP Server (SimpleHTTP)")
let server_instructions = Just "This is an example MCP server using the SimpleHTTP transport. It provides echo, add, and current-time tools, sample resources, a summarize prompt, and completions."
let initial_state =
(initMCPServerState
(ExampleState Nothing) -- initial handler state
Nothing -- no handler init (no user type in SimpleHTTP)
(Just handleFinalize) -- lifecycle: after each request
exampleCapabilities -- what we support
impl -- server name + version
server_instructions -- instructions for clients
exampleHandlers -- all our handlers
){mcp_log_level = Just Debug}
state_var <- newMVar initial_state
putStrLn "=== Example MCP Server (SimpleHTTP) ==="
putStrLn $ "Listening on http://localhost:" <> show port <> "/mcp"
putStrLn "WARNING: No authentication — only use locally or behind an authenticating proxy."
putStrLn ""
putStrLn "Example curl:"
putStrLn $ " curl -X POST http://localhost:" <> show port <> "/mcp \\"
putStrLn " -H 'Content-Type: application/json' \\"
putStrLn " -d '{\"jsonrpc\":\"2.0\",\"id\":1,\"method\":\"initialize\",\"params\":{\"protocolVersion\":\"2025-06-18\",\"capabilities\":{},\"clientInfo\":{\"name\":\"curl\",\"version\":\"1.0\"}}}'"
let app = simpleHttpApp state_var
Warp.run port app
-- | Run in HTTP mode with JWT authentication.
mainHTTP :: IO ()
mainHTTP = do
-- Use line buffering so output is visible immediately when piped.
hSetBuffering stdout LineBuffering
-- Read port from PORT env var, default to 8080.
port <- maybe 8080 read <$> lookupEnv "PORT"
-- Server metadata shown to clients during initialization.
let impl = Implementation "mcp-example" "0.1.0" (Just "Example MCP Server")
-- Free-text instructions sent to clients on initialization.
let server_instructions = Just "This is an example MCP server. It provides echo, add, and current-time tools, sample resources, a summarize prompt, and completions."
-- Create the initial server state. initMCPServerState sets sensible
-- defaults: not yet initialized, log level Warning, empty pending responses.
-- We override the log level to Debug so all requests/responses are logged.
let initial_state =
(initMCPServerState
(ExampleState Nothing) -- initial handler state
(Just handleInit) -- lifecycle: on initialize
(Just handleFinalize) -- lifecycle: after each request
exampleCapabilities -- what we support
impl -- server name + version
server_instructions -- instructions for clients
exampleHandlers -- all our handlers
){mcp_log_level = Just Debug}
state_var <- newMVar initial_state
-- Generate a fresh JWK key for signing tokens.
key <- AuthServer.generateKey
let jwt_cfg = AuthServer.defaultJWTSettings key
let cookie_cfg = AuthServer.defaultCookieSettings
-- The Servant context carries the auth configuration used by servant-auth.
let ctx = cookie_cfg :. jwt_cfg :. EmptyContext
-- Mint a JWT for a test user so you can start making requests immediately.
let test_user = ExampleUser "example-user" "Example User"
token_result <- AuthServer.makeJWT test_user jwt_cfg Nothing
case token_result of
Left err -> putStrLn $ "Failed to generate JWT: " <> show err
Right token -> do
let token_str = TE.decodeUtf8 $ BSL.toStrict token
putStrLn "=== Example MCP Server ==="
putStrLn $ "Listening on http://localhost:" <> show port <> "/mcp"
putStrLn ""
putStrLn "Bearer token for testing:"
putStrLn $ T.unpack token_str
putStrLn ""
putStrLn "Example curl:"
putStrLn $ " curl -X POST http://localhost:" <> show port <> "/mcp \\"
putStrLn " -H 'Content-Type: application/json' \\"
putStrLn $ " -H 'Authorization: Bearer " <> T.unpack token_str <> "' \\"
putStrLn " -d '{\"jsonrpc\":\"2.0\",\"id\":1,\"method\":\"initialize\",\"params\":{\"protocolVersion\":\"2025-06-18\",\"capabilities\":{},\"clientInfo\":{\"name\":\"curl\",\"version\":\"1.0\"}}}'"
-- Build the Servant application and start Warp.
let app = serveWithContext (Proxy @MCPAPI) ctx (mcpAPI state_var)
Warp.run port app
-- ---------------------------------------------------------------------------
-- JSON value helpers
-- ---------------------------------------------------------------------------
-- | Extract a 'Text' from a JSON 'Value', returning 'Nothing' for non-strings.
asText :: Value -> Maybe Text
asText (Aeson.String t) = Just t
asText _ = Nothing
-- | Extract a 'Double' from a JSON 'Value', returning 'Nothing' for non-numbers.
asNumber :: Value -> Maybe Double
asNumber (Aeson.Number n) = Just (realToFrac n)
asNumber _ = Nothing

11
mcp-config.json Normal file
View File

@ -0,0 +1,11 @@
{
"mcpServers": {
"mcp-example": {
"url": "http://localhost:8080/mcp",
"headers": {
"Authorization": "Bearer <PASTE_TOKEN_FROM_SERVER_OUTPUT>"
},
"description": "Example MCP server demonstrating tools, resources, prompts, and completions. Start the server first with: cabal run mcp-example"
}
}
}

View File

@ -1,16 +1,20 @@
cabal-version: 3.0
name: hello-hs
name: mcp-example
version: 0.1.0.0
license-file: LICENSE
author: George Thomas
maintainer: georgefsthomas@gmail.com
executable hello-hs
executable mcp-example
main-is: Main.hs
hs-source-dirs: app
default-language: GHC2021
default-extensions:
DuplicateRecordFields
LambdaCase
ghc-options:
-Wall
-threaded
build-depends:
base,
aeson,
@ -29,3 +33,4 @@ executable hello-hs
time,
transformers,
wai,
warp,

1
test/.gitignore vendored Normal file
View File

@ -0,0 +1 @@
node_modules/

12
test/package.json Normal file
View File

@ -0,0 +1,12 @@
{
"name": "mcp-example-test",
"version": "0.1.0",
"private": true,
"type": "module",
"scripts": {
"test": "node test_mcp_server.mjs"
},
"dependencies": {
"@anthropic-ai/claude-agent-sdk": "^0.2.42"
}
}

193
test/pnpm-lock.yaml generated Normal file
View File

@ -0,0 +1,193 @@
lockfileVersion: '9.0'
settings:
autoInstallPeers: true
excludeLinksFromLockfile: false
importers:
.:
dependencies:
'@anthropic-ai/claude-agent-sdk':
specifier: ^0.2.42
version: 0.2.42(zod@4.3.6)
packages:
'@anthropic-ai/claude-agent-sdk@0.2.42':
resolution: {integrity: sha512-/CugP7AjP57Dqtl2sbsDtxdbpQoPKIhjyF5WrTViGu4NHQdM+UikrRs4MhZ2jeotiC5R7iK9ZUN9SiBgcZ8oLw==}
engines: {node: '>=18.0.0'}
peerDependencies:
zod: ^4.0.0
'@img/sharp-darwin-arm64@0.33.5':
resolution: {integrity: sha512-UT4p+iz/2H4twwAoLCqfA9UH5pI6DggwKEGuaPy7nCVQ8ZsiY5PIcrRvD1DzuY3qYL07NtIQcWnBSY/heikIFQ==}
engines: {node: ^18.17.0 || ^20.3.0 || >=21.0.0}
cpu: [arm64]
os: [darwin]
'@img/sharp-darwin-x64@0.33.5':
resolution: {integrity: sha512-fyHac4jIc1ANYGRDxtiqelIbdWkIuQaI84Mv45KvGRRxSAa7o7d1ZKAOBaYbnepLC1WqxfpimdeWfvqqSGwR2Q==}
engines: {node: ^18.17.0 || ^20.3.0 || >=21.0.0}
cpu: [x64]
os: [darwin]
'@img/sharp-libvips-darwin-arm64@1.0.4':
resolution: {integrity: sha512-XblONe153h0O2zuFfTAbQYAX2JhYmDHeWikp1LM9Hul9gVPjFY427k6dFEcOL72O01QxQsWi761svJ/ev9xEDg==}
cpu: [arm64]
os: [darwin]
'@img/sharp-libvips-darwin-x64@1.0.4':
resolution: {integrity: sha512-xnGR8YuZYfJGmWPvmlunFaWJsb9T/AO2ykoP3Fz/0X5XV2aoYBPkX6xqCQvUTKKiLddarLaxpzNe+b1hjeWHAQ==}
cpu: [x64]
os: [darwin]
'@img/sharp-libvips-linux-arm64@1.0.4':
resolution: {integrity: sha512-9B+taZ8DlyyqzZQnoeIvDVR/2F4EbMepXMc/NdVbkzsJbzkUjhXv/70GQJ7tdLA4YJgNP25zukcxpX2/SueNrA==}
cpu: [arm64]
os: [linux]
libc: [glibc]
'@img/sharp-libvips-linux-arm@1.0.5':
resolution: {integrity: sha512-gvcC4ACAOPRNATg/ov8/MnbxFDJqf/pDePbBnuBDcjsI8PssmjoKMAz4LtLaVi+OnSb5FK/yIOamqDwGmXW32g==}
cpu: [arm]
os: [linux]
libc: [glibc]
'@img/sharp-libvips-linux-x64@1.0.4':
resolution: {integrity: sha512-MmWmQ3iPFZr0Iev+BAgVMb3ZyC4KeFc3jFxnNbEPas60e1cIfevbtuyf9nDGIzOaW9PdnDciJm+wFFaTlj5xYw==}
cpu: [x64]
os: [linux]
libc: [glibc]
'@img/sharp-libvips-linuxmusl-arm64@1.0.4':
resolution: {integrity: sha512-9Ti+BbTYDcsbp4wfYib8Ctm1ilkugkA/uscUn6UXK1ldpC1JjiXbLfFZtRlBhjPZ5o1NCLiDbg8fhUPKStHoTA==}
cpu: [arm64]
os: [linux]
libc: [musl]
'@img/sharp-libvips-linuxmusl-x64@1.0.4':
resolution: {integrity: sha512-viYN1KX9m+/hGkJtvYYp+CCLgnJXwiQB39damAO7WMdKWlIhmYTfHjwSbQeUK/20vY154mwezd9HflVFM1wVSw==}
cpu: [x64]
os: [linux]
libc: [musl]
'@img/sharp-linux-arm64@0.33.5':
resolution: {integrity: sha512-JMVv+AMRyGOHtO1RFBiJy/MBsgz0x4AWrT6QoEVVTyh1E39TrCUpTRI7mx9VksGX4awWASxqCYLCV4wBZHAYxA==}
engines: {node: ^18.17.0 || ^20.3.0 || >=21.0.0}
cpu: [arm64]
os: [linux]
libc: [glibc]
'@img/sharp-linux-arm@0.33.5':
resolution: {integrity: sha512-JTS1eldqZbJxjvKaAkxhZmBqPRGmxgu+qFKSInv8moZ2AmT5Yib3EQ1c6gp493HvrvV8QgdOXdyaIBrhvFhBMQ==}
engines: {node: ^18.17.0 || ^20.3.0 || >=21.0.0}
cpu: [arm]
os: [linux]
libc: [glibc]
'@img/sharp-linux-x64@0.33.5':
resolution: {integrity: sha512-opC+Ok5pRNAzuvq1AG0ar+1owsu842/Ab+4qvU879ippJBHvyY5n2mxF1izXqkPYlGuP/M556uh53jRLJmzTWA==}
engines: {node: ^18.17.0 || ^20.3.0 || >=21.0.0}
cpu: [x64]
os: [linux]
libc: [glibc]
'@img/sharp-linuxmusl-arm64@0.33.5':
resolution: {integrity: sha512-XrHMZwGQGvJg2V/oRSUfSAfjfPxO+4DkiRh6p2AFjLQztWUuY/o8Mq0eMQVIY7HJ1CDQUJlxGGZRw1a5bqmd1g==}
engines: {node: ^18.17.0 || ^20.3.0 || >=21.0.0}
cpu: [arm64]
os: [linux]
libc: [musl]
'@img/sharp-linuxmusl-x64@0.33.5':
resolution: {integrity: sha512-WT+d/cgqKkkKySYmqoZ8y3pxx7lx9vVejxW/W4DOFMYVSkErR+w7mf2u8m/y4+xHe7yY9DAXQMWQhpnMuFfScw==}
engines: {node: ^18.17.0 || ^20.3.0 || >=21.0.0}
cpu: [x64]
os: [linux]
libc: [musl]
'@img/sharp-win32-x64@0.33.5':
resolution: {integrity: sha512-MpY/o8/8kj+EcnxwvrP4aTJSWw/aZ7JIGR4aBeZkZw5B7/Jn+tY9/VNwtcoGmdT7GfggGIU4kygOMSbYnOrAbg==}
engines: {node: ^18.17.0 || ^20.3.0 || >=21.0.0}
cpu: [x64]
os: [win32]
zod@4.3.6:
resolution: {integrity: sha512-rftlrkhHZOcjDwkGlnUtZZkvaPHCsDATp4pGpuOOMDaTdDDXF91wuVDJoWoPsKX/3YPQ5fHuF3STjcYyKr+Qhg==}
snapshots:
'@anthropic-ai/claude-agent-sdk@0.2.42(zod@4.3.6)':
dependencies:
zod: 4.3.6
optionalDependencies:
'@img/sharp-darwin-arm64': 0.33.5
'@img/sharp-darwin-x64': 0.33.5
'@img/sharp-linux-arm': 0.33.5
'@img/sharp-linux-arm64': 0.33.5
'@img/sharp-linux-x64': 0.33.5
'@img/sharp-linuxmusl-arm64': 0.33.5
'@img/sharp-linuxmusl-x64': 0.33.5
'@img/sharp-win32-x64': 0.33.5
'@img/sharp-darwin-arm64@0.33.5':
optionalDependencies:
'@img/sharp-libvips-darwin-arm64': 1.0.4
optional: true
'@img/sharp-darwin-x64@0.33.5':
optionalDependencies:
'@img/sharp-libvips-darwin-x64': 1.0.4
optional: true
'@img/sharp-libvips-darwin-arm64@1.0.4':
optional: true
'@img/sharp-libvips-darwin-x64@1.0.4':
optional: true
'@img/sharp-libvips-linux-arm64@1.0.4':
optional: true
'@img/sharp-libvips-linux-arm@1.0.5':
optional: true
'@img/sharp-libvips-linux-x64@1.0.4':
optional: true
'@img/sharp-libvips-linuxmusl-arm64@1.0.4':
optional: true
'@img/sharp-libvips-linuxmusl-x64@1.0.4':
optional: true
'@img/sharp-linux-arm64@0.33.5':
optionalDependencies:
'@img/sharp-libvips-linux-arm64': 1.0.4
optional: true
'@img/sharp-linux-arm@0.33.5':
optionalDependencies:
'@img/sharp-libvips-linux-arm': 1.0.5
optional: true
'@img/sharp-linux-x64@0.33.5':
optionalDependencies:
'@img/sharp-libvips-linux-x64': 1.0.4
optional: true
'@img/sharp-linuxmusl-arm64@0.33.5':
optionalDependencies:
'@img/sharp-libvips-linuxmusl-arm64': 1.0.4
optional: true
'@img/sharp-linuxmusl-x64@0.33.5':
optionalDependencies:
'@img/sharp-libvips-linuxmusl-x64': 1.0.4
optional: true
'@img/sharp-win32-x64@0.33.5':
optional: true
zod@4.3.6: {}

525
test/test_mcp_server.mjs Normal file
View File

@ -0,0 +1,525 @@
#!/usr/bin/env node
/**
* Test the example MCP server using the Claude Agent SDK.
*
* Builds the example server once, then exercises every tool endpoint
* over HTTP (JWT), simple HTTP (unauthenticated), and stdio transports.
*
* Usage:
* # From the repository root:
* cabal build mcp-example
* cd mcp-server/example/test
* npm install
* npm test
*
* Requires:
* - ANTHROPIC_API_KEY environment variable set
* - GHC 9.12 + cabal (to build the server)
*/
import { query } from "@anthropic-ai/claude-agent-sdk";
import { execSync, spawn } from "node:child_process";
import { createServer } from "node:net";
import { existsSync } from "node:fs";
import { dirname, join } from "node:path";
import { fileURLToPath } from "node:url";
import http from "node:http";
const __dirname = dirname(fileURLToPath(import.meta.url));
// ---------------------------------------------------------------------------
// Server management
// ---------------------------------------------------------------------------
function findRepoRoot() {
let d = __dirname;
for (let i = 0; i < 10; i++) {
if (existsSync(join(d, "cabal.project"))) return d;
d = dirname(d);
}
return null;
}
function buildServer(repoRoot) {
console.log(" Building mcp-example (this may take a while)...");
execSync("cabal build mcp-example", { cwd: repoRoot, stdio: "inherit" });
console.log(" Build succeeded.");
}
function getServerBin(repoRoot) {
return execSync("cabal list-bin mcp-example", {
cwd: repoRoot,
encoding: "utf-8",
}).trim();
}
function getFreePort() {
return new Promise((resolve, reject) => {
const srv = createServer();
srv.listen(0, () => {
const { port } = srv.address();
srv.close(() => resolve(port));
});
srv.on("error", reject);
});
}
function startServer(repoRoot, port) {
return new Promise((resolve, reject) => {
console.log(` repo root: ${repoRoot}`);
console.log(` port: ${port}`);
const serverBin = getServerBin(repoRoot);
console.log(` binary: ${serverBin}`);
const proc = spawn(serverBin, [], {
cwd: repoRoot,
stdio: ["ignore", "pipe", "pipe"],
env: { ...process.env, PORT: String(port) },
});
proc.stderr.on("data", (chunk) => {
for (const line of chunk.toString().split("\n").filter(Boolean)) {
console.log(` [server:stderr] ${line}`);
}
});
let token = null;
const deadline = Date.now() + 30_000;
console.log(" Waiting for server to print JWT token...");
let buf = "";
proc.stdout.on("data", (chunk) => {
buf += chunk.toString();
const lines = buf.split("\n");
buf = lines.pop(); // keep incomplete trailing line
for (const raw of lines) {
const line = raw.trim();
console.log(` [server:stdout] ${line}`);
if (!token && line.startsWith("eyJ")) {
token = line;
}
}
});
const check = setInterval(() => {
if (token) {
clearInterval(check);
// Give the server a moment to finish binding.
setTimeout(() => verifyAndResolve(), 1000);
} else if (Date.now() > deadline) {
clearInterval(check);
proc.kill();
reject(new Error("Timed out waiting for JWT token"));
}
}, 200);
function verifyAndResolve() {
console.log(" Verifying server is reachable...");
const body = JSON.stringify({
jsonrpc: "2.0",
id: 1,
method: "ping",
});
const req = http.request(
{
hostname: "localhost",
port,
path: "/mcp",
method: "POST",
headers: {
"Content-Type": "application/json",
Authorization: `Bearer ${token}`,
},
},
(res) => {
let data = "";
res.on("data", (c) => (data += c));
res.on("end", () => {
console.log(` Server responded: ${data.slice(0, 200)}`);
resolve({ proc, token });
});
},
);
req.on("error", (e) => {
proc.kill();
reject(new Error(`Server not reachable on port ${port}: ${e.message}`));
});
req.end(body);
}
proc.on("error", (err) => {
clearInterval(check);
reject(err);
});
proc.on("exit", (code) => {
if (!token) {
clearInterval(check);
reject(new Error(`Server exited with code ${code} before printing token`));
}
});
});
}
function startSimpleHTTPServer(repoRoot, port) {
return new Promise((resolve, reject) => {
console.log(` repo root: ${repoRoot}`);
console.log(` port: ${port}`);
const serverBin = getServerBin(repoRoot);
console.log(` binary: ${serverBin}`);
const proc = spawn(serverBin, ["--simple-http"], {
cwd: repoRoot,
stdio: ["ignore", "pipe", "pipe"],
env: { ...process.env, PORT: String(port) },
});
proc.stderr.on("data", (chunk) => {
for (const line of chunk.toString().split("\n").filter(Boolean)) {
console.log(` [server:stderr] ${line}`);
}
});
let ready = false;
const deadline = Date.now() + 30_000;
console.log(" Waiting for simple HTTP server to start...");
let buf = "";
proc.stdout.on("data", (chunk) => {
buf += chunk.toString();
const lines = buf.split("\n");
buf = lines.pop(); // keep incomplete trailing line
for (const raw of lines) {
const line = raw.trim();
console.log(` [server:stdout] ${line}`);
if (!ready && line.includes("Listening on")) {
ready = true;
}
}
});
const check = setInterval(() => {
if (ready) {
clearInterval(check);
// Give the server a moment to finish binding.
setTimeout(() => verifyAndResolve(), 1000);
} else if (Date.now() > deadline) {
clearInterval(check);
proc.kill();
reject(new Error("Timed out waiting for simple HTTP server"));
}
}, 200);
function verifyAndResolve() {
console.log(" Verifying server is reachable...");
const body = JSON.stringify({
jsonrpc: "2.0",
id: 1,
method: "ping",
});
const req = http.request(
{
hostname: "localhost",
port,
path: "/mcp",
method: "POST",
headers: {
"Content-Type": "application/json",
},
},
(res) => {
let data = "";
res.on("data", (c) => (data += c));
res.on("end", () => {
console.log(` Server responded: ${data.slice(0, 200)}`);
resolve({ proc });
});
},
);
req.on("error", (e) => {
proc.kill();
reject(new Error(`Server not reachable on port ${port}: ${e.message}`));
});
req.end(body);
}
proc.on("error", (err) => {
clearInterval(check);
reject(err);
});
proc.on("exit", (code) => {
if (!ready) {
clearInterval(check);
reject(new Error(`Server exited with code ${code} before becoming ready`));
}
});
});
}
function stopServer(proc) {
proc.kill("SIGTERM");
setTimeout(() => proc.kill("SIGKILL"), 5000);
}
// ---------------------------------------------------------------------------
// Agent runner
// ---------------------------------------------------------------------------
const TEST_PROMPT = `\
You MUST call these MCP tools directly as tool calls (do NOT use Bash or any other tool):
1. Call mcp__mcp-example__echo with {"message": "Hello MCP!"} report the returned text.
2. Call mcp__mcp-example__add with {"a": 17, "b": 25} report the numeric result.
3. Call mcp__mcp-example__current-time with {} report the returned time string.
After all three tool calls, print "ALL TESTS DONE".
`;
const AGENT_TIMEOUT_MS = 120_000;
async function runAgent(mcpServers) {
const fullText = [];
console.log(" Starting agent (connecting to MCP server + API)...");
const controller = new AbortController();
const timer = setTimeout(() => {
console.log(` ERROR: Agent timed out after ${AGENT_TIMEOUT_MS / 1000}s`);
controller.abort();
}, AGENT_TIMEOUT_MS);
try {
for await (const message of query({
prompt: TEST_PROMPT,
options: {
mcpServers,
allowedTools: ["mcp__mcp-example__*"],
disallowedTools: [
"Bash",
"Read",
"Edit",
"Write",
"Glob",
"Grep",
"WebFetch",
"WebSearch",
"NotebookEdit",
"TodoWrite",
"Task",
],
permissionMode: "bypassPermissions",
allowDangerouslySkipPermissions: true,
maxTurns: 10,
settingSources: [],
abortController: controller,
},
})) {
if (message.type === "system" && message.subtype === "init") {
console.log(
` [system:init] model=${message.model} tools=${JSON.stringify(message.tools)} mcp=${JSON.stringify(message.mcp_servers)}`,
);
} else if (message.type === "assistant") {
for (const block of message.message.content) {
if ("text" in block) {
console.log(` [assistant] ${block.text.slice(0, 200)}`);
fullText.push(block.text);
} else if ("name" in block) {
console.log(
` [tool_use] ${block.name}(${JSON.stringify(block.input).slice(0, 200)})`,
);
}
}
} else if (message.type === "user") {
const content = message.message?.content;
if (Array.isArray(content)) {
for (const block of content) {
if (block.type === "tool_result") {
const text =
typeof block.content === "string"
? block.content
: JSON.stringify(block.content);
console.log(` [tool_result] ${text?.slice(0, 200)}`);
if (text) fullText.push(text);
}
}
}
} else if (message.type === "result") {
console.log(
` [result] subtype=${message.subtype} turns=${message.num_turns} cost=$${message.total_cost_usd}`,
);
if (message.subtype !== "success") {
console.log(` [result] errors: ${message.errors}`);
}
}
}
} catch (err) {
if (err.name === "AbortError") {
console.log(" Agent aborted (timeout).");
} else {
console.log(` ERROR in query(): ${err.message}`);
}
} finally {
clearTimeout(timer);
}
return fullText.join("\n");
}
// ---------------------------------------------------------------------------
// Result checking
// ---------------------------------------------------------------------------
const CHECKS = [
["echo tool", (t) => t.includes("Hello MCP!")],
["add tool", (t) => t.includes("42")],
["current-time tool", (t) => /\d{4}-\d{2}-\d{2}/.test(t)],
];
function evaluate(output) {
let passed = 0;
let failed = 0;
for (const [name, check] of CHECKS) {
if (check(output)) {
console.log(` PASS: ${name}`);
passed++;
} else {
console.log(` FAIL: ${name}`);
failed++;
}
}
return { passed, failed };
}
// ---------------------------------------------------------------------------
// Transport tests
// ---------------------------------------------------------------------------
async function testHTTP(repoRoot) {
const port = await getFreePort();
console.log(`Starting MCP example server on port ${port}...`);
const { proc, token } = await startServer(repoRoot, port);
console.log(`Server started (token: ${token.slice(0, 20)}...)`);
try {
console.log("\nRunning HTTP agent tests...");
const output = await runAgent({
"mcp-example": {
type: "http",
url: `http://localhost:${port}/mcp`,
headers: {
Authorization: `Bearer ${token}`,
},
},
});
console.log("\n--- HTTP agent output ---");
console.log(output);
console.log("--- End HTTP agent output ---\n");
console.log("HTTP results:");
return evaluate(output);
} finally {
console.log("\nStopping HTTP server...");
stopServer(proc);
}
}
async function testSimpleHTTP(repoRoot) {
const port = await getFreePort();
console.log(`Starting simple HTTP MCP server on port ${port}...`);
const { proc } = await startSimpleHTTPServer(repoRoot, port);
console.log("Server started (no auth).");
try {
console.log("\nRunning simple HTTP agent tests...");
const output = await runAgent({
"mcp-example": {
type: "http",
url: `http://localhost:${port}/mcp`,
},
});
console.log("\n--- Simple HTTP agent output ---");
console.log(output);
console.log("--- End simple HTTP agent output ---\n");
console.log("Simple HTTP results:");
return evaluate(output);
} finally {
console.log("\nStopping simple HTTP server...");
stopServer(proc);
}
}
async function testStdio(serverBin) {
console.log("\nRunning stdio agent tests...");
console.log(` binary: ${serverBin}`);
const output = await runAgent({
"mcp-example": {
type: "stdio",
command: serverBin,
args: ["--stdio"],
},
});
console.log("\n--- Stdio agent output ---");
console.log(output);
console.log("--- End stdio agent output ---\n");
console.log("Stdio results:");
return evaluate(output);
}
// ---------------------------------------------------------------------------
// Main
// ---------------------------------------------------------------------------
async function main() {
if (!process.env.ANTHROPIC_API_KEY) {
console.error("Error: ANTHROPIC_API_KEY environment variable not set");
process.exit(1);
}
const repoRoot = findRepoRoot();
if (!repoRoot) {
console.error("Error: could not find repository root (cabal.project)");
process.exit(1);
}
// Build once, reuse for all transports.
buildServer(repoRoot);
const serverBin = getServerBin(repoRoot);
let totalPassed = 0;
let totalFailed = 0;
// --- HTTP ---
{
const { passed, failed } = await testHTTP(repoRoot);
totalPassed += passed;
totalFailed += failed;
}
// --- Simple HTTP ---
{
const { passed, failed } = await testSimpleHTTP(repoRoot);
totalPassed += passed;
totalFailed += failed;
}
// --- Stdio ---
{
const { passed, failed } = await testStdio(serverBin);
totalPassed += passed;
totalFailed += failed;
}
console.log(`\nOverall: ${totalPassed}/${totalPassed + totalFailed} checks passed`);
if (totalFailed > 0) process.exit(1);
console.log("Done.");
}
main().catch((err) => {
console.error(err);
process.exit(1);
});