mcp-server 0.1.0.13 → 0.1.0.14
raw patch · 3 files changed
+48/−53 lines, 3 filesdep ~containersPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: containers
API changes (from Hackage documentation)
Files
- README.md +44/−8
- mcp-server.cabal +2/−2
- src/MCP/Server/Transport/Http.hs +2/−43
README.md view
@@ -70,32 +70,69 @@ } ``` -### Nestable data types+### Advanced Template Haskell Features -You can also nest your data types, but MUST always end in a record with named fields:+#### Automatic Naming Conventions +Constructor names are automatically converted to snake_case for MCP names:+ ```haskell--- Using fields, but prefixing with the Type name, because maybe the user wants to use Lenses+data MyTool = GetValue | SetValue | SearchItems+-- Becomes: "get_value", "set_value", "search_items"+```++#### Automatic Type Conversion++The derivation system automatically converts Text arguments to appropriate Haskell types:++```haskell+data MyTool = Calculate { number :: Int, factor :: Double, enabled :: Bool }+-- Text "42" -> Int 42+-- Text "3.14" -> Double 3.14 +-- Text "true" -> Bool True+```++Supported conversions: `Int`, `Integer`, `Double`, `Float`, `Bool`, and `Text` (no conversion).++#### Nested Parameter Types++You can nest parameter types with automatic unwrapping:++```haskell+-- Parameter record types data GetValueParams = GetValueParams { _gvpKey :: Text } data SetValueParams = SetValueParams { _svpKey :: Text, _svpValue :: Text } +-- Main tool type data SimpleTool = GetValue GetValueParams | SetValue SetValueParams deriving (Show, Eq) ``` -Which is probably nicer for using things like Lenses etc. However we do not support positional (and unnamed) parameters such as:+The Template Haskell derivation recursively unwraps single-parameter constructors until it reaches a record type, then extracts all fields for the MCP schema. +#### Resource URI Generation++Resources automatically get `resource://` URIs based on constructor names:+ ```haskell--- Positional arguments+data MyResource = Menu | Specials+-- Generates: "resource://menu", "resource://specials"+```++#### Unsupported Patterns++We do not support positional (unnamed) parameters:++```haskell+-- ❌ This won't work - no field names data SimpleTool = GetValue Int | SetValue Int Text- deriving (Show, Eq) ``` -Because we don't want to be generating names when returning details in MCP definitions.+All parameter types must ultimately resolve to records with named fields to generate proper MCP schemas. ## Custom Descriptions @@ -163,7 +200,6 @@ ``` **Features:**-- JSON-RPC batching support - CORS enabled for web clients - GET `/mcp` for server discovery - POST `/mcp` for JSON-RPC messages
mcp-server.cabal view
@@ -15,7 +15,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change-version: 0.1.0.13+version: 0.1.0.14 -- A short (one-line) description of the package. synopsis: Library for building Model Context Protocol (MCP) servers -- A longer description of the package.@@ -79,7 +79,7 @@ aeson >=2.0 && <3.0, base >=4.20.0 && <4.22, bytestring >=0.10 && <0.13,- containers >=0.6 && <0.8,+ containers >=0.6 && <0.9, http-types >=0.12 && <1.0, network-uri >=2.6 && <2.8, template-haskell >=2.16 && <2.24,
src/MCP/Server/Transport/Http.hs view
@@ -15,7 +15,6 @@ import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as TE-import qualified Data.Vector as V import Network.HTTP.Types import qualified Network.Wai as Wai import qualified Network.Wai.Handler.Warp as Warp@@ -113,7 +112,7 @@ [("Content-Type", "text/plain"), ("Allow", "GET, POST, OPTIONS")] "Method Not Allowed" --- | Handle JSON-RPC request from HTTP body (supports batching)+-- | Handle JSON-RPC request from HTTP body handleJsonRpcRequest :: HttpConfig -> McpServerInfo -> McpServerHandlers IO -> BSL.ByteString -> (Wai.Response -> IO Wai.ResponseReceived) -> IO Wai.ResponseReceived handleJsonRpcRequest config serverInfo handlers body respond = do case eitherDecode body of@@ -124,11 +123,7 @@ [("Content-Type", "application/json")] (encode $ object ["error" .= ("Invalid JSON" :: Text)]) - Right jsonValue -> do- -- Try to parse as batch first (array), then as single message- case jsonValue of- Array batch -> handleJsonRpcBatch config serverInfo handlers (V.toList batch) respond- singleValue -> handleSingleJsonRpc config serverInfo handlers singleValue respond+ Right jsonValue -> handleSingleJsonRpc config serverInfo handlers jsonValue respond -- | Handle a single JSON-RPC message handleSingleJsonRpc :: HttpConfig -> McpServerInfo -> McpServerHandlers IO -> Value -> (Wai.Response -> IO Wai.ResponseReceived) -> IO Wai.ResponseReceived@@ -162,40 +157,4 @@ [("Content-Type", "application/json"), ("Access-Control-Allow-Origin", "*")] "{}" --- | Handle JSON-RPC batch request (MCP 2025-03-26 feature)-handleJsonRpcBatch :: HttpConfig -> McpServerInfo -> McpServerHandlers IO -> [Value] -> (Wai.Response -> IO Wai.ResponseReceived) -> IO Wai.ResponseReceived-handleJsonRpcBatch config serverInfo handlers batch respond = do- logVerbose config $ "Processing JSON-RPC batch with " ++ show (length batch) ++ " messages"-- -- Process each message in the batch- responses <- mapM (processBatchMessage config serverInfo handlers) batch-- -- Filter out Nothing responses (notifications)- let validResponses = [r | Just r <- responses]-- case validResponses of- [] -> do- logVerbose config "Batch contained only notifications, returning empty JSON array"- respond $ Wai.responseLBS - status200 - [("Content-Type", "application/json"), ("Access-Control-Allow-Origin", "*")] - "[]"- _ -> do- let responseJson = encode $ map encodeJsonRpcMessage validResponses- logVerbose config $ "Sending batch response with " ++ show (length validResponses) ++ " responses"- respond $ Wai.responseLBS- status200- [("Content-Type", "application/json"), ("Access-Control-Allow-Origin", "*")]- responseJson---- | Process a single message from a batch-processBatchMessage :: HttpConfig -> McpServerInfo -> McpServerHandlers IO -> Value -> IO (Maybe JsonRpcMessage)-processBatchMessage config serverInfo handlers jsonValue = do- case parseJsonRpcMessage jsonValue of- Left err -> do- logVerbose config $ "Batch message parse error: " ++ err- return Nothing -- Skip invalid messages in batch- Right message -> do- logVerbose config $ "Processing batch message: " ++ show (getMessageSummary message)- handleMcpMessage serverInfo handlers message