{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# 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, ServerConfig (..), ServerState (..), initialServerState, runMCPServer, sendError, sendResponse)
import MCP.Types

-- | Handle an incoming JSON-RPC message
handleMessage :: (MCPServer MCPServerM) => BSC.ByteString -> MCPServerM (Maybe ())
handleMessage :: MCPServer
  (ReaderT ServerConfig (StateT ServerState (ExceptT Text IO))) =>
ByteString -> MCPServerM (Maybe ())
handleMessage ByteString
input = do
    case ByteString -> Maybe JSONRPCMessage
forall a. FromJSON a => ByteString -> Maybe a
decode (ByteString -> ByteString
LBS.fromStrict ByteString
input) :: Maybe JSONRPCMessage of
        Maybe JSONRPCMessage
Nothing -> do
            ServerConfig
config <- ReaderT
  ServerConfig (StateT ServerState (ExceptT Text IO)) ServerConfig
forall r (m :: * -> *). MonadReader r m => m r
ask
            Handle
-> RequestId
-> JSONRPCErrorInfo
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall (m :: * -> *).
MonadIO m =>
Handle -> RequestId -> JSONRPCErrorInfo -> m ()
sendError (ServerConfig -> Handle
configOutput ServerConfig
config) (Value -> RequestId
RequestId (Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text
"unknown" :: T.Text))) (JSONRPCErrorInfo
 -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ())
-> JSONRPCErrorInfo
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall a b. (a -> b) -> a -> b
$
                Int -> Text -> Maybe Value -> JSONRPCErrorInfo
JSONRPCErrorInfo (-Int
32700) Text
"Parse error" Maybe Value
forall a. Maybe a
Nothing
            Maybe () -> MCPServerM (Maybe ())
forall a.
a -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ()
forall a. Maybe a
Nothing
        Just JSONRPCMessage
msg -> case JSONRPCMessage
msg of
            RequestMessage JSONRPCRequest
req -> do
                JSONRPCRequest
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
MCPServer
  (ReaderT ServerConfig (StateT ServerState (ExceptT Text IO))) =>
JSONRPCRequest
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
handleRequest JSONRPCRequest
req
                Maybe () -> MCPServerM (Maybe ())
forall a.
a -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> Maybe ()
forall a. a -> Maybe a
Just ())
            NotificationMessage JSONRPCNotification
notif -> do
                JSONRPCNotification
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
handleNotification JSONRPCNotification
notif
                Maybe () -> MCPServerM (Maybe ())
forall a.
a -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> Maybe ()
forall a. a -> Maybe a
Just ())
            JSONRPCMessage
_ -> do
                ServerConfig
config <- ReaderT
  ServerConfig (StateT ServerState (ExceptT Text IO)) ServerConfig
forall r (m :: * -> *). MonadReader r m => m r
ask
                Handle
-> RequestId
-> JSONRPCErrorInfo
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall (m :: * -> *).
MonadIO m =>
Handle -> RequestId -> JSONRPCErrorInfo -> m ()
sendError (ServerConfig -> Handle
configOutput ServerConfig
config) (Value -> RequestId
RequestId (Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text
"unknown" :: T.Text))) (JSONRPCErrorInfo
 -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ())
-> JSONRPCErrorInfo
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall a b. (a -> b) -> a -> b
$
                    Int -> Text -> Maybe Value -> JSONRPCErrorInfo
JSONRPCErrorInfo (-Int
32600) Text
"Invalid Request" Maybe Value
forall a. Maybe a
Nothing
                Maybe () -> MCPServerM (Maybe ())
forall a.
a -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ()
forall a. Maybe a
Nothing

-- | Handle a JSON-RPC request
handleRequest :: (MCPServer MCPServerM) => JSONRPCRequest -> MCPServerM ()
handleRequest :: MCPServer
  (ReaderT ServerConfig (StateT ServerState (ExceptT Text IO))) =>
JSONRPCRequest
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
handleRequest (JSONRPCRequest Text
_ RequestId
reqId Text
method Maybe Value
params) = do
    ServerConfig
config <- ReaderT
  ServerConfig (StateT ServerState (ExceptT Text IO)) ServerConfig
forall r (m :: * -> *). MonadReader r m => m r
ask
    ServerState
state <- ReaderT
  ServerConfig (StateT ServerState (ExceptT Text IO)) ServerState
forall s (m :: * -> *). MonadState s m => m s
get

    case Text
method of
        Text
"initialize" -> case Maybe Value
params of
            Just Value
p -> case Value -> Result InitializeParams
forall a. FromJSON a => Value -> Result a
fromJSON Value
p of
                Aeson.Success InitializeParams
initParams -> RequestId
-> InitializeParams
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
handleInitialize RequestId
reqId InitializeParams
initParams
                Aeson.Error String
e ->
                    Handle
