commit 328ae50dcbb50999aebed7a00d71a9432b02576f · anil.recoil.org/slop

+288

claudeio/lib_mcp/SERVER_SESSION_README.md

···

       1
       +
       # MCP Server Session API

     

       2
       +
       

     

       3
       +
       The `Server_session` module provides a high-level, easy-to-use API for creating MCP (Model Context Protocol) servers in OCaml using Eio.

     

       4
       +
       

     

       5
       +
       ## Overview

     

       6
       +
       

     

       7
       +
       This module handles:

     

       8
       +
       - **Initialization handshake**: Automatically handles the MCP initialization protocol

     

       9
       +
       - **Request routing**: Routes incoming requests to your handler functions

     

       10
       +
       - **Response encoding**: Automatically encodes responses using the correct MCP message types

     

       11
       +
       - **Notification sending**: Provides convenient functions for sending notifications to clients

     

       12
       +
       - **Error handling**: Returns proper JSON-RPC error responses for missing handlers

     

       13
       +
       

     

       14
       +
       ## Quick Start

     

       15
       +
       

     

       16
       +
       ```ocaml

     

       17
       +
       open Mcp

     

       18
       +
       

     

       19
       +
       (* Define your handlers *)

     

       20
       +
       let list_tools ~cursor:_ =

     

       21
       +
         let tool = Messages.Tools.make_tool

     

       22
       +
           ~name:"my_tool"

     

       23
       +
           ~description:"An example tool"

     

       24
       +
           ~input_schema:(Jsont.Object ([], Jsont.Meta.none))

     

       25
       +
           ()

     

       26
       +
         in

     

       27
       +
         Messages.Tools.make_list_result ~tools:[tool] ()

     

       28
       +
       

     

       29
       +
       let call_tool ~name ~arguments =

     

       30
       +
         match name with

     

       31
       +
         | "my_tool" ->

     

       32
       +
             Messages.Tools.make_call_result

     

       33
       +
               ~content:[Content.text "Tool result"]

     

       34
       +
               ()

     

       35
       +
         | _ ->

     

       36
       +
             Messages.Tools.make_call_result

     

       37
       +
               ~content:[Content.text "Unknown tool"]

     

       38
       +
               ~is_error:true

     

       39
       +
               ()

     

       40
       +
       

     

       41
       +
       (* Configure your server *)

     

       42
       +
       let config = {

     

       43
       +
         Server_session.server_info = Capabilities.Implementation.make

     

       44
       +
           ~name:"my-server"

     

       45
       +
           ~version:"1.0.0";

     

       46
       +
         server_capabilities = Capabilities.Server.make

     

       47
       +
           ~tools:(Capabilities.Tools.make ())

     

       48
       +
           ();

     

       49
       +
         instructions = Some "My MCP server";

     

       50
       +
       }

     

       51
       +
       

     

       52
       +
       let handlers = {

     

       53
       +
         Server_session.list_tools = Some list_tools;

     

       54
       +
         call_tool = Some call_tool;

     

       55
       +
         list_resources = None;

     

       56
       +
         list_resource_templates = None;

     

       57
       +
         read_resource = None;

     

       58
       +
         subscribe_resource = None;

     

       59
       +
         unsubscribe_resource = None;

     

       60
       +
         list_prompts = None;

     

       61
       +
         get_prompt = None;

     

       62
       +
         complete = None;

     

       63
       +
         ping = None;

     

       64
       +
       }

     

       65
       +
       

     

       66
       +
       (* Start the server *)

     

       67
       +
       let () =

     

       68
       +
         Eio_main.run @@ fun env ->

     

       69
       +
           Eio.Switch.run @@ fun sw ->

     

       70
       +
             let transport = (* create your transport *) in

     

       71
       +
             let server = Server_session.create

     

       72
       +
               ~sw

     

       73
       +
               ~transport

     

       74
       +
               config

     

       75
       +
               handlers

     

       76
       +
             in

     

       77
       +
             (* Server is now running *)

     

       78
       +
       ```

     

       79
       +
       

     

       80
       +
       ## Architecture

     

       81
       +
       

     

       82
       +
       ### Initialization Flow

     

       83
       +
       

     

       84
       +
       1. **Client sends Initialize request** → Server stores client capabilities and info

     

       85
       +
       2. **Server responds with capabilities** → Returns server capabilities and info

     

       86
       +
       3. **Client sends Initialized notification** → Server marks initialization complete

     

       87
       +
       4. **Server is ready** → Now accepts requests and can send notifications

     

       88
       +
       

     

       89
       +
       ### Request Handling

     

       90
       +
       

     

       91
       +
       When a request arrives:

     

       92
       +
       

     

       93
       +
       1. The method name is matched against handler types

     

       94
       +
       2. If a handler exists, it's called with the decoded parameters

     

       95
       +
       3. The result is encoded and sent back

     

       96
       +
       4. If no handler exists, a METHOD_NOT_FOUND error is returned

     

       97
       +
       

     

       98
       +
       ### Error Handling

     

       99
       +
       

     

       100
       +
       The module automatically handles:

     

       101
       +
       - Missing handlers → METHOD_NOT_FOUND error

     

       102
       +
       - Invalid params → INVALID_PARAMS error

     

       103
       +
       - Handler exceptions → INTERNAL_ERROR with exception message

     

       104
       +
       - Pre-initialization requests → Rejected with error

     

       105
       +
       

     

       106
       +
       ## Supported Capabilities

     

       107
       +
       

     

       108
       +
       The server can implement any combination of these capabilities:

     

       109
       +
       

     

       110
       +
       ### Resources

     

       111
       +
       - `list_resources`: List available resources with optional pagination

     

       112
       +
       - `list_resource_templates`: List resource templates

     

       113
       +
       - `read_resource`: Read resource contents by URI

     

       114
       +
       - `subscribe_resource`: Subscribe to resource updates

     

       115
       +
       - `unsubscribe_resource`: Unsubscribe from updates

     

       116
       +
       

     

       117
       +
       Notifications you can send:

     

       118
       +
       - `send_resource_updated`: Notify about a specific resource update

     

       119
       +
       - `send_resource_list_changed`: Notify that the resource list changed

     

       120
       +
       

     

       121
       +
       ### Tools

     

       122
       +
       - `list_tools`: List available tools with optional pagination

     

       123
       +
       - `call_tool`: Execute a tool by name with arguments

     

       124
       +
       

     

       125
       +
       Notifications you can send:

     

       126
       +
       - `send_tool_list_changed`: Notify that the tool list changed

     

       127
       +
       

     

       128
       +
       ### Prompts

     

       129
       +
       - `list_prompts`: List available prompts with optional pagination

     

       130
       +
       - `get_prompt`: Get a prompt by name with arguments

     

       131
       +
       

     

       132
       +
       Notifications you can send:

     

       133
       +
       - `send_prompt_list_changed`: Notify that the prompt list changed

     

       134
       +
       

     

       135
       +
       ### Other

     

       136
       +
       - `complete`: Auto-completion suggestions

     

       137
       +
       - `ping`: Keepalive handler

     

       138
       +
       

     

       139
       +
       ### Logging

     

       140
       +
       - `send_log_message`: Send log messages to the client

     

       141
       +
       

     

       142
       +
       ### Progress

     

       143
       +
       - `send_progress`: Send progress updates for long-running operations

     

       144
       +
       

     

       145
       +
       ## Handler Signatures

     

       146
       +
       

     

       147
       +
       All handlers return strongly-typed message results:

     

       148
       +
       

     

       149
       +
       ```ocaml

     

       150
       +
       type handlers = {

     

       151
       +
         list_resources : (cursor:string option -> Messages.Resources.list_result) option;

     

       152
       +
         read_resource : (uri:string -> Messages.Resources.read_result) option;

     

       153
       +
         list_tools : (cursor:string option -> Messages.Tools.list_result) option;

     

       154
       +
         call_tool : (name:string -> arguments:Jsont.json option -> Messages.Tools.call_result) option;

     

       155
       +
         list_prompts : (cursor:string option -> Messages.Prompts.list_result) option;

     

       156
       +
         get_prompt : (name:string -> arguments:(string * string) list option -> Messages.Prompts.get_result) option;

     

       157
       +
         complete : (ref_:Messages.Completions.completion_ref -> argument:string -> Messages.Completions.result) option;

     

       158
       +
         ping : (unit -> unit) option;

     

       159
       +
         (* ... *)

     

       160
       +
       }

     

       161
       +
       ```

     

       162
       +
       

     

       163
       +
       Set a handler to `None` if you don't support that operation.

     

       164
       +
       

     

       165
       +
       ## Accessing Client Information

     

       166
       +
       

     

       167
       +
       After initialization, you can query client capabilities:

     

       168
       +
       

     

       169
       +
       ```ocaml

     

       170
       +
       let server = Server_session.create ~sw ~transport config handlers in

     

       171
       +
       

     

       172
       +
       (* Get client capabilities *)

     

       173
       +
       let client_caps = Server_session.client_capabilities server in

     

       174
       +
       match client_caps.roots with

     

       175
       +
       | Some _ -> (* Client supports roots *)

     

       176
       +
       | None -> (* Client doesn't support roots *)

     

       177
       +
       

     

       178
       +
       (* Get client info *)

     

       179
       +
       let client_info = Server_session.client_info server in

     

       180
       +
       Printf.printf "Connected to: %s v%s\n"

     

       181
       +
         client_info.name

     

       182
       +
         client_info.version;

     

       183
       +
       

     

       184
       +
       (* Get protocol version *)

     

       185
       +
       let version = Server_session.protocol_version server in

     

       186
       +
       ```

     

       187
       +
       

     

       188
       +
       ## Sending Notifications

     

       189
       +
       

     

       190
       +
       Send notifications to inform clients of changes:

     

       191
       +
       

     

       192
       +
       ```ocaml

     

       193
       +
       (* Resource was updated *)

     

       194
       +
       Server_session.send_resource_updated server ~uri:"file:///example.txt";

     

       195
       +
       

     

       196
       +
       (* Resource list changed *)

     

       197
       +
       Server_session.send_resource_list_changed server;

     

       198
       +
       

     

       199
       +
       (* Tool list changed *)

     

       200
       +
       Server_session.send_tool_list_changed server;

     

       201
       +
       

     

       202
       +
       (* Log a message *)

     

       203
       +
       let log_data = Jsont.String ("Something happened", Jsont.Meta.none) in

     

       204
       +
       Server_session.send_log_message server

     

       205
       +
         ~level:Messages.Logging.Info

     

       206
       +
         ~data:log_data

     

       207
       +
         ();

     

       208
       +
       

     

       209
       +
       (* Report progress *)

     

       210
       +
       Server_session.send_progress server

     

       211
       +
         ~progress_token:"operation-123"

     

       212
       +
         ~progress:0.5

     

       213
       +
         ~total:100.0

     

       214
       +
         ();

     

       215
       +
       ```

     

       216
       +
       

     

       217
       +
       ## Requesting from Client

     

       218
       +
       

     

       219
       +
       Some servers may need to request information from clients:

     

       220
       +
       

     

       221
       +
       ```ocaml

     

       222
       +
       (* Request the list of roots (if client supports it) *)

     

       223
       +
       match Server_session.request_roots_list server with

     

       224
       +
       | Some result ->

     

       225
       +
           List.iter (fun root ->

     

       226
       +
             Printf.printf "Root: %s\n" root.Messages.Roots.uri

     

       227
       +
           ) result.roots

     

       228
       +
       | None ->

     

       229
       +
           (* Client doesn't support roots capability *)

     

       230
       +
           ()

     

       231
       +
       ```

     

       232
       +
       

     

       233
       +
       ## Example: Simple Tool Server

     

       234
       +
       

     

       235
       +
       See `examples/mcp_server_example.ml` for a complete example that demonstrates:

     

       236
       +
       - Tool implementation (add, echo)

     

       237
       +
       - Resource serving (example://greeting)

     

       238
       +
       - Proper capability declaration

     

       239
       +
       - Handler implementation

     

       240
       +
       

     

       241
       +
       ## Implementation Notes

     

       242
       +
       

     

       243
       +
       ### Thread Safety

     

       244
       +
       The module uses Eio structured concurrency. All operations are safe within the same Eio domain. The Session module handles concurrent requests using Eio fibers.

     

       245
       +
       

     

       246
       +
       ### Timeout Support

     

       247
       +
       You can configure request timeouts:

     

       248
       +
       

     

       249
       +
       ```ocaml

     

       250
       +
       let server = Server_session.create

     

       251
       +
         ~sw

     

       252
       +
         ~transport

     

       253
       +
         ~timeout:30.0  (* 30 second timeout *)

     

       254
       +
         ~clock:(Session.C (Eio.Stdenv.clock env))

     

       255
       +
         config

     

       256
       +
         handlers

     

       257
       +
       ```

     

       258
       +
       

     

       259
       +
       ### Error Propagation

     

       260
       +
       - Handler exceptions are caught and converted to INTERNAL_ERROR responses

     

       261
       +
       - The server continues running after handler errors

     

       262
       +
       - Use proper error handling in your handlers for better error messages

     

       263
       +
       

     

       264
       +
       ### Shutdown

     

       265
       +
       The server runs as long as the Eio switch is active:

     

       266
       +
       

     

       267
       +
       ```ocaml

     

       268
       +
       (* Explicit close *)

     

       269
       +
       Server_session.close server;

     

       270
       +
       

     

       271
       +
       (* Or let the switch handle cleanup *)

     

       272
       +
       Eio.Switch.run @@ fun sw ->

     

       273
       +
         let server = Server_session.create ~sw ~transport config handlers in

     

       274
       +
         (* server auto-closes when switch exits *)

     

       275
       +
       ```

     

       276
       +
       

     

       277
       +
       ## Related Modules

     

       278
       +
       

     

       279
       +
       - `Session`: Low-level bidirectional JSON-RPC session

     

       280
       +
       - `Messages`: MCP protocol message types

     

       281
       +
       - `Capabilities`: Capability negotiation types

     

       282
       +
       - `Transport`: Transport layer abstraction

     

       283
       +
       - `Content`: Content block types (text, image, etc.)

     

       284
       +
       

     

       285
       +
       ## References

     

       286
       +
       

     

       287
       +
       - [MCP Specification](https://spec.modelcontextprotocol.io/)

     

       288
       +
       - [JSON-RPC 2.0 Specification](https://www.jsonrpc.org/)

+284

claudeio/lib_mcp/capabilities.ml

···

       1
       +
       (** MCP Capability negotiation types *)

     

       2
       +
       

     

       3
       +
       (* Implementation Info *)

     

       4
       +
       

     

       5
       +
       module Implementation = struct

     

       6
       +
         type t = {

     

       7
       +
           name : string;

     

       8
       +
           version : string;

     

       9
       +
           unknown : Jsont.json;

     

       10
       +
         }

     

       11
       +
       

     

       12
       +
         let make ~name ~version =

     

       13
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       14
       +
           { name; version; unknown }

     

       15
       +
       

     

       16
       +
         let jsont : t Jsont.t =

     

       17
       +
           let make name version unknown = { name; version; unknown } in

     

       18
       +
           Jsont.Object.map ~kind:"Implementation" make

     

       19
       +
           |> Jsont.Object.mem "name" Jsont.string ~enc:(fun i -> i.name)

     

       20
       +
           |> Jsont.Object.mem "version" Jsont.string ~enc:(fun i -> i.version)

     

       21
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun i -> i.unknown)

     

       22
       +
           |> Jsont.Object.finish

     

       23
       +
       

     

       24
       +
         let pp fmt i =

     

       25
       +
           Format.fprintf fmt "%s/%s" i.name i.version

     

       26
       +
       end

     

       27
       +
       

     

       28
       +
       (* Client Capabilities *)

     

       29
       +
       

     

       30
       +
       module Sampling = struct

     

       31
       +
         type t = {

     

       32
       +
           context : bool option;

     

       33
       +
           tools : bool option;

     

       34
       +
           unknown : Jsont.json;

     

       35
       +
         }

     

       36
       +
       

     

       37
       +
         let empty =

     

       38
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       39
       +
           { context = None; tools = None; unknown }

     

       40
       +
       

     

       41
       +
         let make ?context ?tools () =

     

       42
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       43
       +
           { context; tools; unknown }

     

       44
       +
       

     

       45
       +
         let jsont : t Jsont.t =

     

       46
       +
           let make context tools unknown = { context; tools; unknown } in

     

       47
       +
           Jsont.Object.map ~kind:"Sampling" make

     

       48
       +
           |> Jsont.Object.opt_mem "context" Jsont.bool ~enc:(fun s -> s.context)

     

       49
       +
           |> Jsont.Object.opt_mem "tools" Jsont.bool ~enc:(fun s -> s.tools)

     

       50
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun s -> s.unknown)

     

       51
       +
           |> Jsont.Object.finish

     

       52
       +
       end

     

       53
       +
       

     

       54
       +
       module Elicitation = struct

     

       55
       +
         type t = {

     

       56
       +
           unknown : Jsont.json;

     

       57
       +
         }

     

       58
       +
       

     

       59
       +
         let empty =

     

       60
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       61
       +
           { unknown }

     

       62
       +
       

     

       63
       +
         let jsont : t Jsont.t =

     

       64
       +
           let make unknown = { unknown } in

     

       65
       +
           Jsont.Object.map ~kind:"Elicitation" make

     

       66
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun e -> e.unknown)

     

       67
       +
           |> Jsont.Object.finish

     

       68
       +
       end

     

       69
       +
       

     

       70
       +
       module Roots = struct

     

       71
       +
         type t = {

     

       72
       +
           list_changed : bool option;

     

       73
       +
           unknown : Jsont.json;

     

       74
       +
         }

     

       75
       +
       

     

       76
       +
         let empty =

     

       77
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       78
       +
           { list_changed = None; unknown }

     

       79
       +
       

     

       80
       +
         let make ?list_changed () =

     

       81
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       82
       +
           { list_changed; unknown }

     

       83
       +
       

     

       84
       +
         let jsont : t Jsont.t =

     

       85
       +
           let make list_changed unknown = { list_changed; unknown } in

     

       86
       +
           Jsont.Object.map ~kind:"Roots" make

     

       87
       +
           |> Jsont.Object.opt_mem "listChanged" Jsont.bool ~enc:(fun r -> r.list_changed)

     

       88
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun r -> r.unknown)

     

       89
       +
           |> Jsont.Object.finish

     

       90
       +
       end

     

       91
       +
       

     

       92
       +
       module Client = struct

     

       93
       +
         type t = {

     

       94
       +
           sampling : Sampling.t option;

     

       95
       +
           elicitation : Elicitation.t option;

     

       96
       +
           roots : Roots.t option;

     

       97
       +
           experimental : Jsont.json option;

     

       98
       +
           unknown : Jsont.json;

     

       99
       +
         }

     

       100
       +
       

     

       101
       +
         let empty =

     

       102
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       103
       +
           { sampling = None; elicitation = None; roots = None; experimental = None; unknown }

     

       104
       +
       

     

       105
       +
         let make ?sampling ?elicitation ?roots ?experimental () =

     

       106
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       107
       +
           { sampling; elicitation; roots; experimental; unknown }

     

       108
       +
       

     

       109
       +
         let jsont : t Jsont.t =

     

       110
       +
           let make sampling elicitation roots experimental unknown =

     

       111
       +
             { sampling; elicitation; roots; experimental; unknown }

     

       112
       +
           in

     

       113
       +
           Jsont.Object.map ~kind:"ClientCapabilities" make

     

       114
       +
           |> Jsont.Object.opt_mem "sampling" Sampling.jsont ~enc:(fun c -> c.sampling)

     

       115
       +
           |> Jsont.Object.opt_mem "elicitation" Elicitation.jsont ~enc:(fun c -> c.elicitation)

     

       116
       +
           |> Jsont.Object.opt_mem "roots" Roots.jsont ~enc:(fun c -> c.roots)

     

       117
       +
           |> Jsont.Object.opt_mem "experimental" Jsont.json ~enc:(fun c -> c.experimental)

     

       118
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun c -> c.unknown)

     

       119
       +
           |> Jsont.Object.finish

     

       120
       +
       

     

       121
       +
         let pp fmt c =

     

       122
       +
           let caps = [

     

       123
       +
             (match c.sampling with Some _ -> Some "sampling" | None -> None);

     

       124
       +
             (match c.elicitation with Some _ -> Some "elicitation" | None -> None);

     

       125
       +
             (match c.roots with Some _ -> Some "roots" | None -> None);

     

       126
       +
           ] |> List.filter_map Fun.id in

     

       127
       +
           Format.fprintf fmt "[%s]" (String.concat ", " caps)

     

       128
       +
       end

     

       129
       +
       

     

       130
       +
       (* Server Capabilities *)

     

       131
       +
       

     

       132
       +
       module Logging = struct

     

       133
       +
         type t = {

     

       134
       +
           unknown : Jsont.json;

     

       135
       +
         }

     

       136
       +
       

     

       137
       +
         let empty =

     

       138
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       139
       +
           { unknown }

     

       140
       +
       

     

       141
       +
         let jsont : t Jsont.t =

     

       142
       +
           let make unknown = { unknown } in

     

       143
       +
           Jsont.Object.map ~kind:"Logging" make

     

       144
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun l -> l.unknown)

     

       145
       +
           |> Jsont.Object.finish

     

       146
       +
       end

     

       147
       +
       

     

       148
       +
       module Prompts = struct

     

       149
       +
         type t = {

     

       150
       +
           list_changed : bool option;

     

       151
       +
           unknown : Jsont.json;

     

       152
       +
         }

     

       153
       +
       

     

       154
       +
         let empty =

     

       155
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       156
       +
           { list_changed = None; unknown }

     

       157
       +
       

     

       158
       +
         let make ?list_changed () =

     

       159
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       160
       +
           { list_changed; unknown }

     

       161
       +
       

     

       162
       +
         let jsont : t Jsont.t =

     

       163
       +
           let make list_changed unknown = { list_changed; unknown } in

     

       164
       +
           Jsont.Object.map ~kind:"Prompts" make

     

       165
       +
           |> Jsont.Object.opt_mem "listChanged" Jsont.bool ~enc:(fun p -> p.list_changed)

     

       166
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun p -> p.unknown)

     

       167
       +
           |> Jsont.Object.finish

     

       168
       +
       end

     

       169
       +
       

     

       170
       +
       module Resources = struct

     

       171
       +
         type t = {

     

       172
       +
           subscribe : bool option;

     

       173
       +
           list_changed : bool option;

     

       174
       +
           unknown : Jsont.json;

     

       175
       +
         }

     

       176
       +
       

     

       177
       +
         let empty =

     

       178
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       179
       +
           { subscribe = None; list_changed = None; unknown }

     

       180
       +
       

     

       181
       +
         let make ?subscribe ?list_changed () =

     

       182
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       183
       +
           { subscribe; list_changed; unknown }

     

       184
       +
       

     

       185
       +
         let jsont : t Jsont.t =

     

       186
       +
           let make subscribe list_changed unknown =

     

       187
       +
             { subscribe; list_changed; unknown }

     

       188
       +
           in

     

       189
       +
           Jsont.Object.map ~kind:"Resources" make

     

       190
       +
           |> Jsont.Object.opt_mem "subscribe" Jsont.bool ~enc:(fun r -> r.subscribe)

     

       191
       +
           |> Jsont.Object.opt_mem "listChanged" Jsont.bool ~enc:(fun r -> r.list_changed)

     

       192
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun r -> r.unknown)

     

       193
       +
           |> Jsont.Object.finish

     

       194
       +
       end

     

       195
       +
       

     

       196
       +
       module Tools = struct

     

       197
       +
         type t = {

     

       198
       +
           list_changed : bool option;

     

       199
       +
           unknown : Jsont.json;

     

       200
       +
         }

     

       201
       +
       

     

       202
       +
         let empty =

     

       203
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       204
       +
           { list_changed = None; unknown }

     

       205
       +
       

     

       206
       +
         let make ?list_changed () =

     

       207
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       208
       +
           { list_changed; unknown }

     

       209
       +
       

     

       210
       +
         let jsont : t Jsont.t =

     

       211
       +
           let make list_changed unknown = { list_changed; unknown } in

     

       212
       +
           Jsont.Object.map ~kind:"Tools" make

     

       213
       +
           |> Jsont.Object.opt_mem "listChanged" Jsont.bool ~enc:(fun t -> t.list_changed)

     

       214
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun t -> t.unknown)

     

       215
       +
           |> Jsont.Object.finish

     

       216
       +
       end

     

       217
       +
       

     

       218
       +
       module Completions = struct

     

       219
       +
         type t = {

     

       220
       +
           unknown : Jsont.json;

     

       221
       +
         }

     

       222
       +
       

     

       223
       +
         let empty =

     

       224
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       225
       +
           { unknown }

     

       226
       +
       

     

       227
       +
         let jsont : t Jsont.t =

     

       228
       +
           let make unknown = { unknown } in

     

       229
       +
           Jsont.Object.map ~kind:"Completions" make

     

       230
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun c -> c.unknown)

     

       231
       +
           |> Jsont.Object.finish

     

       232
       +
       end

     

       233
       +
       

     

       234
       +
       module Server = struct

     

       235
       +
         type t = {

     

       236
       +
           logging : Logging.t option;

     

       237
       +
           prompts : Prompts.t option;

     

       238
       +
           resources : Resources.t option;

     

       239
       +
           tools : Tools.t option;

     

       240
       +
           completions : Completions.t option;

     

       241
       +
           experimental : Jsont.json option;

     

       242
       +
           unknown : Jsont.json;

     

       243
       +
         }

     

       244
       +
       

     

       245
       +
         let empty =

     

       246
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       247
       +
           {

     

       248
       +
             logging = None;

     

       249
       +
             prompts = None;

     

       250
       +
             resources = None;

     

       251
       +
             tools = None;

     

       252
       +
             completions = None;

     

       253
       +
             experimental = None;

     

       254
       +
             unknown;

     

       255
       +
           }

     

       256
       +
       

     

       257
       +
         let make ?logging ?prompts ?resources ?tools ?completions ?experimental () =

     

       258
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       259
       +
           { logging; prompts; resources; tools; completions; experimental; unknown }

     

       260
       +
       

     

       261
       +
         let jsont : t Jsont.t =

     

       262
       +
           let make logging prompts resources tools completions experimental unknown =

     

       263
       +
             { logging; prompts; resources; tools; completions; experimental; unknown }

     

       264
       +
           in

     

       265
       +
           Jsont.Object.map ~kind:"ServerCapabilities" make

     

       266
       +
           |> Jsont.Object.opt_mem "logging" Logging.jsont ~enc:(fun s -> s.logging)

     

       267
       +
           |> Jsont.Object.opt_mem "prompts" Prompts.jsont ~enc:(fun s -> s.prompts)

     

       268
       +
           |> Jsont.Object.opt_mem "resources" Resources.jsont ~enc:(fun s -> s.resources)

     

       269
       +
           |> Jsont.Object.opt_mem "tools" Tools.jsont ~enc:(fun s -> s.tools)

     

       270
       +
           |> Jsont.Object.opt_mem "completions" Completions.jsont ~enc:(fun s -> s.completions)

     

       271
       +
           |> Jsont.Object.opt_mem "experimental" Jsont.json ~enc:(fun s -> s.experimental)

     

       272
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun s -> s.unknown)

     

       273
       +
           |> Jsont.Object.finish

     

       274
       +
       

     

       275
       +
         let pp fmt s =

     

       276
       +
           let caps = [

     

       277
       +
             (match s.logging with Some _ -> Some "logging" | None -> None);

     

       278
       +
             (match s.prompts with Some _ -> Some "prompts" | None -> None);

     

       279
       +
             (match s.resources with Some _ -> Some "resources" | None -> None);

     

       280
       +
             (match s.tools with Some _ -> Some "tools" | None -> None);

     

       281
       +
             (match s.completions with Some _ -> Some "completions" | None -> None);

     

       282
       +
           ] |> List.filter_map Fun.id in

     

       283
       +
           Format.fprintf fmt "[%s]" (String.concat ", " caps)

     

       284
       +
       end

+161

claudeio/lib_mcp/capabilities.mli

