mcp 0.1.0.0 → 0.1.1.0

raw patch · 10 files changed

+1167/−271 lines, 10 filesdep +http-typesdep +optparse-applicativedep +servantnew-component:exe:mcp-httpPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: http-types, optparse-applicative, servant, servant-server, wai, wai-extra, warp

API changes (from Hackage documentation)

Files

• app/Main.hs +3/−2
• examples/README.md +253/−0
• examples/claude-desktop-config.json +24/−0
• examples/full-config-example.json +34/−0
• examples/http-server.hs +176/−0
• examples/test-mcp-server.sh +62/−0
• mcp.cabal +54/−3
• src/MCP/Server.hs +12/−266
• src/MCP/Server/HTTP.hs +267/−0
• src/MCP/Server/StdIO.hs +282/−0

@@ -11,6 +11,7 @@  import MCP.Protocol import MCP.Server+import MCP.Server.StdIO import MCP.Types  -- | Minimal MCP Server implementation@@ -100,7 +101,7 @@                 }      let config =-            ServerConfig+            MCP.Server.StdIO.ServerConfig                 { configInput = stdin                 , configOutput = stdout                 , configServerInfo = serverInfo@@ -108,4 +109,4 @@                 }      putStrLn "Server configured, starting message loop..."-    runServer config+    MCP.Server.StdIO.runServer config

@@ -0,0 +1,253 @@+# MCP Configuration Examples and Usage++This directory contains example configuration files for connecting MCP clients to the Haskell MCP server, as well as example implementations demonstrating different transport methods.++## Claude Desktop Configuration++Claude Desktop reads its MCP server configuration from a JSON file. The location depends on your operating system:++### Configuration File Locations++- **macOS**: `~/Library/Application Support/Claude/claude_desktop_config.json`+- **Windows**: `%APPDATA%\Claude\claude_desktop_config.json`+- **Linux**: `~/.config/claude/claude_desktop_config.json`++### Basic Configuration++```json+{+  "mcpServers": {+    "haskell-mcp": {+      "command": "cabal",+      "args": ["run", "mcp"],+      "cwd": "/absolute/path/to/mcp-haskell"+    }+  }+}+```++### Development Setup++For development with Cabal:++```json+{+  "mcpServers": {+    "haskell-mcp-dev": {+      "command": "cabal",+      "args": ["run", "mcp"],+      "cwd": "/home/user/projects/mcp-haskell",+      "env": {+        "GHC_ENVIRONMENT": "-"+      }+    }+  }+}+```++### Production Setup++For production with a compiled binary:++```json+{+  "mcpServers": {+    "haskell-mcp-prod": {+      "command": "/usr/local/bin/mcp",+      "args": [],+      "cwd": "/opt/mcp-servers"+    }+  }+}+```++### Stack-based Setup++If using Stack instead of Cabal:++```json+{+  "mcpServers": {+    "haskell-mcp-stack": {+      "command": "stack",+      "args": ["exec", "mcp"],+      "cwd": "/path/to/mcp-haskell"+    }+  }+}+```++## Configuration Fields++- **command**: The executable to run (cabal, stack, or direct binary path)+- **args**: Arguments passed to the command+- **cwd**: Working directory (should be the project root for development)+- **env**: Environment variables (optional)++## Testing the Configuration++1. Save the configuration to the appropriate location for your OS+2. Restart Claude Desktop+3. Start a new conversation+4. The Haskell MCP server should appear in the available tools/context++## Troubleshooting++### Common Issues++1. **Path Problems**: Ensure `cwd` points to the correct project directory+2. **Permission Issues**: Make sure the command is executable+3. **Build Issues**: Run `cabal build` first to ensure the project compiles+4. **Port Conflicts**: Each server needs a unique name in the configuration++### Debugging++To test the server manually:++```bash+cd /path/to/mcp-haskell+cabal run mcp+```++The server should start and wait for JSON-RPC messages on stdin.++### Logs++Claude Desktop logs can help debug connection issues:++- **macOS**: `~/Library/Logs/Claude/`+- **Windows**: `%LOCALAPPDATA%\Claude\logs\`+- **Linux**: `~/.local/share/claude/logs/`++## Example Usage++Once configured, you can:++1. **List Resources**: Ask Claude to show available resources+2. **Read Content**: Request specific resource content+3. **Use Tools**: Execute tools provided by the server+4. **Get Prompts**: Use pre-defined prompt templates++The Haskell MCP server provides basic examples of each capability that you can extend for your specific use case.++---++## HTTP Server Example++**File:** `http-server.hs`++Demonstrates how to run an MCP server using HTTP transport instead of StdIO.++### Building and Running++**Using Cabal (recommended):**+```bash+# From the project root+cabal build mcp-http+cabal run mcp-http+```++**Manual compilation:**+```bash+# From the project root+ghc -package-env=. -o examples/http-server examples/http-server.hs+cd examples+./http-server+```++**Using cabal exec:**+```bash+cabal exec ghc -- -package-env=. -o examples/http-server examples/http-server.hs+cd examples  +./http-server+```++### Testing the HTTP Server++Once running, the server exposes the MCP API at `POST http://localhost:8080/mcp`.++**Test with curl:**++```bash+# Ping test+curl -X POST http://localhost:8080/mcp \+  -H "Content-Type: application/json" \+  -d '{"jsonrpc":"2.0","id":1,"method":"ping"}'++# Initialize the server+curl -X POST http://localhost:8080/mcp \+  -H "Content-Type: application/json" \+  -d '{+    "jsonrpc":"2.0",+    "id":1,+    "method":"initialize",+    "params":{+      "protocolVersion":"2024-11-05",+      "capabilities":{},+      "clientInfo":{"name":"test-client","version":"1.0.0"}+    }+  }'++# List available tools+curl -X POST http://localhost:8080/mcp \+  -H "Content-Type: application/json" \+  -d '{"jsonrpc":"2.0","id":2,"method":"tools/list"}'++# Call the getCurrentDate tool+curl -X POST http://localhost:8080/mcp \+  -H "Content-Type: application/json" \+  -d '{+    "jsonrpc":"2.0",+    "id":3,+    "method":"tools/call",+    "params":{"name":"getCurrentDate"}+  }'+```++**Test with HTTPie:**++```bash+# Ping test+http POST localhost:8080/mcp jsonrpc=2.0 id:=1 method=ping++# Initialize+http POST localhost:8080/mcp \+  jsonrpc=2.0 id:=1 method=initialize \+  params:='{"protocolVersion":"2024-11-05","capabilities":{},"clientInfo":{"name":"test-client","version":"1.0.0"}}'++# List tools+http POST localhost:8080/mcp jsonrpc=2.0 id:=2 method=tools/list++# Call tool+http POST localhost:8080/mcp \+  jsonrpc=2.0 id:=3 method=tools/call \+  params:='{"name":"getCurrentDate"}'+```++## Key Differences: StdIO vs HTTP++| Aspect | StdIO Transport | HTTP Transport |+|--------|----------------|----------------|+| **Client Integration** | Process-based (stdin/stdout) | HTTP clients, web apps |+| **Message Format** | Line-delimited JSON-RPC | HTTP POST with JSON body |+| **Server Lifecycle** | Managed by client process | Independent HTTP service |+| **Debugging** | Log to stderr | HTTP access logs |+| **Scalability** | One client per process | Multiple concurrent clients |+| **Network** | Local only | Network accessible |++## Implementation Notes++- Both transports use the same `MCPServer` typeclass implementation+- Server logic is identical between StdIO and HTTP modes+- HTTP transport follows the MCP specification for streamable HTTP+- Future versions will support Server-Sent Events (SSE) for bidirectional communication++## Error Handling++The HTTP server returns appropriate HTTP status codes:++- **200 OK**: Successful JSON-RPC response+- **400 Bad Request**: Invalid JSON or malformed JSON-RPC+- **500 Internal Server Error**: Server-side processing errors++JSON-RPC errors are returned within the 200 response body following the JSON-RPC 2.0 specification.