-> RequestId
-> JSONRPCErrorInfo
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall (m :: * -> *).
MonadIO m =>
Handle -> RequestId -> JSONRPCErrorInfo -> m ()
sendError (ServerConfig -> Handle
configOutput ServerConfig
config) RequestId
reqId (JSONRPCErrorInfo
 -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ())
-> JSONRPCErrorInfo
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall a b. (a -> b) -> a -> b
$
                        Int -> Text -> Maybe Value -> JSONRPCErrorInfo
JSONRPCErrorInfo (-Int
32602) (Text
"Invalid params: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
e) Maybe Value
forall a. Maybe a
Nothing
            Maybe Value
Nothing ->
                Handle
-> RequestId
-> JSONRPCErrorInfo
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall (m :: * -> *).
MonadIO m =>
Handle -> RequestId -> JSONRPCErrorInfo -> m ()
sendError (ServerConfig -> Handle
configOutput ServerConfig
config) RequestId
reqId (JSONRPCErrorInfo
 -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ())
-> JSONRPCErrorInfo
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall a b. (a -> b) -> a -> b
$
                    Int -> Text -> Maybe Value -> JSONRPCErrorInfo
JSONRPCErrorInfo (-Int
32602) Text
"Missing params" Maybe Value
forall a. Maybe a
Nothing
        Text
"ping" -> RequestId
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
handlePing RequestId
reqId
        Text
"resources/list" -> do
            if Bool -> Bool
not (ServerState -> Bool
serverInitialized ServerState
state)
                then
                    Handle
-> RequestId
-> JSONRPCErrorInfo
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall (m :: * -> *).
MonadIO m =>
Handle -> RequestId -> JSONRPCErrorInfo -> m ()
sendError (ServerConfig -> Handle
configOutput ServerConfig
config) RequestId
reqId (JSONRPCErrorInfo
 -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ())
-> JSONRPCErrorInfo
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall a b. (a -> b) -> a -> b
$
                        Int -> Text -> Maybe Value -> JSONRPCErrorInfo
JSONRPCErrorInfo (-Int
32002) Text
"Server not initialized" Maybe Value
forall a. Maybe a
Nothing
                else case Maybe Value
params of
                    Just Value
p -> case Value -> Result ListResourcesParams
forall a. FromJSON a => Value -> Result a
fromJSON Value
p of
                        Aeson.Success ListResourcesParams
listParams -> do
                            ListResourcesResult
result <- ListResourcesParams
-> ReaderT
     ServerConfig
     (StateT ServerState (ExceptT Text IO))
     ListResourcesResult
forall (m :: * -> *).
MCPServer m =>
ListResourcesParams -> m ListResourcesResult
handleListResources ListResourcesParams
listParams
                            Handle
-> RequestId
-> ListResourcesResult
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall (m :: * -> *) a.
(MonadIO m, ToJSON a) =>
Handle -> RequestId -> a -> m ()
sendResponse (ServerConfig -> Handle
configOutput ServerConfig
config) RequestId
reqId ListResourcesResult
result
                        Aeson.Error String
e ->
                            Handle
-> RequestId
-> JSONRPCErrorInfo
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall (m :: * -> *).
MonadIO m =>
Handle -> RequestId -> JSONRPCErrorInfo -> m ()
sendError (ServerConfig -> Handle
configOutput ServerConfig
config) RequestId
reqId (JSONRPCErrorInfo
 -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ())
-> JSONRPCErrorInfo
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall a b. (a -> b) -> a -> b
$
                                Int -> Text -> Maybe Value -> JSONRPCErrorInfo
JSONRPCErrorInfo (-Int
32602) (Text
"Invalid params: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
e) Maybe Value
forall a. Maybe a
Nothing
                    Maybe Value
Nothing -> do
                        ListResourcesResult
result <- ListResourcesParams
-> ReaderT
     ServerConfig
     (StateT ServerState (ExceptT Text IO))
     ListResourcesResult
forall (m :: * -> *).
MCPServer m =>
ListResourcesParams -> m ListResourcesResult
handleListResources (Maybe Cursor -> ListResourcesParams
ListResourcesParams Maybe Cursor
forall a. Maybe a
Nothing)
                        Handle
-> RequestId
-> ListResourcesResult
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall (m :: * -> *) a.
(MonadIO m, ToJSON a) =>
Handle -> RequestId -> a -> m ()
sendResponse (ServerConfig -> Handle
configOutput ServerConfig
config) RequestId
reqId ListResourcesResult
result
        Text
"resources/read" -> do
            if Bool -> Bool
not (ServerState -> Bool
serverInitialized ServerState
state)
                then
                    Handle
-> RequestId
-> JSONRPCErrorInfo
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall (m :: * -> *).
MonadIO m =>
Handle -> RequestId -> JSONRPCErrorInfo -> m ()
sendError (ServerConfig -> Handle
configOutput ServerConfig
config) RequestId
reqId (JSONRPCErrorInfo
 -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ())
