{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}

module MCP.Server.Transport.Http
  ( -- * HTTP Transport
    HttpConfig(..)
  , transportRunHttp
  , defaultHttpConfig
  ) where

import           Control.Monad            (when)
import           Data.Aeson
import qualified Data.ByteString.Lazy     as BSL
import           Data.String              (IsString (fromString))
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
import           System.IO                (hPutStrLn, stderr)

import           MCP.Server.Handlers
import           MCP.Server.JsonRpc
import           MCP.Server.Types

-- | HTTP transport configuration following MCP 2025-03-26 Streamable HTTP specification
data HttpConfig = HttpConfig
  { HttpConfig -> Int
httpPort     :: Int      -- ^ Port to listen on
  , HttpConfig -> String
httpHost     :: String   -- ^ Host to bind to (default "localhost")
  , HttpConfig -> String
httpEndpoint :: String   -- ^ MCP endpoint path (default "/mcp")
  , HttpConfig -> Bool
httpVerbose  :: Bool     -- ^ Enable verbose logging (default False)
  } deriving (Int -> HttpConfig -> ShowS
[HttpConfig] -> ShowS
HttpConfig -> String
(Int -> HttpConfig -> ShowS)
-> (HttpConfig -> String)
-> ([HttpConfig] -> ShowS)
-> Show HttpConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HttpConfig -> ShowS
showsPrec :: Int -> HttpConfig -> ShowS
$cshow :: HttpConfig -> String
show :: HttpConfig -> String
$cshowList :: [HttpConfig] -> ShowS
showList :: [HttpConfig] -> ShowS
Show, HttpConfig -> HttpConfig -> Bool
(HttpConfig -> HttpConfig -> Bool)
-> (HttpConfig -> HttpConfig -> Bool) -> Eq HttpConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HttpConfig -> HttpConfig -> Bool
== :: HttpConfig -> HttpConfig -> Bool
$c/= :: HttpConfig -> HttpConfig -> Bool
/= :: HttpConfig -> HttpConfig -> Bool
Eq)

-- | Default HTTP configuration
defaultHttpConfig :: HttpConfig
defaultHttpConfig :: HttpConfig
defaultHttpConfig = HttpConfig
  { httpPort :: Int
httpPort = Int
3000
  , httpHost :: String
httpHost = String
"localhost"
  , httpEndpoint :: String
httpEndpoint = String
"/mcp"
  , httpVerbose :: Bool
httpVerbose = Bool
False
  }

-- | Helper for conditional logging
logVerbose :: HttpConfig -> String -> IO ()
logVerbose :: HttpConfig -> String -> IO ()
logVerbose HttpConfig
config String
msg = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (HttpConfig -> Bool
httpVerbose HttpConfig
config) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStrLn Handle
stderr String
msg


-- | Transport-specific implementation for HTTP
transportRunHttp :: HttpConfig -> McpServerInfo -> McpServerHandlers IO -> IO ()
transportRunHttp :: HttpConfig -> McpServerInfo -> McpServerHandlers IO -> IO ()
transportRunHttp HttpConfig
config McpServerInfo
serverInfo McpServerHandlers IO
handlers = do
  let settings :: Settings
settings = HostPreference -> Settings -> Settings
Warp.setHost (String -> HostPreference
forall a. IsString a => String -> a
fromString (String -> HostPreference) -> String -> HostPreference
forall a b. (a -> b) -> a -> b
$ HttpConfig -> String
httpHost HttpConfig
config) (Settings -> Settings) -> Settings -> Settings
forall a b. (a -> b) -> a -> b
$
                 Int -> Settings -> Settings
Warp.setPort (HttpConfig -> Int
httpPort HttpConfig
config) (Settings -> Settings) -> Settings -> Settings
forall a b. (a -> b) -> a -> b
$
                 Settings
Warp.defaultSettings

  String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Starting MCP HTTP server on " String -> ShowS
forall a. [a] -> [a] -> [a]
++ HttpConfig -> String
httpHost HttpConfig
config String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (HttpConfig -> Int
httpPort HttpConfig
config) String -> ShowS
forall a. [a] -> [a] -> [a]
++ HttpConfig -> String
httpEndpoint HttpConfig
config
  Settings -> Application -> IO ()
Warp.runSettings Settings
settings (HttpConfig -> McpServerInfo -> McpServerHandlers IO -> Application
mcpApplication HttpConfig
config McpServerInfo
serverInfo McpServerHandlers IO
handlers)