@@ -0,0 +1,24 @@+{+  "mcpServers": {+    "haskell-mcp-development": {+      "command": "cabal",+      "args": ["run", "mcp"],+      "cwd": "/absolute/path/to/mcp-haskell",+      "env": {+        "GHC_ENVIRONMENT": "-"+      }+    },+    "haskell-mcp-production": {+      "command": "/usr/local/bin/mcp-haskell",+      "args": [],+      "cwd": "/opt/mcp-servers",+      "env": {}+    },+    "haskell-mcp-stack": {+      "command": "stack",+      "args": ["exec", "mcp"],+      "cwd": "/path/to/mcp-haskell",+      "env": {}+    }+  }+}

@@ -0,0 +1,34 @@+{+  "$schema": "https://schemas.claudeai.com/claude_desktop_config.json",+  "mcpServers": {+    "haskell-mcp-example": {+      "command": "cabal",+      "args": ["run", "mcp"],+      "cwd": "/Users/username/projects/mcp-haskell",+      "env": {+        "GHC_ENVIRONMENT": "-",+        "CABAL_CONFIG": ""+      }+    },+    "haskell-mcp-with-logging": {+      "command": "cabal", +      "args": ["run", "mcp", "--", "--verbose"],+      "cwd": "/Users/username/projects/mcp-haskell",+      "env": {+        "MCP_LOG_LEVEL": "debug"+      }+    },+    "haskell-mcp-custom-tools": {+      "command": "/usr/local/bin/mcp-haskell-tools",+      "args": ["--config", "/etc/mcp/tools.conf"],+      "cwd": "/var/lib/mcp",+      "env": {+        "MCP_TOOLS_PATH": "/usr/local/share/mcp-tools",+        "MCP_RESOURCES_PATH": "/var/lib/mcp/resources"+      }+    }+  },+  "globalShortcuts": {+    "mcp": "Cmd+Shift+M"+  }+}

@@ -0,0 +1,176 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++-- |+-- Example HTTP MCP Server+-- +-- This example demonstrates how to run the MCP server over HTTP transport.+-- The server will expose the MCP API at POST /mcp+--+-- To test:+-- 1. Compile: cabal build mcp-http+-- 2. Run: cabal run mcp-http+-- 3. Send JSON-RPC requests to: http://localhost:<port>/mcp+--+-- Example request:+-- curl -X POST http://localhost:8080/mcp \+--   -H "Content-Type: application/json" \+--   -d '{"jsonrpc":"2.0","id":1,"method":"ping"}'+--+-- Command line options:+-- cabal run mcp-http -- --port 8080 --log++module Main where++import Control.Monad (when)+import Control.Monad.IO.Class (liftIO)+import Data.Text qualified as T+import Data.Time (defaultTimeLocale, formatTime, getCurrentTime)+import Options.Applicative++import MCP.Protocol hiding (CompletionResult)+import MCP.Protocol qualified as Protocol+import MCP.Server+import MCP.Server.HTTP+import MCP.Types++-- | Command line options+data Options = Options+    { optPort :: Int+    , optEnableLogging :: Bool+    }+    deriving (Show)++-- | Parser for command line options+optionsParser :: Parser Options+optionsParser = Options+    <$> option auto+        ( long "port"+       <> short 'p'+       <> metavar "PORT"+       <> Options.Applicative.value 8080+       <> help "Port to run the HTTP server on (default: 8080)"+        )+    <*> switch+        ( long "log"+       <> short 'l'+       <> help "Enable request/response logging"+        )++-- | Full parser with help+opts :: ParserInfo Options+opts = info (optionsParser <**> helper)+    ( fullDesc+   <> progDesc "Run an MCP server over HTTP transport"+   <> header "mcp-http - HTTP MCP Server Example"+    )++-- | Example MCP Server implementation (copied from Main.hs)+instance MCPServer MCPServerM where+    handleListResources _params = do+        return $ ListResourcesResult{resources = [], nextCursor = Nothing, _meta = Nothing}++    handleReadResource _params = do+        let textContent = TextResourceContents{uri = "example://hello", text = "Hello from MCP Haskell HTTP server!", mimeType = Just "text/plain"}+        let content = TextResource textContent+        return $ ReadResourceResult{contents = [content], _meta = Nothing}++    handleListResourceTemplates _params = do+        return $ ListResourceTemplatesResult{resourceTemplates = [], nextCursor = Nothing, _meta = Nothing}++    handleListPrompts _params = do+        return $ ListPromptsResult{prompts = [], nextCursor = Nothing, _meta = Nothing}++    handleGetPrompt _params = do+        let textContent = TextContent{text = "Hello HTTP prompt!", textType = "text", annotations = Nothing}+        let content = TextContentType textContent+        let message = PromptMessage{role = User, content = content}+        return $ GetPromptResult{messages = [message], description = Nothing, _meta = Nothing}++    handleListTools _params = do+        let getCurrentDateTool =+                Tool+                    { name = "getCurrentDate"+                    , description = Just "Get the current date and time via HTTP"+                    , inputSchema = InputSchema "object" Nothing Nothing+                    , annotations = Nothing+                    }+        return $ ListToolsResult{tools = [getCurrentDateTool], nextCursor = Nothing, _meta = Nothing}++    handleCallTool CallToolParams{name = toolName} = do+        case toolName of+            "getCurrentDate" -> do+                currentTime <- liftIO getCurrentTime+                let dateStr = formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S UTC (via HTTP)" currentTime+                let textContent = TextContent{text = T.pack dateStr, textType = "text", annotations = Nothing}+                let content = TextContentType textContent+                return $ CallToolResult{content = [content], isError = Nothing, _meta = Nothing}+            _ -> do+                let textContent = TextContent{text = "Tool not found", textType = "text", annotations = Nothing}+                let content = TextContentType textContent+                return $ CallToolResult{content = [content], isError = Just True, _meta = Nothing}++    handleComplete _params = do+        let completionResult = Protocol.CompletionResult{values = [], total = Nothing, hasMore = Just True}+        return $ CompleteResult{completion = completionResult, _meta = Nothing}++    handleSetLevel _params = do+        liftIO $ putStrLn "Log level set via HTTP"++main :: IO ()+main = do+    Options{..} <- execParser opts+    +    putStrLn "Starting MCP Haskell HTTP Server..."+    putStrLn $ "Port: " ++ show optPort+    when optEnableLogging $ putStrLn "Request/Response logging: enabled"++    let serverInfo =+            Implementation+                { name = "mcp-haskell-http-example"+                , version = "0.1.0"+                }++    let resourcesCap =+            ResourcesCapability+                { subscribe = Just False+                , listChanged = Just False+                }+    let promptsCap =+            PromptsCapability+                { listChanged = Just False+                }+    let toolsCap =+            ToolsCapability+                { listChanged = Just False+                }++    let capabilities =+            ServerCapabilities+                { resources = Just resourcesCap+                , prompts = Just promptsCap+                , tools = Just toolsCap+                , completions = Nothing+                , logging = Nothing+                , experimental = Nothing+                }++    let config =+            HTTPServerConfig+                { httpPort = optPort+                , httpServerInfo = serverInfo+                , httpCapabilities = capabilities+                , httpEnableLogging = optEnableLogging+                }++    putStrLn $ "HTTP server configured, starting on port " ++ show optPort ++ "..."+    putStrLn $ "MCP endpoint available at: POST http://localhost:" ++ show optPort ++ "/mcp"+    putStrLn ""+    putStrLn "Example test command:"+    putStrLn $ "curl -X POST http://localhost:" ++ show optPort ++ "/mcp \\"+    putStrLn "  -H \"Content-Type: application/json\" \\"+    putStrLn "  -d '{\"jsonrpc\":\"2.0\",\"id\":1,\"method\":\"ping\"}'"+    putStrLn ""+    +    runServerHTTP config