···

       1
       +
       (** MCP Capability negotiation types.

     

       2
       +
       

     

       3
       +
           Capabilities are exchanged during initialization to determine what features

     

       4
       +
           the client and server support. *)

     

       5
       +
       

     

       6
       +
       (** {1 Implementation Info} *)

     

       7
       +
       

     

       8
       +
       module Implementation : sig

     

       9
       +
         type t = {

     

       10
       +
           name : string;

     

       11
       +
           version : string;

     

       12
       +
           unknown : Jsont.json;

     

       13
       +
         }

     

       14
       +
         (** Information about client or server implementation *)

     

       15
       +
       

     

       16
       +
         val make : name:string -> version:string -> t

     

       17
       +
         val jsont : t Jsont.t

     

       18
       +
         val pp : Format.formatter -> t -> unit

     

       19
       +
       end

     

       20
       +
       

     

       21
       +
       (** {1 Client Capabilities} *)

     

       22
       +
       

     

       23
       +
       module Sampling : sig

     

       24
       +
         type t = {

     

       25
       +
           context : bool option;

     

       26
       +
           tools : bool option;

     

       27
       +
           unknown : Jsont.json;

     

       28
       +
         }

     

       29
       +
         (** Sampling capability (for servers to request LLM sampling from clients) *)

     

       30
       +
       

     

       31
       +
         val empty : t

     

       32
       +
         val make : ?context:bool -> ?tools:bool -> unit -> t

     

       33
       +
         val jsont : t Jsont.t

     

       34
       +
       end

     

       35
       +
       

     

       36
       +
       module Elicitation : sig

     

       37
       +
         type t = {

     

       38
       +
           unknown : Jsont.json;

     

       39
       +
         }

     

       40
       +
         (** Elicitation capability (for servers to request user input) *)

     

       41
       +
       

     

       42
       +
         val empty : t

     

       43
       +
         val jsont : t Jsont.t

     

       44
       +
       end

     

       45
       +
       

     

       46
       +
       module Roots : sig

     

       47
       +
         type t = {

     

       48
       +
           list_changed : bool option;

     

       49
       +
           unknown : Jsont.json;

     

       50
       +
         }

     

       51
       +
         (** Roots capability (for servers to query filesystem roots) *)

     

       52
       +
       

     

       53
       +
         val empty : t

     

       54
       +
         val make : ?list_changed:bool -> unit -> t

     

       55
       +
         val jsont : t Jsont.t

     

       56
       +
       end

     

       57
       +
       

     

       58
       +
       module Client : sig

     

       59
       +
         type t = {

     

       60
       +
           sampling : Sampling.t option;

     

       61
       +
           elicitation : Elicitation.t option;

     

       62
       +
           roots : Roots.t option;

     

       63
       +
           experimental : Jsont.json option;

     

       64
       +
           unknown : Jsont.json;

     

       65
       +
         }

     

       66
       +
         (** Client capabilities advertised during initialization *)

     

       67
       +
       

     

       68
       +
         val empty : t

     

       69
       +
         val make :

     

       70
       +
           ?sampling:Sampling.t ->

     

       71
       +
           ?elicitation:Elicitation.t ->

     

       72
       +
           ?roots:Roots.t ->

     

       73
       +
           ?experimental:Jsont.json ->

     

       74
       +
           unit -> t

     

       75
       +
         val jsont : t Jsont.t

     

       76
       +
         val pp : Format.formatter -> t -> unit

     

       77
       +
       end

     

       78
       +
       

     

       79
       +
       (** {1 Server Capabilities} *)

     

       80
       +
       

     

       81
       +
       module Logging : sig

     

       82
       +
         type t = {

     

       83
       +
           unknown : Jsont.json;

     

       84
       +
         }

     

       85
       +
         (** Logging capability *)

     

       86
       +
       

     

       87
       +
         val empty : t

     

       88
       +
         val jsont : t Jsont.t

     

       89
       +
       end

     

       90
       +
       

     

       91
       +
       module Prompts : sig

     

       92
       +
         type t = {

     

       93
       +
           list_changed : bool option;

     

       94
       +
           unknown : Jsont.json;

     

       95
       +
         }

     

       96
       +
         (** Prompts capability *)

     

       97
       +
       

     

       98
       +
         val empty : t

     

       99
       +
         val make : ?list_changed:bool -> unit -> t

     

       100
       +
         val jsont : t Jsont.t

     

       101
       +
       end

     

       102
       +
       

     

       103
       +
       module Resources : sig

     

       104
       +
         type t = {

     

       105
       +
           subscribe : bool option;

     

       106
       +
           list_changed : bool option;

     

       107
       +
           unknown : Jsont.json;

     

       108
       +
         }

     

       109
       +
         (** Resources capability *)

     

       110
       +
       

     

       111
       +
         val empty : t

     

       112
       +
         val make : ?subscribe:bool -> ?list_changed:bool -> unit -> t

     

       113
       +
         val jsont : t Jsont.t

     

       114
       +
       end

     

       115
       +
       

     

       116
       +
       module Tools : sig

     

       117
       +
         type t = {

     

       118
       +
           list_changed : bool option;

     

       119
       +
           unknown : Jsont.json;

     

       120
       +
         }

     

       121
       +
         (** Tools capability *)

     

       122
       +
       

     

       123
       +
         val empty : t

     

       124
       +
         val make : ?list_changed:bool -> unit -> t

     

       125
       +
         val jsont : t Jsont.t

     

       126
       +
       end

     

       127
       +
       

     

       128
       +
       module Completions : sig

     

       129
       +
         type t = {

     

       130
       +
           unknown : Jsont.json;

     

       131
       +
         }

     

       132
       +
         (** Completions capability (for auto-complete) *)

     

       133
       +
       

     

       134
       +
         val empty : t

     

       135
       +
         val jsont : t Jsont.t

     

       136
       +
       end

     

       137
       +
       

     

       138
       +
       module Server : sig

     

       139
       +
         type t = {

     

       140
       +
           logging : Logging.t option;

     

       141
       +
           prompts : Prompts.t option;

     

       142
       +
           resources : Resources.t option;

     

       143
       +
           tools : Tools.t option;

     

       144
       +
           completions : Completions.t option;

     

       145
       +
           experimental : Jsont.json option;

     

       146
       +
           unknown : Jsont.json;

     

       147
       +
         }

     

       148
       +
         (** Server capabilities advertised during initialization *)

     

       149
       +
       

     

       150
       +
         val empty : t

     

       151
       +
         val make :

     

       152
       +
           ?logging:Logging.t ->

     

       153
       +
           ?prompts:Prompts.t ->

     

       154
       +
           ?resources:Resources.t ->

     

       155
       +
           ?tools:Tools.t ->

     

       156
       +
           ?completions:Completions.t ->

     

       157
       +
           ?experimental:Jsont.json ->

     

       158
       +
           unit -> t

     

       159
       +
         val jsont : t Jsont.t

     

       160
       +
         val pp : Format.formatter -> t -> unit

     

       161
       +
       end

+356

claudeio/lib_mcp/client_session.ml

···

       1
       +
       (** High-level MCP client session implementation *)

     

       2
       +
       

     

       3
       +
       (** {1 Configuration} *)

     

       4
       +
       

     

       5
       +
       type config = {

     

       6
       +
         client_info : Capabilities.Implementation.t;

     

       7
       +
         client_capabilities : Capabilities.Client.t;

     

       8
       +
       }

     

       9
       +
       

     

       10
       +
       (** {1 Internal State} *)

     

       11
       +
       

     

       12
       +
       exception Initialization_error of string

     

       13
       +
       

     

       14
       +
       type notification_handlers = {

     

       15
       +
         mutable on_resource_updated : (uri:string -> unit) option;

     

       16
       +
         mutable on_resource_list_changed : (unit -> unit) option;

     

       17
       +
         mutable on_tool_list_changed : (unit -> unit) option;

     

       18
       +
         mutable on_prompt_list_changed : (unit -> unit) option;

     

       19
       +
         mutable on_log_message : (level:Messages.Logging.level -> logger:string option -> data:Jsont.json -> unit) option;

     

       20
       +
       }

     

       21
       +
       

     

       22
       +
       type t = {

     

       23
       +
         session : Session.t;

     

       24
       +
         server_capabilities : Capabilities.Server.t;

     

       25
       +
         server_info : Capabilities.Implementation.t;

     

       26
       +
         server_instructions : string option;

     

       27
       +
         handlers : notification_handlers;

     

       28
       +
       }

     

       29
       +
       

     

       30
       +
       (** {1 Helper Functions} *)

     

       31
       +
       

     

       32
       +
       (* Encode a value to JSON using jsont codec *)

     

       33
       +
       let encode codec value =

     

       34
       +
         match Jsont.Json.encode codec value with

     

       35
       +
         | Ok json -> json

     

       36
       +
         | Error msg -> failwith ("Failed to encode: " ^ msg)

     

       37
       +
       

     

       38
       +
       (* Decode a JSON value using jsont codec *)

     

       39
       +
       let decode codec json =

     

       40
       +
         match Jsont.Json.decode codec json with

     

       41
       +
         | Ok value -> value

     

       42
       +
         | Error msg -> failwith ("Failed to decode: " ^ msg)

     

       43
       +
       

     

       44
       +
       (* Parse notification parameters - returns None if params is None or null *)

     

       45
       +
       let parse_notification_params codec params_opt =

     

       46
       +
         match params_opt with

     

       47
       +
         | None -> None

     

       48
       +
         | Some (Jsont.Null _) -> None

     

       49
       +
         | Some json -> Some (decode codec json)

     

       50
       +
       

     

       51
       +
       (** {1 Notification Routing} *)

     

       52
       +
       

     

       53
       +
       let create_notification_handler handlers : Session.notification_handler =

     

       54
       +
         fun ~method_ ~params ->

     

       55
       +
           match method_ with

     

       56
       +
           | "notifications/resources/updated" ->

     

       57
       +
               (match handlers.on_resource_updated with

     

       58
       +
               | None -> ()

     

       59
       +
               | Some handler ->

     

       60
       +
                   let notif = parse_notification_params

     

       61
       +
                     Messages.Resources.updated_notification_jsont params in

     

       62
       +
                   (match notif with

     

       63
       +
                   | None -> ()

     

       64
       +
                   | Some n -> handler ~uri:n.Messages.Resources.uri))

     

       65
       +
       

     

       66
       +
           | "notifications/resources/list_changed" ->

     

       67
       +
               (match handlers.on_resource_list_changed with

     

       68
       +
               | None -> ()

     

       69
       +
               | Some handler -> handler ())

     

       70
       +
       

     

       71
       +
           | "notifications/tools/list_changed" ->

     

       72
       +
               (match handlers.on_tool_list_changed with

     

       73
       +
               | None -> ()

     

       74
       +
               | Some handler -> handler ())

     

       75
       +
       

     

       76
       +
           | "notifications/prompts/list_changed" ->

     

       77
       +
               (match handlers.on_prompt_list_changed with

     

       78
       +
               | None -> ()

     

       79
       +
               | Some handler -> handler ())

     

       80
       +
       

     

       81
       +
           | "notifications/message" ->

     

       82
       +
               (match handlers.on_log_message with

     

       83
       +
               | None -> ()

     

       84
       +
               | Some handler ->

     

       85
       +
                   let notif = parse_notification_params

     

       86
       +
                     Messages.Logging.notification_jsont params in

     

       87
       +
                   (match notif with

     

       88
       +
                   | None -> ()

     

       89
       +
                   | Some n ->

     

       90
       +
                       let data = match n.Messages.Logging.data with

     

       91
       +
                         | None -> Jsont.Null ((), Jsont.Meta.none)

     

       92
       +
                         | Some d -> d

     

       93
       +
                       in

     

       94
       +
                       handler

     

       95
       +
                         ~level:n.Messages.Logging.level

     

       96
       +
                         ~logger:n.Messages.Logging.logger

     

       97
       +
                         ~data))

     

       98
       +
       

     

       99
       +
           | _ ->

     

       100
       +
               (* Unknown notification - ignore *)

     

       101
       +
               ()

     

       102
       +
       

     

       103
       +
       (** {1 Request Handler} *)

     

       104
       +
       

     

       105
       +
       (* Client doesn't expect to receive requests from server in most cases *)

     

       106
       +
       let create_request_handler () : Session.request_handler =

     

       107
       +
         fun ~method_ ~params:_ ->

     

       108
       +
           (* Default: return method not found error *)

     

       109
       +
           let error = Jsonrpc.Error_data.make

     

       110
       +
             ~code:Method_not_found

     

       111
       +
             ~message:(Printf.sprintf "Client does not handle method: %s" method_)

     

       112
       +
             ()

     

       113
       +
           in

     

       114
       +
           raise (Session.Remote_error error)

     

       115
       +
       

     

       116
       +
       (** {1 Initialization} *)

     

       117
       +
       

     

       118
       +
       let perform_initialization session config =

     

       119
       +
         (* Send Initialize request *)

     

       120
       +
         let init_params = Messages.Initialize.make_request_params

     

       121
       +
           ~protocol_version:"2024-11-05"

     

       122
       +
           ~capabilities:config.client_capabilities

     

       123
       +
           ~client_info:config.client_info

     

       124
       +
           ()

     

       125
       +
         in

     

       126
       +
         let params_json = encode Messages.Initialize.request_params_jsont init_params in

     

       127
       +
       

     

       128
       +
         let response_json = Session.send_request session

     

       129
       +
           ~method_:Messages.Initialize.method_

     

       130
       +
           ~params:params_json

     

       131
       +
           ()

     

       132
       +
         in

     

       133
       +
       

     

       134
       +
         (* Decode Initialize result *)

     

       135
       +
         let init_result = decode Messages.Initialize.result_jsont response_json in

     

       136
       +
       

     

       137
       +
         (* Send Initialized notification *)

     

       138
       +
         let initialized_notif = Messages.Initialized.make_notification () in

     

       139
       +
         let notif_json = encode Messages.Initialized.notification_jsont initialized_notif in

     

       140
       +
         Session.send_notification session

     

       141
       +
           ~method_:Messages.Initialized.method_

     

       142
       +
           ~params:notif_json

     

       143
       +
           ();

     

       144
       +
       

     

       145
       +
         (* Return server info *)

     

       146
       +
         (init_result.Messages.Initialize.capabilities,

     

       147
       +
          init_result.Messages.Initialize.server_info,

     

       148
       +
          init_result.Messages.Initialize.instructions)

     

       149
       +
       

     

       150
       +
       (** {1 Public API} *)

     

       151
       +
       

     

       152
       +
       let create ~sw ~transport ?timeout ?clock config =

     

       153
       +
         (* Create notification handlers *)

     

       154
       +
         let handlers = {

     

       155
       +
           on_resource_updated = None;

     

       156
       +
           on_resource_list_changed = None;

     

       157
       +
           on_tool_list_changed = None;

     

       158
       +
           on_prompt_list_changed = None;

     

       159
       +
           on_log_message = None;

     

       160
       +
         } in

     

       161
       +
       

     

       162
       +
         (* Create session config *)

     

       163
       +
         let session_config : Session.config = {

     

       164
       +
           transport;

     

       165
       +
           request_handler = create_request_handler ();

     

       166
       +
           notification_handler = create_notification_handler handlers;

     

       167
       +
           timeout;

     

       168
       +
           clock;

     

       169
       +
         } in

     

       170
       +
       

     

       171
       +
         (* Create underlying session *)

     

       172
       +
         let session = Session.create ~sw session_config in

     

       173
       +
       

     

       174
       +
         try

     

       175
       +
           (* Perform initialization handshake *)

     

       176
       +
           let (server_capabilities, server_info, server_instructions) =

     

       177
       +
             perform_initialization session config

     

       178
       +
           in

     

       179
       +
       

     

       180
       +
           (* Return client session *)

     

       181
       +
           {

     

       182
       +
             session;

     

       183
       +
             server_capabilities;

     

       184
       +
             server_info;

     

       185
       +
             server_instructions;

     

       186
       +
             handlers;

     

       187
       +
           }

     

       188
       +
         with

     

       189
       +
         | Session.Remote_error err ->

     

       190
       +
             Session.close session;

     

       191
       +
             raise (Initialization_error

     

       192
       +
               (Printf.sprintf "Server returned error: %s" err.Jsonrpc.Error_data.message))

     

       193
       +
         | Session.Timeout msg ->

     

       194
       +
             Session.close session;

     

       195
       +
             raise (Initialization_error ("Initialization timeout: " ^ msg))

     

       196
       +
         | exn ->

     

       197
       +
             Session.close session;

     

       198
       +
             raise (Initialization_error

     

       199
       +
               (Printf.sprintf "Initialization failed: %s" (Printexc.to_string exn)))

     

       200
       +
       

     

       201
       +
       (** {1 Server Information} *)

     

       202
       +
       

     

       203
       +
       let server_capabilities t = t.server_capabilities

     

       204
       +
       let server_info t = t.server_info

     

       205
       +
       let server_instructions t = t.server_instructions

     

       206
       +
       

     

       207
       +
       (** {1 Basic Operations} *)

     

       208
       +
       

     

       209
       +
       let ping t =

     

       210
       +
         let params = Messages.Ping.make_params () in

     

       211
       +
         let params_json = encode Messages.Ping.params_jsont params in

     

       212
       +
         let response_json = Session.send_request t.session

     

       213
       +
           ~method_:Messages.Ping.method_

     

       214
       +
           ~params:params_json

     

       215
       +
           ()

     

       216
       +
         in

     

       217
       +
         let _result = decode Messages.Ping.result_jsont response_json in

     

       218
       +
         ()

     

       219
       +
       

     

       220
       +
       (** {1 Resources} *)

     

       221
       +
       

     

       222
       +
       let list_resources t ?cursor () =

     

       223
       +
         let request = Messages.Resources.make_list_request ?cursor () in

     

       224
       +
         let params_json = encode Messages.Resources.list_request_jsont request in

     

       225
       +
         let response_json = Session.send_request t.session

     

       226
       +
           ~method_:Messages.Resources.list_method

     

       227
       +
           ~params:params_json

     

       228
       +
           ()

     

       229
       +
         in

     

       230
       +
         decode Messages.Resources.list_result_jsont response_json

     

       231
       +
       

     

       232
       +
       let read_resource t ~uri =

     

       233
       +
         let request = Messages.Resources.make_read_request ~uri in

     

       234
       +
         let params_json = encode Messages.Resources.read_request_jsont request in

     

       235
       +
         let response_json = Session.send_request t.session

     

       236
       +
           ~method_:Messages.Resources.read_method

     

       237
       +
           ~params:params_json

     

       238
       +
           ()

     

       239
       +
         in

     

       240
       +
         decode Messages.Resources.read_result_jsont response_json

     

       241
       +
       

     

       242
       +
       let subscribe_resource t ~uri =

     

       243
       +
         let request = Messages.Resources.make_subscribe_request ~uri in

     

       244
       +
         let params_json = encode Messages.Resources.subscribe_request_jsont request in

     

       245
       +
         let _response_json = Session.send_request t.session

     

       246
       +
           ~method_:Messages.Resources.subscribe_method

     

       247
       +
           ~params:params_json

     

       248
       +
           ()

     

       249
       +
         in

     

       250
       +
         ()

     

       251
       +
       

     

       252
       +
       let unsubscribe_resource t ~uri =

     

       253
       +
         let request = Messages.Resources.make_unsubscribe_request ~uri in

     

       254
       +
         let params_json = encode Messages.Resources.unsubscribe_request_jsont request in

     

       255
       +
         let _response_json = Session.send_request t.session

     

       256
       +
           ~method_:Messages.Resources.unsubscribe_method

     

       257
       +
           ~params:params_json

     

       258
       +
           ()

     

       259
       +
         in

     

       260
       +
         ()

     

       261
       +
       

     

       262
       +
       (** {1 Tools} *)

     

       263
       +
       

     

       264
       +
       let list_tools t ?cursor () =

     

       265
       +
         let request = Messages.Tools.make_list_request ?cursor () in

     

       266
       +
         let params_json = encode Messages.Tools.list_request_jsont request in

     

       267
       +
         let response_json = Session.send_request t.session

     

       268
       +
           ~method_:Messages.Tools.list_method

     

       269
       +
           ~params:params_json

     

       270
       +
           ()

     

       271
       +
         in

     

       272
       +
         decode Messages.Tools.list_result_jsont response_json

     

       273
       +
       

     

       274
       +
       let call_tool t ~name ?arguments () =

     

       275
       +
         let request = Messages.Tools.make_call_request ~name ?arguments () in

     

       276
       +
         let params_json = encode Messages.Tools.call_request_jsont request in

     

       277
       +
         let response_json = Session.send_request t.session

     

       278
       +
           ~method_:Messages.Tools.call_method

     

       279
       +
           ~params:params_json

     

       280
       +
           ()

     

       281
       +
         in

     

       282
       +
         decode Messages.Tools.call_result_jsont response_json

     

       283
       +
       

     

       284
       +
       (** {1 Prompts} *)

     

       285
       +
       

     

       286
       +
       let list_prompts t ?cursor () =

     

       287
       +
         let request = Messages.Prompts.make_list_request ?cursor () in

     

       288
       +
         let params_json = encode Messages.Prompts.list_request_jsont request in

     

       289
       +
         let response_json = Session.send_request t.session

     

       290
       +
           ~method_:Messages.Prompts.list_method

     

       291
       +
           ~params:params_json

     

       292
       +
           ()

     

       293
       +
         in

     

       294
       +
         decode Messages.Prompts.list_result_jsont response_json

     

       295
       +
       

     

       296
       +
       let get_prompt t ~name ?arguments () =

     

       297
       +
         let request = Messages.Prompts.make_get_request ~name ?arguments () in

     

       298
       +
         let params_json = encode Messages.Prompts.get_request_jsont request in

     

       299
       +
         let response_json = Session.send_request t.session

     

       300
       +
           ~method_:Messages.Prompts.get_method

     

       301
       +
           ~params:params_json

     

       302
       +
           ()

     

       303
       +
         in

     

       304
       +
         decode Messages.Prompts.get_result_jsont response_json

     

       305
       +
       

     

       306
       +
       (** {1 Completions} *)

     

       307
       +
       

     

       308
       +
       let complete t ~ref ~argument =

     

       309
       +
         let request = Messages.Completions.make_request ~ref_:ref ~argument () in

     

       310
       +
         let params_json = encode Messages.Completions.request_jsont request in

     

       311
       +
         let response_json = Session.send_request t.session

     

       312
       +
           ~method_:Messages.Completions.method_

     

       313
       +
           ~params:params_json

     

       314
       +
           ()

     

       315
       +
         in

     

       316
       +
         decode Messages.Completions.result_jsont response_json

     

       317
       +
       

     

       318
       +
       (** {1 Logging} *)

     

       319
       +
       

     

       320
       +
       let set_log_level t level =

     

       321
       +
         (* Create a simple request with level parameter *)

     

       322
       +
         let level_json = encode Messages.Logging.level_jsont level in

     

       323
       +
         let params = Jsont.Object ([

     

       324
       +
           (("level", Jsont.Meta.none), level_json)

     

       325
       +
         ], Jsont.Meta.none) in

     

       326
       +
         let _response_json = Session.send_request t.session

     

       327
       +
           ~method_:"logging/setLevel"

     

       328
       +
           ~params

     

       329
       +
           ()

     

       330
       +
         in

     

       331
       +
         ()

     

       332
       +
       

     

       333
       +
       (** {1 Notification Handlers} *)

     

       334
       +
       

     

       335
       +
       let on_resource_updated t handler =

     

       336
       +
         t.handlers.on_resource_updated <- Some handler

     

       337
       +
       

     

       338
       +
       let on_resource_list_changed t handler =

     

       339
       +
         t.handlers.on_resource_list_changed <- Some handler

     

       340
       +
       

     

       341
       +
       let on_tool_list_changed t handler =

     

       342
       +
         t.handlers.on_tool_list_changed <- Some handler

     

       343
       +
       

     

       344
       +
       let on_prompt_list_changed t handler =

     

       345
       +
         t.handlers.on_prompt_list_changed <- Some handler

     

       346
       +
       

     

       347
       +
       let on_log_message t handler =

     

       348
       +
         t.handlers.on_log_message <- Some handler

     

       349
       +
       

     

       350
       +
       (** {1 Session Control} *)

     

       351
       +
       

     

       352
       +
       let close t =

     

       353
       +
         Session.close t.session

     

       354
       +
       

     

       355
       +
       let is_closed t =

     

       356
       +
         Session.is_closed t.session

+217

claudeio/lib_mcp/client_session.mli

···

       1
       +
       (** High-level MCP client session API.

     

       2
       +
       

     

       3
       +
           This module provides a high-level client API for connecting to MCP servers.

     

       4
       +
           It handles the initialization handshake, capability negotiation, and provides

     

       5
       +
           typed methods for all MCP protocol operations.

     

       6
       +
       

     

       7
       +
           {1 Example Usage}

     

       8
       +
       

     

       9
       +
           {[

     

       10
       +
             Eio_main.run @@ fun env ->

     

       11
       +
             Eio.Switch.run @@ fun sw ->

     

       12
       +
               let transport = Transport_stdio.create ~sw (module Eio.Stdenv : Eio.Stdenv.S with type t = _) env in

     

       13
       +
       

     

       14
       +
               let config = {

     

       15
       +
                 client_info = Capabilities.Implementation.make

     

       16
       +
                   ~name:"my-client"

     

       17
       +
                   ~version:"1.0.0";

     

       18
       +
                 client_capabilities = Capabilities.Client.make

     

       19
       +
                   ~roots:(Capabilities.Roots.make ~list_changed:true ())

     

       20
       +
                   ();

     

       21
       +
               } in

     

       22
       +
       

     

       23
       +
               let client = Client_session.create ~sw ~transport config in

     

       24
       +
       

     

       25
       +
               (* List available tools *)

     

       26
       +
               let tools_result = Client_session.list_tools client () in

     

       27
       +
               List.iter (fun tool ->

     

       28
       +
                 Printf.printf "Tool: %s\n" tool.Messages.Tools.name

     

       29
       +
               ) tools_result.Messages.Tools.tools;

     

       30
       +
       

     

       31
       +
               (* Call a tool *)

     

       32
       +
               let args = `Object [("query", `String "hello")] in

     

       33
       +
               let result = Client_session.call_tool client

     

       34
       +
                 ~name:"search"

     

       35
       +
                 ~arguments:args

     

       36
       +
                 ()

     

       37
       +
               in

     

       38
       +
       

     

       39
       +
               Client_session.close client

     

       40
       +
           ]} *)

     

       41
       +
       

     

       42
       +
       (** {1 Configuration} *)

     

       43
       +
       

     

       44
       +
       type config = {

     

       45
       +
         client_info : Capabilities.Implementation.t;

     

       46
       +
         (** Client implementation information (name and version) *)

     

       47
       +
         client_capabilities : Capabilities.Client.t;

     

       48
       +
         (** Client capabilities to advertise to server *)

     

       49
       +
       }

     

       50
       +
       (** Client session configuration *)

     

       51
       +
       

     

       52
       +
       (** {1 Session Management} *)

     

       53
       +
       

     

       54
       +
       type t

     

       55
       +
       (** Client session handle *)

     

       56
       +
       

     

       57
       +
       exception Initialization_error of string

     

       58
       +
       (** Raised when initialization handshake fails *)

     

       59
       +
       

     

       60
       +
       val create :

     

       61
       +
         sw:Eio.Switch.t ->

     

       62
       +
         transport:Transport.t ->

     

       63
       +
         ?timeout:float ->

     

       64
       +
         ?clock:Session.clock ->

     

       65
       +
         config ->

     

       66
       +
         t

     

       67
       +
       (** Create a client session and perform the initialization handshake.

     

       68
       +
       

     

       69
       +
           This sends an Initialize request to the server, stores the server's

     

       70
       +
           capabilities and info, then sends an Initialized notification.

     

       71
       +
       

     

       72
       +
           @param sw Switch for background fibers

     

       73
       +
           @param transport Transport layer for communication

     

       74
       +
           @param timeout Optional request timeout in seconds

     

       75
       +
           @param clock Clock for timeout handling (required if timeout is set)

     

       76
       +
           @param config Client configuration

     

       77
       +
           @raise Initialization_error if the handshake fails

     

       78
       +
           @raise Session.Remote_error if the server returns an error

     

       79
       +
           @raise Session.Timeout if the initialize request times out *)

     

       80
       +
       

     

       81
       +
       (** {1 Server Information} *)

     

       82
       +
       

     

       83
       +
       val server_capabilities : t -> Capabilities.Server.t

     

       84
       +
       (** Get the server's advertised capabilities from initialization *)

     

       85
       +
       

     

       86
       +
       val server_info : t -> Capabilities.Implementation.t

     

       87
       +
       (** Get the server's implementation info (name and version) *)

     

       88
       +
       

     

       89
       +
       val server_instructions : t -> string option

     

       90
       +
       (** Get optional server instructions from initialization *)

     

       91
       +
       

     

       92
       +
       (** {1 Basic Operations} *)

     

       93
       +
       

     

       94
       +
       val ping : t -> unit

     

       95
       +
       (** Send a ping request to the server (keepalive).

     

       96
       +
           @raise Session.Remote_error if the server returns an error

     

       97
       +
           @raise Session.Timeout if the request times out

     

       98
       +
           @raise Session.Session_closed if the session is closed *)

     

       99
       +
       

     

       100
       +
       (** {1 Resources} *)

     

       101
       +
       

     

       102
       +
       val list_resources : t -> ?cursor:string -> unit -> Messages.Resources.list_result

     

       103
       +
       (** List available resources.

     

       104
       +
           @param cursor Optional pagination cursor

     

       105
       +
           @raise Session.Remote_error if the server returns an error

     

       106
       +
           @raise Session.Timeout if the request times out

     

       107
       +
           @raise Session.Session_closed if the session is closed *)

     

       108
       +
       

     

       109
       +
       val read_resource : t -> uri:string -> Messages.Resources.read_result

     

       110
       +
       (** Read resource contents by URI.

     

       111
       +
           @param uri Resource URI to read

     

       112
       +
           @raise Session.Remote_error if the server returns an error

     

       113
       +
           @raise Session.Timeout if the request times out

     

       114
       +
           @raise Session.Session_closed if the session is closed *)

     

       115
       +
       

     

       116
       +
       val subscribe_resource : t -> uri:string -> unit

     

       117
       +
       (** Subscribe to resource update notifications.

     

       118
       +
           @param uri Resource URI to subscribe to

     

       119
       +
           @raise Session.Remote_error if the server returns an error

     

       120
       +
           @raise Session.Timeout if the request times out

     

       121
       +
           @raise Session.Session_closed if the session is closed *)

     

       122
       +
       

     

       123
       +
       val unsubscribe_resource : t -> uri:string -> unit

     

       124
       +
       (** Unsubscribe from resource update notifications.

     

       125
       +
           @param uri Resource URI to unsubscribe from

     

       126
       +
           @raise Session.Remote_error if the server returns an error

     

       127
       +
           @raise Session.Timeout if the request times out

     

       128
       +
           @raise Session.Session_closed if the session is closed *)

     

       129
       +
       

     

       130
       +
       (** {1 Tools} *)

     

       131
       +
       

     

       132
       +
       val list_tools : t -> ?cursor:string -> unit -> Messages.Tools.list_result

     

       133
       +
       (** List available tools.

     

       134
       +
           @param cursor Optional pagination cursor

     

       135
       +
           @raise Session.Remote_error if the server returns an error

     

       136
       +
           @raise Session.Timeout if the request times out

     

       137
       +
           @raise Session.Session_closed if the session is closed *)

     

       138
       +
       

     

       139
       +
       val call_tool : t -> name:string -> ?arguments:Jsont.json -> unit -> Messages.Tools.call_result

     

       140
       +
       (** Call a tool by name.

     

       141
       +
           @param name Tool name

     

       142
       +
           @param arguments Optional tool arguments (JSON object)

     

       143
       +
           @raise Session.Remote_error if the server returns an error

     

       144
       +
           @raise Session.Timeout if the request times out

     

       145
       +
           @raise Session.Session_closed if the session is closed *)

     

       146
       +
       

     

       147
       +
       (** {1 Prompts} *)

     

       148
       +
       

     

       149
       +
       val list_prompts : t -> ?cursor:string -> unit -> Messages.Prompts.list_result

     

       150
       +
       (** List available prompts.

     

       151
       +
           @param cursor Optional pagination cursor

     

       152
       +
           @raise Session.Remote_error if the server returns an error

     

       153
       +
           @raise Session.Timeout if the request times out

     

       154
       +
           @raise Session.Session_closed if the session is closed *)

     

       155
       +
       

     

       156
       +
       val get_prompt : t -> name:string -> ?arguments:(string * string) list -> unit -> Messages.Prompts.get_result

     

       157
       +
       (** Get a prompt by name with optional arguments.

     

       158
       +
           @param name Prompt name

     

       159
       +
           @param arguments Optional key-value pairs for prompt arguments

     

       160
       +
           @raise Session.Remote_error if the server returns an error

     

       161
       +
           @raise Session.Timeout if the request times out

     

       162
       +
           @raise Session.Session_closed if the session is closed *)

     

       163
       +
       

     

       164
       +
       (** {1 Completions} *)

     

       165
       +
       

     

       166
       +
       val complete : t -> ref:Messages.Completions.completion_ref -> argument:string -> Messages.Completions.result

     

       167
       +
       (** Request auto-completion suggestions.

     

       168
       +
           @param ref Completion reference (prompt or resource)

     

       169
       +
           @param argument Argument value to complete

     

       170
       +
           @raise Session.Remote_error if the server returns an error

     

       171
       +
           @raise Session.Timeout if the request times out

     

       172
       +
           @raise Session.Session_closed if the session is closed *)

     

       173
       +
       

     

       174
       +
       (** {1 Logging} *)

     

       175
       +
       

     

       176
       +
       val set_log_level : t -> Messages.Logging.level -> unit

     

       177
       +
       (** Set the server's logging level.

     

       178
       +
           Note: This sends a "logging/setLevel" request.

     

       179
       +
           @param level Desired log level

     

       180
       +
           @raise Session.Remote_error if the server returns an error

     

       181
       +
           @raise Session.Timeout if the request times out

     

       182
       +
           @raise Session.Session_closed if the session is closed *)

     

       183
       +
       

     

       184
       +
       (** {1 Notification Handlers} *)

     

       185
       +
       

     

       186
       +
       val on_resource_updated : t -> (uri:string -> unit) -> unit

     

       187
       +
       (** Register a handler for resource update notifications.

     

       188
       +
           The handler is called when a subscribed resource is updated.

     

       189
       +
           Only one handler can be registered at a time (replaces previous handler). *)

     

       190
       +
       

     

       191
       +
       val on_resource_list_changed : t -> (unit -> unit) -> unit

     

       192
       +
       (** Register a handler for resource list change notifications.

     

       193
       +
           The handler is called when the list of available resources changes.

     

       194
       +
           Only one handler can be registered at a time (replaces previous handler). *)

     

       195
       +
       

     

       196
       +
       val on_tool_list_changed : t -> (unit -> unit) -> unit

     

       197
       +
       (** Register a handler for tool list change notifications.

     

       198
       +
           The handler is called when the list of available tools changes.

     

       199
       +
           Only one handler can be registered at a time (replaces previous handler). *)

     

       200
       +
       

     

       201
       +
       val on_prompt_list_changed : t -> (unit -> unit) -> unit

     

       202
       +
       (** Register a handler for prompt list change notifications.

     

       203
       +
           The handler is called when the list of available prompts changes.

     

       204
       +
           Only one handler can be registered at a time (replaces previous handler). *)

     

       205
       +
       

     

       206
       +
       val on_log_message : t -> (level:Messages.Logging.level -> logger:string option -> data:Jsont.json -> unit) -> unit

     

       207
       +
       (** Register a handler for log message notifications from the server.

     

       208
       +
           Only one handler can be registered at a time (replaces previous handler). *)

     

       209
       +
       

     

       210
       +
       (** {1 Session Control} *)

     

       211
       +
       

     

       212
       +
       val close : t -> unit

     

       213
       +
       (** Close the client session and underlying transport.

     

       214
       +
           This is idempotent - safe to call multiple times. *)

     

       215
       +
       

     

       216
       +
       val is_closed : t -> bool

     

       217
       +
       (** Check if the session is closed. *)

+246

claudeio/lib_mcp/content.ml

···

       1
       +
       (** MCP Content Block types *)

     

       2
       +
       

     

       3
       +
       (* Annotations *)

     

       4
       +
       

     

       5
       +
       module Audience = struct

     

       6
       +
         type t = User | Assistant

     

       7
       +
       

     

       8
       +
         let jsont : t Jsont.t =

     

       9
       +
           Jsont.enum [

     

       10
       +
             "user", User;

     

       11
       +
             "assistant", Assistant;

     

       12
       +
           ]

     

       13
       +
       

     

       14
       +
         let pp fmt = function

     

       15
       +
           | User -> Format.fprintf fmt "user"

     

       16
       +
           | Assistant -> Format.fprintf fmt "assistant"

     

       17
       +
       end

     

       18
       +
       

     

       19
       +
       module Annotations = struct

     

       20
       +
         type t = {

     

       21
       +
           audience : Audience.t list option;

     

       22
       +
           priority : float option;

     

       23
       +
           unknown : Jsont.json;

     

       24
       +
         }

     

       25
       +
       

     

       26
       +
         let empty =

     

       27
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       28
       +
           { audience = None; priority = None; unknown }

     

       29
       +
       

     

       30
       +
         let jsont : t Jsont.t =

     

       31
       +
           let make audience priority unknown = { audience; priority; unknown } in

     

       32
       +
           Jsont.Object.map ~kind:"Annotations" make

     

       33
       +
           |> Jsont.Object.opt_mem "audience" (Jsont.list Audience.jsont)

     

       34
       +
               ~enc:(fun a -> a.audience)

     

       35
       +
           |> Jsont.Object.opt_mem "priority" Jsont.number

     

       36
       +
               ~enc:(fun a -> a.priority)

     

       37
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun a -> a.unknown)

     

       38
       +
           |> Jsont.Object.finish

     

       39
       +
       

     

       40
       +
         let pp fmt _ann =

     

       41
       +
           Format.fprintf fmt "{annotations}"

     

       42
       +
       end

     

       43
       +
       

     

       44
       +
       (* Text Content *)

     

       45
       +
       

     

       46
       +
       module Text = struct

     

       47
       +
         type t = {

     

       48
       +
           text : string;

     

       49
       +
           annotations : Annotations.t option;

     

       50
       +
           unknown : Jsont.json;

     

       51
       +
         }

     

       52
       +
       

     

       53
       +
         let make text =

     

       54
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       55
       +
           { text; annotations = None; unknown }

     

       56
       +
       

     

       57
       +
         let jsont : t Jsont.t =

     

       58
       +
           let make text annotations unknown = { text; annotations; unknown } in

     

       59
       +
           Jsont.Object.map ~kind:"TextContent" make

     

       60
       +
           |> Jsont.Object.mem "text" Jsont.string ~enc:(fun t -> t.text)

     

       61
       +
           |> Jsont.Object.opt_mem "annotations" Annotations.jsont

     

       62
       +
               ~enc:(fun t -> t.annotations)

     

       63
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun t -> t.unknown)

     

       64
       +
           |> Jsont.Object.finish

     

       65
       +
       

     

       66
       +
         let pp fmt t =

     

       67
       +
           Format.fprintf fmt "%S" t.text

     

       68
       +
       end

     

       69
       +
       

     

       70
       +
       (* Image Content *)

     

       71
       +
       

     

       72
       +
       module Image = struct

     

       73
       +
         type t = {

     

       74
       +
           data : string;

     

       75
       +
           mime_type : string;

     

       76
       +
           annotations : Annotations.t option;

     

       77
       +
           unknown : Jsont.json;

     

       78
       +
         }

     

       79
       +
       

     

       80
       +
         let make ~data ~mime_type =

     

       81
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       82
       +
           { data; mime_type; annotations = None; unknown }

     

       83
       +
       

     

       84
       +
         let jsont : t Jsont.t =

     

       85
       +
           let make data mime_type annotations unknown =

     

       86
       +
             { data; mime_type; annotations; unknown }

     

       87
       +
           in

     

       88
       +
           Jsont.Object.map ~kind:"ImageContent" make

     

       89
       +
           |> Jsont.Object.mem "data" Jsont.string ~enc:(fun i -> i.data)

     

       90
       +
           |> Jsont.Object.mem "mimeType" Jsont.string ~enc:(fun i -> i.mime_type)

     

       91
       +
           |> Jsont.Object.opt_mem "annotations" Annotations.jsont

     

       92
       +
               ~enc:(fun i -> i.annotations)

     

       93
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun i -> i.unknown)

     

       94
       +
           |> Jsont.Object.finish

     

       95
       +
       

     

       96
       +
         let pp fmt i =

     

       97
       +
           Format.fprintf fmt "Image(%s, %d bytes)" i.mime_type (String.length i.data)

     

       98
       +
       end

     

       99
       +
       

     

       100
       +
       (* Audio Content *)

     

       101
       +
       

     

       102
       +
       module Audio = struct

     

       103
       +
         type t = {

     

       104
       +
           data : string;

     

       105
       +
           mime_type : string;

     

       106
       +
           annotations : Annotations.t option;

     

       107
       +
           unknown : Jsont.json;

     

       108
       +
         }

     

       109
       +
       

     

       110
       +
         let make ~data ~mime_type =

     

       111
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       112
       +
           { data; mime_type; annotations = None; unknown }

     

       113
       +
       

     

       114
       +
         let jsont : t Jsont.t =

     

       115
       +
           let make data mime_type annotations unknown =

     

       116
       +
             { data; mime_type; annotations; unknown }

     

       117
       +
           in

     

       118
       +
           Jsont.Object.map ~kind:"AudioContent" make

     

       119
       +
           |> Jsont.Object.mem "data" Jsont.string ~enc:(fun a -> a.data)

     

       120
       +
           |> Jsont.Object.mem "mimeType" Jsont.string ~enc:(fun a -> a.mime_type)

     

       121
       +
           |> Jsont.Object.opt_mem "annotations" Annotations.jsont

     

       122
       +
               ~enc:(fun a -> a.annotations)

     

       123
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun a -> a.unknown)

     

       124
       +
           |> Jsont.Object.finish

     

       125
       +
       

     

       126
       +
         let pp fmt a =

     

       127
       +
           Format.fprintf fmt "Audio(%s, %d bytes)" a.mime_type (String.length a.data)

     

       128
       +
       end

     

       129
       +
       

     

       130
       +
       (* Embedded Resource *)

     

       131
       +
       

     

       132
       +
       module Embedded_resource = struct

     

       133
       +
         type resource = {

     

       134
       +
           uri : string;

     

       135
       +
           mime_type : string option;

     

       136
       +
           text : string option;

     

       137
       +
           blob : string option;

     

       138
       +
           unknown : Jsont.json;

     

       139
       +
         }

     

       140
       +
       

     

       141
       +
         let resource_jsont : resource Jsont.t =

     

       142
       +
           let make uri mime_type text blob unknown =

     

       143
       +
             { uri; mime_type; text; blob; unknown }

     

       144
       +
           in

     

       145
       +
           Jsont.Object.map ~kind:"Resource" make

     

       146
       +
           |> Jsont.Object.mem "uri" Jsont.string ~enc:(fun r -> r.uri)

     

       147
       +
           |> Jsont.Object.opt_mem "mimeType" Jsont.string ~enc:(fun r -> r.mime_type)

     

       148
       +
           |> Jsont.Object.opt_mem "text" Jsont.string ~enc:(fun r -> r.text)

     

       149
       +
           |> Jsont.Object.opt_mem "blob" Jsont.string ~enc:(fun r -> r.blob)

     

       150
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun r -> r.unknown)

     

       151
       +
           |> Jsont.Object.finish

     

       152
       +
       

     

       153
       +
         type t = {

     

       154
       +
           resource : resource;

     

       155
       +
           annotations : Annotations.t option;

     

       156
       +
           unknown : Jsont.json;

     

       157
       +
         }

     

       158
       +
       

     

       159
       +
         let make_text ~uri ~text ?mime_type () =

     

       160
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       161
       +
           let resource = {

     

       162
       +
             uri;

     

       163
       +
             mime_type;

     

       164
       +
             text = Some text;

     

       165
       +
             blob = None;

     

       166
       +
             unknown;

     

       167
       +
           } in

     

       168
       +
           { resource; annotations = None; unknown }

     

       169
       +
       

     

       170
       +
         let make_blob ~uri ~blob ~mime_type =

     

       171
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       172
       +
           let resource = {

     

       173
       +
             uri;

     

       174
       +
             mime_type = Some mime_type;

     

       175
       +
             text = None;

     

       176
       +
             blob = Some blob;

     

       177
       +
             unknown;

     

       178
       +
           } in

     

       179
       +
           { resource; annotations = None; unknown }

     

       180
       +
       

     

       181
       +
         let jsont : t Jsont.t =

     

       182
       +
           let make resource annotations unknown =

     

       183
       +
             { resource; annotations; unknown }

     

       184
       +
           in

     

       185
       +
           Jsont.Object.map ~kind:"EmbeddedResource" make

     

       186
       +
           |> Jsont.Object.mem "resource" resource_jsont ~enc:(fun e -> e.resource)

     

       187
       +
           |> Jsont.Object.opt_mem "annotations" Annotations.jsont

     

       188
       +
               ~enc:(fun e -> e.annotations)

     

       189
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun e -> e.unknown)

     

       190
       +
           |> Jsont.Object.finish

     

       191
       +
       

     

       192
       +
         let pp fmt e =

     

       193
       +
           Format.fprintf fmt "Resource(%s)" e.resource.uri

     

       194
       +
       end

     

       195
       +
       

     

       196
       +
       (* Content Block *)

     

       197
       +
       

     

       198
       +
       type block =

     

       199
       +
         | Text of Text.t

     

       200
       +
         | Image of Image.t

     

       201
       +
         | Audio of Audio.t

     

       202
       +
         | Embedded_resource of Embedded_resource.t

     

       203
       +
       

     

       204
       +
       let block_jsont : block Jsont.t =

     

       205
       +
         (* Content blocks use "type" discriminator *)

     

       206
       +
         let case_map kind obj dec = Jsont.Object.Case.map kind obj ~dec in

     

       207
       +
       

     

       208
       +
         let case_text = case_map "text" Text.jsont (fun v -> Text v) in

     

       209
       +
         let case_image = case_map "image" Image.jsont (fun v -> Image v) in

     

       210
       +
         let case_audio = case_map "audio" Audio.jsont (fun v -> Audio v) in

     

       211
       +
         let case_resource = case_map "resource" Embedded_resource.jsont

     

       212
       +
           (fun v -> Embedded_resource v)

     

       213
       +
         in

     

       214
       +
       

     

       215
       +
         let enc_case = function

     

       216
       +
           | Text v -> Jsont.Object.Case.value case_text v

     

       217
       +
           | Image v -> Jsont.Object.Case.value case_image v

     

       218
       +
           | Audio v -> Jsont.Object.Case.value case_audio v

     

       219
       +
           | Embedded_resource v -> Jsont.Object.Case.value case_resource v

     

       220
       +
         in

     

       221
       +
       

     

       222
       +
         let cases = Jsont.Object.Case.[

     

       223
       +
           make case_text;

     

       224
       +
           make case_image;

     

       225
       +
           make case_audio;

     

       226
       +
           make case_resource;

     

       227
       +
         ] in

     

       228
       +
       

     

       229
       +
         Jsont.Object.map ~kind:"ContentBlock" Fun.id

     

       230
       +
         |> Jsont.Object.case_mem "type" Jsont.string ~enc:Fun.id ~enc_case cases

     

       231
       +
             ~tag_to_string:Fun.id ~tag_compare:String.compare

     

       232
       +
         |> Jsont.Object.finish

     

       233
       +
       

     

       234
       +
       let pp_block fmt = function

     

       235
       +
         | Text t -> Text.pp fmt t

     

       236
       +
         | Image i -> Image.pp fmt i

     

       237
       +
         | Audio a -> Audio.pp fmt a

     

       238
       +
         | Embedded_resource e -> Embedded_resource.pp fmt e

     

       239
       +
       

     

       240
       +
       (* Convenience constructors *)

     

       241
       +
       

     

       242
       +
       let text s = Text (Text.make s)

     

       243
       +
       

     

       244
       +
       let image ~data ~mime_type = Image (Image.make ~data ~mime_type)

     

       245
       +
       

     

       246
       +
       let audio ~data ~mime_type = Audio (Audio.make ~data ~mime_type)

