{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
module MCP.Server.HTTP (
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
data HTTPServerConfig = HTTPServerConfig
{ HTTPServerConfig -> Port
httpPort :: Port
, HTTPServerConfig -> Implementation
httpServerInfo :: Implementation
, HTTPServerConfig -> ServerCapabilities
httpCapabilities :: ServerCapabilities
, HTTPServerConfig -> Bool
httpEnableLogging :: Bool
}
deriving (Port -> HTTPServerConfig -> ShowS
[HTTPServerConfig] -> ShowS
HTTPServerConfig -> String
(Port -> HTTPServerConfig -> ShowS)
-> (HTTPServerConfig -> String)
-> ([HTTPServerConfig] -> ShowS)
-> Show HTTPServerConfig
forall a.
(Port -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Port -> HTTPServerConfig -> ShowS
showsPrec :: Port -> HTTPServerConfig -> ShowS
$cshow :: HTTPServerConfig -> String
show :: HTTPServerConfig -> String
$cshowList :: [HTTPServerConfig] -> ShowS
showList :: [HTTPServerConfig] -> ShowS
Show)
type MCPAPI = "mcp" :> ReqBody '[JSON] Aeson.Value :> Post '[JSON] Aeson.Value
mcpApp :: (MCPServer MCPServerM) => HTTPServerConfig -> TVar ServerState -> Application
mcpApp :: MCPServer
(ReaderT ServerConfig (StateT ServerState (ExceptT Text IO))) =>
HTTPServerConfig -> TVar ServerState -> Application
mcpApp HTTPServerConfig
config TVar ServerState
stateVar =
let baseApp :: Application
baseApp = Proxy MCPAPI -> Server MCPAPI -> Application
forall {k} (api :: k).
HasServer api '[] =>
Proxy api -> Server api -> Application
serve (Proxy MCPAPI
forall {k} (t :: k). Proxy t
Proxy :: Proxy MCPAPI) (HTTPServerConfig -> TVar ServerState -> Server MCPAPI
mcpServer HTTPServerConfig
config TVar ServerState
stateVar)
in if HTTPServerConfig -> Bool
httpEnableLogging HTTPServerConfig
config
then Middleware
logStdoutDev Application
baseApp
else Application
baseApp
where
mcpServer :: HTTPServerConfig -> TVar ServerState -> Server MCPAPI
mcpServer :: HTTPServerConfig -> TVar ServerState -> Server MCPAPI
mcpServer HTTPServerConfig
httpConfig TVar ServerState
stateTVar = MCPServer
(ReaderT ServerConfig (StateT ServerState (ExceptT Text IO))) =>
HTTPServerConfig -> TVar ServerState -> Value -> Handler Value
HTTPServerConfig -> TVar ServerState -> Value -> Handler Value
handleHTTPRequest HTTPServerConfig
httpConfig TVar ServerState
stateTVar
handleHTTPRequest :: (MCPServer MCPServerM) => HTTPServerConfig -> TVar ServerState -> Aeson.Value -> Handler Aeson.Value
handleHTTPRequest :: MCPServer
(ReaderT ServerConfig (StateT ServerState (ExceptT Text IO))) =>
HTTPServerConfig -> TVar ServerState -> Value -> Handler Value
handleHTTPRequest HTTPServerConfig
httpConfig TVar ServerState
stateVar Value
requestValue = do
case Value -> Result JSONRPCMessage
forall a. FromJSON a => Value -> Result a
fromJSON Value
requestValue of
Aeson.Success (JSONRPCMessage
msg :: JSONRPCMessage) -> do
case JSONRPCMessage
msg of
RequestMessage JSONRPCRequest
req -> do
Either Text Value
result <- IO (Either Text Value) -> Handler (Either Text Value)
forall a. IO a -> Handler a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either Text Value) -> Handler (Either Text Value))
-> IO (Either Text Value) -> Handler (Either Text Value)
forall a b. (a -> b) -> a -> b
$ MCPServer
(ReaderT ServerConfig (StateT ServerState (ExceptT Text IO))) =>
HTTPServerConfig
-> TVar ServerState -> JSONRPCRequest -> IO (Either Text Value)
HTTPServerConfig
-> TVar ServerState -> JSONRPCRequest -> IO (Either Text Value)
processHTTPRequest HTTPServerConfig
httpConfig TVar ServerState
stateVar JSONRPCRequest
req
case Either Text Value
result of
Left Text
err -> ServerError -> Handler Value
forall a. ServerError -> Handler a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ServerError
err500 { errBody = encode $ object ["error" .= T.unpack err] }
Right Value
response -> Value -> Handler Value
forall a. a -> Handler a
forall (m :: * -> *) a. Monad m => a -> m a
return Value
response
NotificationMessage JSONRPCNotification
notif -> do
()
_ <- IO () -> Handler ()
forall a. IO a -> Handler a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Handler ()) -> IO () -> Handler ()
forall a b. (a -> b) -> a -> b
$ MCPServer
(ReaderT ServerConfig (StateT ServerState (ExceptT Text IO))) =>
HTTPServerConfig
-> TVar ServerState -> JSONRPCNotification -> IO ()
HTTPServerConfig
-> TVar ServerState -> JSONRPCNotification -> IO ()
processHTTPNotification HTTPServerConfig
httpConfig TVar ServerState
stateVar JSONRPCNotification
notif
Value -> Handler Value
forall a. a -> Handler a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> Handler Value) -> Value -> Handler Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object []
JSONRPCMessage
_ -> ServerError -> Handler Value
forall a. ServerError -> Handler a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ServerError
err400 { errBody = "Invalid JSON-RPC message type" }
Aeson.Error String
e -> ServerError -> Handler Value
forall a. ServerError -> Handler a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ServerError
err400 { errBody = LBSC.pack $ "Invalid JSON-RPC message: " ++ e }
processHTTPNotification :: (MCPServer MCPServerM) => HTTPServerConfig -> TVar ServerState -> JSONRPCNotification -> IO ()
processHTTPNotification :: MCPServer
(ReaderT ServerConfig (StateT ServerState (ExceptT Text IO))) =>
HTTPServerConfig
-> TVar ServerState -> JSONRPCNotification -> IO ()
processHTTPNotification HTTPServerConfig
_ TVar ServerState
_ JSONRPCNotification
_ = do
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
processHTTPRequest :: (MCPServer MCPServerM) => HTTPServerConfig -> TVar ServerState -> JSONRPCRequest -> IO (Either Text Aeson.Value)
processHTTPRequest :: MCPServer
(ReaderT ServerConfig (StateT ServerState (ExceptT Text IO))) =>
HTTPServerConfig
-> TVar ServerState -> JSONRPCRequest -> IO (Either Text Value)
processHTTPRequest HTTPServerConfig
httpConfig TVar ServerState
stateVar JSONRPCRequest
req = do
ServerState
currentState <- STM ServerState -> IO ServerState
forall a. STM a -> IO a
atomically (STM ServerState -> IO ServerState)
-> STM ServerState -> IO ServerState
forall a b. (a -> b) -> a -> b
$ TVar ServerState -> STM ServerState
forall a. TVar a -> STM a
readTVar TVar ServerState
stateVar
let dummyConfig :: ServerConfig
dummyConfig = ServerConfig
{ $sel:configInput:ServerConfig :: Handle
configInput = Handle
forall a. HasCallStack => a
undefined
, $sel:configOutput:ServerConfig :: Handle
configOutput = Handle
forall a. HasCallStack => a
undefined
, $sel:configServerInfo:ServerConfig :: Implementation
configServerInfo = HTTPServerConfig -> Implementation
httpServerInfo HTTPServerConfig
httpConfig
, $sel:configCapabilities:ServerConfig :: ServerCapabilities
configCapabilities = HTTPServerConfig -> ServerCapabilities
httpCapabilities HTTPServerConfig
httpConfig
}
Either Text (Value, ServerState)
result <- ServerConfig
-> ServerState
-> MCPServerM Value
-> IO (Either Text (Value, ServerState))
forall a.
ServerConfig
-> ServerState -> MCPServerM a -> IO (Either Text (a, ServerState))
runMCPServer ServerConfig
dummyConfig ServerState
currentState (JSONRPCRequest -> MCPServerM Value
MCPServer
(ReaderT ServerConfig (StateT ServerState (ExceptT Text IO))) =>
JSONRPCRequest -> MCPServerM Value
handleHTTPRequestInner JSONRPCRequest
req)
case Either Text (Value, ServerState)
result of
Left Text
err -> Either Text Value -> IO (Either Text Value)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Value -> IO (Either Text Value))
-> Either Text Value -> IO (Either Text Value)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Value
forall a b. a -> Either a b
Left Text
err
Right (Value
response, ServerState
newState) -> do
STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar ServerState -> ServerState -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar ServerState
stateVar ServerState
newState
Either Text Value -> IO (Either Text Value)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Value -> IO (Either Text Value))
-> Either Text Value -> IO (Either Text Value)
forall a b. (a -> b) -> a -> b
$ Value -> Either Text Value
forall a b. b -> Either a b
Right Value
response
handleHTTPRequestInner :: (MCPServer MCPServerM) => JSONRPCRequest -> MCPServerM Aeson.Value
handleHTTPRequestInner :: MCPServer
(ReaderT ServerConfig (StateT ServerState (ExceptT Text IO))) =>
JSONRPCRequest -> MCPServerM Value
handleHTTPRequestInner (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 -> do
RequestId -> InitializeParams -> MCPServerM ()
handleInitializeHTTP RequestId
reqId InitializeParams
initParams
let result :: InitializeResult
result = InitializeResult
{ $sel:protocolVersion:InitializeResult :: Text
protocolVersion = Text
"2024-11-05"
, $sel:capabilities:InitializeResult :: ServerCapabilities
capabilities = ServerConfig -> ServerCapabilities
configCapabilities ServerConfig
config
, $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
}
Value -> MCPServerM Value
forall a.
a -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> MCPServerM Value) -> Value -> MCPServerM Value
forall a b. (a -> b) -> a -> b
$ JSONRPCResponse -> Value
forall a. ToJSON a => a -> Value
toJSON (JSONRPCResponse -> Value) -> JSONRPCResponse -> Value
forall a b. (a -> b) -> a -> b
$ Text -> RequestId -> Value -> JSONRPCResponse
JSONRPCResponse Text
"2.0" RequestId
reqId (InitializeResult -> Value
forall a. ToJSON a => a -> Value
toJSON InitializeResult
result)
Aeson.Error String
e -> Value -> MCPServerM Value
forall a.
a -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> MCPServerM Value) -> Value -> MCPServerM Value
forall a b. (a -> b) -> a -> b
$ JSONRPCError -> Value
forall a. ToJSON a => a -> Value
toJSON (JSONRPCError -> Value) -> JSONRPCError -> Value
forall a b. (a -> b) -> a -> b
$ Text -> RequestId -> JSONRPCErrorInfo -> JSONRPCError
JSONRPCError Text
"2.0" RequestId
reqId (JSONRPCErrorInfo -> JSONRPCError)
-> JSONRPCErrorInfo -> JSONRPCError
forall a b. (a -> b) -> a -> b
$
Port -> Text -> Maybe Value -> JSONRPCErrorInfo
JSONRPCErrorInfo (-Port
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 -> Value -> MCPServerM Value
forall a.
a -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> MCPServerM Value) -> Value -> MCPServerM Value
forall a b. (a -> b) -> a -> b
$ JSONRPCError -> Value
forall a. ToJSON a => a -> Value
toJSON (JSONRPCError -> Value) -> JSONRPCError -> Value
forall a b. (a -> b) -> a -> b
$ Text -> RequestId -> JSONRPCErrorInfo -> JSONRPCError
JSONRPCError Text
"2.0" RequestId
reqId (JSONRPCErrorInfo -> JSONRPCError)
-> JSONRPCErrorInfo -> JSONRPCError
forall a b. (a -> b) -> a -> b
$
Port -> Text -> Maybe Value -> JSONRPCErrorInfo
JSONRPCErrorInfo (-Port
32602) Text
"Missing params" Maybe Value
forall a. Maybe a
Nothing
Text
"ping" -> Value -> MCPServerM Value
forall a.
a -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> MCPServerM Value) -> Value -> MCPServerM Value
forall a b. (a -> b) -> a -> b
$ JSONRPCResponse -> Value
forall a. ToJSON a => a -> Value
toJSON (JSONRPCResponse -> Value) -> JSONRPCResponse -> Value
forall a b. (a -> b) -> a -> b
$ Text -> RequestId -> Value -> JSONRPCResponse
JSONRPCResponse Text
"2.0" RequestId
reqId ([Pair] -> Value
object [])
Text
"resources/list" -> do
if Bool -> Bool
not (ServerState -> Bool
serverInitialized ServerState
state)
then Value -> MCPServerM Value
forall a.
a -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> MCPServerM Value) -> Value -> MCPServerM Value
forall a b. (a -> b) -> a -> b
$ JSONRPCError -> Value
forall a. ToJSON a => a -> Value
toJSON (JSONRPCError -> Value) -> JSONRPCError -> Value
forall a b. (a -> b) -> a -> b
$ Text -> RequestId -> JSONRPCErrorInfo -> JSONRPCError
JSONRPCError Text
"2.0" RequestId
reqId (JSONRPCErrorInfo -> JSONRPCError)
-> JSONRPCErrorInfo -> JSONRPCError
forall a b. (a -> b) -> a -> b
$
Port -> Text -> Maybe Value -> JSONRPCErrorInfo
JSONRPCErrorInfo (-Port
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
Value -> MCPServerM Value
forall a.
a -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> MCPServerM Value) -> Value -> MCPServerM Value
forall a b. (a -> b) -> a -> b
$ JSONRPCResponse -> Value
forall a. ToJSON a => a -> Value
toJSON (JSONRPCResponse -> Value) -> JSONRPCResponse -> Value
forall a b. (a -> b) -> a -> b
$ Text -> RequestId -> Value -> JSONRPCResponse
JSONRPCResponse Text
"2.0" RequestId
reqId (ListResourcesResult -> Value
forall a. ToJSON a => a -> Value
toJSON ListResourcesResult
result)
Aeson.Error String
e -> Value -> MCPServerM Value
forall a.
a -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> MCPServerM Value) -> Value -> MCPServerM Value
forall a b. (a -> b) -> a -> b
$ JSONRPCError -> Value
forall a. ToJSON a => a -> Value
toJSON (JSONRPCError -> Value) -> JSONRPCError -> Value
forall a b. (a -> b) -> a -> b
$ Text -> RequestId -> JSONRPCErrorInfo -> JSONRPCError
JSONRPCError Text
"2.0" RequestId
reqId (JSONRPCErrorInfo -> JSONRPCError)
-> JSONRPCErrorInfo -> JSONRPCError
forall a b. (a -> b) -> a -> b
$
Port -> Text -> Maybe Value -> JSONRPCErrorInfo
JSONRPCErrorInfo (-Port
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)
Value -> MCPServerM Value
forall a.
a -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> MCPServerM Value) -> Value -> MCPServerM Value
forall a b. (a -> b) -> a -> b
$ JSONRPCResponse -> Value
forall a. ToJSON a => a -> Value
toJSON (JSONRPCResponse -> Value) -> JSONRPCResponse -> Value
forall a b. (a -> b) -> a -> b
$ Text -> RequestId -> Value -> JSONRPCResponse
JSONRPCResponse Text
"2.0" RequestId
reqId (ListResourcesResult -> Value
forall a. ToJSON a => a -> Value
toJSON ListResourcesResult
result)
Text
"resources/read" -> do
if Bool -> Bool
not (ServerState -> Bool
serverInitialized ServerState
state)
then Value -> MCPServerM Value
forall a.
a -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> MCPServerM Value) -> Value -> MCPServerM Value
forall a b. (a -> b) -> a -> b
$ JSONRPCError -> Value
forall a. ToJSON a => a -> Value
toJSON (JSONRPCError -> Value) -> JSONRPCError -> Value
forall a b. (a -> b) -> a -> b
$ Text -> RequestId -> JSONRPCErrorInfo -> JSONRPCError
JSONRPCError Text
"2.0" RequestId
reqId (JSONRPCErrorInfo -> JSONRPCError)
-> JSONRPCErrorInfo -> JSONRPCError
forall a b. (a -> b) -> a -> b
$
Port -> Text -> Maybe Value -> JSONRPCErrorInfo
JSONRPCErrorInfo (-Port
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
Value -> MCPServerM Value
forall a.
a -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> MCPServerM Value) -> Value -> MCPServerM Value
forall a b. (a -> b) -> a -> b
$ JSONRPCResponse -> Value
forall a. ToJSON a => a -> Value
toJSON (JSONRPCResponse -> Value) -> JSONRPCResponse -> Value
forall a b. (a -> b) -> a -> b
$ Text -> RequestId -> Value -> JSONRPCResponse
JSONRPCResponse Text
"2.0" RequestId
reqId (ReadResourceResult -> Value
forall a. ToJSON a => a -> Value
toJSON ReadResourceResult
result)
Aeson.Error String
e -> Value -> MCPServerM Value
forall a.
a -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> MCPServerM Value) -> Value -> MCPServerM Value
forall a b. (a -> b) -> a -> b
$ JSONRPCError -> Value
forall a. ToJSON a => a -> Value
toJSON (JSONRPCError -> Value) -> JSONRPCError -> Value
forall a b. (a -> b) -> a -> b
$ Text -> RequestId -> JSONRPCErrorInfo -> JSONRPCError
JSONRPCError Text
"2.0" RequestId
reqId (JSONRPCErrorInfo -> JSONRPCError)
-> JSONRPCErrorInfo -> JSONRPCError
forall a b. (a -> b) -> a -> b
$
Port -> Text -> Maybe Value -> JSONRPCErrorInfo
JSONRPCErrorInfo (-Port
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 -> Value -> MCPServerM Value
forall a.
a -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> MCPServerM Value) -> Value -> MCPServerM Value
forall a b. (a -> b) -> a -> b
$ JSONRPCError -> Value
forall a. ToJSON a => a -> Value
toJSON (JSONRPCError -> Value) -> JSONRPCError -> Value
forall a b. (a -> b) -> a -> b
$ Text -> RequestId -> JSONRPCErrorInfo -> JSONRPCError
JSONRPCError Text
"2.0" RequestId
reqId (JSONRPCErrorInfo -> JSONRPCError)
-> JSONRPCErrorInfo -> JSONRPCError
forall a b. (a -> b) -> a -> b
$
Port -> Text -> Maybe Value -> JSONRPCErrorInfo
JSONRPCErrorInfo (-Port
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 Value -> MCPServerM Value
forall a.
a -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> MCPServerM Value) -> Value -> MCPServerM Value
forall a b. (a -> b) -> a -> b
$ JSONRPCError -> Value
forall a. ToJSON a => a -> Value
toJSON (JSONRPCError -> Value) -> JSONRPCError -> Value
forall a b. (a -> b) -> a -> b
$ Text -> RequestId -> JSONRPCErrorInfo -> JSONRPCError
JSONRPCError Text
"2.0" RequestId
reqId (JSONRPCErrorInfo -> JSONRPCError)
-> JSONRPCErrorInfo -> JSONRPCError
forall a b. (a -> b) -> a -> b
$
Port -> Text -> Maybe Value -> JSONRPCErrorInfo
JSONRPCErrorInfo (-Port
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
Value -> MCPServerM Value
forall a.
a -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> MCPServerM Value) -> Value -> MCPServerM Value
forall a b. (a -> b) -> a -> b
$ JSONRPCResponse -> Value
forall a. ToJSON a => a -> Value
toJSON (JSONRPCResponse -> Value) -> JSONRPCResponse -> Value
forall a b. (a -> b) -> a -> b
$ Text -> RequestId -> Value -> JSONRPCResponse
JSONRPCResponse Text
"2.0" RequestId
reqId (ListToolsResult -> Value
forall a. ToJSON a => a -> Value
toJSON ListToolsResult
result)
Aeson.Error String
e -> Value -> MCPServerM Value
forall a.
a -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> MCPServerM Value) -> Value -> MCPServerM Value
forall a b. (a -> b) -> a -> b
$ JSONRPCError -> Value
forall a. ToJSON a => a -> Value
toJSON (JSONRPCError -> Value) -> JSONRPCError -> Value
forall a b. (a -> b) -> a -> b
$ Text -> RequestId -> JSONRPCErrorInfo -> JSONRPCError
JSONRPCError Text
"2.0" RequestId
reqId (JSONRPCErrorInfo -> JSONRPCError)
-> JSONRPCErrorInfo -> JSONRPCError
forall a b. (a -> b) -> a -> b
$
Port -> Text -> Maybe Value -> JSONRPCErrorInfo
JSONRPCErrorInfo (-Port
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)
Value -> MCPServerM Value
forall a.
a -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> MCPServerM Value) -> Value -> MCPServerM Value
forall a b. (a -> b) -> a -> b
$ JSONRPCResponse -> Value
forall a. ToJSON a => a -> Value
toJSON (JSONRPCResponse -> Value) -> JSONRPCResponse -> Value
forall a b. (a -> b) -> a -> b
$ Text -> RequestId -> Value -> JSONRPCResponse
JSONRPCResponse Text
"2.0" RequestId
reqId (ListToolsResult -> Value
forall a. ToJSON a => a -> Value
toJSON ListToolsResult
result)
Text
"tools/call" -> do
if Bool -> Bool
not (ServerState -> Bool
serverInitialized ServerState
state)
then Value -> MCPServerM Value
forall a.
a -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> MCPServerM Value) -> Value -> MCPServerM Value
forall a b. (a -> b) -> a -> b
$ JSONRPCError -> Value
forall a. ToJSON a => a -> Value
toJSON (JSONRPCError -> Value) -> JSONRPCError -> Value
forall a b. (a -> b) -> a -> b
$ Text -> RequestId -> JSONRPCErrorInfo -> JSONRPCError
JSONRPCError Text
"2.0" RequestId
reqId (JSONRPCErrorInfo -> JSONRPCError)
-> JSONRPCErrorInfo -> JSONRPCError
forall a b. (a -> b) -> a -> b
$
Port -> Text -> Maybe Value -> JSONRPCErrorInfo
JSONRPCErrorInfo (-Port
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
Value -> MCPServerM Value
forall a.
a -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> MCPServerM Value) -> Value -> MCPServerM Value
forall a b. (a -> b) -> a -> b
$ JSONRPCResponse -> Value
forall a. ToJSON a => a -> Value
toJSON (JSONRPCResponse -> Value) -> JSONRPCResponse -> Value
forall a b. (a -> b) -> a -> b
$ Text -> RequestId -> Value -> JSONRPCResponse
JSONRPCResponse Text
"2.0" RequestId
reqId (CallToolResult -> Value
forall a. ToJSON a => a -> Value
toJSON CallToolResult
result)
Aeson.Error String
e -> Value -> MCPServerM Value
forall a.
a -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> MCPServerM Value) -> Value -> MCPServerM Value
forall a b. (a -> b) -> a -> b
$ JSONRPCError -> Value
forall a. ToJSON a => a -> Value
toJSON (JSONRPCError -> Value) -> JSONRPCError -> Value
forall a b. (a -> b) -> a -> b
$ Text -> RequestId -> JSONRPCErrorInfo -> JSONRPCError
JSONRPCError Text
"2.0" RequestId
reqId (JSONRPCErrorInfo -> JSONRPCError)
-> JSONRPCErrorInfo -> JSONRPCError
forall a b. (a -> b) -> a -> b
$
Port -> Text -> Maybe Value -> JSONRPCErrorInfo
JSONRPCErrorInfo (-Port
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 -> Value -> MCPServerM Value
forall a.
a -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> MCPServerM Value) -> Value -> MCPServerM Value
forall a b. (a -> b) -> a -> b
$ JSONRPCError -> Value
forall a. ToJSON a => a -> Value
toJSON (JSONRPCError -> Value) -> JSONRPCError -> Value
forall a b. (a -> b) -> a -> b
$ Text -> RequestId -> JSONRPCErrorInfo -> JSONRPCError
JSONRPCError Text
"2.0" RequestId
reqId (JSONRPCErrorInfo -> JSONRPCError)
-> JSONRPCErrorInfo -> JSONRPCError
forall a b. (a -> b) -> a -> b
$
Port -> Text -> Maybe Value -> JSONRPCErrorInfo
JSONRPCErrorInfo (-Port
32602) Text
"Missing params" Maybe Value
forall a. Maybe a
Nothing
Text
"prompts/list" -> do
if Bool -> Bool
not (ServerState -> Bool
serverInitialized ServerState
state)
then Value -> MCPServerM Value
forall a.
a -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> MCPServerM Value) -> Value -> MCPServerM Value
forall a b. (a -> b) -> a -> b
$ JSONRPCError -> Value
forall a. ToJSON a => a -> Value
toJSON (JSONRPCError -> Value) -> JSONRPCError -> Value
forall a b. (a -> b) -> a -> b
$ Text -> RequestId -> JSONRPCErrorInfo -> JSONRPCError
JSONRPCError Text
"2.0" RequestId
reqId (JSONRPCErrorInfo -> JSONRPCError)
-> JSONRPCErrorInfo -> JSONRPCError
forall a b. (a -> b) -> a -> b
$
Port -> Text -> Maybe Value -> JSONRPCErrorInfo
JSONRPCErrorInfo (-Port
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
Value -> MCPServerM Value
forall a.
a -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> MCPServerM Value) -> Value -> MCPServerM Value
forall a b. (a -> b) -> a -> b
$ JSONRPCResponse -> Value
forall a. ToJSON a => a -> Value
toJSON (JSONRPCResponse -> Value) -> JSONRPCResponse -> Value
forall a b. (a -> b) -> a -> b
$ Text -> RequestId -> Value -> JSONRPCResponse
JSONRPCResponse Text
"2.0" RequestId
reqId (ListPromptsResult -> Value
forall a. ToJSON a => a -> Value
toJSON ListPromptsResult
result)
Aeson.Error String
e -> Value -> MCPServerM Value
forall a.
a -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> MCPServerM Value) -> Value -> MCPServerM Value
forall a b. (a -> b) -> a -> b
$ JSONRPCError -> Value
forall a. ToJSON a => a -> Value
toJSON (JSONRPCError -> Value) -> JSONRPCError -> Value
forall a b. (a -> b) -> a -> b
$ Text -> RequestId -> JSONRPCErrorInfo -> JSONRPCError
JSONRPCError Text
"2.0" RequestId
reqId (JSONRPCErrorInfo -> JSONRPCError)
-> JSONRPCErrorInfo -> JSONRPCError
forall a b. (a -> b) -> a -> b
$
Port -> Text -> Maybe Value -> JSONRPCErrorInfo
JSONRPCErrorInfo (-Port
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)
Value -> MCPServerM Value
forall a.
a -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> MCPServerM Value) -> Value -> MCPServerM Value
forall a b. (a -> b) -> a -> b
$ JSONRPCResponse -> Value
forall a. ToJSON a => a -> Value
toJSON (JSONRPCResponse -> Value) -> JSONRPCResponse -> Value
forall a b. (a -> b) -> a -> b
$ Text -> RequestId -> Value -> JSONRPCResponse
JSONRPCResponse Text
"2.0" RequestId
reqId (ListPromptsResult -> Value
forall a. ToJSON a => a -> Value
toJSON ListPromptsResult
result)
Text
"prompts/get" -> do
if Bool -> Bool
not (ServerState -> Bool
serverInitialized ServerState
state)
then Value -> MCPServerM Value
forall a.
a -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> MCPServerM Value) -> Value -> MCPServerM Value
forall a b. (a -> b) -> a -> b
$ JSONRPCError -> Value
forall a. ToJSON a => a -> Value
toJSON (JSONRPCError -> Value) -> JSONRPCError -> Value
forall a b. (a -> b) -> a -> b
$ Text -> RequestId -> JSONRPCErrorInfo -> JSONRPCError
JSONRPCError Text
"2.0" RequestId
reqId (JSONRPCErrorInfo -> JSONRPCError)
-> JSONRPCErrorInfo -> JSONRPCError
forall a b. (a -> b) -> a -> b
$
Port -> Text -> Maybe Value -> JSONRPCErrorInfo
JSONRPCErrorInfo (-Port
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
Value -> MCPServerM Value
forall a.
a -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> MCPServerM Value) -> Value -> MCPServerM Value
forall a b. (a -> b) -> a -> b
$ JSONRPCResponse -> Value
forall a. ToJSON a => a -> Value
toJSON (JSONRPCResponse -> Value) -> JSONRPCResponse -> Value
forall a b. (a -> b) -> a -> b
$ Text -> RequestId -> Value -> JSONRPCResponse
JSONRPCResponse Text
"2.0" RequestId
reqId (GetPromptResult -> Value
forall a. ToJSON a => a -> Value
toJSON GetPromptResult
result)
Aeson.Error String
e -> Value -> MCPServerM Value
forall a.
a -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> MCPServerM Value) -> Value -> MCPServerM Value
forall a b. (a -> b) -> a -> b
$ JSONRPCError -> Value
forall a. ToJSON a => a -> Value
toJSON (JSONRPCError -> Value) -> JSONRPCError -> Value
forall a b. (a -> b) -> a -> b
$ Text -> RequestId -> JSONRPCErrorInfo -> JSONRPCError
JSONRPCError Text
"2.0" RequestId
reqId (JSONRPCErrorInfo -> JSONRPCError)
-> JSONRPCErrorInfo -> JSONRPCError
forall a b. (a -> b) -> a -> b
$
Port -> Text -> Maybe Value -> JSONRPCErrorInfo
JSONRPCErrorInfo (-Port
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 -> Value -> MCPServerM Value
forall a.
a -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> MCPServerM Value) -> Value -> MCPServerM Value
forall a b. (a -> b) -> a -> b
$ JSONRPCError -> Value
forall a. ToJSON a => a -> Value
toJSON (JSONRPCError -> Value) -> JSONRPCError -> Value
forall a b. (a -> b) -> a -> b
$ Text -> RequestId -> JSONRPCErrorInfo -> JSONRPCError
JSONRPCError Text
"2.0" RequestId
reqId (JSONRPCErrorInfo -> JSONRPCError)
-> JSONRPCErrorInfo -> JSONRPCError
forall a b. (a -> b) -> a -> b
$
Port -> Text -> Maybe Value -> JSONRPCErrorInfo
JSONRPCErrorInfo (-Port
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 Value -> MCPServerM Value
forall a.
a -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> MCPServerM Value) -> Value -> MCPServerM Value
forall a b. (a -> b) -> a -> b
$ JSONRPCError -> Value
forall a. ToJSON a => a -> Value
toJSON (JSONRPCError -> Value) -> JSONRPCError -> Value
forall a b. (a -> b) -> a -> b
$ Text -> RequestId -> JSONRPCErrorInfo -> JSONRPCError
JSONRPCError Text
"2.0" RequestId
reqId (JSONRPCErrorInfo -> JSONRPCError)
-> JSONRPCErrorInfo -> JSONRPCError
forall a b. (a -> b) -> a -> b
$
Port -> Text -> Maybe Value -> JSONRPCErrorInfo
JSONRPCErrorInfo (-Port
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
Value -> MCPServerM Value
forall a.
a -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> MCPServerM Value) -> Value -> MCPServerM Value
forall a b. (a -> b) -> a -> b
$ JSONRPCResponse -> Value
forall a. ToJSON a => a -> Value
toJSON (JSONRPCResponse -> Value) -> JSONRPCResponse -> Value
forall a b. (a -> b) -> a -> b
$ Text -> RequestId -> Value -> JSONRPCResponse
JSONRPCResponse Text
"2.0" RequestId
reqId (CompleteResult -> Value
forall a. ToJSON a => a -> Value
toJSON CompleteResult
result)
Aeson.Error String
e -> Value -> MCPServerM Value
forall a.
a -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> MCPServerM Value) -> Value -> MCPServerM Value
forall a b. (a -> b) -> a -> b
$ JSONRPCError -> Value
forall a. ToJSON a => a -> Value
toJSON (JSONRPCError -> Value) -> JSONRPCError -> Value
forall a b. (a -> b) -> a -> b
$ Text -> RequestId -> JSONRPCErrorInfo -> JSONRPCError
JSONRPCError Text
"2.0" RequestId
reqId (JSONRPCErrorInfo -> JSONRPCError)
-> JSONRPCErrorInfo -> JSONRPCError
forall a b. (a -> b) -> a -> b
$
Port -> Text -> Maybe Value -> JSONRPCErrorInfo
JSONRPCErrorInfo (-Port
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 -> Value -> MCPServerM Value
forall a.
a -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> MCPServerM Value) -> Value -> MCPServerM Value
forall a b. (a -> b) -> a -> b
$ JSONRPCError -> Value
forall a. ToJSON a => a -> Value
toJSON (JSONRPCError -> Value) -> JSONRPCError -> Value
forall a b. (a -> b) -> a -> b
$ Text -> RequestId -> JSONRPCErrorInfo -> JSONRPCError
JSONRPCError Text
"2.0" RequestId
reqId (JSONRPCErrorInfo -> JSONRPCError)
-> JSONRPCErrorInfo -> JSONRPCError
forall a b. (a -> b) -> a -> b
$
Port -> Text -> Maybe Value -> JSONRPCErrorInfo
JSONRPCErrorInfo (-Port
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 -> MCPServerM ()
forall (m :: * -> *). MCPServer m => SetLevelParams -> m ()
handleSetLevel SetLevelParams
setLevelParams
Value -> MCPServerM Value
forall a.
a -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> MCPServerM Value) -> Value -> MCPServerM Value
forall a b. (a -> b) -> a -> b
$ JSONRPCResponse -> Value
forall a. ToJSON a => a -> Value
toJSON (JSONRPCResponse -> Value) -> JSONRPCResponse -> Value
forall a b. (a -> b) -> a -> b
$ Text -> RequestId -> Value -> JSONRPCResponse
JSONRPCResponse Text
"2.0" RequestId
reqId ([Pair] -> Value
object [])
Aeson.Error String
e -> Value -> MCPServerM Value
forall a.
a -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> MCPServerM Value) -> Value -> MCPServerM Value
forall a b. (a -> b) -> a -> b
$ JSONRPCError -> Value
forall a. ToJSON a => a -> Value
toJSON (JSONRPCError -> Value) -> JSONRPCError -> Value
forall a b. (a -> b) -> a -> b
$ Text -> RequestId -> JSONRPCErrorInfo -> JSONRPCError
JSONRPCError Text
"2.0" RequestId
reqId (JSONRPCErrorInfo -> JSONRPCError)
-> JSONRPCErrorInfo -> JSONRPCError
forall a b. (a -> b) -> a -> b
$
Port -> Text -> Maybe Value -> JSONRPCErrorInfo
JSONRPCErrorInfo (-Port
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 -> Value -> MCPServerM Value
forall a.
a -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> MCPServerM Value) -> Value -> MCPServerM Value
forall a b. (a -> b) -> a -> b
$ JSONRPCError -> Value
forall a. ToJSON a => a -> Value
toJSON (JSONRPCError -> Value) -> JSONRPCError -> Value
forall a b. (a -> b) -> a -> b
$ Text -> RequestId -> JSONRPCErrorInfo -> JSONRPCError
JSONRPCError Text
"2.0" RequestId
reqId (JSONRPCErrorInfo -> JSONRPCError)
-> JSONRPCErrorInfo -> JSONRPCError
forall a b. (a -> b) -> a -> b
$
Port -> Text -> Maybe Value -> JSONRPCErrorInfo
JSONRPCErrorInfo (-Port
32602) Text
"Missing params" Maybe Value
forall a. Maybe a
Nothing
Text
_ -> Value -> MCPServerM Value
forall a.
a -> ReaderT ServerConfig (StateT ServerState (ExceptT Text IO)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> MCPServerM Value) -> Value -> MCPServerM Value
forall a b. (a -> b) -> a -> b
$ JSONRPCError -> Value
forall a. ToJSON a => a -> Value
toJSON (JSONRPCError -> Value) -> JSONRPCError -> Value
forall a b. (a -> b) -> a -> b
$ Text -> RequestId -> JSONRPCErrorInfo -> JSONRPCError
JSONRPCError Text
"2.0" RequestId
reqId (JSONRPCErrorInfo -> JSONRPCError)
-> JSONRPCErrorInfo -> JSONRPCError
forall a b. (a -> b) -> a -> b
$
Port -> Text -> Maybe Value -> JSONRPCErrorInfo
JSONRPCErrorInfo (-Port
32601) Text
"Method not found" Maybe Value
forall a. Maybe a
Nothing
handleInitializeHTTP :: RequestId -> InitializeParams -> MCPServerM ()
handleInitializeHTTP :: RequestId -> InitializeParams -> MCPServerM ()
handleInitializeHTTP RequestId
_ 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 -> MCPServerM ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put ServerState
state
{ serverInitialized = True
, clientCapabilities = Just clientCaps
, serverInfo = Just (configServerInfo config)
}
runServerHTTP :: (MCPServer MCPServerM) => HTTPServerConfig -> IO ()
runServerHTTP :: MCPServer
(ReaderT ServerConfig (StateT ServerState (ExceptT Text IO))) =>
HTTPServerConfig -> IO ()
runServerHTTP HTTPServerConfig
config = do
TVar ServerState
stateVar <- ServerState -> IO (TVar ServerState)
forall a. a -> IO (TVar a)
newTVarIO (ServerState -> IO (TVar ServerState))
-> ServerState -> IO (TVar ServerState)
forall a b. (a -> b) -> a -> b
$ ServerCapabilities -> ServerState
initialServerState (HTTPServerConfig -> ServerCapabilities
httpCapabilities HTTPServerConfig
config)
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Starting MCP HTTP Server on port " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Port -> String
forall a. Show a => a -> String
show (HTTPServerConfig -> Port
httpPort HTTPServerConfig
config) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"..."
Port -> Application -> IO ()
run (HTTPServerConfig -> Port
httpPort HTTPServerConfig
config) (MCPServer
(ReaderT ServerConfig (StateT ServerState (ExceptT Text IO))) =>
HTTPServerConfig -> TVar ServerState -> Application
HTTPServerConfig -> TVar ServerState -> Application
mcpApp HTTPServerConfig
config TVar ServerState
stateVar)