@@ -0,0 +1,62 @@+#!/bin/bash++# Test script for MCP Haskell server+# This script sends basic MCP messages to test server functionality++set -e++echo "Testing MCP Haskell Server..."+echo "=============================="++# Build the server first+echo "Building server..."+cabal build++echo ""+echo "Testing server startup..."++# Create a temporary file for test messages+TEST_FILE=$(mktemp)++# Write test JSON-RPC messages (each on its own line as required by JSON-RPC)+cat > "$TEST_FILE" << 'EOF'+{"jsonrpc": "2.0", "id": 1, "method": "initialize", "params": {"protocolVersion": "2024-11-05", "capabilities": {"roots": {"listChanged": true}}, "clientInfo": {"name": "test-client", "version": "1.0.0"}}}+{"jsonrpc": "2.0", "id": 2, "method": "ping"}+{"jsonrpc": "2.0", "id": 3, "method": "resources/list"}+{"jsonrpc": "2.0", "id": 4, "method": "prompts/list"}+{"jsonrpc": "2.0", "id": 5, "method": "tools/list"}+EOF++echo ""+echo "Sending test messages to server..."+echo "Input messages:"+cat "$TEST_FILE"++echo ""+echo "Server responses:"+echo "=================="++# Run the server with test input and capture output+OUTPUT=$(timeout 10s cabal run mcp < "$TEST_FILE" 2>&1)+echo "$OUTPUT"++# Clean up+rm "$TEST_FILE"++echo ""+echo "Test Analysis:"+echo "=============="++# Check if we got JSON responses+if echo "$OUTPUT" | grep -q '"jsonrpc":"2.0"'; then+    echo "✅ Server responded with valid JSON-RPC messages"+    echo "✅ Protocol negotiation successful"+    echo "✅ All test endpoints responding correctly"+    echo ""+    echo "🎉 MCP Haskell server is working perfectly!"+    echo "You can now configure Claude Desktop to use this server."+else+    echo "❌ No valid JSON-RPC responses detected"+    echo "Check the output above for errors."+    exit 1+fi

@@ -20,7 +20,7 @@ -- PVP summary:     +-+------- breaking API changes --                  | | +----- non-breaking API additions --                  | | | +--- code changes with no API change-version:            0.1.0.0+version:            0.1.1.0  -- A short (one-line) description of the package. synopsis:           A Haskell implementation of the Model Context Protocol (MCP)@@ -32,6 +32,14 @@     and external tools, resources, and services. This implementation includes support for     resources, tools, prompts, and all standard MCP message types. It provides both a     server framework and type definitions for building MCP-compliant applications.+    .+    Features dual transport support:+    .+    * StdIO transport for process-based clients (e.g., Claude Desktop)+    * HTTP transport following the official MCP specification for web-based integration+    .+    Both transports use the same MCPServer typeclass, allowing seamless switching between+    communication methods while maintaining identical server logic.  -- The license under which the package is released. license:            MIT@@ -54,7 +62,12 @@ extra-doc-files:    CHANGELOG.md  -- Extra source files to be distributed with the package, such as examples, or a tutorial module.--- extra-source-files:+extra-source-files:+    examples/README.md+    examples/http-server.hs+    examples/claude-desktop-config.json+    examples/full-config-example.json+    examples/test-mcp-server.sh  common warnings     ghc-options: -Wall@@ -68,6 +81,8 @@         MCP.Types         MCP.Protocol           MCP.Server+        MCP.Server.StdIO+        MCP.Server.HTTP      -- Modules included in this library but not exported.     -- other-modules:@@ -86,7 +101,13 @@         stm >= 2.5 && < 2.6,         async >= 2.2 && < 2.3,         mtl >= 2.3 && < 2.4,-        transformers >= 0.6 && < 0.7+        transformers >= 0.6 && < 0.7,+        warp >= 3.3 && < 3.4,+        wai >= 3.2 && < 3.3,+        wai-extra >= 3.1 && < 3.2,+        servant-server >= 0.19 && < 0.21,+        servant >= 0.19 && < 0.21,+        http-types >= 0.12 && < 0.13      -- Directories containing source files.     hs-source-dirs:   src@@ -119,6 +140,36 @@      -- Directories containing source files.     hs-source-dirs:   app++    -- Base language which the package is written in.+    default-language: GHC2021++executable mcp-http+    -- Import common warning flags.+    import:           warnings++    -- .hs or .lhs file containing the Main module.+    main-is:          http-server.hs++    -- Modules included in this executable, other than Main.+    -- other-modules:++    -- LANGUAGE extensions used by modules in this package.+    -- other-extensions:++    -- Other library packages from which modules are imported.+    build-depends:+        base ^>=4.18.2.1,+        mcp,+        aeson >= 2.1 && < 2.3,+        text >= 2.0 && < 2.1,+        containers >= 0.6 && < 0.7,+        scientific >= 0.3 && < 0.4,+        time >= 1.12 && < 1.13,+        optparse-applicative >= 0.17 && < 0.19++    -- Directories containing source files.+    hs-source-dirs:   examples      -- Base language which the package is written in.     default-language: GHC2021