+125

claudeio/lib_mcp/content.mli

···

       1
       +
       (** MCP Content Block types.

     

       2
       +
       

     

       3
       +
           Content blocks are the building blocks for tool results, prompts, and resource contents.

     

       4
       +
           They support text, images, audio, embedded resources, and tool use/results. *)

     

       5
       +
       

     

       6
       +
       (** {1 Annotations} *)

     

       7
       +
       

     

       8
       +
       module Audience : sig

     

       9
       +
         type t = User | Assistant

     

       10
       +
         (** Who should see this content *)

     

       11
       +
       

     

       12
       +
         val jsont : t Jsont.t

     

       13
       +
         val pp : Format.formatter -> t -> unit

     

       14
       +
       end

     

       15
       +
       

     

       16
       +
       module Annotations : sig

     

       17
       +
         type t = {

     

       18
       +
           audience : Audience.t list option;

     

       19
       +
           priority : float option;

     

       20
       +
           unknown : Jsont.json;

     

       21
       +
         }

     

       22
       +
         (** Hints about content visibility and importance *)

     

       23
       +
       

     

       24
       +
         val empty : t

     

       25
       +
         val jsont : t Jsont.t

     

       26
       +
         val pp : Format.formatter -> t -> unit

     

       27
       +
       end

     

       28
       +
       

     

       29
       +
       (** {1 Text Content} *)

     

       30
       +
       

     

       31
       +
       module Text : sig

     

       32
       +
         type t = {

     

       33
       +
           text : string;

     

       34
       +
           annotations : Annotations.t option;

     

       35
       +
           unknown : Jsont.json;

     

       36
       +
         }

     

       37
       +
         (** Plain text content *)

     

       38
       +
       

     

       39
       +
         val make : string -> t

     

       40
       +
         val jsont : t Jsont.t

     

       41
       +
         val pp : Format.formatter -> t -> unit

     

       42
       +
       end

     

       43
       +
       

     

       44
       +
       (** {1 Image Content} *)

     

       45
       +
       

     

       46
       +
       module Image : sig

     

       47
       +
         type t = {

     

       48
       +
           data : string;         (** Base64-encoded image data *)

     

       49
       +
           mime_type : string;    (** e.g. "image/png" *)

     

       50
       +
           annotations : Annotations.t option;

     

       51
       +
           unknown : Jsont.json;

     

       52
       +
         }

     

       53
       +
         (** Image content (base64-encoded) *)

     

       54
       +
       

     

       55
       +
         val make : data:string -> mime_type:string -> t

     

       56
       +
         val jsont : t Jsont.t

     

       57
       +
         val pp : Format.formatter -> t -> unit

     

       58
       +
       end

     

       59
       +
       

     

       60
       +
       (** {1 Audio Content} *)

     

       61
       +
       

     

       62
       +
       module Audio : sig

     

       63
       +
         type t = {

     

       64
       +
           data : string;         (** Base64-encoded audio data *)

     

       65
       +
           mime_type : string;    (** e.g. "audio/mp3" *)

     

       66
       +
           annotations : Annotations.t option;

     

       67
       +
           unknown : Jsont.json;

     

       68
       +
         }

     

       69
       +
         (** Audio content (base64-encoded) *)

     

       70
       +
       

     

       71
       +
         val make : data:string -> mime_type:string -> t

     

       72
       +
         val jsont : t Jsont.t

     

       73
       +
         val pp : Format.formatter -> t -> unit

     

       74
       +
       end

     

       75
       +
       

     

       76
       +
       (** {1 Embedded Resource} *)

     

       77
       +
       

     

       78
       +
       module Embedded_resource : sig

     

       79
       +
         type resource = {

     

       80
       +
           uri : string;

     

       81
       +
           mime_type : string option;

     

       82
       +
           text : string option;

     

       83
       +
           blob : string option;  (** Base64-encoded binary data *)

     

       84
       +
           unknown : Jsont.json;

     

       85
       +
         }

     

       86
       +
         (** Resource contents *)

     

       87
       +
       

     

       88
       +
         type t = {

     

       89
       +
           resource : resource;

     

       90
       +
           annotations : Annotations.t option;

     

       91
       +
           unknown : Jsont.json;

     

       92
       +
         }

     

       93
       +
         (** Embedded resource content *)

     

       94
       +
       

     

       95
       +
         val make_text : uri:string -> text:string -> ?mime_type:string -> unit -> t

     

       96
       +
         val make_blob : uri:string -> blob:string -> mime_type:string -> t

     

       97
       +
         val jsont : t Jsont.t

     

       98
       +
         val pp : Format.formatter -> t -> unit

     

       99
       +
       end

     

       100
       +
       

     

       101
       +
       (** {1 Content Block} *)

     

       102
       +
       

     

       103
       +
       type block =

     

       104
       +
         | Text of Text.t

     

       105
       +
         | Image of Image.t

     

       106
       +
         | Audio of Audio.t

     

       107
       +
         | Embedded_resource of Embedded_resource.t

     

       108
       +
       (** Content block variants *)

     

       109
       +
       

     

       110
       +
       val block_jsont : block Jsont.t

     

       111
       +
       (** Codec for content blocks (discriminated by "type" field) *)

     

       112
       +
       

     

       113
       +
       val pp_block : Format.formatter -> block -> unit

     

       114
       +
       (** Pretty-print a content block *)

     

       115
       +
       

     

       116
       +
       (** {1 Convenience Constructors} *)

     

       117
       +
       

     

       118
       +
       val text : string -> block

     

       119
       +
       (** Create a text content block *)

     

       120
       +
       

     

       121
       +
       val image : data:string -> mime_type:string -> block

     

       122
       +
       (** Create an image content block *)

     

       123
       +
       

     

       124
       +
       val audio : data:string -> mime_type:string -> block

     

       125
       +
       (** Create an audio content block *)

claudeio/lib_mcp/dune

···

       1
       +
       (library

     

       2
       +
        (name mcp)

     

       3
       +
        (public_name mcp)

     

       4
       +
        (libraries eio eio.unix fmt logs jsont jsont.bytesrw unix))

+279

claudeio/lib_mcp/jsonrpc.ml

···

       1
       +
       (** JSON-RPC 2.0 protocol implementation *)

     

       2
       +
       

     

       3
       +
       (* Protocol Version *)

     

       4
       +
       

     

       5
       +
       type jsonrpc = [ `V2 ]

     

       6
       +
       

     

       7
       +
       let jsonrpc_jsont = Jsont.enum ["2.0", `V2]

     

       8
       +
       

     

       9
       +
       (* Request/Response Identifiers *)

     

       10
       +
       

     

       11
       +
       module Id = struct

     

       12
       +
         type t = [ `String of string | `Number of float | `Null ]

     

       13
       +
       

     

       14
       +
         let jsont : t Jsont.t =

     

       15
       +
           let null = Jsont.null `Null in

     

       16
       +
           let string =

     

       17
       +
             let dec s = `String s in

     

       18
       +
             let enc = function `String s -> s | _ -> assert false in

     

       19
       +
             Jsont.map ~dec ~enc Jsont.string

     

       20
       +
           in

     

       21
       +
           let number =

     

       22
       +
             let dec n = `Number n in

     

       23
       +
             let enc = function `Number n -> n | _ -> assert false in

     

       24
       +
             Jsont.map ~dec ~enc Jsont.number

     

       25
       +
           in

     

       26
       +
           let enc = function

     

       27
       +
           | `Null -> null | `String _ -> string | `Number _ -> number

     

       28
       +
           in

     

       29
       +
           Jsont.any ~dec_null:null ~dec_string:string ~dec_number:number ~enc ()

     

       30
       +
       

     

       31
       +
         let to_string = function

     

       32
       +
           | `String s -> s

     

       33
       +
           | `Number n -> string_of_float n

     

       34
       +
           | `Null -> "null"

     

       35
       +
       

     

       36
       +
         let compare a b = match a, b with

     

       37
       +
           | `Null, `Null -> 0

     

       38
       +
           | `Null, _ -> -1

     

       39
       +
           | _, `Null -> 1

     

       40
       +
           | `String s1, `String s2 -> String.compare s1 s2

     

       41
       +
           | `String _, _ -> -1

     

       42
       +
           | _, `String _ -> 1

     

       43
       +
           | `Number n1, `Number n2 -> Float.compare n1 n2

     

       44
       +
       

     

       45
       +
         let pp fmt = function

     

       46
       +
           | `String s -> Format.fprintf fmt "%S" s

     

       47
       +
           | `Number n -> Format.fprintf fmt "%g" n

     

       48
       +
           | `Null -> Format.fprintf fmt "null"

     

       49
       +
       end

     

       50
       +
       

     

       51
       +
       (* Error Codes *)

     

       52
       +
       

     

       53
       +
       module Error_code = struct

     

       54
       +
         type t =

     

       55
       +
           | Parse_error

     

       56
       +
           | Invalid_request

     

       57
       +
           | Method_not_found

     

       58
       +
           | Invalid_params

     

       59
       +
           | Internal_error

     

       60
       +
           | Connection_closed

     

       61
       +
           | Server_error of int

     

       62
       +
           | Other of int

     

       63
       +
       

     

       64
       +
         let to_int = function

     

       65
       +
           | Parse_error -> -32700

     

       66
       +
           | Invalid_request -> -32600

     

       67
       +
           | Method_not_found -> -32601

     

       68
       +
           | Invalid_params -> -32602

     

       69
       +
           | Internal_error -> -32603

     

       70
       +
           | Connection_closed -> -32000

     

       71
       +
           | Server_error n -> n

     

       72
       +
           | Other n -> n

     

       73
       +
       

     

       74
       +
         let of_int = function

     

       75
       +
           | -32700 -> Parse_error

     

       76
       +
           | -32600 -> Invalid_request

     

       77
       +
           | -32601 -> Method_not_found

     

       78
       +
           | -32602 -> Invalid_params

     

       79
       +
           | -32603 -> Internal_error

     

       80
       +
           | -32000 -> Connection_closed

     

       81
       +
           | n when n >= -32099 && n <= -32001 -> Server_error n

     

       82
       +
           | n -> Other n

     

       83
       +
       

     

       84
       +
         let jsont : t Jsont.t =

     

       85
       +
           let dec n = of_int n in

     

       86
       +
           let enc code = to_int code in

     

       87
       +
           Jsont.map ~dec ~enc Jsont.int

     

       88
       +
       

     

       89
       +
         let pp fmt code =

     

       90
       +
           Format.fprintf fmt "%d" (to_int code)

     

       91
       +
       end

     

       92
       +
       

     

       93
       +
       (* Error Data *)

     

       94
       +
       

     

       95
       +
       module Error_data = struct

     

       96
       +
         type t = {

     

       97
       +
           code : Error_code.t;

     

       98
       +
           message : string;

     

       99
       +
           data : Jsont.json option;

     

       100
       +
           unknown : Jsont.json;

     

       101
       +
         }

     

       102
       +
       

     

       103
       +
         let make ~code ~message ?data () =

     

       104
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       105
       +
           { code; message; data; unknown }

     

       106
       +
       

     

       107
       +
         let jsont : t Jsont.t =

     

       108
       +
           let make code message data unknown = { code; message; data; unknown } in

     

       109
       +
           Jsont.Object.map ~kind:"ErrorData" make

     

       110
       +
           |> Jsont.Object.mem "code" Error_code.jsont ~enc:(fun e -> e.code)

     

       111
       +
           |> Jsont.Object.mem "message" Jsont.string ~enc:(fun e -> e.message)

     

       112
       +
           |> Jsont.Object.opt_mem "data" Jsont.json ~enc:(fun e -> e.data)

     

       113
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun e -> e.unknown)

     

       114
       +
           |> Jsont.Object.finish

     

       115
       +
       

     

       116
       +
         let pp fmt err =

     

       117
       +
           Format.fprintf fmt "{code=%a, message=%S}" Error_code.pp err.code err.message

     

       118
       +
       end

     

       119
       +
       

     

       120
       +
       (* Params *)

     

       121
       +
       

     

       122
       +
       type params = Jsont.json

     

       123
       +
       

     

       124
       +
       let params_jsont =

     

       125
       +
         let enc = function

     

       126
       +
         | Jsont.Object _ | Jsont.Array _ -> Jsont.json

     

       127
       +
         | j ->

     

       128
       +
             let meta = Jsont.Meta.none in

     

       129
       +
             let fnd = Jsont.Sort.to_string (Jsont.Json.sort j) in

     

       130
       +
             Jsont.Error.expected meta "object or array" ~fnd

     

       131
       +
         in

     

       132
       +
         let kind = "JSON-RPC params" in

     

       133
       +
         Jsont.any ~kind ~dec_array:Jsont.json ~dec_object:Jsont.json ~enc ()

     

       134
       +
       

     

       135
       +
       (* Request Message *)

     

       136
       +
       

     

       137
       +
       module Request = struct

     

       138
       +
         type t = {

     

       139
       +
           jsonrpc : jsonrpc;

     

       140
       +
           method_ : string;

     

       141
       +
           params : params option;

     

       142
       +
           id : Id.t option;

     

       143
       +
           unknown : Jsont.json;

     

       144
       +
         }

     

       145
       +
       

     

       146
       +
         let make ~method_ ?params ?id () =

     

       147
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       148
       +
           { jsonrpc = `V2; method_; params; id; unknown }

     

       149
       +
       

     

       150
       +
         let jsont : t Jsont.t =

     

       151
       +
           let make jsonrpc method_ params id unknown =

     

       152
       +
             { jsonrpc; method_; params; id; unknown }

     

       153
       +
           in

     

       154
       +
           Jsont.Object.map ~kind:"JSONRPCRequest" make

     

       155
       +
           |> Jsont.Object.mem "jsonrpc" jsonrpc_jsont ~enc:(fun r -> r.jsonrpc)

     

       156
       +
           |> Jsont.Object.mem "method" Jsont.string ~enc:(fun r -> r.method_)

     

       157
       +
           |> Jsont.Object.opt_mem "params" params_jsont ~enc:(fun r -> r.params)

     

       158
       +
           |> Jsont.Object.opt_mem "id" Id.jsont ~enc:(fun r -> r.id)

     

       159
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun r -> r.unknown)

     

       160
       +
           |> Jsont.Object.finish

     

       161
       +
       

     

       162
       +
         let pp fmt req =

     

       163
       +
           let id_str = match req.id with

     

       164
       +
             | Some id -> Id.to_string id

     

       165
       +
             | None -> "none"

     

       166
       +
           in

     

       167
       +
           Format.fprintf fmt "{method=%S, id=%s}" req.method_ id_str

     

       168
       +
       end

     

       169
       +
       

     

       170
       +
       (* Response Message *)

     

       171
       +
       

     

       172
       +
       module Response = struct

     

       173
       +
         type t = {

     

       174
       +
           jsonrpc : jsonrpc;

     

       175
       +
           value : (Jsont.json, Error_data.t) result;

     

       176
       +
           id : Id.t;

     

       177
       +
           unknown : Jsont.json;

     

       178
       +
         }

     

       179
       +
       

     

       180
       +
         let make_result ~id ~result =

     

       181
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       182
       +
           { jsonrpc = `V2; value = Ok result; id; unknown }

     

       183
       +
       

     

       184
       +
         let make_error ~id ~error =

     

       185
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       186
       +
           { jsonrpc = `V2; value = Error error; id; unknown }

     

       187
       +
       

     

       188
       +
         let response_result r = match r.value with Ok v -> Some v | Error _ -> None

     

       189
       +
         let response_error r = match r.value with Ok _ -> None | Error e -> Some e

     

       190
       +
       

     

       191
       +
         let response jsonrpc result error id : t =

     

       192
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       193
       +
           let err_both () =

     

       194
       +
             Jsont.Error.msgf Jsont.Meta.none "Both %a and %a members are defined"

     

       195
       +
               Jsont.Repr.pp_code "result" Jsont.Repr.pp_code "error"

     

       196
       +
           in

     

       197
       +
           let err_none () =

     

       198
       +
             Jsont.Error.msgf Jsont.Meta.none "Missing either %a or %a member"

     

       199
       +
               Jsont.Repr.pp_code "result" Jsont.Repr.pp_code "error"

     

       200
       +
           in

     

       201
       +
           match result, error with

     

       202
       +
           | Some result, None -> { jsonrpc; value = Ok result; id; unknown }

     

       203
       +
           | None, Some error -> { jsonrpc; value = Error error; id; unknown }

     

       204
       +
           | Some _ , Some _ -> err_both ()

     

       205
       +
           | None, None -> err_none ()

     

       206
       +
       

     

       207
       +
         let jsont : t Jsont.t =

     

       208
       +
           let make jsonrpc result error id unknown =

     

       209
       +
             let resp = response jsonrpc result error id in

     

       210
       +
             { resp with unknown }

     

       211
       +
           in

     

       212
       +
           Jsont.Object.map ~kind:"JSONRPCResponse" make

     

       213
       +
           |> Jsont.Object.mem "jsonrpc" jsonrpc_jsont ~enc:(fun r -> r.jsonrpc)

     

       214
       +
           |> Jsont.Object.opt_mem "result" Jsont.json ~enc:response_result

     

       215
       +
           |> Jsont.Object.opt_mem "error" Error_data.jsont ~enc:response_error

     

       216
       +
           |> Jsont.Object.mem "id" Id.jsont ~enc:(fun r -> r.id)

     

       217
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun r -> r.unknown)

     

       218
       +
           |> Jsont.Object.finish

     

       219
       +
       

     

       220
       +
         let pp fmt resp =

     

       221
       +
           let result_str = match resp.value with

     

       222
       +
             | Ok _ -> "Ok(...)"

     

       223
       +
             | Error err -> Format.asprintf "Error(%a)" Error_data.pp err

     

       224
       +
           in

     

       225
       +
           Format.fprintf fmt "{id=%a, %s}" Id.pp resp.id result_str

     

       226
       +
       end

     

       227
       +
       

     

       228
       +
       (* Message Union *)

     

       229
       +
       

     

       230
       +
       module Message = struct

     

       231
       +
         type t =

     

       232
       +
           | Request of Request.t

     

       233
       +
           | Response of Response.t

     

       234
       +
       

     

       235
       +
         let classify json =

     

       236
       +
           (* Detect message type by presence of fields:

     

       237
       +
              - "method" -> Request

     

       238
       +
              - "result" or "error" -> Response *)

     

       239
       +
           match json with

     

       240
       +
           | Jsont.Object (members, _) ->

     

       241
       +
               let has_method = List.exists (fun ((name, _), _) -> name = "method") members in

     

       242
       +
               let has_result_or_error =

     

       243
       +
                 List.exists (fun ((name, _), _) ->

     

       244
       +
                   name = "result" || name = "error"

     

       245
       +
                 ) members

     

       246
       +
               in

     

       247
       +
               if has_method then

     

       248
       +
                 match Jsont.Json.decode Request.jsont json with

     

       249
       +
                 | Ok req -> Request req

     

       250
       +
                 | Error msg -> failwith ("Failed to decode request: " ^ msg)

     

       251
       +
               else if has_result_or_error then

     

       252
       +
                 match Jsont.Json.decode Response.jsont json with

     

       253
       +
                 | Ok resp -> Response resp

     

       254
       +
                 | Error msg -> failwith ("Failed to decode response: " ^ msg)

     

       255
       +
               else

     

       256
       +
                 failwith "Invalid JSON-RPC message: missing method or result/error"

     

       257
       +
           | _ ->

     

       258
       +
               failwith "Invalid JSON-RPC message: not an object"

     

       259
       +
       

     

       260
       +
         let jsont : t Jsont.t =

     

       261
       +
           let enc = function

     

       262
       +
             | Request req ->

     

       263
       +
                 (match Jsont.Json.encode Request.jsont req with

     

       264
       +
                  | Ok json -> json

     

       265
       +
                  | Error msg -> failwith ("Failed to encode request: " ^ msg))

     

       266
       +
             | Response resp ->

     

       267
       +
                 (match Jsont.Json.encode Response.jsont resp with

     

       268
       +
                  | Ok json -> json

     

       269
       +
                  | Error msg -> failwith ("Failed to encode response: " ^ msg))

     

       270
       +
           in

     

       271
       +
           let dec json =

     

       272
       +
             classify json

     

       273
       +
           in

     

       274
       +
           Jsont.map ~kind:"JSONRPCMessage" ~dec ~enc Jsont.json

     

       275
       +
       

     

       276
       +
         let pp fmt = function

     

       277
       +
           | Request req -> Format.fprintf fmt "Request(%a)" Request.pp req

     

       278
       +
           | Response resp -> Format.fprintf fmt "Response(%a)" Response.pp resp

     

       279
       +
       end

