commit 192863a1ade1343e0ee15bb8b7fafb7e4c8d05c4 · anil.recoil.org/ocaml-mcp

+121

lib/mcp_sdk.ml

···

       82
        
           in

     

       83
        
           `Assoc assoc

     

       84
        
           

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       85
        
         (* Create a tool result with content *)

     

       86
        
         let create_tool_result content ~is_error =

     

       87
        
           `Assoc [

     
···

       134
        
             | None -> assoc

     

       135
        
           in

     

       136
        
           `Assoc assoc

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       137
        
       end

     

       138
        
       

     

       139
        
       (* Prompts for the MCP server *)

     
···

       194
        
             assoc

     

       195
        
           in

     

       196
        
           `Assoc assoc

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       197
        
       end

     

       198
        
       

     

       199
        
       let make_tool_schema properties required =

···

       82
        
           in

     

       83
        
           `Assoc assoc

     

       84
        
           

     

       85
       +
         (* Convert to Mcp_rpc.ToolsList.Tool.t *)

     

       86
       +
         let to_rpc_tool_list_tool (tool:t) =

     

       87
       +
           Mcp_rpc.ToolsList.Tool.{

     

       88
       +
             name = tool.name;

     

       89
       +
             description = tool.description;

     

       90
       +
             input_schema = tool.input_schema;

     

       91
       +
             annotations = None; (* Could be extended to support annotations *)

     

       92
       +
           }

     

       93
       +
       

     

       94
       +
         (* Convert a list of Tool.t to the format needed for tools/list response *)

     

       95
       +
         let to_rpc_tools_list tools =

     

       96
       +
           List.map to_rpc_tool_list_tool tools

     

       97
       +
       

     

       98
       +
         (* Convert Mcp_rpc.ToolsCall response content to Mcp.content list *)

     

       99
       +
         let rpc_content_to_mcp_content content =

     

       100
       +
           List.map (function

     

       101
       +
             | Mcp_rpc.ToolsCall.ToolContent.Text t -> 

     

       102
       +
                 Mcp.Text { TextContent.text = t.text; annotations = None }

     

       103
       +
             | Mcp_rpc.ToolsCall.ToolContent.Image i -> 

     

       104
       +
                 Mcp.Image { 

     

       105
       +
                   ImageContent.mime_type = i.mime_type;

     

       106
       +
                   data = i.data;

     

       107
       +
                   annotations = None

     

       108
       +
                 }

     

       109
       +
             | Mcp_rpc.ToolsCall.ToolContent.Audio a -> 

     

       110
       +
                 Mcp.Audio {

     

       111
       +
                   AudioContent.mime_type = a.mime_type;

     

       112
       +
                   data = a.data;

     

       113
       +
                   annotations = None

     

       114
       +
                 }

     

       115
       +
             | Mcp_rpc.ToolsCall.ToolContent.Resource r -> 

     

       116
       +
                 (* Create a simple text resource from the embedded resource *)

     

       117
       +
                 let uri = match r with 

     

       118
       +
                   | { EmbeddedResource.resource = `Text tr; _ } -> tr.uri

     

       119
       +
                   | { EmbeddedResource.resource = `Blob br; _ } -> br.uri

     

       120
       +
                 in

     

       121
       +
                 let text_content = match r with

     

       122
       +
                   | { EmbeddedResource.resource = `Text tr; _ } -> tr.text

     

       123
       +
                   | { EmbeddedResource.resource = `Blob br; _ } -> "Binary content"

     

       124
       +
                 in

     

       125
       +
                 let mime_type = match r with

     

       126
       +
                   | { EmbeddedResource.resource = `Text tr; _ } -> tr.mime_type

     

       127
       +
                   | { EmbeddedResource.resource = `Blob br; _ } -> br.mime_type

     

       128
       +
                 in

     

       129
       +
                 let text_resource = {

     

       130
       +
                   TextResourceContents.uri;

     

       131
       +
                   text = text_content;

     

       132
       +
                   mime_type

     

       133
       +
                 } in

     

       134
       +
                 Mcp.Resource {

     

       135
       +
                   EmbeddedResource.resource = `Text text_resource;

     

       136
       +
                   annotations = None

     

       137
       +
                 }

     

       138
       +
           ) content

     

       139
       +
       

     

       140
       +
         (* Convert Mcp.content list to Mcp_rpc.ToolsCall.ToolContent.t list *)

     

       141
       +
         let mcp_content_to_rpc_content content =

     

       142
       +
           List.map (function

     

       143
       +
             | Mcp.Text t -> 

     

       144
       +
                 Mcp_rpc.ToolsCall.ToolContent.Text t

     

       145
       +
             | Mcp.Image img -> 

     

       146
       +
                 Mcp_rpc.ToolsCall.ToolContent.Image img

     

       147
       +
             | Mcp.Audio aud -> 

     

       148
       +
                 Mcp_rpc.ToolsCall.ToolContent.Audio aud

     

       149
       +
             | Mcp.Resource res -> 

     

       150
       +
                 let resource_data = match res.resource with

     

       151
       +
                   | `Text txt -> `Text txt

     

       152
       +
                   | `Blob blob -> `Blob blob

     

       153
       +
                 in

     

       154
       +
                 let resource = {

     

       155
       +
                   EmbeddedResource.resource = resource_data;

     

       156
       +
                   annotations = res.annotations

     

       157
       +
                 } in

     

       158
       +
                 Mcp_rpc.ToolsCall.ToolContent.Resource resource

     

       159
       +
           ) content

     

       160
       +
           

     

       161
        
         (* Create a tool result with content *)

     

       162
        
         let create_tool_result content ~is_error =

     

       163
        
           `Assoc [

     
···

       210
        
             | None -> assoc

     

       211
        
           in

     

       212
        
           `Assoc assoc

     

       213
       +
           

     

       214
       +
         (* Convert to Mcp_rpc.ResourcesList.Resource.t *)

     

       215
       +
         let to_rpc_resource_list_resource (resource:t) =

     

       216
       +
           Mcp_rpc.ResourcesList.Resource.{

     

       217
       +
             uri = resource.uri_template;

     

       218
       +
             name = resource.uri_template; (* Use uri as name by default *)

     

       219
       +
             description = resource.description;

     

       220
       +
             mime_type = resource.mime_type;

     

       221
       +
             size = None; (* Size can be added when we have actual resource content *)

     

       222
       +
           }

     

       223
       +
           

     

       224
       +
         (* Convert a list of Resource.t to the format needed for resources/list response *)

     

       225
       +
         let to_rpc_resources_list resources =

     

       226
       +
           List.map to_rpc_resource_list_resource resources

     

       227
        
       end

     

       228
        
       

     

       229
        
       (* Prompts for the MCP server *)

     