-> JSONRPCErrorInfo
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall a b. (a -> b) -> a -> b
$
                        Int -> Text -> Maybe Value -> JSONRPCErrorInfo
JSONRPCErrorInfo (-Int
32002) Text
"Server not initialized" Maybe Value
forall a. Maybe a
Nothing
                else case Maybe Value
params of
                    Just Value
p -> case Value -> Result ReadResourceParams
forall a. FromJSON a => Value -> Result a
fromJSON Value
p of
                        Aeson.Success ReadResourceParams
readParams -> do
                            ReadResourceResult
result <- ReadResourceParams
-> ReaderT
     ServerConfig
     (StateT ServerState (ExceptT Text IO))
     ReadResourceResult
forall (m :: * -> *).
MCPServer m =>
ReadResourceParams -> m ReadResourceResult
handleReadResource ReadResourceParams
readParams
                            Handle
-> RequestId
-> ReadResourceResult
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall (m :: * -> *) a.
(MonadIO m, ToJSON a) =>
Handle -> RequestId -> a -> m ()
sendResponse (ServerConfig -> Handle
configOutput ServerConfig
config) RequestId
reqId ReadResourceResult
result
                        Aeson.Error String
e ->
                            Handle
-> RequestId
-> JSONRPCErrorInfo
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall (m :: * -> *).
MonadIO m =>
Handle -> RequestId -> JSONRPCErrorInfo -> m ()
sendError (ServerConfig -> Handle
configOutput ServerConfig
config) RequestId
reqId (JSONRPCErrorInfo
 -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ())
-> JSONRPCErrorInfo
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall a b. (a -> b) -> a -> b
$
                                Int -> Text -> Maybe Value -> JSONRPCErrorInfo
JSONRPCErrorInfo (-Int
32602) (Text
"Invalid params: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
e) Maybe Value
forall a. Maybe a
Nothing
                    Maybe Value
Nothing ->
                        Handle
-> RequestId
-> JSONRPCErrorInfo
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall (m :: * -> *).
MonadIO m =>
Handle -> RequestId -> JSONRPCErrorInfo -> m ()
sendError (ServerConfig -> Handle
configOutput ServerConfig
config) RequestId
reqId (JSONRPCErrorInfo
 -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ())
-> JSONRPCErrorInfo
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall a b. (a -> b) -> a -> b
$
                            Int -> Text -> Maybe Value -> JSONRPCErrorInfo
JSONRPCErrorInfo (-Int
32602) Text
"Missing params" Maybe Value
forall a. Maybe a
Nothing
        Text
"resources/templates/list" -> do
            if Bool -> Bool
not (ServerState -> Bool
serverInitialized ServerState
state)
                then
                    Handle
-> RequestId
-> JSONRPCErrorInfo
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall (m :: * -> *).
MonadIO m =>
Handle -> RequestId -> JSONRPCErrorInfo -> m ()
sendError (ServerConfig -> Handle
configOutput ServerConfig
config) RequestId
reqId (JSONRPCErrorInfo
 -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ())
-> JSONRPCErrorInfo
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall a b. (a -> b) -> a -> b
$
                        Int -> Text -> Maybe Value -> JSONRPCErrorInfo
JSONRPCErrorInfo (-Int
32002) Text
"Server not initialized" Maybe Value
forall a. Maybe a
Nothing
                else case Maybe Value
params of
                    Just Value
p -> case Value -> Result ListResourceTemplatesParams
forall a. FromJSON a => Value -> Result a
fromJSON Value
p of
                        Aeson.Success ListResourceTemplatesParams
listParams -> do
                            ListResourceTemplatesResult
result <- ListResourceTemplatesParams
-> ReaderT
     ServerConfig
     (StateT ServerState (ExceptT Text IO))
     ListResourceTemplatesResult
forall (m :: * -> *).
MCPServer m =>
ListResourceTemplatesParams -> m ListResourceTemplatesResult
handleListResourceTemplates ListResourceTemplatesParams
listParams
                            Handle
-> RequestId
-> ListResourceTemplatesResult
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall (m :: * -> *) a.
(MonadIO m, ToJSON a) =>
Handle -> RequestId -> a -> m ()
sendResponse (ServerConfig -> Handle
configOutput ServerConfig
config) RequestId
reqId ListResourceTemplatesResult
result
                        Aeson.Error String
e ->
                            Handle
-> RequestId
-> JSONRPCErrorInfo
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall (m :: * -> *).
MonadIO m =>
Handle -> RequestId -> JSONRPCErrorInfo -> m ()
sendError (ServerConfig -> Handle
configOutput ServerConfig
config) RequestId
reqId (JSONRPCErrorInfo
 -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ())
-> JSONRPCErrorInfo
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall a b. (a -> b) -> a -> b
$
                                Int -> Text -> Maybe Value -> JSONRPCErrorInfo
JSONRPCErrorInfo (-Int
32602) (Text
"Invalid params: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
e) Maybe Value
forall a. Maybe a
Nothing
                    Maybe Value