+161

claudeio/lib_mcp/jsonrpc.mli

···

       1
       +
       (** JSON-RPC 2.0 protocol implementation using jsont.

     

       2
       +
       

     

       3
       +
           Based on the JSON-RPC 2.0 specification: https://www.jsonrpc.org/

     

       4
       +
       

     

       5
       +
           This module provides type-safe encoding/decoding of JSON-RPC messages

     

       6
       +
           with forward-compatible unknown field preservation. *)

     

       7
       +
       

     

       8
       +
       (** {1 Protocol Version} *)

     

       9
       +
       

     

       10
       +
       type jsonrpc = [ `V2 ]

     

       11
       +
       (** JSON-RPC protocol version *)

     

       12
       +
       

     

       13
       +
       val jsonrpc_jsont : jsonrpc Jsont.t

     

       14
       +
       (** Codec for protocol version *)

     

       15
       +
       

     

       16
       +
       (** {1 Request/Response Identifiers} *)

     

       17
       +
       

     

       18
       +
       module Id : sig

     

       19
       +
         type t = [ `String of string | `Number of float | `Null ]

     

       20
       +
         (** Request/response correlation ID.

     

       21
       +
             Can be a string, number, or null. *)

     

       22
       +
       

     

       23
       +
         val jsont : t Jsont.t

     

       24
       +
         (** Codec for IDs *)

     

       25
       +
       

     

       26
       +
         val to_string : t -> string

     

       27
       +
         (** Convert ID to string representation *)

     

       28
       +
       

     

       29
       +
         val compare : t -> t -> int

     

       30
       +
         (** Compare IDs for ordering *)

     

       31
       +
       

     

       32
       +
         val pp : Format.formatter -> t -> unit

     

       33
       +
         (** Pretty-print an ID *)

     

       34
       +
       end

     

       35
       +
       

     

       36
       +
       (** {1 Error Codes} *)

     

       37
       +
       

     

       38
       +
       module Error_code : sig

     

       39
       +
         type t =

     

       40
       +
           | Parse_error           (** -32700: Invalid JSON *)

     

       41
       +
           | Invalid_request       (** -32600: Invalid Request object *)

     

       42
       +
           | Method_not_found      (** -32601: Method does not exist *)

     

       43
       +
           | Invalid_params        (** -32602: Invalid method parameters *)

     

       44
       +
           | Internal_error        (** -32603: Internal JSON-RPC error *)

     

       45
       +
           | Connection_closed     (** -32000: MCP-specific: connection closed *)

     

       46
       +
           | Server_error of int   (** -32099 to -32000: Server error *)

     

       47
       +
           | Other of int          (** Implementation-defined error *)

     

       48
       +
       

     

       49
       +
         val jsont : t Jsont.t

     

       50
       +
         (** Codec for error codes *)

     

       51
       +
       

     

       52
       +
         val to_int : t -> int

     

       53
       +
         (** Convert error code to integer *)

     

       54
       +
       

     

       55
       +
         val of_int : int -> t

     

       56
       +
         (** Convert integer to error code *)

     

       57
       +
       

     

       58
       +
         val pp : Format.formatter -> t -> unit

     

       59
       +
         (** Pretty-print an error code *)

     

       60
       +
       end

     

       61
       +
       

     

       62
       +
       (** {1 Error Data} *)

     

       63
       +
       

     

       64
       +
       module Error_data : sig

     

       65
       +
         type t = {

     

       66
       +
           code : Error_code.t;

     

       67
       +
           message : string;

     

       68
       +
           data : Jsont.json option;

     

       69
       +
           unknown : Jsont.json;

     

       70
       +
         }

     

       71
       +
         (** Error information *)

     

       72
       +
       

     

       73
       +
         val make : code:Error_code.t -> message:string -> ?data:Jsont.json -> unit -> t

     

       74
       +
         (** Create error data *)

     

       75
       +
       

     

       76
       +
         val jsont : t Jsont.t

     

       77
       +
         (** Codec for error data *)

     

       78
       +
       

     

       79
       +
         val pp : Format.formatter -> t -> unit

     

       80
       +
         (** Pretty-print error data *)

     

       81
       +
       end

     

       82
       +
       

     

       83
       +
       (** {1 Params} *)

     

       84
       +
       

     

       85
       +
       type params = Jsont.json

     

       86
       +
       (** Parameters for requests (must be Array or Object) *)

     

       87
       +
       

     

       88
       +
       val params_jsont : params Jsont.t

     

       89
       +
       (** Codec for params (validates array or object) *)

     

       90
       +
       

     

       91
       +
       (** {1 Request Message} *)

     

       92
       +
       

     

       93
       +
       module Request : sig

     

       94
       +
         type t = {

     

       95
       +
           jsonrpc : jsonrpc;

     

       96
       +
           method_ : string;

     

       97
       +
           params : params option;

     

       98
       +
           id : Id.t option;

     

       99
       +
           unknown : Jsont.json;

     

       100
       +
         }

     

       101
       +
         (** JSON-RPC request.

     

       102
       +
             - If [id] is [Some _], expects a response

     

       103
       +
             - If [id] is [None], it's a notification (no response) *)

     

       104
       +
       

     

       105
       +
         val make :

     

       106
       +
           method_:string ->

     

       107
       +
           ?params:params ->

     

       108
       +
           ?id:Id.t ->

     

       109
       +
           unit ->

     

       110
       +
           t

     

       111
       +
         (** Create a request *)

     

       112
       +
       

     

       113
       +
         val jsont : t Jsont.t

     

       114
       +
         (** Codec for requests *)

     

       115
       +
       

     

       116
       +
         val pp : Format.formatter -> t -> unit

     

       117
       +
         (** Pretty-print a request *)

     

       118
       +
       end

     

       119
       +
       

     

       120
       +
       (** {1 Response Message} *)

     

       121
       +
       

     

       122
       +
       module Response : sig

     

       123
       +
         type t = {

     

       124
       +
           jsonrpc : jsonrpc;

     

       125
       +
           value : (Jsont.json, Error_data.t) result;

     

       126
       +
           id : Id.t;

     

       127
       +
           unknown : Jsont.json;

     

       128
       +
         }

     

       129
       +
         (** JSON-RPC response.

     

       130
       +
             Either contains [Ok result] or [Error error]. *)

     

       131
       +
       

     

       132
       +
         val make_result : id:Id.t -> result:Jsont.json -> t

     

       133
       +
         (** Create a successful response *)

     

       134
       +
       

     

       135
       +
         val make_error : id:Id.t -> error:Error_data.t -> t

     

       136
       +
         (** Create an error response *)

     

       137
       +
       

     

       138
       +
         val jsont : t Jsont.t

     

       139
       +
         (** Codec for responses *)

     

       140
       +
       

     

       141
       +
         val pp : Format.formatter -> t -> unit

     

       142
       +
         (** Pretty-print a response *)

     

       143
       +
       end

     

       144
       +
       

     

       145
       +
       (** {1 Message Union} *)

     

       146
       +
       

     

       147
       +
       module Message : sig

     

       148
       +
         type t =

     

       149
       +
           | Request of Request.t

     

       150
       +
           | Response of Response.t

     

       151
       +
         (** Union of all JSON-RPC message types *)

     

       152
       +
       

     

       153
       +
         val jsont : t Jsont.t

     

       154
       +
         (** Codec for messages *)

     

       155
       +
       

     

       156
       +
         val classify : Jsont.json -> t

     

       157
       +
         (** Classify a JSON value as a specific message type *)

     

       158
       +
       

     

       159
       +
         val pp : Format.formatter -> t -> unit

     

       160
       +
         (** Pretty-print a message *)

     

       161
       +
       end

+11

claudeio/lib_mcp/mcp.ml

···

       1
       +
       (** Model Context Protocol (MCP) OCaml Implementation *)

     

       2
       +
       

     

       3
       +
       module Jsonrpc = Jsonrpc

     

       4
       +
       module Content = Content

     

       5
       +
       module Capabilities = Capabilities

     

       6
       +
       module Messages = Messages

     

       7
       +
       module Session = Session

     

       8
       +
       module Transport = Transport

     

       9
       +
       module Transport_stdio = Transport_stdio

     

       10
       +
       module Server_session = Server_session

     

       11
       +
       module Client_session = Client_session

+63

claudeio/lib_mcp/mcp.mli

···

       1
       +
       (** Model Context Protocol (MCP) OCaml Implementation.

     

       2
       +
       

     

       3
       +
           This library provides a type-safe, Eio-based implementation of the Model Context Protocol,

     

       4
       +
           using jsont for JSON serialization with forward-compatible unknown field preservation.

     

       5
       +
       

     

       6
       +
           {1 Quick Start}

     

       7
       +
       

     

       8
       +
           The MCP library is organized into several modules:

     

       9
       +
       

     

       10
       +
           - {!Jsonrpc}: JSON-RPC 2.0 protocol layer

     

       11
       +
           - {!Content}: Content block types (text, image, audio, resources)

     

       12
       +
           - {!Capabilities}: Client and server capability negotiation

     

       13
       +
       

     

       14
       +
           {1 Example}

     

       15
       +
       

     

       16
       +
           {[

     

       17
       +
             open Mcp

     

       18
       +
       

     

       19
       +
             (* Create client capabilities *)

     

       20
       +
             let client_caps = Capabilities.Client.make

     

       21
       +
               ~sampling:(Capabilities.Sampling.make ~tools:true ())

     

       22
       +
               ()

     

       23
       +
       

     

       24
       +
             (* Create content blocks *)

     

       25
       +
             let text_block = Content.text "Hello, MCP!"

     

       26
       +
             let image_block = Content.image ~data:"..." ~mime_type:"image/png"

     

       27
       +
           ]}

     

       28
       +
       

     

       29
       +
           {1 Design Principles}

     

       30
       +
       

     

       31
       +
           - {b Type Safety}: All protocol types use jsont codecs for bidirectional JSON serialization

     

       32
       +
           - {b Forward Compatibility}: Unknown fields are preserved in all types

     

       33
       +
           - {b Eio Integration}: Uses Eio for structured concurrency

     

       34
       +
           - {b Protocol Compliance}: Follows MCP specification exactly

     

       35
       +
       

     

       36
       +
           {1 Modules} *)

     

       37
       +
       

     

       38
       +
       (** JSON-RPC 2.0 protocol implementation *)

     

       39
       +
       module Jsonrpc : module type of Jsonrpc

     

       40
       +
       

     

       41
       +
       (** MCP content block types *)

     

       42
       +
       module Content : module type of Content

     

       43
       +
       

     

       44
       +
       (** Client and server capability negotiation *)

     

       45
       +
       module Capabilities : module type of Capabilities

     

       46
       +
       

     

       47
       +
       (** MCP protocol messages (initialize, resources, tools, prompts, logging, etc.) *)

     

       48
       +
       module Messages : module type of Messages

     

       49
       +
       

     

       50
       +
       (** Bidirectional JSON-RPC session management *)

     

       51
       +
       module Session : module type of Session

     

       52
       +
       

     

       53
       +
       (** Transport layer for JSON-RPC communication *)

     

       54
       +
       module Transport : module type of Transport

     

       55
       +
       

     

       56
       +
       (** Stdio transport implementation *)

     

       57
       +
       module Transport_stdio : module type of Transport_stdio

     

       58
       +
       

     

       59
       +
       (** High-level MCP server session API *)

     

       60
       +
       module Server_session : module type of Server_session

     

       61
       +
       

     

       62
       +
       (** High-level MCP client session API *)

     

       63
       +
       module Client_session : module type of Client_session

+900

claudeio/lib_mcp/messages.ml

···

       1
       +
       (** MCP Protocol Messages *)

     

       2
       +
       

     

       3
       +
       (* Protocol Version *)

     

       4
       +
       

     

       5
       +
       type protocol_version = string

     

       6
       +
       

     

       7
       +
       let protocol_version_jsont = Jsont.string

     

       8
       +
       

     

       9
       +
       (* Initialize Protocol *)

     

       10
       +
       

     

       11
       +
       module Initialize = struct

     

       12
       +
         type request_params = {

     

       13
       +
           protocol_version : protocol_version;

     

       14
       +
           capabilities : Capabilities.Client.t;

     

       15
       +
           client_info : Capabilities.Implementation.t;

     

       16
       +
           unknown : Jsont.json;

     

       17
       +
         }

     

       18
       +
       

     

       19
       +
         let make_request_params ~protocol_version ~capabilities ~client_info () =

     

       20
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       21
       +
           { protocol_version; capabilities; client_info; unknown }

     

       22
       +
       

     

       23
       +
         let request_params_jsont : request_params Jsont.t =

     

       24
       +
           let make protocol_version capabilities client_info unknown =

     

       25
       +
             { protocol_version; capabilities; client_info; unknown }

     

       26
       +
           in

     

       27
       +
           Jsont.Object.map ~kind:"InitializeRequestParams" make

     

       28
       +
           |> Jsont.Object.mem "protocolVersion" protocol_version_jsont

     

       29
       +
               ~enc:(fun p -> p.protocol_version)

     

       30
       +
           |> Jsont.Object.mem "capabilities" Capabilities.Client.jsont

     

       31
       +
               ~enc:(fun p -> p.capabilities)

     

       32
       +
           |> Jsont.Object.mem "clientInfo" Capabilities.Implementation.jsont

     

       33
       +
               ~enc:(fun p -> p.client_info)

     

       34
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun p -> p.unknown)

     

       35
       +
           |> Jsont.Object.finish

     

       36
       +
       

     

       37
       +
         type result = {

     

       38
       +
           protocol_version : protocol_version;

     

       39
       +
           capabilities : Capabilities.Server.t;

     

       40
       +
           server_info : Capabilities.Implementation.t;

     

       41
       +
           instructions : string option;

     

       42
       +
           unknown : Jsont.json;

     

       43
       +
         }

     

       44
       +
       

     

       45
       +
         let make_result ~protocol_version ~capabilities ~server_info ?instructions () =

     

       46
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       47
       +
           { protocol_version; capabilities; server_info; instructions; unknown }

     

       48
       +
       

     

       49
       +
         let result_jsont : result Jsont.t =

     

       50
       +
           let make protocol_version capabilities server_info instructions unknown =

     

       51
       +
             { protocol_version; capabilities; server_info; instructions; unknown }

     

       52
       +
           in

     

       53
       +
           Jsont.Object.map ~kind:"InitializeResult" make

     

       54
       +
           |> Jsont.Object.mem "protocolVersion" protocol_version_jsont

     

       55
       +
               ~enc:(fun r -> r.protocol_version)

     

       56
       +
           |> Jsont.Object.mem "capabilities" Capabilities.Server.jsont

     

       57
       +
               ~enc:(fun r -> r.capabilities)

     

       58
       +
           |> Jsont.Object.mem "serverInfo" Capabilities.Implementation.jsont

     

       59
       +
               ~enc:(fun r -> r.server_info)

     

       60
       +
           |> Jsont.Object.opt_mem "instructions" Jsont.string

     

       61
       +
               ~enc:(fun r -> r.instructions)

     

       62
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun r -> r.unknown)

     

       63
       +
           |> Jsont.Object.finish

     

       64
       +
       

     

       65
       +
         let method_ = "initialize"

     

       66
       +
       end

     

       67
       +
       

     

       68
       +
       module Initialized = struct

     

       69
       +
         type notification = {

     

       70
       +
           unknown : Jsont.json;

     

       71
       +
         }

     

       72
       +
       

     

       73
       +
         let make_notification () =

     

       74
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       75
       +
           { unknown }

     

       76
       +
       

     

       77
       +
         let notification_jsont : notification Jsont.t =

     

       78
       +
           let make unknown = { unknown } in

     

       79
       +
           Jsont.Object.map ~kind:"InitializedNotification" make

     

       80
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun n -> n.unknown)

     

       81
       +
           |> Jsont.Object.finish

     

       82
       +
       

     

       83
       +
         let method_ = "notifications/initialized"

     

       84
       +
       end

     

       85
       +
       

     

       86
       +
       module Ping = struct

     

       87
       +
         type params = {

     

       88
       +
           unknown : Jsont.json;

     

       89
       +
         }

     

       90
       +
       

     

       91
       +
         let make_params () =

     

       92
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       93
       +
           { unknown }

     

       94
       +
       

     

       95
       +
         let params_jsont : params Jsont.t =

     

       96
       +
           let make unknown = { unknown } in

     

       97
       +
           Jsont.Object.map ~kind:"PingParams" make

     

       98
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun p -> p.unknown)

     

       99
       +
           |> Jsont.Object.finish

     

       100
       +
       

     

       101
       +
         type result = {

     

       102
       +
           unknown : Jsont.json;

     

       103
       +
         }

     

       104
       +
       

     

       105
       +
         let make_result () =

     

       106
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       107
       +
           { unknown }

     

       108
       +
       

     

       109
       +
         let result_jsont : result Jsont.t =

     

       110
       +
           let make unknown = { unknown } in

     

       111
       +
           Jsont.Object.map ~kind:"PingResult" make

     

       112
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun r -> r.unknown)

     

       113
       +
           |> Jsont.Object.finish

     

       114
       +
       

     

       115
       +
         let method_ = "ping"

     

       116
       +
       end

     

       117
       +
       

     

       118
       +
       (* Resources *)

     

       119
       +
       

     

       120
       +
       module Resources = struct

     

       121
       +
         type resource = {

     

       122
       +
           uri : string;

     

       123
       +
           name : string;

     

       124
       +
           description : string option;

     

       125
       +
           mime_type : string option;

     

       126
       +
           unknown : Jsont.json;

     

       127
       +
         }

     

       128
       +
       

     

       129
       +
         let make_resource ~uri ~name ?description ?mime_type () =

     

       130
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       131
       +
           { uri; name; description; mime_type; unknown }

     

       132
       +
       

     

       133
       +
         let resource_jsont : resource Jsont.t =

     

       134
       +
           let make uri name description mime_type unknown =

     

       135
       +
             { uri; name; description; mime_type; unknown }

     

       136
       +
           in

     

       137
       +
           Jsont.Object.map ~kind:"Resource" make

     

       138
       +
           |> Jsont.Object.mem "uri" Jsont.string ~enc:(fun r -> r.uri)

     

       139
       +
           |> Jsont.Object.mem "name" Jsont.string ~enc:(fun r -> r.name)

     

       140
       +
           |> Jsont.Object.opt_mem "description" Jsont.string ~enc:(fun r -> r.description)

     

       141
       +
           |> Jsont.Object.opt_mem "mimeType" Jsont.string ~enc:(fun r -> r.mime_type)

     

       142
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun r -> r.unknown)

     

       143
       +
           |> Jsont.Object.finish

     

       144
       +
       

     

       145
       +
         type resource_template = {

     

       146
       +
           uri_template : string;

     

       147
       +
           name : string;

     

       148
       +
           description : string option;

     

       149
       +
           mime_type : string option;

     

       150
       +
           unknown : Jsont.json;

     

       151
       +
         }

     

       152
       +
       

     

       153
       +
         let make_resource_template ~uri_template ~name ?description ?mime_type () =

     

       154
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       155
       +
           { uri_template; name; description; mime_type; unknown }

     

       156
       +
       

     

       157
       +
         let resource_template_jsont : resource_template Jsont.t =

     

       158
       +
           let make uri_template name description mime_type unknown =

     

       159
       +
             { uri_template; name; description; mime_type; unknown }

     

       160
       +
           in

     

       161
       +
           Jsont.Object.map ~kind:"ResourceTemplate" make

     

       162
       +
           |> Jsont.Object.mem "uriTemplate" Jsont.string ~enc:(fun t -> t.uri_template)

     

       163
       +
           |> Jsont.Object.mem "name" Jsont.string ~enc:(fun t -> t.name)

     

       164
       +
           |> Jsont.Object.opt_mem "description" Jsont.string ~enc:(fun t -> t.description)

     

       165
       +
           |> Jsont.Object.opt_mem "mimeType" Jsont.string ~enc:(fun t -> t.mime_type)

     

       166
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun t -> t.unknown)

     

       167
       +
           |> Jsont.Object.finish

     

       168
       +
       

     

       169
       +
         type resource_contents = {

     

       170
       +
           uri : string;

     

       171
       +
           mime_type : string option;

     

       172
       +
           text : string option;

     

       173
       +
           blob : string option;

     

       174
       +
           unknown : Jsont.json;

     

       175
       +
         }

     

       176
       +
       

     

       177
       +
         let make_text_contents ~uri ~text ?mime_type () =

     

       178
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       179
       +
           { uri; mime_type; text = Some text; blob = None; unknown }

     

       180
       +
       

     

       181
       +
         let make_blob_contents ~uri ~blob ~mime_type =

     

       182
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       183
       +
           { uri; mime_type = Some mime_type; text = None; blob = Some blob; unknown }

     

       184
       +
       

     

       185
       +
         let resource_contents_jsont : resource_contents Jsont.t =

     

       186
       +
           let make uri mime_type text blob unknown =

     

       187
       +
             { uri; mime_type; text; blob; unknown }

     

       188
       +
           in

     

       189
       +
           Jsont.Object.map ~kind:"ResourceContents" make

     

       190
       +
           |> Jsont.Object.mem "uri" Jsont.string ~enc:(fun c -> c.uri)

     

       191
       +
           |> Jsont.Object.opt_mem "mimeType" Jsont.string ~enc:(fun c -> c.mime_type)

     

       192
       +
           |> Jsont.Object.opt_mem "text" Jsont.string ~enc:(fun c -> c.text)

     

       193
       +
           |> Jsont.Object.opt_mem "blob" Jsont.string ~enc:(fun c -> c.blob)

     

       194
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun c -> c.unknown)

     

       195
       +
           |> Jsont.Object.finish

     

       196
       +
       

     

       197
       +
         type list_request = {

     

       198
       +
           cursor : string option;

     

       199
       +
           unknown : Jsont.json;

     

       200
       +
         }

     

       201
       +
       

     

       202
       +
         let make_list_request ?cursor () =

     

       203
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       204
       +
           { cursor; unknown }

     

       205
       +
       

     

       206
       +
         let list_request_jsont : list_request Jsont.t =

     

       207
       +
           let make cursor unknown = { cursor; unknown } in

     

       208
       +
           Jsont.Object.map ~kind:"ResourcesListRequest" make

     

       209
       +
           |> Jsont.Object.opt_mem "cursor" Jsont.string ~enc:(fun r -> r.cursor)

     

       210
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun r -> r.unknown)

     

       211
       +
           |> Jsont.Object.finish

     

       212
       +
       

     

       213
       +
         type list_result = {

     

       214
       +
           resources : resource list;

     

       215
       +
           next_cursor : string option;

     

       216
       +
           unknown : Jsont.json;

     

       217
       +
         }

     

       218
       +
       

     

       219
       +
         let make_list_result ~resources ?next_cursor () =

     

       220
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       221
       +
           { resources; next_cursor; unknown }

     

       222
       +
       

     

       223
       +
         let list_result_jsont : list_result Jsont.t =

     

       224
       +
           let make resources next_cursor unknown =

     

       225
       +
             { resources; next_cursor; unknown }

     

       226
       +
           in

     

       227
       +
           Jsont.Object.map ~kind:"ResourcesListResult" make

     

       228
       +
           |> Jsont.Object.mem "resources" (Jsont.list resource_jsont)

     

       229
       +
               ~enc:(fun r -> r.resources)

     

       230
       +
           |> Jsont.Object.opt_mem "nextCursor" Jsont.string

     

       231
       +
               ~enc:(fun r -> r.next_cursor)

     

       232
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun r -> r.unknown)

     

       233
       +
           |> Jsont.Object.finish

     

       234
       +
       

     

       235
       +
         type read_request = {

     

       236
       +
           uri : string;

     

       237
       +
           unknown : Jsont.json;

     

       238
       +
         }

     

       239
       +
       

     

       240
       +
         let make_read_request ~uri =

     

       241
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       242
       +
           { uri; unknown }

     

       243
       +
       

     

       244
       +
         let read_request_jsont : read_request Jsont.t =

     

       245
       +
           let make uri unknown = { uri; unknown } in

     

       246
       +
           Jsont.Object.map ~kind:"ResourcesReadRequest" make

     

       247
       +
           |> Jsont.Object.mem "uri" Jsont.string ~enc:(fun r -> r.uri)

     

       248
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun r -> r.unknown)

     

       249
       +
           |> Jsont.Object.finish

     

       250
       +
       

     

       251
       +
         type read_result = {

     

       252
       +
           contents : resource_contents list;

     

       253
       +
           unknown : Jsont.json;

     

       254
       +
         }

     

       255
       +
       

     

       256
       +
         let make_read_result ~contents =

     

       257
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       258
       +
           { contents; unknown }

     

       259
       +
       

     

       260
       +
         let read_result_jsont : read_result Jsont.t =

     

       261
       +
           let make contents unknown = { contents; unknown } in

     

       262
       +
           Jsont.Object.map ~kind:"ResourcesReadResult" make

     

       263
       +
           |> Jsont.Object.mem "contents" (Jsont.list resource_contents_jsont)

     

       264
       +
               ~enc:(fun r -> r.contents)

     

       265
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun r -> r.unknown)

     

       266
       +
           |> Jsont.Object.finish

     

       267
       +
       

     

       268
       +
         type subscribe_request = {

     

       269
       +
           uri : string;

     

       270
       +
           unknown : Jsont.json;

     

       271
       +
         }

     

       272
       +
       

     

       273
       +
         let make_subscribe_request ~uri =

     

       274
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       275
       +
           { uri; unknown }

     

       276
       +
       

     

       277
       +
         let subscribe_request_jsont : subscribe_request Jsont.t =

     

       278
       +
           let make uri unknown = { uri; unknown } in

     

       279
       +
           Jsont.Object.map ~kind:"ResourcesSubscribeRequest" make

     

       280
       +
           |> Jsont.Object.mem "uri" Jsont.string ~enc:(fun r -> r.uri)

     

       281
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun r -> r.unknown)

     

       282
       +
           |> Jsont.Object.finish

     

       283
       +
       

     

       284
       +
         type unsubscribe_request = {

     

       285
       +
           uri : string;

     

       286
       +
           unknown : Jsont.json;

     

       287
       +
         }

     

       288
       +
       

     

       289
       +
         let make_unsubscribe_request ~uri =

     

       290
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       291
       +
           { uri; unknown }

     

       292
       +
       

     

       293
       +
         let unsubscribe_request_jsont : unsubscribe_request Jsont.t =

     

       294
       +
           let make uri unknown = { uri; unknown } in

     

       295
       +
           Jsont.Object.map ~kind:"ResourcesUnsubscribeRequest" make

     

       296
       +
           |> Jsont.Object.mem "uri" Jsont.string ~enc:(fun r -> r.uri)

     

       297
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun r -> r.unknown)

     

       298
       +
           |> Jsont.Object.finish

     

       299
       +
       

     

       300
       +
         type updated_notification = {

     

       301
       +
           uri : string;

     

       302
       +
           unknown : Jsont.json;

     

       303
       +
         }

     

       304
       +
       

     

       305
       +
         let make_updated_notification ~uri =

     

       306
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       307
       +
           { uri; unknown }

     

       308
       +
       

     

       309
       +
         let updated_notification_jsont : updated_notification Jsont.t =

     

       310
       +
           let make uri unknown = { uri; unknown } in

     

       311
       +
           Jsont.Object.map ~kind:"ResourceUpdatedNotification" make

     

       312
       +
           |> Jsont.Object.mem "uri" Jsont.string ~enc:(fun n -> n.uri)

     

       313
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun n -> n.unknown)

     

       314
       +
           |> Jsont.Object.finish

     

       315
       +
       

     

       316
       +
         type list_changed_notification = {

     

       317
       +
           unknown : Jsont.json;

     

       318
       +
         }

     

       319
       +
       

     

       320
       +
         let make_list_changed_notification () =

     

       321
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       322
       +
           { unknown }

     

       323
       +
       

     

       324
       +
         let list_changed_notification_jsont : list_changed_notification Jsont.t =

     

       325
       +
           let make unknown = { unknown } in

     

       326
       +
           Jsont.Object.map ~kind:"ResourceListChangedNotification" make

     

       327
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun n -> n.unknown)

     

       328
       +
           |> Jsont.Object.finish

     

       329
       +
       

     

       330
       +
         let list_method = "resources/list"

     

       331
       +
         let read_method = "resources/read"

     

       332
       +
         let subscribe_method = "resources/subscribe"

     

       333
       +
         let unsubscribe_method = "resources/unsubscribe"

     

       334
       +
         let updated_notification_method = "notifications/resources/updated"

     

       335
       +
         let list_changed_notification_method = "notifications/resources/list_changed"

     

       336
       +
       end

     

       337
       +
       

     

       338
       +
       (* Tools *)

     

       339
       +
       

     

       340
       +
       module Tools = struct

     

       341
       +
         type tool = {

     

       342
       +
           name : string;

     

       343
       +
           description : string option;

     

       344
       +
           input_schema : Jsont.json;

     

       345
       +
           unknown : Jsont.json;

     

       346
       +
         }

     

       347
       +
       

     

       348
       +
         let make_tool ~name ?description ~input_schema () =

     

       349
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       350
       +
           { name; description; input_schema; unknown }

     

       351
       +
       

     

       352
       +
         let tool_jsont : tool Jsont.t =

     

       353
       +
           let make name description input_schema unknown =

     

       354
       +
             { name; description; input_schema; unknown }

     

       355
       +
           in

     

       356
       +
           Jsont.Object.map ~kind:"Tool" make

     

       357
       +
           |> Jsont.Object.mem "name" Jsont.string ~enc:(fun t -> t.name)

     

       358
       +
           |> Jsont.Object.opt_mem "description" Jsont.string ~enc:(fun t -> t.description)

     

       359
       +
           |> Jsont.Object.mem "inputSchema" Jsont.json ~enc:(fun t -> t.input_schema)

     

       360
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun t -> t.unknown)

     

       361
       +
           |> Jsont.Object.finish

     

       362
       +
       

     

       363
       +
         type list_request = {

     

       364
       +
           cursor : string option;

     

       365
       +
           unknown : Jsont.json;

     

       366
       +
         }

     

       367
       +
       

     

       368
       +
         let make_list_request ?cursor () =

     

       369
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       370
       +
           { cursor; unknown }

     

       371
       +
       

     

       372
       +
         let list_request_jsont : list_request Jsont.t =

     

       373
       +
           let make cursor unknown = { cursor; unknown } in

     

       374
       +
           Jsont.Object.map ~kind:"ToolsListRequest" make

     

       375
       +
           |> Jsont.Object.opt_mem "cursor" Jsont.string ~enc:(fun r -> r.cursor)

     

       376
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun r -> r.unknown)

     

       377
       +
           |> Jsont.Object.finish

     

       378
       +
       

     

       379
       +
         type list_result = {

     

       380
       +
           tools : tool list;

     

       381
       +
           next_cursor : string option;

     

       382
       +
           unknown : Jsont.json;

     

       383
       +
         }

     

       384
       +
       

     

       385
       +
         let make_list_result ~tools ?next_cursor () =

     

       386
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       387
       +
           { tools; next_cursor; unknown }

     

       388
       +
       

     

       389
       +
         let list_result_jsont : list_result Jsont.t =

     

       390
       +
           let make tools next_cursor unknown =

     

       391
       +
             { tools; next_cursor; unknown }

     

       392
       +
           in

     

       393
       +
           Jsont.Object.map ~kind:"ToolsListResult" make

     

       394
       +
           |> Jsont.Object.mem "tools" (Jsont.list tool_jsont)

     

       395
       +
               ~enc:(fun r -> r.tools)

     

       396
       +
           |> Jsont.Object.opt_mem "nextCursor" Jsont.string

     

       397
       +
               ~enc:(fun r -> r.next_cursor)

     

       398
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun r -> r.unknown)

     

       399
       +
           |> Jsont.Object.finish

     

       400
       +
       

     

       401
       +
         type call_request = {

     

       402
       +
           name : string;

     

       403
       +
           arguments : Jsont.json option;

     

       404
       +
           unknown : Jsont.json;

     

       405
       +
         }

     

       406
       +
       

     

       407
       +
         let make_call_request ~name ?arguments () =

     

       408
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       409
       +
           { name; arguments; unknown }

     

       410
       +
       

     

       411
       +
         let call_request_jsont : call_request Jsont.t =

     

       412
       +
           let make name arguments unknown = { name; arguments; unknown } in

     

       413
       +
           Jsont.Object.map ~kind:"ToolsCallRequest" make

     

       414
       +
           |> Jsont.Object.mem "name" Jsont.string ~enc:(fun r -> r.name)

     

       415
       +
           |> Jsont.Object.opt_mem "arguments" Jsont.json ~enc:(fun r -> r.arguments)

     

       416
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun r -> r.unknown)

     

       417
       +
           |> Jsont.Object.finish

     

       418
       +
       

     

       419
       +
         type call_result = {

     

       420
       +
           content : Content.block list;

     

       421
       +
           is_error : bool option;

     

       422
       +
           unknown : Jsont.json;

     

       423
       +
         }

     

       424
       +
       

     

       425
       +
         let make_call_result ~content ?is_error () =

     

       426
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       427
       +
           { content; is_error; unknown }

     

       428
       +
       

     

       429
       +
         let call_result_jsont : call_result Jsont.t =

     

       430
       +
           let make content is_error unknown =

     

       431
       +
             { content; is_error; unknown }

     

       432
       +
           in

     

       433
       +
           Jsont.Object.map ~kind:"ToolsCallResult" make

     

       434
       +
           |> Jsont.Object.mem "content" (Jsont.list Content.block_jsont)

     

       435
       +
               ~enc:(fun r -> r.content)

     

       436
       +
           |> Jsont.Object.opt_mem "isError" Jsont.bool ~enc:(fun r -> r.is_error)

     

       437
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun r -> r.unknown)

     

       438
       +
           |> Jsont.Object.finish

     

       439
       +
       

     

       440
       +
         type list_changed_notification = {

     

       441
       +
           unknown : Jsont.json;

     

       442
       +
         }

     

       443
       +
       

     

       444
       +
         let make_list_changed_notification () =

     

       445
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       446
       +
           { unknown }

     

       447
       +
       

     

       448
       +
         let list_changed_notification_jsont : list_changed_notification Jsont.t =

     

       449
       +
           let make unknown = { unknown } in

     

       450
       +
           Jsont.Object.map ~kind:"ToolsListChangedNotification" make

     

       451
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun n -> n.unknown)

     

       452
       +
           |> Jsont.Object.finish

     

       453
       +
       

     

       454
       +
         let list_method = "tools/list"

     

       455
       +
         let call_method = "tools/call"

     

       456
       +
         let list_changed_notification_method = "notifications/tools/list_changed"

     

       457
       +
       end

     

       458
       +
       

     

       459
       +
       (* Prompts *)

     

       460
       +
       

     

       461
       +
       module Prompts = struct

     

       462
       +
         type prompt_argument = {

     

       463
       +
           name : string;

     

       464
       +
           description : string option;

     

       465
       +
           required : bool option;

     

       466
       +
           unknown : Jsont.json;

     

       467
       +
         }

     

       468
       +
       

     

       469
       +
         let make_prompt_argument ~name ?description ?required () =

     

       470
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       471
       +
           { name; description; required; unknown }

     

       472
       +
       

     

       473
       +
         let prompt_argument_jsont : prompt_argument Jsont.t =

     

       474
       +
           let make name description required unknown =

     

       475
       +
             { name; description; required; unknown }

     

       476
       +
           in

     

       477
       +
           Jsont.Object.map ~kind:"PromptArgument" make

     

       478
       +
           |> Jsont.Object.mem "name" Jsont.string ~enc:(fun a -> a.name)

     

       479
       +
           |> Jsont.Object.opt_mem "description" Jsont.string ~enc:(fun a -> a.description)

     

       480
       +
           |> Jsont.Object.opt_mem "required" Jsont.bool ~enc:(fun a -> a.required)

     

       481
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun a -> a.unknown)

     

       482
       +
           |> Jsont.Object.finish

     

       483
       +
       

     

       484
       +
         type prompt = {

     

       485
       +
           name : string;

     

       486
       +
           description : string option;

     

       487
       +
           arguments : prompt_argument list option;

     

       488
       +
           unknown : Jsont.json;

     

       489
       +
         }

     

       490
       +
       

     

       491
       +
         let make_prompt ~name ?description ?arguments () =

     

       492
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       493
       +
           { name; description; arguments; unknown }

     

       494
       +
       

     

       495
       +
         let prompt_jsont : prompt Jsont.t =

     

       496
       +
           let make name description arguments unknown =

     

       497
       +
             { name; description; arguments; unknown }

     

       498
       +
           in

     

       499
       +
           Jsont.Object.map ~kind:"Prompt" make

     

       500
       +
           |> Jsont.Object.mem "name" Jsont.string ~enc:(fun p -> p.name)

     

       501
       +
           |> Jsont.Object.opt_mem "description" Jsont.string ~enc:(fun p -> p.description)

     

       502
       +
           |> Jsont.Object.opt_mem "arguments" (Jsont.list prompt_argument_jsont)

     

       503
       +
               ~enc:(fun p -> p.arguments)

     

       504
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun p -> p.unknown)

     

       505
       +
           |> Jsont.Object.finish

     

       506
       +
       

     

       507
       +
         type role = User | Assistant

     

       508
       +
       

     

       509
       +
         let role_jsont : role Jsont.t =

     

       510
       +
           Jsont.enum [

     

       511
       +
             "user", User;

     

       512
       +
             "assistant", Assistant;

     

       513
       +
           ]

     

       514
       +
       

     

       515
       +
         type prompt_message = {

     

       516
       +
           role : role;

     

       517
       +
           content : Content.block list;

     

       518
       +
           unknown : Jsont.json;

     

       519
       +
         }

     

       520
       +
       

     

       521
       +
         let make_prompt_message ~role ~content () =

     

       522
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       523
       +
           { role; content; unknown }

     

       524
       +
       

     

       525
       +
         let prompt_message_jsont : prompt_message Jsont.t =

     

       526
       +
           let make role content unknown = { role; content; unknown } in

     

       527
       +
           Jsont.Object.map ~kind:"PromptMessage" make

     

       528
       +
           |> Jsont.Object.mem "role" role_jsont ~enc:(fun m -> m.role)

     

       529
       +
           |> Jsont.Object.mem "content" (Jsont.list Content.block_jsont)

     

       530
       +
               ~enc:(fun m -> m.content)

     

       531
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun m -> m.unknown)

     

       532
       +
           |> Jsont.Object.finish

     

       533
       +
       

     

       534
       +
         type list_request = {

     

       535
       +
           cursor : string option;

     

       536
       +
           unknown : Jsont.json;

     

       537
       +
         }

     

       538
       +
       

     

       539
       +
         let make_list_request ?cursor () =

     

       540
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       541
       +
           { cursor; unknown }

     

       542
       +
       

     

       543
       +
         let list_request_jsont : list_request Jsont.t =

     

       544
       +
           let make cursor unknown = { cursor; unknown } in

     

       545
       +
           Jsont.Object.map ~kind:"PromptsListRequest" make

     

       546
       +
           |> Jsont.Object.opt_mem "cursor" Jsont.string ~enc:(fun r -> r.cursor)

     

       547
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun r -> r.unknown)

     

       548
       +
           |> Jsont.Object.finish

     

       549
       +
       

     

       550
       +
         type list_result = {

     

       551
       +
           prompts : prompt list;

     

       552
       +
           next_cursor : string option;

     

       553
       +
           unknown : Jsont.json;

     

       554
       +
         }

     

       555
       +
       

     

       556
       +
         let make_list_result ~prompts ?next_cursor () =

     

       557
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       558
       +
           { prompts; next_cursor; unknown }

     

       559
       +
       

     

       560
       +
         let list_result_jsont : list_result Jsont.t =

     

       561
       +
           let make prompts next_cursor unknown =

     

       562
       +
             { prompts; next_cursor; unknown }

     

       563
       +
           in

     

       564
       +
           Jsont.Object.map ~kind:"PromptsListResult" make

     

       565
       +
           |> Jsont.Object.mem "prompts" (Jsont.list prompt_jsont)

     

       566
       +
               ~enc:(fun r -> r.prompts)

     

       567
       +
           |> Jsont.Object.opt_mem "nextCursor" Jsont.string

     

       568
       +
               ~enc:(fun r -> r.next_cursor)

     

       569
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun r -> r.unknown)

     

       570
       +
           |> Jsont.Object.finish

     

       571
       +
       

     

       572
       +
         (* Arguments as object with string keys *)

     

       573
       +
         let arguments_jsont : (string * string) list Jsont.t =

     

       574
       +
           let enc_obj args =

     

       575
       +
             let pairs = List.map (fun (k, v) ->

     

       576
       +
               ((k, Jsont.Meta.none), Jsont.String (v, Jsont.Meta.none))

     

       577
       +
             ) args in

     

       578
       +
             Jsont.Object (pairs, Jsont.Meta.none)

     

       579
       +
           in

     

       580
       +
           let dec_obj = function

     

       581
       +
             | Jsont.Object (members, _) ->

     

       582
       +
                 List.map (fun ((k, _), v) ->

     

       583
       +
                   match v with

     

       584
       +
                   | Jsont.String (s, _) -> (k, s)

     

       585
       +
                   | _ -> Jsont.Error.msgf Jsont.Meta.none

     

       586
       +
                       "Argument values must be strings"

     

       587
       +
                 ) members

     

       588
       +
             | _ ->

     

       589
       +
                 Jsont.Error.msgf Jsont.Meta.none "Arguments must be an object"

     

       590
       +
           in

     

       591
       +
           Jsont.map ~kind:"PromptArguments" ~dec:dec_obj ~enc:enc_obj Jsont.json

     

       592
       +
       

     

       593
       +
         type get_request = {

     

       594
       +
           name : string;

     

       595
       +
           arguments : (string * string) list option;

     

       596
       +
           unknown : Jsont.json;

     

       597
       +
         }

     

       598
       +
       

     

       599
       +
         let make_get_request ~name ?arguments () =

     

       600
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       601
       +
           { name; arguments; unknown }

     

       602
       +
       

     

       603
       +
         let get_request_jsont : get_request Jsont.t =

     

       604
       +
           let make name arguments unknown = { name; arguments; unknown } in

     

       605
       +
           Jsont.Object.map ~kind:"PromptsGetRequest" make

     

       606
       +
           |> Jsont.Object.mem "name" Jsont.string ~enc:(fun r -> r.name)

     

       607
       +
           |> Jsont.Object.opt_mem "arguments" arguments_jsont ~enc:(fun r -> r.arguments)

     

       608
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun r -> r.unknown)

     

       609
       +
           |> Jsont.Object.finish

     

       610
       +
       

     

       611
       +
         type get_result = {

     

       612
       +
           description : string option;

     

       613
       +
           messages : prompt_message list;

     

       614
       +
           unknown : Jsont.json;

     

       615
       +
         }

     

       616
       +
       

     

       617
       +
         let make_get_result ?description ~messages () =

     

       618
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       619
       +
           { description; messages; unknown }

     

       620
       +
       

     

       621
       +
         let get_result_jsont : get_result Jsont.t =

     

       622
       +
           let make description messages unknown =

     

       623
       +
             { description; messages; unknown }

     

       624
       +
           in

     

       625
       +
           Jsont.Object.map ~kind:"PromptsGetResult" make

     

       626
       +
           |> Jsont.Object.opt_mem "description" Jsont.string ~enc:(fun r -> r.description)

     

       627
       +
           |> Jsont.Object.mem "messages" (Jsont.list prompt_message_jsont)

     

       628
       +
               ~enc:(fun r -> r.messages)

     

       629
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun r -> r.unknown)

     

       630
       +
           |> Jsont.Object.finish

     

       631
       +
       

     

       632
       +
         type list_changed_notification = {

     

       633
       +
           unknown : Jsont.json;

     

       634
       +
         }

     

       635
       +
       

     

       636
       +
         let make_list_changed_notification () =

     

       637
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       638
       +
           { unknown }

     

       639
       +
       

     

       640
       +
         let list_changed_notification_jsont : list_changed_notification Jsont.t =

     

       641
       +
           let make unknown = { unknown } in

     

       642
       +
           Jsont.Object.map ~kind:"PromptsListChangedNotification" make

     

       643
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun n -> n.unknown)

     

       644
       +
           |> Jsont.Object.finish

     

       645
       +
       

     

       646
       +
         let list_method = "prompts/list"

     

       647
       +
         let get_method = "prompts/get"

     

       648
       +
         let list_changed_notification_method = "notifications/prompts/list_changed"

     

       649
       +
       end

     

       650
       +
       

     

       651
       +
       (* Logging *)

     

       652
       +
       

     

       653
       +
       module Logging = struct

     

       654
       +
         type level =

     

       655
       +
           | Debug

     

       656
       +
           | Info

     

       657
       +
           | Notice

     

       658
       +
           | Warning

     

       659
       +
           | Error

     

       660
       +
           | Critical

     

       661
       +
           | Alert

     

       662
       +
           | Emergency

     

       663
       +
       

     

       664
       +
         let level_jsont : level Jsont.t =

     

       665
       +
           Jsont.enum [

     

       666
       +
             "debug", Debug;

     

       667
       +
             "info", Info;

     

       668
       +
             "notice", Notice;

     

       669
       +
             "warning", Warning;

     

       670
       +
             "error", Error;

     

       671
       +
             "critical", Critical;

     

       672
       +
             "alert", Alert;

     

       673
       +
             "emergency", Emergency;

     

       674
       +
           ]

     

       675
       +
       

     

       676
       +
         let level_to_string = function

     

       677
       +
           | Debug -> "debug"

     

       678
       +
           | Info -> "info"

     

       679
       +
           | Notice -> "notice"

     

       680
       +
           | Warning -> "warning"

     

       681
       +
           | Error -> "error"

     

       682
       +
           | Critical -> "critical"

     

       683
       +
           | Alert -> "alert"

     

       684
       +
           | Emergency -> "emergency"

     

       685
       +
       

     

       686
       +
         type notification = {

     

       687
       +
           level : level;

     

       688
       +
           logger : string option;

     

       689
       +
           data : Jsont.json option;

     

       690
       +
           unknown : Jsont.json;

     

       691
       +
         }

     

       692
       +
       

     

       693
       +
         let make_notification ~level ?logger ?data () =

     

       694
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       695
       +
           { level; logger; data; unknown }

     

       696
       +
       

     

       697
       +
         let notification_jsont : notification Jsont.t =

     

       698
       +
           let make level logger data unknown =

     

       699
       +
             { level; logger; data; unknown }

     

       700
       +
           in

     

       701
       +
           Jsont.Object.map ~kind:"LoggingNotification" make

     

       702
       +
           |> Jsont.Object.mem "level" level_jsont ~enc:(fun n -> n.level)

     

       703
       +
           |> Jsont.Object.opt_mem "logger" Jsont.string ~enc:(fun n -> n.logger)

     

       704
       +
           |> Jsont.Object.opt_mem "data" Jsont.json ~enc:(fun n -> n.data)

     

       705
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun n -> n.unknown)

     

       706
       +
           |> Jsont.Object.finish

     

       707
       +
       

     

       708
       +
         let method_ = "notifications/message"

     

       709
       +
       end

     

       710
       +
       

     

       711
       +
       (* Completions *)

     

       712
       +
       

     

       713
       +
       module Completions = struct

     

       714
       +
         type completion_ref = {

     

       715
       +
           ref_type : string;

     

       716
       +
           uri : string;

     

       717
       +
           unknown : Jsont.json;

     

       718
       +
         }

     

       719
       +
       

     

       720
       +
         let make_completion_ref ~ref_type ~uri () =

     

       721
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       722
       +
           { ref_type; uri; unknown }

     

       723
       +
       

     

       724
       +
         let completion_ref_jsont : completion_ref Jsont.t =

     

       725
       +
           let make ref_type uri unknown = { ref_type; uri; unknown } in

     

       726
       +
           Jsont.Object.map ~kind:"CompletionRef" make

     

       727
       +
           |> Jsont.Object.mem "type" Jsont.string ~enc:(fun r -> r.ref_type)

     

       728
       +
           |> Jsont.Object.mem "uri" Jsont.string ~enc:(fun r -> r.uri)

     

       729
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun r -> r.unknown)

     

       730
       +
           |> Jsont.Object.finish

     

       731
       +
       

     

       732
       +
         type request = {

     

       733
       +
           ref_ : completion_ref;

     

       734
       +
           argument : string option;

     

       735
       +
           unknown : Jsont.json;

     

       736
       +
         }

     

       737
       +
       

     

       738
       +
         let make_request ~ref_ ?argument () =

     

       739
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       740
       +
           { ref_; argument; unknown }

     

       741
       +
       

     

       742
       +
         let request_jsont : request Jsont.t =

     

       743
       +
           let make ref_ argument unknown = { ref_; argument; unknown } in

     

       744
       +
           Jsont.Object.map ~kind:"CompletionRequest" make

     

       745
       +
           |> Jsont.Object.mem "ref" completion_ref_jsont ~enc:(fun r -> r.ref_)

     

       746
       +
           |> Jsont.Object.opt_mem "argument" Jsont.string ~enc:(fun r -> r.argument)

     

       747
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun r -> r.unknown)

     

       748
       +
           |> Jsont.Object.finish

     

       749
       +
       

     

       750
       +
         type result = {

     

       751
       +
           completion : string list;

     

       752
       +
           total : int option;

     

       753
       +
           has_more : bool option;

     

       754
       +
           unknown : Jsont.json;

     

       755
       +
         }

     

       756
       +
       

     

       757
       +
         let make_result ~completion ?total ?has_more () =

     

       758
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       759
       +
           { completion; total; has_more; unknown }

     

       760
       +
       

     

       761
       +
         let result_jsont : result Jsont.t =

     

       762
       +
           let make completion total has_more unknown =

     

       763
       +
             { completion; total; has_more; unknown }

     

       764
       +
           in

     

       765
       +
           Jsont.Object.map ~kind:"CompletionResult" make

     

       766
       +
           |> Jsont.Object.mem "completion" (Jsont.list Jsont.string)

     

       767
       +
               ~enc:(fun r -> r.completion)

     

       768
       +
           |> Jsont.Object.opt_mem "total" Jsont.int ~enc:(fun r -> r.total)

     

       769
       +
           |> Jsont.Object.opt_mem "hasMore" Jsont.bool ~enc:(fun r -> r.has_more)

     

       770
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun r -> r.unknown)

     

       771
       +
           |> Jsont.Object.finish

     

       772
       +
       

     

       773
       +
         let method_ = "completion/complete"

     

       774
       +
       end

     

       775
       +
       

     

       776
       +
       (* Roots *)

     

       777
       +
       

     

       778
       +
       module Roots = struct

     

       779
       +
         type root = {

     

       780
       +
           uri : string;

     

       781
       +
           name : string option;

     

       782
       +
           unknown : Jsont.json;

     

       783
       +
         }

     

       784
       +
       

     

       785
       +
         let make_root ~uri ?name () =

     

       786
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       787
       +
           { uri; name; unknown }

     

       788
       +
       

     

       789
       +
         let root_jsont : root Jsont.t =

     

       790
       +
           let make uri name unknown = { uri; name; unknown } in

     

       791
       +
           Jsont.Object.map ~kind:"Root" make

     

       792
       +
           |> Jsont.Object.mem "uri" Jsont.string ~enc:(fun r -> r.uri)

     

       793
       +
           |> Jsont.Object.opt_mem "name" Jsont.string ~enc:(fun r -> r.name)

     

       794
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun r -> r.unknown)

     

       795
       +
           |> Jsont.Object.finish

     

       796
       +
       

     

       797
       +
         type list_request = {

     

       798
       +
           unknown : Jsont.json;

     

       799
       +
         }

     

       800
       +
       

     

       801
       +
         let make_list_request () =

     

       802
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       803
       +
           { unknown }

     

       804
       +
       

     

       805
       +
         let list_request_jsont : list_request Jsont.t =

     

       806
       +
           let make unknown = { unknown } in

     

       807
       +
           Jsont.Object.map ~kind:"RootsListRequest" make

     

       808
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun r -> r.unknown)

     

       809
       +
           |> Jsont.Object.finish

     

       810
       +
       

     

       811
       +
         type list_result = {

     

       812
       +
           roots : root list;

     

       813
       +
           unknown : Jsont.json;

     

       814
       +
         }

     

       815
       +
       

     

       816
       +
         let make_list_result ~roots =

     

       817
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       818
       +
           { roots; unknown }

     

       819
       +
       

     

       820
       +
         let list_result_jsont : list_result Jsont.t =

     

       821
       +
           let make roots unknown = { roots; unknown } in

     

       822
       +
           Jsont.Object.map ~kind:"RootsListResult" make

     

       823
       +
           |> Jsont.Object.mem "roots" (Jsont.list root_jsont)

     

       824
       +
               ~enc:(fun r -> r.roots)

     

       825
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun r -> r.unknown)

     

       826
       +
           |> Jsont.Object.finish

     

       827
       +
       

     

       828
       +
         type list_changed_notification = {

     

       829
       +
           unknown : Jsont.json;

     

       830
       +
         }

     

       831
       +
       

     

       832
       +
         let make_list_changed_notification () =

     

       833
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       834
       +
           { unknown }

     

       835
       +
       

     

       836
       +
         let list_changed_notification_jsont : list_changed_notification Jsont.t =

     

       837
       +
           let make unknown = { unknown } in

     

       838
       +
           Jsont.Object.map ~kind:"RootsListChangedNotification" make

     

       839
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun n -> n.unknown)

     

       840
       +
           |> Jsont.Object.finish

     

       841
       +
       

     

       842
       +
         let list_method = "roots/list"

     

       843
       +
         let list_changed_notification_method = "notifications/roots/list_changed"

     

       844
       +
       end

     

       845
       +
       

     

       846
       +
       (* Progress *)

     

       847
       +
       

     

       848
       +
       module Progress = struct

     

       849
       +
         type notification = {

     

       850
       +
           progress_token : string;

     

       851
       +
           progress : float;

     

       852
       +
           total : float option;

     

       853
       +
           unknown : Jsont.json;

     

       854
       +
         }

     

       855
       +
       

     

       856
       +
         let make_notification ~progress_token ~progress ?total () =

     

       857
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       858
       +
           { progress_token; progress; total; unknown }

     

       859
       +
       

     

       860
       +
         let notification_jsont : notification Jsont.t =

     

       861
       +
           let make progress_token progress total unknown =

     

       862
       +
             { progress_token; progress; total; unknown }

     

       863
       +
           in

     

       864
       +
           Jsont.Object.map ~kind:"ProgressNotification" make

     

       865
       +
           |> Jsont.Object.mem "progressToken" Jsont.string

     

       866
       +
               ~enc:(fun n -> n.progress_token)

     

       867
       +
           |> Jsont.Object.mem "progress" Jsont.number ~enc:(fun n -> n.progress)

     

       868
       +
           |> Jsont.Object.opt_mem "total" Jsont.number ~enc:(fun n -> n.total)

     

       869
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun n -> n.unknown)

     

       870
       +
           |> Jsont.Object.finish

     

       871
       +
       

     

       872
       +
         let method_ = "notifications/progress"

     

       873
       +
       end

     

       874
       +
       

     

       875
       +
       (* Cancellation *)

     

       876
       +
       

     

       877
       +
       module Cancellation = struct

     

       878
       +
         type notification = {

     

       879
       +
           request_id : Jsonrpc.Id.t;

     

       880
       +
           reason : string option;

     

       881
       +
           unknown : Jsont.json;

     

       882
       +
         }

     

       883
       +
       

     

       884
       +
         let make_notification ~request_id ?reason () =

     

       885
       +
           let unknown = Jsont.Object ([], Jsont.Meta.none) in

     

       886
       +
           { request_id; reason; unknown }

     

       887
       +
       

     

       888
       +
         let notification_jsont : notification Jsont.t =

     

       889
       +
           let make request_id reason unknown =

     

       890
       +
             { request_id; reason; unknown }

     

       891
       +
           in

     

       892
       +
           Jsont.Object.map ~kind:"CancellationNotification" make

     

       893
       +
           |> Jsont.Object.mem "requestId" Jsonrpc.Id.jsont

     

       894
       +
               ~enc:(fun n -> n.request_id)

     

       895
       +
           |> Jsont.Object.opt_mem "reason" Jsont.string ~enc:(fun n -> n.reason)

     

       896
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun n -> n.unknown)

     

       897
       +
           |> Jsont.Object.finish

     

       898
       +
       

     

       899
       +
         let method_ = "notifications/cancelled"

     

       900
       +
       end