-- | WAI Application for MCP over HTTP
mcpApplication :: HttpConfig -> McpServerInfo -> McpServerHandlers IO -> Wai.Application
mcpApplication :: HttpConfig -> McpServerInfo -> McpServerHandlers IO -> Application
mcpApplication HttpConfig
config McpServerInfo
serverInfo McpServerHandlers IO
handlers Request
req Response -> IO ResponseReceived
respond = do
  -- Log the request
  HttpConfig -> String -> IO ()
logVerbose HttpConfig
config (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"HTTP " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show (Request -> ByteString
Wai.requestMethod Request
req) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack (ByteString -> Text
TE.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Request -> ByteString
Wai.rawPathInfo Request
req)

  -- Check if this is our MCP endpoint
  if ByteString -> Text
TE.decodeUtf8 (Request -> ByteString
Wai.rawPathInfo Request
req) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
T.pack (HttpConfig -> String
httpEndpoint HttpConfig
config)
    then HttpConfig -> McpServerInfo -> McpServerHandlers IO -> Application
handleMcpRequest HttpConfig
config McpServerInfo
serverInfo McpServerHandlers IO
handlers Request
req Response -> IO ResponseReceived
respond
    else Response -> IO ResponseReceived
respond (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ Status -> ResponseHeaders -> ByteString -> Response
Wai.responseLBS Status
status404 [(HeaderName
"Content-Type", ByteString
"text/plain")] ByteString
"Not Found"

-- | Handle MCP requests according to Streamable HTTP specification
handleMcpRequest :: HttpConfig -> McpServerInfo -> McpServerHandlers IO -> Wai.Request -> (Wai.Response -> IO Wai.ResponseReceived) -> IO Wai.ResponseReceived
handleMcpRequest :: HttpConfig -> McpServerInfo -> McpServerHandlers IO -> Application
handleMcpRequest HttpConfig
config McpServerInfo
serverInfo McpServerHandlers IO
handlers Request
req Response -> IO ResponseReceived
respond = do
  case Request -> ByteString
Wai.requestMethod Request
req of
    -- GET requests for endpoint discovery
    ByteString
"GET" -> do
      let discoveryResponse :: Value
discoveryResponse = [Pair] -> Value
object
            [ Key
"name" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= McpServerInfo -> Text
serverName McpServerInfo
serverInfo
            , Key
"version" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= McpServerInfo -> Text
serverVersion McpServerInfo
serverInfo
            , Key
"description" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= McpServerInfo -> Text
serverInstructions McpServerInfo
serverInfo
            , Key
"protocolVersion" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"2025-03-26" :: Text)
            , Key
"capabilities" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object
                [ Key
"tools" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object []
                , Key
"prompts" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object []
                , Key
"resources" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object []
                ]
            ]
      HttpConfig -> String -> IO ()
logVerbose HttpConfig
config (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Sending server discovery response: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Value -> String
forall a. Show a => a -> String
show Value
discoveryResponse
      Response -> IO ResponseReceived
respond (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ Status -> ResponseHeaders -> ByteString -> Response
Wai.responseLBS
        Status
status200
        [(HeaderName
"Content-Type", ByteString
"application/json"), (HeaderName
"Access-Control-Allow-Origin", ByteString
"*")]
        (Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
discoveryResponse)

    -- POST requests for JSON-RPC messages
    ByteString
"POST" -> do
      -- Read request body
      body <- Request -> IO ByteString
Wai.strictRequestBody Request
req
      logVerbose config $ "Received POST body (" ++ show (BSL.length body) ++ " bytes): " ++ take 200 (show body)
      handleJsonRpcRequest config serverInfo handlers body respond

    -- OPTIONS for CORS preflight
    ByteString
"OPTIONS" -> Response -> IO ResponseReceived
respond (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ Status -> ResponseHeaders -> ByteString -> Response
Wai.responseLBS
      Status
status200
      [ (HeaderName
"Access-Control-Allow-Origin", ByteString
"*")
      , (HeaderName
"Access-Control-Allow-Methods", ByteString
"GET, POST, OPTIONS")
      , (HeaderName
"Access-Control-Allow-Headers", ByteString
"Content-Type")
      ]
      ByteString
""

    -- Unsupported methods
    ByteString
_ -> Response -> IO ResponseReceived
respond (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ Status -> ResponseHeaders -> ByteString -> Response
Wai.responseLBS
      Status
status405
      [(HeaderName
"Content-Type", ByteString
"text/plain"), (HeaderName
"Allow", ByteString
"GET, POST, OPTIONS")]
      ByteString
"Method Not Allowed"

-- | Handle JSON-RPC request from HTTP body (supports batching)
handleJsonRpcRequest :: HttpConfig -> McpServerInfo -> McpServerHandlers IO -> BSL.ByteString -> (Wai.Response -> IO Wai.ResponseReceived) -> IO Wai.ResponseReceived
handleJsonRpcRequest :: HttpConfig
-> McpServerInfo
-> McpServerHandlers IO
-> ByteString
-> (Response -> IO ResponseReceived)
-> IO ResponseReceived
handleJsonRpcRequest HttpConfig
config McpServerInfo
serverInfo McpServerHandlers IO
handlers ByteString
body Response -> IO ResponseReceived
respond = do
  case ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
body of
    Left String
err -> do
      Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"JSON parse error: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
err
      Response -> IO ResponseReceived
respond (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ Status -> ResponseHeaders -> ByteString -> Response
Wai.responseLBS
        Status
status400
        [(HeaderName
"Content-Type", ByteString
"application/json")]
        (Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode (Value -> ByteString) -> Value -> ByteString
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object [Key
"error" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"Invalid JSON" :: Text)])

    Right Value
jsonValue -> do
      -- Try to parse as batch first (array), then as single message
      case Value
jsonValue of
        Array Array
batch -> HttpConfig
-> McpServerInfo
-> McpServerHandlers IO
-> [Value]
-> (Response -> IO ResponseReceived)
-> IO ResponseReceived
handleJsonRpcBatch HttpConfig
config McpServerInfo
serverInfo McpServerHandlers IO
handlers (Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
batch) Response -> IO ResponseReceived
respond
        Value
singleValue -> HttpConfig
-> McpServerInfo
-> McpServerHandlers IO
-> Value
-> (Response -> IO ResponseReceived)
-> IO ResponseReceived
handleSingleJsonRpc HttpConfig
config McpServerInfo
serverInfo McpServerHandlers IO
handlers Value
singleValue Response -> IO ResponseReceived
respond

-- | Handle a single JSON-RPC message
handleSingleJsonRpc :: HttpConfig -> McpServerInfo -> McpServerHandlers IO -> Value -> (Wai.Response -> IO Wai.ResponseReceived) -> IO Wai.ResponseReceived
handleSingleJsonRpc :: HttpConfig
-> McpServerInfo
-> McpServerHandlers IO
-> Value
-> (Response -> IO ResponseReceived)
-> IO ResponseReceived
handleSingleJsonRpc HttpConfig
config McpServerInfo
serverInfo McpServerHandlers IO
handlers Value
jsonValue Response -> IO ResponseReceived
respond = do
  case Value -> Either String JsonRpcMessage
parseJsonRpcMessage Value
jsonValue of
    Left String
err -> do
      Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"JSON-RPC parse error: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
err
      Response -> IO ResponseReceived
respond (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ Status -> ResponseHeaders -> ByteString -> Response
Wai.responseLBS
        Status
status400
        [(HeaderName
"Content-Type", ByteString
"application/json")]
        (Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode (Value -> ByteString) -> Value -> ByteString
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object [Key
"error" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"Invalid JSON-RPC" :: Text)])

    Right JsonRpcMessage
message -> do
      HttpConfig -> String -> IO ()
logVerbose HttpConfig
config (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Processing HTTP message: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show (JsonRpcMessage -> String
getMessageSummary JsonRpcMessage
message)
      maybeResponse <- McpServerInfo
-> McpServerHandlers IO
-> JsonRpcMessage
-> IO (Maybe JsonRpcMessage)
forall (m :: * -> *).
MonadIO m =>
McpServerInfo
-> McpServerHandlers m
-> JsonRpcMessage
-> m (Maybe JsonRpcMessage)
handleMcpMessage McpServerInfo
serverInfo McpServerHandlers IO
handlers JsonRpcMessage
message

      case maybeResponse of
        Just JsonRpcMessage
responseMsg -> do
          let responseJson :: ByteString
responseJson = Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode (Value -> ByteString) -> Value -> ByteString
forall a b. (a -> b) -> a -> b
$ JsonRpcMessage -> Value
encodeJsonRpcMessage JsonRpcMessage
responseMsg
          HttpConfig -> String -> IO ()
logVerbose HttpConfig
config (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Sending HTTP response for: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show (JsonRpcMessage -> String
getMessageSummary JsonRpcMessage
message)
          Response -> IO ResponseReceived
respond (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ Status -> ResponseHeaders -> ByteString -> Response
Wai.responseLBS
            Status
status200
            [(HeaderName
"Content-Type", ByteString
"application/json"), (HeaderName
"Access-Control-Allow-Origin", ByteString
"*")]
            ByteString
responseJson

        Maybe JsonRpcMessage
Nothing -> do
          HttpConfig -> String -> IO ()
logVerbose HttpConfig
config (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"No response needed for: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show (JsonRpcMessage -> String
getMessageSummary JsonRpcMessage
message)
          -- For notifications, return 200 with empty JSON object (per MCP spec)
          Response -> IO ResponseReceived
respond (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ Status -> ResponseHeaders -> ByteString -> Response
Wai.responseLBS 
            Status
status200 
            [(HeaderName
"Content-Type", ByteString
"application/json"), (HeaderName
"Access-Control-Allow-Origin", ByteString
"*")] 
            ByteString
"{}"

-- | 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 :: HttpConfig
-> McpServerInfo
-> McpServerHandlers IO
-> [Value]
-> (Response -> IO ResponseReceived)
-> IO ResponseReceived
handleJsonRpcBatch HttpConfig
config McpServerInfo
serverInfo McpServerHandlers IO
handlers [Value]
batch Response -> IO ResponseReceived
respond = do
  HttpConfig -> String -> IO ()
logVerbose HttpConfig
config (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Processing JSON-RPC batch with " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([Value] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
batch) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" messages"

  -- Process each message in the batch
  responses <- (Value -> IO (Maybe JsonRpcMessage))
-> [Value] -> IO [Maybe JsonRpcMessage]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (HttpConfig
-> McpServerInfo
-> McpServerHandlers IO
-> Value
-> IO (Maybe JsonRpcMessage)
processBatchMessage HttpConfig
config McpServerInfo
serverInfo McpServerHandlers IO
handlers) [Value]
batch

  -- Filter out Nothing responses (notifications)
  let validResponses = [JsonRpcMessage
r | Just JsonRpcMessage
r <- [Maybe JsonRpcMessage]
responses]

  case validResponses of
    [] -> do
      HttpConfig -> String -> IO ()
logVerbose HttpConfig
config String
"Batch contained only notifications, returning empty JSON array"
      Response -> IO ResponseReceived
respond (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ Status -> ResponseHeaders -> ByteString -> Response
Wai.responseLBS 
        Status
status200 
        [(HeaderName
"Content-Type", ByteString
"application/json"), (HeaderName
"Access-Control-Allow-Origin", ByteString
"*")] 
        ByteString
"[]"
    [JsonRpcMessage]
_ -> do
      let responseJson :: ByteString
responseJson = [Value] -> ByteString
forall a. ToJSON a => a -> ByteString
encode ([Value] -> ByteString) -> [Value] -> ByteString
forall a b. (a -> b) -> a -> b
$ (JsonRpcMessage -> Value) -> [JsonRpcMessage] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map JsonRpcMessage -> Value
encodeJsonRpcMessage [JsonRpcMessage]
validResponses
      HttpConfig -> String -> IO ()
logVerbose HttpConfig
config (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Sending batch response with " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([JsonRpcMessage] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [JsonRpcMessage]
validResponses) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" responses"
      Response -> IO ResponseReceived
respond (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ Status -> ResponseHeaders -> ByteString -> Response
Wai.responseLBS
        Status
status200
        [(HeaderName
"Content-Type", ByteString
"application/json"), (HeaderName
"Access-Control-Allow-Origin", ByteString
"*")]
        ByteString
responseJson

-- | Process a single message from a batch
processBatchMessage :: HttpConfig -> McpServerInfo -> McpServerHandlers IO -> Value -> IO (Maybe JsonRpcMessage)
processBatchMessage :: HttpConfig
-> McpServerInfo
-> McpServerHandlers IO
-> Value
-> IO (Maybe JsonRpcMessage)
processBatchMessage HttpConfig
config McpServerInfo
serverInfo McpServerHandlers IO
handlers Value
jsonValue = do
  case Value -> Either String JsonRpcMessage
parseJsonRpcMessage Value
jsonValue of
    Left String
err -> do
      HttpConfig -> String -> IO ()
logVerbose HttpConfig
config (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Batch message parse error: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
err
      Maybe JsonRpcMessage -> IO (Maybe JsonRpcMessage)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe JsonRpcMessage
forall a. Maybe a
Nothing -- Skip invalid messages in batch
    Right JsonRpcMessage
message -> do
      HttpConfig -> String -> IO ()
logVerbose HttpConfig
config (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Processing batch message: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show (JsonRpcMessage -> String
getMessageSummary JsonRpcMessage
message)
      McpServerInfo
-> McpServerHandlers IO
-> JsonRpcMessage
-> IO (Maybe JsonRpcMessage)
forall (m :: * -> *).
MonadIO m =>
McpServerInfo
-> McpServerHandlers m
-> JsonRpcMessage
-> m (Maybe JsonRpcMessage)
handleMcpMessage McpServerInfo
serverInfo McpServerHandlers IO
handlers JsonRpcMessage
message