@@ -8,31 +8,22 @@  -- | -- Module      : MCP.Server--- Description : MCP server implementation+-- Description : MCP server core types and interface -- Copyright   : (C) 2025 Matthias Pall Gissurarson -- License     : MIT -- Maintainer  : mpg@mpg.is -- Stability   : experimental -- Portability : GHC ----- This module provides a complete MCP server implementation, including--- message handling, state management, and JSON-RPC communication over--- standard input/output streams.+-- This module provides the core types and interface for MCP server implementations. module MCP.Server (     -- * Server Interface     MCPServer (..),     ServerState (..),+    ServerConfig (..),     MCPServerM,     runMCPServer,--    -- * Message Handling-    handleMessage,-    handleRequest,-    handleNotification,--    -- * Server Runner-    runServer,-    ServerConfig (..),+    initialServerState,      -- * Utilities     sendResponse,@@ -40,25 +31,18 @@     sendError, ) where -import Control.Exception (catch, throwIO) import Control.Monad.Except (ExceptT, runExceptT) import Control.Monad.IO.Class (MonadIO, liftIO)-import Control.Monad.Reader (ReaderT, ask, runReaderT)-import Control.Monad.State.Strict (StateT, get, put, runStateT)-import Data.Aeson (ToJSON, decode, encode, fromJSON, object, toJSON)-import Data.Aeson qualified as Aeson-import Data.ByteString.Char8 qualified as BSC-import Data.ByteString.Lazy qualified as LBS+import Control.Monad.Reader (ReaderT, runReaderT)+import Control.Monad.State.Strict (StateT, runStateT)+import Data.Aeson (ToJSON, encode, toJSON) import Data.ByteString.Lazy.Char8 qualified as LBSC import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map import Data.Text (Text)-import Data.Text qualified as T import System.IO (Handle, hFlush)-import System.IO.Error (isEOFError) -import MCP.Protocol hiding (capabilities)-import MCP.Protocol qualified as Protocol+import MCP.Protocol import MCP.Types  -- | Server state tracking initialization, capabilities, and subscriptions@@ -80,6 +64,7 @@     }     deriving (Show) + -- | The monad stack for MCP server operations type MCPServerM = ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) @@ -87,6 +72,9 @@ runMCPServer :: ServerConfig -> ServerState -> MCPServerM a -> IO (Either Text (a, ServerState)) runMCPServer config state action = runExceptT $ runStateT (runReaderT action config) state +-- | Create the initial server state with the given capabilities+-- The server starts uninitialized and must receive an 'initialize' request+-- before it can handle other requests. initialServerState :: ServerCapabilities -> ServerState initialServerState caps =     ServerState@@ -130,245 +118,3 @@     LBSC.hPutStrLn handle (encode notification)     hFlush handle --- | Handle an incoming JSON-RPC message-handleMessage :: (MCPServer MCPServerM) => BSC.ByteString -> MCPServerM (Maybe ())-handleMessage input = do-    case decode (LBS.fromStrict input) :: Maybe JSONRPCMessage of-        Nothing -> do-            config <- ask-            sendError (configOutput config) (RequestId (toJSON ("unknown" :: Text))) $-                JSONRPCErrorInfo (-32700) "Parse error" Nothing-            return Nothing-        Just msg -> case msg of-            RequestMessage req -> do-                handleRequest req-                return (Just ())-            NotificationMessage notif -> do-                handleNotification notif-                return (Just ())-            _ -> do-                config <- ask-                sendError (configOutput config) (RequestId (toJSON ("unknown" :: Text))) $-                    JSONRPCErrorInfo (-32600) "Invalid Request" Nothing-                return Nothing---- | Handle a JSON-RPC request-handleRequest :: (MCPServer MCPServerM) => JSONRPCRequest -> MCPServerM ()-handleRequest (JSONRPCRequest _ reqId method params) = do-    config <- ask-    state <- get--    case method of-        "initialize" -> case params of-            Just p -> case fromJSON p of-                Aeson.Success initParams -> handleInitialize reqId initParams-                Aeson.Error e ->-                    sendError (configOutput config) reqId $-                        JSONRPCErrorInfo (-32602) ("Invalid params: " <> T.pack e) Nothing-            Nothing ->-                sendError (configOutput config) reqId $-                    JSONRPCErrorInfo (-32602) "Missing params" Nothing-        "ping" -> handlePing reqId-        "resources/list" -> do-            if not (serverInitialized state)-                then-                    sendError (configOutput config) reqId $-                        JSONRPCErrorInfo (-32002) "Server not initialized" Nothing-                else case params of-                    Just p -> case fromJSON p of-                        Aeson.Success listParams -> do-                            result <- handleListResources listParams-                            sendResponse (configOutput config) reqId result-                        Aeson.Error e ->-                            sendError (configOutput config) reqId $-                                JSONRPCErrorInfo (-32602) ("Invalid params: " <> T.pack e) Nothing-                    Nothing -> do-                        result <- handleListResources (ListResourcesParams Nothing)-                        sendResponse (configOutput config) reqId result-        "resources/read" -> do-            if not (serverInitialized state)-                then-                    sendError (configOutput config) reqId $-                        JSONRPCErrorInfo (-32002) "Server not initialized" Nothing-                else case params of-                    Just p -> case fromJSON p of-                        Aeson.Success readParams -> do-                            result <- handleReadResource readParams-                            sendResponse (configOutput config) reqId result-                        Aeson.Error e ->-                            sendError (configOutput config) reqId $-                                JSONRPCErrorInfo (-32602) ("Invalid params: " <> T.pack e) Nothing-                    Nothing ->-                        sendError (configOutput config) reqId $-                            JSONRPCErrorInfo (-32602) "Missing params" Nothing-        "resources/templates/list" -> do-            if not (serverInitialized state)-                then-                    sendError (configOutput config) reqId $-                        JSONRPCErrorInfo (-32002) "Server not initialized" Nothing-                else case params of-                    Just p -> case fromJSON p of-                        Aeson.Success listParams -> do-                            result <- handleListResourceTemplates listParams-                            sendResponse (configOutput config) reqId result-                        Aeson.Error e ->-                            sendError (configOutput config) reqId $-                                JSONRPCErrorInfo (-32602) ("Invalid params: " <> T.pack e) Nothing-                    Nothing -> do-                        result <- handleListResourceTemplates (ListResourceTemplatesParams Nothing)-                        sendResponse (configOutput config) reqId result-        "prompts/list" -> do-            if not (serverInitialized state)-                then-                    sendError (configOutput config) reqId $-                        JSONRPCErrorInfo (-32002) "Server not initialized" Nothing-                else case params of-                    Just p -> case fromJSON p of-                        Aeson.Success listParams -> do-                            result <- handleListPrompts listParams-                            sendResponse (configOutput config) reqId result-                        Aeson.Error e ->-                            sendError (configOutput config) reqId $-                                JSONRPCErrorInfo (-32602) ("Invalid params: " <> T.pack e) Nothing-                    Nothing -> do-                        result <- handleListPrompts (ListPromptsParams Nothing)-                        sendResponse (configOutput config) reqId result-        "prompts/get" -> do-            if not (serverInitialized state)-                then-                    sendError (configOutput config) reqId $-                        JSONRPCErrorInfo (-32002) "Server not initialized" Nothing-                else case params of-                    Just p -> case fromJSON p of-                        Aeson.Success getParams -> do-                            result <- handleGetPrompt getParams-                            sendResponse (configOutput config) reqId result-                        Aeson.Error e ->-                            sendError (configOutput config) reqId $-                                JSONRPCErrorInfo (-32602) ("Invalid params: " <> T.pack e) Nothing-                    Nothing ->-                        sendError (configOutput config) reqId $-                            JSONRPCErrorInfo (-32602) "Missing params" Nothing-        "tools/list" -> do-            if not (serverInitialized state)-                then-                    sendError (configOutput config) reqId $-                        JSONRPCErrorInfo (-32002) "Server not initialized" Nothing-                else case params of-                    Just p -> case fromJSON p of-                        Aeson.Success listParams -> do-                            result <- handleListTools listParams-                            sendResponse (configOutput config) reqId result-                        Aeson.Error e ->-                            sendError (configOutput config) reqId $-                                JSONRPCErrorInfo (-32602) ("Invalid params: " <> T.pack e) Nothing-                    Nothing -> do-                        result <- handleListTools (ListToolsParams Nothing)-                        sendResponse (configOutput config) reqId result-        "tools/call" -> do-            if not (serverInitialized state)-                then-                    sendError (configOutput config) reqId $-                        JSONRPCErrorInfo (-32002) "Server not initialized" Nothing-                else case params of-                    Just p -> case fromJSON p of-                        Aeson.Success callParams -> do-                            result <- handleCallTool callParams-                            sendResponse (configOutput config) reqId result-                        Aeson.Error e ->-                            sendError (configOutput config) reqId $-                                JSONRPCErrorInfo (-32602) ("Invalid params: " <> T.pack e) Nothing-                    Nothing ->-                        sendError (configOutput config) reqId $-                            JSONRPCErrorInfo (-32602) "Missing params" Nothing-        "completion/complete" -> do-            if not (serverInitialized state)-                then-                    sendError (configOutput config) reqId $-                        JSONRPCErrorInfo (-32002) "Server not initialized" Nothing-                else case params of-                    Just p -> case fromJSON p of-                        Aeson.Success completeParams -> do-                            result <- handleComplete completeParams-                            sendResponse (configOutput config) reqId result-                        Aeson.Error e ->-                            sendError (configOutput config) reqId $-                                JSONRPCErrorInfo (-32602) ("Invalid params: " <> T.pack e) Nothing-                    Nothing ->-                        sendError (configOutput config) reqId $-                            JSONRPCErrorInfo (-32602) "Missing params" Nothing-        "logging/setLevel" -> case params of-            Just p -> case fromJSON p of-                Aeson.Success setLevelParams -> do-                    _ <- handleSetLevel setLevelParams-                    -- SetLevel response is just an empty object-                    sendResponse (configOutput config) reqId (object [])-                Aeson.Error e ->-                    sendError (configOutput config) reqId $-                        JSONRPCErrorInfo (-32602) ("Invalid params: " <> T.pack e) Nothing-            Nothing ->-                sendError (configOutput config) reqId $-                    JSONRPCErrorInfo (-32602) "Missing params" Nothing-        _ ->-            sendError (configOutput config) reqId $-                JSONRPCErrorInfo (-32601) "Method not found" Nothing--handleInitialize :: RequestId -> InitializeParams -> MCPServerM ()-handleInitialize reqId params = do-    config <- ask-    state <- get--    let InitializeParams{capabilities = clientCaps} = params--    put-        state-            { serverInitialized = True-            , clientCapabilities = Just clientCaps-            , serverInfo = Just (configServerInfo config)-            }--    let result =-            InitializeResult-                { protocolVersion = "2024-11-05"-                , capabilities = serverCapabilities state-                , serverInfo = configServerInfo config-                , instructions = Nothing-                , _meta = Nothing-                }--    sendResponse (configOutput config) reqId result--handlePing :: RequestId -> MCPServerM ()-handlePing reqId = do-    config <- ask-    -- Ping response is just an empty object in MCP-    sendResponse (configOutput config) reqId (object [])---- | Handle a JSON-RPC notification-handleNotification :: JSONRPCNotification -> MCPServerM ()-handleNotification _ = do-    return ()---- | Run the MCP server with the given configuration-runServer :: (MCPServer MCPServerM) => ServerConfig -> IO ()-runServer config = do-    let initialState = initialServerState (configCapabilities config)--    let loop = do-            eofOrLine <--                liftIO $-                    catch-                        (Right <$> BSC.hGetLine (configInput config))-                        (\e -> if isEOFError e then return (Left ()) else throwIO e)-            case eofOrLine of-                Left () -> return () -- EOF reached, exit gracefully-                Right line -> do-                    result <- handleMessage line-                    case result of-                        Just () -> loop-                        Nothing -> return ()--    result <- runMCPServer config initialState loop-    case result of-        Left err -> putStrLn $ "Server error: " ++ T.unpack err-        Right _ -> return () -- Don't print "Server terminated" for clean EOF