+660

claudeio/lib_mcp/messages.mli

···

       1
       +
       (** MCP Protocol Messages.

     

       2
       +
       

     

       3
       +
           This module provides all protocol message types for the Model Context Protocol (MCP).

     

       4
       +
           It includes initialization, resources, tools, prompts, logging, and other protocol messages.

     

       5
       +
       

     

       6
       +
           All types include unknown field preservation for forward compatibility. *)

     

       7
       +
       

     

       8
       +
       (** {1 Protocol Version} *)

     

       9
       +
       

     

       10
       +
       type protocol_version = string

     

       11
       +
       (** MCP protocol version string (e.g., "2024-11-05") *)

     

       12
       +
       

     

       13
       +
       val protocol_version_jsont : protocol_version Jsont.t

     

       14
       +
       

     

       15
       +
       (** {1 Initialize Protocol} *)

     

       16
       +
       

     

       17
       +
       module Initialize : sig

     

       18
       +
         (** Initialize request parameters *)

     

       19
       +
         type request_params = {

     

       20
       +
           protocol_version : protocol_version;

     

       21
       +
           capabilities : Capabilities.Client.t;

     

       22
       +
           client_info : Capabilities.Implementation.t;

     

       23
       +
           unknown : Jsont.json;

     

       24
       +
         }

     

       25
       +
       

     

       26
       +
         val make_request_params :

     

       27
       +
           protocol_version:protocol_version ->

     

       28
       +
           capabilities:Capabilities.Client.t ->

     

       29
       +
           client_info:Capabilities.Implementation.t ->

     

       30
       +
           unit ->

     

       31
       +
           request_params

     

       32
       +
       

     

       33
       +
         val request_params_jsont : request_params Jsont.t

     

       34
       +
       

     

       35
       +
         (** Initialize result *)

     

       36
       +
         type result = {

     

       37
       +
           protocol_version : protocol_version;

     

       38
       +
           capabilities : Capabilities.Server.t;

     

       39
       +
           server_info : Capabilities.Implementation.t;

     

       40
       +
           instructions : string option;

     

       41
       +
           unknown : Jsont.json;

     

       42
       +
         }

     

       43
       +
       

     

       44
       +
         val make_result :

     

       45
       +
           protocol_version:protocol_version ->

     

       46
       +
           capabilities:Capabilities.Server.t ->

     

       47
       +
           server_info:Capabilities.Implementation.t ->

     

       48
       +
           ?instructions:string ->

     

       49
       +
           unit ->

     

       50
       +
           result

     

       51
       +
       

     

       52
       +
         val result_jsont : result Jsont.t

     

       53
       +
       

     

       54
       +
         val method_ : string

     

       55
       +
         (** Method name: "initialize" *)

     

       56
       +
       end

     

       57
       +
       

     

       58
       +
       module Initialized : sig

     

       59
       +
         (** Initialized notification (sent after initialize completes) *)

     

       60
       +
         type notification = {

     

       61
       +
           unknown : Jsont.json;

     

       62
       +
         }

     

       63
       +
       

     

       64
       +
         val make_notification : unit -> notification

     

       65
       +
         val notification_jsont : notification Jsont.t

     

       66
       +
       

     

       67
       +
         val method_ : string

     

       68
       +
         (** Method name: "notifications/initialized" *)

     

       69
       +
       end

     

       70
       +
       

     

       71
       +
       module Ping : sig

     

       72
       +
         (** Ping request (keepalive) *)

     

       73
       +
         type params = {

     

       74
       +
           unknown : Jsont.json;

     

       75
       +
         }

     

       76
       +
       

     

       77
       +
         val make_params : unit -> params

     

       78
       +
         val params_jsont : params Jsont.t

     

       79
       +
       

     

       80
       +
         (** Ping result (empty object) *)

     

       81
       +
         type result = {

     

       82
       +
           unknown : Jsont.json;

     

       83
       +
         }

     

       84
       +
       

     

       85
       +
         val make_result : unit -> result

     

       86
       +
         val result_jsont : result Jsont.t

     

       87
       +
       

     

       88
       +
         val method_ : string

     

       89
       +
         (** Method name: "ping" *)

     

       90
       +
       end

     

       91
       +
       

     

       92
       +
       (** {1 Resources} *)

     

       93
       +
       

     

       94
       +
       module Resources : sig

     

       95
       +
         (** Resource descriptor *)

     

       96
       +
         type resource = {

     

       97
       +
           uri : string;

     

       98
       +
           name : string;

     

       99
       +
           description : string option;

     

       100
       +
           mime_type : string option;

     

       101
       +
           unknown : Jsont.json;

     

       102
       +
         }

     

       103
       +
       

     

       104
       +
         val make_resource :

     

       105
       +
           uri:string ->

     

       106
       +
           name:string ->

     

       107
       +
           ?description:string ->

     

       108
       +
           ?mime_type:string ->

     

       109
       +
           unit ->

     

       110
       +
           resource

     

       111
       +
       

     

       112
       +
         val resource_jsont : resource Jsont.t

     

       113
       +
       

     

       114
       +
         (** Resource template (URI template with placeholders) *)

     

       115
       +
         type resource_template = {

     

       116
       +
           uri_template : string;

     

       117
       +
           name : string;

     

       118
       +
           description : string option;

     

       119
       +
           mime_type : string option;

     

       120
       +
           unknown : Jsont.json;

     

       121
       +
         }

     

       122
       +
       

     

       123
       +
         val make_resource_template :

     

       124
       +
           uri_template:string ->

     

       125
       +
           name:string ->

     

       126
       +
           ?description:string ->

     

       127
       +
           ?mime_type:string ->

     

       128
       +
           unit ->

     

       129
       +
           resource_template

     

       130
       +
       

     

       131
       +
         val resource_template_jsont : resource_template Jsont.t

     

       132
       +
       

     

       133
       +
         (** Resource contents (from read request) *)

     

       134
       +
         type resource_contents = {

     

       135
       +
           uri : string;

     

       136
       +
           mime_type : string option;

     

       137
       +
           text : string option;

     

       138
       +
           blob : string option;  (** Base64-encoded binary data *)

     

       139
       +
           unknown : Jsont.json;

     

       140
       +
         }

     

       141
       +
       

     

       142
       +
         val make_text_contents :

     

       143
       +
           uri:string ->

     

       144
       +
           text:string ->

     

       145
       +
           ?mime_type:string ->

     

       146
       +
           unit ->

     

       147
       +
           resource_contents

     

       148
       +
       

     

       149
       +
         val make_blob_contents :

     

       150
       +
           uri:string ->

     

       151
       +
           blob:string ->

     

       152
       +
           mime_type:string ->

     

       153
       +
           resource_contents

     

       154
       +
       

     

       155
       +
         val resource_contents_jsont : resource_contents Jsont.t

     

       156
       +
       

     

       157
       +
         (** List resources request *)

     

       158
       +
         type list_request = {

     

       159
       +
           cursor : string option;

     

       160
       +
           unknown : Jsont.json;

     

       161
       +
         }

     

       162
       +
       

     

       163
       +
         val make_list_request : ?cursor:string -> unit -> list_request

     

       164
       +
         val list_request_jsont : list_request Jsont.t

     

       165
       +
       

     

       166
       +
         (** List resources result *)

     

       167
       +
         type list_result = {

     

       168
       +
           resources : resource list;

     

       169
       +
           next_cursor : string option;

     

       170
       +
           unknown : Jsont.json;

     

       171
       +
         }

     

       172
       +
       

     

       173
       +
         val make_list_result :

     

       174
       +
           resources:resource list ->

     

       175
       +
           ?next_cursor:string ->

     

       176
       +
           unit ->

     

       177
       +
           list_result

     

       178
       +
       

     

       179
       +
         val list_result_jsont : list_result Jsont.t

     

       180
       +
       

     

       181
       +
         (** Read resource request *)

     

       182
       +
         type read_request = {

     

       183
       +
           uri : string;

     

       184
       +
           unknown : Jsont.json;

     

       185
       +
         }

     

       186
       +
       

     

       187
       +
         val make_read_request : uri:string -> read_request

     

       188
       +
         val read_request_jsont : read_request Jsont.t

     

       189
       +
       

     

       190
       +
         (** Read resource result *)

     

       191
       +
         type read_result = {

     

       192
       +
           contents : resource_contents list;

     

       193
       +
           unknown : Jsont.json;

     

       194
       +
         }

     

       195
       +
       

     

       196
       +
         val make_read_result : contents:resource_contents list -> read_result

     

       197
       +
         val read_result_jsont : read_result Jsont.t

     

       198
       +
       

     

       199
       +
         (** Subscribe to resource updates *)

     

       200
       +
         type subscribe_request = {

     

       201
       +
           uri : string;

     

       202
       +
           unknown : Jsont.json;

     

       203
       +
         }

     

       204
       +
       

     

       205
       +
         val make_subscribe_request : uri:string -> subscribe_request

     

       206
       +
         val subscribe_request_jsont : subscribe_request Jsont.t

     

       207
       +
       

     

       208
       +
         (** Unsubscribe from resource updates *)

     

       209
       +
         type unsubscribe_request = {

     

       210
       +
           uri : string;

     

       211
       +
           unknown : Jsont.json;

     

       212
       +
         }

     

       213
       +
       

     

       214
       +
         val make_unsubscribe_request : uri:string -> unsubscribe_request

     

       215
       +
         val unsubscribe_request_jsont : unsubscribe_request Jsont.t

     

       216
       +
       

     

       217
       +
         (** Resource updated notification *)

     

       218
       +
         type updated_notification = {

     

       219
       +
           uri : string;

     

       220
       +
           unknown : Jsont.json;

     

       221
       +
         }

     

       222
       +
       

     

       223
       +
         val make_updated_notification : uri:string -> updated_notification

     

       224
       +
         val updated_notification_jsont : updated_notification Jsont.t

     

       225
       +
       

     

       226
       +
         (** Resource list changed notification *)

     

       227
       +
         type list_changed_notification = {

     

       228
       +
           unknown : Jsont.json;

     

       229
       +
         }

     

       230
       +
       

     

       231
       +
         val make_list_changed_notification : unit -> list_changed_notification

     

       232
       +
         val list_changed_notification_jsont : list_changed_notification Jsont.t

     

       233
       +
       

     

       234
       +
         val list_method : string

     

       235
       +
         (** Method name: "resources/list" *)

     

       236
       +
       

     

       237
       +
         val read_method : string

     

       238
       +
         (** Method name: "resources/read" *)

     

       239
       +
       

     

       240
       +
         val subscribe_method : string

     

       241
       +
         (** Method name: "resources/subscribe" *)

     

       242
       +
       

     

       243
       +
         val unsubscribe_method : string

     

       244
       +
         (** Method name: "resources/unsubscribe" *)

     

       245
       +
       

     

       246
       +
         val updated_notification_method : string

     

       247
       +
         (** Method name: "notifications/resources/updated" *)

     

       248
       +
       

     

       249
       +
         val list_changed_notification_method : string

     

       250
       +
         (** Method name: "notifications/resources/list_changed" *)

     

       251
       +
       end

     

       252
       +
       

     

       253
       +
       (** {1 Tools} *)

     

       254
       +
       

     

       255
       +
       module Tools : sig

     

       256
       +
         (** Tool descriptor *)

     

       257
       +
         type tool = {

     

       258
       +
           name : string;

     

       259
       +
           description : string option;

     

       260
       +
           input_schema : Jsont.json;  (** JSON Schema for tool inputs *)

     

       261
       +
           unknown : Jsont.json;

     

       262
       +
         }

     

       263
       +
       

     

       264
       +
         val make_tool :

     

       265
       +
           name:string ->

     

       266
       +
           ?description:string ->

     

       267
       +
           input_schema:Jsont.json ->

     

       268
       +
           unit ->

     

       269
       +
           tool

     

       270
       +
       

     

       271
       +
         val tool_jsont : tool Jsont.t

     

       272
       +
       

     

       273
       +
         (** List tools request *)

     

       274
       +
         type list_request = {

     

       275
       +
           cursor : string option;

     

       276
       +
           unknown : Jsont.json;

     

       277
       +
         }

     

       278
       +
       

     

       279
       +
         val make_list_request : ?cursor:string -> unit -> list_request

     

       280
       +
         val list_request_jsont : list_request Jsont.t

     

       281
       +
       

     

       282
       +
         (** List tools result *)

     

       283
       +
         type list_result = {

     

       284
       +
           tools : tool list;

     

       285
       +
           next_cursor : string option;

     

       286
       +
           unknown : Jsont.json;

     

       287
       +
         }

     

       288
       +
       

     

       289
       +
         val make_list_result :

     

       290
       +
           tools:tool list ->

     

       291
       +
           ?next_cursor:string ->

     

       292
       +
           unit ->

     

       293
       +
           list_result

     

       294
       +
       

     

       295
       +
         val list_result_jsont : list_result Jsont.t

     

       296
       +
       

     

       297
       +
         (** Call tool request *)

     

       298
       +
         type call_request = {

     

       299
       +
           name : string;

     

       300
       +
           arguments : Jsont.json option;

     

       301
       +
           unknown : Jsont.json;

     

       302
       +
         }

     

       303
       +
       

     

       304
       +
         val make_call_request :

     

       305
       +
           name:string ->

     

       306
       +
           ?arguments:Jsont.json ->

     

       307
       +
           unit ->

     

       308
       +
           call_request

     

       309
       +
       

     

       310
       +
         val call_request_jsont : call_request Jsont.t

     

       311
       +
       

     

       312
       +
         (** Call tool result *)

     

       313
       +
         type call_result = {

     

       314
       +
           content : Content.block list;

     

       315
       +
           is_error : bool option;

     

       316
       +
           unknown : Jsont.json;

     

       317
       +
         }

     

       318
       +
       

     

       319
       +
         val make_call_result :

     

       320
       +
           content:Content.block list ->

     

       321
       +
           ?is_error:bool ->

     

       322
       +
           unit ->

     

       323
       +
           call_result

     

       324
       +
       

     

       325
       +
         val call_result_jsont : call_result Jsont.t

     

       326
       +
       

     

       327
       +
         (** Tool list changed notification *)

     

       328
       +
         type list_changed_notification = {

     

       329
       +
           unknown : Jsont.json;

     

       330
       +
         }

     

       331
       +
       

     

       332
       +
         val make_list_changed_notification : unit -> list_changed_notification

     

       333
       +
         val list_changed_notification_jsont : list_changed_notification Jsont.t

     

       334
       +
       

     

       335
       +
         val list_method : string

     

       336
       +
         (** Method name: "tools/list" *)

     

       337
       +
       

     

       338
       +
         val call_method : string

     

       339
       +
         (** Method name: "tools/call" *)

     

       340
       +
       

     

       341
       +
         val list_changed_notification_method : string

     

       342
       +
         (** Method name: "notifications/tools/list_changed" *)

     

       343
       +
       end

     

       344
       +
       

     

       345
       +
       (** {1 Prompts} *)

     

       346
       +
       

     

       347
       +
       module Prompts : sig

     

       348
       +
         (** Prompt argument descriptor *)

     

       349
       +
         type prompt_argument = {

     

       350
       +
           name : string;

     

       351
       +
           description : string option;

     

       352
       +
           required : bool option;

     

       353
       +
           unknown : Jsont.json;

     

       354
       +
         }

     

       355
       +
       

     

       356
       +
         val make_prompt_argument :

     

       357
       +
           name:string ->

     

       358
       +
           ?description:string ->

     

       359
       +
           ?required:bool ->

     

       360
       +
           unit ->

     

       361
       +
           prompt_argument

     

       362
       +
       

     

       363
       +
         val prompt_argument_jsont : prompt_argument Jsont.t

     

       364
       +
       

     

       365
       +
         (** Prompt descriptor *)

     

       366
       +
         type prompt = {

     

       367
       +
           name : string;

     

       368
       +
           description : string option;

     

       369
       +
           arguments : prompt_argument list option;

     

       370
       +
           unknown : Jsont.json;

     

       371
       +
         }

     

       372
       +
       

     

       373
       +
         val make_prompt :

     

       374
       +
           name:string ->

     

       375
       +
           ?description:string ->

     

       376
       +
           ?arguments:prompt_argument list ->

     

       377
       +
           unit ->

     

       378
       +
           prompt

     

       379
       +
       

     

       380
       +
         val prompt_jsont : prompt Jsont.t

     

       381
       +
       

     

       382
       +
         (** Prompt message role *)

     

       383
       +
         type role = User | Assistant

     

       384
       +
       

     

       385
       +
         val role_jsont : role Jsont.t

     

       386
       +
       

     

       387
       +
         (** Prompt message *)

     

       388
       +
         type prompt_message = {

     

       389
       +
           role : role;

     

       390
       +
           content : Content.block list;

     

       391
       +
           unknown : Jsont.json;

     

       392
       +
         }

     

       393
       +
       

     

       394
       +
         val make_prompt_message :

     

       395
       +
           role:role ->

     

       396
       +
           content:Content.block list ->

     

       397
       +
           unit ->

     

       398
       +
           prompt_message

     

       399
       +
       

     

       400
       +
         val prompt_message_jsont : prompt_message Jsont.t

     

       401
       +
       

     

       402
       +
         (** List prompts request *)

     

       403
       +
         type list_request = {

     

       404
       +
           cursor : string option;

     

       405
       +
           unknown : Jsont.json;

     

       406
       +
         }

     

       407
       +
       

     

       408
       +
         val make_list_request : ?cursor:string -> unit -> list_request

     

       409
       +
         val list_request_jsont : list_request Jsont.t

     

       410
       +
       

     

       411
       +
         (** List prompts result *)

     

       412
       +
         type list_result = {

     

       413
       +
           prompts : prompt list;

     

       414
       +
           next_cursor : string option;

     

       415
       +
           unknown : Jsont.json;

     

       416
       +
         }

     

       417
       +
       

     

       418
       +
         val make_list_result :

     

       419
       +
           prompts:prompt list ->

     

       420
       +
           ?next_cursor:string ->

     

       421
       +
           unit ->

     

       422
       +
           list_result

     

       423
       +
       

     

       424
       +
         val list_result_jsont : list_result Jsont.t

     

       425
       +
       

     

       426
       +
         (** Get prompt request *)

     

       427
       +
         type get_request = {

     

       428
       +
           name : string;

     

       429
       +
           arguments : (string * string) list option;  (** Key-value pairs *)

     

       430
       +
           unknown : Jsont.json;

     

       431
       +
         }

     

       432
       +
       

     

       433
       +
         val make_get_request :

     

       434
       +
           name:string ->

     

       435
       +
           ?arguments:(string * string) list ->

     

       436
       +
           unit ->

     

       437
       +
           get_request

     

       438
       +
       

     

       439
       +
         val get_request_jsont : get_request Jsont.t

     

       440
       +
       

     

       441
       +
         (** Get prompt result *)

     

       442
       +
         type get_result = {

     

       443
       +
           description : string option;

     

       444
       +
           messages : prompt_message list;

     

       445
       +
           unknown : Jsont.json;

     

       446
       +
         }

     

       447
       +
       

     

       448
       +
         val make_get_result :

     

       449
       +
           ?description:string ->

     

       450
       +
           messages:prompt_message list ->

     

       451
       +
           unit ->

     

       452
       +
           get_result

     

       453
       +
       

     

       454
       +
         val get_result_jsont : get_result Jsont.t

     

       455
       +
       

     

       456
       +
         (** Prompt list changed notification *)

     

       457
       +
         type list_changed_notification = {

     

       458
       +
           unknown : Jsont.json;

     

       459
       +
         }

     

       460
       +
       

     

       461
       +
         val make_list_changed_notification : unit -> list_changed_notification

     

       462
       +
         val list_changed_notification_jsont : list_changed_notification Jsont.t

     

       463
       +
       

     

       464
       +
         val list_method : string

     

       465
       +
         (** Method name: "prompts/list" *)

     

       466
       +
       

     

       467
       +
         val get_method : string

     

       468
       +
         (** Method name: "prompts/get" *)

     

       469
       +
       

     

       470
       +
         val list_changed_notification_method : string

     

       471
       +
         (** Method name: "notifications/prompts/list_changed" *)

     

       472
       +
       end

     

       473
       +
       

     

       474
       +
       (** {1 Logging} *)

     

       475
       +
       

     

       476
       +
       module Logging : sig

     

       477
       +
         (** Log level *)

     

       478
       +
         type level =

     

       479
       +
           | Debug

     

       480
       +
           | Info

     

       481
       +
           | Notice

     

       482
       +
           | Warning

     

       483
       +
           | Error

     

       484
       +
           | Critical

     

       485
       +
           | Alert

     

       486
       +
           | Emergency

     

       487
       +
       

     

       488
       +
         val level_jsont : level Jsont.t

     

       489
       +
         val level_to_string : level -> string

     

       490
       +
       

     

       491
       +
         (** Logging message notification *)

     

       492
       +
         type notification = {

     

       493
       +
           level : level;

     

       494
       +
           logger : string option;

     

       495
       +
           data : Jsont.json option;

     

       496
       +
           unknown : Jsont.json;

     

       497
       +
         }

     

       498
       +
       

     

       499
       +
         val make_notification :

     

       500
       +
           level:level ->

     

       501
       +
           ?logger:string ->

     

       502
       +
           ?data:Jsont.json ->

     

       503
       +
           unit ->

     

       504
       +
           notification

     

       505
       +
       

     

       506
       +
         val notification_jsont : notification Jsont.t

     

       507
       +
       

     

       508
       +
         val method_ : string

     

       509
       +
         (** Method name: "notifications/message" *)

     

       510
       +
       end

     

       511
       +
       

     

       512
       +
       (** {1 Completions} *)

     

       513
       +
       

     

       514
       +
       module Completions : sig

     

       515
       +
         (** Completion reference (argument or resource URI) *)

     

       516
       +
         type completion_ref = {

     

       517
       +
           ref_type : string;  (** "ref/prompt" or "ref/resource" *)

     

       518
       +
           uri : string;

     

       519
       +
           unknown : Jsont.json;

     

       520
       +
         }

     

       521
       +
       

     

       522
       +
         val make_completion_ref :

     

       523
       +
           ref_type:string ->

     

       524
       +
           uri:string ->

     

       525
       +
           unit ->

     

       526
       +
           completion_ref

     

       527
       +
       

     

       528
       +
         val completion_ref_jsont : completion_ref Jsont.t

     

       529
       +
       

     

       530
       +
         (** Completion request *)

     

       531
       +
         type request = {

     

       532
       +
           ref_ : completion_ref;

     

       533
       +
           argument : string option;

     

       534
       +
           unknown : Jsont.json;

     

       535
       +
         }

     

       536
       +
       

     

       537
       +
         val make_request :

     

       538
       +
           ref_:completion_ref ->

     

       539
       +
           ?argument:string ->

     

       540
       +
           unit ->

     

       541
       +
           request

     

       542
       +
       

     

       543
       +
         val request_jsont : request Jsont.t

     

       544
       +
       

     

       545
       +
         (** Completion result *)

     

       546
       +
         type result = {

     

       547
       +
           completion : string list;

     

       548
       +
           total : int option;

     

       549
       +
           has_more : bool option;

     

       550
       +
           unknown : Jsont.json;

     

       551
       +
         }

     

       552
       +
       

     

       553
       +
         val make_result :

     

       554
       +
           completion:string list ->

     

       555
       +
           ?total:int ->

     

       556
       +
           ?has_more:bool ->

     

       557
       +
           unit ->

     

       558
       +
           result

     

       559
       +
       

     

       560
       +
         val result_jsont : result Jsont.t

     

       561
       +
       

     

       562
       +
         val method_ : string

     

       563
       +
         (** Method name: "completion/complete" *)

     

       564
       +
       end

     

       565
       +
       

     

       566
       +
       (** {1 Roots} *)

     

       567
       +
       

     

       568
       +
       module Roots : sig

     

       569
       +
         (** Root descriptor *)

     

       570
       +
         type root = {

     

       571
       +
           uri : string;

     

       572
       +
           name : string option;

     

       573
       +
           unknown : Jsont.json;

     

       574
       +
         }

     

       575
       +
       

     

       576
       +
         val make_root :

     

       577
       +
           uri:string ->

     

       578
       +
           ?name:string ->

     

       579
       +
           unit ->

     

       580
       +
           root

     

       581
       +
       

     

       582
       +
         val root_jsont : root Jsont.t

     

       583
       +
       

     

       584
       +
         (** List roots request *)

     

       585
       +
         type list_request = {

     

       586
       +
           unknown : Jsont.json;

     

       587
       +
         }

     

       588
       +
       

     

       589
       +
         val make_list_request : unit -> list_request

     

       590
       +
         val list_request_jsont : list_request Jsont.t

     

       591
       +
       

     

       592
       +
         (** List roots result *)

     

       593
       +
         type list_result = {

     

       594
       +
           roots : root list;

     

       595
       +
           unknown : Jsont.json;

     

       596
       +
         }

     

       597
       +
       

     

       598
       +
         val make_list_result : roots:root list -> list_result

     

       599
       +
         val list_result_jsont : list_result Jsont.t

     

       600
       +
       

     

       601
       +
         (** Roots list changed notification *)

     

       602
       +
         type list_changed_notification = {

     

       603
       +
           unknown : Jsont.json;

     

       604
       +
         }

     

       605
       +
       

     

       606
       +
         val make_list_changed_notification : unit -> list_changed_notification

     

       607
       +
         val list_changed_notification_jsont : list_changed_notification Jsont.t

     

       608
       +
       

     

       609
       +
         val list_method : string

     

       610
       +
         (** Method name: "roots/list" *)

     

       611
       +
       

     

       612
       +
         val list_changed_notification_method : string

     

       613
       +
         (** Method name: "notifications/roots/list_changed" *)

     

       614
       +
       end

     

       615
       +
       

     

       616
       +
       (** {1 Progress} *)

     

       617
       +
       

     

       618
       +
       module Progress : sig

     

       619
       +
         (** Progress notification *)

     

       620
       +
         type notification = {

     

       621
       +
           progress_token : string;  (** Unique token identifying the operation *)

     

       622
       +
           progress : float;         (** Progress value (0.0 to 1.0) *)

     

       623
       +
           total : float option;     (** Optional total value *)

     

       624
       +
           unknown : Jsont.json;

     

       625
       +
         }

     

       626
       +
       

     

       627
       +
         val make_notification :

     

       628
       +
           progress_token:string ->

     

       629
       +
           progress:float ->

     

       630
       +
           ?total:float ->

     

       631
       +
           unit ->

     

       632
       +
           notification

     

       633
       +
       

     

       634
       +
         val notification_jsont : notification Jsont.t

     

       635
       +
       

     

       636
       +
         val method_ : string

     

       637
       +
         (** Method name: "notifications/progress" *)

     

       638
       +
       end

     

       639
       +
       

     

       640
       +
       (** {1 Cancellation} *)

     

       641
       +
       

     

       642
       +
       module Cancellation : sig

     

       643
       +
         (** Cancel request notification *)

     

       644
       +
         type notification = {

     

       645
       +
           request_id : Jsonrpc.Id.t;

     

       646
       +
           reason : string option;

     

       647
       +
           unknown : Jsont.json;

     

       648
       +
         }

     

       649
       +
       

     

       650
       +
         val make_notification :

     

       651
       +
           request_id:Jsonrpc.Id.t ->

     

       652
       +
           ?reason:string ->

     

       653
       +
           unit ->

     

       654
       +
           notification

     

       655
       +
       

     

       656
       +
         val notification_jsont : notification Jsont.t

     

       657
       +
       

     

       658
       +
         val method_ : string

     

       659
       +
         (** Method name: "notifications/cancelled" *)

     

       660
       +
       end