···

       284
        
             assoc

     

       285
        
           in

     

       286
        
           `Assoc assoc

     

       287
       +
           

     

       288
       +
         (* Convert argument to Mcp_rpc.PromptsList.PromptArgument.t *)

     

       289
       +
         let argument_to_rpc_prompt_argument (arg:argument) =

     

       290
       +
           Mcp_rpc.PromptsList.PromptArgument.{

     

       291
       +
             name = arg.name;

     

       292
       +
             description = arg.description;

     

       293
       +
             required = arg.required;

     

       294
       +
           }

     

       295
       +
           

     

       296
       +
         (* Convert to Mcp_rpc.PromptsList.Prompt.t *)

     

       297
       +
         let to_rpc_prompt_list_prompt (prompt:t) =

     

       298
       +
           Mcp_rpc.PromptsList.Prompt.{

     

       299
       +
             name = prompt.name;

     

       300
       +
             description = prompt.description;

     

       301
       +
             arguments = List.map argument_to_rpc_prompt_argument prompt.arguments;

     

       302
       +
           }

     

       303
       +
         

     

       304
       +
         (* Convert a list of Prompt.t to the format needed for prompts/list response *)

     

       305
       +
         let to_rpc_prompts_list prompts =

     

       306
       +
           List.map to_rpc_prompt_list_prompt prompts

     

       307
       +
           

     

       308
       +
         (* Convert message to Mcp_rpc.PromptMessage.t *)

     

       309
       +
         let message_to_rpc_prompt_message msg =

     

       310
       +
           {

     

       311
       +
             PromptMessage.role = msg.role;

     

       312
       +
             PromptMessage.content = msg.content;

     

       313
       +
           }

     

       314
       +
           

     

       315
       +
         (* Convert a list of messages to the format needed for prompts/get response *)

     

       316
       +
         let messages_to_rpc_prompt_messages messages =

     

       317
       +
           List.map message_to_rpc_prompt_message messages

     

       318
        
       end

     

       319
        
       

     

       320
        
       let make_tool_schema properties required =

+33

lib/mcp_sdk.mli

···

       50
        
         val create : name:string -> ?description:string -> input_schema:Json.t -> handler:handler -> unit -> t

     

       51
        
         val to_json : t -> Json.t

     

       52
        
         

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       53
        
         (** Create a tool result with content *)

     

       54
        
         val create_tool_result : Mcp.content list -> is_error:bool -> Json.t

     

       55
        
         

     
···

       79
        
       

     

       80
        
         val create : uri_template:string -> ?description:string -> ?mime_type:string -> handler:handler -> unit -> t

     

       81
        
         val to_json : t -> Json.t

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       82
        
       end

     

       83
        
       

     

       84
        
       (** Prompts for the MCP server *)

     
···

       106
        
         val create : name:string -> ?description:string -> ?arguments:argument list -> handler:handler -> unit -> t

     

       107
        
         val create_argument : name:string -> ?description:string -> ?required:bool -> unit -> argument

     

       108
        
         val to_json : t -> Json.t

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       109
        
       end

     

       110
        
       

     

       111
        
       (** Main server type *)

···

       50
        
         val create : name:string -> ?description:string -> input_schema:Json.t -> handler:handler -> unit -> t

     

       51
        
         val to_json : t -> Json.t

     

       52
        
         

     

       53
       +
         (** Convert to Mcp_rpc.ToolsList.Tool.t *)

     

       54
       +
         val to_rpc_tool_list_tool : t -> Mcp_rpc.ToolsList.Tool.t

     

       55
       +
         

     

       56
       +
         (** Convert a list of Tool.t to the format needed for tools/list response *)

     

       57
       +
         val to_rpc_tools_list : t list -> Mcp_rpc.ToolsList.Tool.t list

     

       58
       +
         

     

       59
       +
         (** Convert Mcp_rpc.ToolsCall response content to Mcp.content list *)

     

       60
       +
         val rpc_content_to_mcp_content : Mcp_rpc.ToolsCall.ToolContent.t list -> Mcp.content list

     

       61
       +
         

     

       62
       +
         (** Convert Mcp.content list to Mcp_rpc.ToolsCall.ToolContent.t list *)

     

       63
       +
         val mcp_content_to_rpc_content : Mcp.content list -> Mcp_rpc.ToolsCall.ToolContent.t list

     

       64
       +
         

     

       65
        
         (** Create a tool result with content *)

     

       66
        
         val create_tool_result : Mcp.content list -> is_error:bool -> Json.t

     

       67
        
         

     
···

       91
        
       

     

       92
        
         val create : uri_template:string -> ?description:string -> ?mime_type:string -> handler:handler -> unit -> t

     

       93
        
         val to_json : t -> Json.t

     

       94
       +
         

     

       95
       +
         (** Convert to Mcp_rpc.ResourcesList.Resource.t *)

     

       96
       +
         val to_rpc_resource_list_resource : t -> Mcp_rpc.ResourcesList.Resource.t

     

       97
       +
         

     

       98
       +
         (** Convert a list of Resource.t to the format needed for resources/list response *)

     

       99
       +
         val to_rpc_resources_list : t list -> Mcp_rpc.ResourcesList.Resource.t list

     

       100
        
       end

     

       101
        
       

     

       102
        
       (** Prompts for the MCP server *)

     
···

       124
        
         val create : name:string -> ?description:string -> ?arguments:argument list -> handler:handler -> unit -> t

     

       125
        
         val create_argument : name:string -> ?description:string -> ?required:bool -> unit -> argument

     

       126
        
         val to_json : t -> Json.t

     

       127
       +
         

     

       128
       +
         (** Convert argument to Mcp_rpc.PromptsList.PromptArgument.t *)

     

       129
       +
         val argument_to_rpc_prompt_argument : argument -> Mcp_rpc.PromptsList.PromptArgument.t

     

       130
       +
         

     

       131
       +
         (** Convert to Mcp_rpc.PromptsList.Prompt.t *)

     

       132
       +
         val to_rpc_prompt_list_prompt : t -> Mcp_rpc.PromptsList.Prompt.t

     

       133
       +
         

     

       134
       +
         (** Convert a list of Prompt.t to the format needed for prompts/list response *)

     

       135
       +
         val to_rpc_prompts_list : t list -> Mcp_rpc.PromptsList.Prompt.t list

     

       136
       +
         

     

       137
       +
         (** Convert message to Mcp_rpc.PromptMessage.t *)

     

       138
       +
         val message_to_rpc_prompt_message : message -> PromptMessage.t

     

       139
       +
         

     

       140
       +
         (** Convert a list of messages to the format needed for prompts/get response *)

     

       141
       +
         val messages_to_rpc_prompt_messages : message list -> PromptMessage.t list

     

       142
        
       end

     

       143
        
       

     

       144
        
       (** Main server type *)

+42 -11

lib/mcp_server.ml

···

       33
        
       (* Process tools/list request *)

     

       34
        
       let handle_tools_list server (req:JSONRPCMessage.request) =

     

       35
        
         Log.debug "Processing tools/list request";

     

       36
       -
         let tool_list = List.map Tool.to_json (tools server) in

     

       37
       -
         let result = `Assoc [("tools", `List tool_list)] in

     

       38
       -
         Some (create_response ~id:req.id ~result)

     

       39
        
       

     

       40
        
       (* Process prompts/list request *)

     

       41
        
       let handle_prompts_list server (req:JSONRPCMessage.request) =

     

       42
        
         Log.debug "Processing prompts/list request";

     

       43
       -
         let prompt_list = List.map Prompt.to_json (prompts server) in

     

       44
       -
         let result = `Assoc [("prompts", `List prompt_list)] in

     

       45
       -
         Some (create_response ~id:req.id ~result)

     

       46
        
       

     

       47
        
       (* Process resources/list request *)

     

       48
        
       let handle_resources_list server (req:JSONRPCMessage.request) =

     

       49
        
         Log.debug "Processing resources/list request";

     

       50
       -
         let resource_list = List.map Resource.to_json (resources server) in

     

       51
       -
         let result = `Assoc [("resources", `List resource_list)] in

     

       52
       -
         Some (create_response ~id:req.id ~result)

     

       53
        
       

     

       54
        
       (* Extract the tool name from params *)

     

       55
        
       let extract_tool_name params =

     
···

       97
        
         | Not_found -> Tool.handle_unknown_tool_error name

     

       98
        
         | exn -> Tool.handle_execution_exception exn

     

       99
        
       

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       100
        
       (* Process tools/call request *)

     

       101
        
       let handle_tools_call server req =

     

       102
        
         Log.debug "Processing tools/call request";

     
···

       115
        
               in

     

       116
        
                       

     

       117
        
               (* Execute the tool *)

     

       118
       -
               let result = execute_tool server ctx name args in

     

       119
        
               

     

       120
       -
               Some (create_response ~id:req.id ~result)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       121
        
           | None ->

     

       122
        
               Some (create_jsonrpc_error req.id InvalidParams "Missing tool name parameter" ()))

     

       123
        
         | _ ->

···

       33
        
       (* Process tools/list request *)

     

       34
        
       let handle_tools_list server (req:JSONRPCMessage.request) =

     

       35
        
         Log.debug "Processing tools/list request";

     

       36
       +
         let tools_list = Tool.to_rpc_tools_list (tools server) in

     

       37
       +
         let response = Mcp_rpc.ToolsList.create_response ~id:req.id ~tools:tools_list () in

     

       38
       +
         Some response

     

       39
        
       

     

       40
        
       (* Process prompts/list request *)

     

       41
        
       let handle_prompts_list server (req:JSONRPCMessage.request) =

     

       42
        
         Log.debug "Processing prompts/list request";

     

       43
       +
         let prompts_list = Prompt.to_rpc_prompts_list (prompts server) in

     

       44
       +
         let response = Mcp_rpc.PromptsList.create_response ~id:req.id ~prompts:prompts_list () in

     

       45
       +
         Some response

     

       46
        
       

     

       47
        
       (* Process resources/list request *)

     

       48
        
       let handle_resources_list server (req:JSONRPCMessage.request) =

     

       49
        
         Log.debug "Processing resources/list request";

     

       50
       +
         let resources_list = Resource.to_rpc_resources_list (resources server) in

     

       51
       +
         let response = Mcp_rpc.ResourcesList.create_response ~id:req.id ~resources:resources_list () in

     

       52
       +
         Some response

     

       53
        
       

     

       54
        
       (* Extract the tool name from params *)

     

       55
        
       let extract_tool_name params =

     
···

       97
        
         | Not_found -> Tool.handle_unknown_tool_error name

     

       98
        
         | exn -> Tool.handle_execution_exception exn

     

       99
        
       

     

       100
       +
       (* Convert JSON tool result to RPC content format *)

     

       101
       +
       let json_to_rpc_content json =

     

       102
       +
         match json with

     

       103
       +
         | `Assoc fields ->

     

       104
       +
           (match List.assoc_opt "content" fields, List.assoc_opt "isError" fields with

     

       105
       +
            | Some (`List content_items), Some (`Bool is_error) ->

     

       106
       +
                let mcp_content = List.map Mcp.content_of_yojson content_items in

     

       107
       +
                let rpc_content = Tool.mcp_content_to_rpc_content mcp_content in

     

       108
       +
                (rpc_content, is_error)

     

       109
       +
            | _ -> 

     

       110
       +
                (* Fallback for compatibility with older formats *)

     

       111
       +
                let text = Yojson.Safe.to_string json in

     

       112
       +
                let text_content = { TextContent.text = text; annotations = None } in

     

       113
       +
                ([Mcp_rpc.ToolsCall.ToolContent.Text text_content], false))

     

       114
       +
         | _ ->

     

       115
       +
           (* Simple fallback for non-object results *)

     

       116
       +
           let text = Yojson.Safe.to_string json in

     

       117
       +
           let text_content = { TextContent.text = text; annotations = None } in

     

       118
       +
           ([Mcp_rpc.ToolsCall.ToolContent.Text text_content], false)

     

       119
       +
       

     

       120
        
       (* Process tools/call request *)

     

       121
        
       let handle_tools_call server req =

     

       122
        
         Log.debug "Processing tools/call request";

     
···

       135
        
               in

     

       136
        
                       

     

       137
        
               (* Execute the tool *)

     

       138
       +
               let result_json = execute_tool server ctx name args in

     

       139
        
               

     

       140
       +
               (* Convert JSON result to RPC format *)

     

       141
       +
               let content, is_error = json_to_rpc_content result_json in

     

       142
       +
               

     

       143
       +
               (* Create the RPC response *)

     

       144
       +
               let response = Mcp_rpc.ToolsCall.create_response 

     

       145
       +
                 ~id:req.id 

     

       146
       +
                 ~content 

     

       147
       +
                 ~is_error 

     

       148
       +
                 () 

     

       149
       +
               in

     

       150
       +
               

     

       151
       +
               Some response

     

       152
        
           | None ->

     

       153
        
               Some (create_jsonrpc_error req.id InvalidParams "Missing tool name parameter" ()))

     

       154
        
         | _ ->