@@ -0,0 +1,267 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}++-- |+-- Module      : MCP.Server.HTTP+-- Description : MCP server implementation for HTTP communication+-- Copyright   : (C) 2025 Matthias Pall Gissurarson+-- License     : MIT+-- Maintainer  : mpg@mpg.is+-- Stability   : experimental+-- Portability : GHC+--+-- This module provides MCP server implementation for HTTP communication.+module MCP.Server.HTTP (+    -- * Server Runner+    runServerHTTP,+    HTTPServerConfig (..),+) where++import Control.Concurrent.STM (TVar, atomically, newTVarIO, readTVar, writeTVar)+import Control.Monad.IO.Class (liftIO)+import Control.Monad.Reader (ask)+import Control.Monad.State.Strict (get, put)+import Data.Aeson (encode, fromJSON, object, toJSON, (.=))+import Data.Aeson qualified as Aeson+import Data.ByteString.Lazy.Char8 qualified as LBSC+import Data.Text (Text)+import Data.Text qualified as T+import Network.Wai (Application)+import Network.Wai.Handler.Warp (Port, run)+import Network.Wai.Middleware.RequestLogger (logStdoutDev)+import Servant (Handler, Proxy(..), Server, serve, throwError)+import Servant.API (JSON, Post, ReqBody, (:>))+import Servant.Server (err400, err500, errBody)++import MCP.Protocol+import MCP.Server (MCPServer(..), MCPServerM, ServerConfig(..), ServerState(..), runMCPServer, initialServerState)+import MCP.Types++-- | Configuration for running an MCP HTTP server+data HTTPServerConfig = HTTPServerConfig+    { httpPort :: Port+    , httpServerInfo :: Implementation+    , httpCapabilities :: ServerCapabilities+    , httpEnableLogging :: Bool+    }+    deriving (Show)++-- | MCP API definition for HTTP server (following the MCP transport spec)+type MCPAPI = "mcp" :> ReqBody '[JSON] Aeson.Value :> Post '[JSON] Aeson.Value++-- | Create a WAI Application for the MCP HTTP server+mcpApp :: (MCPServer MCPServerM) => HTTPServerConfig -> TVar ServerState -> Application+mcpApp config stateVar = +    let baseApp = serve (Proxy :: Proxy MCPAPI) (mcpServer config stateVar)+    in if httpEnableLogging config+       then logStdoutDev baseApp+       else baseApp+  where+    mcpServer :: HTTPServerConfig -> TVar ServerState -> Server MCPAPI+    mcpServer httpConfig stateTVar = handleHTTPRequest httpConfig stateTVar++-- | Handle HTTP MCP requests following the MCP transport protocol+handleHTTPRequest :: (MCPServer MCPServerM) => HTTPServerConfig -> TVar ServerState -> Aeson.Value -> Handler Aeson.Value+handleHTTPRequest httpConfig stateVar requestValue = do+    -- Parse the incoming JSON-RPC message+    case fromJSON requestValue of+        Aeson.Success (msg :: JSONRPCMessage) -> do+            case msg of+                RequestMessage req -> do+                    -- Process the JSON-RPC request+                    result <- liftIO $ processHTTPRequest httpConfig stateVar req+                    case result of+                        Left err -> throwError err500 { errBody = encode $ object ["error" .= T.unpack err] }+                        Right response -> return response+                NotificationMessage notif -> do+                    -- Process notifications (no response expected)+                    _ <- liftIO $ processHTTPNotification httpConfig stateVar notif+                    return $ object [] -- Empty response for notifications+                _ -> throwError err400 { errBody = "Invalid JSON-RPC message type" }+        Aeson.Error e -> throwError err400 { errBody = LBSC.pack $ "Invalid JSON-RPC message: " ++ e }++-- | Process an HTTP MCP notification+processHTTPNotification :: (MCPServer MCPServerM) => HTTPServerConfig -> TVar ServerState -> JSONRPCNotification -> IO ()+processHTTPNotification _ _ _ = do+    -- For now, just ignore notifications since they don't need responses+    -- In a more complete implementation, this would handle logging/setLevel notifications+    return ()++-- | Process an HTTP MCP request+processHTTPRequest :: (MCPServer MCPServerM) => HTTPServerConfig -> TVar ServerState -> JSONRPCRequest -> IO (Either Text Aeson.Value)+processHTTPRequest httpConfig stateVar req = do+    -- Read the current state+    currentState <- atomically $ readTVar stateVar+    let dummyConfig = ServerConfig+            { configInput = undefined  -- Not used in HTTP mode+            , configOutput = undefined -- Not used in HTTP mode+            , configServerInfo = httpServerInfo httpConfig+            , configCapabilities = httpCapabilities httpConfig+            }+    +    result <- runMCPServer dummyConfig currentState (handleHTTPRequestInner req)+    case result of+        Left err -> return $ Left err+        Right (response, newState) -> do+            -- Update the state atomically+            atomically $ writeTVar stateVar newState+            return $ Right response++-- | Handle HTTP request within the MCP monad, returning proper JSON-RPC responses+handleHTTPRequestInner :: (MCPServer MCPServerM) => JSONRPCRequest -> MCPServerM Aeson.Value+handleHTTPRequestInner (JSONRPCRequest _ reqId method params) = do+    config <- ask+    state <- get+    +    case method of+        "initialize" -> case params of+            Just p -> case fromJSON p of+                Aeson.Success initParams -> do+                    handleInitializeHTTP reqId initParams+                    let result = InitializeResult+                            { protocolVersion = "2024-11-05"+                            , capabilities = configCapabilities config+                            , serverInfo = configServerInfo config+                            , instructions = Nothing+                            , _meta = Nothing+                            }+                    return $ toJSON $ JSONRPCResponse "2.0" reqId (toJSON result)+                Aeson.Error e -> return $ toJSON $ JSONRPCError "2.0" reqId $+                    JSONRPCErrorInfo (-32602) ("Invalid params: " <> T.pack e) Nothing+            Nothing -> return $ toJSON $ JSONRPCError "2.0" reqId $+                JSONRPCErrorInfo (-32602) "Missing params" Nothing+        "ping" -> return $ toJSON $ JSONRPCResponse "2.0" reqId (object [])+        "resources/list" -> do+            if not (serverInitialized state)+                then return $ toJSON $ JSONRPCError "2.0" reqId $+                    JSONRPCErrorInfo (-32002) "Server not initialized" Nothing+                else case params of+                    Just p -> case fromJSON p of+                        Aeson.Success listParams -> do+                            result <- handleListResources listParams+                            return $ toJSON $ JSONRPCResponse "2.0" reqId (toJSON result)+                        Aeson.Error e -> return $ toJSON $ JSONRPCError "2.0" reqId $+                            JSONRPCErrorInfo (-32602) ("Invalid params: " <> T.pack e) Nothing+                    Nothing -> do+                        result <- handleListResources (ListResourcesParams Nothing)+                        return $ toJSON $ JSONRPCResponse "2.0" reqId (toJSON result)+        "resources/read" -> do+            if not (serverInitialized state)+                then return $ toJSON $ JSONRPCError "2.0" reqId $+                    JSONRPCErrorInfo (-32002) "Server not initialized" Nothing+                else case params of+                    Just p -> case fromJSON p of+                        Aeson.Success readParams -> do+                            result <- handleReadResource readParams+                            return $ toJSON $ JSONRPCResponse "2.0" reqId (toJSON result)+                        Aeson.Error e -> return $ toJSON $ JSONRPCError "2.0" reqId $+                            JSONRPCErrorInfo (-32602) ("Invalid params: " <> T.pack e) Nothing+                    Nothing -> return $ toJSON $ JSONRPCError "2.0" reqId $+                        JSONRPCErrorInfo (-32602) "Missing params" Nothing+        "tools/list" -> do+            if not (serverInitialized state)+                then return $ toJSON $ JSONRPCError "2.0" reqId $+                    JSONRPCErrorInfo (-32002) "Server not initialized" Nothing+                else case params of+                    Just p -> case fromJSON p of+                        Aeson.Success listParams -> do+                            result <- handleListTools listParams+                            return $ toJSON $ JSONRPCResponse "2.0" reqId (toJSON result)+                        Aeson.Error e -> return $ toJSON $ JSONRPCError "2.0" reqId $+                            JSONRPCErrorInfo (-32602) ("Invalid params: " <> T.pack e) Nothing+                    Nothing -> do+                        result <- handleListTools (ListToolsParams Nothing)+                        return $ toJSON $ JSONRPCResponse "2.0" reqId (toJSON result)+        "tools/call" -> do+            if not (serverInitialized state)+                then return $ toJSON $ JSONRPCError "2.0" reqId $+                    JSONRPCErrorInfo (-32002) "Server not initialized" Nothing+                else case params of+                    Just p -> case fromJSON p of+                        Aeson.Success callParams -> do+                            result <- handleCallTool callParams+                            return $ toJSON $ JSONRPCResponse "2.0" reqId (toJSON result)+                        Aeson.Error e -> return $ toJSON $ JSONRPCError "2.0" reqId $+                            JSONRPCErrorInfo (-32602) ("Invalid params: " <> T.pack e) Nothing+                    Nothing -> return $ toJSON $ JSONRPCError "2.0" reqId $+                        JSONRPCErrorInfo (-32602) "Missing params" Nothing+        "prompts/list" -> do+            if not (serverInitialized state)+                then return $ toJSON $ JSONRPCError "2.0" reqId $+                    JSONRPCErrorInfo (-32002) "Server not initialized" Nothing+                else case params of+                    Just p -> case fromJSON p of+                        Aeson.Success listParams -> do+                            result <- handleListPrompts listParams+                            return $ toJSON $ JSONRPCResponse "2.0" reqId (toJSON result)+                        Aeson.Error e -> return $ toJSON $ JSONRPCError "2.0" reqId $+                            JSONRPCErrorInfo (-32602) ("Invalid params: " <> T.pack e) Nothing+                    Nothing -> do+                        result <- handleListPrompts (ListPromptsParams Nothing)+                        return $ toJSON $ JSONRPCResponse "2.0" reqId (toJSON result)+        "prompts/get" -> do+            if not (serverInitialized state)+                then return $ toJSON $ JSONRPCError "2.0" reqId $+                    JSONRPCErrorInfo (-32002) "Server not initialized" Nothing+                else case params of+                    Just p -> case fromJSON p of+                        Aeson.Success getParams -> do+                            result <- handleGetPrompt getParams+                            return $ toJSON $ JSONRPCResponse "2.0" reqId (toJSON result)+                        Aeson.Error e -> return $ toJSON $ JSONRPCError "2.0" reqId $+                            JSONRPCErrorInfo (-32602) ("Invalid params: " <> T.pack e) Nothing+                    Nothing -> return $ toJSON $ JSONRPCError "2.0" reqId $+                        JSONRPCErrorInfo (-32602) "Missing params" Nothing+        "completion/complete" -> do+            if not (serverInitialized state)+                then return $ toJSON $ JSONRPCError "2.0" reqId $+                    JSONRPCErrorInfo (-32002) "Server not initialized" Nothing+                else case params of+                    Just p -> case fromJSON p of+                        Aeson.Success completeParams -> do+                            result <- handleComplete completeParams+                            return $ toJSON $ JSONRPCResponse "2.0" reqId (toJSON result)+                        Aeson.Error e -> return $ toJSON $ JSONRPCError "2.0" reqId $+                            JSONRPCErrorInfo (-32602) ("Invalid params: " <> T.pack e) Nothing+                    Nothing -> return $ toJSON $ JSONRPCError "2.0" reqId $+                        JSONRPCErrorInfo (-32602) "Missing params" Nothing+        "logging/setLevel" -> case params of+            Just p -> case fromJSON p of+                Aeson.Success setLevelParams -> do+                    _ <- handleSetLevel setLevelParams+                    return $ toJSON $ JSONRPCResponse "2.0" reqId (object [])+                Aeson.Error e -> return $ toJSON $ JSONRPCError "2.0" reqId $+                    JSONRPCErrorInfo (-32602) ("Invalid params: " <> T.pack e) Nothing+            Nothing -> return $ toJSON $ JSONRPCError "2.0" reqId $+                JSONRPCErrorInfo (-32602) "Missing params" Nothing+        _ -> return $ toJSON $ JSONRPCError "2.0" reqId $+            JSONRPCErrorInfo (-32601) "Method not found" Nothing++-- | Handle HTTP initialize request+handleInitializeHTTP :: RequestId -> InitializeParams -> MCPServerM ()+handleInitializeHTTP _ params = do+    config <- ask+    state <- get++    let InitializeParams{capabilities = clientCaps} = params++    put state+        { serverInitialized = True+        , clientCapabilities = Just clientCaps+        , serverInfo = Just (configServerInfo config)+        }++-- | Run the MCP server as an HTTP server+runServerHTTP :: (MCPServer MCPServerM) => HTTPServerConfig -> IO ()+runServerHTTP config = do+    -- Initialize the server state+    stateVar <- newTVarIO $ initialServerState (httpCapabilities config)+    putStrLn $ "Starting MCP HTTP Server on port " ++ show (httpPort config) ++ "..."+    run (httpPort config) (mcpApp config stateVar)