+371

claudeio/lib_mcp/server_session.ml

···

       1
       +
       (** High-level MCP server session API *)

     

       2
       +
       

     

       3
       +
       (** {1 Types} *)

     

       4
       +
       

     

       5
       +
       type config = {

     

       6
       +
         server_info : Capabilities.Implementation.t;

     

       7
       +
         server_capabilities : Capabilities.Server.t;

     

       8
       +
         instructions : string option;

     

       9
       +
       }

     

       10
       +
       

     

       11
       +
       type handlers = {

     

       12
       +
         list_resources : (cursor:string option -> Messages.Resources.list_result) option;

     

       13
       +
         list_resource_templates : (cursor:string option -> Messages.Resources.list_result) option;

     

       14
       +
         read_resource : (uri:string -> Messages.Resources.read_result) option;

     

       15
       +
         subscribe_resource : (uri:string -> unit) option;

     

       16
       +
         unsubscribe_resource : (uri:string -> unit) option;

     

       17
       +
         list_tools : (cursor:string option -> Messages.Tools.list_result) option;

     

       18
       +
         call_tool : (name:string -> arguments:Jsont.json option -> Messages.Tools.call_result) option;

     

       19
       +
         list_prompts : (cursor:string option -> Messages.Prompts.list_result) option;

     

       20
       +
         get_prompt : (name:string -> arguments:(string * string) list option -> Messages.Prompts.get_result) option;

     

       21
       +
         complete : (ref_:Messages.Completions.completion_ref -> argument:string -> Messages.Completions.result) option;

     

       22
       +
         ping : (unit -> unit) option;

     

       23
       +
       }

     

       24
       +
       

     

       25
       +
       type t = {

     

       26
       +
         session : Session.t;

     

       27
       +
         config : config;

     

       28
       +
         handlers : handlers;

     

       29
       +
         mutable client_capabilities : Capabilities.Client.t option;

     

       30
       +
         mutable client_info : Capabilities.Implementation.t option;

     

       31
       +
         mutable protocol_version : string option;

     

       32
       +
         mutable initialized : bool;

     

       33
       +
       }

     

       34
       +
       

     

       35
       +
       (** {1 Helper Functions} *)

     

       36
       +
       

     

       37
       +
       let encode_json jsont value =

     

       38
       +
         match Jsont.Json.encode jsont value with

     

       39
       +
         | Ok json -> json

     

       40
       +
         | Error e -> failwith ("Failed to encode JSON: " ^ e)

     

       41
       +
       

     

       42
       +
       let decode_json jsont json =

     

       43
       +
         match Jsont.Json.decode jsont json with

     

       44
       +
         | Ok value -> value

     

       45
       +
         | Error e -> failwith ("Failed to decode JSON: " ^ e)

     

       46
       +
       

     

       47
       +
       let method_not_found method_ =

     

       48
       +
         let error = Jsonrpc.Error_data.make

     

       49
       +
           ~code:Method_not_found

     

       50
       +
           ~message:(Printf.sprintf "Method not found: %s" method_)

     

       51
       +
           ()

     

       52
       +
         in

     

       53
       +
         raise (Session.Remote_error error)

     

       54
       +
       

     

       55
       +
       let invalid_params method_ msg =

     

       56
       +
         let error = Jsonrpc.Error_data.make

     

       57
       +
           ~code:Invalid_params

     

       58
       +
           ~message:(Printf.sprintf "Invalid params for %s: %s" method_ msg)

     

       59
       +
           ()

     

       60
       +
         in

     

       61
       +
         raise (Session.Remote_error error)

     

       62
       +
       

     

       63
       +
       (** {1 Request Handler} *)

     

       64
       +
       

     

       65
       +
       let handle_request t ~method_ ~params =

     

       66
       +
         (* Ensure initialization has completed for non-init requests *)

     

       67
       +
         if method_ <> Messages.Initialize.method_ && not t.initialized then begin

     

       68
       +
           let error = Jsonrpc.Error_data.make

     

       69
       +
             ~code:Internal_error

     

       70
       +
             ~message:"Server not initialized"

     

       71
       +
             ()

     

       72
       +
           in

     

       73
       +
           raise (Session.Remote_error error)

     

       74
       +
         end;

     

       75
       +
       

     

       76
       +
         (* Route to appropriate handler *)

     

       77
       +
         match method_ with

     

       78
       +
         | m when m = Messages.Initialize.method_ ->

     

       79
       +
             (* Handle initialization *)

     

       80
       +
             let req_params = match params with

     

       81
       +
               | Some p -> decode_json Messages.Initialize.request_params_jsont p

     

       82
       +
               | None -> invalid_params method_ "missing params"

     

       83
       +
             in

     

       84
       +
       

     

       85
       +
             (* Store client info *)

     

       86
       +
             t.client_capabilities <- Some req_params.capabilities;

     

       87
       +
             t.client_info <- Some req_params.client_info;

     

       88
       +
             t.protocol_version <- Some req_params.protocol_version;

     

       89
       +
       

     

       90
       +
             (* Build response *)

     

       91
       +
             let result = Messages.Initialize.make_result

     

       92
       +
               ~protocol_version:req_params.protocol_version

     

       93
       +
               ~capabilities:t.config.server_capabilities

     

       94
       +
               ~server_info:t.config.server_info

     

       95
       +
               ?instructions:t.config.instructions

     

       96
       +
               ()

     

       97
       +
             in

     

       98
       +
             encode_json Messages.Initialize.result_jsont result

     

       99
       +
       

     

       100
       +
         | m when m = Messages.Ping.method_ ->

     

       101
       +
             let handler = t.handlers.ping in

     

       102
       +
             (match handler with

     

       103
       +
              | None -> method_not_found method_

     

       104
       +
              | Some h ->

     

       105
       +
                  h ();

     

       106
       +
                  let result = Messages.Ping.make_result () in

     

       107
       +
                  encode_json Messages.Ping.result_jsont result)

     

       108
       +
       

     

       109
       +
         | m when m = Messages.Resources.list_method ->

     

       110
       +
             let handler = t.handlers.list_resources in

     

       111
       +
             (match handler with

     

       112
       +
              | None -> method_not_found method_

     

       113
       +
              | Some h ->

     

       114
       +
                  let req = match params with

     

       115
       +
                    | Some p -> decode_json Messages.Resources.list_request_jsont p

     

       116
       +
                    | None -> Messages.Resources.make_list_request ()

     

       117
       +
                  in

     

       118
       +
                  let result = h ~cursor:req.cursor in

     

       119
       +
                  encode_json Messages.Resources.list_result_jsont result)

     

       120
       +
       

     

       121
       +
         | m when m = Messages.Resources.read_method ->

     

       122
       +
             let handler = t.handlers.read_resource in

     

       123
       +
             (match handler with

     

       124
       +
              | None -> method_not_found method_

     

       125
       +
              | Some h ->

     

       126
       +
                  let req = match params with

     

       127
       +
                    | Some p -> decode_json Messages.Resources.read_request_jsont p

     

       128
       +
                    | None -> invalid_params method_ "missing params"

     

       129
       +
                  in

     

       130
       +
                  let result = h ~uri:req.uri in

     

       131
       +
                  encode_json Messages.Resources.read_result_jsont result)

     

       132
       +
       

     

       133
       +
         | m when m = Messages.Resources.subscribe_method ->

     

       134
       +
             let handler = t.handlers.subscribe_resource in

     

       135
       +
             (match handler with

     

       136
       +
              | None -> method_not_found method_

     

       137
       +
              | Some h ->

     

       138
       +
                  let req = match params with

     

       139
       +
                    | Some p -> decode_json Messages.Resources.subscribe_request_jsont p

     

       140
       +
                    | None -> invalid_params method_ "missing params"

     

       141
       +
                  in

     

       142
       +
                  h ~uri:req.uri;

     

       143
       +
                  Jsont.Object ([], Jsont.Meta.none))  (* Empty response *)

     

       144
       +
       

     

       145
       +
         | m when m = Messages.Resources.unsubscribe_method ->

     

       146
       +
             let handler = t.handlers.unsubscribe_resource in

     

       147
       +
             (match handler with

     

       148
       +
              | None -> method_not_found method_

     

       149
       +
              | Some h ->

     

       150
       +
                  let req = match params with

     

       151
       +
                    | Some p -> decode_json Messages.Resources.unsubscribe_request_jsont p

     

       152
       +
                    | None -> invalid_params method_ "missing params"

     

       153
       +
                  in

     

       154
       +
                  h ~uri:req.uri;

     

       155
       +
                  Jsont.Object ([], Jsont.Meta.none))  (* Empty response *)

     

       156
       +
       

     

       157
       +
         | m when m = Messages.Tools.list_method ->

     

       158
       +
             let handler = t.handlers.list_tools in

     

       159
       +
             (match handler with

     

       160
       +
              | None -> method_not_found method_

     

       161
       +
              | Some h ->

     

       162
       +
                  let req = match params with

     

       163
       +
                    | Some p -> decode_json Messages.Tools.list_request_jsont p

     

       164
       +
                    | None -> Messages.Tools.make_list_request ()

     

       165
       +
                  in

     

       166
       +
                  let result = h ~cursor:req.cursor in

     

       167
       +
                  encode_json Messages.Tools.list_result_jsont result)

     

       168
       +
       

     

       169
       +
         | m when m = Messages.Tools.call_method ->

     

       170
       +
             let handler = t.handlers.call_tool in

     

       171
       +
             (match handler with

     

       172
       +
              | None -> method_not_found method_

     

       173
       +
              | Some h ->

     

       174
       +
                  let req = match params with

     

       175
       +
                    | Some p -> decode_json Messages.Tools.call_request_jsont p

     

       176
       +
                    | None -> invalid_params method_ "missing params"

     

       177
       +
                  in

     

       178
       +
                  let result = h ~name:req.name ~arguments:req.arguments in

     

       179
       +
                  encode_json Messages.Tools.call_result_jsont result)

     

       180
       +
       

     

       181
       +
         | m when m = Messages.Prompts.list_method ->

     

       182
       +
             let handler = t.handlers.list_prompts in

     

       183
       +
             (match handler with

     

       184
       +
              | None -> method_not_found method_

     

       185
       +
              | Some h ->

     

       186
       +
                  let req = match params with

     

       187
       +
                    | Some p -> decode_json Messages.Prompts.list_request_jsont p

     

       188
       +
                    | None -> Messages.Prompts.make_list_request ()

     

       189
       +
                  in

     

       190
       +
                  let result = h ~cursor:req.cursor in

     

       191
       +
                  encode_json Messages.Prompts.list_result_jsont result)

     

       192
       +
       

     

       193
       +
         | m when m = Messages.Prompts.get_method ->

     

       194
       +
             let handler = t.handlers.get_prompt in

     

       195
       +
             (match handler with

     

       196
       +
              | None -> method_not_found method_

     

       197
       +
              | Some h ->

     

       198
       +
                  let req = match params with

     

       199
       +
                    | Some p -> decode_json Messages.Prompts.get_request_jsont p

     

       200
       +
                    | None -> invalid_params method_ "missing params"

     

       201
       +
                  in

     

       202
       +
                  let result = h ~name:req.name ~arguments:req.arguments in

     

       203
       +
                  encode_json Messages.Prompts.get_result_jsont result)

     

       204
       +
       

     

       205
       +
         | m when m = Messages.Completions.method_ ->

     

       206
       +
             let handler = t.handlers.complete in

     

       207
       +
             (match handler with

     

       208
       +
              | None -> method_not_found method_

     

       209
       +
              | Some h ->

     

       210
       +
                  let req = match params with

     

       211
       +
                    | Some p -> decode_json Messages.Completions.request_jsont p

     

       212
       +
                    | None -> invalid_params method_ "missing params"

     

       213
       +
                  in

     

       214
       +
                  let argument = match req.argument with

     

       215
       +
                    | Some a -> a

     

       216
       +
                    | None -> ""

     

       217
       +
                  in

     

       218
       +
                  let result = h ~ref_:req.ref_ ~argument in

     

       219
       +
                  encode_json Messages.Completions.result_jsont result)

     

       220
       +
       

     

       221
       +
         | _ ->

     

       222
       +
             method_not_found method_

     

       223
       +
       

     

       224
       +
       (** {1 Notification Handler} *)

     

       225
       +
       

     

       226
       +
       let handle_notification t ~method_ ~params =

     

       227
       +
         match method_ with

     

       228
       +
         | m when m = Messages.Initialized.method_ ->

     

       229
       +
             (* Client has confirmed initialization *)

     

       230
       +
             let _notif = match params with

     

       231
       +
               | Some p -> decode_json Messages.Initialized.notification_jsont p

     

       232
       +
               | None -> Messages.Initialized.make_notification ()

     

       233
       +
             in

     

       234
       +
             t.initialized <- true

     

       235
       +
       

     

       236
       +
         | _ ->

     

       237
       +
             (* Ignore unknown notifications *)

     

       238
       +
             ()

     

       239
       +
       

     

       240
       +
       (** {1 Public API} *)

     

       241
       +
       

     

       242
       +
       let create ~sw ~transport ?timeout ?clock config handlers =

     

       243
       +
         (* Create session with handlers *)

     

       244
       +
         let t_ref = ref None in

     

       245
       +
       

     

       246
       +
         let request_handler ~method_ ~params =

     

       247
       +
           match !t_ref with

     

       248
       +
           | None -> failwith "Server session not initialized"

     

       249
       +
           | Some t -> handle_request t ~method_ ~params

     

       250
       +
         in

     

       251
       +
       

     

       252
       +
         let notification_handler ~method_ ~params =

     

       253
       +
           match !t_ref with

     

       254
       +
           | None -> ()

     

       255
       +
           | Some t -> handle_notification t ~method_ ~params

     

       256
       +
         in

     

       257
       +
       

     

       258
       +
         let session_config = {

     

       259
       +
           Session.transport;

     

       260
       +
           request_handler;

     

       261
       +
           notification_handler;

     

       262
       +
           timeout;

     

       263
       +
           clock;

     

       264
       +
         } in

     

       265
       +
       

     

       266
       +
         let session = Session.create ~sw session_config in

     

       267
       +
       

     

       268
       +
         let t = {

     

       269
       +
           session;

     

       270
       +
           config;

     

       271
       +
           handlers;

     

       272
       +
           client_capabilities = None;

     

       273
       +
           client_info = None;

     

       274
       +
           protocol_version = None;

     

       275
       +
           initialized = false;

     

       276
       +
         } in

     

       277
       +
       

     

       278
       +
         t_ref := Some t;

     

       279
       +
       

     

       280
       +
         t

     

       281
       +
       

     

       282
       +
       let client_capabilities t =

     

       283
       +
         match t.client_capabilities with

     

       284
       +
         | Some c -> c

     

       285
       +
         | None -> invalid_arg "Server_session.client_capabilities: not initialized"

     

       286
       +
       

     

       287
       +
       let client_info t =

     

       288
       +
         match t.client_info with

     

       289
       +
         | Some i -> i

     

       290
       +
         | None -> invalid_arg "Server_session.client_info: not initialized"

     

       291
       +
       

     

       292
       +
       let protocol_version t =

     

       293
       +
         match t.protocol_version with

     

       294
       +
         | Some v -> v

     

       295
       +
         | None -> invalid_arg "Server_session.protocol_version: not initialized"

     

       296
       +
       

     

       297
       +
       (** {1 Sending Notifications} *)

     

       298
       +
       

     

       299
       +
       let send_notification t method_ params_jsont params =

     

       300
       +
         let params_json = encode_json params_jsont params in

     

       301
       +
         Session.send_notification t.session ~method_ ~params:params_json ()

     

       302
       +
       

     

       303
       +
       let send_resource_updated t ~uri =

     

       304
       +
         let notif = Messages.Resources.make_updated_notification ~uri in

     

       305
       +
         send_notification t

     

       306
       +
           Messages.Resources.updated_notification_method

     

       307
       +
           Messages.Resources.updated_notification_jsont

     

       308
       +
           notif

     

       309
       +
       

     

       310
       +
       let send_resource_list_changed t =

     

       311
       +
         let notif = Messages.Resources.make_list_changed_notification () in

     

       312
       +
         send_notification t

     

       313
       +
           Messages.Resources.list_changed_notification_method

     

       314
       +
           Messages.Resources.list_changed_notification_jsont

     

       315
       +
           notif

     

       316
       +
       

     

       317
       +
       let send_tool_list_changed t =

     

       318
       +
         let notif = Messages.Tools.make_list_changed_notification () in

     

       319
       +
         send_notification t

     

       320
       +
           Messages.Tools.list_changed_notification_method

     

       321
       +
           Messages.Tools.list_changed_notification_jsont

     

       322
       +
           notif

     

       323
       +
       

     

       324
       +
       let send_prompt_list_changed t =

     

       325
       +
         let notif = Messages.Prompts.make_list_changed_notification () in

     

       326
       +
         send_notification t

     

       327
       +
           Messages.Prompts.list_changed_notification_method

     

       328
       +
           Messages.Prompts.list_changed_notification_jsont

     

       329
       +
           notif

     

       330
       +
       

     

       331
       +
       let send_roots_list_changed t =

     

       332
       +
         let notif = Messages.Roots.make_list_changed_notification () in

     

       333
       +
         send_notification t

     

       334
       +
           Messages.Roots.list_changed_notification_method

     

       335
       +
           Messages.Roots.list_changed_notification_jsont

     

       336
       +
           notif

     

       337
       +
       

     

       338
       +
       let send_log_message t ~level ?logger ~data () =

     

       339
       +
         let notif = Messages.Logging.make_notification ~level ?logger ~data () in

     

       340
       +
         send_notification t

     

       341
       +
           Messages.Logging.method_

     

       342
       +
           Messages.Logging.notification_jsont

     

       343
       +
           notif

     

       344
       +
       

     

       345
       +
       let send_progress t ~progress_token ~progress ?total () =

     

       346
       +
         let notif = Messages.Progress.make_notification ~progress_token ~progress ?total () in

     

       347
       +
         send_notification t

     

       348
       +
           Messages.Progress.method_

     

       349
       +
           Messages.Progress.notification_jsont

     

       350
       +
           notif

     

       351
       +
       

     

       352
       +
       (** {1 Requesting from Client} *)

     

       353
       +
       

     

       354
       +
       let request_roots_list t =

     

       355
       +
         match client_capabilities t with

     

       356
       +
         | { roots = None; _ } -> None

     

       357
       +
         | { roots = Some _; _ } ->

     

       358
       +
             let req = Messages.Roots.make_list_request () in

     

       359
       +
             let params = encode_json Messages.Roots.list_request_jsont req in

     

       360
       +
             let result_json = Session.send_request t.session

     

       361
       +
               ~method_:Messages.Roots.list_method

     

       362
       +
               ~params

     

       363
       +
               ()

     

       364
       +
             in

     

       365
       +
             let result = decode_json Messages.Roots.list_result_jsont result_json in

     

       366
       +
             Some result

     

       367
       +
       

     

       368
       +
       (** {1 Session Management} *)

     

       369
       +
       

     

       370
       +
       let close t =

     

       371
       +
         Session.close t.session