Nothing -> do
                        ListResourceTemplatesResult
result <- ListResourceTemplatesParams
-> ReaderT
     ServerConfig
     (StateT ServerState (ExceptT Text IO))
     ListResourceTemplatesResult
forall (m :: * -> *).
MCPServer m =>
ListResourceTemplatesParams -> m ListResourceTemplatesResult
handleListResourceTemplates (Maybe Cursor -> ListResourceTemplatesParams
ListResourceTemplatesParams Maybe Cursor
forall a. Maybe a
Nothing)
                        Handle
-> RequestId
-> ListResourceTemplatesResult
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall (m :: * -> *) a.
(MonadIO m, ToJSON a) =>
Handle -> RequestId -> a -> m ()
sendResponse (ServerConfig -> Handle
configOutput ServerConfig
config) RequestId
reqId ListResourceTemplatesResult
result
        Text
"prompts/list" -> do
            if Bool -> Bool
not (ServerState -> Bool
serverInitialized ServerState
state)
                then
                    Handle
-> RequestId
-> JSONRPCErrorInfo
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall (m :: * -> *).
MonadIO m =>
Handle -> RequestId -> JSONRPCErrorInfo -> m ()
sendError (ServerConfig -> Handle
configOutput ServerConfig
config) RequestId
reqId (JSONRPCErrorInfo
 -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ())
-> JSONRPCErrorInfo
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall a b. (a -> b) -> a -> b
$
                        Int -> Text -> Maybe Value -> JSONRPCErrorInfo
JSONRPCErrorInfo (-Int
32002) Text
"Server not initialized" Maybe Value
forall a. Maybe a
Nothing
                else case Maybe Value
params of
                    Just Value
p -> case Value -> Result ListPromptsParams
forall a. FromJSON a => Value -> Result a
fromJSON Value
p of
                        Aeson.Success ListPromptsParams
listParams -> do
                            ListPromptsResult
result <- ListPromptsParams
-> ReaderT
     ServerConfig
     (StateT ServerState (ExceptT Text IO))
     ListPromptsResult
forall (m :: * -> *).
MCPServer m =>
ListPromptsParams -> m ListPromptsResult
handleListPrompts ListPromptsParams
listParams
                            Handle
-> RequestId
-> ListPromptsResult
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall (m :: * -> *) a.
(MonadIO m, ToJSON a) =>
Handle -> RequestId -> a -> m ()
sendResponse (ServerConfig -> Handle
configOutput ServerConfig
config) RequestId
reqId ListPromptsResult
result
                        Aeson.Error String
e ->
                            Handle
-> RequestId
-> JSONRPCErrorInfo
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall (m :: * -> *).
MonadIO m =>
Handle -> RequestId -> JSONRPCErrorInfo -> m ()
sendError (ServerConfig -> Handle
configOutput ServerConfig
config) RequestId
reqId (JSONRPCErrorInfo
 -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ())
-> JSONRPCErrorInfo
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall a b. (a -> b) -> a -> b
$
                                Int -> Text -> Maybe Value -> JSONRPCErrorInfo
JSONRPCErrorInfo (-Int
32602) (Text
"Invalid params: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
e) Maybe Value
forall a. Maybe a
Nothing
                    Maybe Value
Nothing -> do
                        ListPromptsResult
result <- ListPromptsParams
-> ReaderT
     ServerConfig
     (StateT ServerState (ExceptT Text IO))
     ListPromptsResult
forall (m :: * -> *).
MCPServer m =>
ListPromptsParams -> m ListPromptsResult
handleListPrompts (Maybe Cursor -> ListPromptsParams
ListPromptsParams Maybe Cursor
forall a. Maybe a
Nothing)
                        Handle
-> RequestId
-> ListPromptsResult
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall (m :: * -> *) a.
(MonadIO m, ToJSON a) =>
Handle -> RequestId -> a -> m ()
sendResponse (ServerConfig -> Handle
configOutput ServerConfig
config) RequestId
reqId ListPromptsResult
result
        Text
"prompts/get" -> do
            if Bool -> Bool
not (ServerState -> Bool
serverInitialized ServerState
state)
                then
                    Handle
-> RequestId
-> JSONRPCErrorInfo
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall (m :: * -> *).
MonadIO m =>
Handle -> RequestId -> JSONRPCErrorInfo -> m ()
sendError (ServerConfig -> Handle
configOutput ServerConfig
config) RequestId
reqId (JSONRPCErrorInfo
 -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ())
-> JSONRPCErrorInfo
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall a b. (a -> b) -> a -> b
$
                        Int -> Text -> Maybe Value -> JSONRPCErrorInfo
JSONRPCErrorInfo (-Int
32002) Text
"Server not initialized" Maybe Value
forall a. Maybe a
Nothing
                else case Maybe Value
params of
                    Just Value
