{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}

-- |
-- Module      : MCP.Server.HTTP
-- Description : MCP server implementation for HTTP communication
-- Copyright   : (C) 2025 Matthias Pall Gissurarson
-- License     : MIT
-- Maintainer  : mpg@mpg.is
-- Stability   : experimental
-- Portability : GHC
--
-- This module provides MCP server implementation for HTTP communication.
module MCP.Server.HTTP (
    -- * Server Runner
    runServerHTTP,
    HTTPServerConfig (..),
) where

import Control.Concurrent.STM (TVar, atomically, newTVarIO, readTVar, writeTVar)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Reader (ask)
import Control.Monad.State.Strict (get, put)
import Data.Aeson (encode, fromJSON, object, toJSON, (.=))
import Data.Aeson qualified as Aeson
import Data.ByteString.Lazy.Char8 qualified as LBSC
import Data.Text (Text)
import Data.Text qualified as T
import Network.Wai (Application)
import Network.Wai.Handler.Warp (Port, run)
import Network.Wai.Middleware.RequestLogger (logStdoutDev)
import Servant (Handler, Proxy(..), Server, serve, throwError)
import Servant.API (JSON, Post, ReqBody, (:>))
import Servant.Server (err400, err500, errBody)

import MCP.Protocol
import MCP.Server (MCPServer(..), MCPServerM, ServerConfig(..), ServerState(..), runMCPServer, initialServerState)
import MCP.Types

-- | Configuration for running an MCP HTTP server
data HTTPServerConfig = HTTPServerConfig
    { 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)

-- | MCP API definition for HTTP server (following the MCP transport spec)
type MCPAPI = "mcp" :> ReqBody '[JSON] Aeson.Value :> Post '[JSON] Aeson.Value

-- | Create a WAI Application for the MCP HTTP server
mcpApp :: (MCPServer MCPServerM) => HTTPServerConfig -> TVar ServerState -> Application
mcpApp :: 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

-- | Handle HTTP MCP requests following the MCP transport protocol
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
    -- Parse the incoming JSON-RPC message
    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
                    -- Process the JSON-RPC request
                    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
                    -- Process notifications (no response expected)
                    ()
_ <- 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 [] -- Empty response for notifications
                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 }

-- | Process an HTTP MCP notification
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
    -- For now, just ignore notifications since they don't need responses
    -- In a more complete implementation, this would handle logging/setLevel notifications
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Process an HTTP MCP request
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
    -- Read the current state
    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  -- Not used in HTTP mode
            , $sel:configOutput:ServerConfig :: Handle
configOutput = Handle
forall a. HasCallStack => a
undefined -- Not used in HTTP mode
            , $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
            -- Update the state atomically
            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

-- | Handle HTTP request within the MCP monad, returning proper JSON-RPC responses
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

-- | Handle HTTP initialize request
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)
        }

-- | Run the MCP server as an HTTP server
runServerHTTP :: (MCPServer MCPServerM) => HTTPServerConfig -> IO ()
runServerHTTP :: MCPServer
  (ReaderT ServerConfig (StateT ServerState (ExceptT Text IO))) =>
HTTPServerConfig -> IO ()
runServerHTTP HTTPServerConfig
config = do
    -- Initialize the server state
    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)