+208

claudeio/lib_mcp/server_session.mli

···

       1
       +
       (** High-level MCP server session API.

     

       2
       +
       

     

       3
       +
           This module provides a convenient server-side API for hosting MCP servers.

     

       4
       +
           It handles the initialization handshake, routes incoming requests to handlers,

     

       5
       +
           and provides helpers for sending notifications to clients.

     

       6
       +
       

     

       7
       +
           {1 Example Usage}

     

       8
       +
       

     

       9
       +
           {[

     

       10
       +
             let config = {

     

       11
       +
               server_info = Capabilities.Implementation.make

     

       12
       +
                 ~name:"my-server"

     

       13
       +
                 ~version:"1.0.0";

     

       14
       +
               server_capabilities = Capabilities.Server.make

     

       15
       +
                 ~tools:(Some (Capabilities.Tools.make ()))

     

       16
       +
                 ();

     

       17
       +
               instructions = Some "This is my MCP server";

     

       18
       +
             } in

     

       19
       +
       

     

       20
       +
             let handlers = {

     

       21
       +
               list_tools = Some (fun ~cursor ->

     

       22
       +
                 Messages.Tools.make_list_result

     

       23
       +
                   ~tools:[

     

       24
       +
                     Messages.Tools.make_tool

     

       25
       +
                       ~name:"example"

     

       26
       +
                       ~description:"An example tool"

     

       27
       +
                       ~input_schema:(`Object [])

     

       28
       +
                       ();

     

       29
       +
                   ]

     

       30
       +
                   ()

     

       31
       +
               );

     

       32
       +
               call_tool = Some (fun ~name ~arguments ->

     

       33
       +
                 Messages.Tools.make_call_result

     

       34
       +
                   ~content:[Content.text "Tool result"]

     

       35
       +
                   ()

     

       36
       +
               );

     

       37
       +
               (* ... other handlers ... *)

     

       38
       +
               list_resources = None;

     

       39
       +
               list_resource_templates = None;

     

       40
       +
               read_resource = None;

     

       41
       +
               subscribe_resource = None;

     

       42
       +
               unsubscribe_resource = None;

     

       43
       +
               list_prompts = None;

     

       44
       +
               get_prompt = None;

     

       45
       +
               complete = None;

     

       46
       +
               ping = None;

     

       47
       +
             } in

     

       48
       +
       

     

       49
       +
             Eio.Switch.run @@ fun sw ->

     

       50
       +
               let server = Server_session.create

     

       51
       +
                 ~sw

     

       52
       +
                 ~transport

     

       53
       +
                 config

     

       54
       +
                 handlers

     

       55
       +
               in

     

       56
       +
               (* Server is now running and handling requests *)

     

       57
       +
               (* Send notifications as needed *)

     

       58
       +
               Server_session.send_tool_list_changed server

     

       59
       +
           ]} *)

     

       60
       +
       

     

       61
       +
       (** {1 Types} *)

     

       62
       +
       

     

       63
       +
       type t

     

       64
       +
       (** Server session handle *)

     

       65
       +
       

     

       66
       +
       (** {1 Configuration} *)

     

       67
       +
       

     

       68
       +
       type config = {

     

       69
       +
         server_info : Capabilities.Implementation.t;

     

       70
       +
         (** Server implementation information (name, version) *)

     

       71
       +
         server_capabilities : Capabilities.Server.t;

     

       72
       +
         (** Server capabilities to advertise to client *)

     

       73
       +
         instructions : string option;

     

       74
       +
         (** Optional instructions for using the server *)

     

       75
       +
       }

     

       76
       +
       (** Server configuration *)

     

       77
       +
       

     

       78
       +
       (** {1 Request Handlers} *)

     

       79
       +
       

     

       80
       +
       type handlers = {

     

       81
       +
         (* Resources *)

     

       82
       +
         list_resources : (cursor:string option -> Messages.Resources.list_result) option;

     

       83
       +
         (** Handler for resources/list requests *)

     

       84
       +
       

     

       85
       +
         list_resource_templates : (cursor:string option -> Messages.Resources.list_result) option;

     

       86
       +
         (** Handler for resources/templates/list requests *)

     

       87
       +
       

     

       88
       +
         read_resource : (uri:string -> Messages.Resources.read_result) option;

     

       89
       +
         (** Handler for resources/read requests *)

     

       90
       +
       

     

       91
       +
         subscribe_resource : (uri:string -> unit) option;

     

       92
       +
         (** Handler for resources/subscribe requests *)

     

       93
       +
       

     

       94
       +
         unsubscribe_resource : (uri:string -> unit) option;

     

       95
       +
         (** Handler for resources/unsubscribe requests *)

     

       96
       +
       

     

       97
       +
         (* Tools *)

     

       98
       +
         list_tools : (cursor:string option -> Messages.Tools.list_result) option;

     

       99
       +
         (** Handler for tools/list requests *)

     

       100
       +
       

     

       101
       +
         call_tool : (name:string -> arguments:Jsont.json option -> Messages.Tools.call_result) option;

     

       102
       +
         (** Handler for tools/call requests *)

     

       103
       +
       

     

       104
       +
         (* Prompts *)

     

       105
       +
         list_prompts : (cursor:string option -> Messages.Prompts.list_result) option;

     

       106
       +
         (** Handler for prompts/list requests *)

     

       107
       +
       

     

       108
       +
         get_prompt : (name:string -> arguments:(string * string) list option -> Messages.Prompts.get_result) option;

     

       109
       +
         (** Handler for prompts/get requests *)

     

       110
       +
       

     

       111
       +
         (* Completions *)

     

       112
       +
         complete : (ref_:Messages.Completions.completion_ref -> argument:string -> Messages.Completions.result) option;

     

       113
       +
         (** Handler for completion/complete requests *)

     

       114
       +
       

     

       115
       +
         (* Ping *)

     

       116
       +
         ping : (unit -> unit) option;

     

       117
       +
         (** Handler for ping requests *)

     

       118
       +
       }

     

       119
       +
       (** Request handler callbacks.

     

       120
       +
           Set to [None] to indicate the method is not supported.

     

       121
       +
           If a request is received for an unsupported method, a METHOD_NOT_FOUND error is returned. *)

     

       122
       +
       

     

       123
       +
       (** {1 Server Creation} *)

     

       124
       +
       

     

       125
       +
       val create :

     

       126
       +
         sw:Eio.Switch.t ->

     

       127
       +
         transport:Transport.t ->

     

       128
       +
         ?timeout:float ->

     

       129
       +
         ?clock:Session.clock ->

     

       130
       +
         config ->

     

       131
       +
         handlers ->

     

       132
       +
         t

     

       133
       +
       (** Create and initialize a server session.

     

       134
       +
       

     

       135
       +
           This function:

     

       136
       +
           1. Creates an underlying Session

     

       137
       +
           2. Waits for the Initialize request from the client

     

       138
       +
           3. Returns the Initialize response with server capabilities

     

       139
       +
           4. Waits for the Initialized notification

     

       140
       +
           5. Returns a ready-to-use server session

     

       141
       +
       

     

       142
       +
           The server will then handle incoming requests by routing them to the provided handlers.

     

       143
       +
       

     

       144
       +
           @param sw Switch for the session background fibers

     

       145
       +
           @param transport Transport layer for communication

     

       146
       +
           @param timeout Optional request timeout in seconds

     

       147
       +
           @param clock Optional clock for timeout handling (required if timeout is set)

     

       148
       +
           @raise Invalid_argument if initialization fails or times out *)

     

       149
       +
       

     

       150
       +
       (** {1 Client Information} *)

     

       151
       +
       

     

       152
       +
       val client_capabilities : t -> Capabilities.Client.t

     

       153
       +
       (** Get the client's advertised capabilities *)

     

       154
       +
       

     

       155
       +
       val client_info : t -> Capabilities.Implementation.t

     

       156
       +
       (** Get the client's implementation information *)

     

       157
       +
       

     

       158
       +
       val protocol_version : t -> string

     

       159
       +
       (** Get the negotiated protocol version *)

     

       160
       +
       

     

       161
       +
       (** {1 Sending Notifications} *)

     

       162
       +
       

     

       163
       +
       val send_resource_updated : t -> uri:string -> unit

     

       164
       +
       (** Send a notification that a resource has been updated.

     

       165
       +
           Only works if client supports resource subscriptions.

     

       166
       +
           @param uri The URI of the updated resource *)

     

       167
       +
       

     

       168
       +
       val send_resource_list_changed : t -> unit

     

       169
       +
       (** Send a notification that the resource list has changed.

     

       170
       +
           Only works if client supports resource list_changed capability. *)

     

       171
       +
       

     

       172
       +
       val send_tool_list_changed : t -> unit

     

       173
       +
       (** Send a notification that the tool list has changed.

     

       174
       +
           Only works if server advertised tools capability. *)

     

       175
       +
       

     

       176
       +
       val send_prompt_list_changed : t -> unit

     

       177
       +
       (** Send a notification that the prompt list has changed.

     

       178
       +
           Only works if server advertised prompts capability. *)

     

       179
       +
       

     

       180
       +
       val send_roots_list_changed : t -> unit

     

       181
       +
       (** Send a notification that the roots list has changed.

     

       182
       +
           Only works if client supports roots capability. *)

     

       183
       +
       

     

       184
       +
       val send_log_message : t -> level:Messages.Logging.level -> ?logger:string -> data:Jsont.json -> unit -> unit

     

       185
       +
       (** Send a log message notification.

     

       186
       +
           Only works if server advertised logging capability.

     

       187
       +
           @param level Log level

     

       188
       +
           @param logger Optional logger name

     

       189
       +
           @param data Log message data (any JSON value) *)

     

       190
       +
       

     

       191
       +
       val send_progress : t -> progress_token:string -> progress:float -> ?total:float -> unit -> unit

     

       192
       +
       (** Send a progress notification.

     

       193
       +
           @param progress_token Unique token identifying the operation

     

       194
       +
           @param progress Progress value (0.0 to 1.0)

     

       195
       +
           @param total Optional total value *)

     

       196
       +
       

     

       197
       +
       (** {1 Requesting from Client} *)

     

       198
       +
       

     

       199
       +
       val request_roots_list : t -> Messages.Roots.list_result option

     

       200
       +
       (** Request the list of roots from the client.

     

       201
       +
           Returns [None] if the client doesn't support the roots capability.

     

       202
       +
           @raise Session.Timeout if the request times out

     

       203
       +
           @raise Session.Remote_error if the client returns an error *)

     

       204
       +
       

     

       205
       +
       (** {1 Session Management} *)

     

       206
       +
       

     

       207
       +
       val close : t -> unit

     

       208
       +
       (** Close the server session and underlying transport *)

+254

claudeio/lib_mcp/session.ml

···

       1
       +
       (** Bidirectional JSON-RPC session management with request/response correlation *)

     

       2
       +
       

     

       3
       +
       (** {1 Handlers} *)

     

       4
       +
       

     

       5
       +
       type request_handler =

     

       6
       +
         method_:string ->

     

       7
       +
         params:Jsont.json option ->

     

       8
       +
         Jsont.json

     

       9
       +
       

     

       10
       +
       type notification_handler =

     

       11
       +
         method_:string ->

     

       12
       +
         params:Jsont.json option ->

     

       13
       +
         unit

     

       14
       +
       

     

       15
       +
       (** {1 Configuration} *)

     

       16
       +
       

     

       17
       +
       type clock = C : _ Eio.Time.clock -> clock

     

       18
       +
       

     

       19
       +
       type config = {

     

       20
       +
         transport : Transport.t;

     

       21
       +
         request_handler : request_handler;

     

       22
       +
         notification_handler : notification_handler;

     

       23
       +
         timeout : float option;

     

       24
       +
         clock : clock option;

     

       25
       +
         (** Clock for timeout handling. Required if timeout is set. *)

     

       26
       +
       }

     

       27
       +
       

     

       28
       +
       (** {1 Exceptions} *)

     

       29
       +
       

     

       30
       +
       exception Timeout of string

     

       31
       +
       exception Session_closed

     

       32
       +
       exception Unknown_response of Jsonrpc.Id.t

     

       33
       +
       exception Remote_error of Jsonrpc.Error_data.t

     

       34
       +
       

     

       35
       +
       (** {1 Internal Types} *)

     

       36
       +
       

     

       37
       +
       type response_result =

     

       38
       +
         | Success of Jsont.json

     

       39
       +
         | Error of exn

     

       40
       +
       

     

       41
       +
       type pending_request = {

     

       42
       +
         id : Jsonrpc.Id.t;

     

       43
       +
         resolver : response_result Eio.Promise.u;

     

       44
       +
         mutable cancelled : bool;  (* Flag to indicate request was completed *)

     

       45
       +
       }

     

       46
       +
       

     

       47
       +
       type t = {

     

       48
       +
         transport : Transport.t;

     

       49
       +
         mutable next_id : int;

     

       50
       +
         pending : (Jsonrpc.Id.t, pending_request) Hashtbl.t;

     

       51
       +
         request_handler : request_handler;

     

       52
       +
         notification_handler : notification_handler;

     

       53
       +
         timeout : float option;

     

       54
       +
         clock : clock option;

     

       55
       +
         sw : Eio.Switch.t;

     

       56
       +
         mutable closed : bool;

     

       57
       +
       }

     

       58
       +
       

     

       59
       +
       (** {1 Helper Functions} *)

     

       60
       +
       

     

       61
       +
       let encode_message msg =

     

       62
       +
         match Jsont.Json.encode Jsonrpc.Message.jsont msg with

     

       63
       +
         | Ok json -> json

     

       64
       +
         | Error e -> failwith ("Failed to encode message: " ^ e)

     

       65
       +
       

     

       66
       +
       let send_json t json =

     

       67
       +
         if t.closed then raise Session_closed;

     

       68
       +
         Transport.send t.transport json

     

       69
       +
       

     

       70
       +
       (** Handle an incoming request by calling the user's handler and sending response *)

     

       71
       +
       let handle_request t req =

     

       72
       +
         let open Jsonrpc in

     

       73
       +
         let id = match req.Request.id with

     

       74
       +
           | Some id -> id

     

       75
       +
           | None ->

     

       76
       +
               (* This is a notification, not a request - no response needed *)

     

       77
       +
               t.notification_handler

     

       78
       +
                 ~method_:req.Request.method_

     

       79
       +
                 ~params:req.Request.params;

     

       80
       +
               raise Exit  (* Exit this handler without sending response *)

     

       81
       +
         in

     

       82
       +
       

     

       83
       +
         try

     

       84
       +
           (* Call user's request handler *)

     

       85
       +
           let result = t.request_handler

     

       86
       +
             ~method_:req.Request.method_

     

       87
       +
             ~params:req.Request.params

     

       88
       +
           in

     

       89
       +
           (* Send success response *)

     

       90
       +
           let response = Response.make_result ~id ~result in

     

       91
       +
           let msg = Message.Response response in

     

       92
       +
           let json = encode_message msg in

     

       93
       +
           send_json t json

     

       94
       +
         with

     

       95
       +
         | Exit -> ()  (* Notification, no response *)

     

       96
       +
         | exn ->

     

       97
       +
             (* Convert exception to error response *)

     

       98
       +
             let error = Error_data.make

     

       99
       +
               ~code:Internal_error

     

       100
       +
               ~message:(Printexc.to_string exn)

     

       101
       +
               ()

     

       102
       +
             in

     

       103
       +
             let response = Response.make_error ~id ~error in

     

       104
       +
             let msg = Message.Response response in

     

       105
       +
             let json = encode_message msg in

     

       106
       +
             send_json t json

     

       107
       +
       

     

       108
       +
       (** Resolve a pending request with a response *)

     

       109
       +
       let resolve_response t resp =

     

       110
       +
         let open Jsonrpc in

     

       111
       +
         let id = resp.Response.id in

     

       112
       +
         match Hashtbl.find_opt t.pending id with

     

       113
       +
         | None ->

     

       114
       +
             (* Received response for unknown request ID *)

     

       115
       +
             raise (Unknown_response id)

     

       116
       +
         | Some pending ->

     

       117
       +
             Hashtbl.remove t.pending id;

     

       118
       +
             (* Mark as cancelled so timeout doesn't fire *)

     

       119
       +
             pending.cancelled <- true;

     

       120
       +
             (* Resolve the promise with result or error *)

     

       121
       +
             (match resp.Response.value with

     

       122
       +
             | Ok result ->

     

       123
       +
                 Eio.Promise.resolve pending.resolver (Success result)

     

       124
       +
             | Stdlib.Result.Error error ->

     

       125
       +
                 Eio.Promise.resolve pending.resolver (Error (Remote_error error)))

     

       126
       +
       

     

       127
       +
       (** Background receive loop - reads messages and routes them *)

     

       128
       +
       let rec receive_loop t =

     

       129
       +
         if t.closed then () else

     

       130
       +
         match Transport.receive t.transport with

     

       131
       +
         | None ->

     

       132
       +
             (* Transport closed *)

     

       133
       +
             t.closed <- true;

     

       134
       +
             (* Cancel all pending requests *)

     

       135
       +
             Hashtbl.iter (fun _ pending ->

     

       136
       +
               Eio.Promise.resolve pending.resolver (Error Session_closed)

     

       137
       +
             ) t.pending;

     

       138
       +
             Hashtbl.clear t.pending

     

       139
       +
         | Some json ->

     

       140
       +
             (try

     

       141
       +
                let msg = Jsonrpc.Message.classify json in

     

       142
       +
                match msg with

     

       143
       +
                | Request req ->

     

       144
       +
                    (* Handle request in new fibre so it doesn't block receive loop *)

     

       145
       +
                    Eio.Fiber.fork_promise ~sw:t.sw (fun () ->

     

       146
       +
                      handle_request t req

     

       147
       +
                    ) |> ignore

     

       148
       +
                | Response resp ->

     

       149
       +
                    (* Resolve pending promise *)

     

       150
       +
                    resolve_response t resp

     

       151
       +
              with exn ->

     

       152
       +
                (* Log error but continue receive loop *)

     

       153
       +
                Printf.eprintf "Error in receive loop: %s\n%!" (Printexc.to_string exn)

     

       154
       +
             );

     

       155
       +
             receive_loop t

     

       156
       +
       

     

       157
       +
       (** {1 Public API} *)

     

       158
       +
       

     

       159
       +
       let create ~sw (config : config) : t =

     

       160
       +
         (* Validate that clock is provided if timeout is set *)

     

       161
       +
         (match config.timeout with

     

       162
       +
          | Some _ when config.clock = None ->

     

       163
       +
              invalid_arg "Session.create: clock must be provided when timeout is set"

     

       164
       +
          | _ -> ());

     

       165
       +
       

     

       166
       +
         let t = {

     

       167
       +
           transport = config.transport;

     

       168
       +
           next_id = 1;

     

       169
       +
           pending = Hashtbl.create 16;

     

       170
       +
           request_handler = config.request_handler;

     

       171
       +
           notification_handler = config.notification_handler;

     

       172
       +
           timeout = config.timeout;

     

       173
       +
           clock = config.clock;

     

       174
       +
           sw;

     

       175
       +
           closed = false;

     

       176
       +
         } in

     

       177
       +
       

     

       178
       +
         (* Start background receive loop *)

     

       179
       +
         Eio.Fiber.fork ~sw (fun () -> receive_loop t);

     

       180
       +
       

     

       181
       +
         t

     

       182
       +
       

     

       183
       +
       let send_request t ~method_ ?params () =

     

       184
       +
         if t.closed then raise Session_closed;

     

       185
       +
       

     

       186
       +
         (* Generate unique request ID *)

     

       187
       +
         let id = `Number (float_of_int t.next_id) in

     

       188
       +
         t.next_id <- t.next_id + 1;

     

       189
       +
       

     

       190
       +
         (* Create promise for response *)

     

       191
       +
         let promise, resolver = Eio.Promise.create () in

     

       192
       +
       

     

       193
       +
         (* Register pending request *)

     

       194
       +
         let pending = {

     

       195
       +
           id;

     

       196
       +
           resolver;

     

       197
       +
           cancelled = false;

     

       198
       +
         } in

     

       199
       +
         Hashtbl.add t.pending id pending;

     

       200
       +
       

     

       201
       +
         (* Setup timeout if configured *)

     

       202
       +
         (match t.timeout, t.clock with

     

       203
       +
          | None, _ | _, None -> ()

     

       204
       +
          | Some timeout_sec, Some (C clock) ->

     

       205
       +
              (* Start timeout fiber *)

     

       206
       +
              Eio.Fiber.fork ~sw:t.sw (fun () ->

     

       207
       +
                Eio.Time.sleep clock timeout_sec;

     

       208
       +
                (* Timeout expired - check if request is still pending and not cancelled *)

     

       209
       +
                if not pending.cancelled then begin

     

       210
       +
                  match Hashtbl.find_opt t.pending id with

     

       211
       +
                  | Some _ ->

     

       212
       +
                      Hashtbl.remove t.pending id;

     

       213
       +
                      let msg = Printf.sprintf "Request timeout after %.1fs: %s" timeout_sec method_ in

     

       214
       +
                      Eio.Promise.resolve pending.resolver (Error (Timeout msg))

     

       215
       +
                  | None ->

     

       216
       +
                      (* Request already completed, nothing to do *)

     

       217
       +
                      ()

     

       218
       +
                end

     

       219
       +
              )

     

       220
       +
         );

     

       221
       +
       

     

       222
       +
         (* Send request *)

     

       223
       +
         let req = Jsonrpc.Request.make ~method_ ?params ~id () in

     

       224
       +
         let msg = Jsonrpc.Message.Request req in

     

       225
       +
         let json = encode_message msg in

     

       226
       +
         send_json t json;

     

       227
       +
       

     

       228
       +
         (* Wait for response *)

     

       229
       +
         match Eio.Promise.await promise with

     

       230
       +
         | Success result -> result

     

       231
       +
         | Error exn -> raise exn

     

       232
       +
       

     

       233
       +
       let send_notification t ~method_ ?params () =

     

       234
       +
         if t.closed then raise Session_closed;

     

       235
       +
       

     

       236
       +
         (* Create notification (request with no ID) *)

     

       237
       +
         let req = Jsonrpc.Request.make ~method_ ?params () in

     

       238
       +
         let msg = Jsonrpc.Message.Request req in

     

       239
       +
         let json = encode_message msg in

     

       240
       +
         send_json t json

     

       241
       +
       

     

       242
       +
       let close t =

     

       243
       +
         if not t.closed then begin

     

       244
       +
           t.closed <- true;

     

       245
       +
           (* Cancel all pending requests *)

     

       246
       +
           Hashtbl.iter (fun _ pending ->

     

       247
       +
             Eio.Promise.resolve pending.resolver (Error Session_closed)

     

       248
       +
           ) t.pending;

     

       249
       +
           Hashtbl.clear t.pending;

     

       250
       +
           (* Close transport *)

     

       251
       +
           Transport.close t.transport

     

       252
       +
         end

     

       253
       +
       

     

       254
       +
       let is_closed t = t.closed

+140

claudeio/lib_mcp/session.mli

···

       1
       +
       (** Bidirectional JSON-RPC session management with request/response correlation.

     

       2
       +
       

     

       3
       +
           This module provides a high-level session abstraction over a transport layer,

     

       4
       +
           handling request ID generation, response correlation via promises, and

     

       5
       +
           bidirectional message routing using Eio structured concurrency.

     

       6
       +
       

     

       7
       +
           {1 Architecture}

     

       8
       +
       

     

       9
       +
           Sessions run a background receive loop in an Eio fiber that continuously

     

       10
       +
           reads from the transport and routes messages:

     

       11
       +
           - Incoming requests → dispatched to request_handler in new fiber

     

       12
       +
           - Incoming responses → resolve pending promises

     

       13
       +
           - Incoming notifications → dispatched to notification_handler

     

       14
       +
       

     

       15
       +
           Outgoing messages (requests and notifications) are sent directly on the

     

       16
       +
           transport. Requests return promises that are resolved when the corresponding

     

       17
       +
           response arrives.

     

       18
       +
       

     

       19
       +
           {1 Example Usage}

     

       20
       +
       

     

       21
       +
           {[

     

       22
       +
             Eio_main.run @@ fun env ->

     

       23
       +
             let config = {

     

       24
       +
               transport;

     

       25
       +
               request_handler = (fun ~method_ ~params ->

     

       26
       +
                 (* Handle incoming requests *)

     

       27
       +
                 match method_ with

     

       28
       +
                 | "ping" -> `String "pong"

     

       29
       +
                 | _ -> failwith "Unknown method"

     

       30
       +
               );

     

       31
       +
               notification_handler = (fun ~method_ ~params ->

     

       32
       +
                 (* Handle incoming notifications *)

     

       33
       +
                 Printf.printf "Notification: %s\n" method_

     

       34
       +
               );

     

       35
       +
               timeout = Some 30.0;  (* 30 second timeout *)

     

       36
       +
               clock = Some (C (Eio.Stdenv.clock env));

     

       37
       +
             }

     

       38
       +
             in

     

       39
       +
       

     

       40
       +
             Eio.Switch.run @@ fun sw ->

     

       41
       +
               let session = Session.create ~sw config in

     

       42
       +
       

     

       43
       +
               (* Send a request and wait for response *)

     

       44
       +
               let response = Session.send_request session

     

       45
       +
                 ~method_:"initialize"

     

       46
       +
                 ~params:(`Object [("version", `String "1.0")])

     

       47
       +
                 ()

     

       48
       +
               in

     

       49
       +
       

     

       50
       +
               (* Send a notification (no response expected) *)

     

       51
       +
               Session.send_notification session

     

       52
       +
                 ~method_:"progress"

     

       53
       +
                 ~params:(`Object [("percent", `Number 50.0)])

     

       54
       +
                 ()

     

       55
       +
           ]} *)

     

       56
       +
       

     

       57
       +
       (** {1 Handlers} *)

     

       58
       +
       

     

       59
       +
       type request_handler =

     

       60
       +
         method_:string ->

     

       61
       +
         params:Jsont.json option ->

     

       62
       +
         Jsont.json

     

       63
       +
       (** Handler for incoming requests. Should return the result value.

     

       64
       +
           May raise exceptions which will be converted to JSON-RPC errors. *)

     

       65
       +
       

     

       66
       +
       type notification_handler =

     

       67
       +
         method_:string ->

     

       68
       +
         params:Jsont.json option ->

     

       69
       +
         unit

     

       70
       +
       (** Handler for incoming notifications. No response is expected. *)

     

       71
       +
       

     

       72
       +
       (** {1 Configuration} *)

     

       73
       +
       

     

       74
       +
       type clock = C : _ Eio.Time.clock -> clock

     

       75
       +
       (** Wrapper for existential clock type *)

     

       76
       +
       

     

       77
       +
       type config = {

     

       78
       +
         transport : Transport.t;

     

       79
       +
         (** Transport layer for sending/receiving JSON messages *)

     

       80
       +
         request_handler : request_handler;

     

       81
       +
         (** Handler for incoming requests *)

     

       82
       +
         notification_handler : notification_handler;

     

       83
       +
         (** Handler for incoming notifications *)

     

       84
       +
         timeout : float option;

     

       85
       +
         (** Request timeout in seconds. [None] means no timeout. *)

     

       86
       +
         clock : clock option;

     

       87
       +
         (** Clock for timeout handling. Required if [timeout] is set. *)

     

       88
       +
       }

     

       89
       +
       (** Session configuration *)

     

       90
       +
       

     

       91
       +
       (** {1 Session Management} *)

     

       92
       +
       

     

       93
       +
       type t

     

       94
       +
       (** Session handle *)

     

       95
       +
       

     

       96
       +
       exception Timeout of string

     

       97
       +
       (** Raised when a request times out *)

     

       98
       +
       

     

       99
       +
       exception Session_closed

     

       100
       +
       (** Raised when attempting to use a closed session *)

     

       101
       +
       

     

       102
       +
       exception Unknown_response of Jsonrpc.Id.t

     

       103
       +
       (** Raised when receiving a response for an unknown request ID *)

     

       104
       +
       

     

       105
       +
       exception Remote_error of Jsonrpc.Error_data.t

     

       106
       +
       (** Raised when the remote side returns an error response *)

     

       107
       +
       

     

       108
       +
       val create :

     

       109
       +
         sw:Eio.Switch.t ->

     

       110
       +
         config ->

     

       111
       +
         t

     

       112
       +
       (** Create and start a session with a background receive loop.

     

       113
       +
           The receive loop runs in a background fiber attached to [sw]. *)

     

       114
       +
       

     

       115
       +
       val send_request :

     

       116
       +
         t ->

     

       117
       +
         method_:string ->

     

       118
       +
         ?params:Jsont.json ->

     

       119
       +
         unit ->

     

       120
       +
         Jsont.json

     

       121
       +
       (** Send a request and await the response.

     

       122
       +
           Raises [Timeout] if the request times out.

     

       123
       +
           Raises [Remote_error] if the server returns an error.

     

       124
       +
           Raises [Session_closed] if the session is closed. *)

     

       125
       +
       

     

       126
       +
       val send_notification :

     

       127
       +
         t ->

     

       128
       +
         method_:string ->

     

       129
       +
         ?params:Jsont.json ->

     

       130
       +
         unit ->

     

       131
       +
         unit

     

       132
       +
       (** Send a notification (no response expected).

     

       133
       +
           Raises [Session_closed] if the session is closed. *)

     

       134
       +
       

     

       135
       +
       val close : t -> unit

     

       136
       +
       (** Close the session and underlying transport.

     

       137
       +
           This will cancel all pending requests. *)

     

       138
       +
       

     

       139
       +
       val is_closed : t -> bool

     

       140
       +
       (** Check if the session is closed *)

+29

claudeio/lib_mcp/transport.ml

···

       1
       +
       (** Abstract transport layer for MCP communication *)

     

       2
       +
       

     

       3
       +
       exception Connection_error of string

     

       4
       +
       

     

       5
       +
       (** Internal module type that transport implementations must satisfy *)

     

       6
       +
       module type TRANSPORT = sig

     

       7
       +
         type state

     

       8
       +
       

     

       9
       +
         val send : state -> Jsont.json -> unit

     

       10
       +
         val receive : state -> Jsont.json option

     

       11
       +
         val close : state -> unit

     

       12
       +
         val is_closed : state -> bool

     

       13
       +
       end

     

       14
       +
       

     

       15
       +
       (** The abstract transport type - hides the concrete implementation *)

     

       16
       +
       type t = T : (module TRANSPORT with type state = 'a) * 'a -> t

     

       17
       +
         [@@warning "-37"] (* Constructor T is used in transport implementations *)

     

       18
       +
       

     

       19
       +
       let send (T ((module M), state)) json =

     

       20
       +
         M.send state json

     

       21
       +
       

     

       22
       +
       let receive (T ((module M), state)) =

     

       23
       +
         M.receive state

     

       24
       +
       

     

       25
       +
       let close (T ((module M), state)) =

     

       26
       +
         M.close state

     

       27
       +
       

     

       28
       +
       let is_closed (T ((module M), state)) =

     

       29
       +
         M.is_closed state

+34

claudeio/lib_mcp/transport.mli

···

       1
       +
       (** Abstract transport layer for MCP communication *)

     

       2
       +
       

     

       3
       +
       (** Module type that transport implementations must satisfy *)

     

       4
       +
       module type TRANSPORT = sig

     

       5
       +
         type state

     

       6
       +
       

     

       7
       +
         val send : state -> Jsont.json -> unit

     

       8
       +
         val receive : state -> Jsont.json option

     

       9
       +
         val close : state -> unit

     

       10
       +
         val is_closed : state -> bool

     

       11
       +
       end

     

       12
       +
       

     

       13
       +
       (** The abstract transport type for sending/receiving JSON messages *)

     

       14
       +
       type t = T : (module TRANSPORT with type state = 'a) * 'a -> t

     

       15
       +
       

     

       16
       +
       (** [send t json] sends a JSON message through the transport.

     

       17
       +
           @raise Connection_error if the transport is closed or sending fails *)

     

       18
       +
       val send : t -> Jsont.json -> unit

     

       19
       +
       

     

       20
       +
       (** [receive t] receives a JSON message from the transport (blocking).

     

       21
       +
           Returns [None] on EOF or when the transport is closed.

     

       22
       +
           @raise Connection_error if receiving fails for reasons other than EOF *)

     

       23
       +
       val receive : t -> Jsont.json option

     

       24
       +
       

     

       25
       +
       (** [close t] closes the transport and releases all associated resources.

     

       26
       +
           This is idempotent - calling close multiple times is safe. *)

     

       27
       +
       val close : t -> unit

     

       28
       +
       

     

       29
       +
       (** [is_closed t] checks if the transport is closed.

     

       30
       +
           Returns [true] if the transport has been closed, [false] otherwise. *)

     

       31
       +
       val is_closed : t -> bool

     

       32
       +
       

     

       33
       +
       (** Exception raised when transport operations fail *)

     

       34
       +
       exception Connection_error of string

+179

claudeio/lib_mcp/transport_stdio.ml

···

       1
       +
       (** Stdio transport implementation for MCP *)

     

       2
       +
       

     

       3
       +
       let src = Logs.Src.create "mcp.transport.stdio" ~doc:"MCP stdio transport"

     

       4
       +
       module Log = (val Logs.src_log src : Logs.LOG)

     

       5
       +
       

     

       6
       +
       exception Process_spawn_error of string

     

       7
       +
       

     

       8
       +
       (** Parameters for creating a stdio transport *)

     

       9
       +
       type params = {

     

       10
       +
         command : string;

     

       11
       +
         args : string list;

     

       12
       +
         env : (string * string) list option;

     

       13
       +
         max_buffer_size : int option;

     

       14
       +
       }

     

       15
       +
       

     

       16
       +
       (** Wrapper for existential process type *)

     

       17
       +
       type process = P : _ Eio.Process.t -> process

     

       18
       +
       

     

       19
       +
       (** Internal state for stdio transport *)

     

       20
       +
       type state = {

     

       21
       +
         process : process;

     

       22
       +
         stdin : Eio.Flow.sink_ty Eio.Resource.t;

     

       23
       +
         stdin_close : [`Close | `Flow] Eio.Resource.t;

     

       24
       +
         stdout : Eio.Buf_read.t;

     

       25
       +
         mutable closed : bool;

     

       26
       +
         sw : Eio.Switch.t;

     

       27
       +
       }

     

       28
       +
       

     

       29
       +
       (** Send a JSON message by encoding to a line-delimited string *)

     

       30
       +
       let send state json =

     

       31
       +
         if state.closed then

     

       32
       +
           raise (Transport.Connection_error "Transport is closed");

     

       33
       +
       

     

       34
       +
         let data = match Jsont_bytesrw.encode_string' Jsont.json json with

     

       35
       +
           | Ok s -> s

     

       36
       +
           | Error err ->

     

       37
       +
               let msg = Jsont.Error.to_string err in

     

       38
       +
               raise (Transport.Connection_error ("JSON encoding failed: " ^ msg))

     

       39
       +
         in

     

       40
       +
       

     

       41
       +
         Log.debug (fun m -> m "Sending: %s" data);

     

       42
       +
       

     

       43
       +
         try

     

       44
       +
           Eio.Flow.write state.stdin [Cstruct.of_string (data ^ "\n")]

     

       45
       +
         with

     

       46
       +
         | exn ->

     

       47
       +
             Log.err (fun m -> m "Failed to send message: %s" (Printexc.to_string exn));

     

       48
       +
             raise (Transport.Connection_error

     

       49
       +
               (Printf.sprintf "Failed to send message: %s" (Printexc.to_string exn)))

     

       50
       +
       

     

       51
       +
       (** Receive a JSON message by reading a line and decoding *)

     

       52
       +
       let receive state =

     

       53
       +
         if state.closed then

     

       54
       +
           None

     

       55
       +
         else

     

       56
       +
           try

     

       57
       +
             match Eio.Buf_read.line state.stdout with

     

       58
       +
             | line ->

     

       59
       +
                 Log.debug (fun m -> m "Received: %s" line);

     

       60
       +
                 (match Jsont_bytesrw.decode_string' Jsont.json line with

     

       61
       +
                  | Ok json -> Some json

     

       62
       +
                  | Error err ->

     

       63
       +
                      let msg = Jsont.Error.to_string err in

     

       64
       +
                      Log.err (fun m -> m "JSON decoding failed: %s" msg);

     

       65
       +
                      raise (Transport.Connection_error ("JSON decoding failed: " ^ msg)))

     

       66
       +
             | exception End_of_file ->

     

       67
       +
                 Log.debug (fun m -> m "Received EOF");

     

       68
       +
                 state.closed <- true;

     

       69
       +
                 None

     

       70
       +
           with

     

       71
       +
           | Transport.Connection_error _ as e -> raise e

     

       72
       +
           | exn ->

     

       73
       +
               Log.err (fun m -> m "Failed to receive message: %s" (Printexc.to_string exn));

     

       74
       +
               raise (Transport.Connection_error

     

       75
       +
                 (Printf.sprintf "Failed to receive message: %s" (Printexc.to_string exn)))

     

       76
       +
       

     

       77
       +
       (** Close the transport and cleanup resources *)

     

       78
       +
       let close state =

     

       79
       +
         if not state.closed then begin

     

       80
       +
           state.closed <- true;

     

       81
       +
           try

     

       82
       +
             Eio.Flow.close state.stdin_close;

     

       83
       +
             let (P process) = state.process in

     

       84
       +
             Eio.Process.await_exn process

     

       85
       +
           with _ -> ()

     

       86
       +
         end

     

       87
       +
       

     

       88
       +
       (** Check if transport is closed *)

     

       89
       +
       let is_closed state =

     

       90
       +
         state.closed

     

       91
       +
       

     

       92
       +
       (** The transport module implementation *)

     

       93
       +
       module Stdio_transport : Transport.TRANSPORT with type state = state = struct

     

       94
       +
         type nonrec state = state

     

       95
       +
       

     

       96
       +
         let send = send

     

       97
       +
         let receive = receive

     

       98
       +
         let close = close

     

       99
       +
         let is_closed = is_closed

     

       100
       +
       end

     

       101
       +
       

     

       102
       +
       (** Create a new stdio transport *)

     

       103
       +
       let create ~sw ~process_mgr params =

     

       104
       +
         (* Build command arguments *)

     

       105
       +
         let cmd = params.command :: params.args in

     

       106
       +
       

     

       107
       +
         (* Build environment - preserve essential vars and add custom ones *)

     

       108
       +
         let home = try Unix.getenv "HOME" with Not_found -> "/tmp" in

     

       109
       +
         let path = try Unix.getenv "PATH" with Not_found -> "/usr/bin:/bin" in

     

       110
       +
       

     

       111
       +
         (* Preserve other potentially important environment variables *)

     

       112
       +
         let preserve_vars = [

     

       113
       +
           "USER"; "LOGNAME"; "SHELL"; "TERM";

     

       114
       +
           "XDG_CONFIG_HOME"; "XDG_DATA_HOME"; "XDG_CACHE_HOME";

     

       115
       +
         ] in

     

       116
       +
       

     

       117
       +
         let preserved = List.filter_map (fun var ->

     

       118
       +
           try Some (Printf.sprintf "%s=%s" var (Unix.getenv var))

     

       119
       +
           with Not_found -> None

     

       120
       +
         ) preserve_vars in

     

       121
       +
       

     

       122
       +
         let base_env = [

     

       123
       +
           Printf.sprintf "HOME=%s" home;

     

       124
       +
           Printf.sprintf "PATH=%s" path;

     

       125
       +
         ] @ preserved in

     

       126
       +
       

     

       127
       +
         let custom_env = match params.env with

     

       128
       +
           | None -> []

     

       129
       +
           | Some vars -> List.map (fun (k, v) -> Printf.sprintf "%s=%s" k v) vars

     

       130
       +
         in

     

       131
       +
       

     

       132
       +
         let env = Array.of_list (base_env @ custom_env) in

     

       133
       +
       

     

       134
       +
         Log.debug (fun m -> m "Environment: HOME=%s, PATH=%s" home path);

     

       135
       +
         Log.info (fun m -> m "Spawning command: %s" (String.concat " " cmd));

     

       136
       +
       

     

       137
       +
         (* Create pipes for stdin/stdout *)

     

       138
       +
         let stdin_r, stdin_w = Eio.Process.pipe ~sw process_mgr in

     

       139
       +
         let stdout_r, stdout_w = Eio.Process.pipe ~sw process_mgr in

     

       140
       +
       

     

       141
       +
         (* Spawn the process *)

     

       142
       +
         let process =

     

       143
       +
           try

     

       144
       +
             Eio.Process.spawn ~sw process_mgr

     

       145
       +
               ~env

     

       146
       +
               ~stdin:(stdin_r :> Eio.Flow.source_ty Eio.Resource.t)

     

       147
       +
               ~stdout:(stdout_w :> Eio.Flow.sink_ty Eio.Resource.t)

     

       148
       +
               cmd

     

       149
       +
           with

     

       150
       +
           | exn ->

     

       151
       +
               Log.err (fun m -> m "Failed to spawn process: %s" (Printexc.to_string exn));

     

       152
       +
               raise (Process_spawn_error

     

       153
       +
                 (Printf.sprintf "Failed to spawn process: %s" (Printexc.to_string exn)))

     

       154
       +
         in

     

       155
       +
       

     

       156
       +
         (* Setup stdin for writing *)

     

       157
       +
         let stdin = (stdin_w :> Eio.Flow.sink_ty Eio.Resource.t) in

     

       158
       +
         let stdin_close = (stdin_w :> [`Close | `Flow] Eio.Resource.t) in

     

       159
       +
       

     

       160
       +
         (* Setup stdout for reading with buffering *)

     

       161
       +
         let max_size = match params.max_buffer_size with

     

       162
       +
           | Some size -> size

     

       163
       +
           | None -> 1_000_000  (* Default 1MB *)

     

       164
       +
         in

     

       165
       +
         let stdout = Eio.Buf_read.of_flow ~max_size

     

       166
       +
           (stdout_r :> Eio.Flow.source_ty Eio.Resource.t) in

     

       167
       +
       

     

       168
       +
         (* Create the state *)

     

       169
       +
         let state = {

     

       170
       +
           process = P process;

     

       171
       +
           stdin;

     

       172
       +
           stdin_close;

     

       173
       +
           stdout;

     

       174
       +
           closed = false;

     

       175
       +
           sw;

     

       176
       +
         } in

     

       177
       +
       

     

       178
       +
         (* Wrap in abstract transport type *)

     

       179
       +
         Transport.T ((module Stdio_transport), state)

+38

claudeio/lib_mcp/transport_stdio.mli

···

       1
       +
       (** Stdio transport implementation for MCP *)

     

       2
       +
       

     

       3
       +
       (** Parameters for creating a stdio transport *)

     

       4
       +
       type params = {

     

       5
       +
         command : string;

     

       6
       +
         (** The command to execute (executable path or name in PATH) *)

     

       7
       +
       

     

       8
       +
         args : string list;

     

       9
       +
         (** Command-line arguments to pass to the command *)

     

       10
       +
       

     

       11
       +
         env : (string * string) list option;

     

       12
       +
         (** Optional environment variables to set. If [None], inherits parent environment.

     

       13
       +
             If [Some vars], these are ADDED to essential preserved variables (HOME, PATH, etc.) *)

     

       14
       +
       

     

       15
       +
         max_buffer_size : int option;

     

       16
       +
         (** Maximum buffer size for reading from stdout. Defaults to 1MB if [None] *)

     

       17
       +
       }

     

       18
       +
       

     

       19
       +
       (** [create ~sw ~process_mgr params] creates a new stdio transport by spawning

     

       20
       +
           a subprocess with the given parameters.

     

       21
       +
       

     

       22
       +
           The subprocess communicates via line-delimited JSON on stdin/stdout:

     

       23
       +
           - Each message is a single JSON object on one line

     

       24
       +
           - Lines are terminated with newline ('\n')

     

       25
       +
           - The transport handles encoding/decoding automatically

     

       26
       +
       

     

       27
       +
           @param sw The Eio switch that manages the subprocess lifetime

     

       28
       +
           @param process_mgr The Eio process manager for spawning subprocesses

     

       29
       +
           @param params Configuration parameters for the subprocess

     

       30
       +
           @raise Transport.Connection_error if subprocess spawning fails *)

     

       31
       +
       val create :

     

       32
       +
         sw:Eio.Switch.t ->

     

       33
       +
         process_mgr:_ Eio.Process.mgr ->

     

       34
       +
         params ->

     

       35
       +
         Transport.t

     

       36
       +
       

     

       37
       +
       (** Exception raised when subprocess spawning fails *)

     

       38
       +
       exception Process_spawn_error of string

+30

claudeio/mcp.opam

···

       1
       +
       # This file is generated by dune, edit dune-project instead

     

       2
       +
       opam-version: "2.0"

     

       3
       +
       synopsis: "Model Context Protocol (MCP) implementation in OCaml"

     

       4
       +
       description:

     

       5
       +
         "An Eio-based OCaml library implementing the Model Context Protocol for connecting AI assistants with tools and data sources"

     

       6
       +
       depends: [

     

       7
       +
         "ocaml"

     

       8
       +
         "dune" {>= "3.0"}

     

       9
       +
         "eio"

     

       10
       +
         "fmt"

     

       11
       +
         "logs"

     

       12
       +
         "jsont" {>= "0.2.0"}

     

       13
       +
         "jsont_bytesrw" {>= "0.2.0"}

     

       14
       +
         "alcotest" {with-test}

     

       15
       +
         "odoc" {with-doc}

     

       16
       +
       ]

     

       17
       +
       build: [

     

       18
       +
         ["dune" "subst"] {dev}

     

       19
       +
         [

     

       20
       +
           "dune"

     

       21
       +
           "build"

     

       22
       +
           "-p"

     

       23
       +
           name

     

       24
       +
           "-j"

     

       25
       +
           jobs

     

       26
       +
           "@install"

     

       27
       +
           "@runtest" {with-test}

     

       28
       +
           "@doc" {with-doc}

     

       29
       +
         ]

     

       30
       +
       ]