p -> case Value -> Result GetPromptParams
forall a. FromJSON a => Value -> Result a
fromJSON Value
p of
                        Aeson.Success GetPromptParams
getParams -> do
                            GetPromptResult
result <- GetPromptParams
-> ReaderT
     ServerConfig (StateT ServerState (ExceptT Text IO)) GetPromptResult
forall (m :: * -> *).
MCPServer m =>
GetPromptParams -> m GetPromptResult
handleGetPrompt GetPromptParams
getParams
                            Handle
-> RequestId
-> GetPromptResult
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall (m :: * -> *) a.
(MonadIO m, ToJSON a) =>
Handle -> RequestId -> a -> m ()
sendResponse (ServerConfig -> Handle
configOutput ServerConfig
config) RequestId
reqId GetPromptResult
result
                        Aeson.Error String
e ->
                            Handle
-> RequestId
-> JSONRPCErrorInfo
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall (m :: * -> *).
MonadIO m =>
Handle -> RequestId -> JSONRPCErrorInfo -> m ()
sendError (ServerConfig -> Handle
configOutput ServerConfig
config) RequestId
reqId (JSONRPCErrorInfo
 -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ())
-> JSONRPCErrorInfo
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall a b. (a -> b) -> a -> b
$
                                Int -> Text -> Maybe Value -> JSONRPCErrorInfo
JSONRPCErrorInfo (-Int
32602) (Text
"Invalid params: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
e) Maybe Value
forall a. Maybe a
Nothing
                    Maybe Value
Nothing ->
                        Handle
-> RequestId
-> JSONRPCErrorInfo
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall (m :: * -> *).
MonadIO m =>
Handle -> RequestId -> JSONRPCErrorInfo -> m ()
sendError (ServerConfig -> Handle
configOutput ServerConfig
config) RequestId
reqId (JSONRPCErrorInfo
 -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ())
-> JSONRPCErrorInfo
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall a b. (a -> b) -> a -> b
$
                            Int -> Text -> Maybe Value -> JSONRPCErrorInfo
JSONRPCErrorInfo (-Int
32602) Text
"Missing params" Maybe Value
forall a. Maybe a
Nothing
        Text
"tools/list" -> do
            if Bool -> Bool
not (ServerState -> Bool
serverInitialized ServerState
state)
                then
                    Handle
-> RequestId
-> JSONRPCErrorInfo
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall (m :: * -> *).
MonadIO m =>
Handle -> RequestId -> JSONRPCErrorInfo -> m ()
sendError (ServerConfig -> Handle
configOutput ServerConfig
config) RequestId
reqId (JSONRPCErrorInfo
 -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ())
-> JSONRPCErrorInfo
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall a b. (a -> b) -> a -> b
$
                        Int -> Text -> Maybe Value -> JSONRPCErrorInfo
JSONRPCErrorInfo (-Int
32002) Text
"Server not initialized" Maybe Value
forall a. Maybe a
Nothing
                else case Maybe Value
params of
                    Just Value
p -> case Value -> Result ListToolsParams
forall a. FromJSON a => Value -> Result a
fromJSON Value
p of
                        Aeson.Success ListToolsParams
listParams -> do
                            ListToolsResult
result <- ListToolsParams
-> ReaderT
     ServerConfig (StateT ServerState (ExceptT Text IO)) ListToolsResult
forall (m :: * -> *).
MCPServer m =>
ListToolsParams -> m ListToolsResult
handleListTools ListToolsParams
listParams
                            Handle
-> RequestId
-> ListToolsResult
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall (m :: * -> *) a.
(MonadIO m, ToJSON a) =>
Handle -> RequestId -> a -> m ()
sendResponse (ServerConfig -> Handle
configOutput ServerConfig
config) RequestId
reqId ListToolsResult
result
                        Aeson.Error String
e ->
                            Handle
-> RequestId
-> JSONRPCErrorInfo
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall (m :: * -> *).
MonadIO m =>
Handle -> RequestId -> JSONRPCErrorInfo -> m ()
sendError (ServerConfig -> Handle
configOutput ServerConfig
config) RequestId
reqId (JSONRPCErrorInfo
 -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ())
-> JSONRPCErrorInfo
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall a b. (a -> b) -> a -> b
$
                                Int -> Text -> Maybe Value -> JSONRPCErrorInfo
JSONRPCErrorInfo (-Int
32602) (Text
"Invalid params: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
e) Maybe Value
forall a. Maybe a
Nothing
                    Maybe Value
Nothing -> do
                        ListToolsResult
result <- ListToolsParams
-> ReaderT
     ServerConfig (StateT ServerState (ExceptT Text IO)) ListToolsResult
forall (m :: * -> *).
MCPServer m =>
ListToolsParams -> m ListToolsResult
handleListTools (Maybe Cursor -> ListToolsParams
ListToolsParams Maybe Cursor
forall a. Maybe a
Nothing)
                        Handle