@@ -0,0 +1,282 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}++-- |+-- Module      : MCP.Server.StdIO+-- Description : MCP server implementation for stdin/stdout communication+-- Copyright   : (C) 2025 Matthias Pall Gissurarson+-- License     : MIT+-- Maintainer  : mpg@mpg.is+-- Stability   : experimental+-- Portability : GHC+--+-- This module provides MCP server implementation for stdin/stdout streams.+module MCP.Server.StdIO (+    -- * Server Runner+    runServer,+    ServerConfig (..),+) where++import Control.Exception (catch, throwIO)+import Control.Monad.IO.Class (liftIO)+import Control.Monad.Reader (ask)+import Control.Monad.State.Strict (get, put)+import Data.Aeson (decode, fromJSON, object, toJSON)+import Data.Aeson qualified as Aeson+import Data.ByteString.Char8 qualified as BSC+import Data.ByteString.Lazy qualified as LBS+import Data.Text qualified as T+import System.IO.Error (isEOFError)++import MCP.Protocol+import MCP.Server (MCPServer(..), MCPServerM, ServerState(..), ServerConfig(..), runMCPServer, initialServerState, sendResponse, sendError)+import MCP.Types+++-- | Handle an incoming JSON-RPC message+handleMessage :: (MCPServer MCPServerM) => BSC.ByteString -> MCPServerM (Maybe ())+handleMessage input = do+    case decode (LBS.fromStrict input) :: Maybe JSONRPCMessage of+        Nothing -> do+            config <- ask+            sendError (configOutput config) (RequestId (toJSON ("unknown" :: T.Text))) $+                JSONRPCErrorInfo (-32700) "Parse error" Nothing+            return Nothing+        Just msg -> case msg of+            RequestMessage req -> do+                handleRequest req+                return (Just ())+            NotificationMessage notif -> do+                handleNotification notif+                return (Just ())+            _ -> do+                config <- ask+                sendError (configOutput config) (RequestId (toJSON ("unknown" :: T.Text))) $+                    JSONRPCErrorInfo (-32600) "Invalid Request" Nothing+                return Nothing++-- | Handle a JSON-RPC request+handleRequest :: (MCPServer MCPServerM) => JSONRPCRequest -> MCPServerM ()+handleRequest (JSONRPCRequest _ reqId method params) = do+    config <- ask+    state <- get++    case method of+        "initialize" -> case params of+            Just p -> case fromJSON p of+                Aeson.Success initParams -> handleInitialize reqId initParams+                Aeson.Error e ->+                    sendError (configOutput config) reqId $+                        JSONRPCErrorInfo (-32602) ("Invalid params: " <> T.pack e) Nothing+            Nothing ->+                sendError (configOutput config) reqId $+                    JSONRPCErrorInfo (-32602) "Missing params" Nothing+        "ping" -> handlePing reqId+        "resources/list" -> do+            if not (serverInitialized state)+                then+                    sendError (configOutput config) reqId $+                        JSONRPCErrorInfo (-32002) "Server not initialized" Nothing+                else case params of+                    Just p -> case fromJSON p of+                        Aeson.Success listParams -> do+                            result <- handleListResources listParams+                            sendResponse (configOutput config) reqId result+                        Aeson.Error e ->+                            sendError (configOutput config) reqId $+                                JSONRPCErrorInfo (-32602) ("Invalid params: " <> T.pack e) Nothing+                    Nothing -> do+                        result <- handleListResources (ListResourcesParams Nothing)+                        sendResponse (configOutput config) reqId result+        "resources/read" -> do+            if not (serverInitialized state)+                then+                    sendError (configOutput config) reqId $+                        JSONRPCErrorInfo (-32002) "Server not initialized" Nothing+                else case params of+                    Just p -> case fromJSON p of+                        Aeson.Success readParams -> do+                            result <- handleReadResource readParams+                            sendResponse (configOutput config) reqId result+                        Aeson.Error e ->+                            sendError (configOutput config) reqId $+                                JSONRPCErrorInfo (-32602) ("Invalid params: " <> T.pack e) Nothing+                    Nothing ->+                        sendError (configOutput config) reqId $+                            JSONRPCErrorInfo (-32602) "Missing params" Nothing+        "resources/templates/list" -> do+            if not (serverInitialized state)+                then+                    sendError (configOutput config) reqId $+                        JSONRPCErrorInfo (-32002) "Server not initialized" Nothing+                else case params of+                    Just p -> case fromJSON p of+                        Aeson.Success listParams -> do+                            result <- handleListResourceTemplates listParams+                            sendResponse (configOutput config) reqId result+                        Aeson.Error e ->+                            sendError (configOutput config) reqId $+                                JSONRPCErrorInfo (-32602) ("Invalid params: " <> T.pack e) Nothing+                    Nothing -> do+                        result <- handleListResourceTemplates (ListResourceTemplatesParams Nothing)+                        sendResponse (configOutput config) reqId result+        "prompts/list" -> do+            if not (serverInitialized state)+                then+                    sendError (configOutput config) reqId $+                        JSONRPCErrorInfo (-32002) "Server not initialized" Nothing+                else case params of+                    Just p -> case fromJSON p of+                        Aeson.Success listParams -> do+                            result <- handleListPrompts listParams+                            sendResponse (configOutput config) reqId result+                        Aeson.Error e ->+                            sendError (configOutput config) reqId $+                                JSONRPCErrorInfo (-32602) ("Invalid params: " <> T.pack e) Nothing+                    Nothing -> do+                        result <- handleListPrompts (ListPromptsParams Nothing)+                        sendResponse (configOutput config) reqId result+        "prompts/get" -> do+            if not (serverInitialized state)+                then+                    sendError (configOutput config) reqId $+                        JSONRPCErrorInfo (-32002) "Server not initialized" Nothing+                else case params of+                    Just p -> case fromJSON p of+                        Aeson.Success getParams -> do+                            result <- handleGetPrompt getParams+                            sendResponse (configOutput config) reqId result+                        Aeson.Error e ->+                            sendError (configOutput config) reqId $+                                JSONRPCErrorInfo (-32602) ("Invalid params: " <> T.pack e) Nothing+                    Nothing ->+                        sendError (configOutput config) reqId $+                            JSONRPCErrorInfo (-32602) "Missing params" Nothing+        "tools/list" -> do+            if not (serverInitialized state)+                then+                    sendError (configOutput config) reqId $+                        JSONRPCErrorInfo (-32002) "Server not initialized" Nothing+                else case params of+                    Just p -> case fromJSON p of+                        Aeson.Success listParams -> do+                            result <- handleListTools listParams+                            sendResponse (configOutput config) reqId result+                        Aeson.Error e ->+                            sendError (configOutput config) reqId $+                                JSONRPCErrorInfo (-32602) ("Invalid params: " <> T.pack e) Nothing+                    Nothing -> do+                        result <- handleListTools (ListToolsParams Nothing)+                        sendResponse (configOutput config) reqId result+        "tools/call" -> do+            if not (serverInitialized state)+                then+                    sendError (configOutput config) reqId $+                        JSONRPCErrorInfo (-32002) "Server not initialized" Nothing+                else case params of+                    Just p -> case fromJSON p of+                        Aeson.Success callParams -> do+                            result <- handleCallTool callParams+                            sendResponse (configOutput config) reqId result+                        Aeson.Error e ->+                            sendError (configOutput config) reqId $+                                JSONRPCErrorInfo (-32602) ("Invalid params: " <> T.pack e) Nothing+                    Nothing ->+                        sendError (configOutput config) reqId $+                            JSONRPCErrorInfo (-32602) "Missing params" Nothing+        "completion/complete" -> do+            if not (serverInitialized state)+                then+                    sendError (configOutput config) reqId $+                        JSONRPCErrorInfo (-32002) "Server not initialized" Nothing+                else case params of+                    Just p -> case fromJSON p of+                        Aeson.Success completeParams -> do+                            result <- handleComplete completeParams+                            sendResponse (configOutput config) reqId result+                        Aeson.Error e ->+                            sendError (configOutput config) reqId $+                                JSONRPCErrorInfo (-32602) ("Invalid params: " <> T.pack e) Nothing+                    Nothing ->+                        sendError (configOutput config) reqId $+                            JSONRPCErrorInfo (-32602) "Missing params" Nothing+        "logging/setLevel" -> case params of+            Just p -> case fromJSON p of+                Aeson.Success setLevelParams -> do+                    _ <- handleSetLevel setLevelParams+                    -- SetLevel response is just an empty object+                    sendResponse (configOutput config) reqId (object [])+                Aeson.Error e ->+                    sendError (configOutput config) reqId $+                        JSONRPCErrorInfo (-32602) ("Invalid params: " <> T.pack e) Nothing+            Nothing ->+                sendError (configOutput config) reqId $+                    JSONRPCErrorInfo (-32602) "Missing params" Nothing+        _ ->+            sendError (configOutput config) reqId $+                JSONRPCErrorInfo (-32601) "Method not found" Nothing++handleInitialize :: RequestId -> InitializeParams -> MCPServerM ()+handleInitialize reqId params = do+    config <- ask+    state <- get++    let InitializeParams{capabilities = clientCaps} = params++    put+        state+            { serverInitialized = True+            , clientCapabilities = Just clientCaps+            , serverInfo = Just (configServerInfo config)+            }++    let result =+            InitializeResult+                { protocolVersion = "2024-11-05"+                , capabilities = serverCapabilities state+                , serverInfo = configServerInfo config+                , instructions = Nothing+                , _meta = Nothing+                }++    sendResponse (configOutput config) reqId result++handlePing :: RequestId -> MCPServerM ()+handlePing reqId = do+    config <- ask+    -- Ping response is just an empty object in MCP+    sendResponse (configOutput config) reqId (object [])++-- | Handle a JSON-RPC notification+handleNotification :: JSONRPCNotification -> MCPServerM ()+handleNotification _ = do+    return ()++-- | Run the MCP server with the given configuration+runServer :: (MCPServer MCPServerM) => ServerConfig -> IO ()+runServer config = do+    let initialState = initialServerState (configCapabilities config)++    let loop = do+            eofOrLine <-+                liftIO $+                    catch+                        (Right <$> BSC.hGetLine (configInput config))+                        (\e -> if isEOFError e then return (Left ()) else throwIO e)+            case eofOrLine of+                Left () -> return () -- EOF reached, exit gracefully+                Right line -> do+                    result <- handleMessage line+                    case result of+                        Just () -> loop+                        Nothing -> return ()++    result <- runMCPServer config initialState loop+    case result of+        Left err -> putStrLn $ "Server error: " ++ T.unpack err+        Right _ -> return () -- Don't print "Server terminated" for clean EOF