-> RequestId
-> ListToolsResult
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall (m :: * -> *) a.
(MonadIO m, ToJSON a) =>
Handle -> RequestId -> a -> m ()
sendResponse (ServerConfig -> Handle
configOutput ServerConfig
config) RequestId
reqId ListToolsResult
result
        Text
"tools/call" -> do
            if Bool -> Bool
not (ServerState -> Bool
serverInitialized ServerState
state)
                then
                    Handle
-> RequestId
-> JSONRPCErrorInfo
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall (m :: * -> *).
MonadIO m =>
Handle -> RequestId -> JSONRPCErrorInfo -> m ()
sendError (ServerConfig -> Handle
configOutput ServerConfig
config) RequestId
reqId (JSONRPCErrorInfo
 -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ())
-> JSONRPCErrorInfo
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall a b. (a -> b) -> a -> b
$
                        Int -> Text -> Maybe Value -> JSONRPCErrorInfo
JSONRPCErrorInfo (-Int
32002) Text
"Server not initialized" Maybe Value
forall a. Maybe a
Nothing
                else case Maybe Value
params of
                    Just Value
p -> case Value -> Result CallToolParams
forall a. FromJSON a => Value -> Result a
fromJSON Value
p of
                        Aeson.Success CallToolParams
callParams -> do
                            CallToolResult
result <- CallToolParams
-> ReaderT
     ServerConfig (StateT ServerState (ExceptT Text IO)) CallToolResult
forall (m :: * -> *).
MCPServer m =>
CallToolParams -> m CallToolResult
handleCallTool CallToolParams
callParams
                            Handle
-> RequestId
-> CallToolResult
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall (m :: * -> *) a.
(MonadIO m, ToJSON a) =>
Handle -> RequestId -> a -> m ()
sendResponse (ServerConfig -> Handle
configOutput ServerConfig
config) RequestId
reqId CallToolResult
result
                        Aeson.Error String
e ->
                            Handle
-> RequestId
-> JSONRPCErrorInfo
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall (m :: * -> *).
MonadIO m =>
Handle -> RequestId -> JSONRPCErrorInfo -> m ()
sendError (ServerConfig -> Handle
configOutput ServerConfig
config) RequestId
reqId (JSONRPCErrorInfo
 -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ())
-> JSONRPCErrorInfo
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall a b. (a -> b) -> a -> b
$
                                Int -> Text -> Maybe Value -> JSONRPCErrorInfo
JSONRPCErrorInfo (-Int
32602) (Text
"Invalid params: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
e) Maybe Value
forall a. Maybe a
Nothing
                    Maybe Value
Nothing ->
                        Handle
-> RequestId
-> JSONRPCErrorInfo
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall (m :: * -> *).
MonadIO m =>
Handle -> RequestId -> JSONRPCErrorInfo -> m ()
sendError (ServerConfig -> Handle
configOutput ServerConfig
config) RequestId
reqId (JSONRPCErrorInfo
 -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ())
-> JSONRPCErrorInfo
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall a b. (a -> b) -> a -> b
$
                            Int -> Text -> Maybe Value -> JSONRPCErrorInfo
JSONRPCErrorInfo (-Int
32602) Text
"Missing params" Maybe Value
forall a. Maybe a
Nothing
        Text
"completion/complete" -> do
            if Bool -> Bool
not (ServerState -> Bool
serverInitialized ServerState
state)
                then
                    Handle
-> RequestId
-> JSONRPCErrorInfo
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall (m :: * -> *).
MonadIO m =>
Handle -> RequestId -> JSONRPCErrorInfo -> m ()
sendError (ServerConfig -> Handle
configOutput ServerConfig
config) RequestId
reqId (JSONRPCErrorInfo
 -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ())
-> JSONRPCErrorInfo
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall a b. (a -> b) -> a -> b
$
                        Int -> Text -> Maybe Value -> JSONRPCErrorInfo
JSONRPCErrorInfo (-Int
32002) Text
"Server not initialized" Maybe Value
forall a. Maybe a
Nothing
                else case Maybe Value
params of
                    Just Value
p -> case Value -> Result CompleteParams
forall a. FromJSON a => Value -> Result a
fromJSON Value
p of
                        Aeson.Success CompleteParams
completeParams -> do
                            CompleteResult
result <- CompleteParams
-> ReaderT
     ServerConfig (StateT ServerState (ExceptT Text IO)) CompleteResult
forall (m :: * -> *).
MCPServer m =>
CompleteParams -> m CompleteResult
handleComplete CompleteParams
completeParams
                            Handle
-> RequestId
-> CompleteResult
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall (m :: * -> *) a.
(MonadIO m, ToJSON a) =>
Handle -> RequestId -> a -> m ()
sendResponse (ServerConfig -> Handle
configOutput ServerConfig
config) RequestId
reqId CompleteResult
result
                        Aeson.Error String
e ->
                            Handle
-> RequestId
-> JSONRPCErrorInfo
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall (m :: * -> *).
MonadIO m =>
Handle -> RequestId -> JSONRPCErrorInfo -> m ()
sendError (ServerConfig -> Handle
configOutput ServerConfig
config) RequestId
reqId (JSONRPCErrorInfo
 -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ())
-> JSONRPCErrorInfo
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall a b. (a -> b) -> a -> b
$
                                Int -> Text -> Maybe Value -> JSONRPCErrorInfo
JSONRPCErrorInfo (-Int
32602) (Text
"Invalid params: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
e) Maybe Value
forall a. Maybe a
Nothing
                    Maybe Value
Nothing ->
                        Handle
-> RequestId
-> JSONRPCErrorInfo
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall (m :: * -> *).
MonadIO m =>
Handle -> RequestId -> JSONRPCErrorInfo -> m ()
sendError (ServerConfig -> Handle
configOutput ServerConfig
config) RequestId
reqId (JSONRPCErrorInfo
 -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ())
-> JSONRPCErrorInfo
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall a b. (a -> b) -> a -> b
$
                            Int -> Text -> Maybe Value -> JSONRPCErrorInfo
JSONRPCErrorInfo (-Int
32602) Text
"Missing params" Maybe Value
forall a. Maybe a
Nothing
        Text
"logging/setLevel" -> case Maybe Value
params of
            Just Value
p -> case Value -> Result SetLevelParams
forall a. FromJSON a => Value -> Result a
fromJSON Value
p of
                Aeson.Success SetLevelParams
setLevelParams -> do
                    ()
_ <- SetLevelParams
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall (m :: * -> *). MCPServer m => SetLevelParams -> m ()
handleSetLevel SetLevelParams
setLevelParams
                    -- SetLevel response is just an empty object
                    Handle
-> RequestId
-> Value
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall (m :: * -> *) a.
(MonadIO m, ToJSON a) =>
Handle -> RequestId -> a -> m ()
sendResponse (ServerConfig -> Handle
configOutput ServerConfig
config) RequestId
reqId ([Pair] -> Value
object [])
                Aeson.Error String
e ->
                    Handle
-> RequestId
-> JSONRPCErrorInfo
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall (m :: * -> *).
MonadIO m =>
Handle -> RequestId -> JSONRPCErrorInfo -> m ()
sendError (ServerConfig -> Handle
configOutput ServerConfig
config) RequestId
reqId (JSONRPCErrorInfo
 -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ())
-> JSONRPCErrorInfo
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall a b. (a -> b) -> a -> b
$
                        Int -> Text -> Maybe Value -> JSONRPCErrorInfo
JSONRPCErrorInfo (-Int
32602) (Text
"Invalid params: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
e) Maybe Value
forall a. Maybe a
Nothing
            Maybe Value
Nothing ->
                Handle
-> RequestId
-> JSONRPCErrorInfo
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall (m :: * -> *).
MonadIO m =>
Handle -> RequestId -> JSONRPCErrorInfo -> m ()
sendError (ServerConfig -> Handle
configOutput ServerConfig
config) RequestId
reqId (JSONRPCErrorInfo
 -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ())
-> JSONRPCErrorInfo
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall a b. (a -> b) -> a -> b
$
                    Int -> Text -> Maybe Value -> JSONRPCErrorInfo
JSONRPCErrorInfo (-Int
32602) Text
"Missing params" Maybe Value
forall a. Maybe a
Nothing
        Text
_ ->
            Handle
-> RequestId
-> JSONRPCErrorInfo
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall (m :: * -> *).
MonadIO m =>
Handle -> RequestId -> JSONRPCErrorInfo -> m ()
sendError (ServerConfig -> Handle
configOutput ServerConfig
config) RequestId
reqId (JSONRPCErrorInfo
 -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ())
-> JSONRPCErrorInfo
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall a b. (a -> b) -> a -> b
$
                Int -> Text -> Maybe Value -> JSONRPCErrorInfo
JSONRPCErrorInfo (-Int
32601) Text
"Method not found" Maybe Value
forall a. Maybe a
Nothing

handleInitialize :: RequestId -> InitializeParams -> MCPServerM ()
handleInitialize :: RequestId
-> InitializeParams
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
handleInitialize RequestId
reqId InitializeParams
params = do
    ServerConfig
config <- ReaderT
  ServerConfig (StateT ServerState (ExceptT Text IO)) ServerConfig
forall r (m :: * -> *). MonadReader r m => m r
ask
    ServerState
state <- ReaderT
  ServerConfig (StateT ServerState (ExceptT Text IO)) ServerState
forall s (m :: * -> *). MonadState s m => m s
get

    let InitializeParams{$sel:capabilities:InitializeParams :: InitializeParams -> ClientCapabilities
capabilities = ClientCapabilities
clientCaps} = InitializeParams
params

    ServerState
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put
        ServerState
state
            { serverInitialized = True
            , clientCapabilities = Just clientCaps
            , serverInfo = Just (configServerInfo config)
            }

    let result :: InitializeResult
result =
            InitializeResult
                { $sel:protocolVersion:InitializeResult :: Text
protocolVersion = Text
mcpProtocolVersion
                , $sel:capabilities:InitializeResult :: ServerCapabilities
capabilities = ServerState -> ServerCapabilities
serverCapabilities ServerState
state
                , $sel:serverInfo:InitializeResult :: Implementation
serverInfo = ServerConfig -> Implementation
configServerInfo ServerConfig
config
                , $sel:instructions:InitializeResult :: Maybe Text
instructions = Maybe Text
forall a. Maybe a
Nothing
                , $sel:_meta:InitializeResult :: Maybe Metadata
_meta = Maybe Metadata
forall a. Maybe a
Nothing
                }

    Handle
-> RequestId
-> InitializeResult
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall (m :: * -> *) a.
(MonadIO m, ToJSON a) =>
Handle -> RequestId -> a -> m ()
sendResponse (ServerConfig -> Handle
configOutput ServerConfig
config) RequestId
reqId InitializeResult
result

handlePing :: RequestId -> MCPServerM ()
handlePing :: RequestId
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
handlePing RequestId
reqId = do
    ServerConfig
config <- ReaderT
  ServerConfig (StateT ServerState (ExceptT Text IO)) ServerConfig
forall r (m :: * -> *). MonadReader r m => m r
ask
    -- Ping response is just an empty object in MCP
    Handle
-> RequestId
-> Value
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall (m :: * -> *) a.
(MonadIO m, ToJSON a) =>
Handle -> RequestId -> a -> m ()
sendResponse (ServerConfig -> Handle
configOutput ServerConfig
config) RequestId
reqId ([Pair] -> Value
object [])

-- | Handle a JSON-RPC notification
handleNotification :: JSONRPCNotification -> MCPServerM ()
handleNotification :: JSONRPCNotification
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
handleNotification JSONRPCNotification
_ = do
    ()
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall a.
a -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Run the MCP server with the given configuration
runServer :: (MCPServer MCPServerM) => ServerConfig -> IO ()
runServer :: MCPServer
  (ReaderT ServerConfig (StateT ServerState (ExceptT Text IO))) =>
ServerConfig -> IO ()
runServer ServerConfig
config = do
    let initialState :: ServerState
initialState = ServerCapabilities -> ServerState
initialServerState (ServerConfig -> ServerCapabilities
configCapabilities ServerConfig
config)

    let loop :: ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
loop = do
            Either () ByteString
eofOrLine <-
                IO (Either () ByteString)
-> ReaderT
     ServerConfig
     (StateT ServerState (ExceptT Text IO))
     (Either () ByteString)
forall a.
IO a
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either () ByteString)
 -> ReaderT
      ServerConfig
      (StateT ServerState (ExceptT Text IO))
      (Either () ByteString))
-> IO (Either () ByteString)
-> ReaderT
     ServerConfig
     (StateT ServerState (ExceptT Text IO))
     (Either () ByteString)
forall a b. (a -> b) -> a -> b
$
                    IO (Either () ByteString)
-> (IOError -> IO (Either () ByteString))
-> IO (Either () ByteString)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch
                        (ByteString -> Either () ByteString
forall a b. b -> Either a b
Right (ByteString -> Either () ByteString)
-> IO ByteString -> IO (Either () ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO ByteString
BSC.hGetLine (ServerConfig -> Handle
configInput ServerConfig
config))
                        (\IOError
e -> if IOError -> Bool
isEOFError IOError
e then Either () ByteString -> IO (Either () ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> Either () ByteString
forall a b. a -> Either a b
Left ()) else IOError -> IO (Either () ByteString)
forall e a. Exception e => e -> IO a
throwIO IOError
e)
            case Either () ByteString
eofOrLine of
                Left () -> ()
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall a.
a -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) a
forall (m :: * -> *) a. Monad m => a -> m a
return () -- EOF reached, exit gracefully
                Right ByteString
line -> do
                    Maybe ()
result <- ByteString -> MCPServerM (Maybe ())
MCPServer
  (ReaderT ServerConfig (StateT ServerState (ExceptT Text IO))) =>
ByteString -> MCPServerM (Maybe ())
handleMessage ByteString
line
                    case Maybe ()
result of
                        Just () -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
loop
                        Maybe ()
Nothing -> ()
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
forall a.
a -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    Either Text ((), ServerState)
result <- ServerConfig
-> ServerState
-> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
-> IO (Either Text ((), ServerState))
forall a.
ServerConfig
-> ServerState -> MCPServerM a -> IO (Either Text (a, ServerState))
runMCPServer ServerConfig
config ServerState
initialState ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) ()
loop
    case Either Text ((), ServerState)
result of
        Left Text
err -> String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Server error: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
err
        Right ((), ServerState)
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return () -- Don't print "Server terminated" for clean EOF