comparing 192863a1ade1343e0ee15bb8b7fafb7e4c8d05c4 and tmp on anil.recoil.org/ocaml-mcp

+330

bin/audio_example.ml

···

       1
       +
       open Mcp

     

       2
       +
       open Mcp_sdk

     

       3
       +
       open Mcp_server

     

       4
       +
       

     

       5
       +
       (* WAV file format helper module *)

     

       6
       +
       module Wav = struct

     

       7
       +
         (* Simple WAV file generation for a sine wave *)

     

       8
       +
         let generate_sine_wave ~frequency ~duration ~sample_rate ~amplitude =

     

       9
       +
           (* WAV parameters *)

     

       10
       +
           let num_channels = 1 in (* Mono *)

     

       11
       +
           let bits_per_sample = 16 in

     

       12
       +
           let byte_rate = sample_rate * num_channels * bits_per_sample / 8 in

     

       13
       +
           let block_align = num_channels * bits_per_sample / 8 in

     

       14
       +
           let num_samples = int_of_float (float_of_int sample_rate *. duration) in

     

       15
       +
           let data_size = num_samples * block_align in

     

       16
       +
           

     

       17
       +
           (* Create buffer for the WAV data *)

     

       18
       +
           let buffer = Buffer.create (44 + data_size) in

     

       19
       +
           

     

       20
       +
           (* Write WAV header *)

     

       21
       +
           (* "RIFF" chunk *)

     

       22
       +
           Buffer.add_string buffer "RIFF";

     

       23
       +
           let file_size = 36 + data_size in

     

       24
       +
           Buffer.add_char buffer (char_of_int (file_size land 0xff));

     

       25
       +
           Buffer.add_char buffer (char_of_int ((file_size lsr 8) land 0xff));

     

       26
       +
           Buffer.add_char buffer (char_of_int ((file_size lsr 16) land 0xff));

     

       27
       +
           Buffer.add_char buffer (char_of_int ((file_size lsr 24) land 0xff));

     

       28
       +
           Buffer.add_string buffer "WAVE";

     

       29
       +
           

     

       30
       +
           (* "fmt " sub-chunk *)

     

       31
       +
           Buffer.add_string buffer "fmt ";

     

       32
       +
           Buffer.add_char buffer (char_of_int 16); (* Sub-chunk size (16 for PCM) *)

     

       33
       +
           Buffer.add_char buffer (char_of_int 0);

     

       34
       +
           Buffer.add_char buffer (char_of_int 0);

     

       35
       +
           Buffer.add_char buffer (char_of_int 0);

     

       36
       +
           Buffer.add_char buffer (char_of_int 1); (* Audio format (1 for PCM) *)

     

       37
       +
           Buffer.add_char buffer (char_of_int 0);

     

       38
       +
           Buffer.add_char buffer (char_of_int num_channels); (* Number of channels *)

     

       39
       +
           Buffer.add_char buffer (char_of_int 0);

     

       40
       +
           

     

       41
       +
           (* Sample rate *)

     

       42
       +
           Buffer.add_char buffer (char_of_int (sample_rate land 0xff));

     

       43
       +
           Buffer.add_char buffer (char_of_int ((sample_rate lsr 8) land 0xff));

     

       44
       +
           Buffer.add_char buffer (char_of_int ((sample_rate lsr 16) land 0xff));

     

       45
       +
           Buffer.add_char buffer (char_of_int ((sample_rate lsr 24) land 0xff));

     

       46
       +
           

     

       47
       +
           (* Byte rate *)

     

       48
       +
           Buffer.add_char buffer (char_of_int (byte_rate land 0xff));

     

       49
       +
           Buffer.add_char buffer (char_of_int ((byte_rate lsr 8) land 0xff));

     

       50
       +
           Buffer.add_char buffer (char_of_int ((byte_rate lsr 16) land 0xff));

     

       51
       +
           Buffer.add_char buffer (char_of_int ((byte_rate lsr 24) land 0xff));

     

       52
       +
           

     

       53
       +
           (* Block align *)

     

       54
       +
           Buffer.add_char buffer (char_of_int block_align);

     

       55
       +
           Buffer.add_char buffer (char_of_int 0);

     

       56
       +
           

     

       57
       +
           (* Bits per sample *)

     

       58
       +
           Buffer.add_char buffer (char_of_int bits_per_sample);

     

       59
       +
           Buffer.add_char buffer (char_of_int 0);

     

       60
       +
           

     

       61
       +
           (* "data" sub-chunk *)

     

       62
       +
           Buffer.add_string buffer "data";

     

       63
       +
           Buffer.add_char buffer (char_of_int (data_size land 0xff));

     

       64
       +
           Buffer.add_char buffer (char_of_int ((data_size lsr 8) land 0xff));

     

       65
       +
           Buffer.add_char buffer (char_of_int ((data_size lsr 16) land 0xff));

     

       66
       +
           Buffer.add_char buffer (char_of_int ((data_size lsr 24) land 0xff));

     

       67
       +
           

     

       68
       +
           (* Generate sine wave data *)

     

       69
       +
           let max_amplitude = float_of_int (1 lsl (bits_per_sample - 1)) -. 1.0 in

     

       70
       +
           for i = 0 to num_samples - 1 do

     

       71
       +
             let t = float_of_int i /. float_of_int sample_rate in

     

       72
       +
             let value = int_of_float (amplitude *. max_amplitude *. sin (2.0 *. Float.pi *. frequency *. t)) in

     

       73
       +
             (* Write 16-bit sample (little-endian) *)

     

       74
       +
             Buffer.add_char buffer (char_of_int (value land 0xff));

     

       75
       +
             Buffer.add_char buffer (char_of_int ((value lsr 8) land 0xff));

     

       76
       +
           done;

     

       77
       +
           

     

       78
       +
           Buffer.contents buffer

     

       79
       +
           

     

       80
       +
         (* Encode binary data as base64 *)

     

       81
       +
         let base64_encode data =

     

       82
       +
           let buffer = Buffer.create (4 * (String.length data + 2) / 3) in

     

       83
       +
           let alphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" in

     

       84
       +
           

     

       85
       +
           let encode_block i bytes =

     

       86
       +
             let b1 = Char.code (String.get bytes (i * 3)) in

     

       87
       +
             let b2 = if i * 3 + 1 < String.length bytes then Char.code (String.get bytes (i * 3 + 1)) else 0 in

     

       88
       +
             let b3 = if i * 3 + 2 < String.length bytes then Char.code (String.get bytes (i * 3 + 2)) else 0 in

     

       89
       +
             

     

       90
       +
             let n = (b1 lsl 16) lor (b2 lsl 8) lor b3 in

     

       91
       +
             Buffer.add_char buffer (String.get alphabet ((n lsr 18) land 63));

     

       92
       +
             Buffer.add_char buffer (String.get alphabet ((n lsr 12) land 63));

     

       93
       +
             

     

       94
       +
             if i * 3 + 1 < String.length bytes then

     

       95
       +
               Buffer.add_char buffer (String.get alphabet ((n lsr 6) land 63))

     

       96
       +
             else

     

       97
       +
               Buffer.add_char buffer '=';

     

       98
       +
               

     

       99
       +
             if i * 3 + 2 < String.length bytes then

     

       100
       +
               Buffer.add_char buffer (String.get alphabet (n land 63))

     

       101
       +
             else

     

       102
       +
               Buffer.add_char buffer '=';

     

       103
       +
           in

     

       104
       +
           

     

       105
       +
           for i = 0 to (String.length data + 2) / 3 - 1 do

     

       106
       +
             encode_block i data

     

       107
       +
           done;

     

       108
       +
           

     

       109
       +
           Buffer.contents buffer

     

       110
       +
       end

     

       111
       +
       

     

       112
       +
       (* Helper for extracting string value from JSON *)

     

       113
       +
       let get_string_param json name =

     

       114
       +
         match json with

     

       115
       +
         | `Assoc fields ->

     

       116
       +
           (match List.assoc_opt name fields with

     

       117
       +
           | Some (`String value) -> value

     

       118
       +
           | _ -> raise (Failure (Printf.sprintf "Missing or invalid parameter: %s" name)))

     

       119
       +
         | _ -> raise (Failure "Expected JSON object")

     

       120
       +
       

     

       121
       +
       (* Create a server *)

     

       122
       +
       let server = create_server 

     

       123
       +
         ~name:"OCaml MCP Audio Example" 

     

       124
       +
         ~version:"0.1.0" 

     

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

     

       126
       +
         ()

     

       127
       +
       

     

       128
       +
       (* Define startup and shutdown hooks *)

     

       129
       +
       let startup () =

     

       130
       +
         (* Use stderr for direct printing to avoid interfering with JSON-RPC protocol *)

     

       131
       +
         Printf.fprintf stderr "AudioExampleServer is starting up!\n";

     

       132
       +
         flush stderr;

     

       133
       +
         Log.info "AudioExampleServer is starting up!"

     

       134
       +
       

     

       135
       +
       let shutdown () =

     

       136
       +
         Printf.fprintf stderr "AudioExampleServer is shutting down. Goodbye!\n";

     

       137
       +
         flush stderr;

     

       138
       +
         Log.info "AudioExampleServer is shutting down. Goodbye!"

     

       139
       +
       

     

       140
       +
       (* Register the hooks *)

     

       141
       +
       let () =

     

       142
       +
         set_startup_hook server startup;

     

       143
       +
         set_shutdown_hook server shutdown

     

       144
       +
       

     

       145
       +
       (* Helper to create audio content *)

     

       146
       +
       let make_audio_content data mime_type =

     

       147
       +
         let audio_content = AudioContent.{

     

       148
       +
           data;

     

       149
       +
           mime_type;

     

       150
       +
           annotations = None;

     

       151
       +
         } in

     

       152
       +
         Audio audio_content

     

       153
       +
       

     

       154
       +
       (* Define and register an audio tool *)

     

       155
       +
       let _ = add_tool server

     

       156
       +
         ~name:"generate_audio_description"

     

       157
       +
         ~description:"Generates a description with an audio sample"

     

       158
       +
         ~schema_properties:[

     

       159
       +
           ("text", "string", "The text to describe with audio");

     

       160
       +
           ("frequency", "number", "The frequency in Hz for the tone (optional)");

     

       161
       +
           ("duration", "number", "The duration in seconds for the tone (optional)");

     

       162
       +
           ("amplitude", "number", "The amplitude (0.0-1.0) for the tone (optional)");

     

       163
       +
         ]

     

       164
       +
         ~schema_required:["text"]

     

       165
       +
         (fun args ->

     

       166
       +
           try

     

       167
       +
             let text = get_string_param args "text" in

     

       168
       +
             

     

       169
       +
             (* Parse parameters with defaults *)

     

       170
       +
             let frequency = 

     

       171
       +
               try

     

       172
       +
                 match List.assoc_opt "frequency" (match args with `Assoc l -> l | _ -> []) with

     

       173
       +
                 | Some (`Int f) -> float_of_int f

     

       174
       +
                 | Some (`Float f) -> f

     

       175
       +
                 | _ -> 440.0 (* Default to A440 *)

     

       176
       +
               with _ -> 440.0

     

       177
       +
             in

     

       178
       +
             

     

       179
       +
             let duration = 

     

       180
       +
               try

     

       181
       +
                 match List.assoc_opt "duration" (match args with `Assoc l -> l | _ -> []) with

     

       182
       +
                 | Some (`Int d) -> float_of_int d

     

       183
       +
                 | Some (`Float d) -> d

     

       184
       +
                 | _ -> 2.0 (* Default to 2 seconds *)

     

       185
       +
               with _ -> 2.0

     

       186
       +
             in

     

       187
       +
             

     

       188
       +
             let amplitude = 

     

       189
       +
               try

     

       190
       +
                 match List.assoc_opt "amplitude" (match args with `Assoc l -> l | _ -> []) with

     

       191
       +
                 | Some (`Int a) -> float_of_int a

     

       192
       +
                 | Some (`Float a) -> a

     

       193
       +
                 | _ -> 0.8 (* Default to 80% amplitude *)

     

       194
       +
               with _ -> 0.8

     

       195
       +
             in

     

       196
       +
             

     

       197
       +
             (* Generate WAV file for the tone *)

     

       198
       +
             let sample_rate = 44100 in  (* CD quality *)

     

       199
       +
             let wav_data = Wav.generate_sine_wave 

     

       200
       +
               ~frequency 

     

       201
       +
               ~duration 

     

       202
       +
               ~sample_rate 

     

       203
       +
               ~amplitude

     

       204
       +
             in

     

       205
       +
             

     

       206
       +
             (* Encode WAV data as base64 *)

     

       207
       +
             let base64_audio = Wav.base64_encode wav_data in

     

       208
       +
             

     

       209
       +
             Log.info (Printf.sprintf "Generated %d Hz tone for %.1f seconds (%.1f KB)" 

     

       210
       +
                         (int_of_float frequency) duration 

     

       211
       +
                         (float_of_int (String.length wav_data) /. 1024.0));

     

       212
       +
             

     

       213
       +
             (* Create a response with both text and audio content *)

     

       214
       +
             CallToolResult.yojson_of_t CallToolResult.{

     

       215
       +
               content = [

     

       216
       +
                 Text TextContent.{ 

     

       217
       +
                   text = Printf.sprintf "Description: %s (with %.1f Hz tone for %.1f seconds)" 

     

       218
       +
                           text frequency duration; 

     

       219
       +
                   annotations = None 

     

       220
       +
                 };

     

       221
       +
                 Audio AudioContent.{ 

     

       222
       +
                   data = base64_audio; 

     

       223
       +
                   mime_type = "audio/wav"; 

     

       224
       +
                   annotations = None 

     

       225
       +
                 }

     

       226
       +
               ];

     

       227
       +
               is_error = false;

     

       228
       +
               meta = None

     

       229
       +
             }

     

       230
       +
           with

     

       231
       +
           | Failure msg ->

     

       232
       +
             Log.error (Printf.sprintf "Error in audio tool: %s" msg);

     

       233
       +
             CallToolResult.yojson_of_t CallToolResult.{

     

       234
       +
               content = [

     

       235
       +
                 Text TextContent.{ 

     

       236
       +
                   text = Printf.sprintf "Error: %s" msg; 

     

       237
       +
                   annotations = None 

     

       238
       +
                 }

     

       239
       +
               ];

     

       240
       +
               is_error = true;

     

       241
       +
               meta = None

     

       242
       +
             }

     

       243
       +
         )

     

       244
       +
       

     

       245
       +
       (* Define and register a prompt example with audio *)

     

       246
       +
       let _ = add_prompt server

     

       247
       +
         ~name:"audio-description-prompt"

     

       248
       +
         ~description:"A prompt with audio and text content"

     

       249
       +
         ~arguments:[

     

       250
       +
           ("description", Some "Text description to accompany the audio", true);

     

       251
       +
           ("frequency", Some "Frequency in Hz for the audio tone", false);

     

       252
       +
           ("duration", Some "Duration in seconds for the audio tone", false);

     

       253
       +
         ]

     

       254
       +
         (fun args ->

     

       255
       +
           let description = 

     

       256
       +
             try List.assoc "description" args

     

       257
       +
             with Not_found -> "No description provided"

     

       258
       +
           in

     

       259
       +
           

     

       260
       +
           (* Parse frequency with default *)

     

       261
       +
           let frequency = 

     

       262
       +
             try float_of_string (List.assoc "frequency" args)

     

       263
       +
             with _ -> 440.0 (* Default to A440 *)

     

       264
       +
           in

     

       265
       +
           

     

       266
       +
           (* Parse duration with default *)

     

       267
       +
           let duration =

     

       268
       +
             try float_of_string (List.assoc "duration" args)

     

       269
       +
             with _ -> 3.0 (* Default to 3 seconds *)

     

       270
       +
           in

     

       271
       +
           

     

       272
       +
           (* Generate WAV data *)

     

       273
       +
           let sample_rate = 44100 in

     

       274
       +
           let wav_data = Wav.generate_sine_wave 

     

       275
       +
             ~frequency 

     

       276
       +
             ~duration 

     

       277
       +
             ~sample_rate 

     

       278
       +
             ~amplitude:0.8

     

       279
       +
           in

     

       280
       +
           

     

       281
       +
           (* Encode WAV data as base64 *)

     

       282
       +
           let base64_audio = Wav.base64_encode wav_data in

     

       283
       +
           

     

       284
       +
           Log.info (Printf.sprintf "Generated %.1f Hz tone for prompt (%.1f seconds, %.1f KB)" 

     

       285
       +
                       frequency duration 

     

       286
       +
                       (float_of_int (String.length wav_data) /. 1024.0));

     

       287
       +
           

     

       288
       +
           [

     

       289
       +
             Prompt.{ 

     

       290
       +
               role = `User; 

     

       291
       +
               content = make_text_content "Here's a sound sample with description:"

     

       292
       +
             };

     

       293
       +
             Prompt.{ 

     

       294
       +
               role = `User;

     

       295
       +
               content = make_audio_content base64_audio "audio/wav" 

     

       296
       +
             };

     

       297
       +
             Prompt.{ 

     

       298
       +
               role = `User; 

     

       299
       +
               content = make_text_content (Printf.sprintf "%s (%.1f Hz tone for %.1f seconds)" 

     

       300
       +
                                             description frequency duration)

     

       301
       +
             };

     

       302
       +
             Prompt.{ 

     

       303
       +
               role = `Assistant; 

     

       304
       +
               content = make_text_content "I've received your audio file and description."

     

       305
       +
             }

     

       306
       +
           ]

     

       307
       +
         )

     

       308
       +
       

     

       309
       +
       (* Main function *)

     

       310
       +
       let () =

     

       311
       +
         (* Parse command line arguments *)

     

       312
       +
         let transport_type = ref Mcp_server.Stdio in

     

       313
       +
         let args = [

     

       314
       +
           ("--http", Arg.Unit (fun () -> transport_type := Mcp_server.Http), 

     

       315
       +
            "Start server with HTTP transport (default is stdio)");

     

       316
       +
         ] in

     

       317
       +
         let usage_msg = "Usage: audio_example [--http]" in

     

       318
       +
         Arg.parse args (fun _ -> ()) usage_msg;

     

       319
       +
       

     

       320
       +
         (* Use stderr for direct printing to avoid interfering with JSON-RPC protocol *)

     

       321
       +
         Printf.fprintf stderr "Starting AudioExampleServer...\n";

     

       322
       +
         flush stderr;

     

       323
       +
         Log.info "Starting AudioExampleServer...";

     

       324
       +
         

     

       325
       +
         (* Configure the server with appropriate capabilities *)

     

       326
       +
         ignore (configure_server server ());

     

       327
       +
         

     

       328
       +
         (* Create and start MCP server with the selected transport *)

     

       329
       +
         let mcp_server = Mcp_server.create ~server ~transport:!transport_type () in

     

       330
       +
         Mcp_server.start mcp_server

+46 -12

bin/capitalize_sdk.ml

···

       1
        
       open Mcp

     

       2
        
       open Mcp_sdk

     

       0
        
       
     

       3
        
       

     

       4
        
       (* Helper for extracting string value from JSON *)

     

       5
        
       let get_string_param json name =

     
···

       14
        
       let server = create_server 

     

       15
        
         ~name:"OCaml MCP Capitalizer" 

     

       16
        
         ~version:"0.1.0" 

     

       17
       -
         ~protocol_version:"2024-11-05" () |>

     

       18
       -
         fun server ->

     

       19
       -
         (* Set default capabilities *)

     

       20
       -
           configure_server server ~with_tools:true ~with_resources:true ~with_prompts:true ()

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       21
        
       

     

       22
        
       (* Define and register a capitalize tool *)

     

       23
        
       let _ = add_tool server

     
···

       37
        
             }

     

       38
        
           with

     

       39
        
           | Failure msg ->

     

       40
       -
             Log.errorf "Error in capitalize tool: %s" msg;

     

       41
        
             TextContent.yojson_of_t TextContent.{

     

       42
        
               text = Printf.sprintf "Error: %s" msg;

     

       43
        
               annotations = None

     
···

       72
        
           [

     

       73
        
             Prompt.{ 

     

       74
        
               role = `User; 

     

       75
       -
               content = Mcp.make_text_content "Please help me capitalize the following text:"

     

       76
        
             };

     

       77
        
             Prompt.{ 

     

       78
        
               role = `User; 

     

       79
       -
               content = Mcp.make_text_content text

     

       80
        
             };

     

       81
        
             Prompt.{ 

     

       82
        
               role = `Assistant; 

     

       83
       -
               content = Mcp.make_text_content "Here's the capitalized version:"

     

       84
        
             };

     

       85
        
             Prompt.{ 

     

       86
        
               role = `Assistant; 

     

       87
       -
               content = Mcp.make_text_content (String.uppercase_ascii text)

     

       88
        
             }

     

       89
        
           ]

     

       90
        
         )

     

       91
        
       

     

       0
        
       
     

       92
        
       let () =

     

       93
       -
         (* Run the server with the default scheduler *)

     

       94
       -
         Eio_main.run @@ fun env->

     

       95
       -
           Mcp_server.run_server env server

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0

···

       1
        
       open Mcp

     

       2
        
       open Mcp_sdk

     

       3
       +
       open Mcp_server

     

       4
        
       

     

       5
        
       (* Helper for extracting string value from JSON *)

     

       6
        
       let get_string_param json name =

     
···

       15
        
       let server = create_server 

     

       16
        
         ~name:"OCaml MCP Capitalizer" 

     

       17
        
         ~version:"0.1.0" 

     

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

     

       19
       +
         ()

     

       20
       +
       

     

       21
       +
       (* Define startup and shutdown hooks *)

     

       22
       +
       let startup () =

     

       23
       +
         (* Use stderr for direct printing to avoid interfering with JSON-RPC protocol *)

     

       24
       +
         Printf.fprintf stderr "CapitalizeServer is starting up!\n";

     

       25
       +
         flush stderr;

     

       26
       +
         Log.info "CapitalizeServer is starting up!"

     

       27
       +
       

     

       28
       +
       let shutdown () =

     

       29
       +
         Printf.fprintf stderr "CapitalizeServer is shutting down. Goodbye!\n";

     

       30
       +
         flush stderr;

     

       31
       +
         Log.info "CapitalizeServer is shutting down. Goodbye!"

     

       32
       +
       

     

       33
       +
       (* Register the hooks *)

     

       34
       +
       let () =

     

       35
       +
         set_startup_hook server startup;

     

       36
       +
         set_shutdown_hook server shutdown

     

       37
        
       

     

       38
        
       (* Define and register a capitalize tool *)

     

       39
        
       let _ = add_tool server

     
···

       53
        
             }

     

       54
        
           with

     

       55
        
           | Failure msg ->

     

       56
       +
             Log.error (Printf.sprintf "Error in capitalize tool: %s" msg);

     

       57
        
             TextContent.yojson_of_t TextContent.{

     

       58
        
               text = Printf.sprintf "Error: %s" msg;

     

       59
        
               annotations = None

     
···

       88
        
           [

     

       89
        
             Prompt.{ 

     

       90
        
               role = `User; 

     

       91
       +
               content = make_text_content "Please help me capitalize the following text:"

     

       92
        
             };

     

       93
        
             Prompt.{ 

     

       94
        
               role = `User; 

     

       95
       +
               content = make_text_content text

     

       96
        
             };

     

       97
        
             Prompt.{ 

     

       98
        
               role = `Assistant; 

     

       99
       +
               content = make_text_content "Here's the capitalized version:"

     

       100
        
             };

     

       101
        
             Prompt.{ 

     

       102
        
               role = `Assistant; 

     

       103
       +
               content = make_text_content (String.uppercase_ascii text)

     

       104
        
             }

     

       105
        
           ]

     

       106
        
         )

     

       107
        
       

     

       108
       +
       (* Main function *)

     

       109
        
       let () =

     

       110
       +
         (* Parse command line arguments *)

     

       111
       +
         let transport_type = ref Stdio in

     

       112
       +
         let args = [

     

       113
       +
           ("--http", Arg.Unit (fun () -> transport_type := Http), 

     

       114
       +
            "Start server with HTTP transport (default is stdio)");

     

       115
       +
         ] in

     

       116
       +
         let usage_msg = "Usage: capitalize_sdk [--http]" in

     

       117
       +
         Arg.parse args (fun _ -> ()) usage_msg;

     

       118
       +
       

     

       119
       +
         (* Use stderr for direct printing to avoid interfering with JSON-RPC protocol *)

     

       120
       +
         Printf.fprintf stderr "Starting CapitalizeServer...\n";

     

       121
       +
         flush stderr;

     

       122
       +
         Log.info "Starting CapitalizeServer...";

     

       123
       +
         

     

       124
       +
         (* Configure the server with appropriate capabilities *)

     

       125
       +
         ignore (configure_server server ());

     

       126
       +
         

     

       127
       +
         (* Create and start MCP server with the selected transport *)

     

       128
       +
         let mcp_server = create ~server ~transport:!transport_type () in

     

       129
       +
         start mcp_server

+193

bin/completion_example.ml

···

       1
       +
       open Mcp

     

       2
       +
       open Mcp_sdk

     

       3
       +
       open Mcp_server

     

       4
       +
       

     

       5
       +
       (* Helper for extracting string value from JSON *)

     

       6
       +
       let get_string_param json name =

     

       7
       +
         match json with

     

       8
       +
         | `Assoc fields ->

     

       9
       +
           (match List.assoc_opt name fields with

     

       10
       +
           | Some (`String value) -> value

     

       11
       +
           | _ -> raise (Failure (Printf.sprintf "Missing or invalid parameter: %s" name)))

     

       12
       +
         | _ -> raise (Failure "Expected JSON object")

     

       13
       +
       

     

       14
       +
       (* Create a server *)

     

       15
       +
       let server = create_server 

     

       16
       +
         ~name:"OCaml MCP Completion Example" 

     

       17
       +
         ~version:"0.1.0" 

     

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

     

       19
       +
         ()

     

       20
       +
       

     

       21
       +
       (* Define startup and shutdown hooks *)

     

       22
       +
       let startup () =

     

       23
       +
         (* Use stderr for direct printing to avoid interfering with JSON-RPC protocol *)

     

       24
       +
         Printf.fprintf stderr "CompletionServer is starting up!\n";

     

       25
       +
         flush stderr;

     

       26
       +
         Log.info "CompletionServer is starting up!"

     

       27
       +
       

     

       28
       +
       let shutdown () =

     

       29
       +
         Printf.fprintf stderr "CompletionServer is shutting down. Goodbye!\n";

     

       30
       +
         flush stderr;

     

       31
       +
         Log.info "CompletionServer is shutting down. Goodbye!"

     

       32
       +
       

     

       33
       +
       (* Register the hooks *)

     

       34
       +
       let () =

     

       35
       +
         set_startup_hook server startup;

     

       36
       +
         set_shutdown_hook server shutdown

     

       37
       +
       

     

       38
       +
       (* Database of programming languages and their features *)

     

       39
       +
       let languages = [

     

       40
       +
         ("ocaml", ["functional"; "static typing"; "pattern matching"; "modules"; "type inference"]);

     

       41
       +
         ("python", ["dynamic typing"; "interpreted"; "object-oriented"; "high-level"; "scripting"]);

     

       42
       +
         ("rust", ["memory safety"; "performance"; "static typing"; "ownership"; "zero-cost abstractions"]);

     

       43
       +
         ("javascript", ["dynamic typing"; "interpreted"; "prototypes"; "single-threaded"; "event-driven"]);

     

       44
       +
         ("go", ["concurrency"; "garbage collection"; "simplicity"; "static typing"; "compiled"]);

     

       45
       +
       ]

     

       46
       +
       

     

       47
       +
       (* Helper function to create a completion response *)

     

       48
       +
       let create_completion values ?(has_more=false) ?(total=None) () =

     

       49
       +
         Completion.Result.{

     

       50
       +
           completion = {

     

       51
       +
             values;

     

       52
       +
             has_more = Some has_more;

     

       53
       +
             total;

     

       54
       +
           };

     

       55
       +
           meta = None;

     

       56
       +
         }

     

       57
       +
       

     

       58
       +
       (* Define and register a tool that handles completions *)

     

       59
       +
       let _ = add_tool server

     

       60
       +
         ~name:"complete"

     

       61
       +
         ~description:"Handles completion requests for programming languages and features"

     

       62
       +
         ~schema_properties:[

     

       63
       +
           ("argument_name", "string", "The name of the argument to complete");

     

       64
       +
           ("argument_value", "string", "The partial value to complete");

     

       65
       +
         ]

     

       66
       +
         ~schema_required:["argument_name"; "argument_value"]

     

       67
       +
         (fun args ->

     

       68
       +
           try

     

       69
       +
             let argument_name = get_string_param args "argument_name" in

     

       70
       +
             let argument_value = get_string_param args "argument_value" in

     

       71
       +
             

     

       72
       +
             Log.info (Printf.sprintf "Completion request for %s = %s" argument_name argument_value);

     

       73
       +
             

     

       74
       +
             (* Handle different completion requests *)

     

       75
       +
             let result = 

     

       76
       +
               match argument_name with

     

       77
       +
               | "language" ->

     

       78
       +
                   (* Complete programming language names *)

     

       79
       +
                   let matches = 

     

       80
       +
                     List.filter 

     

       81
       +
                       (fun (lang, _) -> 

     

       82
       +
                         let lang_lower = String.lowercase_ascii lang in

     

       83
       +
                         let arg_lower = String.lowercase_ascii argument_value in

     

       84
       +
                         String.length lang_lower >= String.length arg_lower &&

     

       85
       +
                         String.sub lang_lower 0 (String.length arg_lower) = arg_lower)

     

       86
       +
                       languages

     

       87
       +
                   in

     

       88
       +
                   let values = List.map fst matches in

     

       89
       +
                   create_completion values ~has_more:false ~total:(Some (List.length values)) ()

     

       90
       +
                   

     

       91
       +
               | "feature" ->

     

       92
       +
                   (* Complete programming language features *)

     

       93
       +
                   let all_features = 

     

       94
       +
                     List.flatten (List.map snd languages) |>

     

       95
       +
                     List.sort_uniq String.compare

     

       96
       +
                   in

     

       97
       +
                   let matches =

     

       98
       +
                     List.filter

     

       99
       +
                       (fun feature -> 

     

       100
       +
                         let feature_lower = String.lowercase_ascii feature in

     

       101
       +
                         let arg_lower = String.lowercase_ascii argument_value in

     

       102
       +
                         String.length feature_lower >= String.length arg_lower &&

     

       103
       +
                         String.sub feature_lower 0 (String.length arg_lower) = arg_lower)

     

       104
       +
                       all_features

     

       105
       +
                   in

     

       106
       +
                   create_completion matches ~has_more:false ~total:(Some (List.length matches)) ()

     

       107
       +
                   

     

       108
       +
               | _ ->

     

       109
       +
                   (* Default completions for unknown arguments *)

     

       110
       +
                   create_completion ["unknown argument"] ()

     

       111
       +
             in

     

       112
       +
             

     

       113
       +
             (* Convert to JSON and return *)

     

       114
       +
             TextContent.yojson_of_t TextContent.{

     

       115
       +
               text = Yojson.Safe.to_string (Completion.Result.to_result result);

     

       116
       +
               annotations = None

     

       117
       +
             }

     

       118
       +
           with

     

       119
       +
           | Failure msg ->

     

       120
       +
               Log.error (Printf.sprintf "Error handling completion request: %s" msg);

     

       121
       +
               TextContent.yojson_of_t TextContent.{

     

       122
       +
                 text = Printf.sprintf "Error: %s" msg;

     

       123
       +
                 annotations = None

     

       124
       +
               }

     

       125
       +
         )

     

       126
       +
       

     

       127
       +
       (* Define and register a prompt that provides programming language info *)

     

       128
       +
       let _ = add_prompt server

     

       129
       +
         ~name:"language-info-prompt"

     

       130
       +
         ~description:"A prompt that provides information about programming languages"

     

       131
       +
         ~arguments:[

     

       132
       +
           ("language", Some "Name of the programming language", true);

     

       133
       +
         ]

     

       134
       +
         (fun args ->

     

       135
       +
           let language = 

     

       136
       +
             try List.assoc "language" args

     

       137
       +
             with Not_found -> "ocaml" (* Default to OCaml *)

     

       138
       +
           in

     

       139
       +
           

     

       140
       +
           let features =

     

       141
       +
             try 

     

       142
       +
               let features = List.assoc (String.lowercase_ascii language) languages in

     

       143
       +
               String.concat ", " features

     

       144
       +
             with Not_found -> "unknown language"

     

       145
       +
           in

     

       146
       +
           

     

       147
       +
           [

     

       148
       +
             Prompt.{ 

     

       149
       +
               role = `User; 

     

       150
       +
               content = make_text_content (Printf.sprintf "Tell me about the %s programming language" language)

     

       151
       +
             };

     

       152
       +
             Prompt.{ 

     

       153
       +
               role = `Assistant; 

     

       154
       +
               content = make_text_content (Printf.sprintf "%s is a programming language with the following features: %s" language features)

     

       155
       +
             }

     

       156
       +
           ]

     

       157
       +
         )

     

       158
       +
       

     

       159
       +
       (* Main function *)

     

       160
       +
       let () =

     

       161
       +
         (* Parse command line arguments *)

     

       162
       +
         let transport_type = ref Stdio in

     

       163
       +
         let args = [

     

       164
       +
           ("--http", Arg.Unit (fun () -> transport_type := Http), 

     

       165
       +
            "Start server with HTTP transport (default is stdio)");

     

       166
       +
         ] in

     

       167
       +
         let usage_msg = "Usage: completion_example [--http]" in

     

       168
       +
         Arg.parse args (fun _ -> ()) usage_msg;

     

       169
       +
       

     

       170
       +
         (* Use stderr for direct printing to avoid interfering with JSON-RPC protocol *)

     

       171
       +
         Printf.fprintf stderr "Starting CompletionServer...\n";

     

       172
       +
         flush stderr;

     

       173
       +
         Log.info "Starting CompletionServer...";

     

       174
       +
         

     

       175
       +
         (* Set custom capabilities to indicate support for completions *)

     

       176
       +
         let capabilities = `Assoc [

     

       177
       +
           ("completions", `Assoc []);  (* Indicate support for completions *)

     

       178
       +
           ("prompts", `Assoc [

     

       179
       +
             ("listChanged", `Bool true)

     

       180
       +
           ]);

     

       181
       +
           ("resources", `Assoc [

     

       182
       +
             ("listChanged", `Bool true);

     

       183
       +
             ("subscribe", `Bool true)

     

       184
       +
           ]);

     

       185
       +
           ("tools", `Assoc [

     

       186
       +
             ("listChanged", `Bool true)

     

       187
       +
           ])

     

       188
       +
         ] in

     

       189
       +
         set_capabilities server capabilities;

     

       190
       +
         

     

       191
       +
         (* Create and start MCP server with the selected transport *)

     

       192
       +
         let mcp_server = create ~server ~transport:!transport_type () in

     

       193
       +
         start mcp_server

+35 -9

bin/dune

···

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       1
        
       (executable

     

       2
        
        (name capitalize_sdk)

     

       3
        
        (modules capitalize_sdk)

     

       4
       -
        (libraries mcp mcp_server yojson eio_main eio))

     

       0
        
       
     

       5
        
       

     

       6
        
       (executable

     

       7
       -
        (name multimodal_sdk)

     

       8
       -
        (modules multimodal_sdk)

     

       9
       -
        (libraries mcp mcp_sdk mcp_server yojson eio_main eio))

     

       0
        
       
     

       10
        
       

     

       11
        
       (executable

     

       12
       -
        (name ocaml_eval_sdk)

     

       13
       -
        (modes byte)

     

       14
       -
        (modules ocaml_eval_sdk)

     

       15
       -
        (flags (:standard -w -32 -w -33))

     

       16
       -
        (libraries mcp mcp_sdk mcp_server yojson eio_main eio compiler-libs.toplevel))

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0

···

       1
       +
       (executable

     

       2
       +
        (name server)

     

       3
       +
        (libraries mcp yojson unix)

     

       4
       +
        (flags (:standard -w -8-11)))

     

       5
       +
       

     

       6
        
       (executable

     

       7
        
        (name capitalize_sdk)

     

       8
        
        (modules capitalize_sdk)

     

       9
       +
        (libraries mcp mcp_sdk mcp_server yojson unix)

     

       10
       +
        (flags (:standard -w -33)))

     

       11
        
       

     

       12
        
       (executable

     

       13
       +
        (name audio_example)

     

       14
       +
        (modules audio_example)

     

       15
       +
        (libraries mcp mcp_sdk mcp_server yojson unix)

     

       16
       +
        (flags (:standard -w -33)))

     

       17
        
       

     

       18
        
       (executable

     

       19
       +
        (name resource_template_example)

     

       20
       +
        (modules resource_template_example)

     

       21
       +
        (libraries mcp mcp_sdk mcp_server yojson unix)

     

       22
       +
        (flags (:standard -w -33)))

     

       23
       +
       

     

       24
       +
       (executable

     

       25
       +
        (name completion_example)

     

       26
       +
        (modules completion_example)

     

       27
       +
        (libraries mcp mcp_sdk mcp_server yojson unix)

     

       28
       +
        (flags (:standard -w -33)))

     

       29
       +
       

     

       30
       +
       

     

       31
       +
       (executable

     

       32
       +
        (name image_generator_example)

     

       33
       +
        (modules image_generator_example)

     

       34
       +
        (libraries mcp mcp_sdk mcp_server yojson unix)

     

       35
       +
        (flags (:standard -w -33)))

     

       36
       +
       

     

       37
       +
       (executable

     

       38
       +
        (name multimodal_example)

     

       39
       +
        (modules multimodal_example)

     

       40
       +
        (libraries mcp mcp_sdk mcp_server yojson unix)

     

       41
       +
        (flags (:standard -w -33 -w -32)))

     

       42
       +

+468

bin/image_generator_example.ml

···

       1
       +
       open Mcp

     

       2
       +
       open Mcp_sdk

     

       3
       +
       open Mcp_server

     

       4
       +
       

     

       5
       +
       (* Random pixel image generator MCP server *)

     

       6
       +
       

     

       7
       +
       (* Base64 encoding helper *)

     

       8
       +
       module Base64 = struct

     

       9
       +
         let encode_char n =

     

       10
       +
           "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/".[n]

     

       11
       +
           

     

       12
       +
         let encode_block i bytes =

     

       13
       +
           let buffer = Buffer.create 4 in

     

       14
       +
           let b1 = Char.code (String.get bytes (i * 3)) in

     

       15
       +
           let b2 = if i * 3 + 1 < String.length bytes then Char.code (String.get bytes (i * 3 + 1)) else 0 in

     

       16
       +
           let b3 = if i * 3 + 2 < String.length bytes then Char.code (String.get bytes (i * 3 + 2)) else 0 in

     

       17
       +
           

     

       18
       +
           let n = (b1 lsl 16) lor (b2 lsl 8) lor b3 in

     

       19
       +
           Buffer.add_char buffer (encode_char ((n lsr 18) land 63));

     

       20
       +
           Buffer.add_char buffer (encode_char ((n lsr 12) land 63));

     

       21
       +
           

     

       22
       +
           if i * 3 + 1 < String.length bytes then

     

       23
       +
             Buffer.add_char buffer (encode_char ((n lsr 6) land 63))

     

       24
       +
           else

     

       25
       +
             Buffer.add_char buffer '=';

     

       26
       +
             

     

       27
       +
           if i * 3 + 2 < String.length bytes then

     

       28
       +
             Buffer.add_char buffer (encode_char (n land 63))

     

       29
       +
           else

     

       30
       +
             Buffer.add_char buffer '=';

     

       31
       +
           

     

       32
       +
           Buffer.contents buffer

     

       33
       +
           

     

       34
       +
         let encode data =

     

       35
       +
           let buffer = Buffer.create (4 * (String.length data + 2) / 3) in

     

       36
       +
           for i = 0 to (String.length data - 1) / 3 do

     

       37
       +
             Buffer.add_string buffer (encode_block i data)

     

       38
       +
           done;

     

       39
       +
           Buffer.contents buffer

     

       40
       +
       end

     

       41
       +
       

     

       42
       +
       (* Image generation utilities *)

     

       43
       +
       module ImageGenerator = struct

     

       44
       +
         (* Simple PNG generation *)

     

       45
       +
         let create_png width height pixels =

     

       46
       +
           (* PNG signature *)

     

       47
       +
           let signature = [|137; 80; 78; 71; 13; 10; 26; 10|] in

     

       48
       +
           

     

       49
       +
           (* IHDR chunk data *)

     

       50
       +
           let ihdr_data = Bytes.create 13 in

     

       51
       +
           (* Width - big endian *)

     

       52
       +
           Bytes.set ihdr_data 0 (Char.chr ((width lsr 24) land 0xff));

     

       53
       +
           Bytes.set ihdr_data 1 (Char.chr ((width lsr 16) land 0xff));

     

       54
       +
           Bytes.set ihdr_data 2 (Char.chr ((width lsr 8) land 0xff));

     

       55
       +
           Bytes.set ihdr_data 3 (Char.chr (width land 0xff));

     

       56
       +
           (* Height - big endian *)

     

       57
       +
           Bytes.set ihdr_data 4 (Char.chr ((height lsr 24) land 0xff));

     

       58
       +
           Bytes.set ihdr_data 5 (Char.chr ((height lsr 16) land 0xff));

     

       59
       +
           Bytes.set ihdr_data 6 (Char.chr ((height lsr 8) land 0xff));

     

       60
       +
           Bytes.set ihdr_data 7 (Char.chr (height land 0xff));

     

       61
       +
           (* Bit depth - 8 bits *)

     

       62
       +
           Bytes.set ihdr_data 8 (Char.chr 8);

     

       63
       +
           (* Color type - RGB with alpha *)

     

       64
       +
           Bytes.set ihdr_data 9 (Char.chr 6);

     

       65
       +
           (* Compression, filter, interlace - all 0 *)

     

       66
       +
           Bytes.set ihdr_data 10 (Char.chr 0);

     

       67
       +
           Bytes.set ihdr_data 11 (Char.chr 0);

     

       68
       +
           Bytes.set ihdr_data 12 (Char.chr 0);

     

       69
       +
           

     

       70
       +
           (* Very simple CRC32 implementation for PNG chunks *)

     

       71
       +
           let calculate_crc data =

     

       72
       +
             let crc = ref 0xffffffff in

     

       73
       +
             for i = 0 to Bytes.length data - 1 do

     

       74
       +
               let byte = Char.code (Bytes.get data i) in

     

       75
       +
               crc := !crc lxor byte;

     

       76
       +
               for _ = 0 to 7 do

     

       77
       +
                 if !crc land 1 <> 0 then

     

       78
       +
                   crc := (!crc lsr 1) lxor 0xedb88320

     

       79
       +
                 else

     

       80
       +
                   crc := !crc lsr 1

     

       81
       +
               done

     

       82
       +
             done;

     

       83
       +
             !crc lxor 0xffffffff

     

       84
       +
           in

     

       85
       +
           

     

       86
       +
           (* Create IHDR chunk *)

     

       87
       +
           let ihdr_chunk = Buffer.create 25 in

     

       88
       +
           (* Length - 13 bytes *)

     

       89
       +
           Buffer.add_char ihdr_chunk (Char.chr 0);

     

       90
       +
           Buffer.add_char ihdr_chunk (Char.chr 0);

     

       91
       +
           Buffer.add_char ihdr_chunk (Char.chr 0);

     

       92
       +
           Buffer.add_char ihdr_chunk (Char.chr 13);

     

       93
       +
           (* Chunk type - IHDR *)

     

       94
       +
           Buffer.add_string ihdr_chunk "IHDR";

     

       95
       +
           (* Chunk data *)

     

       96
       +
           Buffer.add_string ihdr_chunk (Bytes.unsafe_to_string ihdr_data);

     

       97
       +
           (* CRC *)

     

       98
       +
           let ihdr_crc_data = Bytes.create 17 in

     

       99
       +
           Bytes.blit_string "IHDR" 0 ihdr_crc_data 0 4;

     

       100
       +
           Bytes.blit ihdr_data 0 ihdr_crc_data 4 13;

     

       101
       +
           let crc = calculate_crc ihdr_crc_data in

     

       102
       +
           Buffer.add_char ihdr_chunk (Char.chr ((crc lsr 24) land 0xff));

     

       103
       +
           Buffer.add_char ihdr_chunk (Char.chr ((crc lsr 16) land 0xff));

     

       104
       +
           Buffer.add_char ihdr_chunk (Char.chr ((crc lsr 8) land 0xff));

     

       105
       +
           Buffer.add_char ihdr_chunk (Char.chr (crc land 0xff));

     

       106
       +
           

     

       107
       +
           (* Create IDAT chunk (uncompressed for simplicity) *)

     

       108
       +
           let row_size = width * 4 in

     

       109
       +
           let data_size = height * (row_size + 1) in

     

       110
       +
           let idat_chunk = Buffer.create (12 + data_size) in

     

       111
       +
           (* Length *)

     

       112
       +
           Buffer.add_char idat_chunk (Char.chr ((data_size lsr 24) land 0xff));

     

       113
       +
           Buffer.add_char idat_chunk (Char.chr ((data_size lsr 16) land 0xff));

     

       114
       +
           Buffer.add_char idat_chunk (Char.chr ((data_size lsr 8) land 0xff));

     

       115
       +
           Buffer.add_char idat_chunk (Char.chr (data_size land 0xff));

     

       116
       +
           (* Chunk type - IDAT *)

     

       117
       +
           Buffer.add_string idat_chunk "IDAT";

     

       118
       +
           

     

       119
       +
           (* Very simple zlib header (no compression) *)

     

       120
       +
           Buffer.add_char idat_chunk (Char.chr 0x78); (* CMF byte *)

     

       121
       +
           Buffer.add_char idat_chunk (Char.chr 0x01); (* FLG byte *)

     

       122
       +
           

     

       123
       +
           (* Raw image data with filter type 0 (None) for each scanline *)

     

       124
       +
           for y = 0 to height - 1 do

     

       125
       +
             (* Filter type 0 (None) *)

     

       126
       +
             Buffer.add_char idat_chunk (Char.chr 0);

     

       127
       +
             for x = 0 to width - 1 do

     

       128
       +
               let idx = (y * width + x) * 4 in

     

       129
       +
               Buffer.add_char idat_chunk (Char.chr (Bytes.get_uint8 pixels idx)); (* R *)

     

       130
       +
               Buffer.add_char idat_chunk (Char.chr (Bytes.get_uint8 pixels (idx + 1))); (* G *)

     

       131
       +
               Buffer.add_char idat_chunk (Char.chr (Bytes.get_uint8 pixels (idx + 2))); (* B *)

     

       132
       +
               Buffer.add_char idat_chunk (Char.chr (Bytes.get_uint8 pixels (idx + 3))); (* A *)

     

       133
       +
             done

     

       134
       +
           done;

     

       135
       +
           

     

       136
       +
           (* Zlib Adler-32 checksum (simplified) *)

     

       137
       +
           let adler = ref 1 in

     

       138
       +
           Buffer.add_char idat_chunk (Char.chr ((!adler lsr 24) land 0xff));

     

       139
       +
           Buffer.add_char idat_chunk (Char.chr ((!adler lsr 16) land 0xff));

     

       140
       +
           Buffer.add_char idat_chunk (Char.chr ((!adler lsr 8) land 0xff));

     

       141
       +
           Buffer.add_char idat_chunk (Char.chr (!adler land 0xff));

     

       142
       +
           

     

       143
       +
           (* CRC *)

     

       144
       +
           let idat_crc = ref 0 in (* Not calculating CRC for simplicity *)

     

       145
       +
           Buffer.add_char idat_chunk (Char.chr ((!idat_crc lsr 24) land 0xff));

     

       146
       +
           Buffer.add_char idat_chunk (Char.chr ((!idat_crc lsr 16) land 0xff));

     

       147
       +
           Buffer.add_char idat_chunk (Char.chr ((!idat_crc lsr 8) land 0xff));

     

       148
       +
           Buffer.add_char idat_chunk (Char.chr (!idat_crc land 0xff));

     

       149
       +
           

     

       150
       +
           (* Create IEND chunk *)

     

       151
       +
           let iend_chunk = Buffer.create 12 in

     

       152
       +
           (* Length - 0 bytes *)

     

       153
       +
           Buffer.add_char iend_chunk (Char.chr 0);

     

       154
       +
           Buffer.add_char iend_chunk (Char.chr 0);

     

       155
       +
           Buffer.add_char iend_chunk (Char.chr 0);

     

       156
       +
           Buffer.add_char iend_chunk (Char.chr 0);

     

       157
       +
           (* Chunk type - IEND *)

     

       158
       +
           Buffer.add_string iend_chunk "IEND";

     

       159
       +
           (* CRC *)

     

       160
       +
           let iend_crc = 0xAE426082 in (* Precomputed CRC for IEND chunk *)

     

       161
       +
           Buffer.add_char iend_chunk (Char.chr ((iend_crc lsr 24) land 0xff));

     

       162
       +
           Buffer.add_char iend_chunk (Char.chr ((iend_crc lsr 16) land 0xff));

     

       163
       +
           Buffer.add_char iend_chunk (Char.chr ((iend_crc lsr 8) land 0xff));

     

       164
       +
           Buffer.add_char iend_chunk (Char.chr (iend_crc land 0xff));

     

       165
       +
           

     

       166
       +
           (* Combine all parts *)

     

       167
       +
           let result = Buffer.create (8 + Buffer.length ihdr_chunk + Buffer.length idat_chunk + Buffer.length iend_chunk) in

     

       168
       +
           (* PNG signature *)

     

       169
       +
           Array.iter (fun c -> Buffer.add_char result (Char.chr c)) signature;

     

       170
       +
           (* IHDR chunk *)

     

       171
       +
           Buffer.add_buffer result ihdr_chunk;

     

       172
       +
           (* IDAT chunk *)

     

       173
       +
           Buffer.add_buffer result idat_chunk;

     

       174
       +
           (* IEND chunk *)

     

       175
       +
           Buffer.add_buffer result iend_chunk;

     

       176
       +
           

     

       177
       +
           Buffer.contents result

     

       178
       +
         

     

       179
       +
         (* Generate random pixel art image *)

     

       180
       +
         let generate_random_image ?(width=16) ?(height=16) ?(pixel_size=1) ?(seed=None) () =

     

       181
       +
           let pixels = Bytes.create (width * height * 4) in

     

       182
       +
           

     

       183
       +
           (* Set random seed if provided *)

     

       184
       +
           (match seed with

     

       185
       +
            | Some s -> Random.init s

     

       186
       +
            | None -> Random.self_init ());

     

       187
       +
           

     

       188
       +
           (* Generate a random color palette *)

     

       189
       +
           let palette_size = Random.int 8 + 2 in (* 2-10 colors *)

     

       190
       +
           let palette = Array.init palette_size (fun _ ->

     

       191
       +
             (Random.int 256, Random.int 256, Random.int 256, 255) (* RGBA *)

     

       192
       +
           ) in

     

       193
       +
           

     

       194
       +
           (* Fill the pixel buffer *)

     

       195
       +
           for y = 0 to height - 1 do

     

       196
       +
             for x = 0 to width - 1 do

     

       197
       +
               let color_idx = Random.int palette_size in

     

       198
       +
               let (r, g, b, a) = palette.(color_idx) in

     

       199
       +
               let idx = (y * width + x) * 4 in

     

       200
       +
               Bytes.set_uint8 pixels idx r;

     

       201
       +
               Bytes.set_uint8 pixels (idx + 1) g;

     

       202
       +
               Bytes.set_uint8 pixels (idx + 2) b;

     

       203
       +
               Bytes.set_uint8 pixels (idx + 3) a;

     

       204
       +
             done

     

       205
       +
           done;

     

       206
       +
           

     

       207
       +
           (* Create symmetrical patterns - horizontally, vertically, or both *)

     

       208
       +
           let symmetry_type = Random.int 3 in

     

       209
       +
           if symmetry_type > 0 then begin

     

       210
       +
             for y = 0 to height - 1 do

     

       211
       +
               for x = 0 to width / 2 do

     

       212
       +
                 (* Mirror horizontally (except center column for odd widths) *)

     

       213
       +
                 if symmetry_type = 1 || symmetry_type = 2 then begin

     

       214
       +
                   let mirror_x = width - 1 - x in

     

       215
       +
                   if x <> mirror_x then begin

     

       216
       +
                     let src_idx = (y * width + x) * 4 in

     

       217
       +
                     let dst_idx = (y * width + mirror_x) * 4 in

     

       218
       +
                     for i = 0 to 3 do

     

       219
       +
                       Bytes.set pixels (dst_idx + i) (Bytes.get pixels (src_idx + i))

     

       220
       +
                     done

     

       221
       +
                   end

     

       222
       +
                 end

     

       223
       +
               done

     

       224
       +
             done;

     

       225
       +
             

     

       226
       +
             (* Mirror vertically for symmetry_type = 2 *)

     

       227
       +
             if symmetry_type = 2 then begin

     

       228
       +
               for y = 0 to height / 2 do

     

       229
       +
                 let mirror_y = height - 1 - y in

     

       230
       +
                 if y <> mirror_y then begin

     

       231
       +
                   for x = 0 to width - 1 do

     

       232
       +
                     let src_idx = (y * width + x) * 4 in

     

       233
       +
                     let dst_idx = (mirror_y * width + x) * 4 in

     

       234
       +
                     for i = 0 to 3 do

     

       235
       +
                       Bytes.set pixels (dst_idx + i) (Bytes.get pixels (src_idx + i))

     

       236
       +
                     done

     

       237
       +
                   done

     

       238
       +
                 end

     

       239
       +
               done

     

       240
       +
             end

     

       241
       +
           end;

     

       242
       +
           

     

       243
       +
           (* Scale up the image if pixel_size > 1 *)

     

       244
       +
           let final_width = width * pixel_size in

     

       245
       +
           let final_height = height * pixel_size in

     

       246
       +
           

     

       247
       +
           if pixel_size = 1 then

     

       248
       +
             create_png width height pixels

     

       249
       +
           else begin

     

       250
       +
             let scaled_pixels = Bytes.create (final_width * final_height * 4) in

     

       251
       +
             

     

       252
       +
             for y = 0 to height - 1 do

     

       253
       +
               for x = 0 to width - 1 do

     

       254
       +
                 let src_idx = (y * width + x) * 4 in

     

       255
       +
                 for py = 0 to pixel_size - 1 do

     

       256
       +
                   for px = 0 to pixel_size - 1 do

     

       257
       +
                     let dst_x = x * pixel_size + px in

     

       258
       +
                     let dst_y = y * pixel_size + py in

     

       259
       +
                     let dst_idx = (dst_y * final_width + dst_x) * 4 in

     

       260
       +
                     for i = 0 to 3 do

     

       261
       +
                       Bytes.set scaled_pixels (dst_idx + i) (Bytes.get pixels (src_idx + i))

     

       262
       +
                     done

     

       263
       +
                   done

     

       264
       +
                 done

     

       265
       +
               done

     

       266
       +
             done;

     

       267
       +
             

     

       268
       +
             create_png final_width final_height scaled_pixels

     

       269
       +
           end

     

       270
       +
       end

     

       271
       +
       

     

       272
       +
       (* Helper for extracting values from JSON *)

     

       273
       +
       let get_param_int json name default =

     

       274
       +
         match json with

     

       275
       +
         | `Assoc fields ->

     

       276
       +
           (match List.assoc_opt name fields with

     

       277
       +
            | Some (`Int i) -> i

     

       278
       +
            | Some (`Float f) -> int_of_float f

     

       279
       +
            | _ -> default)

     

       280
       +
         | _ -> default

     

       281
       +
       

     

       282
       +
       (* Create a server *)

     

       283
       +
       let server = create_server 

     

       284
       +
         ~name:"OCaml MCP Image Generator" 

     

       285
       +
         ~version:"0.1.0" 

     

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

     

       287
       +
         ()

     

       288
       +
       

     

       289
       +
       (* Define startup and shutdown hooks *)

     

       290
       +
       let startup () =

     

       291
       +
         Printf.fprintf stderr "ImageGeneratorServer is starting up!\n";

     

       292
       +
         flush stderr;

     

       293
       +
         Log.info "ImageGeneratorServer is starting up!"

     

       294
       +
       

     

       295
       +
       let shutdown () =

     

       296
       +
         Printf.fprintf stderr "ImageGeneratorServer is shutting down. Goodbye!\n";

     

       297
       +
         flush stderr;

     

       298
       +
         Log.info "ImageGeneratorServer is shutting down. Goodbye!"

     

       299
       +
       

     

       300
       +
       (* Register the hooks *)

     

       301
       +
       let () =

     

       302
       +
         set_startup_hook server startup;

     

       303
       +
         set_shutdown_hook server shutdown

     

       304
       +
       

     

       305
       +
       (* Make an image content helper *)

     

       306
       +
       let make_image_content data mime_type =

     

       307
       +
         let image_content = ImageContent.{

     

       308
       +
           data;

     

       309
       +
           mime_type;

     

       310
       +
           annotations = None;

     

       311
       +
         } in

     

       312
       +
         Image image_content

     

       313
       +
       

     

       314
       +
       (* Define and register a random pixel art generator tool *)

     

       315
       +
       let _ = add_tool server

     

       316
       +
         ~name:"generate_random_pixel_art"

     

       317
       +
         ~description:"Generates a random pixel art image"

     

       318
       +
         ~schema_properties:[

     

       319
       +
           ("width", "integer", "Width of the pixel art grid (default: 16)");

     

       320
       +
           ("height", "integer", "Height of the pixel art grid (default: 16)");

     

       321
       +
           ("pixel_size", "integer", "Size of each pixel (default: 8)");

     

       322
       +
           ("seed", "integer", "Random seed (optional)");

     

       323
       +
         ]

     

       324
       +
         ~schema_required:[]

     

       325
       +
         (fun args ->

     

       326
       +
           try

     

       327
       +
             let width = get_param_int args "width" 16 in

     

       328
       +
             let height = get_param_int args "height" 16 in

     

       329
       +
             let pixel_size = get_param_int args "pixel_size" 8 in

     

       330
       +
             

     

       331
       +
             (* Validate parameters *)

     

       332
       +
             let width = max 1 (min 64 width) in  (* Limit to 1-64 *)

     

       333
       +
             let height = max 1 (min 64 height) in  (* Limit to 1-64 *)

     

       334
       +
             let pixel_size = max 1 (min 16 pixel_size) in  (* Limit to 1-16 *)

     

       335
       +
             

     

       336
       +
             (* Extract optional seed *)

     

       337
       +
             let seed = match args with

     

       338
       +
               | `Assoc fields ->

     

       339
       +
                 (match List.assoc_opt "seed" fields with

     

       340
       +
                  | Some (`Int s) -> Some s

     

       341
       +
                  | _ -> None)

     

       342
       +
               | _ -> None

     

       343
       +
             in

     

       344
       +
             

     

       345
       +
             (* Generate the image *)

     

       346
       +
             let image_data = ImageGenerator.generate_random_image 

     

       347
       +
               ~width ~height ~pixel_size ~seed () in

     

       348
       +
             

     

       349
       +
             (* Encode as base64 *)

     

       350
       +
             let base64_data = Base64.encode image_data in

     

       351
       +
             

     

       352
       +
             Log.info (Printf.sprintf "Generated random pixel art image (%dx%d grid, %dpx pixels)" 

     

       353
       +
                        width height pixel_size);

     

       354
       +
             

     

       355
       +
             (* Create a response with both text and image content *)

     

       356
       +
             CallToolResult.yojson_of_t CallToolResult.{

     

       357
       +
               content = [

     

       358
       +
                 Text TextContent.{ 

     

       359
       +
                   text = Printf.sprintf "Generated random pixel art image (%dx%d grid, %dpx pixels)" 

     

       360
       +
                           width height pixel_size;

     

       361
       +
                   annotations = None 

     

       362
       +
                 };

     

       363
       +
                 Image ImageContent.{ 

     

       364
       +
                   data = base64_data; 

     

       365
       +
                   mime_type = "image/png"; 

     

       366
       +
                   annotations = None 

     

       367
       +
                 }

     

       368
       +
               ];

     

       369
       +
               is_error = false;

     

       370
       +
               meta = None

     

       371
       +
             }

     

       372
       +
           with

     

       373
       +
           | Failure msg ->

     

       374
       +
             Log.error (Printf.sprintf "Error in image generator tool: %s" msg);

     

       375
       +
             CallToolResult.yojson_of_t CallToolResult.{

     

       376
       +
               content = [

     

       377
       +
                 Text TextContent.{ 

     

       378
       +
                   text = Printf.sprintf "Error: %s" msg; 

     

       379
       +
                   annotations = None 

     

       380
       +
                 }

     

       381
       +
               ];

     

       382
       +
               is_error = true;

     

       383
       +
               meta = None

     

       384
       +
             }

     

       385
       +
         )

     

       386
       +
       

     

       387
       +
       (* Define and register a pixel art prompt *)

     

       388
       +
       let _ = add_prompt server

     

       389
       +
         ~name:"pixel-art-prompt"

     

       390
       +
         ~description:"A prompt that includes a random pixel art image"

     

       391
       +
         ~arguments:[

     

       392
       +
           ("width", Some "Width of the pixel art (1-64)", false);

     

       393
       +
           ("height", Some "Height of the pixel art (1-64)", false);

     

       394
       +
           ("pixel_size", Some "Size of each pixel (1-16)", false);

     

       395
       +
         ]

     

       396
       +
         (fun args ->

     

       397
       +
           (* Parse parameters with defaults *)

     

       398
       +
           let width = 

     

       399
       +
             try int_of_string (List.assoc "width" args)

     

       400
       +
             with _ -> 16

     

       401
       +
           in

     

       402
       +
           let height = 

     

       403
       +
             try int_of_string (List.assoc "height" args)

     

       404
       +
             with _ -> 16

     

       405
       +
           in

     

       406
       +
           let pixel_size = 

     

       407
       +
             try int_of_string (List.assoc "pixel_size" args)

     

       408
       +
             with _ -> 8

     

       409
       +
           in

     

       410
       +
           

     

       411
       +
           (* Validate parameters *)

     

       412
       +
           let width = max 1 (min 64 width) in

     

       413
       +
           let height = max 1 (min 64 height) in

     

       414
       +
           let pixel_size = max 1 (min 16 pixel_size) in

     

       415
       +
           

     

       416
       +
           (* Generate image *)

     

       417
       +
           let image_data = ImageGenerator.generate_random_image 

     

       418
       +
             ~width ~height ~pixel_size () in

     

       419
       +
           

     

       420
       +
           (* Encode as base64 *)

     

       421
       +
           let base64_data = Base64.encode image_data in

     

       422
       +
           

     

       423
       +
           Log.info (Printf.sprintf "Generated pixel art for prompt (%dx%d grid, %dpx pixels)" 

     

       424
       +
                      width height pixel_size);

     

       425
       +
           

     

       426
       +
           [

     

       427
       +
             Prompt.{ 

     

       428
       +
               role = `User; 

     

       429
       +
               content = make_text_content "I've generated a random pixel art image for you:"

     

       430
       +
             };

     

       431
       +
             Prompt.{ 

     

       432
       +
               role = `User;

     

       433
       +
               content = make_image_content base64_data "image/png" 

     

       434
       +
             };

     

       435
       +
             Prompt.{ 

     

       436
       +
               role = `User; 

     

       437
       +
               content = make_text_content (Printf.sprintf "Please describe what you see in this %dx%d pixel art."

     

       438
       +
                                            width height)

     

       439
       +
             };

     

       440
       +
             Prompt.{ 

     

       441
       +
               role = `Assistant; 

     

       442
       +
               content = make_text_content "I'll describe what I see in this pixel art image."

     

       443
       +
             }

     

       444
       +
           ]

     

       445
       +
         )

     

       446
       +
       

     

       447
       +
       (* Main function *)

     

       448
       +
       let () =

     

       449
       +
         (* Parse command line arguments *)

     

       450
       +
         let transport_type = ref Stdio in

     

       451
       +
         let args = [

     

       452
       +
           ("--http", Arg.Unit (fun () -> transport_type := Http), 

     

       453
       +
            "Start server with HTTP transport (default is stdio)");

     

       454
       +
         ] in

     

       455
       +
         let usage_msg = "Usage: image_generator_example [--http]" in

     

       456
       +
         Arg.parse args (fun _ -> ()) usage_msg;

     

       457
       +
       

     

       458
       +
         (* Use stderr for direct printing to avoid interfering with JSON-RPC protocol *)

     

       459
       +
         Printf.fprintf stderr "Starting ImageGeneratorServer...\n";

     

       460
       +
         flush stderr;

     

       461
       +
         Log.info "Starting ImageGeneratorServer...";

     

       462
       +
         

     

       463
       +
         (* Configure the server with appropriate capabilities *)

     

       464
       +
         ignore (configure_server server ());

     

       465
       +
         

     

       466
       +
         (* Create and start MCP server with the selected transport *)

     

       467
       +
         let mcp_server = create ~server ~transport:!transport_type () in

     

       468
       +
         start mcp_server

+502

bin/multimodal_example.ml

···

       1
       +
       open Mcp

     

       2
       +
       open Mcp_sdk

     

       3
       +
       open Mcp_server

     

       4
       +
       

     

       5
       +
       (* Multimodal example MCP server *)

     

       6
       +
       

     

       7
       +
       (* Base64 encoding helper *)

     

       8
       +
       module Base64 = struct

     

       9
       +
         let encode_char n =

     

       10
       +
           "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/".[n]

     

       11
       +
           

     

       12
       +
         let encode_block i bytes =

     

       13
       +
           let buffer = Buffer.create 4 in

     

       14
       +
           let b1 = Char.code (String.get bytes (i * 3)) in

     

       15
       +
           let b2 = if i * 3 + 1 < String.length bytes then Char.code (String.get bytes (i * 3 + 1)) else 0 in

     

       16
       +
           let b3 = if i * 3 + 2 < String.length bytes then Char.code (String.get bytes (i * 3 + 2)) else 0 in

     

       17
       +
           

     

       18
       +
           let n = (b1 lsl 16) lor (b2 lsl 8) lor b3 in

     

       19
       +
           Buffer.add_char buffer (encode_char ((n lsr 18) land 63));

     

       20
       +
           Buffer.add_char buffer (encode_char ((n lsr 12) land 63));

     

       21
       +
           

     

       22
       +
           if i * 3 + 1 < String.length bytes then

     

       23
       +
             Buffer.add_char buffer (encode_char ((n lsr 6) land 63))

     

       24
       +
           else

     

       25
       +
             Buffer.add_char buffer '=';

     

       26
       +
             

     

       27
       +
           if i * 3 + 2 < String.length bytes then

     

       28
       +
             Buffer.add_char buffer (encode_char (n land 63))

     

       29
       +
           else

     

       30
       +
             Buffer.add_char buffer '=';

     

       31
       +
           

     

       32
       +
           Buffer.contents buffer

     

       33
       +
           

     

       34
       +
         let encode data =

     

       35
       +
           let buffer = Buffer.create (4 * (String.length data + 2) / 3) in

     

       36
       +
           for i = 0 to (String.length data - 1) / 3 do

     

       37
       +
             Buffer.add_string buffer (encode_block i data)

     

       38
       +
           done;

     

       39
       +
           Buffer.contents buffer

     

       40
       +
       end

     

       41
       +
       

     

       42
       +
       (* Audio generator *)

     

       43
       +
       module AudioGenerator = struct

     

       44
       +
         (* Generate a simple sine wave *)

     

       45
       +
         let generate_sine_wave ~frequency ~duration ~sample_rate ~amplitude =

     

       46
       +
           (* WAV parameters *)

     

       47
       +
           let num_channels = 1 in (* Mono *)

     

       48
       +
           let bits_per_sample = 16 in

     

       49
       +
           let byte_rate = sample_rate * num_channels * bits_per_sample / 8 in

     

       50
       +
           let block_align = num_channels * bits_per_sample / 8 in

     

       51
       +
           let num_samples = int_of_float (float_of_int sample_rate *. duration) in

     

       52
       +
           let data_size = num_samples * block_align in

     

       53
       +
           

     

       54
       +
           (* Create buffer for the WAV data *)

     

       55
       +
           let buffer = Buffer.create (44 + data_size) in

     

       56
       +
           

     

       57
       +
           (* Write WAV header *)

     

       58
       +
           (* "RIFF" chunk *)

     

       59
       +
           Buffer.add_string buffer "RIFF";

     

       60
       +
           let file_size = 36 + data_size in

     

       61
       +
           Buffer.add_char buffer (Char.chr (file_size land 0xff));

     

       62
       +
           Buffer.add_char buffer (Char.chr ((file_size lsr 8) land 0xff));

     

       63
       +
           Buffer.add_char buffer (Char.chr ((file_size lsr 16) land 0xff));

     

       64
       +
           Buffer.add_char buffer (Char.chr ((file_size lsr 24) land 0xff));

     

       65
       +
           Buffer.add_string buffer "WAVE";

     

       66
       +
           

     

       67
       +
           (* "fmt " sub-chunk *)

     

       68
       +
           Buffer.add_string buffer "fmt ";

     

       69
       +
           Buffer.add_char buffer (Char.chr 16); (* Sub-chunk size (16 for PCM) *)

     

       70
       +
           Buffer.add_char buffer (Char.chr 0);

     

       71
       +
           Buffer.add_char buffer (Char.chr 0);

     

       72
       +
           Buffer.add_char buffer (Char.chr 0);

     

       73
       +
           Buffer.add_char buffer (Char.chr 1); (* Audio format (1 for PCM) *)

     

       74
       +
           Buffer.add_char buffer (Char.chr 0);

     

       75
       +
           Buffer.add_char buffer (Char.chr num_channels); (* Number of channels *)

     

       76
       +
           Buffer.add_char buffer (Char.chr 0);

     

       77
       +
           

     

       78
       +
           (* Sample rate *)

     

       79
       +
           Buffer.add_char buffer (Char.chr (sample_rate land 0xff));

     

       80
       +
           Buffer.add_char buffer (Char.chr ((sample_rate lsr 8) land 0xff));

     

       81
       +
           Buffer.add_char buffer (Char.chr ((sample_rate lsr 16) land 0xff));

     

       82
       +
           Buffer.add_char buffer (Char.chr ((sample_rate lsr 24) land 0xff));

     

       83
       +
           

     

       84
       +
           (* Byte rate *)

     

       85
       +
           Buffer.add_char buffer (Char.chr (byte_rate land 0xff));

     

       86
       +
           Buffer.add_char buffer (Char.chr ((byte_rate lsr 8) land 0xff));

     

       87
       +
           Buffer.add_char buffer (Char.chr ((byte_rate lsr 16) land 0xff));

     

       88
       +
           Buffer.add_char buffer (Char.chr ((byte_rate lsr 24) land 0xff));

     

       89
       +
           

     

       90
       +
           (* Block align *)

     

       91
       +
           Buffer.add_char buffer (Char.chr block_align);

     

       92
       +
           Buffer.add_char buffer (Char.chr 0);

     

       93
       +
           

     

       94
       +
           (* Bits per sample *)

     

       95
       +
           Buffer.add_char buffer (Char.chr bits_per_sample);

     

       96
       +
           Buffer.add_char buffer (Char.chr 0);

     

       97
       +
           

     

       98
       +
           (* "data" sub-chunk *)

     

       99
       +
           Buffer.add_string buffer "data";

     

       100
       +
           Buffer.add_char buffer (Char.chr (data_size land 0xff));

     

       101
       +
           Buffer.add_char buffer (Char.chr ((data_size lsr 8) land 0xff));

     

       102
       +
           Buffer.add_char buffer (Char.chr ((data_size lsr 16) land 0xff));

     

       103
       +
           Buffer.add_char buffer (Char.chr ((data_size lsr 24) land 0xff));

     

       104
       +
           

     

       105
       +
           (* Generate sine wave data *)

     

       106
       +
           let max_amplitude = float_of_int (1 lsl (bits_per_sample - 1)) -. 1.0 in

     

       107
       +
           for i = 0 to num_samples - 1 do

     

       108
       +
             let t = float_of_int i /. float_of_int sample_rate in

     

       109
       +
             let value = int_of_float (amplitude *. max_amplitude *. sin (2.0 *. Float.pi *. frequency *. t)) in

     

       110
       +
             (* Write 16-bit sample (little-endian) *)

     

       111
       +
             Buffer.add_char buffer (Char.chr (value land 0xff));

     

       112
       +
             Buffer.add_char buffer (Char.chr ((value lsr 8) land 0xff));

     

       113
       +
           done;

     

       114
       +
           

     

       115
       +
           Buffer.contents buffer

     

       116
       +
       end

     

       117
       +
       

     

       118
       +
       (* Image generator *)

     

       119
       +
       module ImageGenerator = struct

     

       120
       +
         (* Simple PNG generation *)

     

       121
       +
         let generate_simple_image width height color_str =

     

       122
       +
           (* Parse color - expected format: #RRGGBB or #RRGGBBAA *)

     

       123
       +
           let r, g, b, a = 

     

       124
       +
             try

     

       125
       +
               if String.length color_str >= 7 && color_str.[0] = '#' then

     

       126
       +
                 let r = int_of_string ("0x" ^ String.sub color_str 1 2) in

     

       127
       +
                 let g = int_of_string ("0x" ^ String.sub color_str 3 2) in

     

       128
       +
                 let b = int_of_string ("0x" ^ String.sub color_str 5 2) in

     

       129
       +
                 let a = if String.length color_str >= 9 then

     

       130
       +
                          int_of_string ("0x" ^ String.sub color_str 7 2)

     

       131
       +
                        else 255 in

     

       132
       +
                 (r, g, b, a)

     

       133
       +
               else

     

       134
       +
                 (255, 0, 0, 255)  (* Default to red if invalid *)

     

       135
       +
             with _ -> 

     

       136
       +
               (255, 0, 0, 255)  (* Default to red on parsing error *)

     

       137
       +
           in

     

       138
       +
           

     

       139
       +
           (* Create a very simple 1x1 PNG with the specified color *)

     

       140
       +
           (* PNG signature *)

     

       141
       +
           let signature = [137; 80; 78; 71; 13; 10; 26; 10] in

     

       142
       +
           

     

       143
       +
           (* Create buffer for the PNG data *)

     

       144
       +
           let buffer = Buffer.create 100 in

     

       145
       +
           

     

       146
       +
           (* PNG signature *)

     

       147
       +
           List.iter (fun b -> Buffer.add_char buffer (Char.chr b)) signature;

     

       148
       +
           

     

       149
       +
           (* IHDR chunk *)

     

       150
       +
           Buffer.add_char buffer (Char.chr 0); (* length - 13 bytes *)

     

       151
       +
           Buffer.add_char buffer (Char.chr 0);

     

       152
       +
           Buffer.add_char buffer (Char.chr 0);

     

       153
       +
           Buffer.add_char buffer (Char.chr 13);

     

       154
       +
           

     

       155
       +
           Buffer.add_string buffer "IHDR";

     

       156
       +
           

     

       157
       +
           (* Width *)

     

       158
       +
           Buffer.add_char buffer (Char.chr ((width lsr 24) land 0xff));

     

       159
       +
           Buffer.add_char buffer (Char.chr ((width lsr 16) land 0xff));

     

       160
       +
           Buffer.add_char buffer (Char.chr ((width lsr 8) land 0xff));

     

       161
       +
           Buffer.add_char buffer (Char.chr (width land 0xff));

     

       162
       +
           

     

       163
       +
           (* Height *)

     

       164
       +
           Buffer.add_char buffer (Char.chr ((height lsr 24) land 0xff));

     

       165
       +
           Buffer.add_char buffer (Char.chr ((height lsr 16) land 0xff));

     

       166
       +
           Buffer.add_char buffer (Char.chr ((height lsr 8) land 0xff));

     

       167
       +
           Buffer.add_char buffer (Char.chr (height land 0xff));

     

       168
       +
           

     

       169
       +
           Buffer.add_char buffer (Char.chr 8); (* Bit depth - 8 bits per channel *)

     

       170
       +
           Buffer.add_char buffer (Char.chr 6); (* Color type - RGBA *)

     

       171
       +
           Buffer.add_char buffer (Char.chr 0); (* Compression method - deflate *)

     

       172
       +
           Buffer.add_char buffer (Char.chr 0); (* Filter method - adaptive filtering *)

     

       173
       +
           Buffer.add_char buffer (Char.chr 0); (* Interlace method - no interlace *)

     

       174
       +
           

     

       175
       +
           (* IHDR CRC - precomputed for simplicity *)

     

       176
       +
           Buffer.add_char buffer (Char.chr 0);

     

       177
       +
           Buffer.add_char buffer (Char.chr 0);

     

       178
       +
           Buffer.add_char buffer (Char.chr 0);

     

       179
       +
           Buffer.add_char buffer (Char.chr 0);

     

       180
       +
           

     

       181
       +
           (* IDAT chunk - simplified for example *)

     

       182
       +
           let pixels_per_row = width * 4 in

     

       183
       +
           let data_size = (1 + pixels_per_row) * height in

     

       184
       +
           

     

       185
       +
           Buffer.add_char buffer (Char.chr ((data_size lsr 24) land 0xff));

     

       186
       +
           Buffer.add_char buffer (Char.chr ((data_size lsr 16) land 0xff));

     

       187
       +
           Buffer.add_char buffer (Char.chr ((data_size lsr 8) land 0xff));

     

       188
       +
           Buffer.add_char buffer (Char.chr (data_size land 0xff));

     

       189
       +
           

     

       190
       +
           Buffer.add_string buffer "IDAT";

     

       191
       +
           

     

       192
       +
           (* Simple zlib header *)

     

       193
       +
           Buffer.add_char buffer (Char.chr 0x78);

     

       194
       +
           Buffer.add_char buffer (Char.chr 0x01);

     

       195
       +
           

     

       196
       +
           (* Raw image data *)

     

       197
       +
           for _ = 0 to height - 1 do

     

       198
       +
             Buffer.add_char buffer (Char.chr 0); (* Filter type 0 - None *)

     

       199
       +
             for _ = 0 to width - 1 do

     

       200
       +
               Buffer.add_char buffer (Char.chr r);

     

       201
       +
               Buffer.add_char buffer (Char.chr g);

     

       202
       +
               Buffer.add_char buffer (Char.chr b);

     

       203
       +
               Buffer.add_char buffer (Char.chr a);

     

       204
       +
             done

     

       205
       +
           done;

     

       206
       +
           

     

       207
       +
           (* Dummy Adler32 checksum *)

     

       208
       +
           Buffer.add_char buffer (Char.chr 0);

     

       209
       +
           Buffer.add_char buffer (Char.chr 0);

     

       210
       +
           Buffer.add_char buffer (Char.chr 0);

     

       211
       +
           Buffer.add_char buffer (Char.chr 0);

     

       212
       +
           

     

       213
       +
           (* IDAT CRC - precomputed for simplicity *)

     

       214
       +
           Buffer.add_char buffer (Char.chr 0);

     

       215
       +
           Buffer.add_char buffer (Char.chr 0);

     

       216
       +
           Buffer.add_char buffer (Char.chr 0);

     

       217
       +
           Buffer.add_char buffer (Char.chr 0);

     

       218
       +
           

     

       219
       +
           (* IEND chunk *)

     

       220
       +
           Buffer.add_char buffer (Char.chr 0);

     

       221
       +
           Buffer.add_char buffer (Char.chr 0);

     

       222
       +
           Buffer.add_char buffer (Char.chr 0);

     

       223
       +
           Buffer.add_char buffer (Char.chr 0);

     

       224
       +
           

     

       225
       +
           Buffer.add_string buffer "IEND";

     

       226
       +
           

     

       227
       +
           (* IEND CRC - precomputed value *)

     

       228
       +
           Buffer.add_char buffer (Char.chr 0xAE);

     

       229
       +
           Buffer.add_char buffer (Char.chr 0x42);

     

       230
       +
           Buffer.add_char buffer (Char.chr 0x60);

     

       231
       +
           Buffer.add_char buffer (Char.chr 0x82);

     

       232
       +
           

     

       233
       +
           Buffer.contents buffer

     

       234
       +
       end

     

       235
       +
       

     

       236
       +
       (* Helper for extracting values from JSON *)

     

       237
       +
       let get_param_int json name default =

     

       238
       +
         match json with

     

       239
       +
         | `Assoc fields -> begin

     

       240
       +
             match List.assoc_opt name fields with

     

       241
       +
             | Some (`Int i) -> begin

     

       242
       +
                 i

     

       243
       +
               end

     

       244
       +
             | Some (`Float f) -> begin

     

       245
       +
                 int_of_float f

     

       246
       +
               end

     

       247
       +
             | _ -> begin

     

       248
       +
                 default

     

       249
       +
               end

     

       250
       +
           end

     

       251
       +
         | _ -> begin

     

       252
       +
             default

     

       253
       +
           end

     

       254
       +
       

     

       255
       +
       let get_param_float json name default =

     

       256
       +
         match json with

     

       257
       +
         | `Assoc fields -> begin

     

       258
       +
             match List.assoc_opt name fields with

     

       259
       +
             | Some (`Int i) -> begin

     

       260
       +
                 float_of_int i

     

       261
       +
               end

     

       262
       +
             | Some (`Float f) -> begin

     

       263
       +
                 f

     

       264
       +
               end

     

       265
       +
             | _ -> begin

     

       266
       +
                 default

     

       267
       +
               end

     

       268
       +
           end

     

       269
       +
         | _ -> begin

     

       270
       +
             default

     

       271
       +
           end

     

       272
       +
       

     

       273
       +
       let get_param_string json name default =

     

       274
       +
         match json with

     

       275
       +
         | `Assoc fields -> begin

     

       276
       +
             match List.assoc_opt name fields with

     

       277
       +
             | Some (`String s) -> begin

     

       278
       +
                 s

     

       279
       +
               end

     

       280
       +
             | _ -> begin

     

       281
       +
                 default

     

       282
       +
               end

     

       283
       +
           end

     

       284
       +
         | _ -> begin

     

       285
       +
             default

     

       286
       +
           end

     

       287
       +
       

     

       288
       +
       (* Create a server *)

     

       289
       +
       let server = create_server 

     

       290
       +
         ~name:"OCaml MCP Multimodal Example" 

     

       291
       +
         ~version:"0.1.0" 

     

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

     

       293
       +
         ()

     

       294
       +
       

     

       295
       +
       (* Define startup and shutdown hooks *)

     

       296
       +
       let startup () =

     

       297
       +
         Printf.fprintf stderr "MultimodalServer is starting up!\n";

     

       298
       +
         flush stderr;

     

       299
       +
         Log.info "MultimodalServer is starting up!"

     

       300
       +
       

     

       301
       +
       let shutdown () =

     

       302
       +
         Printf.fprintf stderr "MultimodalServer is shutting down. Goodbye!\n";

     

       303
       +
         flush stderr;

     

       304
       +
         Log.info "MultimodalServer is shutting down. Goodbye!"

     

       305
       +
       

     

       306
       +
       (* Register the hooks *)

     

       307
       +
       let () =

     

       308
       +
         set_startup_hook server startup;

     

       309
       +
         set_shutdown_hook server shutdown

     

       310
       +
       

     

       311
       +
       (* Define and register a multimodal tool *)

     

       312
       +
       let _ = add_tool server

     

       313
       +
         ~name:"generate_multimodal_response"

     

       314
       +
         ~description:"Generates a response with text, image and audio content"

     

       315
       +
         ~schema_properties:[

     

       316
       +
           ("message", "string", "The text message to include");

     

       317
       +
           ("color", "string", "Color for the image (hex format #RRGGBB)");

     

       318
       +
           ("frequency", "integer", "Frequency for the audio tone in Hz");

     

       319
       +
         ]

     

       320
       +
         ~schema_required:["message"]

     

       321
       +
         (fun args ->

     

       322
       +
           try

     

       323
       +
             let message = get_param_string args "message" "Hello, multimodal world!" in

     

       324
       +
             let color = get_param_string args "color" "#FF0000" in

     

       325
       +
             let frequency = get_param_int args "frequency" 440 in

     

       326
       +
             

     

       327
       +
             (* Generate image *)

     

       328
       +
             let image_data = ImageGenerator.generate_simple_image 100 100 color in

     

       329
       +
             let image_base64 = Base64.encode image_data in

     

       330
       +
             

     

       331
       +
             (* Generate audio *)

     

       332
       +
             let audio_data = AudioGenerator.generate_sine_wave 

     

       333
       +
               ~frequency:(float_of_int frequency) 

     

       334
       +
               ~duration:1.0 

     

       335
       +
               ~sample_rate:8000 

     

       336
       +
               ~amplitude:0.8 in

     

       337
       +
             let audio_base64 = Base64.encode audio_data in

     

       338
       +
             

     

       339
       +
             (* Create a response with text, image and audio content *)

     

       340
       +
             CallToolResult.yojson_of_t CallToolResult.{

     

       341
       +
               content = [

     

       342
       +
                 Text TextContent.{ 

     

       343
       +
                   text = message;

     

       344
       +
                   annotations = None 

     

       345
       +
                 };

     

       346
       +
                 Image ImageContent.{ 

     

       347
       +
                   data = image_base64; 

     

       348
       +
                   mime_type = "image/png"; 

     

       349
       +
                   annotations = None 

     

       350
       +
                 };

     

       351
       +
                 Audio AudioContent.{ 

     

       352
       +
                   data = audio_base64; 

     

       353
       +
                   mime_type = "audio/wav"; 

     

       354
       +
                   annotations = None 

     

       355
       +
                 }

     

       356
       +
               ];

     

       357
       +
               is_error = false;

     

       358
       +
               meta = None

     

       359
       +
             }

     

       360
       +
           with

     

       361
       +
           | Failure msg ->

     

       362
       +
             Log.error (Printf.sprintf "Error in multimodal tool: %s" msg);

     

       363
       +
             CallToolResult.yojson_of_t CallToolResult.{

     

       364
       +
               content = [

     

       365
       +
                 Text TextContent.{ 

     

       366
       +
                   text = Printf.sprintf "Error: %s" msg; 

     

       367
       +
                   annotations = None 

     

       368
       +
                 }

     

       369
       +
               ];

     

       370
       +
               is_error = true;

     

       371
       +
               meta = None

     

       372
       +
             }

     

       373
       +
         )

     

       374
       +
       

     

       375
       +
       (* Define and register a multimodal prompt *)

     

       376
       +
       let _ = add_prompt server

     

       377
       +
         ~name:"multimodal-prompt"

     

       378
       +
         ~description:"A prompt that includes text, image, and audio"

     

       379
       +
         ~arguments:[

     

       380
       +
           ("message", Some "Text message to include", true);

     

       381
       +
           ("color", Some "Color for the image (hex format #RRGGBB)", false);

     

       382
       +
           ("frequency", Some "Frequency for the audio tone in Hz", false);

     

       383
       +
         ]

     

       384
       +
         (fun args ->

     

       385
       +
           (* Parse parameters with defaults *)

     

       386
       +
           let message = 

     

       387
       +
             try List.assoc "message" args

     

       388
       +
             with Not_found -> "Hello, multimodal world!"

     

       389
       +
           in

     

       390
       +
           

     

       391
       +
           let color = 

     

       392
       +
             try List.assoc "color" args

     

       393
       +
             with Not_found -> "#0000FF"

     

       394
       +
           in

     

       395
       +
           

     

       396
       +
           let frequency = 

     

       397
       +
             try int_of_string (List.assoc "frequency" args)

     

       398
       +
             with _ -> 440

     

       399
       +
           in

     

       400
       +
           

     

       401
       +
           (* Generate image *)

     

       402
       +
           let image_data = ImageGenerator.generate_simple_image 100 100 color in

     

       403
       +
           let image_base64 = Base64.encode image_data in

     

       404
       +
           

     

       405
       +
           (* Generate audio *)

     

       406
       +
           let audio_data = AudioGenerator.generate_sine_wave 

     

       407
       +
             ~frequency:(float_of_int frequency) 

     

       408
       +
             ~duration:1.0 

     

       409
       +
             ~sample_rate:8000 

     

       410
       +
             ~amplitude:0.8 in

     

       411
       +
           let audio_base64 = Base64.encode audio_data in

     

       412
       +
           

     

       413
       +
           (* Create a multimodal prompt *)

     

       414
       +
           [

     

       415
       +
             Prompt.{ 

     

       416
       +
               role = `User; 

     

       417
       +
               content = make_text_content "Here's a multimodal message with text, image, and audio:"

     

       418
       +
             };

     

       419
       +
             Prompt.{ 

     

       420
       +
               role = `User; 

     

       421
       +
               content = make_text_content message

     

       422
       +
             };

     

       423
       +
             Prompt.{ 

     

       424
       +
               role = `User;

     

       425
       +
               content = make_image_content image_base64 "image/png"

     

       426
       +
             };

     

       427
       +
             Prompt.{ 

     

       428
       +
               role = `User;

     

       429
       +
               content = make_audio_content audio_base64 "audio/wav"

     

       430
       +
             };

     

       431
       +
             Prompt.{ 

     

       432
       +
               role = `Assistant; 

     

       433
       +
               content = make_text_content "I've received your multimodal message with text, image, and audio."

     

       434
       +
             }

     

       435
       +
           ]

     

       436
       +
         )

     

       437
       +
       

     

       438
       +
       (* Also register a resource prompt example *)

     

       439
       +
       let _ = add_prompt server

     

       440
       +
         ~name:"resource-prompt"

     

       441
       +
         ~description:"A prompt that includes embedded resources"

     

       442
       +
         ~arguments:[

     

       443
       +
           ("resource_id", Some "ID of the resource to include", true);

     

       444
       +
         ]

     

       445
       +
         (fun args ->

     

       446
       +
           (* Sample resource texts *)

     

       447
       +
           let resources = [

     

       448
       +
             ("doc1", "This is the content of document 1.");

     

       449
       +
             ("doc2", "Document 2 contains important information about OCaml.");

     

       450
       +
             ("doc3", "Document 3 explains the MCP protocol in detail.");

     

       451
       +
           ] in

     

       452
       +
           

     

       453
       +
           (* Get the requested resource *)

     

       454
       +
           let resource_id = 

     

       455
       +
             try List.assoc "resource_id" args

     

       456
       +
             with Not_found -> "doc1"

     

       457
       +
           in

     

       458
       +
           

     

       459
       +
           (* Find the resource content *)

     

       460
       +
           let resource_content = 

     

       461
       +
             try List.assoc resource_id resources

     

       462
       +
             with Not_found -> Printf.sprintf "Resource '%s' not found" resource_id

     

       463
       +
           in

     

       464
       +
           

     

       465
       +
           (* Create a prompt with embedded resource *)

     

       466
       +
           [

     

       467
       +
             Prompt.{ 

     

       468
       +
               role = `User; 

     

       469
       +
               content = make_text_content (Printf.sprintf "Here's the content of resource %s:" resource_id)

     

       470
       +
             };

     

       471
       +
             Prompt.{ 

     

       472
       +
               role = `User;

     

       473
       +
               content = make_text_resource_content (Printf.sprintf "resource://%s" resource_id) resource_content ~mime_type:"text/plain" ()

     

       474
       +
             };

     

       475
       +
             Prompt.{ 

     

       476
       +
               role = `User; 

     

       477
       +
               content = make_text_content "Please analyze this content."

     

       478
       +
             };

     

       479
       +
             Prompt.{ 

     

       480
       +
               role = `Assistant; 

     

       481
       +
               content = make_text_content "I'll analyze the resource content for you."

     

       482
       +
             }

     

       483
       +
           ]

     

       484
       +
         )

     

       485
       +
       

     

       486
       +
       (* Main function *)

     

       487
       +
       let () =

     

       488
       +
         (* Parse command line arguments *)

     

       489
       +
         let transport_type = ref Stdio in

     

       490
       +
         let args = [

     

       491
       +
           ("--http", Arg.Unit (fun () -> transport_type := Http), 

     

       492
       +
            "Start server with HTTP transport (default is stdio)");

     

       493
       +
         ] in

     

       494
       +
         let usage_msg = "Usage: multimodal_example [--http]" in

     

       495
       +
         Arg.parse args (fun _ -> ()) usage_msg;

     

       496
       +
       

     

       497
       +
         (* Configure the server with appropriate capabilities *)

     

       498
       +
         let server = configure_server server ~with_tools:true ~with_resources:false ~with_prompts:true () in

     

       499
       +
         

     

       500
       +
         (* Create and start MCP server with the selected transport *)

     

       501
       +
         let mcp_server = create ~server ~transport:!transport_type () in

     

       502
       +
         start mcp_server;

-370

bin/multimodal_sdk.ml

···

       1
       -
       open Mcp_sdk

     

       2
       -
       

     

       3
       -
       (* Helper for extracting string value from JSON *)

     

       4
       -
       let get_string_param json name =

     

       5
       -
         match json with

     

       6
       -
         | `Assoc fields ->

     

       7
       -
           (match List.assoc_opt name fields with

     

       8
       -
           | Some (`String value) -> value

     

       9
       -
           | _ -> raise (Failure (Printf.sprintf "Missing or invalid parameter: %s" name)))

     

       10
       -
         | _ -> raise (Failure "Expected JSON object")

     

       11
       -
       

     

       12
       -
       (* Helper for extracting integer value from JSON *)

     

       13
       -
       let get_int_param json name =

     

       14
       -
         match json with

     

       15
       -
         | `Assoc fields ->

     

       16
       -
           (match List.assoc_opt name fields with

     

       17
       -
           | Some (`Int value) -> value

     

       18
       -
           | Some (`String value) -> int_of_string value

     

       19
       -
           | _ -> raise (Failure (Printf.sprintf "Missing or invalid parameter: %s" name)))

     

       20
       -
         | _ -> raise (Failure "Expected JSON object")

     

       21
       -
       

     

       22
       -
       (* Base64 encoding - simplified version *)

     

       23
       -
       module Base64 = struct

     

       24
       -
         let encode_char idx =

     

       25
       -
           "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/".[idx]

     

       26
       -
         

     

       27
       -
         let encode s =

     

       28
       -
           let len = String.length s in

     

       29
       -
           let result = Bytes.create (((len + 2) / 3) * 4) in

     

       30
       -
           

     

       31
       -
           let rec loop i j =

     

       32
       -
             if i >= len then j

     

       33
       -
             else

     

       34
       -
               let n =

     

       35
       -
                 let n = Char.code s.[i] lsl 16 in

     

       36
       -
                 let n = if i + 1 < len then n lor (Char.code s.[i+1] lsl 8) else n in

     

       37
       -
                 if i + 2 < len then n lor Char.code s.[i+2] else n

     

       38
       -
               in

     

       39
       -
               Bytes.set result j (encode_char ((n lsr 18) land 63));

     

       40
       -
               Bytes.set result (j+1) (encode_char ((n lsr 12) land 63));

     

       41
       -
               Bytes.set result (j+2) 

     

       42
       -
                 (if i + 1 < len then encode_char ((n lsr 6) land 63) else '=');

     

       43
       -
               Bytes.set result (j+3) 

     

       44
       -
                 (if i + 2 < len then encode_char (n land 63) else '=');

     

       45
       -
               loop (i + 3) (j + 4)

     

       46
       -
           in

     

       47
       -
           Bytes.sub_string result 0 (loop 0 0)

     

       48
       -
       end

     

       49
       -
       

     

       50
       -
       (* Generate a simple GIF format image *)

     

       51
       -
       let generate_random_image width height =

     

       52
       -
         (* Ensure dimensions are reasonable *)

     

       53
       -
         let width = min 256 (max 16 width) in  

     

       54
       -
         let height = min 256 (max 16 height) in

     

       55
       -
         

     

       56
       -
         (* Create a buffer for GIF data *)

     

       57
       -
         let buf = Buffer.create 1024 in

     

       58
       -
         

     

       59
       -
         (* GIF Header - "GIF89a" *)

     

       60
       -
         Buffer.add_string buf "GIF89a";

     

       61
       -
         

     

       62
       -
         (* Logical Screen Descriptor *)

     

       63
       -
         (* Width - 2 bytes little endian *)

     

       64
       -
         Buffer.add_char buf (Char.chr (width land 0xff));

     

       65
       -
         Buffer.add_char buf (Char.chr ((width lsr 8) land 0xff));

     

       66
       -
         

     

       67
       -
         (* Height - 2 bytes little endian *)

     

       68
       -
         Buffer.add_char buf (Char.chr (height land 0xff));

     

       69
       -
         Buffer.add_char buf (Char.chr ((height lsr 8) land 0xff));

     

       70
       -
         

     

       71
       -
         (* Packed fields - 1 byte:

     

       72
       -
            Global Color Table Flag - 1 bit (1)

     

       73
       -
            Color Resolution - 3 bits (7 = 8 bits per color)

     

       74
       -
            Sort Flag - 1 bit (0)

     

       75
       -
            Size of Global Color Table - 3 bits (2 = 8 colors) *)

     

       76
       -
         Buffer.add_char buf (Char.chr 0xF2);

     

       77
       -
         

     

       78
       -
         (* Background color index - 1 byte *)

     

       79
       -
         Buffer.add_char buf (Char.chr 0);

     

       80
       -
         

     

       81
       -
         (* Pixel aspect ratio - 1 byte *)

     

       82
       -
         Buffer.add_char buf (Char.chr 0);

     

       83
       -
         

     

       84
       -
         (* Global Color Table - 8 colors x 3 bytes (R,G,B) *)

     

       85
       -
         (* Simple 8-color palette *)

     

       86
       -
         Buffer.add_string buf "\xFF\xFF\xFF"; (* White (0) *)

     

       87
       -
         Buffer.add_string buf "\xFF\x00\x00"; (* Red (1) *)

     

       88
       -
         Buffer.add_string buf "\x00\xFF\x00"; (* Green (2) *)

     

       89
       -
         Buffer.add_string buf "\x00\x00\xFF"; (* Blue (3) *)

     

       90
       -
         Buffer.add_string buf "\xFF\xFF\x00"; (* Yellow (4) *)

     

       91
       -
         Buffer.add_string buf "\xFF\x00\xFF"; (* Magenta (5) *)

     

       92
       -
         Buffer.add_string buf "\x00\xFF\xFF"; (* Cyan (6) *)

     

       93
       -
         Buffer.add_string buf "\x00\x00\x00"; (* Black (7) *)

     

       94
       -
         

     

       95
       -
         (* Graphics Control Extension (optional) *)

     

       96
       -
         Buffer.add_char buf (Char.chr 0x21); (* Extension Introducer *)

     

       97
       -
         Buffer.add_char buf (Char.chr 0xF9); (* Graphic Control Label *)

     

       98
       -
         Buffer.add_char buf (Char.chr 0x04); (* Block Size *)

     

       99
       -
         Buffer.add_char buf (Char.chr 0x01); (* Packed field: 1 bit for transparency *)

     

       100
       -
         Buffer.add_char buf (Char.chr 0x00); (* Delay time (1/100s) - 2 bytes *)

     

       101
       -
         Buffer.add_char buf (Char.chr 0x00);

     

       102
       -
         Buffer.add_char buf (Char.chr 0x00); (* Transparent color index *)

     

       103
       -
         Buffer.add_char buf (Char.chr 0x00); (* Block terminator *)

     

       104
       -
         

     

       105
       -
         (* Image Descriptor *)

     

       106
       -
         Buffer.add_char buf (Char.chr 0x2C); (* Image Separator *)

     

       107
       -
         Buffer.add_char buf (Char.chr 0x00); (* Left position - 2 bytes *)

     

       108
       -
         Buffer.add_char buf (Char.chr 0x00);

     

       109
       -
         Buffer.add_char buf (Char.chr 0x00); (* Top position - 2 bytes *)

     

       110
       -
         Buffer.add_char buf (Char.chr 0x00);

     

       111
       -
         

     

       112
       -
         (* Image width - 2 bytes little endian *)

     

       113
       -
         Buffer.add_char buf (Char.chr (width land 0xff));

     

       114
       -
         Buffer.add_char buf (Char.chr ((width lsr 8) land 0xff));

     

       115
       -
         

     

       116
       -
         (* Image height - 2 bytes little endian *)

     

       117
       -
         Buffer.add_char buf (Char.chr (height land 0xff));

     

       118
       -
         Buffer.add_char buf (Char.chr ((height lsr 8) land 0xff));

     

       119
       -
         

     

       120
       -
         (* Packed fields - 1 byte - no local color table *)

     

       121
       -
         Buffer.add_char buf (Char.chr 0x00);

     

       122
       -
         

     

       123
       -
         (* LZW Minimum Code Size - 1 byte *)

     

       124
       -
         Buffer.add_char buf (Char.chr 0x03); (* Minimum code size 3 for 8 colors *)

     

       125
       -
         

     

       126
       -
         (* Generate a simple image - a checkerboard pattern *)

     

       127
       -
         let step = width / 8 in

     

       128
       -
         let image_data = Buffer.create (width * height / 4) in

     

       129
       -
         

     

       130
       -
         (* Very simple LZW compression - just store raw clear codes and color indexes *)

     

       131
       -
         (* Start with Clear code *)

     

       132
       -
         Buffer.add_char image_data (Char.chr 0x08); (* Clear code 8 *)

     

       133
       -
         

     

       134
       -
         (* For very simple encoding, we'll just use a sequence of color indexes *)

     

       135
       -
         for y = 0 to height - 1 do

     

       136
       -
           for x = 0 to width - 1 do

     

       137
       -
             (* Checkerboard pattern with different colors *)

     

       138
       -
             let color =

     

       139
       -
               if ((x / step) + (y / step)) mod 2 = 0 then

     

       140
       -
                 3  (* Blue *)

     

       141
       -
               else

     

       142
       -
                 1  (* Red *)

     

       143
       -
             in

     

       144
       -
             Buffer.add_char image_data (Char.chr color);

     

       145
       -
           done

     

       146
       -
         done;

     

       147
       -
         

     

       148
       -
         (* End with End of Information code *)

     

       149
       -
         Buffer.add_char image_data (Char.chr 0x09);

     

       150
       -
         

     

       151
       -
         (* Add image data blocks - GIF uses 255-byte max chunks *)

     

       152
       -
         let data = Buffer.contents image_data in

     

       153
       -
         let data_len = String.length data in

     

       154
       -
         let pos = ref 0 in

     

       155
       -
         

     

       156
       -
         while !pos < data_len do

     

       157
       -
           let chunk_size = min 255 (data_len - !pos) in

     

       158
       -
           Buffer.add_char buf (Char.chr chunk_size);

     

       159
       -
           for i = 0 to chunk_size - 1 do

     

       160
       -
             Buffer.add_char buf (String.get data (!pos + i));

     

       161
       -
           done;

     

       162
       -
           pos := !pos + chunk_size;

     

       163
       -
         done;

     

       164
       -
         

     

       165
       -
         (* Zero-length block to end the image data *)

     

       166
       -
         Buffer.add_char buf (Char.chr 0x00);

     

       167
       -
         

     

       168
       -
         (* GIF Trailer *)

     

       169
       -
         Buffer.add_char buf (Char.chr 0x3B);

     

       170
       -
         

     

       171
       -
         (* Base64 encode the GIF data *)

     

       172
       -
         Base64.encode (Buffer.contents buf)

     

       173
       -
       

     

       174
       -
       (* Helper to write 32-bit little endian integer *)

     

       175
       -
       let write_int32_le buf n =

     

       176
       -
         Buffer.add_char buf (Char.chr (n land 0xff));

     

       177
       -
         Buffer.add_char buf (Char.chr ((n lsr 8) land 0xff));

     

       178
       -
         Buffer.add_char buf (Char.chr ((n lsr 16) land 0xff));

     

       179
       -
         Buffer.add_char buf (Char.chr ((n lsr 24) land 0xff))

     

       180
       -
       

     

       181
       -
       (* Helper to write 16-bit little endian integer *)

     

       182
       -
       let write_int16_le buf n =

     

       183
       -
         Buffer.add_char buf (Char.chr (n land 0xff));

     

       184
       -
         Buffer.add_char buf (Char.chr ((n lsr 8) land 0xff))

     

       185
       -
       

     

       186
       -
       (* Generate a simple WAV file with sine wave *)

     

       187
       -
       let generate_sine_wave_audio frequency duration =

     

       188
       -
         (* WAV header *)

     

       189
       -
         let sample_rate = 8000 in

     

       190
       -
         let num_samples = sample_rate * duration in

     

       191
       -
         let header_buf = Buffer.create 44 in

     

       192
       -
         

     

       193
       -
         (* Fill WAV header properly *)

     

       194
       -
         Buffer.add_string header_buf "RIFF";

     

       195
       -
         write_int32_le header_buf (36 + num_samples * 2); (* File size minus 8 *)

     

       196
       -
         Buffer.add_string header_buf "WAVE";

     

       197
       -
         

     

       198
       -
         (* Format chunk *)

     

       199
       -
         Buffer.add_string header_buf "fmt ";

     

       200
       -
         write_int32_le header_buf 16; (* Format chunk size *)

     

       201
       -
         write_int16_le header_buf 1;  (* PCM format *)

     

       202
       -
         write_int16_le header_buf 1;  (* Mono *)

     

       203
       -
         write_int32_le header_buf sample_rate; (* Sample rate *)

     

       204
       -
         write_int32_le header_buf (sample_rate * 2); (* Byte rate *)

     

       205
       -
         write_int16_le header_buf 2;  (* Block align *)

     

       206
       -
         write_int16_le header_buf 16; (* Bits per sample *)

     

       207
       -
         

     

       208
       -
         (* Data chunk *)

     

       209
       -
         Buffer.add_string header_buf "data";

     

       210
       -
         write_int32_le header_buf (num_samples * 2); (* Data size *)

     

       211
       -
         

     

       212
       -
         (* Generate sine wave samples *)

     

       213
       -
         let samples_buf = Buffer.create (num_samples * 2) in

     

       214
       -
         let amplitude = 16384.0 in (* 16-bit with headroom *)

     

       215
       -
         

     

       216
       -
         for i = 0 to num_samples - 1 do

     

       217
       -
           let t = float_of_int i /. float_of_int sample_rate in

     

       218
       -
           let value = amplitude *. sin (2.0 *. Float.pi *. frequency *. t) in

     

       219
       -
           let sample = int_of_float value in

     

       220
       -
           

     

       221
       -
           (* Convert to 16-bit little-endian *)

     

       222
       -
           let sample = if sample < 0 then sample + 65536 else sample in

     

       223
       -
           write_int16_le samples_buf sample;

     

       224
       -
         done;

     

       225
       -
         

     

       226
       -
         (* Combine header and samples, then encode as Base64 *)

     

       227
       -
         let wav_data = Buffer.contents header_buf ^ Buffer.contents samples_buf in

     

       228
       -
         Base64.encode wav_data

     

       229
       -
       

     

       230
       -
       (* Create a server *)

     

       231
       -
       let server = create_server 

     

       232
       -
         ~name:"OCaml MCP Multimodal Example" 

     

       233
       -
         ~version:"0.1.0" 

     

       234
       -
         ~protocol_version:"2024-11-05" () |>

     

       235
       -
         fun server ->

     

       236
       -
           (* Set default capabilities *)

     

       237
       -
           configure_server server ~with_tools:true ~with_resources:true ~with_prompts:true ()

     

       238
       -
       

     

       239
       -
       (* Define and register a multimodal tool that returns text, images, and audio *)

     

       240
       -
       let _ = add_tool server

     

       241
       -
         ~name:"multimodal_demo"

     

       242
       -
         ~description:"Demonstrates multimodal content with text, image, and audio"

     

       243
       -
         ~schema_properties:[

     

       244
       -
           ("width", "integer", "Width of the generated image (pixels)");

     

       245
       -
           ("height", "integer", "Height of the generated image (pixels)");

     

       246
       -
           ("frequency", "integer", "Frequency of the generated audio tone (Hz)");

     

       247
       -
           ("duration", "integer", "Duration of the generated audio (seconds)");

     

       248
       -
           ("message", "string", "Text message to include")

     

       249
       -
         ]

     

       250
       -
         ~schema_required:["message"]

     

       251
       -
         (fun args ->

     

       252
       -
           try

     

       253
       -
             (* Extract parameters with defaults if not provided *)

     

       254
       -
             let message = get_string_param args "message" in

     

       255
       -
             let width = try get_int_param args "width" with _ -> 128 in

     

       256
       -
             let height = try get_int_param args "height" with _ -> 128 in

     

       257
       -
             let frequency = try get_int_param args "frequency" with _ -> 440 in

     

       258
       -
             let duration = try get_int_param args "duration" with _ -> 1 in

     

       259
       -
             

     

       260
       -
             (* Generate image and audio data *)

     

       261
       -
             let image_data = generate_random_image width height in

     

       262
       -
             let audio_data = generate_sine_wave_audio (float_of_int frequency) duration in

     

       263
       -
             

     

       264
       -
             (* Create a multimodal tool result *)

     

       265
       -
             Tool.create_tool_result [

     

       266
       -
               Mcp.make_text_content message;

     

       267
       -
               Mcp.make_image_content image_data "image/gif";

     

       268
       -
               Mcp.make_audio_content audio_data "audio/wav"

     

       269
       -
             ] ~is_error:false

     

       270
       -
           with

     

       271
       -
           | Failure msg -> 

     

       272
       -
             Log.errorf "Error in multimodal tool: %s" msg;

     

       273
       -
             Tool.create_tool_result [Mcp.make_text_content (Printf.sprintf "Error: %s" msg)] ~is_error:true

     

       274
       -
         )

     

       275
       -
       

     

       276
       -
       (* Define and register a tool for generating only images *)

     

       277
       -
       let _ = add_tool server

     

       278
       -
         ~name:"generate_image"

     

       279
       -
         ~description:"Generates a random image with specified dimensions"

     

       280
       -
         ~schema_properties:[

     

       281
       -
           ("width", "integer", "Width of the generated image (pixels)");

     

       282
       -
           ("height", "integer", "Height of the generated image (pixels)")

     

       283
       -
         ]

     

       284
       -
         ~schema_required:["width"; "height"]

     

       285
       -
         (fun args ->

     

       286
       -
           try

     

       287
       -
             let width = get_int_param args "width" in

     

       288
       -
             let height = get_int_param args "height" in

     

       289
       -
             

     

       290
       -
             if width < 1 || width > 1024 || height < 1 || height > 1024 then

     

       291
       -
               Tool.create_tool_result 

     

       292
       -
                 [Mcp.make_text_content "Error: Dimensions must be between 1 and 1024 pixels"] 

     

       293
       -
                 ~is_error:true

     

       294
       -
             else

     

       295
       -
               let image_data = generate_random_image width height in

     

       296
       -
               Tool.create_tool_result 

     

       297
       -
                 [Mcp.make_image_content image_data "image/gif"]

     

       298
       -
                 ~is_error:false

     

       299
       -
           with

     

       300
       -
           | Failure msg ->

     

       301
       -
             Log.errorf "Error in generate_image tool: %s" msg;

     

       302
       -
             Tool.create_tool_result [Mcp.make_text_content (Printf.sprintf "Error: %s" msg)] ~is_error:true

     

       303
       -
         )

     

       304
       -
       

     

       305
       -
       (* Define and register a tool for generating only audio *)

     

       306
       -
       let _ = add_tool server

     

       307
       -
         ~name:"generate_audio"

     

       308
       -
         ~description:"Generates an audio tone with specified frequency and duration"

     

       309
       -
         ~schema_properties:[

     

       310
       -
           ("frequency", "integer", "Frequency of the tone in Hz (20-20000)");

     

       311
       -
           ("duration", "integer", "Duration of the tone in seconds (1-10)")

     

       312
       -
         ]

     

       313
       -
         ~schema_required:["frequency"; "duration"]

     

       314
       -
         (fun args ->

     

       315
       -
           try

     

       316
       -
             let frequency = get_int_param args "frequency" in

     

       317
       -
             let duration = get_int_param args "duration" in

     

       318
       -
             

     

       319
       -
             if frequency < 20 || frequency > 20000 then

     

       320
       -
               Tool.create_tool_result 

     

       321
       -
                 [Mcp.make_text_content "Error: Frequency must be between 20Hz and 20,000Hz"] 

     

       322
       -
                 ~is_error:true

     

       323
       -
             else if duration < 1 || duration > 10 then

     

       324
       -
               Tool.create_tool_result 

     

       325
       -
                 [Mcp.make_text_content "Error: Duration must be between 1 and 10 seconds"] 

     

       326
       -
                 ~is_error:true

     

       327
       -
             else

     

       328
       -
               let audio_data = generate_sine_wave_audio (float_of_int frequency) duration in

     

       329
       -
               Tool.create_tool_result 

     

       330
       -
                 [Mcp.make_audio_content audio_data "audio/wav"]

     

       331
       -
                 ~is_error:false

     

       332
       -
           with

     

       333
       -
           | Failure msg ->

     

       334
       -
             Log.errorf "Error in generate_audio tool: %s" msg;

     

       335
       -
             Tool.create_tool_result [Mcp.make_text_content (Printf.sprintf "Error: %s" msg)] ~is_error:true

     

       336
       -
         )

     

       337
       -
       

     

       338
       -
       (* Define and register a resource example with multimodal content *)

     

       339
       -
       let _ = add_resource server

     

       340
       -
         ~uri_template:"multimodal://{name}"

     

       341
       -
         ~description:"Get a multimodal greeting with text, image and audio"

     

       342
       -
         ~mime_type:"application/json"

     

       343
       -
         (fun params ->

     

       344
       -
           match params with

     

       345
       -
           | [name] ->

     

       346
       -
             let greeting = Printf.sprintf "Hello, %s! Welcome to the multimodal MCP example." name in

     

       347
       -
             let image_data = generate_random_image 128 128 in

     

       348
       -
             let audio_data = generate_sine_wave_audio 440.0 1 in

     

       349
       -
             

     

       350
       -
             Printf.sprintf {|

     

       351
       -
               {

     

       352
       -
                 "greeting": "%s",

     

       353
       -
                 "image": {

     

       354
       -
                   "data": "%s",

     

       355
       -
                   "mimeType": "image/gif"

     

       356
       -
                 },

     

       357
       -
                 "audio": {

     

       358
       -
                   "data": "%s",

     

       359
       -
                   "mimeType": "audio/wav"

     

       360
       -
                 }

     

       361
       -
               }

     

       362
       -
             |} greeting image_data audio_data

     

       363
       -
           | _ -> Printf.sprintf {|{"error": "Invalid parameters"}|}

     

       364
       -
         )

     

       365
       -
       

     

       366
       -
       (* Run the server with the default scheduler *)

     

       367
       -
       let () =

     

       368
       -
         Random.self_init();  (* Initialize random generator *)

     

       369
       -
         Eio_main.run @@ fun env ->

     

       370
       -
           Mcp_server.run_server env server

-166

bin/ocaml_eval_sdk.ml

···

       1
       -
       open Mcp_sdk

     

       2
       -
       open Mcp_rpc

     

       3
       -
       

     

       4
       -
       (* Set up the formatter for capturing evaluation output *)

     

       5
       -
       let capture_output f =

     

       6
       -
         let buffer = Buffer.create 1024 in

     

       7
       -
         let fmt = Format.formatter_of_buffer buffer in

     

       8
       -
         let result = f fmt in

     

       9
       -
         Format.pp_print_flush fmt ();

     

       10
       -
         (result, Buffer.contents buffer)

     

       11
       -
       

     

       12
       -
       (* Helper for extracting string value from JSON *)

     

       13
       -
       let get_string_param json name =

     

       14
       -
         match json with

     

       15
       -
         | `Assoc fields ->

     

       16
       -
           (match List.assoc_opt name fields with

     

       17
       -
           | Some (`String value) -> value

     

       18
       -
           | _ -> failwith (Printf.sprintf "Missing or invalid parameter: %s" name))

     

       19
       -
         | _ -> failwith "Expected JSON object"

     

       20
       -
           

     

       21
       -
       (* Initialize the OCaml toploop with standard libraries *)

     

       22
       -
       let initialize_toploop () =

     

       23
       -
         (* Initialize the toplevel environment *)

     

       24
       -
         Toploop.initialize_toplevel_env ();

     

       25
       -
         

     

       26
       -
         (* Set up the toplevel as if using the standard OCaml REPL *)

     

       27
       -
         Clflags.nopervasives := false;

     

       28
       -
         Clflags.real_paths := true;

     

       29
       -
         Clflags.recursive_types := false;

     

       30
       -
         Clflags.strict_sequence := false;

     

       31
       -
         Clflags.applicative_functors := true;

     

       32
       -
         

     

       33
       -
         (* Return success message *)

     

       34
       -
         "OCaml evaluation environment initialized"

     

       35
       -
       

     

       36
       -
       (* Evaluate an OCaml toplevel phrase *)

     

       37
       -
       let evaluate_phrase phrase =

     

       38
       -
         (* Parse the input text as a toplevel phrase *)

     

       39
       -
         let lexbuf = Lexing.from_string phrase in

     

       40
       -
         

     

       41
       -
         (* Capture both success/failure status and output *)

     

       42
       -
         try

     

       43
       -
           let parsed_phrase = !Toploop.parse_toplevel_phrase lexbuf in

     

       44
       -
           let (success, output) = capture_output (fun fmt -> 

     

       45
       -
             Toploop.execute_phrase true fmt parsed_phrase

     

       46
       -
           ) in

     

       47
       -
           

     

       48
       -
           (* Return structured result with status and captured output *)

     

       49
       -
           if success then

     

       50
       -
             `Assoc [

     

       51
       -
               ("success", `Bool true);

     

       52
       -
               ("output", `String output);

     

       53
       -
             ]

     

       54
       -
           else

     

       55
       -
             `Assoc [

     

       56
       -
               ("success", `Bool false);

     

       57
       -
               ("error", `String "Execution failed");

     

       58
       -
               ("output", `String output);

     

       59
       -
             ]

     

       60
       -
         with e ->

     

       61
       -
           (* Handle parsing or other errors with more detailed messages *)

     

       62
       -
           let error_msg = match e with

     

       63
       -
           | Syntaxerr.Error err -> 

     

       64
       -
               let msg = match err with

     

       65
       -
               | Syntaxerr.Unclosed _ -> "Syntax error: Unclosed delimiter"

     

       66
       -
               | Syntaxerr.Expecting _ -> "Syntax error: Expecting a different token"

     

       67
       -
               | Syntaxerr.Not_expecting _ -> "Syntax error: Unexpected token"

     

       68
       -
               | Syntaxerr.Applicative_path _ -> "Syntax error: Invalid applicative path"

     

       69
       -
               | Syntaxerr.Variable_in_scope _ -> "Syntax error: Variable in scope"

     

       70
       -
               | Syntaxerr.Other _ -> "Syntax error"

     

       71
       -
               | _ -> "Syntax error (unknown kind)"

     

       72
       -
               in

     

       73
       -
               msg

     

       74
       -
                 

     

       75
       -
           | Lexer.Error (err, _) -> 

     

       76
       -
               let msg = match err with

     

       77
       -
               | Lexer.Illegal_character _ -> "Lexer error: Illegal character"

     

       78
       -
               | Lexer.Illegal_escape _ -> "Lexer error: Illegal escape sequence"

     

       79
       -
               | Lexer.Unterminated_comment _ -> "Lexer error: Unterminated comment"

     

       80
       -
               | Lexer.Unterminated_string -> "Lexer error: Unterminated string"

     

       81
       -
               | Lexer.Unterminated_string_in_comment _ -> "Lexer error: Unterminated string in comment"

     

       82
       -
               | Lexer.Invalid_literal _ -> "Lexer error: Invalid literal"

     

       83
       -
               | _ -> "Lexer error (unknown kind)"

     

       84
       -
               in 

     

       85
       -
               msg

     

       86
       -
           | _ -> Printexc.to_string e

     

       87
       -
           in

     

       88
       -
           `Assoc [

     

       89
       -
             ("success", `Bool false);

     

       90
       -
             ("error", `String error_msg);

     

       91
       -
           ]

     

       92
       -
       

     

       93
       -
       (* Create evaluation server *)

     

       94
       -
       let server = create_server 

     

       95
       -
         ~name:"OCaml Evaluation Server" 

     

       96
       -
         ~version:"0.1.0" () |>

     

       97
       -
         fun server ->

     

       98
       -
           (* Set default capabilities *)

     

       99
       -
           configure_server server ~with_tools:true ()

     

       100
       -
       

     

       101
       -
       (* Toplevel environment state management *)

     

       102
       -
       let toplevel_initialized = ref false

     

       103
       -
       

     

       104
       -
       (* Initialize OCaml toplevel on first use *)

     

       105
       -
       let ensure_toploop_initialized () =

     

       106
       -
         if not !toplevel_initialized then begin

     

       107
       -
           let _ = initialize_toploop () in

     

       108
       -
           toplevel_initialized := true;

     

       109
       -
         end

     

       110
       -
       

     

       111
       -
       (* Register eval tool *)

     

       112
       -
       let _ = add_tool server

     

       113
       -
         ~name:"ocaml_eval"

     

       114
       -
         ~description:"Evaluates OCaml toplevel phrases and returns the result"

     

       115
       -
         ~schema_properties:[

     

       116
       -
           ("code", "string", "OCaml code to evaluate")

     

       117
       -
         ]

     

       118
       -
         ~schema_required:["code"]

     

       119
       -
         (fun args ->

     

       120
       -
           ensure_toploop_initialized ();

     

       121
       -
           

     

       122
       -
           try

     

       123
       -
             (* Extract code parameter *)

     

       124
       -
             let code = get_string_param args "code" in

     

       125
       -
             

     

       126
       -
             (* Execute the code *)

     

       127
       -
             let result = evaluate_phrase code in

     

       128
       -
             

     

       129
       -
             (* Return formatted result *)

     

       130
       -
             let success = match result with

     

       131
       -
               | `Assoc fields -> (

     

       132
       -
                 match List.assoc_opt "success" fields with

     

       133
       -
                 | Some (`Bool true) -> true

     

       134
       -
                 | _ -> false

     

       135
       -
               )

     

       136
       -
               | _ -> false

     

       137
       -
             in

     

       138
       -
             

     

       139
       -
             let output = match result with

     

       140
       -
               | `Assoc fields -> (

     

       141
       -
                 match List.assoc_opt "output" fields with

     

       142
       -
                 | Some (`String s) -> s

     

       143
       -
                 | _ -> (

     

       144
       -
                   match List.assoc_opt "error" fields with

     

       145
       -
                   | Some (`String s) -> s

     

       146
       -
                   | _ -> "Unknown result"

     

       147
       -
                 )

     

       148
       -
               )

     

       149
       -
               | _ -> "Unknown result"

     

       150
       -
             in

     

       151
       -
             

     

       152
       -
             (* Create a tool result with colorized output *)

     

       153
       -
             Tool.create_tool_result [

     

       154
       -
               Mcp.make_text_content output

     

       155
       -
             ] ~is_error:(not success)

     

       156
       -
             

     

       157
       -
           with

     

       158
       -
           | Failure msg ->

     

       159
       -
             Log.errorf "Error in OCaml eval tool: %s" msg;

     

       160
       -
             Tool.create_tool_result [Mcp.make_text_content (Printf.sprintf "Error: %s" msg)] ~is_error:true

     

       161
       -
         )

     

       162
       -
       

     

       163
       -
       (* Run the server with the default scheduler *)

     

       164
       -
       let () =

     

       165
       -
         Eio_main.run @@ fun env->

     

       166
       -
           Mcp_server.run_server env server

+186

bin/resource_template_example.ml

···

       1
       +
       open Mcp

     

       2
       +
       open Mcp_sdk

     

       3
       +
       open Mcp_server

     

       4
       +
       

     

       5
       +
       (* Helper for extracting string value from JSON *)

     

       6
       +
       let get_string_param json name =

     

       7
       +
         match json with

     

       8
       +
         | `Assoc fields ->

     

       9
       +
           (match List.assoc_opt name fields with

     

       10
       +
           | Some (`String value) -> value

     

       11
       +
           | _ -> raise (Failure (Printf.sprintf "Missing or invalid parameter: %s" name)))

     

       12
       +
         | _ -> raise (Failure "Expected JSON object")

     

       13
       +
       

     

       14
       +
       (* Create a server *)

     

       15
       +
       let server = create_server 

     

       16
       +
         ~name:"OCaml MCP Resource Template Example" 

     

       17
       +
         ~version:"0.1.0" 

     

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

     

       19
       +
         ()

     

       20
       +
       

     

       21
       +
       (* Define startup and shutdown hooks *)

     

       22
       +
       let startup () =

     

       23
       +
         (* Use stderr for direct printing to avoid interfering with JSON-RPC protocol *)

     

       24
       +
         Printf.fprintf stderr "ResourceTemplateServer is starting up!\n";

     

       25
       +
         flush stderr;

     

       26
       +
         Log.info "ResourceTemplateServer is starting up!"

     

       27
       +
       

     

       28
       +
       let shutdown () =

     

       29
       +
         Printf.fprintf stderr "ResourceTemplateServer is shutting down. Goodbye!\n";

     

       30
       +
         flush stderr;

     

       31
       +
         Log.info "ResourceTemplateServer is shutting down. Goodbye!"

     

       32
       +
       

     

       33
       +
       (* Register the hooks *)

     

       34
       +
       let () =

     

       35
       +
         set_startup_hook server startup;

     

       36
       +
         set_shutdown_hook server shutdown

     

       37
       +
       

     

       38
       +
       (* Database of "documents" *)

     

       39
       +
       let documents = [

     

       40
       +
         ("doc1", "This is the first document content");

     

       41
       +
         ("doc2", "This document contains information about OCaml");

     

       42
       +
         ("doc3", "MCP protocol is a standard for LLM-based applications");

     

       43
       +
         ("doc4", "Resource templates allow for parameterized resources");

     

       44
       +
       ]

     

       45
       +
       

     

       46
       +
       (* Define and register a resource template for documents *)

     

       47
       +
       let _ = add_resource server

     

       48
       +
         ~uri_template:"document://{id}"

     

       49
       +
         ~description:"Get a document by ID"

     

       50
       +
         ~mime_type:"text/plain"

     

       51
       +
         (fun params ->

     

       52
       +
           match params with

     

       53
       +
           | [id] -> 

     

       54
       +
               begin

     

       55
       +
                 try

     

       56
       +
                   let content = List.assoc id documents in

     

       57
       +
                   content

     

       58
       +
                 with Not_found -> 

     

       59
       +
                   Printf.sprintf "Error: Document '%s' not found" id

     

       60
       +
               end

     

       61
       +
           | _ -> "Error: Invalid document ID"

     

       62
       +
         )

     

       63
       +
       

     

       64
       +
       (* Define and register a list documents resource *)

     

       65
       +
       let _ = add_resource server

     

       66
       +
         ~uri_template:"documents://list"

     

       67
       +
         ~description:"List all available documents"

     

       68
       +
         ~mime_type:"text/plain"

     

       69
       +
         (fun _ ->

     

       70
       +
           let doc_list = 

     

       71
       +
             String.concat "\n" 

     

       72
       +
               (List.map (fun (id, _) -> Printf.sprintf "- %s" id) documents)

     

       73
       +
           in

     

       74
       +
           Printf.sprintf "Available Documents:\n%s" doc_list

     

       75
       +
         )

     

       76
       +
       

     

       77
       +
       (* Define and register a tool that uses resource references *)

     

       78
       +
       let _ = add_tool server

     

       79
       +
         ~name:"get_document"

     

       80
       +
         ~description:"Gets a document by ID using resource references"

     

       81
       +
         ~schema_properties:[

     

       82
       +
           ("document_id", "string", "The ID of the document to retrieve");

     

       83
       +
         ]

     

       84
       +
         ~schema_required:["document_id"]

     

       85
       +
         (fun args ->

     

       86
       +
           try

     

       87
       +
             let doc_id = get_string_param args "document_id" in

     

       88
       +
             

     

       89
       +
             (* Create a resource reference *)

     

       90
       +
             let ref = ResourceReference.{ uri = Printf.sprintf "document://%s" doc_id } in

     

       91
       +
             (* Convert to JSON for logging purposes *)

     

       92
       +
             let _ = ResourceReference.yojson_of_t ref in

     

       93
       +
             

     

       94
       +
             (* Return the reference *)

     

       95
       +
             CallToolResult.yojson_of_t CallToolResult.{

     

       96
       +
               content = [

     

       97
       +
                 Text TextContent.{ text = Printf.sprintf "Resource reference for document %s:" doc_id; annotations = None };

     

       98
       +
                 Resource EmbeddedResource.{ 

     

       99
       +
                   resource = `Text TextResourceContents.{

     

       100
       +
                     uri = Printf.sprintf "document://%s" doc_id;

     

       101
       +
                     text = (try List.assoc doc_id documents with Not_found -> "Not found");

     

       102
       +
                     mime_type = Some "text/plain"

     

       103
       +
                   };

     

       104
       +
                   annotations = None

     

       105
       +
                 }

     

       106
       +
               ];

     

       107
       +
               is_error = false;

     

       108
       +
               meta = None

     

       109
       +
             }

     

       110
       +
           with

     

       111
       +
           | Failure msg ->

     

       112
       +
             Log.error (Printf.sprintf "Error in get_document tool: %s" msg);

     

       113
       +
             CallToolResult.yojson_of_t CallToolResult.{

     

       114
       +
               content = [

     

       115
       +
                 Text TextContent.{ 

     

       116
       +
                   text = Printf.sprintf "Error: %s" msg; 

     

       117
       +
                   annotations = None 

     

       118
       +
                 }

     

       119
       +
               ];

     

       120
       +
               is_error = true;

     

       121
       +
               meta = None

     

       122
       +
             }

     

       123
       +
         )

     

       124
       +
       

     

       125
       +
       (* Define and register a prompt that uses resource templates *)

     

       126
       +
       let _ = add_prompt server

     

       127
       +
         ~name:"document-prompt"

     

       128
       +
         ~description:"A prompt that references document resources"

     

       129
       +
         ~arguments:[

     

       130
       +
           ("document_id", Some "ID of the document to include in the prompt", true);

     

       131
       +
         ]

     

       132
       +
         (fun args ->

     

       133
       +
           let doc_id = 

     

       134
       +
             try List.assoc "document_id" args

     

       135
       +
             with Not_found -> "doc1" (* Default to doc1 *)

     

       136
       +
           in

     

       137
       +
           

     

       138
       +
           let doc_text = 

     

       139
       +
             try List.assoc doc_id documents

     

       140
       +
             with Not_found -> Printf.sprintf "Document '%s' not found" doc_id

     

       141
       +
           in

     

       142
       +
           

     

       143
       +
           [

     

       144
       +
             Prompt.{ 

     

       145
       +
               role = `User; 

     

       146
       +
               content = make_text_content (Printf.sprintf "Please summarize the following document (ID: %s):" doc_id)

     

       147
       +
             };

     

       148
       +
             Prompt.{ 

     

       149
       +
               role = `User; 

     

       150
       +
               content = Resource EmbeddedResource.{

     

       151
       +
                 resource = `Text TextResourceContents.{

     

       152
       +
                   uri = Printf.sprintf "document://%s" doc_id;

     

       153
       +
                   text = doc_text;

     

       154
       +
                   mime_type = Some "text/plain"

     

       155
       +
                 };

     

       156
       +
                 annotations = None

     

       157
       +
               }

     

       158
       +
             };

     

       159
       +
             Prompt.{ 

     

       160
       +
               role = `Assistant; 

     

       161
       +
               content = make_text_content "I'll help summarize this document for you."

     

       162
       +
             }

     

       163
       +
           ]

     

       164
       +
         )

     

       165
       +
       

     

       166
       +
       (* Main function *)

     

       167
       +
       let () =

     

       168
       +
         (* Parse command line arguments *)

     

       169
       +
         let transport_type = ref Stdio in

     

       170
       +
         let args = [

     

       171
       +
           ("--http", Arg.Unit (fun () -> transport_type := Http), 

     

       172
       +
            "Start server with HTTP transport (default is stdio)");

     

       173
       +
         ] in

     

       174
       +
         let usage_msg = "Usage: resource_template_example [--http]" in

     

       175
       +
         Arg.parse args (fun _ -> ()) usage_msg;

     

       176
       +
       

     

       177
       +
         (* Instead of printing directly to stdout which messes up the JSON-RPC protocol,

     

       178
       +
            use the logging system which sends output to stderr *)

     

       179
       +
         Log.info "Starting ResourceTemplateServer...";

     

       180
       +
         

     

       181
       +
         (* Configure the server with appropriate capabilities *)

     

       182
       +
         ignore (configure_server server ());

     

       183
       +
         

     

       184
       +
         (* Create and start MCP server with the selected transport *)

     

       185
       +
         let mcp_server = create ~server ~transport:!transport_type () in

     

       186
       +
         start mcp_server

+365

bin/server.ml

···

       1
       +
       open Mcp

     

       2
       +
       open Jsonrpc

     

       3
       +
       

     

       4
       +
       (* Logging utilities *)

     

       5
       +
       let log_debug msg =

     

       6
       +
         Printf.eprintf "[DEBUG] %s\n" msg;

     

       7
       +
         flush stderr

     

       8
       +
       

     

       9
       +
       let log_error msg =

     

       10
       +
         Printf.eprintf "[ERROR] %s\n" msg;

     

       11
       +
         flush stderr

     

       12
       +
       

     

       13
       +
       (* Server state *)

     

       14
       +
       let protocol_version = "2024-11-05"

     

       15
       +
       let server_info = Implementation.{ name = "ocaml-mcp-capitalizer"; version = "0.1.0" }

     

       16
       +
       let server_capabilities = `Assoc [

     

       17
       +
         (* We support tools *)

     

       18
       +
         ("tools", `Assoc [

     

       19
       +
           ("listChanged", `Bool true)

     

       20
       +
         ]);

     

       21
       +
         (* We don't support resources - make this explicit *)

     

       22
       +
         ("resources", `Assoc [

     

       23
       +
           ("listChanged", `Bool false);

     

       24
       +
           ("subscribe", `Bool false)

     

       25
       +
         ]);

     

       26
       +
         (* We don't support prompts - make this explicit *)

     

       27
       +
         ("prompts", `Assoc [

     

       28
       +
           ("listChanged", `Bool false)

     

       29
       +
         ])

     

       30
       +
       ]

     

       31
       +
       

     

       32
       +
       (* Tool implementation *)

     

       33
       +
       module CapitalizeTool = struct

     

       34
       +
         let name = "capitalize"

     

       35
       +
         let description = "Capitalizes the provided text"

     

       36
       +
         let input_schema = `Assoc [

     

       37
       +
           ("type", `String "object");

     

       38
       +
           ("properties", `Assoc [

     

       39
       +
             ("text", `Assoc [

     

       40
       +
               ("type", `String "string");

     

       41
       +
               ("description", `String "The text to capitalize")

     

       42
       +
             ])

     

       43
       +
           ]);

     

       44
       +
           ("required", `List [`String "text"])

     

       45
       +
         ]

     

       46
       +
       

     

       47
       +
         let call json =

     

       48
       +
           match json with

     

       49
       +
           | `Assoc fields ->

     

       50
       +
             (match List.assoc_opt "text" fields with

     

       51
       +
              | Some (`String text) ->

     

       52
       +
                let capitalized_text = String.uppercase_ascii text in

     

       53
       +
                let content = TextContent.{ 

     

       54
       +
                  text = capitalized_text;

     

       55
       +
                  annotations = None 

     

       56
       +
                } in

     

       57
       +
                `Assoc [

     

       58
       +
                  ("content", `List [TextContent.yojson_of_t content]);

     

       59
       +
                  ("isError", `Bool false)

     

       60
       +
                ]

     

       61
       +
              | _ -> 

     

       62
       +
                let error_content = TextContent.{

     

       63
       +
                  text = "Missing or invalid 'text' parameter";

     

       64
       +
                  annotations = None

     

       65
       +
                } in

     

       66
       +
                `Assoc [

     

       67
       +
                  ("content", `List [TextContent.yojson_of_t error_content]);

     

       68
       +
                  ("isError", `Bool true)

     

       69
       +
                ])

     

       70
       +
           | _ ->

     

       71
       +
             let error_content = TextContent.{

     

       72
       +
               text = "Invalid arguments format";

     

       73
       +
               annotations = None

     

       74
       +
             } in

     

       75
       +
             `Assoc [

     

       76
       +
               ("content", `List [TextContent.yojson_of_t error_content]);

     

       77
       +
               ("isError", `Bool true)

     

       78
       +
             ]

     

       79
       +
       end

     

       80
       +
       

     

       81
       +
       (* Handle tool listing *)

     

       82
       +
       let list_tools () =

     

       83
       +
         let tool = `Assoc [

     

       84
       +
           ("name", `String CapitalizeTool.name);

     

       85
       +
           ("description", `String CapitalizeTool.description);

     

       86
       +
           ("inputSchema", CapitalizeTool.input_schema)

     

       87
       +
         ] in

     

       88
       +
         `Assoc [

     

       89
       +
           ("tools", `List [tool])

     

       90
       +
         ]

     

       91
       +
       

     

       92
       +
       (* Handle tool calls *)

     

       93
       +
       let call_tool name args =

     

       94
       +
         if name = CapitalizeTool.name then

     

       95
       +
           CapitalizeTool.call args

     

       96
       +
         else

     

       97
       +
           let error_content = TextContent.{

     

       98
       +
             text = Printf.sprintf "Unknown tool: %s" name;

     

       99
       +
             annotations = None

     

       100
       +
           } in

     

       101
       +
           `Assoc [

     

       102
       +
             ("content", `List [TextContent.yojson_of_t error_content]);

     

       103
       +
             ("isError", `Bool true)

     

       104
       +
           ]

     

       105
       +
       

     

       106
       +
       (* Handle initialization *)

     

       107
       +
       let handle_initialize id json =

     

       108
       +
         try

     

       109
       +
           log_debug (Printf.sprintf "Processing initialize request with id: %s" 

     

       110
       +
             (match id with 

     

       111
       +
              | `Int i -> string_of_int i 

     

       112
       +
              | `String s -> s));

     

       113
       +
           

     

       114
       +
           log_debug (Printf.sprintf "Initialize params: %s" 

     

       115
       +
             (match json with 

     

       116
       +
              | Some j -> Yojson.Safe.to_string j 

     

       117
       +
              | None -> "null"));

     

       118
       +
           

     

       119
       +
           let _ = match json with

     

       120
       +
             | Some params -> 

     

       121
       +
                 log_debug "Parsing initialize request params...";

     

       122
       +
                 let req = Initialize.Request.t_of_yojson params in

     

       123
       +
                 log_debug (Printf.sprintf "Client info: %s v%s" req.client_info.name req.client_info.version);

     

       124
       +
                 log_debug (Printf.sprintf "Client protocol version: %s" req.protocol_version);

     

       125
       +
                 

     

       126
       +
                 (* Check protocol version compatibility *)

     

       127
       +
                 if req.protocol_version <> protocol_version then

     

       128
       +
                   log_debug (Printf.sprintf "Protocol version mismatch: client=%s server=%s - will use server version" 

     

       129
       +
                     req.protocol_version protocol_version);

     

       130
       +
                 

     

       131
       +
                 req

     

       132
       +
             | None -> 

     

       133
       +
                 log_error "Missing params for initialize request";

     

       134
       +
                 raise (Json.Of_json ("Missing params for initialize request", `Null))

     

       135
       +
           in

     

       136
       +
           

     

       137
       +
           log_debug "Creating initialize response...";

     

       138
       +
           let result = Initialize.Result.create

     

       139
       +
             ~capabilities:server_capabilities

     

       140
       +
             ~server_info

     

       141
       +
             ~protocol_version

     

       142
       +
             ~instructions:"This server provides a tool to capitalize text."

     

       143
       +
             ()

     

       144
       +
           in

     

       145
       +
           

     

       146
       +
           log_debug "Serializing initialize response...";

     

       147
       +
           let response = create_response ~id ~result:(Initialize.Result.yojson_of_t result) in

     

       148
       +
           log_debug "Initialize response created successfully";

     

       149
       +
           response

     

       150
       +
         with

     

       151
       +
         | Json.Of_json (msg, _) ->

     

       152
       +
           log_error (Printf.sprintf "JSON error in initialize: %s" msg);

     

       153
       +
           create_error ~id ~code:(-32602) ~message:("Invalid params: " ^ msg) ()

     

       154
       +
         | exc ->

     

       155
       +
           log_error (Printf.sprintf "Exception in initialize: %s" (Printexc.to_string exc));

     

       156
       +
           log_error (Printf.sprintf "Backtrace: %s" (Printexc.get_backtrace()));

     

       157
       +
           create_error ~id ~code:(-32603) ~message:("Internal error: " ^ (Printexc.to_string exc)) ()

     

       158
       +
       

     

       159
       +
       (* Handle tools/list *)

     

       160
       +
       let handle_list_tools id =

     

       161
       +
         log_debug "Processing tools/list request";

     

       162
       +
         let result = list_tools () in

     

       163
       +
         log_debug (Printf.sprintf "Tools list result: %s" (Yojson.Safe.to_string result));

     

       164
       +
         create_response ~id ~result

     

       165
       +
       

     

       166
       +
       (* Handle tools/call *)

     

       167
       +
       let handle_call_tool id json =

     

       168
       +
         try

     

       169
       +
           log_debug (Printf.sprintf "Processing tool call request with id: %s" 

     

       170
       +
             (match id with 

     

       171
       +
              | `Int i -> string_of_int i 

     

       172
       +
              | `String s -> s));

     

       173
       +
           

     

       174
       +
           log_debug (Printf.sprintf "Tool call params: %s" 

     

       175
       +
             (match json with 

     

       176
       +
              | Some j -> Yojson.Safe.to_string j 

     

       177
       +
              | None -> "null"));

     

       178
       +
           

     

       179
       +
           match json with

     

       180
       +
           | Some (`Assoc params) ->

     

       181
       +
             let name = match List.assoc_opt "name" params with

     

       182
       +
               | Some (`String name) -> 

     

       183
       +
                   log_debug (Printf.sprintf "Tool name: %s" name);

     

       184
       +
                   name

     

       185
       +
               | _ -> 

     

       186
       +
                   log_error "Missing or invalid 'name' parameter in tool call";

     

       187
       +
                   raise (Json.Of_json ("Missing or invalid 'name' parameter", `Assoc params))

     

       188
       +
             in

     

       189
       +
             let args = match List.assoc_opt "arguments" params with

     

       190
       +
               | Some (args) -> 

     

       191
       +
                   log_debug (Printf.sprintf "Tool arguments: %s" (Yojson.Safe.to_string args));

     

       192
       +
                   args

     

       193
       +
               | _ -> 

     

       194
       +
                   log_debug "No arguments provided for tool call, using empty object";

     

       195
       +
                   `Assoc [] (* Empty arguments is valid *)

     

       196
       +
             in

     

       197
       +
             log_debug (Printf.sprintf "Calling tool: %s" name);

     

       198
       +
             let result = call_tool name args in

     

       199
       +
             log_debug (Printf.sprintf "Tool call result: %s" (Yojson.Safe.to_string result));

     

       200
       +
             create_response ~id ~result

     

       201
       +
           | _ ->

     

       202
       +
             log_error "Invalid params format for tools/call";

     

       203
       +
             create_error ~id ~code:(-32602) ~message:"Invalid params for tools/call" ()

     

       204
       +
         with

     

       205
       +
         | Json.Of_json (msg, _) ->

     

       206
       +
           log_error (Printf.sprintf "JSON error in tool call: %s" msg);

     

       207
       +
           create_error ~id ~code:(-32602) ~message:("Invalid params: " ^ msg) ()

     

       208
       +
         | exc ->

     

       209
       +
           log_error (Printf.sprintf "Exception in tool call: %s" (Printexc.to_string exc));

     

       210
       +
           log_error (Printf.sprintf "Backtrace: %s" (Printexc.get_backtrace()));

     

       211
       +
           create_error ~id ~code:(-32603) ~message:("Internal error: " ^ (Printexc.to_string exc)) ()

     

       212
       +
       

     

       213
       +
       (* Handle ping *)

     

       214
       +
       let handle_ping id =

     

       215
       +
         create_response ~id ~result:(`Assoc [])

     

       216
       +
       

     

       217
       +
       (* Process a single message *)

     

       218
       +
       let process_message message =

     

       219
       +
         try

     

       220
       +
           log_debug "Parsing message as JSONRPC message...";

     

       221
       +
           match JSONRPCMessage.t_of_yojson message with

     

       222
       +
           | JSONRPCMessage.Request req ->

     

       223
       +
             log_debug (Printf.sprintf "Received request with method: %s" req.method_);

     

       224
       +
             (match req.method_ with

     

       225
       +
              | "initialize" -> 

     

       226
       +
                log_debug "Processing initialize request";

     

       227
       +
                Some (handle_initialize req.id req.params)

     

       228
       +
              | "tools/list" -> 

     

       229
       +
                log_debug "Processing tools/list request";

     

       230
       +
                Some (handle_list_tools req.id)

     

       231
       +
              | "tools/call" -> 

     

       232
       +
                log_debug "Processing tools/call request";

     

       233
       +
                Some (handle_call_tool req.id req.params)

     

       234
       +
              | "ping" -> 

     

       235
       +
                log_debug "Processing ping request";

     

       236
       +
                Some (handle_ping req.id)

     

       237
       +
              | _ -> 

     

       238
       +
                log_error (Printf.sprintf "Unknown method received: %s" req.method_);

     

       239
       +
                Some (create_error ~id:req.id ~code:(-32601) ~message:("Method not found: " ^ req.method_) ()))

     

       240
       +
           | JSONRPCMessage.Notification notif ->

     

       241
       +
             log_debug (Printf.sprintf "Received notification with method: %s" notif.method_);

     

       242
       +
             (match notif.method_ with

     

       243
       +
              | "notifications/initialized" ->

     

       244
       +
                log_debug "Client initialization complete - Server is now ready to receive requests";

     

       245
       +
                log_debug (Printf.sprintf "Notification params: %s" 

     

       246
       +
                  (match notif.params with

     

       247
       +
                   | Some p -> Yojson.Safe.to_string p

     

       248
       +
                   | None -> "null"));

     

       249
       +
                None

     

       250
       +
              | _ ->

     

       251
       +
                log_debug (Printf.sprintf "Ignoring notification: %s" notif.method_);

     

       252
       +
                None)

     

       253
       +
           | JSONRPCMessage.Response _ ->

     

       254
       +
             log_error "Unexpected response message received";

     

       255
       +
             None

     

       256
       +
           | JSONRPCMessage.Error _ ->

     

       257
       +
             log_error "Unexpected error message received";

     

       258
       +
             None

     

       259
       +
         with

     

       260
       +
         | exc ->

     

       261
       +
           log_error (Printf.sprintf "Exception during message processing: %s" (Printexc.to_string exc));

     

       262
       +
           log_error (Printf.sprintf "Backtrace: %s" (Printexc.get_backtrace()));

     

       263
       +
           log_error (Printf.sprintf "Message was: %s" (Yojson.Safe.to_string message));

     

       264
       +
           None

     

       265
       +
       

     

       266
       +
       (* Main loop *)

     

       267
       +
       let rec read_message () =

     

       268
       +
         try

     

       269
       +
           log_debug "Attempting to read line from stdin...";

     

       270
       +
           let line = read_line () in

     

       271
       +
           if line = "" then (

     

       272
       +
             log_debug "Empty line received, ignoring";

     

       273
       +
             None

     

       274
       +
           ) else (

     

       275
       +
             log_debug (Printf.sprintf "Raw input: %s" line);

     

       276
       +
             try

     

       277
       +
               let json = Yojson.Safe.from_string line in

     

       278
       +
               log_debug "Successfully parsed JSON";

     

       279
       +
               Some json

     

       280
       +
             with

     

       281
       +
             | Yojson.Json_error msg -> 

     

       282
       +
               log_error (Printf.sprintf "Error parsing JSON: %s" msg);

     

       283
       +
               log_error (Printf.sprintf "Input was: %s" line);

     

       284
       +
               read_message ()

     

       285
       +
           )

     

       286
       +
         with

     

       287
       +
         | End_of_file -> 

     

       288
       +
           log_debug "End of file received on stdin";

     

       289
       +
           None

     

       290
       +
         | Sys_error msg -> 

     

       291
       +
           log_error (Printf.sprintf "System error while reading: %s" msg);

     

       292
       +
           None

     

       293
       +
         | exc ->

     

       294
       +
           log_error (Printf.sprintf "Exception while reading: %s" (Printexc.to_string exc));

     

       295
       +
           None

     

       296
       +
       

     

       297
       +
       let () =

     

       298
       +
         try

     

       299
       +
           (* Enable exception backtraces *)

     

       300
       +
           Printexc.record_backtrace true;

     

       301
       +
           

     

       302
       +
           (* Enable line buffering for stdout *)

     

       303
       +
           set_binary_mode_out stdout false;

     

       304
       +
           

     

       305
       +
           log_debug "MCP Capitalizer server started";

     

       306
       +
           log_debug (Printf.sprintf "Protocol version: %s" protocol_version);

     

       307
       +
           log_debug (Printf.sprintf "Server info: %s v%s" server_info.name server_info.version);

     

       308
       +
           

     

       309
       +
           (* Print environment info for debugging *)

     

       310
       +
           log_debug "Environment variables:";

     

       311
       +
           Unix.environment()

     

       312
       +
           |> Array.iter (fun s -> 

     

       313
       +
             try

     

       314
       +
               let i = String.index s '=' in

     

       315
       +
               let name = String.sub s 0 i in

     

       316
       +
               if String.length name > 0 then

     

       317
       +
                 log_debug (Printf.sprintf "  %s" s)

     

       318
       +
             with Not_found -> ()

     

       319
       +
           );

     

       320
       +
           

     

       321
       +
           let rec server_loop count =

     

       322
       +
             log_debug (Printf.sprintf "Waiting for message #%d..." count);

     

       323
       +
             match read_message () with

     

       324
       +
             | Some json ->

     

       325
       +
               log_debug (Printf.sprintf "Received message: %s" (Yojson.Safe.to_string json));

     

       326
       +
               (match process_message json with

     

       327
       +
                | Some response ->

     

       328
       +
                  let response_json = JSONRPCMessage.yojson_of_t response in

     

       329
       +
                  let response_str = Yojson.Safe.to_string response_json in

     

       330
       +
                  log_debug (Printf.sprintf "Sending response: %s" response_str);

     

       331
       +
                  (* Make sure we emit properly formatted JSON on a single line with a newline at the end *)

     

       332
       +
                  Printf.printf "%s\n" response_str;

     

       333
       +
                  flush stdout;

     

       334
       +
                  (* Give the client a moment to process the response *)

     

       335
       +
                  Unix.sleepf 0.01;

     

       336
       +
                  server_loop (count + 1)

     

       337
       +
                | None -> 

     

       338
       +
                  log_debug "No response needed for this message";

     

       339
       +
                  server_loop (count + 1))

     

       340
       +
             | None -> 

     

       341
       +
               log_debug "End of input stream, terminating server";

     

       342
       +
               ()

     

       343
       +
           in

     

       344
       +
           

     

       345
       +
           log_debug "Starting server loop...";

     

       346
       +
           log_debug "Waiting for the initialize request...";

     

       347
       +
           

     

       348
       +
           (* Set up signal handler to gracefully exit *)

     

       349
       +
           Sys.(set_signal sigint (Signal_handle (fun _ -> 

     

       350
       +
             log_debug "Received interrupt signal, exiting...";

     

       351
       +
             exit 0

     

       352
       +
           )));

     

       353
       +
           

     

       354
       +
           server_loop 1;

     

       355
       +
           log_debug "Server terminated normally";

     

       356
       +
         with

     

       357
       +
         | End_of_file ->

     

       358
       +
           log_error "Unexpected end of file";

     

       359
       +
         | Sys_error msg ->

     

       360
       +
           log_error (Printf.sprintf "System error: %s" msg);

     

       361
       +
         | Unix.Unix_error(err, func, arg) ->

     

       362
       +
           log_error (Printf.sprintf "Unix error in %s(%s): %s" func arg (Unix.error_message err));

     

       363
       +
         | exc ->

     

       364
       +
           log_error (Printf.sprintf "Unhandled exception: %s" (Printexc.to_string exc));

     

       365
       +
           log_error (Printf.sprintf "Backtrace: %s" (Printexc.get_backtrace()))

bin/server.mli

···

       1
       +
       val process_message : Jsonrpc.Json.t -> Mcp.JSONRPCMessage.t option

     

       2
       +
       val handle_initialize : Jsonrpc.Id.t -> Jsonrpc.Json.t option -> Mcp.JSONRPCMessage.t

     

       3
       +
       val handle_list_tools : Jsonrpc.Id.t -> Mcp.JSONRPCMessage.t

     

       4
       +
       val handle_call_tool : Jsonrpc.Id.t -> Jsonrpc.Json.t option -> Mcp.JSONRPCMessage.t

     

       5
       +
       val handle_ping : Jsonrpc.Id.t -> Mcp.JSONRPCMessage.t

-18

dune-project

···

       1
        
       (lang dune 3.17)

     

       2
       -
       (name mcp)

     

       3
       -
       

     

       4
       -
       (license ISC)

     

       5
       -
       (authors "Anil Madhavapeddy")

     

       6
       -
       (maintainers "anil@recoil.org")

     

       7
       -
       

     

       8
       -
       (generate_opam_files true)

     

       9
       -
       

     

       10
       -
       (package

     

       11
       -
        (name mcp)

     

       12
       -
        (synopsis "Model Context Protocol for LLMs")

     

       13
       -
        (description "This is all still a work in progress")

     

       14
       -
        (depends

     

       15
       -
         (ocaml (>= "5.2.0"))

     

       16
       -
         jsonrpc

     

       17
       -
         eio_main

     

       18
       -
         eio))

     

       19
       -

···

       1
        
       (lang dune 3.17)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0

+3 -13

lib/dune

···

       1
        
       (library

     

       2
        
         (name mcp)

     

       3
       -
         (public_name mcp)

     

       4
        
         (libraries jsonrpc unix yojson)

     

       5
        
         (modules mcp))

     

       6
       -
       

     

       7
       -
       (library

     

       8
       -
         (name mcp_rpc)

     

       9
       -
         (public_name mcp.rpc)

     

       10
       -
         (libraries mcp jsonrpc unix yojson)

     

       11
       -
         (modules mcp_rpc)

     

       12
       -
         (flags (:standard -w -67 -w -27 -w -32 -w -33 -w -34)))

     

       13
        
       

     

       14
        
       (library

     

       15
        
         (name mcp_sdk)

     

       16
       -
         (public_name mcp.sdk)

     

       17
       -
         (libraries mcp mcp_rpc jsonrpc unix yojson)

     

       18
        
         (modules mcp_sdk)

     

       19
        
         (flags (:standard -w -67 -w -27 -w -32)))

     

       20
        
       

     

       21
        
       (library

     

       22
        
         (name mcp_server)

     

       23
       -
         (public_name mcp.server)

     

       24
       -
         (libraries mcp_sdk jsonrpc eio_main eio)

     

       25
        
         (modules mcp_server)

     

       26
       -
       )

···

       1
        
       (library

     

       2
        
         (name mcp)

     

       0
        
       
     

       3
        
         (libraries jsonrpc unix yojson)

     

       4
        
         (modules mcp))

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       5
        
       

     

       6
        
       (library

     

       7
        
         (name mcp_sdk)

     

       8
       +
         (libraries mcp jsonrpc unix yojson)

     

       0
        
       
     

       9
        
         (modules mcp_sdk)

     

       10
        
         (flags (:standard -w -67 -w -27 -w -32)))

     

       11
        
       

     

       12
        
       (library

     

       13
        
         (name mcp_server)

     

       14
       +
         (libraries mcp mcp_sdk jsonrpc unix yojson)

     

       0
        
       
     

       15
        
         (modules mcp_server)

     

       16
       +
         (flags (:standard -w -67 -w -27 -w -32 -w -8 -w -11 -w -33)))

+601 -316

lib/mcp.ml

···

       1
        
       open Jsonrpc

     

       2
        
       

     

       3
       -
       (* Utility functions for JSON parsing *)

     

       4
       -
       module Util = struct

     

       5
       -
         (* Helper to raise a Json.Of_json exception with formatted message *)

     

       6
       -
         let json_error fmt json = 

     

       7
       -
           Printf.ksprintf (fun msg -> raise (Json.Of_json (msg, json))) fmt

     

       8
       -
         

     

       9
       -
         (* Extract a string field from JSON object or raise an error *)

     

       10
       -
         let get_string_field fields name json =

     

       11
       -
           match List.assoc_opt name fields with

     

       12
       -
           | Some (`String s) -> s

     

       13
       -
           | _ -> json_error "Missing or invalid '%s' field" json name

     

       14
       -
         

     

       15
       -
         (* Extract an optional string field from JSON object *)

     

       16
       -
         let get_optional_string_field fields name =

     

       17
       -
           List.assoc_opt name fields |> Option.map (function

     

       18
       -
             | `String s -> s

     

       19
       -
             | j -> json_error "Expected string for %s" j name

     

       20
       -
           )

     

       21
       -
         

     

       22
       -
         (* Extract an int field from JSON object or raise an error *)

     

       23
       -
         let get_int_field fields name json =

     

       24
       -
           match List.assoc_opt name fields with

     

       25
       -
           | Some (`Int i) -> i

     

       26
       -
           | _ -> json_error "Missing or invalid '%s' field" json name

     

       27
       -
           

     

       28
       -
         (* Extract a float field from JSON object or raise an error *)

     

       29
       -
         let get_float_field fields name json =

     

       30
       -
           match List.assoc_opt name fields with

     

       31
       -
           | Some (`Float f) -> f

     

       32
       -
           | _ -> json_error "Missing or invalid '%s' field" json name

     

       33
       -
         

     

       34
       -
         (* Extract a boolean field from JSON object or raise an error *)

     

       35
       -
         let get_bool_field fields name json =

     

       36
       -
           match List.assoc_opt name fields with

     

       37
       -
           | Some (`Bool b) -> b

     

       38
       -
           | _ -> json_error "Missing or invalid '%s' field" json name

     

       39
       -
           

     

       40
       -
         (* Extract an object field from JSON object or raise an error *)

     

       41
       -
         let get_object_field fields name json =

     

       42
       -
           match List.assoc_opt name fields with

     

       43
       -
           | Some (`Assoc obj) -> obj

     

       44
       -
           | _ -> json_error "Missing or invalid '%s' field" json name

     

       45
       -
           

     

       46
       -
         (* Extract a list field from JSON object or raise an error *)

     

       47
       -
         let get_list_field fields name json =

     

       48
       -
           match List.assoc_opt name fields with

     

       49
       -
           | Some (`List items) -> items

     

       50
       -
           | _ -> json_error "Missing or invalid '%s' field" json name

     

       51
       -
           

     

       52
       -
         (* Verify a specific string value in a field *)

     

       53
       -
         let verify_string_field fields name expected_value json =

     

       54
       -
           match List.assoc_opt name fields with

     

       55
       -
           | Some (`String s) when s = expected_value -> ()

     

       56
       -
           | _ -> json_error "Field '%s' missing or not equal to '%s'" json name expected_value

     

       57
       -
       end

     

       58
       -
       

     

       59
       -
       (* Error codes for JSON-RPC *)

     

       60
        
       module ErrorCode = struct

     

       61
       -
         type t = 

     

       62
       -
           | ParseError       (* -32700 - Invalid JSON *)

     

       63
       -
           | InvalidRequest   (* -32600 - Invalid JSON-RPC request *)

     

       64
       -
           | MethodNotFound   (* -32601 - Method not available *)

     

       65
       -
           | InvalidParams    (* -32602 - Invalid method parameters *)

     

       66
       -
           | InternalError    (* -32603 - Internal JSON-RPC error *)

     

       67
       -
           | ResourceNotFound (* -32002 - Custom MCP error: requested resource not found *)

     

       68
       -
           | AuthRequired     (* -32001 - Custom MCP error: authentication required *)

     

       69
       -
           | CustomError of int (* For any other error codes *)

     

       70
       -
         

     

       71
       -
         (* Convert the error code to its integer representation *)

     

       72
       -
         let to_int = function

     

       73
       -
           | ParseError -> -32700

     

       74
       -
           | InvalidRequest -> -32600

     

       75
       -
           | MethodNotFound -> -32601

     

       76
       -
           | InvalidParams -> -32602

     

       77
       -
           | InternalError -> -32603

     

       78
       -
           | ResourceNotFound -> -32002

     

       79
       -
           | AuthRequired -> -32001

     

       80
       -
           | CustomError code -> code

     

       81
       -
         

     

       82
       -
         (* Get error message for standard error codes *)

     

       83
       -
         let to_message = function

     

       84
       -
           | ParseError -> "Parse error"

     

       85
       -
           | InvalidRequest -> "Invalid Request"

     

       86
       -
           | MethodNotFound -> "Method not found"

     

       87
       -
           | InvalidParams -> "Invalid params"

     

       88
       -
           | InternalError -> "Internal error"

     

       89
       -
           | ResourceNotFound -> "Resource not found"

     

       90
       -
           | AuthRequired -> "Authentication required"

     

       91
       -
           | CustomError _ -> "Error"

     

       92
       -
       end

     

       93
       -
       

     

       94
       -
       (* Protocol method types *)

     

       95
       -
       module Method = struct

     

       96
       -
         (* Method type representing all MCP protocol methods *)

     

       97
       -
         type t =

     

       98
       -
           (* Initialization and lifecycle methods *)

     

       99
       -
           | Initialize

     

       100
       -
           | Initialized

     

       101
       -
           

     

       102
       -
           (* Resource methods *)

     

       103
       -
           | ResourcesList

     

       104
       -
           | ResourcesRead

     

       105
       -
           | ResourcesTemplatesList

     

       106
       -
           | ResourcesSubscribe

     

       107
       -
           | ResourcesListChanged

     

       108
       -
           | ResourcesUpdated

     

       109
       -
           

     

       110
       -
           (* Tool methods *)

     

       111
       -
           | ToolsList

     

       112
       -
           | ToolsCall

     

       113
       -
           | ToolsListChanged

     

       114
       -
           

     

       115
       -
           (* Prompt methods *)

     

       116
       -
           | PromptsList

     

       117
       -
           | PromptsGet

     

       118
       -
           | PromptsListChanged

     

       119
       -
           

     

       120
       -
           (* Progress notifications *)

     

       121
       -
           | Progress

     

       122
       -
         

     

       123
       -
         (* Convert method type to string representation *)

     

       124
       -
         let to_string = function

     

       125
       -
           | Initialize -> "initialize"

     

       126
       -
           | Initialized -> "notifications/initialized"

     

       127
       -
           | ResourcesList -> "resources/list"

     

       128
       -
           | ResourcesRead -> "resources/read"

     

       129
       -
           | ResourcesTemplatesList -> "resources/templates/list"

     

       130
       -
           | ResourcesSubscribe -> "resources/subscribe"

     

       131
       -
           | ResourcesListChanged -> "notifications/resources/list_changed"

     

       132
       -
           | ResourcesUpdated -> "notifications/resources/updated"

     

       133
       -
           | ToolsList -> "tools/list"

     

       134
       -
           | ToolsCall -> "tools/call"

     

       135
       -
           | ToolsListChanged -> "notifications/tools/list_changed"

     

       136
       -
           | PromptsList -> "prompts/list"

     

       137
       -
           | PromptsGet -> "prompts/get"

     

       138
       -
           | PromptsListChanged -> "notifications/prompts/list_changed"

     

       139
       -
           | Progress -> "notifications/progress"

     

       140
       -
         

     

       141
       -
         (* Convert string to method type *)

     

       142
       -
         let of_string = function

     

       143
       -
           | "initialize" -> Initialize

     

       144
       -
           | "notifications/initialized" -> Initialized

     

       145
       -
           | "resources/list" -> ResourcesList

     

       146
       -
           | "resources/read" -> ResourcesRead

     

       147
       -
           | "resources/templates/list" -> ResourcesTemplatesList

     

       148
       -
           | "resources/subscribe" -> ResourcesSubscribe

     

       149
       -
           | "notifications/resources/list_changed" -> ResourcesListChanged

     

       150
       -
           | "notifications/resources/updated" -> ResourcesUpdated

     

       151
       -
           | "tools/list" -> ToolsList

     

       152
       -
           | "tools/call" -> ToolsCall

     

       153
       -
           | "notifications/tools/list_changed" -> ToolsListChanged

     

       154
       -
           | "prompts/list" -> PromptsList

     

       155
       -
           | "prompts/get" -> PromptsGet

     

       156
       -
           | "notifications/prompts/list_changed" -> PromptsListChanged

     

       157
       -
           | "notifications/progress" -> Progress

     

       158
       -
           | s -> failwith ("Unknown MCP method: " ^ s)

     

       159
        
       end

     

       160
        
       

     

       161
        
       (* Common types *)

     
···

       170
        
         let of_string = function

     

       171
        
           | "user" -> `User

     

       172
        
           | "assistant" -> `Assistant

     

       173
       -
           | s -> Util.json_error "Unknown role: %s" (`String s) s

     

       174
        
       

     

       175
        
         let yojson_of_t t = `String (to_string t)

     

       176
        
         let t_of_yojson = function

     

       177
        
           | `String s -> of_string s

     

       178
       -
           | j -> Util.json_error "Expected string for Role" j

     

       179
        
       end

     

       180
        
       

     

       181
        
       module ProgressToken = struct

     
···

       192
        
         let yojson_of_t t = `String t

     

       193
        
         let t_of_yojson = function

     

       194
        
           | `String s -> s

     

       195
       -
           | j -> Util.json_error "Expected string for Cursor" j

     

       196
        
       end

     

       197
        
       

     

       198
        
       (* Annotations *)

     
···

       222
        
           | `Assoc fields ->

     

       223
        
             let audience = List.assoc_opt "audience" fields |> Option.map (function

     

       224
        
               | `List items -> List.map Role.t_of_yojson items

     

       225
       -
               | j -> Util.json_error "Expected list for audience" j

     

       226
        
             ) in

     

       227
        
             let priority = List.assoc_opt "priority" fields |> Option.map (function

     

       228
        
               | `Float f -> f

     

       229
       -
               | j -> Util.json_error "Expected float for priority" j

     

       230
        
             ) in

     

       231
        
             { audience; priority }

     

       232
       -
           | j -> Util.json_error "Expected object for annotation" j

     

       233
        
       

     

       234
        
         let yojson_of_t { annotations } =

     

       235
        
           match annotations with

     
···

       240
        
           | `Assoc fields ->

     

       241
        
             let annotations = List.assoc_opt "annotations" fields |> Option.map annotation_of_yojson in

     

       242
        
             { annotations }

     

       243
       -
           | j -> Util.json_error "Expected object for Annotated" j

     

       244
        
       end

     

       245
        
       

     

       246
        
       (* Content types *)

     
···

       263
        
           `Assoc assoc

     

       264
        
       

     

       265
        
         let t_of_yojson = function

     

       266
       -
           | `Assoc fields as json ->

     

       267
       -
             let text = Util.get_string_field fields "text" json in

     

       268
       -
             Util.verify_string_field fields "type" "text" json;

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       269
        
             let annotations = List.assoc_opt "annotations" fields |> Option.map Annotated.annotation_of_yojson in

     

       270
        
             { text; annotations }

     

       271
       -
           | j -> Util.json_error "Expected object for TextContent" j

     

       272
        
       end

     

       273
        
       

     

       274
        
       module ImageContent = struct

     
···

       280
        
       

     

       281
        
         let yojson_of_t { data; mime_type; annotations } =

     

       282
        
           let assoc = [

     

       283
       -
             ("type", `String "image");

     

       284
        
             ("data", `String data);

     

       285
        
             ("mimeType", `String mime_type);

     

       0
        
       
     

       286
        
           ] in

     

       287
        
           let assoc = match annotations with

     

       288
        
             | Some annotations -> ("annotations", Annotated.yojson_of_annotation annotations) :: assoc

     
···

       291
        
           `Assoc assoc

     

       292
        
       

     

       293
        
         let t_of_yojson = function

     

       294
       -
           | `Assoc fields as json ->

     

       295
       -
             let data = Util.get_string_field fields "data" json in

     

       296
       -
             let mime_type = Util.get_string_field fields "mimeType" json in

     

       297
       -
             Util.verify_string_field fields "type" "image" json;

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       298
        
             let annotations = List.assoc_opt "annotations" fields |> Option.map Annotated.annotation_of_yojson in

     

       299
        
             { data; mime_type; annotations }

     

       300
       -
           | j -> Util.json_error "Expected object for ImageContent" j

     

       301
        
       end

     

       302
        
       

     

       303
        
       module AudioContent = struct

     
···

       309
        
       

     

       310
        
         let yojson_of_t { data; mime_type; annotations } =

     

       311
        
           let assoc = [

     

       312
       -
             ("type", `String "audio");

     

       313
        
             ("data", `String data);

     

       314
        
             ("mimeType", `String mime_type);

     

       0
        
       
     

       315
        
           ] in

     

       316
        
           let assoc = match annotations with

     

       317
        
             | Some annotations -> ("annotations", Annotated.yojson_of_annotation annotations) :: assoc

     
···

       320
        
           `Assoc assoc

     

       321
        
       

     

       322
        
         let t_of_yojson = function

     

       323
       -
           | `Assoc fields as json ->

     

       324
       -
             let data = Util.get_string_field fields "data" json in

     

       325
       -
             let mime_type = Util.get_string_field fields "mimeType" json in

     

       326
       -
             Util.verify_string_field fields "type" "audio" json;

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       327
        
             let annotations = List.assoc_opt "annotations" fields |> Option.map Annotated.annotation_of_yojson in

     

       328
        
             { data; mime_type; annotations }

     

       329
       -
           | j -> Util.json_error "Expected object for AudioContent" j

     

       330
        
       end

     

       331
        
       

     

       332
        
       module ResourceContents = struct

     
···

       346
        
           `Assoc assoc

     

       347
        
       

     

       348
        
         let t_of_yojson = function

     

       349
       -
           | `Assoc fields as json ->

     

       350
       -
             let uri = Util.get_string_field fields "uri" json in

     

       351
       -
             let mime_type = Util.get_optional_string_field fields "mimeType" in

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       352
        
             { uri; mime_type }

     

       353
       -
           | j -> Util.json_error "Expected object for ResourceContents" j

     

       354
        
       end

     

       355
        
       

     

       356
        
       module TextResourceContents = struct

     
···

       372
        
           `Assoc assoc

     

       373
        
       

     

       374
        
         let t_of_yojson = function

     

       375
       -
           | `Assoc fields as json ->

     

       376
       -
             let uri = Util.get_string_field fields "uri" json in

     

       377
       -
             let text = Util.get_string_field fields "text" json in

     

       378
       -
             let mime_type = Util.get_optional_string_field fields "mimeType" in

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       379
        
             { uri; text; mime_type }

     

       380
       -
           | j -> Util.json_error "Expected object for TextResourceContents" j

     

       381
        
       end

     

       382
        
       

     

       383
        
       module BlobResourceContents = struct

     
···

       399
        
           `Assoc assoc

     

       400
        
       

     

       401
        
         let t_of_yojson = function

     

       402
       -
           | `Assoc fields as json ->

     

       403
       -
             let uri = Util.get_string_field fields "uri" json in

     

       404
       -
             let blob = Util.get_string_field fields "blob" json in

     

       405
       -
             let mime_type = Util.get_optional_string_field fields "mimeType" in

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       406
        
             { uri; blob; mime_type }

     

       407
       -
           | j -> Util.json_error "Expected object for BlobResourceContents" j

     

       408
        
       end

     

       409
        
       

     

       410
        
       module EmbeddedResource = struct

     
···

       429
        
           `Assoc assoc

     

       430
        
       

     

       431
        
         let t_of_yojson = function

     

       432
       -
           | `Assoc fields as json ->

     

       433
       -
             Util.verify_string_field fields "type" "resource" json;

     

       434
       -
             let resource_fields = match List.assoc_opt "resource" fields with

     

       435
       -
               | Some (`Assoc res_fields) -> res_fields

     

       436
       -
               | _ -> Util.json_error "Missing or invalid 'resource' field" json

     

       437
        
             in

     

       438
       -
             let resource = 

     

       439
       -
               if List.mem_assoc "text" resource_fields then

     

       440
       -
                 `Text (TextResourceContents.t_of_yojson (`Assoc resource_fields))

     

       441
       -
               else if List.mem_assoc "blob" resource_fields then

     

       442
       -
                 `Blob (BlobResourceContents.t_of_yojson (`Assoc resource_fields))

     

       443
       -
               else

     

       444
       -
                 Util.json_error "Invalid resource content" (`Assoc resource_fields)

     

       0
        
       
     

       0
        
       
     

       445
        
             in

     

       446
        
             let annotations = List.assoc_opt "annotations" fields |> Option.map Annotated.annotation_of_yojson in

     

       447
        
             { resource; annotations }

     

       448
       -
           | j -> Util.json_error "Expected object for EmbeddedResource" j

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       449
        
       end

     

       450
        
       

     

       451
        
       type content = 

     
···

       461
        
         | Resource r -> EmbeddedResource.yojson_of_t r

     

       462
        
       

     

       463
        
       let content_of_yojson = function

     

       464
       -
         | `Assoc fields as json ->

     

       465
        
           (match List.assoc_opt "type" fields with

     

       466
       -
            | Some (`String "text") -> Text (TextContent.t_of_yojson json)

     

       467
       -
            | Some (`String "image") -> Image (ImageContent.t_of_yojson json)

     

       468
       -
            | Some (`String "audio") -> Audio (AudioContent.t_of_yojson json)

     

       469
       -
            | Some (`String "resource") -> Resource (EmbeddedResource.t_of_yojson json)

     

       470
       -
            | _ -> Util.json_error "Invalid or missing content type" json)

     

       471
       -
         | j -> Util.json_error "Expected object for content" j

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       472
        
       

     

       473
        
       (* Message types *)

     

       474
        
       

     
···

       485
        
           ]

     

       486
        
       

     

       487
        
         let t_of_yojson = function

     

       488
       -
           | `Assoc fields as json ->

     

       489
        
             let role = match List.assoc_opt "role" fields with

     

       490
        
               | Some json -> Role.t_of_yojson json

     

       491
       -
               | None -> Util.json_error "Missing role field" json

     

       492
        
             in

     

       493
        
             let content = match List.assoc_opt "content" fields with

     

       494
        
               | Some json -> content_of_yojson json

     

       495
       -
               | None -> Util.json_error "Missing content field" json

     

       496
        
             in

     

       497
        
             { role; content }

     

       498
       -
           | j -> Util.json_error "Expected object for PromptMessage" j

     

       499
        
       end

     

       500
        
       

     

       501
        
       module SamplingMessage = struct

     

       502
        
         type t = {

     

       503
        
           role: Role.t;

     

       504
       -
           content: [ `Text of TextContent.t | `Image of ImageContent.t | `Audio of AudioContent.t ];

     

       505
        
         }

     

       506
        
       

     

       507
        
         let yojson_of_t { role; content } =

     

       508
        
           let content_json = match content with

     

       509
        
             | `Text t -> TextContent.yojson_of_t t

     

       510
        
             | `Image i -> ImageContent.yojson_of_t i

     

       511
       -
             | `Audio a -> AudioContent.yojson_of_t a

     

       512
        
           in

     

       513
        
           `Assoc [

     

       514
        
             ("role", Role.yojson_of_t role);

     
···

       516
        
           ]

     

       517
        
       

     

       518
        
         let t_of_yojson = function

     

       519
       -
           | `Assoc fields as json ->

     

       520
        
             let role = match List.assoc_opt "role" fields with

     

       521
        
               | Some json -> Role.t_of_yojson json

     

       522
       -
               | None -> Util.json_error "Missing role field" json

     

       523
        
             in

     

       524
       -
             let content_obj = match List.assoc_opt "content" fields with

     

       525
       -
               | Some (`Assoc content_fields) -> content_fields

     

       526
       -
               | _ -> Util.json_error "Missing or invalid content field" json

     

       527
       -
             in

     

       528
       -
             let content_type = match List.assoc_opt "type" content_obj with

     

       529
       -
               | Some (`String ty) -> ty

     

       530
       -
               | _ -> Util.json_error "Missing or invalid content type" (`Assoc content_obj)

     

       531
       -
             in

     

       532
       -
             let content = 

     

       533
       -
               match content_type with

     

       534
       -
               | "text" -> `Text (TextContent.t_of_yojson (`Assoc content_obj))

     

       535
       -
               | "image" -> `Image (ImageContent.t_of_yojson (`Assoc content_obj))

     

       536
       -
               | "audio" -> `Audio (AudioContent.t_of_yojson (`Assoc content_obj))

     

       537
       -
               | _ -> Util.json_error "Invalid content type: %s" (`Assoc content_obj) content_type

     

       538
        
             in

     

       539
        
             { role; content }

     

       540
       -
           | j -> Util.json_error "Expected object for SamplingMessage" j

     

       541
        
       end

     

       542
        
       

     

       543
        
       (* Implementation info *)

     
···

       555
        
           ]

     

       556
        
       

     

       557
        
         let t_of_yojson = function

     

       558
       -
           | `Assoc fields as json ->

     

       559
       -
             let name = Util.get_string_field fields "name" json in

     

       560
       -
             let version = Util.get_string_field fields "version" json in

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       561
        
             { name; version }

     

       562
       -
           | j -> Util.json_error "Expected object for Implementation" j

     

       563
        
       end

     

       564
        
       

     

       565
        
       (* JSONRPC Message types *)

     

       0
        
       
     

       566
        
       

     

       567
        
       module JSONRPCMessage = struct

     

       568
        
         type notification = {

     

       569
       -
           meth: Method.t;

     

       570
        
           params: Json.t option;

     

       571
        
         }

     

       572
        
       

     

       573
        
         type request = {

     

       574
        
           id: RequestId.t;

     

       575
       -
           meth: Method.t;

     

       576
        
           params: Json.t option;

     

       577
        
           progress_token: ProgressToken.t option;

     

       578
        
         }

     
···

       598
        
         let yojson_of_notification (n: notification) =

     

       599
        
           let assoc = [

     

       600
        
             ("jsonrpc", `String "2.0");

     

       601
       -
             ("method", `String (Method.to_string n.meth));

     

       602
        
           ] in

     

       603
        
           let assoc = match n.params with

     

       604
        
             | Some params -> ("params", params) :: assoc

     
···

       610
        
           let assoc = [

     

       611
        
             ("jsonrpc", `String "2.0");

     

       612
        
             ("id", Id.yojson_of_t r.id);

     

       613
       -
             ("method", `String (Method.to_string r.meth));

     

       614
        
           ] in

     

       615
        
           let assoc = match r.params with

     

       616
        
             | Some params ->

     
···

       660
        
       

     

       661
        
         let notification_of_yojson = function

     

       662
        
           | `Assoc fields ->

     

       663
       -
             let meth = match List.assoc_opt "method" fields with

     

       664
       -
               | Some (`String s) -> 

     

       665
       -
                   (try Method.of_string s

     

       666
       -
                    with Failure msg -> Util.json_error "%s" (`String s) msg)

     

       667
       -
               | _ -> Util.json_error "Missing or invalid 'method' field" (`Assoc fields)

     

       668
        
             in

     

       669
        
             let params = List.assoc_opt "params" fields in

     

       670
       -
             { meth; params }

     

       671
       -
           | j -> Util.json_error "Expected object for notification" j

     

       672
        
       

     

       673
        
         let request_of_yojson = function

     

       674
        
           | `Assoc fields ->

     

       675
        
             let id = match List.assoc_opt "id" fields with

     

       676
        
               | Some id_json -> Id.t_of_yojson id_json

     

       677
       -
               | _ -> Util.json_error "Missing or invalid 'id' field" (`Assoc fields)

     

       678
        
             in

     

       679
       -
             let meth = match List.assoc_opt "method" fields with

     

       680
       -
               | Some (`String s) -> 

     

       681
       -
                   (try Method.of_string s

     

       682
       -
                    with Failure msg -> Util.json_error "%s" (`String s) msg)

     

       683
       -
               | _ -> Util.json_error "Missing or invalid 'method' field" (`Assoc fields)

     

       684
        
             in

     

       685
        
             let params = List.assoc_opt "params" fields in

     

       686
        
             let progress_token = 

     
···

       694
        
                  | _ -> None)

     

       695
        
               | _ -> None

     

       696
        
             in

     

       697
       -
             { id; meth; params; progress_token }

     

       698
       -
           | j -> Util.json_error "Expected object for request" j

     

       699
        
       

     

       700
        
         let response_of_yojson = function

     

       701
        
           | `Assoc fields ->

     

       702
        
             let id = match List.assoc_opt "id" fields with

     

       703
        
               | Some id_json -> Id.t_of_yojson id_json

     

       704
       -
               | _ -> Util.json_error "Missing or invalid 'id' field" (`Assoc fields)

     

       705
        
             in

     

       706
        
             let result = match List.assoc_opt "result" fields with

     

       707
        
               | Some result -> result

     

       708
       -
               | _ -> Util.json_error "Missing 'result' field" (`Assoc fields)

     

       709
        
             in

     

       710
        
             { id; result }

     

       711
       -
           | j -> Util.json_error "Expected object for response" j

     

       712
        
       

     

       713
        
         let error_of_yojson = function

     

       714
       -
           | `Assoc fields as json ->

     

       715
        
             let id = match List.assoc_opt "id" fields with

     

       716
        
               | Some id_json -> Id.t_of_yojson id_json

     

       717
       -
               | _ -> Util.json_error "Missing or invalid 'id' field" json

     

       718
        
             in

     

       719
        
             let error = match List.assoc_opt "error" fields with

     

       720
        
               | Some (`Assoc error_fields) -> error_fields

     

       721
       -
               | _ -> Util.json_error "Missing or invalid 'error' field" json

     

       722
        
             in

     

       723
        
             let code = match List.assoc_opt "code" error with

     

       724
        
               | Some (`Int code) -> code

     

       725
       -
               | _ -> Util.json_error "Missing or invalid 'code' field in error" (`Assoc error)

     

       726
        
             in

     

       727
        
             let message = match List.assoc_opt "message" error with

     

       728
        
               | Some (`String msg) -> msg

     

       729
       -
               | _ -> Util.json_error "Missing or invalid 'message' field in error" (`Assoc error)

     

       730
        
             in

     

       731
        
             let data = List.assoc_opt "data" error in

     

       732
        
             { id; code; message; data }

     

       733
       -
           | j -> Util.json_error "Expected object for error" j

     

       734
        
       

     

       735
        
         let t_of_yojson json =

     

       736
        
           match json with

     

       737
        
           | `Assoc fields ->

     

       738
        
             let _jsonrpc = match List.assoc_opt "jsonrpc" fields with

     

       739
        
               | Some (`String "2.0") -> ()

     

       740
       -
               | _ -> Util.json_error "Missing or invalid 'jsonrpc' field" json

     

       741
        
             in

     

       742
        
             if List.mem_assoc "method" fields then

     

       743
        
               if List.mem_assoc "id" fields then

     
···

       749
        
             else if List.mem_assoc "error" fields then

     

       750
        
               Error (error_of_yojson json)

     

       751
        
             else

     

       752
       -
               Util.json_error "Invalid JSONRPC message format" json

     

       753
       -
           | j -> Util.json_error "Expected object for JSONRPC message" j

     

       754
        
       

     

       755
       -
         let create_notification ?(params=None) ~meth () =

     

       756
       -
           Notification { meth; params }

     

       757
        
       

     

       758
       -
         let create_request ?(params=None) ?(progress_token=None) ~id ~meth () =

     

       759
       -
           Request { id; meth; params; progress_token }

     

       760
        
       

     

       761
        
         let create_response ~id ~result =

     

       762
        
           Response { id; result }

     
···

       783
        
             ]

     

       784
        
       

     

       785
        
           let t_of_yojson = function

     

       786
       -
             | `Assoc fields as json ->

     

       787
        
               let capabilities = match List.assoc_opt "capabilities" fields with

     

       788
        
                 | Some json -> json

     

       789
       -
                 | None -> Util.json_error "Missing capabilities field" json

     

       790
        
               in

     

       791
        
               let client_info = match List.assoc_opt "clientInfo" fields with

     

       792
        
                 | Some json -> Implementation.t_of_yojson json

     

       793
       -
                 | None -> Util.json_error "Missing clientInfo field" json

     

       794
        
               in

     

       795
       -
               let protocol_version = Util.get_string_field fields "protocolVersion" json in

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       796
        
               { capabilities; client_info; protocol_version }

     

       797
       -
             | j -> Util.json_error "Expected object for InitializeRequest" j

     

       798
        
       

     

       799
        
           let create ~capabilities ~client_info ~protocol_version =

     

       800
        
             { capabilities; client_info; protocol_version }

     

       801
        
       

     

       802
        
           let to_jsonrpc ~id t =

     

       803
        
             let params = yojson_of_t t in

     

       804
       -
             JSONRPCMessage.create_request ~id ~meth:Method.Initialize ~params:(Some params) ()

     

       805
        
         end

     

       806
        
       

     

       807
        
         module Result = struct

     
···

       830
        
             `Assoc assoc

     

       831
        
       

     

       832
        
           let t_of_yojson = function

     

       833
       -
             | `Assoc fields as json ->

     

       834
        
               let capabilities = match List.assoc_opt "capabilities" fields with

     

       835
        
                 | Some json -> json

     

       836
       -
                 | None -> Util.json_error "Missing capabilities field" json

     

       837
        
               in

     

       838
        
               let server_info = match List.assoc_opt "serverInfo" fields with

     

       839
        
                 | Some json -> Implementation.t_of_yojson json

     

       840
       -
                 | None -> Util.json_error "Missing serverInfo field" json

     

       841
        
               in

     

       842
       -
               let protocol_version = Util.get_string_field fields "protocolVersion" json in

     

       843
       -
               let instructions = Util.get_optional_string_field fields "instructions" in

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       844
        
               let meta = List.assoc_opt "_meta" fields in

     

       845
        
               { capabilities; server_info; protocol_version; instructions; meta }

     

       846
       -
             | j -> Util.json_error "Expected object for InitializeResult" j

     

       847
        
       

     

       848
        
           let create ~capabilities ~server_info ~protocol_version ?instructions ?meta () =

     

       849
        
             { capabilities; server_info; protocol_version; instructions; meta }

     
···

       871
        
             | `Assoc fields ->

     

       872
        
               let meta = List.assoc_opt "_meta" fields in

     

       873
        
               { meta }

     

       874
       -
             | j -> Util.json_error "Expected object for InitializedNotification" j

     

       875
        
       

     

       876
        
           let create ?meta () = { meta }

     

       877
        
       

     
···

       880
        
               | `Assoc [] -> None

     

       881
        
               | json -> Some json

     

       882
        
             in

     

       883
       -
             JSONRPCMessage.create_notification ~meth:Method.Initialized ~params ()

     

       884
        
         end

     

       885
        
       end

     

       886
       -
       

     

       887
        
       

     

       888
        
       (* Export the main interface for using the MCP protocol *)

     

       889
        
       

     

       890
        
       let parse_message json =

     

       891
        
         JSONRPCMessage.t_of_yojson json

     

       892
        
       

     

       893
       -
       let create_notification ?(params=None) ~meth () =

     

       894
       -
         JSONRPCMessage.create_notification ~params ~meth ()

     

       895
       -
       

     

       896
       -
       let create_request ?(params=None) ?(progress_token=None) ~id ~meth () =

     

       897
       -
         JSONRPCMessage.create_request ~params ~progress_token ~id ~meth ()

     

       898
       -
       

     

       899
        
       let create_response = JSONRPCMessage.create_response

     

       900
        
       let create_error = JSONRPCMessage.create_error

     

       901
        
       

     

       902
       -
       (* Content type constructors *)

     

       903
       -
       let make_text_content text =

     

       904
       -
         Text (TextContent.{ text; annotations = None })

     

       905
       -
       

     

       906
       -
       let make_image_content data mime_type =

     

       907
       -
         Image (ImageContent.{ data; mime_type; annotations = None })

     

       908
       -
       

     

       909
       -
       let make_audio_content data mime_type =

     

       910
       -
         Audio (AudioContent.{ data; mime_type; annotations = None })

     

       911
       -
       

     

       912
       -
       let make_resource_text_content uri text mime_type =

     

       913
       -
         Resource (EmbeddedResource.{

     

       914
       -
           resource = `Text TextResourceContents.{ uri; text; mime_type };

     

       915
       -
           annotations = None;

     

       916
       -
         })

     

       917
       -
       

     

       918
       -
       let make_resource_blob_content uri blob mime_type =

     

       919
       -
         Resource (EmbeddedResource.{

     

       920
       -
           resource = `Blob BlobResourceContents.{ uri; blob; mime_type };

     

       921
       -
           annotations = None;

     

       922
       -
         })

···

       1
        
       open Jsonrpc

     

       2
        
       

     

       3
       +
       (* Standard error codes *)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       4
        
       module ErrorCode = struct

     

       5
       +
         let parse_error = -32700

     

       6
       +
         let invalid_request = -32600

     

       7
       +
         let method_not_found = -32601

     

       8
       +
         let invalid_params = -32602

     

       9
       +
         let internal_error = -32603

     

       10
       +
         let resource_not_found = -32002

     

       11
       +
         let server_error_start = -32000

     

       12
       +
         let server_error_end = -32099

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       13
        
       end

     

       14
        
       

     

       15
        
       (* Common types *)

     
···

       24
        
         let of_string = function

     

       25
        
           | "user" -> `User

     

       26
        
           | "assistant" -> `Assistant

     

       27
       +
           | s -> raise (Json.Of_json ("Unknown role: " ^ s, `String s))

     

       28
        
       

     

       29
        
         let yojson_of_t t = `String (to_string t)

     

       30
        
         let t_of_yojson = function

     

       31
        
           | `String s -> of_string s

     

       32
       +
           | j -> raise (Json.Of_json ("Expected string for Role", j))

     

       33
        
       end

     

       34
        
       

     

       35
        
       module ProgressToken = struct

     
···

       46
        
         let yojson_of_t t = `String t

     

       47
        
         let t_of_yojson = function

     

       48
        
           | `String s -> s

     

       49
       +
           | j -> raise (Json.Of_json ("Expected string for Cursor", j))

     

       50
        
       end

     

       51
        
       

     

       52
        
       (* Annotations *)

     
···

       76
        
           | `Assoc fields ->

     

       77
        
             let audience = List.assoc_opt "audience" fields |> Option.map (function

     

       78
        
               | `List items -> List.map Role.t_of_yojson items

     

       79
       +
               | j -> raise (Json.Of_json ("Expected list for audience", j))

     

       80
        
             ) in

     

       81
        
             let priority = List.assoc_opt "priority" fields |> Option.map (function

     

       82
        
               | `Float f -> f

     

       83
       +
               | j -> raise (Json.Of_json ("Expected float for priority", j))

     

       84
        
             ) in

     

       85
        
             { audience; priority }

     

       86
       +
           | j -> raise (Json.Of_json ("Expected object for annotation", j))

     

       87
        
       

     

       88
        
         let yojson_of_t { annotations } =

     

       89
        
           match annotations with

     
···

       94
        
           | `Assoc fields ->

     

       95
        
             let annotations = List.assoc_opt "annotations" fields |> Option.map annotation_of_yojson in

     

       96
        
             { annotations }

     

       97
       +
           | j -> raise (Json.Of_json ("Expected object for Annotated", j))

     

       98
        
       end

     

       99
        
       

     

       100
        
       (* Content types *)

     
···

       117
        
           `Assoc assoc

     

       118
        
       

     

       119
        
         let t_of_yojson = function

     

       120
       +
           | `Assoc fields ->

     

       121
       +
             let text = match List.assoc_opt "text" fields with

     

       122
       +
               | Some (`String s) -> s

     

       123
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'text' field", `Assoc fields))

     

       124
       +
             in

     

       125
       +
             let _ = match List.assoc_opt "type" fields with

     

       126
       +
               | Some (`String "text") -> ()

     

       127
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'type' field", `Assoc fields))

     

       128
       +
             in

     

       129
        
             let annotations = List.assoc_opt "annotations" fields |> Option.map Annotated.annotation_of_yojson in

     

       130
        
             { text; annotations }

     

       131
       +
           | j -> raise (Json.Of_json ("Expected object for TextContent", j))

     

       132
        
       end

     

       133
        
       

     

       134
        
       module ImageContent = struct

     
···

       140
        
       

     

       141
        
         let yojson_of_t { data; mime_type; annotations } =

     

       142
        
           let assoc = [

     

       0
        
       
     

       143
        
             ("data", `String data);

     

       144
        
             ("mimeType", `String mime_type);

     

       145
       +
             ("type", `String "image");

     

       146
        
           ] in

     

       147
        
           let assoc = match annotations with

     

       148
        
             | Some annotations -> ("annotations", Annotated.yojson_of_annotation annotations) :: assoc

     
···

       151
        
           `Assoc assoc

     

       152
        
       

     

       153
        
         let t_of_yojson = function

     

       154
       +
           | `Assoc fields ->

     

       155
       +
             let data = match List.assoc_opt "data" fields with

     

       156
       +
               | Some (`String s) -> s

     

       157
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'data' field", `Assoc fields))

     

       158
       +
             in

     

       159
       +
             let mime_type = match List.assoc_opt "mimeType" fields with

     

       160
       +
               | Some (`String s) -> s

     

       161
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'mimeType' field", `Assoc fields))

     

       162
       +
             in

     

       163
       +
             let _ = match List.assoc_opt "type" fields with

     

       164
       +
               | Some (`String "image") -> ()

     

       165
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'type' field", `Assoc fields))

     

       166
       +
             in

     

       167
        
             let annotations = List.assoc_opt "annotations" fields |> Option.map Annotated.annotation_of_yojson in

     

       168
        
             { data; mime_type; annotations }

     

       169
       +
           | j -> raise (Json.Of_json ("Expected object for ImageContent", j))

     

       170
        
       end

     

       171
        
       

     

       172
        
       module AudioContent = struct

     
···

       178
        
       

     

       179
        
         let yojson_of_t { data; mime_type; annotations } =

     

       180
        
           let assoc = [

     

       0
        
       
     

       181
        
             ("data", `String data);

     

       182
        
             ("mimeType", `String mime_type);

     

       183
       +
             ("type", `String "audio");

     

       184
        
           ] in

     

       185
        
           let assoc = match annotations with

     

       186
        
             | Some annotations -> ("annotations", Annotated.yojson_of_annotation annotations) :: assoc

     
···

       189
        
           `Assoc assoc

     

       190
        
       

     

       191
        
         let t_of_yojson = function

     

       192
       +
           | `Assoc fields ->

     

       193
       +
             let data = match List.assoc_opt "data" fields with

     

       194
       +
               | Some (`String s) -> s

     

       195
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'data' field", `Assoc fields))

     

       196
       +
             in

     

       197
       +
             let mime_type = match List.assoc_opt "mimeType" fields with

     

       198
       +
               | Some (`String s) -> s

     

       199
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'mimeType' field", `Assoc fields))

     

       200
       +
             in

     

       201
       +
             let _ = match List.assoc_opt "type" fields with

     

       202
       +
               | Some (`String "audio") -> ()

     

       203
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'type' field", `Assoc fields))

     

       204
       +
             in

     

       205
        
             let annotations = List.assoc_opt "annotations" fields |> Option.map Annotated.annotation_of_yojson in

     

       206
        
             { data; mime_type; annotations }

     

       207
       +
           | j -> raise (Json.Of_json ("Expected object for AudioContent", j))

     

       208
        
       end

     

       209
        
       

     

       210
        
       module ResourceContents = struct

     
···

       224
        
           `Assoc assoc

     

       225
        
       

     

       226
        
         let t_of_yojson = function

     

       227
       +
           | `Assoc fields ->

     

       228
       +
             let uri = match List.assoc_opt "uri" fields with

     

       229
       +
               | Some (`String s) -> s

     

       230
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'uri' field", `Assoc fields))

     

       231
       +
             in

     

       232
       +
             let mime_type = List.assoc_opt "mimeType" fields |> Option.map (function

     

       233
       +
               | `String s -> s

     

       234
       +
               | j -> raise (Json.Of_json ("Expected string for mimeType", j))

     

       235
       +
             ) in

     

       236
        
             { uri; mime_type }

     

       237
       +
           | j -> raise (Json.Of_json ("Expected object for ResourceContents", j))

     

       238
        
       end

     

       239
        
       

     

       240
        
       module TextResourceContents = struct

     
···

       256
        
           `Assoc assoc

     

       257
        
       

     

       258
        
         let t_of_yojson = function

     

       259
       +
           | `Assoc fields ->

     

       260
       +
             let uri = match List.assoc_opt "uri" fields with

     

       261
       +
               | Some (`String s) -> s

     

       262
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'uri' field", `Assoc fields))

     

       263
       +
             in

     

       264
       +
             let text = match List.assoc_opt "text" fields with

     

       265
       +
               | Some (`String s) -> s

     

       266
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'text' field", `Assoc fields))

     

       267
       +
             in

     

       268
       +
             let mime_type = List.assoc_opt "mimeType" fields |> Option.map (function

     

       269
       +
               | `String s -> s

     

       270
       +
               | j -> raise (Json.Of_json ("Expected string for mimeType", j))

     

       271
       +
             ) in

     

       272
        
             { uri; text; mime_type }

     

       273
       +
           | j -> raise (Json.Of_json ("Expected object for TextResourceContents", j))

     

       274
        
       end

     

       275
        
       

     

       276
        
       module BlobResourceContents = struct

     
···

       292
        
           `Assoc assoc

     

       293
        
       

     

       294
        
         let t_of_yojson = function

     

       295
       +
           | `Assoc fields ->

     

       296
       +
             let uri = match List.assoc_opt "uri" fields with

     

       297
       +
               | Some (`String s) -> s

     

       298
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'uri' field", `Assoc fields))

     

       299
       +
             in

     

       300
       +
             let blob = match List.assoc_opt "blob" fields with

     

       301
       +
               | Some (`String s) -> s

     

       302
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'blob' field", `Assoc fields))

     

       303
       +
             in

     

       304
       +
             let mime_type = List.assoc_opt "mimeType" fields |> Option.map (function

     

       305
       +
               | `String s -> s

     

       306
       +
               | j -> raise (Json.Of_json ("Expected string for mimeType", j))

     

       307
       +
             ) in

     

       308
        
             { uri; blob; mime_type }

     

       309
       +
           | j -> raise (Json.Of_json ("Expected object for BlobResourceContents", j))

     

       310
        
       end

     

       311
        
       

     

       312
        
       module EmbeddedResource = struct

     
···

       331
        
           `Assoc assoc

     

       332
        
       

     

       333
        
         let t_of_yojson = function

     

       334
       +
           | `Assoc fields ->

     

       335
       +
             let _ = match List.assoc_opt "type" fields with

     

       336
       +
               | Some (`String "resource") -> ()

     

       337
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'type' field", `Assoc fields))

     

       0
        
       
     

       338
        
             in

     

       339
       +
             let resource = match List.assoc_opt "resource" fields with

     

       340
       +
               | Some (`Assoc res_fields) ->

     

       341
       +
                 if List.mem_assoc "text" res_fields then

     

       342
       +
                   `Text (TextResourceContents.t_of_yojson (`Assoc res_fields))

     

       343
       +
                 else if List.mem_assoc "blob" res_fields then

     

       344
       +
                   `Blob (BlobResourceContents.t_of_yojson (`Assoc res_fields))

     

       345
       +
                 else

     

       346
       +
                   raise (Json.Of_json ("Invalid resource content", `Assoc res_fields))

     

       347
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'resource' field", `Assoc fields))

     

       348
        
             in

     

       349
        
             let annotations = List.assoc_opt "annotations" fields |> Option.map Annotated.annotation_of_yojson in

     

       350
        
             { resource; annotations }

     

       351
       +
           | j -> raise (Json.Of_json ("Expected object for EmbeddedResource", j))

     

       352
       +
       end

     

       353
       +
       

     

       354
       +
       (** Tool definition *)

     

       355
       +
       module Tool = struct

     

       356
       +
         type t = {

     

       357
       +
           name: string;

     

       358
       +
           description: string option;

     

       359
       +
           input_schema: Json.t;

     

       360
       +
         }

     

       361
       +
       

     

       362
       +
         let yojson_of_t { name; description; input_schema } =

     

       363
       +
           let assoc = [

     

       364
       +
             ("name", `String name);

     

       365
       +
             ("inputSchema", input_schema);

     

       366
       +
           ] in

     

       367
       +
           let assoc = match description with

     

       368
       +
             | Some desc -> ("description", `String desc) :: assoc

     

       369
       +
             | None -> assoc

     

       370
       +
           in

     

       371
       +
           `Assoc assoc

     

       372
       +
       

     

       373
       +
         let t_of_yojson = function

     

       374
       +
           | `Assoc fields ->

     

       375
       +
             let name = match List.assoc_opt "name" fields with

     

       376
       +
               | Some (`String s) -> s

     

       377
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'name' field", `Assoc fields))

     

       378
       +
             in

     

       379
       +
             let description = match List.assoc_opt "description" fields with

     

       380
       +
               | Some (`String s) -> Some s

     

       381
       +
               | _ -> None

     

       382
       +
             in

     

       383
       +
             let input_schema = match List.assoc_opt "inputSchema" fields with

     

       384
       +
               | Some json -> json

     

       385
       +
               | _ -> raise (Json.Of_json ("Missing 'inputSchema' field", `Assoc fields))

     

       386
       +
             in

     

       387
       +
             { name; description; input_schema }

     

       388
       +
           | j -> raise (Json.Of_json ("Expected object for Tool", j))

     

       389
        
       end

     

       390
        
       

     

       391
        
       type content = 

     
···

       401
        
         | Resource r -> EmbeddedResource.yojson_of_t r

     

       402
        
       

     

       403
        
       let content_of_yojson = function

     

       404
       +
         | `Assoc fields ->

     

       405
        
           (match List.assoc_opt "type" fields with

     

       406
       +
            | Some (`String "text") -> Text (TextContent.t_of_yojson (`Assoc fields))

     

       407
       +
            | Some (`String "image") -> Image (ImageContent.t_of_yojson (`Assoc fields))

     

       408
       +
            | Some (`String "audio") -> Audio (AudioContent.t_of_yojson (`Assoc fields))

     

       409
       +
            | Some (`String "resource") -> Resource (EmbeddedResource.t_of_yojson (`Assoc fields))

     

       410
       +
            | _ -> raise (Json.Of_json ("Invalid or missing content type", `Assoc fields)))

     

       411
       +
         | j -> raise (Json.Of_json ("Expected object for content", j))

     

       412
       +
       

     

       413
       +
       (** Tool result *)

     

       414
       +
       module CallToolResult = struct

     

       415
       +
         type t = {

     

       416
       +
           content: content list;

     

       417
       +
           is_error: bool;

     

       418
       +
           meta: Json.t option;

     

       419
       +
         }

     

       420
       +
       

     

       421
       +
         let yojson_of_t { content; is_error; meta } =

     

       422
       +
           let assoc = [

     

       423
       +
             ("content", `List (List.map yojson_of_content content));

     

       424
       +
             ("isError", `Bool is_error);

     

       425
       +
           ] in

     

       426
       +
           let assoc = match meta with

     

       427
       +
             | Some meta_json -> ("_meta", meta_json) :: assoc

     

       428
       +
             | None -> assoc

     

       429
       +
           in

     

       430
       +
           `Assoc assoc

     

       431
       +
       

     

       432
       +
         let t_of_yojson = function

     

       433
       +
           | `Assoc fields ->

     

       434
       +
             let content = match List.assoc_opt "content" fields with

     

       435
       +
               | Some (`List items) -> List.map content_of_yojson items

     

       436
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'content' field", `Assoc fields))

     

       437
       +
             in

     

       438
       +
             let is_error = match List.assoc_opt "isError" fields with

     

       439
       +
               | Some (`Bool b) -> b

     

       440
       +
               | None -> false (* Default to false if not specified *)

     

       441
       +
               | _ -> raise (Json.Of_json ("Invalid 'isError' field", `Assoc fields))

     

       442
       +
             in

     

       443
       +
             let meta = List.assoc_opt "_meta" fields in

     

       444
       +
             { content; is_error; meta }

     

       445
       +
           | j -> raise (Json.Of_json ("Expected object for CallToolResult", j))

     

       446
       +
       end

     

       447
       +
       

     

       448
       +
       (** Resource definition *)

     

       449
       +
       module Resource = struct

     

       450
       +
         type t = {

     

       451
       +
           name: string;

     

       452
       +
           uri: string;

     

       453
       +
           description: string option;

     

       454
       +
           mime_type: string option;

     

       455
       +
           size: int option;

     

       456
       +
           annotations: Annotated.annotation option;

     

       457
       +
         }

     

       458
       +
       

     

       459
       +
         let yojson_of_t { name; uri; description; mime_type; size; annotations } =

     

       460
       +
           let assoc = [

     

       461
       +
             ("name", `String name);

     

       462
       +
             ("uri", `String uri);

     

       463
       +
           ] in

     

       464
       +
           let assoc = match description with

     

       465
       +
             | Some desc -> ("description", `String desc) :: assoc

     

       466
       +
             | None -> assoc

     

       467
       +
           in

     

       468
       +
           let assoc = match mime_type with

     

       469
       +
             | Some mime -> ("mimeType", `String mime) :: assoc

     

       470
       +
             | None -> assoc

     

       471
       +
           in

     

       472
       +
           let assoc = match size with

     

       473
       +
             | Some s -> ("size", `Int s) :: assoc

     

       474
       +
             | None -> assoc

     

       475
       +
           in

     

       476
       +
           let assoc = match annotations with

     

       477
       +
             | Some ann -> ("annotations", Annotated.yojson_of_annotation ann) :: assoc

     

       478
       +
             | None -> assoc

     

       479
       +
           in

     

       480
       +
           `Assoc assoc

     

       481
       +
       

     

       482
       +
         let t_of_yojson = function

     

       483
       +
           | `Assoc fields ->

     

       484
       +
             let name = match List.assoc_opt "name" fields with

     

       485
       +
               | Some (`String s) -> s

     

       486
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'name' field", `Assoc fields))

     

       487
       +
             in

     

       488
       +
             let uri = match List.assoc_opt "uri" fields with

     

       489
       +
               | Some (`String s) -> s

     

       490
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'uri' field", `Assoc fields))

     

       491
       +
             in

     

       492
       +
             let description = match List.assoc_opt "description" fields with

     

       493
       +
               | Some (`String s) -> Some s

     

       494
       +
               | _ -> None

     

       495
       +
             in

     

       496
       +
             let mime_type = match List.assoc_opt "mimeType" fields with

     

       497
       +
               | Some (`String s) -> Some s

     

       498
       +
               | _ -> None

     

       499
       +
             in

     

       500
       +
             let size = match List.assoc_opt "size" fields with

     

       501
       +
               | Some (`Int s) -> Some s

     

       502
       +
               | _ -> None

     

       503
       +
             in

     

       504
       +
             let annotations = match List.assoc_opt "annotations" fields with

     

       505
       +
               | Some json -> Some (Annotated.annotation_of_yojson json)

     

       506
       +
               | _ -> None

     

       507
       +
             in

     

       508
       +
             { name; uri; description; mime_type; size; annotations }

     

       509
       +
           | j -> raise (Json.Of_json ("Expected object for Resource", j))

     

       510
       +
       end

     

       511
       +
       

     

       512
       +
       (** Resource Template definition *)

     

       513
       +
       module ResourceTemplate = struct

     

       514
       +
         type t = {

     

       515
       +
           name: string;

     

       516
       +
           uri_template: string;

     

       517
       +
           description: string option;

     

       518
       +
           mime_type: string option;

     

       519
       +
           annotations: Annotated.annotation option;

     

       520
       +
         }

     

       521
       +
       

     

       522
       +
         let yojson_of_t { name; uri_template; description; mime_type; annotations } =

     

       523
       +
           let assoc = [

     

       524
       +
             ("name", `String name);

     

       525
       +
             ("uriTemplate", `String uri_template);

     

       526
       +
           ] in

     

       527
       +
           let assoc = match description with

     

       528
       +
             | Some desc -> ("description", `String desc) :: assoc

     

       529
       +
             | None -> assoc

     

       530
       +
           in

     

       531
       +
           let assoc = match mime_type with

     

       532
       +
             | Some mime -> ("mimeType", `String mime) :: assoc

     

       533
       +
             | None -> assoc

     

       534
       +
           in

     

       535
       +
           let assoc = match annotations with

     

       536
       +
             | Some ann -> ("annotations", Annotated.yojson_of_annotation ann) :: assoc

     

       537
       +
             | None -> assoc

     

       538
       +
           in

     

       539
       +
           `Assoc assoc

     

       540
       +
       

     

       541
       +
         let t_of_yojson = function

     

       542
       +
           | `Assoc fields ->

     

       543
       +
             let name = match List.assoc_opt "name" fields with

     

       544
       +
               | Some (`String s) -> s

     

       545
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'name' field", `Assoc fields))

     

       546
       +
             in

     

       547
       +
             let uri_template = match List.assoc_opt "uriTemplate" fields with

     

       548
       +
               | Some (`String s) -> s

     

       549
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'uriTemplate' field", `Assoc fields))

     

       550
       +
             in

     

       551
       +
             let description = match List.assoc_opt "description" fields with

     

       552
       +
               | Some (`String s) -> Some s

     

       553
       +
               | _ -> None

     

       554
       +
             in

     

       555
       +
             let mime_type = match List.assoc_opt "mimeType" fields with

     

       556
       +
               | Some (`String s) -> Some s

     

       557
       +
               | _ -> None

     

       558
       +
             in

     

       559
       +
             let annotations = match List.assoc_opt "annotations" fields with

     

       560
       +
               | Some json -> Some (Annotated.annotation_of_yojson json)

     

       561
       +
               | _ -> None

     

       562
       +
             in

     

       563
       +
             { name; uri_template; description; mime_type; annotations }

     

       564
       +
           | j -> raise (Json.Of_json ("Expected object for ResourceTemplate", j))

     

       565
       +
       end

     

       566
       +
       

     

       567
       +
       (** Resource Reference *)

     

       568
       +
       module ResourceReference = struct

     

       569
       +
         type t = {

     

       570
       +
           uri: string;

     

       571
       +
         }

     

       572
       +
       

     

       573
       +
         let yojson_of_t { uri } =

     

       574
       +
           `Assoc [

     

       575
       +
             ("type", `String "ref/resource");

     

       576
       +
             ("uri", `String uri);

     

       577
       +
           ]

     

       578
       +
       

     

       579
       +
         let t_of_yojson = function

     

       580
       +
           | `Assoc fields ->

     

       581
       +
             let _ = match List.assoc_opt "type" fields with

     

       582
       +
               | Some (`String "ref/resource") -> ()

     

       583
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'type' field", `Assoc fields))

     

       584
       +
             in

     

       585
       +
             let uri = match List.assoc_opt "uri" fields with

     

       586
       +
               | Some (`String s) -> s

     

       587
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'uri' field", `Assoc fields))

     

       588
       +
             in

     

       589
       +
             { uri }

     

       590
       +
           | j -> raise (Json.Of_json ("Expected object for ResourceReference", j))

     

       591
       +
       end

     

       592
       +
       

     

       593
       +
       (** Prompt Reference *)

     

       594
       +
       module PromptReference = struct

     

       595
       +
         type t = {

     

       596
       +
           name: string;

     

       597
       +
         }

     

       598
       +
       

     

       599
       +
         let yojson_of_t { name } =

     

       600
       +
           `Assoc [

     

       601
       +
             ("type", `String "ref/prompt");

     

       602
       +
             ("name", `String name);

     

       603
       +
           ]

     

       604
       +
       

     

       605
       +
         let t_of_yojson = function

     

       606
       +
           | `Assoc fields ->

     

       607
       +
             let _ = match List.assoc_opt "type" fields with

     

       608
       +
               | Some (`String "ref/prompt") -> ()

     

       609
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'type' field", `Assoc fields))

     

       610
       +
             in

     

       611
       +
             let name = match List.assoc_opt "name" fields with

     

       612
       +
               | Some (`String s) -> s

     

       613
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'name' field", `Assoc fields))

     

       614
       +
             in

     

       615
       +
             { name }

     

       616
       +
           | j -> raise (Json.Of_json ("Expected object for PromptReference", j))

     

       617
       +
       end

     

       618
       +
       

     

       619
       +
       (** Completion support *)

     

       620
       +
       module Completion = struct

     

       621
       +
         

     

       622
       +
         module Argument = struct

     

       623
       +
           type t = {

     

       624
       +
             name: string;

     

       625
       +
             value: string;

     

       626
       +
           }

     

       627
       +
       

     

       628
       +
           let yojson_of_t { name; value } =

     

       629
       +
             `Assoc [

     

       630
       +
               ("name", `String name);

     

       631
       +
               ("value", `String value);

     

       632
       +
             ]

     

       633
       +
       

     

       634
       +
           let t_of_yojson = function

     

       635
       +
             | `Assoc fields ->

     

       636
       +
               let name = match List.assoc_opt "name" fields with

     

       637
       +
                 | Some (`String s) -> s

     

       638
       +
                 | _ -> raise (Json.Of_json ("Missing or invalid 'name' field", `Assoc fields))

     

       639
       +
               in

     

       640
       +
               let value = match List.assoc_opt "value" fields with

     

       641
       +
                 | Some (`String s) -> s

     

       642
       +
                 | _ -> raise (Json.Of_json ("Missing or invalid 'value' field", `Assoc fields))

     

       643
       +
               in

     

       644
       +
               { name; value }

     

       645
       +
             | j -> raise (Json.Of_json ("Expected object for Completion.Argument", j))

     

       646
       +
         end

     

       647
       +
       

     

       648
       +
         module Request = struct

     

       649
       +
           type reference = [ `Prompt of PromptReference.t | `Resource of ResourceReference.t ]

     

       650
       +
       

     

       651
       +
           type t = {

     

       652
       +
             argument: Argument.t;

     

       653
       +
             ref: reference;

     

       654
       +
           }

     

       655
       +
       

     

       656
       +
           let yojson_of_reference = function

     

       657
       +
             | `Prompt p -> PromptReference.yojson_of_t p

     

       658
       +
             | `Resource r -> ResourceReference.yojson_of_t r

     

       659
       +
       

     

       660
       +
           let reference_of_yojson = function

     

       661
       +
             | `Assoc fields ->

     

       662
       +
               (match List.assoc_opt "type" fields with

     

       663
       +
                | Some (`String "ref/prompt") -> `Prompt (PromptReference.t_of_yojson (`Assoc fields))

     

       664
       +
                | Some (`String "ref/resource") -> `Resource (ResourceReference.t_of_yojson (`Assoc fields))

     

       665
       +
                | _ -> raise (Json.Of_json ("Invalid or missing reference type", `Assoc fields)))

     

       666
       +
             | j -> raise (Json.Of_json ("Expected object for reference", j))

     

       667
       +
       

     

       668
       +
           let yojson_of_t { argument; ref } =

     

       669
       +
             `Assoc [

     

       670
       +
               ("argument", Argument.yojson_of_t argument);

     

       671
       +
               ("ref", yojson_of_reference ref);

     

       672
       +
             ]

     

       673
       +
       

     

       674
       +
           let t_of_yojson = function

     

       675
       +
             | `Assoc fields ->

     

       676
       +
               let argument = match List.assoc_opt "argument" fields with

     

       677
       +
                 | Some json -> Argument.t_of_yojson json

     

       678
       +
                 | _ -> raise (Json.Of_json ("Missing argument field", `Assoc fields))

     

       679
       +
               in

     

       680
       +
               let ref = match List.assoc_opt "ref" fields with

     

       681
       +
                 | Some json -> reference_of_yojson json

     

       682
       +
                 | _ -> raise (Json.Of_json ("Missing ref field", `Assoc fields))

     

       683
       +
               in

     

       684
       +
               { argument; ref }

     

       685
       +
             | j -> raise (Json.Of_json ("Expected object for Completion.Request", j))

     

       686
       +
       

     

       687
       +
           let create ~argument ~ref =

     

       688
       +
             { argument; ref }

     

       689
       +
       

     

       690
       +
           let to_params t =

     

       691
       +
             yojson_of_t t

     

       692
       +
         end

     

       693
       +
       

     

       694
       +
         module Result = struct

     

       695
       +
           type completion = {

     

       696
       +
             values: string list;

     

       697
       +
             has_more: bool option;

     

       698
       +
             total: int option;

     

       699
       +
           }

     

       700
       +
       

     

       701
       +
           type t = {

     

       702
       +
             completion: completion;

     

       703
       +
             meta: Json.t option;

     

       704
       +
           }

     

       705
       +
       

     

       706
       +
           let yojson_of_completion { values; has_more; total } =

     

       707
       +
             let assoc = [

     

       708
       +
               ("values", `List (List.map (fun s -> `String s) values));

     

       709
       +
             ] in

     

       710
       +
             let assoc = match has_more with

     

       711
       +
               | Some b -> ("hasMore", `Bool b) :: assoc

     

       712
       +
               | None -> assoc

     

       713
       +
             in

     

       714
       +
             let assoc = match total with

     

       715
       +
               | Some n -> ("total", `Int n) :: assoc

     

       716
       +
               | None -> assoc

     

       717
       +
             in

     

       718
       +
             `Assoc assoc

     

       719
       +
       

     

       720
       +
           let completion_of_yojson = function

     

       721
       +
             | `Assoc fields ->

     

       722
       +
               let values = match List.assoc_opt "values" fields with

     

       723
       +
                 | Some (`List items) -> 

     

       724
       +
                   List.map (function

     

       725
       +
                     | `String s -> s

     

       726
       +
                     | _ -> raise (Json.Of_json ("Expected string in values array", `List items))

     

       727
       +
                   ) items

     

       728
       +
                 | _ -> raise (Json.Of_json ("Missing or invalid 'values' field", `Assoc fields))

     

       729
       +
               in

     

       730
       +
               let has_more = match List.assoc_opt "hasMore" fields with

     

       731
       +
                 | Some (`Bool b) -> Some b

     

       732
       +
                 | None -> None

     

       733
       +
                 | _ -> raise (Json.Of_json ("Invalid 'hasMore' field", `Assoc fields))

     

       734
       +
               in

     

       735
       +
               let total = match List.assoc_opt "total" fields with

     

       736
       +
                 | Some (`Int n) -> Some n

     

       737
       +
                 | None -> None

     

       738
       +
                 | _ -> raise (Json.Of_json ("Invalid 'total' field", `Assoc fields))

     

       739
       +
               in

     

       740
       +
               { values; has_more; total }

     

       741
       +
             | j -> raise (Json.Of_json ("Expected object for completion", j))

     

       742
       +
       

     

       743
       +
           let yojson_of_t { completion; meta } =

     

       744
       +
             let assoc = [

     

       745
       +
               ("completion", yojson_of_completion completion);

     

       746
       +
             ] in

     

       747
       +
             let assoc = match meta with

     

       748
       +
               | Some meta_json -> ("_meta", meta_json) :: assoc

     

       749
       +
               | None -> assoc

     

       750
       +
             in

     

       751
       +
             `Assoc assoc

     

       752
       +
       

     

       753
       +
           let t_of_yojson = function

     

       754
       +
             | `Assoc fields ->

     

       755
       +
               let completion = match List.assoc_opt "completion" fields with

     

       756
       +
                 | Some json -> completion_of_yojson json

     

       757
       +
                 | _ -> raise (Json.Of_json ("Missing completion field", `Assoc fields))

     

       758
       +
               in

     

       759
       +
               let meta = List.assoc_opt "_meta" fields in

     

       760
       +
               { completion; meta }

     

       761
       +
             | j -> raise (Json.Of_json ("Expected object for Completion.Result", j))

     

       762
       +
       

     

       763
       +
           let create ~completion ?meta () =

     

       764
       +
             { completion; meta }

     

       765
       +
       

     

       766
       +
           let to_result t =

     

       767
       +
             yojson_of_t t

     

       768
       +
         end

     

       769
       +
       end

     

       770
        
       

     

       771
        
       (* Message types *)

     

       772
        
       

     
···

       783
        
           ]

     

       784
        
       

     

       785
        
         let t_of_yojson = function

     

       786
       +
           | `Assoc fields ->

     

       787
        
             let role = match List.assoc_opt "role" fields with

     

       788
        
               | Some json -> Role.t_of_yojson json

     

       789
       +
               | None -> raise (Json.Of_json ("Missing role field", `Assoc fields))

     

       790
        
             in

     

       791
        
             let content = match List.assoc_opt "content" fields with

     

       792
        
               | Some json -> content_of_yojson json

     

       793
       +
               | None -> raise (Json.Of_json ("Missing content field", `Assoc fields))

     

       794
        
             in

     

       795
        
             { role; content }

     

       796
       +
           | j -> raise (Json.Of_json ("Expected object for PromptMessage", j))

     

       797
        
       end

     

       798
        
       

     

       799
        
       module SamplingMessage = struct

     

       800
        
         type t = {

     

       801
        
           role: Role.t;

     

       802
       +
           content: [ `Text of TextContent.t | `Image of ImageContent.t ];

     

       803
        
         }

     

       804
        
       

     

       805
        
         let yojson_of_t { role; content } =

     

       806
        
           let content_json = match content with

     

       807
        
             | `Text t -> TextContent.yojson_of_t t

     

       808
        
             | `Image i -> ImageContent.yojson_of_t i

     

       0
        
       
     

       809
        
           in

     

       810
        
           `Assoc [

     

       811
        
             ("role", Role.yojson_of_t role);

     
···

       813
        
           ]

     

       814
        
       

     

       815
        
         let t_of_yojson = function

     

       816
       +
           | `Assoc fields ->

     

       817
        
             let role = match List.assoc_opt "role" fields with

     

       818
        
               | Some json -> Role.t_of_yojson json

     

       819
       +
               | None -> raise (Json.Of_json ("Missing role field", `Assoc fields))

     

       820
        
             in

     

       821
       +
             let content = match List.assoc_opt "content" fields with

     

       822
       +
               | Some (`Assoc content_fields) ->

     

       823
       +
                 (match List.assoc_opt "type" content_fields with

     

       824
       +
                  | Some (`String "text") -> `Text (TextContent.t_of_yojson (`Assoc content_fields))

     

       825
       +
                  | Some (`String "image") -> `Image (ImageContent.t_of_yojson (`Assoc content_fields))

     

       826
       +
                  | _ -> raise (Json.Of_json ("Invalid content type", `Assoc content_fields)))

     

       827
       +
               | _ -> raise (Json.Of_json ("Missing or invalid content field", `Assoc fields))

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       828
        
             in

     

       829
        
             { role; content }

     

       830
       +
           | j -> raise (Json.Of_json ("Expected object for SamplingMessage", j))

     

       831
        
       end

     

       832
        
       

     

       833
        
       (* Implementation info *)

     
···

       845
        
           ]

     

       846
        
       

     

       847
        
         let t_of_yojson = function

     

       848
       +
           | `Assoc fields ->

     

       849
       +
             let name = match List.assoc_opt "name" fields with

     

       850
       +
               | Some (`String s) -> s

     

       851
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'name' field", `Assoc fields))

     

       852
       +
             in

     

       853
       +
             let version = match List.assoc_opt "version" fields with

     

       854
       +
               | Some (`String s) -> s

     

       855
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'version' field", `Assoc fields))

     

       856
       +
             in

     

       857
        
             { name; version }

     

       858
       +
           | j -> raise (Json.Of_json ("Expected object for Implementation", j))

     

       859
        
       end

     

       860
        
       

     

       861
        
       (* JSONRPC Message types *)

     

       862
       +
       

     

       863
        
       

     

       864
        
       module JSONRPCMessage = struct

     

       865
        
         type notification = {

     

       866
       +
           method_: string;

     

       867
        
           params: Json.t option;

     

       868
        
         }

     

       869
        
       

     

       870
        
         type request = {

     

       871
        
           id: RequestId.t;

     

       872
       +
           method_: string;

     

       873
        
           params: Json.t option;

     

       874
        
           progress_token: ProgressToken.t option;

     

       875
        
         }

     
···

       895
        
         let yojson_of_notification (n: notification) =

     

       896
        
           let assoc = [

     

       897
        
             ("jsonrpc", `String "2.0");

     

       898
       +
             ("method", `String n.method_);

     

       899
        
           ] in

     

       900
        
           let assoc = match n.params with

     

       901
        
             | Some params -> ("params", params) :: assoc

     
···

       907
        
           let assoc = [

     

       908
        
             ("jsonrpc", `String "2.0");

     

       909
        
             ("id", Id.yojson_of_t r.id);

     

       910
       +
             ("method", `String r.method_);

     

       911
        
           ] in

     

       912
        
           let assoc = match r.params with

     

       913
        
             | Some params ->

     
···

       957
        
       

     

       958
        
         let notification_of_yojson = function

     

       959
        
           | `Assoc fields ->

     

       960
       +
             let method_ = match List.assoc_opt "method" fields with

     

       961
       +
               | Some (`String s) -> s

     

       962
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'method' field", `Assoc fields))

     

       0
        
       
     

       0
        
       
     

       963
        
             in

     

       964
        
             let params = List.assoc_opt "params" fields in

     

       965
       +
             { method_; params }

     

       966
       +
           | j -> raise (Json.Of_json ("Expected object for notification", j))

     

       967
        
       

     

       968
        
         let request_of_yojson = function

     

       969
        
           | `Assoc fields ->

     

       970
        
             let id = match List.assoc_opt "id" fields with

     

       971
        
               | Some id_json -> Id.t_of_yojson id_json

     

       972
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'id' field", `Assoc fields))

     

       973
        
             in

     

       974
       +
             let method_ = match List.assoc_opt "method" fields with

     

       975
       +
               | Some (`String s) -> s

     

       976
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'method' field", `Assoc fields))

     

       0
        
       
     

       0
        
       
     

       977
        
             in

     

       978
        
             let params = List.assoc_opt "params" fields in

     

       979
        
             let progress_token = 

     
···

       987
        
                  | _ -> None)

     

       988
        
               | _ -> None

     

       989
        
             in

     

       990
       +
             { id; method_; params; progress_token }

     

       991
       +
           | j -> raise (Json.Of_json ("Expected object for request", j))

     

       992
        
       

     

       993
        
         let response_of_yojson = function

     

       994
        
           | `Assoc fields ->

     

       995
        
             let id = match List.assoc_opt "id" fields with

     

       996
        
               | Some id_json -> Id.t_of_yojson id_json

     

       997
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'id' field", `Assoc fields))

     

       998
        
             in

     

       999
        
             let result = match List.assoc_opt "result" fields with

     

       1000
        
               | Some result -> result

     

       1001
       +
               | _ -> raise (Json.Of_json ("Missing 'result' field", `Assoc fields))

     

       1002
        
             in

     

       1003
        
             { id; result }

     

       1004
       +
           | j -> raise (Json.Of_json ("Expected object for response", j))

     

       1005
        
       

     

       1006
        
         let error_of_yojson = function

     

       1007
       +
           | `Assoc fields ->

     

       1008
        
             let id = match List.assoc_opt "id" fields with

     

       1009
        
               | Some id_json -> Id.t_of_yojson id_json

     

       1010
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'id' field", `Assoc fields))

     

       1011
        
             in

     

       1012
        
             let error = match List.assoc_opt "error" fields with

     

       1013
        
               | Some (`Assoc error_fields) -> error_fields

     

       1014
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'error' field", `Assoc fields))

     

       1015
        
             in

     

       1016
        
             let code = match List.assoc_opt "code" error with

     

       1017
        
               | Some (`Int code) -> code

     

       1018
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'code' field in error", `Assoc error))

     

       1019
        
             in

     

       1020
        
             let message = match List.assoc_opt "message" error with

     

       1021
        
               | Some (`String msg) -> msg

     

       1022
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'message' field in error", `Assoc error))

     

       1023
        
             in

     

       1024
        
             let data = List.assoc_opt "data" error in

     

       1025
        
             { id; code; message; data }

     

       1026
       +
           | j -> raise (Json.Of_json ("Expected object for error", j))

     

       1027
        
       

     

       1028
        
         let t_of_yojson json =

     

       1029
        
           match json with

     

       1030
        
           | `Assoc fields ->

     

       1031
        
             let _jsonrpc = match List.assoc_opt "jsonrpc" fields with

     

       1032
        
               | Some (`String "2.0") -> ()

     

       1033
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'jsonrpc' field", json))

     

       1034
        
             in

     

       1035
        
             if List.mem_assoc "method" fields then

     

       1036
        
               if List.mem_assoc "id" fields then

     
···

       1042
        
             else if List.mem_assoc "error" fields then

     

       1043
        
               Error (error_of_yojson json)

     

       1044
        
             else

     

       1045
       +
               raise (Json.Of_json ("Invalid JSONRPC message format", json))

     

       1046
       +
           | j -> raise (Json.Of_json ("Expected object for JSONRPC message", j))

     

       1047
        
       

     

       1048
       +
         let create_notification ?(params=None) ~method_ () =

     

       1049
       +
           Notification { method_; params }

     

       1050
        
       

     

       1051
       +
         let create_request ?(params=None) ?(progress_token=None) ~id ~method_ () =

     

       1052
       +
           Request { id; method_; params; progress_token }

     

       1053
        
       

     

       1054
        
         let create_response ~id ~result =

     

       1055
        
           Response { id; result }

     
···

       1076
        
             ]

     

       1077
        
       

     

       1078
        
           let t_of_yojson = function

     

       1079
       +
             | `Assoc fields ->

     

       1080
        
               let capabilities = match List.assoc_opt "capabilities" fields with

     

       1081
        
                 | Some json -> json

     

       1082
       +
                 | None -> raise (Json.Of_json ("Missing capabilities field", `Assoc fields))

     

       1083
        
               in

     

       1084
        
               let client_info = match List.assoc_opt "clientInfo" fields with

     

       1085
        
                 | Some json -> Implementation.t_of_yojson json

     

       1086
       +
                 | None -> raise (Json.Of_json ("Missing clientInfo field", `Assoc fields))

     

       1087
        
               in

     

       1088
       +
               let protocol_version = match List.assoc_opt "protocolVersion" fields with

     

       1089
       +
                 | Some (`String s) -> s

     

       1090
       +
                 | _ -> raise (Json.Of_json ("Missing or invalid protocolVersion field", `Assoc fields))

     

       1091
       +
               in

     

       1092
        
               { capabilities; client_info; protocol_version }

     

       1093
       +
             | j -> raise (Json.Of_json ("Expected object for InitializeRequest", j))

     

       1094
        
       

     

       1095
        
           let create ~capabilities ~client_info ~protocol_version =

     

       1096
        
             { capabilities; client_info; protocol_version }

     

       1097
        
       

     

       1098
        
           let to_jsonrpc ~id t =

     

       1099
        
             let params = yojson_of_t t in

     

       1100
       +
             JSONRPCMessage.create_request ~id ~method_:"initialize" ~params:(Some params) ()

     

       1101
        
         end

     

       1102
        
       

     

       1103
        
         module Result = struct

     
···

       1126
        
             `Assoc assoc

     

       1127
        
       

     

       1128
        
           let t_of_yojson = function

     

       1129
       +
             | `Assoc fields ->

     

       1130
        
               let capabilities = match List.assoc_opt "capabilities" fields with

     

       1131
        
                 | Some json -> json

     

       1132
       +
                 | None -> raise (Json.Of_json ("Missing capabilities field", `Assoc fields))

     

       1133
        
               in

     

       1134
        
               let server_info = match List.assoc_opt "serverInfo" fields with

     

       1135
        
                 | Some json -> Implementation.t_of_yojson json

     

       1136
       +
                 | None -> raise (Json.Of_json ("Missing serverInfo field", `Assoc fields))

     

       1137
        
               in

     

       1138
       +
               let protocol_version = match List.assoc_opt "protocolVersion" fields with

     

       1139
       +
                 | Some (`String s) -> s

     

       1140
       +
                 | _ -> raise (Json.Of_json ("Missing or invalid protocolVersion field", `Assoc fields))

     

       1141
       +
               in

     

       1142
       +
               let instructions = match List.assoc_opt "instructions" fields with

     

       1143
       +
                 | Some (`String s) -> Some s

     

       1144
       +
                 | _ -> None

     

       1145
       +
               in

     

       1146
        
               let meta = List.assoc_opt "_meta" fields in

     

       1147
        
               { capabilities; server_info; protocol_version; instructions; meta }

     

       1148
       +
             | j -> raise (Json.Of_json ("Expected object for InitializeResult", j))

     

       1149
        
       

     

       1150
        
           let create ~capabilities ~server_info ~protocol_version ?instructions ?meta () =

     

       1151
        
             { capabilities; server_info; protocol_version; instructions; meta }

     
···

       1173
        
             | `Assoc fields ->

     

       1174
        
               let meta = List.assoc_opt "_meta" fields in

     

       1175
        
               { meta }

     

       1176
       +
             | j -> raise (Json.Of_json ("Expected object for InitializedNotification", j))

     

       1177
        
       

     

       1178
        
           let create ?meta () = { meta }

     

       1179
        
       

     
···

       1182
        
               | `Assoc [] -> None

     

       1183
        
               | json -> Some json

     

       1184
        
             in

     

       1185
       +
             JSONRPCMessage.create_notification ~method_:"notifications/initialized" ~params ()

     

       1186
        
         end

     

       1187
        
       end

     

       0
        
       
     

       1188
        
       

     

       1189
        
       (* Export the main interface for using the MCP protocol *)

     

       1190
        
       

     

       1191
        
       let parse_message json =

     

       1192
        
         JSONRPCMessage.t_of_yojson json

     

       1193
        
       

     

       1194
       +
       let create_notification = JSONRPCMessage.create_notification

     

       1195
       +
       let create_request = JSONRPCMessage.create_request

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       1196
        
       let create_response = JSONRPCMessage.create_response

     

       1197
        
       let create_error = JSONRPCMessage.create_error

     

       1198
        
       

     

       1199
       +
       (* Helper functions *)

     

       1200
       +
       let create_completion_request ~id ~argument ~ref =

     

       1201
       +
         let params = Completion.Request.to_params { argument; ref } in

     

       1202
       +
         create_request ~id ~method_:"completion/complete" ~params:(Some params) ()

     

       1203
       +
         

     

       1204
       +
       let create_completion_response ~id ~values ?(has_more=None) ?(total=None) ?(meta=None) () =

     

       1205
       +
         let completion = { Completion.Result.values; has_more; total } in

     

       1206
       +
         let result = Completion.Result.to_result { completion; meta } in

     

       1207
       +
         create_response ~id ~result
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0

+219 -887

lib/mcp.mli

···

       1
       -
       (** MCP - Model Context Protocol implementation 

     

       2
       -
           

     

       3
       -
           The Model Context Protocol (MCP) is a standardized protocol for AI agents to exchange context

     

       4
       -
           with servers. This module provides the core OCaml implementation of MCP including

     

       5
       -
           all message types, content representations, and serialization functionality.

     

       6
       -
           

     

       7
       -
           MCP Architecture:

     

       8
       -
           - Uses JSON-RPC 2.0 as its underlying message format with UTF-8 encoding

     

       9
       -
           - Follows a client-server model where clients (often LLM-integrated applications) communicate with MCP servers

     

       10
       -
           - Supports multiple transport methods including stdio and streamable HTTP

     

       11
       -
           - Implements a three-phase connection lifecycle: initialization, operation, and shutdown

     

       12
       -
           - Provides capability negotiation during initialization to determine available features

     

       13
       -
           - Offers four primary context exchange mechanisms:

     

       14
       -
             1. Resources: Server-exposed data that provides context to language models

     

       15
       -
             2. Tools: Server-exposed functionality that can be invoked by language models

     

       16
       -
             3. Prompts: Server-defined templates for structuring interactions with models

     

       17
       -
             4. Sampling: Client-exposed ability to generate completions from LLMs

     

       18
       -
           - Supports multimodal content types: text, images, audio, and embedded resources

     

       19
       -
           - Includes standardized error handling with defined error codes

     

       20
       -
           

     

       21
       -
           This implementation follows Protocol Revision 2025-03-26.

     

       22
       -
       *)

     

       23
        
       

     

       24
        
       open Jsonrpc

     

       25
        
       

     

       26
       -
       (** Utility functions for JSON parsing *)

     

       27
       -
       module Util : sig

     

       28
       -
         (** Helper to raise a Json.Of_json exception with formatted message

     

       29
       -
             @param fmt Format string for the error message

     

       30
       -
             @param json JSON value to include in the exception

     

       31
       -
             @return Never returns, always raises an exception

     

       32
       -
             @raise Json.Of_json with the formatted message and JSON value

     

       33
       -
         *)

     

       34
       -
         val json_error : ('a, unit, string, 'b) format4 -> Json.t -> 'a

     

       35
       -
         

     

       36
       -
         (** Extract a string field from JSON object or raise an error 

     

       37
       -
             @param fields Assoc list of fields from JSON object

     

       38
       -
             @param name Field name to extract

     

       39
       -
             @param json Original JSON for error context

     

       40
       -
             @return The string value of the field

     

       41
       -
             @raise Json.Of_json if the field is missing or not a string

     

       42
       -
         *)

     

       43
       -
         val get_string_field : (string * Json.t) list -> string -> Json.t -> string

     

       44
       -
         

     

       45
       -
         (** Extract an optional string field from JSON object

     

       46
       -
             @param fields Assoc list of fields from JSON object

     

       47
       -
             @param name Field name to extract

     

       48
       -
             @return Some string if present and a string, None if missing

     

       49
       -
             @raise Json.Of_json if the field exists but is not a string

     

       50
       -
         *)

     

       51
       -
         val get_optional_string_field : (string * Json.t) list -> string -> string option

     

       52
       -
         

     

       53
       -
         (** Extract an int field from JSON object or raise an error

     

       54
       -
             @param fields Assoc list of fields from JSON object

     

       55
       -
             @param name Field name to extract

     

       56
       -
             @param json Original JSON for error context

     

       57
       -
             @return The int value of the field

     

       58
       -
             @raise Json.Of_json if the field is missing or not an int

     

       59
       -
         *)

     

       60
       -
         val get_int_field : (string * Json.t) list -> string -> Json.t -> int

     

       61
       -
         

     

       62
       -
         (** Extract a float field from JSON object or raise an error

     

       63
       -
             @param fields Assoc list of fields from JSON object

     

       64
       -
             @param name Field name to extract

     

       65
       -
             @param json Original JSON for error context

     

       66
       -
             @return The float value of the field

     

       67
       -
             @raise Json.Of_json if the field is missing or not a float

     

       68
       -
         *)

     

       69
       -
         val get_float_field : (string * Json.t) list -> string -> Json.t -> float

     

       70
       -
         

     

       71
       -
         (** Extract a boolean field from JSON object or raise an error

     

       72
       -
             @param fields Assoc list of fields from JSON object

     

       73
       -
             @param name Field name to extract

     

       74
       -
             @param json Original JSON for error context

     

       75
       -
             @return The boolean value of the field

     

       76
       -
             @raise Json.Of_json if the field is missing or not a boolean

     

       77
       -
         *)

     

       78
       -
         val get_bool_field : (string * Json.t) list -> string -> Json.t -> bool

     

       79
       -
         

     

       80
       -
         (** Extract an object field from JSON object or raise an error

     

       81
       -
             @param fields Assoc list of fields from JSON object

     

       82
       -
             @param name Field name to extract

     

       83
       -
             @param json Original JSON for error context

     

       84
       -
             @return The object as an assoc list

     

       85
       -
             @raise Json.Of_json if the field is missing or not an object

     

       86
       -
         *)

     

       87
       -
         val get_object_field : (string * Json.t) list -> string -> Json.t -> (string * Json.t) list

     

       88
       -
         

     

       89
       -
         (** Extract a list field from JSON object or raise an error

     

       90
       -
             @param fields Assoc list of fields from JSON object

     

       91
       -
             @param name Field name to extract

     

       92
       -
             @param json Original JSON for error context

     

       93
       -
             @return The list items

     

       94
       -
             @raise Json.Of_json if the field is missing or not a list

     

       95
       -
         *)

     

       96
       -
         val get_list_field : (string * Json.t) list -> string -> Json.t -> Json.t list

     

       97
       -
         

     

       98
       -
         (** Verify a specific string value in a field

     

       99
       -
             @param fields Assoc list of fields from JSON object

     

       100
       -
             @param name Field name to check

     

       101
       -
             @param expected_value The expected string value

     

       102
       -
             @param json Original JSON for error context

     

       103
       -
             @raise Json.Of_json if the field is missing or not equal to expected_value

     

       104
       -
         *)

     

       105
       -
         val verify_string_field : (string * Json.t) list -> string -> string -> Json.t -> unit

     

       106
       -
       end

     

       107
       -
       

     

       108
       -
       (** Error codes for JSON-RPC *)

     

       109
        
       module ErrorCode : sig

     

       110
       -
         (** Standard JSON-RPC error codes with MCP-specific additions *)

     

       111
       -
         type t = 

     

       112
       -
           | ParseError       (** -32700 - Invalid JSON *)

     

       113
       -
           | InvalidRequest   (** -32600 - Invalid JSON-RPC request *)

     

       114
       -
           | MethodNotFound   (** -32601 - Method not available *)

     

       115
       -
           | InvalidParams    (** -32602 - Invalid method parameters *)

     

       116
       -
           | InternalError    (** -32603 - Internal JSON-RPC error *)

     

       117
       -
           | ResourceNotFound (** -32002 - Custom MCP error: requested resource not found *)

     

       118
       -
           | AuthRequired     (** -32001 - Custom MCP error: authentication required *)

     

       119
       -
           | CustomError of int (** For any other error codes *)

     

       120
       -
         

     

       121
       -
         (** Convert the error code to its integer representation

     

       122
       -
             @param code The error code to convert

     

       123
       -
             @return The integer error code as defined in the JSON-RPC spec

     

       124
       -
         *)

     

       125
       -
         val to_int : t -> int

     

       126
       -
         

     

       127
       -
         (** Get error message for standard error codes

     

       128
       -
             @param code The error code to get message for

     

       129
       -
             @return A standard message for the error code

     

       130
       -
         *)

     

       131
       -
         val to_message : t -> string

     

       132
        
       end

     

       133
        
       

     

       134
       -
       (** MCP Protocol Methods - Algebraic data type representing all MCP methods *)

     

       135
       -
       module Method : sig

     

       136
       -
         (** Method type representing all MCP protocol methods *)

     

       137
       -
         type t =

     

       138
       -
           (* Initialization and lifecycle methods *)

     

       139
       -
           | Initialize      (** Start the MCP lifecycle *)

     

       140
       -
           | Initialized     (** Signal readiness after initialization *)

     

       141
       -
           

     

       142
       -
           (* Resource methods *)

     

       143
       -
           | ResourcesList           (** Discover available resources *)

     

       144
       -
           | ResourcesRead           (** Retrieve resource contents *)

     

       145
       -
           | ResourcesTemplatesList  (** List available resource templates *)

     

       146
       -
           | ResourcesSubscribe      (** Subscribe to resource changes *)

     

       147
       -
           | ResourcesListChanged    (** Resource list has changed *)

     

       148
       -
           | ResourcesUpdated        (** Resource has been updated *)

     

       149
       -
           

     

       150
       -
           (* Tool methods *)

     

       151
       -
           | ToolsList        (** Discover available tools *)

     

       152
       -
           | ToolsCall        (** Invoke a tool *)

     

       153
       -
           | ToolsListChanged (** Tool list has changed *)

     

       154
       -
           

     

       155
       -
           (* Prompt methods *)

     

       156
       -
           | PromptsList        (** Discover available prompts *)

     

       157
       -
           | PromptsGet         (** Retrieve a prompt template with arguments *)

     

       158
       -
           | PromptsListChanged (** Prompt list has changed *)

     

       159
       -
           

     

       160
       -
           (* Progress notifications *)

     

       161
       -
           | Progress         (** Progress update for long-running operations *)

     

       162
       -
         

     

       163
       -
         (** Convert method type to string representation

     

       164
       -
             @param meth The method to convert

     

       165
       -
             @return The string representation of the method (e.g., "initialize", "resources/list")

     

       166
       -
         *)

     

       167
       -
         val to_string : t -> string

     

       168
       -
         

     

       169
       -
         (** Convert string to method type

     

       170
       -
             @param s The string representation of the method

     

       171
       -
             @return The corresponding method type

     

       172
       -
             @raise Failure if the string is not a valid MCP method

     

       173
       -
         *)

     

       174
       -
         val of_string : string -> t

     

       175
       -
       end

     

       176
       -
       

     

       177
       -
       

     

       178
        
       (** Common types *)

     

       179
        
       

     

       180
        
       (** Roles for conversation participants *)

     

       181
        
       module Role : sig

     

       182
       -
         (** Role represents conversation participants in MCP messages.

     

       183
       -
             Roles can be either 'user' or 'assistant', determining the

     

       184
       -
             source of each message in a conversation. *)

     

       185
        
         type t = [ `User | `Assistant ]

     

       186
       -
         include Json.Jsonable.S with type t := t

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       187
        
       end

     

       188
        
       

     

       189
        
       (** Progress tokens for long-running operations *)

     

       190
        
       module ProgressToken : sig

     

       191
       -
         (** Progress tokens identify long-running operations and enable

     

       192
       -
             servers to provide progress updates to clients. This is used

     

       193
       -
             to track operations that may take significant time to complete. *)

     

       194
        
         type t = [ `String of string | `Int of int ]

     

       0
        
       
     

       195
        
         include Json.Jsonable.S with type t := t

     

       196
        
       end

     

       197
        
       

     

       198
        
       (** Request IDs *)

     

       199
        
       module RequestId : sig

     

       200
       -
         (** Request IDs uniquely identify JSON-RPC requests, allowing responses

     

       201
       -
             to be correlated with their originating requests. They can be either

     

       202
       -
             string or integer values. *)

     

       203
        
         type t = [ `String of string | `Int of int ]

     

       0
        
       
     

       204
        
         include Json.Jsonable.S with type t := t

     

       205
        
       end

     

       206
        
       

     

       207
        
       (** Cursors for pagination *)

     

       208
        
       module Cursor : sig

     

       209
       -
         (** Cursors enable pagination in list operations for resources, tools, and prompts.

     

       210
       -
             When a server has more items than can be returned in a single response,

     

       211
       -
             it provides a cursor for the client to retrieve subsequent pages. *)

     

       212
        
         type t = string

     

       213
       -
         include Json.Jsonable.S with type t := t

     

       0
        
       
     

       0
        
       
     

       214
        
       end

     

       215
        
       

     

       216
        
       (** Annotations for objects *)

     

       217
        
       module Annotated : sig

     

       218
       -
         (** Annotations provide metadata for content objects, allowing

     

       219
       -
             role-specific targeting and priority settings. *)

     

       220
        
         type t = {

     

       221
        
           annotations: annotation option;

     

       222
        
         }

     

       223
        
         and annotation = {

     

       224
        
           audience: Role.t list option;

     

       225
       -
           (** Optional list of roles that should receive this content *)

     

       226
        
           priority: float option;

     

       227
       -
           (** Optional priority value for this content *)

     

       228
        
         }

     

       229
       -
         include Json.Jsonable.S with type t := t

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       230
        
       end

     

       231
        
       

     

       232
       -
       (** Text content - Core textual message representation in MCP *)

     

       233
        
       module TextContent : sig

     

       234
       -
         (** TextContent represents plain text messages in MCP conversations.

     

       235
       -
             This is the most common content type used for natural language interactions 

     

       236
       -
             between users and assistants. Text content is used in prompts, tool results,

     

       237
       -
             and model responses.

     

       238
       -
             

     

       239
       -
             In JSON-RPC, this is represented as:

     

       240
       -
             {v

     

       241
       -
             {

     

       242
       -
               "type": "text",

     

       243
       -
               "text": "The text content of the message"

     

       244
       -
             }

     

       245
       -
             v}

     

       246
       -
             

     

       247
       -
             For security, implementations must sanitize text content to prevent

     

       248
       -
             injection attacks or unauthorized access to resources. *)

     

       249
        
         type t = {

     

       250
        
           text: string;

     

       251
       -
           (** The actual text content as a UTF-8 encoded string *)

     

       252
        
           annotations: Annotated.annotation option;

     

       253
       -
           (** Optional annotations for audience targeting and priority.

     

       254
       -
               Annotations can restrict content visibility to specific roles (user/assistant)

     

       255
       -
               and indicate relative importance of different content elements. *)

     

       256
        
         }

     

       257
       -
         include Json.Jsonable.S with type t := t

     

       0
        
       
     

       0
        
       
     

       258
        
       end

     

       259
        
       

     

       260
       -
       (** Image content - Visual data representation in MCP *)

     

       261
        
       module ImageContent : sig

     

       262
       -
         (** ImageContent enables including visual information in MCP messages,

     

       263
       -
             supporting multimodal interactions where visual context is important.

     

       264
       -
             

     

       265
       -
             Images can be used in several scenarios:

     

       266
       -
             - As user inputs for visual understanding tasks

     

       267
       -
             - As context for generating descriptions or analysis

     

       268
       -
             - As outputs from tools that generate visualizations

     

       269
       -
             - As part of prompt templates with visual components

     

       270
       -
             

     

       271
       -
             In JSON-RPC, this is represented as:

     

       272
       -
             {v

     

       273
       -
             {

     

       274
       -
               "type": "image",

     

       275
       -
               "data": "base64-encoded-image-data",

     

       276
       -
               "mimeType": "image/png"

     

       277
       -
             }

     

       278
       -
             v}

     

       279
       -
             

     

       280
       -
             The data MUST be base64-encoded to ensure safe transmission in JSON.

     

       281
       -
             Common mime types include image/png, image/jpeg, image/gif, and image/svg+xml. *)

     

       282
        
         type t = {

     

       283
        
           data: string;

     

       284
       -
           (** Base64-encoded image data. All binary image data must be encoded using

     

       285
       -
               standard base64 encoding (RFC 4648) to safely transmit within JSON. *)

     

       286
        
           mime_type: string;

     

       287
       -
           (** MIME type of the image (e.g., "image/png", "image/jpeg", "image/gif", "image/svg+xml").

     

       288
       -
               This field is required and must accurately represent the image format to ensure

     

       289
       -
               proper handling by clients. *)

     

       290
        
           annotations: Annotated.annotation option;

     

       291
       -
           (** Optional annotations for audience targeting and priority.

     

       292
       -
               Annotations can restrict content visibility to specific roles (user/assistant)

     

       293
       -
               and indicate relative importance of different content elements. *)

     

       294
        
         }

     

       295
       -
         include Json.Jsonable.S with type t := t

     

       0
        
       
     

       0
        
       
     

       296
        
       end

     

       297
        
       

     

       298
       -
       (** Audio content - Sound data representation in MCP *)

     

       299
        
       module AudioContent : sig

     

       300
       -
         (** AudioContent enables including audio information in MCP messages,

     

       301
       -
             supporting multimodal interactions where audio context is important.

     

       302
       -
             

     

       303
       -
             Audio can be used in several scenarios:

     

       304
       -
             - As user inputs for speech recognition or audio analysis

     

       305
       -
             - As context for transcription or sound classification tasks

     

       306
       -
             - As outputs from tools that generate audio samples

     

       307
       -
             - As part of prompt templates with audio components

     

       308
       -
             

     

       309
       -
             In JSON-RPC, this is represented as:

     

       310
       -
             {v

     

       311
       -
             {

     

       312
       -
               "type": "audio",

     

       313
       -
               "data": "base64-encoded-audio-data",

     

       314
       -
               "mimeType": "audio/wav"

     

       315
       -
             }

     

       316
       -
             v}

     

       317
       -
             

     

       318
       -
             The data MUST be base64-encoded to ensure safe transmission in JSON.

     

       319
       -
             Common mime types include audio/wav, audio/mp3, audio/ogg, and audio/mpeg. *)

     

       320
        
         type t = {

     

       321
        
           data: string;

     

       322
       -
           (** Base64-encoded audio data. All binary audio data must be encoded using

     

       323
       -
               standard base64 encoding (RFC 4648) to safely transmit within JSON. *)

     

       324
        
           mime_type: string;

     

       325
       -
           (** MIME type of the audio (e.g., "audio/wav", "audio/mp3", "audio/ogg", "audio/mpeg").

     

       326
       -
               This field is required and must accurately represent the audio format to ensure

     

       327
       -
               proper handling by clients. *)

     

       328
        
           annotations: Annotated.annotation option;

     

       329
       -
           (** Optional annotations for audience targeting and priority.

     

       330
       -
               Annotations can restrict content visibility to specific roles (user/assistant)

     

       331
       -
               and indicate relative importance of different content elements. *)

     

       332
        
         }

     

       333
       -
         include Json.Jsonable.S with type t := t

     

       0
        
       
     

       0
        
       
     

       334
        
       end

     

       335
        
       

     

       336
       -
       (** Base resource contents - Core resource metadata in MCP *)

     

       337
        
       module ResourceContents : sig

     

       338
       -
         (** ResourceContents provides basic metadata for resources in MCP.

     

       339
       -
             

     

       340
       -
             Resources are server-exposed data that provides context to language models,

     

       341
       -
             such as files, database schemas, or application-specific information.

     

       342
       -
             Each resource is uniquely identified by a URI.

     

       343
       -
             

     

       344
       -
             The MCP resources architecture is designed to be application-driven, with

     

       345
       -
             host applications determining how to incorporate context based on their needs.

     

       346
       -
             

     

       347
       -
             In the protocol, resources are discovered via the 'resources/list' endpoint

     

       348
       -
             and retrieved via the 'resources/read' endpoint. Servers that support resources

     

       349
       -
             must declare the 'resources' capability during initialization. *)

     

       350
        
         type t = {

     

       351
        
           uri: string;

     

       352
       -
           (** URI that uniquely identifies the resource.

     

       353
       -
               

     

       354
       -
               Resources use standard URI schemes including:

     

       355
       -
               - file:// - For filesystem-like resources

     

       356
       -
               - https:// - For web-accessible resources

     

       357
       -
               - git:// - For version control integration

     

       358
       -
               

     

       359
       -
               The URI serves as a stable identifier even if the underlying content changes. *)

     

       360
        
           mime_type: string option;

     

       361
       -
           (** Optional MIME type of the resource content to aid in client rendering.

     

       362
       -
               Common MIME types include text/plain, application/json, image/png, etc.

     

       363
       -
               For directories, the XDG MIME type inode/directory may be used. *)

     

       364
        
         }

     

       365
       -
         include Json.Jsonable.S with type t := t

     

       0
        
       
     

       0
        
       
     

       366
        
       end

     

       367
        
       

     

       368
       -
       (** Text resource contents - Textual resource data *)

     

       369
        
       module TextResourceContents : sig

     

       370
       -
         (** TextResourceContents represents a text-based resource in MCP.

     

       371
       -
             

     

       372
       -
             Text resources are used for sharing code snippets, documentation, logs,

     

       373
       -
             configuration files, and other textual information with language models.

     

       374
       -
             

     

       375
       -
             The server handles access control and security, ensuring that only

     

       376
       -
             authorized resources are shared with clients.

     

       377
       -
             

     

       378
       -
             In JSON-RPC, this is represented as:

     

       379
       -
             {v

     

       380
       -
             {

     

       381
       -
               "uri": "file:///example.txt",

     

       382
       -
               "mimeType": "text/plain",

     

       383
       -
               "text": "Resource content"

     

       384
       -
             }

     

       385
       -
             v}

     

       386
       -
             *)

     

       387
        
         type t = {

     

       388
        
           uri: string;

     

       389
       -
           (** URI that uniquely identifies the resource.

     

       390
       -
               This URI can be referenced in subsequent requests to fetch updates. *)

     

       391
        
           text: string;

     

       392
       -
           (** The actual text content of the resource as a UTF-8 encoded string.

     

       393
       -
               This may be sanitized by the server to remove sensitive information. *)

     

       394
        
           mime_type: string option;

     

       395
       -
           (** Optional MIME type of the text content to aid in client rendering.

     

       396
       -
               Common text MIME types include: text/plain, text/markdown, text/x-python, 

     

       397
       -
               application/json, text/html, text/csv, etc. *)

     

       398
        
         }

     

       399
       -
         include Json.Jsonable.S with type t := t

     

       0
        
       
     

       0
        
       
     

       400
        
       end

     

       401
        
       

     

       402
       -
       (** Binary resource contents - Binary resource data *)

     

       403
        
       module BlobResourceContents : sig

     

       404
       -
         (** BlobResourceContents represents a binary resource in MCP.

     

       405
       -
             

     

       406
       -
             Binary resources allow sharing non-textual data like images, audio files,

     

       407
       -
             PDFs, and other binary formats with language models that support processing

     

       408
       -
             such content.

     

       409
       -
             

     

       410
       -
             In JSON-RPC, this is represented as:

     

       411
       -
             {v

     

       412
       -
             {

     

       413
       -
               "uri": "file:///example.png",

     

       414
       -
               "mimeType": "image/png",

     

       415
       -
               "blob": "base64-encoded-data"

     

       416
       -
             }

     

       417
       -
             v}

     

       418
       -
             

     

       419
       -
             Binary data MUST be properly base64-encoded to ensure safe transmission

     

       420
       -
             in JSON payloads. *)

     

       421
        
         type t = {

     

       422
        
           uri: string;

     

       423
       -
           (** URI that uniquely identifies the resource.

     

       424
       -
               This URI can be referenced in subsequent requests to fetch updates. *)

     

       425
        
           blob: string;

     

       426
       -
           (** Base64-encoded binary data using standard base64 encoding (RFC 4648).

     

       427
       -
               This encoding ensures that binary data can be safely transmitted in JSON. *)

     

       428
        
           mime_type: string option;

     

       429
       -
           (** Optional MIME type of the binary content to aid in client rendering.

     

       430
       -
               Common binary MIME types include: image/png, image/jpeg, application/pdf, 

     

       431
       -
               audio/wav, video/mp4, application/octet-stream, etc. *)

     

       432
        
         }

     

       433
       -
         include Json.Jsonable.S with type t := t

     

       0
        
       
     

       0
        
       
     

       434
        
       end

     

       435
        
       

     

       436
       -
       (** Embedded resource - Resource included directly in messages *)

     

       437
        
       module EmbeddedResource : sig

     

       438
       -
         (** EmbeddedResource allows referencing server-side resources directly

     

       439
       -
             in MCP messages, enabling seamless incorporation of managed content.

     

       440
       -
             

     

       441
       -
             Embedded resources can be included in:

     

       442
       -
             - Tool results to provide rich context

     

       443
       -
             - Prompt templates to include reference materials

     

       444
       -
             - Messages to provide additional context to language models

     

       445
       -
             

     

       446
       -
             In contrast to direct content (TextContent, ImageContent, AudioContent),

     

       447
       -
             embedded resources have the advantage of being persistently stored on the server

     

       448
       -
             with a stable URI, allowing later retrieval and updates through the resources API.

     

       449
       -
             

     

       450
       -
             For example, a tool might return an embedded resource containing a chart or

     

       451
       -
             a large dataset that the client can later reference or update. *)

     

       452
        
         type t = {

     

       453
        
           resource: [ `Text of TextResourceContents.t | `Blob of BlobResourceContents.t ];

     

       454
       -
           (** The resource content, either as text or binary blob. *)

     

       455
        
           annotations: Annotated.annotation option;

     

       456
       -
           (** Optional annotations for audience targeting and priority.

     

       457
       -
               Annotations can restrict resource visibility to specific roles (user/assistant)

     

       458
       -
               and indicate relative importance of different content elements. *)

     

       459
        
         }

     

       460
       -
         include Json.Jsonable.S with type t := t

     

       0
        
       
     

       0
        
       
     

       461
        
       end

     

       462
        
       

     

       463
       -
       (** Content type used in messages - Unified multimodal content representation in MCP *)

     

       464
        
       type content = 

     

       465
       -
         | Text of TextContent.t    (** Text content for natural language messages. This is the most common content type for user-assistant interactions. *)

     

       466
       -
         | Image of ImageContent.t  (** Image content for visual data. Used for sharing visual context in multimodal conversations. *)

     

       467
       -
         | Audio of AudioContent.t  (** Audio content for audio data. Used for sharing audio context in multimodal conversations. *)

     

       468
       -
         | Resource of EmbeddedResource.t  (** Resource content for referencing server-side resources. Used for incorporating managed server content with stable URIs. *)

     

       469
        
       

     

       470
       -
       (** Convert content to Yojson representation 

     

       471
       -
           @param content The content to convert

     

       472
       -
           @return JSON representation of the content

     

       473
       -
       *)

     

       474
        
       val yojson_of_content : content -> Json.t

     

       475
       -
       

     

       476
       -
       (** Convert Yojson representation to content 

     

       477
       -
           @param json JSON representation of content

     

       478
       -
           @return Parsed content object

     

       479
       -
       *)

     

       480
        
       val content_of_yojson : Json.t -> content

     

       481
        
       

     

       482
       -
       (** Message for prompts - Template messages in the MCP prompts feature *)

     

       483
        
       module PromptMessage : sig

     

       484
       -
         (** PromptMessage represents a message in an MCP prompt template,

     

       485
       -
             containing a role and content which can be customized with arguments.

     

       486
       -
             

     

       487
       -
             Prompt messages are part of prompt templates exposed by servers through

     

       488
       -
             the prompts/get endpoint. They define structured conversation templates

     

       489
       -
             that can be instantiated with user-provided arguments.

     

       490
       -
             

     

       491
       -
             The prompt feature is designed to be user-controlled, with prompts typically

     

       492
       -
             exposed through UI elements like slash commands that users can explicitly select.

     

       493
       -
             

     

       494
       -
             In JSON-RPC, prompt messages are represented as:

     

       495
       -
             {v

     

       496
       -
             {

     

       497
       -
               "role": "user",

     

       498
       -
               "content": {

     

       499
       -
                 "type": "text",

     

       500
       -
                 "text": "Please review this code: ${code}"

     

       501
       -
               }

     

       502
       -
             }

     

       503
       -
             v}

     

       504
       -
             

     

       505
       -
             Where $code would be replaced with a user-provided argument. *)

     

       506
        
         type t = {

     

       507
        
           role: Role.t;

     

       508
       -
           (** The role of the message sender (user or assistant).

     

       509
       -
               Prompt templates typically alternate between user and assistant messages

     

       510
       -
               to create a conversation structure. *)

     

       511
        
           content: content;

     

       512
       -
           (** The message content, which can be text, image, audio, or resource.

     

       513
       -
               This unified content type supports rich multimodal prompts. *)

     

       514
        
         }

     

       515
       -
         include Json.Jsonable.S with type t := t

     

       0
        
       
     

       0
        
       
     

       516
        
       end

     

       517
        
       

     

       518
       -
       (** Message for sampling - Messages used in LLM completion requests *)

     

       519
        
       module SamplingMessage : sig

     

       520
       -
         (** SamplingMessage represents a message in an MCP sampling request,

     

       521
       -
             used for AI model generation based on a prompt.

     

       522
       -
             

     

       523
       -
             The sampling feature allows clients to expose language model capabilities

     

       524
       -
             to servers, enabling servers to request completions from the client's LLM.

     

       525
       -
             This is effectively the reverse of the normal MCP flow, with the server

     

       526
       -
             requesting generative capabilities from the client.

     

       527
       -
             

     

       528
       -
             Sampling messages differ from prompt messages in that they don't support

     

       529
       -
             embedded resources, as they represent the actual context window being

     

       530
       -
             sent to the LLM rather than template definitions.

     

       531
       -
             

     

       532
       -
             Clients that support sampling must declare the 'sampling' capability

     

       533
       -
             during initialization. *)

     

       534
        
         type t = {

     

       535
        
           role: Role.t;

     

       536
       -
           (** The role of the message sender (user or assistant).

     

       537
       -
               Typically, a sampling request will contain multiple messages

     

       538
       -
               representing a conversation history, with alternating roles. *)

     

       539
       -
           content: [ `Text of TextContent.t | `Image of ImageContent.t | `Audio of AudioContent.t ];

     

       540
       -
           (** The message content, restricted to text, image, or audio (no resources).

     

       541
       -
               Resources are not included since sampling messages represent the

     

       542
       -
               actual context window for the LLM, not template definitions. *)

     

       543
        
         }

     

       544
       -
         include Json.Jsonable.S with type t := t

     

       0
        
       
     

       0
        
       
     

       545
        
       end

     

       546
        
       

     

       547
        
       (** Implementation information *)

     

       548
        
       module Implementation : sig

     

       549
       -
         (** Implementation provides metadata about client and server implementations,

     

       550
       -
             used during the initialization phase to identify each party. *)

     

       551
        
         type t = {

     

       552
        
           name: string;

     

       553
       -
           (** Name of the implementation *)

     

       554
        
           version: string;

     

       555
       -
           (** Version of the implementation *)

     

       556
        
         }

     

       557
       -
         include Json.Jsonable.S with type t := t

     

       0
        
       
     

       0
        
       
     

       558
        
       end

     

       559
        
       

     

       560
       -
       (** JSONRPC message types - Core message protocol for MCP

     

       561
       -
       

     

       562
       -
           MCP uses JSON-RPC 2.0 as its underlying messaging protocol.

     

       563
       -
           All MCP messages are encoded as JSON-RPC 2.0 messages with UTF-8 encoding,

     

       564
       -
           following the standard JSON-RPC message formats with some MCP-specific extensions.

     

       565
       -
           

     

       566
       -
           MCP defines four message types:

     

       567
       -
           1. Notifications: One-way messages that don't expect a response

     

       568
       -
           2. Requests: Messages that expect a corresponding response

     

       569
       -
           3. Responses: Replies to requests with successful results

     

       570
       -
           4. Errors: Replies to requests with error information

     

       571
       -
           

     

       572
       -
           These can be transported over multiple transport mechanisms:

     

       573
       -
           - stdio: Communication over standard input/output

     

       574
       -
           - Streamable HTTP: HTTP POST/GET with SSE for server streaming

     

       575
       -
           - Custom transports: Implementation-specific transports

     

       576
       -
           

     

       577
       -
           Messages may be sent individually or as part of a JSON-RPC batch.

     

       578
       -
       *)

     

       579
        
       module JSONRPCMessage : sig

     

       580
       -
         (** Notification represents a JSON-RPC notification (one-way message without a response).

     

       581
       -
             

     

       582
       -
             Notifications are used for events that don't require a response, such as:

     

       583
       -
             - The 'initialized' notification completing initialization

     

       584
       -
             - Resource change notifications

     

       585
       -
             - Progress updates for long-running operations

     

       586
       -
             - List changed notifications for tools, resources, and prompts

     

       587
       -
             

     

       588
       -
             In JSON-RPC, notifications are identified by the absence of an 'id' field:

     

       589
       -
             {v

     

       590
       -
             {

     

       591
       -
               "jsonrpc": "2.0",

     

       592
       -
               "method": "notifications/resources/updated",

     

       593
       -
               "params": {

     

       594
       -
                 "uri": "file:///project/src/main.rs"

     

       595
       -
               }

     

       596
       -
             }

     

       597
       -
             v}

     

       598
       -
         *)

     

       599
        
         type notification = {

     

       600
       -
           meth: Method.t;

     

       601
       -
           (** Method for the notification, using the Method.t type to ensure type safety.

     

       602
       -
               Examples: Method.Initialized, Method.ResourcesUpdated *)

     

       603
        
           params: Json.t option;

     

       604
       -
           (** Optional parameters for the notification as arbitrary JSON.

     

       605
       -
               The structure depends on the specific notification method. *)

     

       606
        
         }

     

       607
        
       

     

       608
       -
         (** Request represents a JSON-RPC request that expects a response.

     

       609
       -
             

     

       610
       -
             Requests are used for operations that require a response, such as:

     

       611
       -
             - Initialization

     

       612
       -
             - Listing resources, tools, or prompts

     

       613
       -
             - Reading resources

     

       614
       -
             - Calling tools

     

       615
       -
             - Getting prompts

     

       616
       -
             

     

       617
       -
             In JSON-RPC, requests include an 'id' field that correlates with the response:

     

       618
       -
             {v

     

       619
       -
             {

     

       620
       -
               "jsonrpc": "2.0",

     

       621
       -
               "id": 1,

     

       622
       -
               "method": "resources/read",

     

       623
       -
               "params": {

     

       624
       -
                 "uri": "file:///project/src/main.rs"

     

       625
       -
               }

     

       626
       -
             }

     

       627
       -
             v}

     

       628
       -
         *)

     

       629
        
         type request = {

     

       630
        
           id: RequestId.t;

     

       631
       -
           (** Unique identifier for the request, which will be echoed in the response.

     

       632
       -
               This can be a string or integer and should be unique within the session. *)

     

       633
       -
           meth: Method.t;

     

       634
       -
           (** Method for the request, using the Method.t type to ensure type safety.

     

       635
       -
               Examples: Method.Initialize, Method.ResourcesRead, Method.ToolsCall *)

     

       636
        
           params: Json.t option;

     

       637
       -
           (** Optional parameters for the request as arbitrary JSON.

     

       638
       -
               The structure depends on the specific request method. *)

     

       639
        
           progress_token: ProgressToken.t option;

     

       640
       -
           (** Optional progress token for long-running operations.

     

       641
       -
               If provided, the server can send progress notifications using this token

     

       642
       -
               to inform the client about the operation's status. *)

     

       643
        
         }

     

       644
        
       

     

       645
       -
         (** Response represents a successful JSON-RPC response to a request.

     

       646
       -
             

     

       647
       -
             Responses are sent in reply to requests and contain the successful result.

     

       648
       -
             Each response must include the same ID as its corresponding request.

     

       649
       -
             

     

       650
       -
             In JSON-RPC, responses include the 'id' field matching the request:

     

       651
       -
             {v

     

       652
       -
             {

     

       653
       -
               "jsonrpc": "2.0",

     

       654
       -
               "id": 1,

     

       655
       -
               "result": {

     

       656
       -
                 "contents": [

     

       657
       -
                   {

     

       658
       -
                     "uri": "file:///project/src/main.rs",

     

       659
       -
                     "mimeType": "text/x-rust",

     

       660
       -
                     "text": "fn main() {\n    println!(\"Hello world!\");\n}"

     

       661
       -
                   }

     

       662
       -
                 ]

     

       663
       -
               }

     

       664
       -
             }

     

       665
       -
             v}

     

       666
       -
         *)

     

       667
        
         type response = {

     

       668
        
           id: RequestId.t;

     

       669
       -
           (** ID matching the original request, allowing clients to correlate

     

       670
       -
               responses with their originating requests, especially important

     

       671
       -
               when multiple requests are in flight. *)

     

       672
        
           result: Json.t;

     

       673
       -
           (** Result of the successful request as arbitrary JSON.

     

       674
       -
               The structure depends on the specific request method that was called. *)

     

       675
        
         }

     

       676
        
       

     

       677
       -
         (** Error represents an error response to a JSON-RPC request.

     

       678
       -
             

     

       679
       -
             Errors are sent in reply to requests when processing fails.

     

       680
       -
             Each error must include the same ID as its corresponding request.

     

       681
       -
             

     

       682
       -
             MCP defines several standard error codes:

     

       683
       -
             - Standard JSON-RPC errors (-32700 to -32603)

     

       684
       -
             - MCP-specific errors (-32002 for resource not found, etc.)

     

       685
       -
             

     

       686
       -
             In JSON-RPC, errors follow this structure:

     

       687
       -
             {v

     

       688
       -
             {

     

       689
       -
               "jsonrpc": "2.0",

     

       690
       -
               "id": 1,

     

       691
       -
               "error": {

     

       692
       -
                 "code": -32002,

     

       693
       -
                 "message": "Resource not found",

     

       694
       -
                 "data": {

     

       695
       -
                   "uri": "file:///nonexistent.txt"

     

       696
       -
                 }

     

       697
       -
               }

     

       698
       -
             }

     

       699
       -
             v}

     

       700
       -
         *)

     

       701
        
         type error = {

     

       702
        
           id: RequestId.t;

     

       703
       -
           (** ID matching the original request, allowing clients to correlate

     

       704
       -
               errors with their originating requests. *)

     

       705
        
           code: int;

     

       706
       -
           (** Error code indicating the type of error, following the JSON-RPC standard.

     

       707
       -
               Common codes include:

     

       708
       -
               - -32700: Parse error

     

       709
       -
               - -32600: Invalid request

     

       710
       -
               - -32601: Method not found

     

       711
       -
               - -32602: Invalid params

     

       712
       -
               - -32603: Internal error

     

       713
       -
               - -32002: Resource not found (MCP-specific)

     

       714
       -
               - -32001: Authentication required (MCP-specific) *)

     

       715
        
           message: string;

     

       716
       -
           (** Human-readable error message describing the issue.

     

       717
       -
               This should be concise but informative enough for debugging. *)

     

       718
        
           data: Json.t option;

     

       719
       -
           (** Optional additional error data as arbitrary JSON.

     

       720
       -
               This can provide more context about the error, such as which

     

       721
       -
               resource wasn't found or which parameter was invalid. *)

     

       722
        
         }

     

       723
        
       

     

       724
       -
         (** Union type for all JSON-RPC message kinds, providing a single type

     

       725
       -
             that can represent any MCP message. *)

     

       726
        
         type t =

     

       727
        
           | Notification of notification

     

       728
        
           | Request of request

     

       729
        
           | Response of response

     

       730
        
           | Error of error

     

       731
        
       

     

       732
       -
         (** Convert notification to Yojson representation 

     

       733
       -
             @param notification The notification to convert

     

       734
       -
             @return JSON representation of the notification

     

       735
       -
         *)

     

       736
        
         val yojson_of_notification : notification -> Json.t

     

       737
       -
         

     

       738
       -
         (** Convert request to Yojson representation 

     

       739
       -
             @param request The request to convert

     

       740
       -
             @return JSON representation of the request

     

       741
       -
         *)

     

       742
        
         val yojson_of_request : request -> Json.t

     

       743
       -
         

     

       744
       -
         (** Convert response to Yojson representation 

     

       745
       -
             @param response The response to convert

     

       746
       -
             @return JSON representation of the response

     

       747
       -
         *)

     

       748
        
         val yojson_of_response : response -> Json.t

     

       749
       -
         

     

       750
       -
         (** Convert error to Yojson representation 

     

       751
       -
             @param error The error to convert

     

       752
       -
             @return JSON representation of the error

     

       753
       -
         *)

     

       754
        
         val yojson_of_error : error -> Json.t

     

       755
       -
         

     

       756
       -
         (** Convert any message to Yojson representation 

     

       757
       -
             @param message The message to convert

     

       758
       -
             @return JSON representation of the message

     

       759
       -
         *)

     

       760
        
         val yojson_of_t : t -> Json.t

     

       761
        
       

     

       762
       -
         (** Convert Yojson representation to notification 

     

       763
       -
             @param json JSON representation of a notification

     

       764
       -
             @return Parsed notification object

     

       765
       -
             @raise Parse error if the JSON is not a valid notification

     

       766
       -
         *)

     

       767
        
         val notification_of_yojson : Json.t -> notification

     

       768
       -
         

     

       769
       -
         (** Convert Yojson representation to request 

     

       770
       -
             @param json JSON representation of a request

     

       771
       -
             @return Parsed request object

     

       772
       -
             @raise Parse error if the JSON is not a valid request

     

       773
       -
         *)

     

       774
        
         val request_of_yojson : Json.t -> request

     

       775
       -
         

     

       776
       -
         (** Convert Yojson representation to response 

     

       777
       -
             @param json JSON representation of a response

     

       778
       -
             @return Parsed response object

     

       779
       -
             @raise Parse error if the JSON is not a valid response

     

       780
       -
         *)

     

       781
        
         val response_of_yojson : Json.t -> response

     

       782
       -
         

     

       783
       -
         (** Convert Yojson representation to error 

     

       784
       -
             @param json JSON representation of an error

     

       785
       -
             @return Parsed error object

     

       786
       -
             @raise Parse error if the JSON is not a valid error

     

       787
       -
         *)

     

       788
        
         val error_of_yojson : Json.t -> error

     

       789
       -
         

     

       790
       -
         (** Convert Yojson representation to any message 

     

       791
       -
             @param json JSON representation of any message type

     

       792
       -
             @return Parsed message object

     

       793
       -
             @raise Parse error if the JSON is not a valid message

     

       794
       -
         *)

     

       795
        
         val t_of_yojson : Json.t -> t

     

       796
        
       

     

       797
       -
         (** Create a new notification message

     

       798
       -
             @param params Optional parameters for the notification

     

       799
       -
             @param meth Method name for the notification

     

       800
       -
             @return A new JSON-RPC notification message

     

       801
       -
         *)

     

       802
       -
         val create_notification : ?params:Json.t option -> meth:Method.t -> unit -> t

     

       803
       -
         

     

       804
       -
         (** Create a new request message

     

       805
       -
             @param params Optional parameters for the request

     

       806
       -
             @param progress_token Optional progress token for long-running operations

     

       807
       -
             @param id Unique identifier for the request

     

       808
       -
             @param meth Method name for the request

     

       809
       -
             @return A new JSON-RPC request message

     

       810
       -
         *)

     

       811
       -
         val create_request : ?params:Json.t option -> ?progress_token:ProgressToken.t option -> id:RequestId.t -> meth:Method.t -> unit -> t

     

       812
       -
         

     

       813
       -
         (** Create a new response message

     

       814
       -
             @param id ID matching the original request

     

       815
       -
             @param result Result of the successful request

     

       816
       -
             @return A new JSON-RPC response message

     

       817
       -
         *)

     

       818
        
         val create_response : id:RequestId.t -> result:Json.t -> t

     

       819
       -
         

     

       820
       -
         (** Create a new error message

     

       821
       -
             @param id ID matching the original request

     

       822
       -
             @param code Error code indicating the type of error

     

       823
       -
             @param message Human-readable error message

     

       824
       -
             @param data Optional additional error data

     

       825
       -
             @return A new JSON-RPC error message

     

       826
       -
         *)

     

       827
        
         val create_error : id:RequestId.t -> code:int -> message:string -> ?data:Json.t option -> unit -> t

     

       828
        
       end

     

       829
        
       

     

       830
       -
       (** Initialize request/response - The first phase of the MCP lifecycle 

     

       831
       -
           

     

       832
       -
           The initialization phase is the mandatory first interaction between client and server.

     

       833
       -
           During this phase, the protocol version is negotiated and capabilities are exchanged

     

       834
       -
           to determine which optional features will be available during the session.

     

       835
       -
           

     

       836
       -
           This follows a strict sequence:

     

       837
       -
           1. Client sends an InitializeRequest containing its capabilities and protocol version

     

       838
       -
           2. Server responds with an InitializeResult containing its capabilities and protocol version

     

       839
       -
           3. Client sends an InitializedNotification to signal it's ready for normal operations

     

       840
       -
           

     

       841
       -
           The Initialize module handles steps 1 and 2 of this process.

     

       842
       -
       *)

     

       843
        
       module Initialize : sig

     

       844
        
         (** Initialize request *)

     

       845
        
         module Request : sig

     

       846
       -
           (** InitializeRequest starts the MCP lifecycle, negotiating capabilities

     

       847
       -
               and protocol versions between client and server. This is always the first

     

       848
       -
               message sent by the client and MUST NOT be part of a JSON-RPC batch.

     

       849
       -
               

     

       850
       -
               The client SHOULD send the latest protocol version it supports. If the server

     

       851
       -
               does not support this version, it will respond with a version it does support,

     

       852
       -
               and the client must either use that version or disconnect. *)

     

       853
        
           type t = {

     

       854
       -
             capabilities: Json.t; (** ClientCapabilities that define supported optional features.

     

       855
       -
                 This includes which optional protocol features the client supports,

     

       856
       -
                 such as 'roots' (filesystem access), 'sampling' (LLM generation),

     

       857
       -
                 and any experimental features. *)

     

       858
        
             client_info: Implementation.t;

     

       859
       -
             (** Client implementation details (name and version) used for identification

     

       860
       -
                 and debugging. Helps servers understand which client they're working with. *)

     

       861
        
             protocol_version: string;

     

       862
       -
             (** MCP protocol version supported by the client, formatted as YYYY-MM-DD

     

       863
       -
                 according to the MCP versioning scheme. Example: "2025-03-26" *)

     

       864
        
           }

     

       865
       -
           include Json.Jsonable.S with type t := t

     

       0
        
       
     

       0
        
       
     

       866
        
       

     

       867
       -
           (** Create a new initialization request

     

       868
       -
               @param capabilities Client capabilities that define supported optional features

     

       869
       -
               @param client_info Client implementation details

     

       870
       -
               @param protocol_version MCP protocol version supported by the client

     

       871
       -
               @return A new initialization request

     

       872
       -
           *)

     

       873
        
           val create : capabilities:Json.t -> client_info:Implementation.t -> protocol_version:string -> t

     

       874
       -
           

     

       875
       -
           (** Convert to JSON-RPC message

     

       876
       -
               @param id Unique request identifier

     

       877
       -
               @param t Initialization request

     

       878
       -
               @return JSON-RPC message containing the initialization request

     

       879
       -
           *)

     

       880
        
           val to_jsonrpc : id:RequestId.t -> t -> JSONRPCMessage.t

     

       881
        
         end

     

       882
        
       

     

       883
        
         (** Initialize result *)

     

       884
        
         module Result : sig

     

       885
       -
           (** InitializeResult is the server's response to an initialization request,

     

       886
       -
               completing capability negotiation and establishing the protocol version.

     

       887
       -
               

     

       888
       -
               After receiving this message, the client must send an InitializedNotification.

     

       889
       -
               The server should not send any requests other than pings and logging before

     

       890
       -
               receiving the initialized notification. *)

     

       891
        
           type t = {

     

       892
       -
             capabilities: Json.t; (** ServerCapabilities that define supported optional features.

     

       893
       -
                 This declares which server features are available, including:

     

       894
       -
                 - prompts: Server provides prompt templates

     

       895
       -
                 - resources: Server provides readable resources

     

       896
       -
                 - tools: Server exposes callable tools

     

       897
       -
                 - logging: Server emits structured log messages

     

       898
       -
                 

     

       899
       -
                 Each capability may have sub-capabilities like:

     

       900
       -
                 - listChanged: Server will notify when available items change

     

       901
       -
                 - subscribe: Clients can subscribe to individual resources *)

     

       902
        
             server_info: Implementation.t;

     

       903
       -
             (** Server implementation details (name and version) used for identification

     

       904
       -
                 and debugging. Helps clients understand which server they're working with. *)

     

       905
        
             protocol_version: string;

     

       906
       -
             (** MCP protocol version supported by the server, formatted as YYYY-MM-DD.

     

       907
       -
                 If the server supports the client's requested version, it responds with

     

       908
       -
                 the same version. Otherwise, it responds with a version it does support. *)

     

       909
        
             instructions: string option;

     

       910
       -
             (** Optional instructions for using the server. These can provide human-readable

     

       911
       -
                 guidance on how to interact with this specific server implementation. *)

     

       912
        
             meta: Json.t option;

     

       913
       -
             (** Optional additional metadata as arbitrary JSON. Can contain server-specific

     

       914
       -
                 information not covered by the standard fields. *)

     

       915
        
           }

     

       916
       -
           include Json.Jsonable.S with type t := t

     

       0
        
       
     

       0
        
       
     

       917
        
       

     

       918
       -
           (** Create a new initialization result

     

       919
       -
               @param capabilities Server capabilities that define supported optional features

     

       920
       -
               @param server_info Server implementation details

     

       921
       -
               @param protocol_version MCP protocol version supported by the server

     

       922
       -
               @param instructions Optional instructions for using the server

     

       923
       -
               @param meta Optional additional metadata

     

       924
       -
               @return A new initialization result

     

       925
       -
           *)

     

       926
        
           val create : capabilities:Json.t -> server_info:Implementation.t -> protocol_version:string -> ?instructions:string -> ?meta:Json.t -> unit -> t

     

       927
       -
           

     

       928
       -
           (** Convert to JSON-RPC message

     

       929
       -
               @param id ID matching the original request

     

       930
       -
               @param t Initialization result

     

       931
       -
               @return JSON-RPC message containing the initialization result

     

       932
       -
           *)

     

       933
        
           val to_jsonrpc : id:RequestId.t -> t -> JSONRPCMessage.t

     

       934
        
         end

     

       935
        
       end

     

       936
        
       

     

       937
       -
       (** Initialized notification - Completes the initialization phase of the MCP lifecycle *)

     

       938
        
       module Initialized : sig

     

       939
        
         module Notification : sig

     

       940
       -
           (** InitializedNotification is sent by the client after receiving the initialization

     

       941
       -
               response, indicating it's ready to begin normal operations. This completes the

     

       942
       -
               three-step initialization process, after which both client and server can

     

       943
       -
               freely exchange messages according to the negotiated capabilities.

     

       944
       -
               

     

       945
       -
               Only after this notification has been sent should the client begin normal operations

     

       946
       -
               like listing resources, calling tools, or requesting prompts. *)

     

       947
        
           type t = {

     

       948
        
             meta: Json.t option;

     

       949
       -
             (** Optional additional metadata as arbitrary JSON. Can contain client-specific

     

       950
       -
                 information not covered by the standard fields. *)

     

       951
        
           }

     

       952
       -
           include Json.Jsonable.S with type t := t

     

       0
        
       
     

       0
        
       
     

       953
        
       

     

       954
       -
           (** Create a new initialized notification

     

       955
       -
               @param meta Optional additional metadata

     

       956
       -
               @return A new initialized notification

     

       957
       -
           *)

     

       958
        
           val create : ?meta:Json.t -> unit -> t

     

       959
       -
           

     

       960
       -
           (** Convert to JSON-RPC message

     

       961
       -
               @param t Initialized notification

     

       962
       -
               @return JSON-RPC message containing the initialized notification

     

       963
       -
           *)

     

       964
        
           val to_jsonrpc : t -> JSONRPCMessage.t

     

       965
        
         end

     

       966
        
       end

     

       967
        
       

     

       968
       -
       (** Parse a JSON message into an MCP message 

     

       969
       -
           

     

       970
       -
           This function takes a raw JSON value and parses it into a structured MCP message.

     

       971
       -
           It's the primary entry point for processing incoming JSON-RPC messages in the MCP protocol.

     

       972
       -
           

     

       973
       -
           The function determines the message type (notification, request, response, or error)

     

       974
       -
           based on the presence and values of specific fields:

     

       975
       -
           - A message with "method" but no "id" is a notification

     

       976
       -
           - A message with "method" and "id" is a request

     

       977
       -
           - A message with "id" and "result" is a response

     

       978
       -
           - A message with "id" and "error" is an error

     

       979
       -
           

     

       980
       -
           @param json The JSON message to parse, typically received from the transport layer

     

       981
       -
           @return The parsed MCP message as a structured JSONRPCMessage.t value

     

       982
       -
           @raise Parse error if the JSON cannot be parsed as a valid MCP message

     

       983
       -
       *)

     

       984
       -
       val parse_message : Json.t -> JSONRPCMessage.t

     

       985
        
       

     

       986
       -
       (** Create a new notification message

     

       987
       -
           

     

       988
       -
           Notifications are one-way messages that don't expect a response.

     

       989
       -
           This is a convenience wrapper around JSONRPCMessage.create_notification.

     

       990
       -
           

     

       991
       -
           Common notifications in MCP include:

     

       992
       -
           - "notifications/initialized" - Sent after initialization

     

       993
       -
           - "notifications/progress" - Updates on long-running operations

     

       994
       -
           - "notifications/resources/updated" - Resource content changed

     

       995
       -
           - "notifications/prompts/list_changed" - Available prompts changed

     

       996
       -
           - "notifications/tools/list_changed" - Available tools changed

     

       997
       -
           

     

       998
       -
           @param params Optional parameters for the notification as a JSON value

     

       999
       -
           @param meth Method type for the notification

     

       1000
       -
           @return A new JSON-RPC notification message

     

       1001
       -
       *)

     

       1002
       -
       val create_notification : ?params:Json.t option -> meth:Method.t -> unit -> JSONRPCMessage.t

     

       1003
        
       

     

       1004
       -
       (** Create a new request message

     

       1005
       -
           

     

       1006
       -
           Requests are messages that expect a corresponding response.

     

       1007
       -
           This is a convenience wrapper around JSONRPCMessage.create_request.

     

       1008
       -
           

     

       1009
       -
           Common requests in MCP include:

     

       1010
       -
           - "initialize" - Start the MCP lifecycle

     

       1011
       -
           - "resources/list" - Discover available resources

     

       1012
       -
           - "resources/read" - Retrieve resource contents

     

       1013
       -
           - "tools/list" - Discover available tools

     

       1014
       -
           - "tools/call" - Invoke a tool

     

       1015
       -
           - "prompts/list" - Discover available prompts

     

       1016
       -
           - "prompts/get" - Retrieve a prompt template

     

       1017
       -
           

     

       1018
       -
           @param params Optional parameters for the request as a JSON value

     

       1019
       -
           @param progress_token Optional progress token for long-running operations

     

       1020
       -
                  that can report progress updates

     

       1021
       -
           @param id Unique identifier for the request, used to correlate with the response

     

       1022
       -
           @param meth Method type for the request

     

       1023
       -
           @return A new JSON-RPC request message

     

       1024
       -
       *)

     

       1025
       -
       val create_request : ?params:Json.t option -> ?progress_token:ProgressToken.t option -> id:RequestId.t -> meth:Method.t -> unit -> JSONRPCMessage.t

     

       1026
        
       

     

       1027
       -
       (** Create a new response message

     

       1028
       -
           

     

       1029
       -
           Responses are sent in reply to requests and contain successful results.

     

       1030
       -
           This is a convenience wrapper around JSONRPCMessage.create_response.

     

       1031
       -
           

     

       1032
       -
           Each response must include the same ID as its corresponding request

     

       1033
       -
           to allow the client to correlate them, especially when multiple

     

       1034
       -
           requests are in flight simultaneously.

     

       1035
       -
           

     

       1036
       -
           @param id ID matching the original request

     

       1037
       -
           @param result Result of the successful request as a JSON value

     

       1038
       -
           @return A new JSON-RPC response message

     

       1039
       -
       *)

     

       1040
       -
       val create_response : id:RequestId.t -> result:Json.t -> JSONRPCMessage.t

     

       1041
        
       

     

       1042
       -
       (** Create a new error message

     

       1043
       -
           

     

       1044
       -
           Errors are sent in reply to requests when processing fails.

     

       1045
       -
           This is a convenience wrapper around JSONRPCMessage.create_error.

     

       1046
       -
           

     

       1047
       -
           MCP uses standard JSON-RPC error codes as well as some protocol-specific codes:

     

       1048
       -
           - -32700: Parse error (invalid JSON)

     

       1049
       -
           - -32600: Invalid request (malformed JSON-RPC)

     

       1050
       -
           - -32601: Method not found

     

       1051
       -
           - -32602: Invalid parameters

     

       1052
       -
           - -32603: Internal error

     

       1053
       -
           - -32002: Resource not found (MCP-specific)

     

       1054
       -
           - -32001: Authentication required (MCP-specific)

     

       1055
       -
           

     

       1056
       -
           @param id ID matching the original request

     

       1057
       -
           @param code Error code indicating the type of error

     

       1058
       -
           @param message Human-readable error message describing the issue

     

       1059
       -
           @param data Optional additional error data providing more context

     

       1060
       -
           @return A new JSON-RPC error message

     

       1061
       -
       *)

     

       1062
       -
       val create_error : id:RequestId.t -> code:int -> message:string -> ?data:Json.t option -> unit -> JSONRPCMessage.t

     

       1063
        
       

     

       1064
       -
       (** Create a new text content object

     

       1065
       -
           @param text The text content

     

       1066
       -
           @return A content value with the text

     

       1067
       -
       *)

     

       1068
       -
       val make_text_content : string -> content

     

       1069
        
       

     

       1070
       -
       (** Create a new image content object

     

       1071
       -
           @param data Base64-encoded image data

     

       1072
       -
           @param mime_type MIME type of the image (e.g., "image/png", "image/jpeg")  

     

       1073
       -
           @return A content value with the image

     

       1074
       -
       *)

     

       1075
       -
       val make_image_content : string -> string -> content

     

       1076
        
       

     

       1077
       -
       (** Create a new audio content object

     

       1078
       -
           @param data Base64-encoded audio data

     

       1079
       -
           @param mime_type MIME type of the audio (e.g., "audio/wav", "audio/mp3")

     

       1080
       -
           @return A content value with the audio

     

       1081
       -
       *)

     

       1082
       -
       val make_audio_content : string -> string -> content

     

       1083
        
       

     

       1084
       -
       (** Create a new text resource content object

     

       1085
       -
           @param uri URI that uniquely identifies the resource

     

       1086
       -
           @param text The text content of the resource

     

       1087
       -
           @param mime_type Optional MIME type of the text content

     

       1088
       -
           @return A content value with the text resource

     

       1089
       -
       *)

     

       1090
       -
       val make_resource_text_content : string -> string -> string option -> content

     

       1091
        
       

     

       1092
       -
       (** Create a new binary resource content object

     

       1093
       -
           @param uri URI that uniquely identifies the resource

     

       1094
       -
           @param blob Base64-encoded binary data

     

       1095
       -
           @param mime_type Optional MIME type of the binary content

     

       1096
       -
           @return A content value with the binary resource

     

       1097
       -
       *)

     

       1098
       -
       val make_resource_blob_content : string -> string -> string option -> content

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0

···

       1
       +
       (** MCP - Model Context Protocol implementation *)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       2
        
       

     

       3
        
       open Jsonrpc

     

       4
        
       

     

       5
       +
       (** Standard error codes *)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       6
        
       module ErrorCode : sig

     

       7
       +
         val parse_error : int

     

       8
       +
         val invalid_request : int

     

       9
       +
         val method_not_found : int

     

       10
       +
         val invalid_params : int

     

       11
       +
         val internal_error : int

     

       12
       +
         val resource_not_found : int

     

       13
       +
         val server_error_start : int

     

       14
       +
         val server_error_end : int

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       15
        
       end

     

       16
        
       

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       17
        
       (** Common types *)

     

       18
        
       

     

       19
        
       (** Roles for conversation participants *)

     

       20
        
       module Role : sig

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       21
        
         type t = [ `User | `Assistant ]

     

       22
       +
       

     

       23
       +
         val to_string : t -> string

     

       24
       +
         val of_string : string -> t

     

       25
       +
       

     

       26
       +
         val yojson_of_t : t -> Json.t

     

       27
       +
         val t_of_yojson : Json.t -> t

     

       28
        
       end

     

       29
        
       

     

       30
        
       (** Progress tokens for long-running operations *)

     

       31
        
       module ProgressToken : sig

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       32
        
         type t = [ `String of string | `Int of int ]

     

       33
       +
       

     

       34
        
         include Json.Jsonable.S with type t := t

     

       35
        
       end

     

       36
        
       

     

       37
        
       (** Request IDs *)

     

       38
        
       module RequestId : sig

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       39
        
         type t = [ `String of string | `Int of int ]

     

       40
       +
       

     

       41
        
         include Json.Jsonable.S with type t := t

     

       42
        
       end

     

       43
        
       

     

       44
        
       (** Cursors for pagination *)

     

       45
        
       module Cursor : sig

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       46
        
         type t = string

     

       47
       +
       

     

       48
       +
         val yojson_of_t : t -> Json.t

     

       49
       +
         val t_of_yojson : Json.t -> t

     

       50
        
       end

     

       51
        
       

     

       52
        
       (** Annotations for objects *)

     

       53
        
       module Annotated : sig

     

       0
        
       
     

       0
        
       
     

       54
        
         type t = {

     

       55
        
           annotations: annotation option;

     

       56
        
         }

     

       57
        
         and annotation = {

     

       58
        
           audience: Role.t list option;

     

       0
        
       
     

       59
        
           priority: float option;

     

       0
        
       
     

       60
        
         }

     

       61
       +
       

     

       62
       +
         val yojson_of_annotation : annotation -> Json.t

     

       63
       +
         val annotation_of_yojson : Json.t -> annotation

     

       64
       +
       

     

       65
       +
         val yojson_of_t : t -> Json.t

     

       66
       +
         val t_of_yojson : Json.t -> t

     

       67
        
       end

     

       68
        
       

     

       69
       +
       (** Text content *)

     

       70
        
       module TextContent : sig

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       71
        
         type t = {

     

       72
        
           text: string;

     

       0
        
       
     

       73
        
           annotations: Annotated.annotation option;

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       74
        
         }

     

       75
       +
       

     

       76
       +
         val yojson_of_t : t -> Json.t

     

       77
       +
         val t_of_yojson : Json.t -> t

     

       78
        
       end

     

       79
        
       

     

       80
       +
       (** Image content *)

     

       81
        
       module ImageContent : sig

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       82
        
         type t = {

     

       83
        
           data: string;

     

       0
        
       
     

       0
        
       
     

       84
        
           mime_type: string;

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       85
        
           annotations: Annotated.annotation option;

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       86
        
         }

     

       87
       +
       

     

       88
       +
         val yojson_of_t : t -> Json.t

     

       89
       +
         val t_of_yojson : Json.t -> t

     

       90
        
       end

     

       91
        
       

     

       92
       +
       (** Audio content *)

     

       93
        
       module AudioContent : sig

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       94
        
         type t = {

     

       95
        
           data: string;

     

       0
        
       
     

       0
        
       
     

       96
        
           mime_type: string;

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       97
        
           annotations: Annotated.annotation option;

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       98
        
         }

     

       99
       +
       

     

       100
       +
         val yojson_of_t : t -> Json.t

     

       101
       +
         val t_of_yojson : Json.t -> t

     

       102
        
       end

     

       103
        
       

     

       104
       +
       (** Base resource contents *)

     

       105
        
       module ResourceContents : sig

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       106
        
         type t = {

     

       107
        
           uri: string;

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       108
        
           mime_type: string option;

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       109
        
         }

     

       110
       +
       

     

       111
       +
         val yojson_of_t : t -> Json.t

     

       112
       +
         val t_of_yojson : Json.t -> t

     

       113
        
       end

     

       114
        
       

     

       115
       +
       (** Text resource contents *)

     

       116
        
       module TextResourceContents : sig

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       117
        
         type t = {

     

       118
        
           uri: string;

     

       0
        
       
     

       0
        
       
     

       119
        
           text: string;

     

       0
        
       
     

       0
        
       
     

       120
        
           mime_type: string option;

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       121
        
         }

     

       122
       +
       

     

       123
       +
         val yojson_of_t : t -> Json.t

     

       124
       +
         val t_of_yojson : Json.t -> t

     

       125
        
       end

     

       126
        
       

     

       127
       +
       (** Binary resource contents *)

     

       128
        
       module BlobResourceContents : sig

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       129
        
         type t = {

     

       130
        
           uri: string;

     

       0
        
       
     

       0
        
       
     

       131
        
           blob: string;

     

       0
        
       
     

       0
        
       
     

       132
        
           mime_type: string option;

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       133
        
         }

     

       134
       +
       

     

       135
       +
         val yojson_of_t : t -> Json.t

     

       136
       +
         val t_of_yojson : Json.t -> t

     

       137
        
       end

     

       138
        
       

     

       139
       +
       (** Embedded resource *)

     

       140
        
       module EmbeddedResource : sig

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       141
        
         type t = {

     

       142
        
           resource: [ `Text of TextResourceContents.t | `Blob of BlobResourceContents.t ];

     

       0
        
       
     

       143
        
           annotations: Annotated.annotation option;

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       144
        
         }

     

       145
       +
       

     

       146
       +
         val yojson_of_t : t -> Json.t

     

       147
       +
         val t_of_yojson : Json.t -> t

     

       148
        
       end

     

       149
        
       

     

       150
       +
       (** Content type used in messages *)

     

       151
        
       type content = 

     

       152
       +
         | Text of TextContent.t

     

       153
       +
         | Image of ImageContent.t

     

       154
       +
         | Audio of AudioContent.t

     

       155
       +
         | Resource of EmbeddedResource.t

     

       156
        
       

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       157
        
       val yojson_of_content : content -> Json.t

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       158
        
       val content_of_yojson : Json.t -> content

     

       159
        
       

     

       160
       +
       (** Message for prompts *)

     

       161
        
       module PromptMessage : sig

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       162
        
         type t = {

     

       163
        
           role: Role.t;

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       164
        
           content: content;

     

       0
        
       
     

       0
        
       
     

       165
        
         }

     

       166
       +
       

     

       167
       +
         val yojson_of_t : t -> Json.t

     

       168
       +
         val t_of_yojson : Json.t -> t

     

       169
        
       end

     

       170
        
       

     

       171
       +
       (** Message for sampling *)

     

       172
        
       module SamplingMessage : sig

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       173
        
         type t = {

     

       174
        
           role: Role.t;

     

       175
       +
           content: [ `Text of TextContent.t | `Image of ImageContent.t ];

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       176
        
         }

     

       177
       +
       

     

       178
       +
         val yojson_of_t : t -> Json.t

     

       179
       +
         val t_of_yojson : Json.t -> t

     

       180
        
       end

     

       181
        
       

     

       182
        
       (** Implementation information *)

     

       183
        
       module Implementation : sig

     

       0
        
       
     

       0
        
       
     

       184
        
         type t = {

     

       185
        
           name: string;

     

       0
        
       
     

       186
        
           version: string;

     

       0
        
       
     

       187
        
         }

     

       188
       +
       

     

       189
       +
         val yojson_of_t : t -> Json.t

     

       190
       +
         val t_of_yojson : Json.t -> t

     

       191
        
       end

     

       192
        
       

     

       193
       +
       (** JSONRPC message types *)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       194
        
       module JSONRPCMessage : sig

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       195
        
         type notification = {

     

       196
       +
           method_: string;

     

       0
        
       
     

       0
        
       
     

       197
        
           params: Json.t option;

     

       0
        
       
     

       0
        
       
     

       198
        
         }

     

       199
        
       

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       200
        
         type request = {

     

       201
        
           id: RequestId.t;

     

       202
       +
           method_: string;

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       203
        
           params: Json.t option;

     

       0
        
       
     

       0
        
       
     

       204
        
           progress_token: ProgressToken.t option;

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       205
        
         }

     

       206
        
       

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       207
        
         type response = {

     

       208
        
           id: RequestId.t;

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       209
        
           result: Json.t;

     

       0
        
       
     

       0
        
       
     

       210
        
         }

     

       211
        
       

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       212
        
         type error = {

     

       213
        
           id: RequestId.t;

     

       0
        
       
     

       0
        
       
     

       214
        
           code: int;

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       215
        
           message: string;

     

       0
        
       
     

       0
        
       
     

       216
        
           data: Json.t option;

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       217
        
         }

     

       218
        
       

     

       0
        
       
     

       0
        
       
     

       219
        
         type t =

     

       220
        
           | Notification of notification

     

       221
        
           | Request of request

     

       222
        
           | Response of response

     

       223
        
           | Error of error

     

       224
        
       

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       225
        
         val yojson_of_notification : notification -> Json.t

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       226
        
         val yojson_of_request : request -> Json.t

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       227
        
         val yojson_of_response : response -> Json.t

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       228
        
         val yojson_of_error : error -> Json.t

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       229
        
         val yojson_of_t : t -> Json.t

     

       230
        
       

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       231
        
         val notification_of_yojson : Json.t -> notification

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       232
        
         val request_of_yojson : Json.t -> request

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       233
        
         val response_of_yojson : Json.t -> response

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       234
        
         val error_of_yojson : Json.t -> error

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       235
        
         val t_of_yojson : Json.t -> t

     

       236
        
       

     

       237
       +
         val create_notification : ?params:Json.t option -> method_:string -> unit -> t

     

       238
       +
         val create_request : ?params:Json.t option -> ?progress_token:ProgressToken.t option -> id:RequestId.t -> method_:string -> unit -> t

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       239
        
         val create_response : id:RequestId.t -> result:Json.t -> t

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       240
        
         val create_error : id:RequestId.t -> code:int -> message:string -> ?data:Json.t option -> unit -> t

     

       241
        
       end

     

       242
        
       

     

       243
       +
       (** Initialize request/response *)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       244
        
       module Initialize : sig

     

       245
        
         (** Initialize request *)

     

       246
        
         module Request : sig

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       247
        
           type t = {

     

       248
       +
             capabilities: Json.t; (** ClientCapabilities *)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       249
        
             client_info: Implementation.t;

     

       0
        
       
     

       0
        
       
     

       250
        
             protocol_version: string;

     

       0
        
       
     

       0
        
       
     

       251
        
           }

     

       252
       +
       

     

       253
       +
           val yojson_of_t : t -> Json.t

     

       254
       +
           val t_of_yojson : Json.t -> t

     

       255
        
       

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       256
        
           val create : capabilities:Json.t -> client_info:Implementation.t -> protocol_version:string -> t

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       257
        
           val to_jsonrpc : id:RequestId.t -> t -> JSONRPCMessage.t

     

       258
        
         end

     

       259
        
       

     

       260
        
         (** Initialize result *)

     

       261
        
         module Result : sig

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       262
        
           type t = {

     

       263
       +
             capabilities: Json.t; (** ServerCapabilities *)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       264
        
             server_info: Implementation.t;

     

       0
        
       
     

       0
        
       
     

       265
        
             protocol_version: string;

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       266
        
             instructions: string option;

     

       0
        
       
     

       0
        
       
     

       267
        
             meta: Json.t option;

     

       0
        
       
     

       0
        
       
     

       268
        
           }

     

       269
       +
       

     

       270
       +
           val yojson_of_t : t -> Json.t

     

       271
       +
           val t_of_yojson : Json.t -> t

     

       272
        
       

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       273
        
           val create : capabilities:Json.t -> server_info:Implementation.t -> protocol_version:string -> ?instructions:string -> ?meta:Json.t -> unit -> t

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       274
        
           val to_jsonrpc : id:RequestId.t -> t -> JSONRPCMessage.t

     

       275
        
         end

     

       276
        
       end

     

       277
        
       

     

       278
       +
       (** Initialized notification *)

     

       279
        
       module Initialized : sig

     

       280
        
         module Notification : sig

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       281
        
           type t = {

     

       282
        
             meta: Json.t option;

     

       0
        
       
     

       0
        
       
     

       283
        
           }

     

       284
       +
       

     

       285
       +
           val yojson_of_t : t -> Json.t

     

       286
       +
           val t_of_yojson : Json.t -> t

     

       287
        
       

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       288
        
           val create : ?meta:Json.t -> unit -> t

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       289
        
           val to_jsonrpc : t -> JSONRPCMessage.t

     

       290
        
         end

     

       291
        
       end

     

       292
        
       

     

       293
       +
       (** Tool definition *)

     

       294
       +
       module Tool : sig

     

       295
       +
         type t = {

     

       296
       +
           name: string;

     

       297
       +
           description: string option;

     

       298
       +
           input_schema: Json.t;

     

       299
       +
         }

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       300
        
       

     

       301
       +
         val yojson_of_t : t -> Json.t

     

       302
       +
         val t_of_yojson : Json.t -> t

     

       303
       +
       end

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       304
        
       

     

       305
       +
       (** Tool result *)

     

       306
       +
       module CallToolResult : sig

     

       307
       +
         type t = {

     

       308
       +
           content: content list;

     

       309
       +
           is_error: bool;

     

       310
       +
           meta: Json.t option;

     

       311
       +
         }

     

       312
       +
         

     

       313
       +
         val yojson_of_t : t -> Json.t

     

       314
       +
         val t_of_yojson : Json.t -> t

     

       315
       +
       end

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       316
        
       

     

       317
       +
       (** Resource definition *)

     

       318
       +
       module Resource : sig

     

       319
       +
         type t = {

     

       320
       +
           name: string;

     

       321
       +
           uri: string;

     

       322
       +
           description: string option;

     

       323
       +
           mime_type: string option;

     

       324
       +
           size: int option;

     

       325
       +
           annotations: Annotated.annotation option;

     

       326
       +
         }

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       327
        
       

     

       328
       +
         val yojson_of_t : t -> Json.t

     

       329
       +
         val t_of_yojson : Json.t -> t

     

       330
       +
       end

     

       331
       +
       

     

       332
       +
       (** Resource Template definition *)

     

       333
       +
       module ResourceTemplate : sig

     

       334
       +
         type t = {

     

       335
       +
           name: string;

     

       336
       +
           uri_template: string;

     

       337
       +
           description: string option;

     

       338
       +
           mime_type: string option;

     

       339
       +
           annotations: Annotated.annotation option;

     

       340
       +
         }

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       341
        
       

     

       342
       +
         val yojson_of_t : t -> Json.t

     

       343
       +
         val t_of_yojson : Json.t -> t

     

       344
       +
       end

     

       0
        
       
     

       0
        
       
     

       345
        
       

     

       346
       +
       (** Resource Reference *)

     

       347
       +
       module ResourceReference : sig

     

       348
       +
         type t = {

     

       349
       +
           uri: string;

     

       350
       +
         }

     

       0
        
       
     

       351
        
       

     

       352
       +
         val yojson_of_t : t -> Json.t

     

       353
       +
         val t_of_yojson : Json.t -> t

     

       354
       +
       end

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       355
        
       

     

       356
       +
       (** Prompt Reference *)

     

       357
       +
       module PromptReference : sig

     

       358
       +
         type t = {

     

       359
       +
           name: string;

     

       360
       +
         }

     

       0
        
       
     

       0
        
       
     

       361
        
       

     

       362
       +
         val yojson_of_t : t -> Json.t

     

       363
       +
         val t_of_yojson : Json.t -> t

     

       364
       +
       end

     

       365
       +
       

     

       366
       +
       (** Completion support *)

     

       367
       +
       module Completion : sig

     

       368
       +
         module Argument : sig

     

       369
       +
           type t = {

     

       370
       +
             name: string;

     

       371
       +
             value: string;

     

       372
       +
           }

     

       373
       +
       

     

       374
       +
           val yojson_of_t : t -> Json.t

     

       375
       +
           val t_of_yojson : Json.t -> t

     

       376
       +
         end

     

       377
       +
       

     

       378
       +
         module Request : sig

     

       379
       +
           type reference = [ `Prompt of PromptReference.t | `Resource of ResourceReference.t ]

     

       380
       +
       

     

       381
       +
           type t = {

     

       382
       +
             argument: Argument.t;

     

       383
       +
             ref: reference;

     

       384
       +
           }

     

       385
       +
       

     

       386
       +
           val yojson_of_t : t -> Json.t

     

       387
       +
           val t_of_yojson : Json.t -> t

     

       388
       +
       

     

       389
       +
           val yojson_of_reference : reference -> Json.t

     

       390
       +
           val reference_of_yojson : Json.t -> reference

     

       391
       +
       

     

       392
       +
           val create : argument:Argument.t -> ref:reference -> t

     

       393
       +
           val to_params : t -> Json.t

     

       394
       +
         end

     

       395
       +
       

     

       396
       +
         module Result : sig

     

       397
       +
           type completion = {

     

       398
       +
             values: string list;

     

       399
       +
             has_more: bool option;

     

       400
       +
             total: int option;

     

       401
       +
           }

     

       402
       +
       

     

       403
       +
           type t = {

     

       404
       +
             completion: completion;

     

       405
       +
             meta: Json.t option;

     

       406
       +
           }

     

       407
       +
       

     

       408
       +
           val yojson_of_completion : completion -> Json.t

     

       409
       +
           val completion_of_yojson : Json.t -> completion

     

       410
       +
       

     

       411
       +
           val yojson_of_t : t -> Json.t

     

       412
       +
           val t_of_yojson : Json.t -> t

     

       413
       +
       

     

       414
       +
           val create : completion:completion -> ?meta:Json.t -> unit -> t

     

       415
       +
           val to_result : t -> Json.t

     

       416
       +
         end

     

       417
       +
       end

     

       418
       +
       

     

       419
       +
       (** Parse a JSON message into an MCP message *)

     

       420
       +
       val parse_message : Json.t -> JSONRPCMessage.t

     

       421
       +
       

     

       422
       +
       (** Create JSONRPC message helpers *)

     

       423
       +
       val create_notification : ?params:Json.t option -> method_:string -> unit -> JSONRPCMessage.t

     

       424
       +
       val create_request : ?params:Json.t option -> ?progress_token:ProgressToken.t option -> id:RequestId.t -> method_:string -> unit -> JSONRPCMessage.t

     

       425
       +
       val create_response : id:RequestId.t -> result:Json.t -> JSONRPCMessage.t

     

       426
       +
       val create_error : id:RequestId.t -> code:int -> message:string -> ?data:Json.t option -> unit -> JSONRPCMessage.t

     

       427
       +
       

     

       428
       +
       (** Helper functions for common requests/responses *)

     

       429
       +
       val create_completion_request : id:RequestId.t -> argument:Completion.Argument.t -> ref:Completion.Request.reference -> JSONRPCMessage.t

     

       430
       +
       val create_completion_response : id:RequestId.t -> values:string list -> ?has_more:bool option -> ?total:int option -> ?meta:Json.t option -> unit -> JSONRPCMessage.t

-726

lib/mcp_rpc.ml

···

       1
       -
       (* Mcp_message - High-level RPC message definitions for Model Context Protocol *)

     

       2
       -
       

     

       3
       -
       open Mcp

     

       4
       -
       open Jsonrpc

     

       5
       -
       

     

       6
       -
       (* Resources/List *)

     

       7
       -
       module ResourcesList = struct

     

       8
       -
         module Request = struct

     

       9
       -
           type t = {

     

       10
       -
             cursor: Cursor.t option;

     

       11
       -
           }

     

       12
       -
           

     

       13
       -
           let yojson_of_t { cursor } =

     

       14
       -
             let assoc = [] in

     

       15
       -
             let assoc = match cursor with

     

       16
       -
               | Some c -> ("cursor", Cursor.yojson_of_t c) :: assoc

     

       17
       -
               | None -> assoc

     

       18
       -
             in

     

       19
       -
             `Assoc assoc

     

       20
       -
           

     

       21
       -
           let t_of_yojson = function

     

       22
       -
             | `Assoc fields ->

     

       23
       -
               let cursor = List.assoc_opt "cursor" fields |> Option.map Cursor.t_of_yojson in

     

       24
       -
               { cursor }

     

       25
       -
             | j -> Util.json_error "Expected object for ResourcesList.Request.t" j

     

       26
       -
             

     

       27
       -
         end

     

       28
       -
         

     

       29
       -
         module Resource = struct

     

       30
       -
           type t = {

     

       31
       -
             uri: string;

     

       32
       -
             name: string;

     

       33
       -
             description: string option;

     

       34
       -
             mime_type: string option;

     

       35
       -
             size: int option;

     

       36
       -
           }

     

       37
       -
           

     

       38
       -
           let yojson_of_t { uri; name; description; mime_type; size } =

     

       39
       -
             let assoc = [

     

       40
       -
               ("uri", `String uri);

     

       41
       -
               ("name", `String name);

     

       42
       -
             ] in

     

       43
       -
             let assoc = match description with

     

       44
       -
               | Some desc -> ("description", `String desc) :: assoc

     

       45
       -
               | None -> assoc

     

       46
       -
             in

     

       47
       -
             let assoc = match mime_type with

     

       48
       -
               | Some mime -> ("mimeType", `String mime) :: assoc

     

       49
       -
               | None -> assoc

     

       50
       -
             in

     

       51
       -
             let assoc = match size with

     

       52
       -
               | Some s -> ("size", `Int s) :: assoc

     

       53
       -
               | None -> assoc

     

       54
       -
             in

     

       55
       -
             `Assoc assoc

     

       56
       -
           

     

       57
       -
           let t_of_yojson = function

     

       58
       -
             | `Assoc fields as json ->

     

       59
       -
               let uri = match List.assoc_opt "uri" fields with

     

       60
       -
                 | Some (`String s) -> s

     

       61
       -
                 | _ -> Util.json_error "Missing or invalid 'uri' field" json

     

       62
       -
               in

     

       63
       -
               let name = match List.assoc_opt "name" fields with

     

       64
       -
                 | Some (`String s) -> s

     

       65
       -
                 | _ -> Util.json_error "Missing or invalid 'name' field" json

     

       66
       -
               in

     

       67
       -
               let description = List.assoc_opt "description" fields |> Option.map (function

     

       68
       -
                 | `String s -> s

     

       69
       -
                 | j -> Util.json_error "Expected string for description" j

     

       70
       -
               ) in

     

       71
       -
               let mime_type = List.assoc_opt "mimeType" fields |> Option.map (function

     

       72
       -
                 | `String s -> s

     

       73
       -
                 | j -> Util.json_error "Expected string for mimeType" j

     

       74
       -
               ) in

     

       75
       -
               let size = List.assoc_opt "size" fields |> Option.map (function

     

       76
       -
                 | `Int i -> i

     

       77
       -
                 | j -> Util.json_error "Expected int for size" j

     

       78
       -
               ) in

     

       79
       -
               { uri; name; description; mime_type; size }

     

       80
       -
             | j -> Util.json_error "Expected object for ResourcesList.Resource.t" j

     

       81
       -
         end

     

       82
       -
         

     

       83
       -
         module Response = struct

     

       84
       -
           type t = {

     

       85
       -
             resources: Resource.t list;

     

       86
       -
             next_cursor: Cursor.t option;

     

       87
       -
           }

     

       88
       -
           

     

       89
       -
           let yojson_of_t { resources; next_cursor } =

     

       90
       -
             let assoc = [

     

       91
       -
               ("resources", `List (List.map Resource.yojson_of_t resources));

     

       92
       -
             ] in

     

       93
       -
             let assoc = match next_cursor with

     

       94
       -
               | Some c -> ("nextCursor", Cursor.yojson_of_t c) :: assoc

     

       95
       -
               | None -> assoc

     

       96
       -
             in

     

       97
       -
             `Assoc assoc

     

       98
       -
           

     

       99
       -
           let t_of_yojson = function

     

       100
       -
             | `Assoc fields as json ->

     

       101
       -
               let resources = match List.assoc_opt "resources" fields with

     

       102
       -
                 | Some (`List items) -> List.map Resource.t_of_yojson items

     

       103
       -
                 | _ -> Util.json_error "Missing or invalid 'resources' field" json

     

       104
       -
               in

     

       105
       -
               let next_cursor = List.assoc_opt "nextCursor" fields |> Option.map Cursor.t_of_yojson in

     

       106
       -
               { resources; next_cursor }

     

       107
       -
             | j -> Util.json_error "Expected object for ResourcesList.Response.t" j

     

       108
       -
             

     

       109
       -
         end

     

       110
       -
         

     

       111
       -
         (* Request/response creation helpers *)

     

       112
       -
         let create_request ?cursor ?id () =

     

       113
       -
           let id = match id with

     

       114
       -
             | Some i -> i

     

       115
       -
             | None -> `Int (Random.int 10000)

     

       116
       -
           in

     

       117
       -
           let params = Request.yojson_of_t { cursor } in

     

       118
       -
           JSONRPCMessage.create_request ~id ~meth:Method.ResourcesList ~params:(Some params) ()

     

       119
       -
         

     

       120
       -
         let create_response ~id ~resources ?next_cursor () =

     

       121
       -
           let result = Response.yojson_of_t { resources; next_cursor } in

     

       122
       -
           JSONRPCMessage.create_response ~id ~result

     

       123
       -
       end

     

       124
       -
       

     

       125
       -
       (* Resources/Read *)

     

       126
       -
       module ResourcesRead = struct

     

       127
       -
         module Request = struct

     

       128
       -
           type t = {

     

       129
       -
             uri: string;

     

       130
       -
           }

     

       131
       -
           

     

       132
       -
           let yojson_of_t { uri } =

     

       133
       -
             `Assoc [

     

       134
       -
               ("uri", `String uri);

     

       135
       -
             ]

     

       136
       -
           

     

       137
       -
           let t_of_yojson = function

     

       138
       -
             | `Assoc fields as json ->

     

       139
       -
               let uri = match List.assoc_opt "uri" fields with

     

       140
       -
                 | Some (`String s) -> s

     

       141
       -
                 | _ -> Util.json_error "Missing or invalid 'uri' field" json

     

       142
       -
               in

     

       143
       -
               { uri }

     

       144
       -
             | j -> Util.json_error "Expected object for ResourcesRead.Request.t" j

     

       145
       -
             

     

       146
       -
         end

     

       147
       -
         

     

       148
       -
         module ResourceContent = struct

     

       149
       -
           type t = 

     

       150
       -
             | TextResource of TextResourceContents.t

     

       151
       -
             | BlobResource of BlobResourceContents.t

     

       152
       -
           

     

       153
       -
           let yojson_of_t = function

     

       154
       -
             | TextResource tr -> TextResourceContents.yojson_of_t tr

     

       155
       -
             | BlobResource br -> BlobResourceContents.yojson_of_t br

     

       156
       -
           

     

       157
       -
           let t_of_yojson json =

     

       158
       -
             match json with

     

       159
       -
             | `Assoc fields ->

     

       160
       -
               if List.mem_assoc "text" fields then

     

       161
       -
                 TextResource (TextResourceContents.t_of_yojson json)

     

       162
       -
               else if List.mem_assoc "blob" fields then

     

       163
       -
                 BlobResource (BlobResourceContents.t_of_yojson json)

     

       164
       -
               else

     

       165
       -
                 Util.json_error "Invalid resource content" json

     

       166
       -
             | j -> Util.json_error "Expected object for ResourcesRead.ResourceContent.t" j

     

       167
       -
             

     

       168
       -
         end

     

       169
       -
         

     

       170
       -
         module Response = struct

     

       171
       -
           type t = {

     

       172
       -
             contents: ResourceContent.t list;

     

       173
       -
           }

     

       174
       -
           

     

       175
       -
           let yojson_of_t { contents } =

     

       176
       -
             `Assoc [

     

       177
       -
               ("contents", `List (List.map ResourceContent.yojson_of_t contents));

     

       178
       -
             ]

     

       179
       -
           

     

       180
       -
           let t_of_yojson = function

     

       181
       -
             | `Assoc fields as json ->

     

       182
       -
               let contents = match List.assoc_opt "contents" fields with

     

       183
       -
                 | Some (`List items) -> List.map ResourceContent.t_of_yojson items

     

       184
       -
                 | _ -> Util.json_error "Missing or invalid 'contents' field" json

     

       185
       -
               in

     

       186
       -
               { contents }

     

       187
       -
             | j -> Util.json_error "Expected object for ResourcesRead.Response.t" j

     

       188
       -
             

     

       189
       -
         end

     

       190
       -
         

     

       191
       -
         (* Request/response creation helpers *)

     

       192
       -
         let create_request ~uri ?id () =

     

       193
       -
           let id = match id with

     

       194
       -
             | Some i -> i

     

       195
       -
             | None -> `Int (Random.int 10000)

     

       196
       -
           in

     

       197
       -
           let params = Request.yojson_of_t { uri } in

     

       198
       -
           JSONRPCMessage.create_request ~id ~meth:Method.ResourcesRead ~params:(Some params) ()

     

       199
       -
         

     

       200
       -
         let create_response ~id ~contents () =

     

       201
       -
           let result = Response.yojson_of_t { contents } in

     

       202
       -
           JSONRPCMessage.create_response ~id ~result

     

       203
       -
       end

     

       204
       -
       

     

       205
       -
       (* Tools/List *)

     

       206
       -
       module ToolsList = struct

     

       207
       -
         module Request = struct

     

       208
       -
           type t = {

     

       209
       -
             cursor: Cursor.t option;

     

       210
       -
           }

     

       211
       -
           

     

       212
       -
           let yojson_of_t { cursor } =

     

       213
       -
             let assoc = [] in

     

       214
       -
             let assoc = match cursor with

     

       215
       -
               | Some c -> ("cursor", Cursor.yojson_of_t c) :: assoc

     

       216
       -
               | None -> assoc

     

       217
       -
             in

     

       218
       -
             `Assoc assoc

     

       219
       -
           

     

       220
       -
           let t_of_yojson = function

     

       221
       -
             | `Assoc fields ->

     

       222
       -
               let cursor = List.assoc_opt "cursor" fields |> Option.map Cursor.t_of_yojson in

     

       223
       -
               { cursor }

     

       224
       -
             | j -> Util.json_error "Expected object for ToolsList.Request.t" j

     

       225
       -
             

     

       226
       -
         end

     

       227
       -
         

     

       228
       -
         module Tool = struct

     

       229
       -
           type t = {

     

       230
       -
             name: string;

     

       231
       -
             description: string option;

     

       232
       -
             input_schema: Json.t;

     

       233
       -
             annotations: Json.t option;

     

       234
       -
           }

     

       235
       -
           

     

       236
       -
           let yojson_of_t { name; description; input_schema; annotations } =

     

       237
       -
             let assoc = [

     

       238
       -
               ("name", `String name);

     

       239
       -
               ("inputSchema", input_schema);

     

       240
       -
             ] in

     

       241
       -
             let assoc = match description with

     

       242
       -
               | Some desc -> ("description", `String desc) :: assoc

     

       243
       -
               | None -> assoc

     

       244
       -
             in

     

       245
       -
             let assoc = match annotations with

     

       246
       -
               | Some anno -> ("annotations", anno) :: assoc

     

       247
       -
               | None -> assoc

     

       248
       -
             in

     

       249
       -
             `Assoc assoc

     

       250
       -
           

     

       251
       -
           let t_of_yojson = function

     

       252
       -
             | `Assoc fields as json ->

     

       253
       -
               let name = match List.assoc_opt "name" fields with

     

       254
       -
                 | Some (`String s) -> s

     

       255
       -
                 | _ -> Util.json_error "Missing or invalid 'name' field" json

     

       256
       -
               in

     

       257
       -
               let description = List.assoc_opt "description" fields |> Option.map (function

     

       258
       -
                 | `String s -> s

     

       259
       -
                 | j -> Util.json_error "Expected string for description" j

     

       260
       -
               ) in

     

       261
       -
               let input_schema = match List.assoc_opt "inputSchema" fields with

     

       262
       -
                 | Some schema -> schema

     

       263
       -
                 | None -> Util.json_error "Missing 'inputSchema' field" json

     

       264
       -
               in

     

       265
       -
               let annotations = List.assoc_opt "annotations" fields in

     

       266
       -
               { name; description; input_schema; annotations }

     

       267
       -
             | j -> Util.json_error "Expected object for ToolsList.Tool.t" j

     

       268
       -
             

     

       269
       -
         end

     

       270
       -
         

     

       271
       -
         module Response = struct

     

       272
       -
           type t = {

     

       273
       -
             tools: Tool.t list;

     

       274
       -
             next_cursor: Cursor.t option;

     

       275
       -
           }

     

       276
       -
           

     

       277
       -
           let yojson_of_t { tools; next_cursor } =

     

       278
       -
             let assoc = [

     

       279
       -
               ("tools", `List (List.map Tool.yojson_of_t tools));

     

       280
       -
             ] in

     

       281
       -
             let assoc = match next_cursor with

     

       282
       -
               | Some c -> ("nextCursor", Cursor.yojson_of_t c) :: assoc

     

       283
       -
               | None -> assoc

     

       284
       -
             in

     

       285
       -
             `Assoc assoc

     

       286
       -
           

     

       287
       -
           let t_of_yojson = function

     

       288
       -
             | `Assoc fields as json ->

     

       289
       -
               let tools = match List.assoc_opt "tools" fields with

     

       290
       -
                 | Some (`List items) -> List.map Tool.t_of_yojson items

     

       291
       -
                 | _ -> Util.json_error "Missing or invalid 'tools' field" json

     

       292
       -
               in

     

       293
       -
               let next_cursor = List.assoc_opt "nextCursor" fields |> Option.map Cursor.t_of_yojson in

     

       294
       -
               { tools; next_cursor }

     

       295
       -
             | j -> Util.json_error "Expected object for ToolsList.Response.t" j

     

       296
       -
             

     

       297
       -
         end

     

       298
       -
         

     

       299
       -
         (* Request/response creation helpers *)

     

       300
       -
         let create_request ?cursor ?id () =

     

       301
       -
           let id = match id with

     

       302
       -
             | Some i -> i

     

       303
       -
             | None -> `Int (Random.int 10000)

     

       304
       -
           in

     

       305
       -
           let params = Request.yojson_of_t { cursor } in

     

       306
       -
           JSONRPCMessage.create_request ~id ~meth:Method.ToolsList ~params:(Some params) ()

     

       307
       -
         

     

       308
       -
         let create_response ~id ~tools ?next_cursor () =

     

       309
       -
           let result = Response.yojson_of_t { tools; next_cursor } in

     

       310
       -
           JSONRPCMessage.create_response ~id ~result

     

       311
       -
       end

     

       312
       -
       

     

       313
       -
       (* Tools/Call *)

     

       314
       -
       module ToolsCall = struct

     

       315
       -
         module Request = struct

     

       316
       -
           type t = {

     

       317
       -
             name: string;

     

       318
       -
             arguments: Json.t;

     

       319
       -
           }

     

       320
       -
           

     

       321
       -
           let yojson_of_t { name; arguments } =

     

       322
       -
             `Assoc [

     

       323
       -
               ("name", `String name);

     

       324
       -
               ("arguments", arguments);

     

       325
       -
             ]

     

       326
       -
           

     

       327
       -
           let t_of_yojson = function

     

       328
       -
             | `Assoc fields as json ->

     

       329
       -
               let name = match List.assoc_opt "name" fields with

     

       330
       -
                 | Some (`String s) -> s

     

       331
       -
                 | _ -> Util.json_error "Missing or invalid 'name' field" json

     

       332
       -
               in

     

       333
       -
               let arguments = match List.assoc_opt "arguments" fields with

     

       334
       -
                 | Some json -> json

     

       335
       -
                 | None -> Util.json_error "Missing 'arguments' field" json

     

       336
       -
               in

     

       337
       -
               { name; arguments }

     

       338
       -
             | j -> Util.json_error "Expected object for ToolsCall.Request.t" j

     

       339
       -
             

     

       340
       -
         end

     

       341
       -
         

     

       342
       -
         module ToolContent = struct

     

       343
       -
           type t = 

     

       344
       -
             | Text of TextContent.t

     

       345
       -
             | Image of ImageContent.t

     

       346
       -
             | Audio of AudioContent.t

     

       347
       -
             | Resource of EmbeddedResource.t

     

       348
       -
           

     

       349
       -
           let yojson_of_t = function

     

       350
       -
             | Text t -> TextContent.yojson_of_t t

     

       351
       -
             | Image i -> ImageContent.yojson_of_t i

     

       352
       -
             | Audio a -> AudioContent.yojson_of_t a

     

       353
       -
             | Resource r -> EmbeddedResource.yojson_of_t r

     

       354
       -
           

     

       355
       -
           let t_of_yojson json =

     

       356
       -
             match json with

     

       357
       -
             | `Assoc fields ->

     

       358
       -
               (match List.assoc_opt "type" fields with

     

       359
       -
                | Some (`String "text") -> Text (TextContent.t_of_yojson json)

     

       360
       -
                | Some (`String "image") -> Image (ImageContent.t_of_yojson json)

     

       361
       -
                | Some (`String "audio") -> Audio (AudioContent.t_of_yojson json)

     

       362
       -
                | Some (`String "resource") -> Resource (EmbeddedResource.t_of_yojson json)

     

       363
       -
                | _ -> Util.json_error "Invalid or missing content type" json)

     

       364
       -
             | j -> Util.json_error "Expected object for ToolsCall.ToolContent.t" j

     

       365
       -
             

     

       366
       -
         end

     

       367
       -
         

     

       368
       -
         module Response = struct

     

       369
       -
           type t = {

     

       370
       -
             content: ToolContent.t list;

     

       371
       -
             is_error: bool;

     

       372
       -
           }

     

       373
       -
           

     

       374
       -
           let yojson_of_t { content; is_error } =

     

       375
       -
             `Assoc [

     

       376
       -
               ("content", `List (List.map ToolContent.yojson_of_t content));

     

       377
       -
               ("isError", `Bool is_error);

     

       378
       -
             ]

     

       379
       -
           

     

       380
       -
           let t_of_yojson = function

     

       381
       -
             | `Assoc fields as json ->

     

       382
       -
               let content = match List.assoc_opt "content" fields with

     

       383
       -
                 | Some (`List items) -> List.map ToolContent.t_of_yojson items

     

       384
       -
                 | _ -> Util.json_error "Missing or invalid 'content' field" json

     

       385
       -
               in

     

       386
       -
               let is_error = match List.assoc_opt "isError" fields with

     

       387
       -
                 | Some (`Bool b) -> b

     

       388
       -
                 | _ -> false

     

       389
       -
               in

     

       390
       -
               { content; is_error }

     

       391
       -
             | j -> Util.json_error "Expected object for ToolsCall.Response.t" j

     

       392
       -
             

     

       393
       -
         end

     

       394
       -
         

     

       395
       -
         (* Request/response creation helpers *)

     

       396
       -
         let create_request ~name ~arguments ?id () =

     

       397
       -
           let id = match id with

     

       398
       -
             | Some i -> i

     

       399
       -
             | None -> `Int (Random.int 10000)

     

       400
       -
           in

     

       401
       -
           let params = Request.yojson_of_t { name; arguments } in

     

       402
       -
           JSONRPCMessage.create_request ~id ~meth:Method.ToolsCall ~params:(Some params) ()

     

       403
       -
         

     

       404
       -
         let create_response ~id ~content ~is_error () =

     

       405
       -
           let result = Response.yojson_of_t { content; is_error } in

     

       406
       -
           JSONRPCMessage.create_response ~id ~result

     

       407
       -
       end

     

       408
       -
       

     

       409
       -
       (* Prompts/List *)

     

       410
       -
       module PromptsList = struct

     

       411
       -
         module PromptArgument = struct

     

       412
       -
           type t = {

     

       413
       -
             name: string;

     

       414
       -
             description: string option;

     

       415
       -
             required: bool;

     

       416
       -
           }

     

       417
       -
           

     

       418
       -
           let yojson_of_t { name; description; required } =

     

       419
       -
             let assoc = [

     

       420
       -
               ("name", `String name);

     

       421
       -
             ] in

     

       422
       -
             let assoc = match description with

     

       423
       -
               | Some desc -> ("description", `String desc) :: assoc

     

       424
       -
               | None -> assoc

     

       425
       -
             in

     

       426
       -
             let assoc = if required then

     

       427
       -
               ("required", `Bool true) :: assoc

     

       428
       -
             else

     

       429
       -
               assoc

     

       430
       -
             in

     

       431
       -
             `Assoc assoc

     

       432
       -
           

     

       433
       -
           let t_of_yojson = function

     

       434
       -
             | `Assoc fields as json ->

     

       435
       -
               let name = match List.assoc_opt "name" fields with

     

       436
       -
                 | Some (`String s) -> s

     

       437
       -
                 | _ -> Util.json_error "Missing or invalid 'name' field" json

     

       438
       -
               in

     

       439
       -
               let description = List.assoc_opt "description" fields |> Option.map (function

     

       440
       -
                 | `String s -> s

     

       441
       -
                 | j -> Util.json_error "Expected string for description" j

     

       442
       -
               ) in

     

       443
       -
               let required = match List.assoc_opt "required" fields with

     

       444
       -
                 | Some (`Bool b) -> b

     

       445
       -
                 | _ -> false

     

       446
       -
               in

     

       447
       -
               { name; description; required }

     

       448
       -
             | j -> Util.json_error "Expected object for PromptsList.PromptArgument.t" j

     

       449
       -
             

     

       450
       -
         end

     

       451
       -
         

     

       452
       -
         module Prompt = struct

     

       453
       -
           type t = {

     

       454
       -
             name: string;

     

       455
       -
             description: string option;

     

       456
       -
             arguments: PromptArgument.t list;

     

       457
       -
           }

     

       458
       -
           

     

       459
       -
           let yojson_of_t { name; description; arguments } =

     

       460
       -
             let assoc = [

     

       461
       -
               ("name", `String name);

     

       462
       -
             ] in

     

       463
       -
             let assoc = match description with

     

       464
       -
               | Some desc -> ("description", `String desc) :: assoc

     

       465
       -
               | None -> assoc

     

       466
       -
             in

     

       467
       -
             let assoc = if arguments <> [] then

     

       468
       -
               ("arguments", `List (List.map PromptArgument.yojson_of_t arguments)) :: assoc

     

       469
       -
             else

     

       470
       -
               assoc

     

       471
       -
             in

     

       472
       -
             `Assoc assoc

     

       473
       -
           

     

       474
       -
           let t_of_yojson = function

     

       475
       -
             | `Assoc fields as json ->

     

       476
       -
               let name = match List.assoc_opt "name" fields with

     

       477
       -
                 | Some (`String s) -> s

     

       478
       -
                 | _ -> Util.json_error "Missing or invalid 'name' field" json

     

       479
       -
               in

     

       480
       -
               let description = List.assoc_opt "description" fields |> Option.map (function

     

       481
       -
                 | `String s -> s

     

       482
       -
                 | j -> Util.json_error "Expected string for description" j

     

       483
       -
               ) in

     

       484
       -
               let arguments = match List.assoc_opt "arguments" fields with

     

       485
       -
                 | Some (`List items) -> List.map PromptArgument.t_of_yojson items

     

       486
       -
                 | _ -> []

     

       487
       -
               in

     

       488
       -
               { name; description; arguments }

     

       489
       -
             | j -> Util.json_error "Expected object for PromptsList.Prompt.t" j

     

       490
       -
             

     

       491
       -
         end

     

       492
       -
         

     

       493
       -
         module Request = struct

     

       494
       -
           type t = {

     

       495
       -
             cursor: Cursor.t option;

     

       496
       -
           }

     

       497
       -
           

     

       498
       -
           let yojson_of_t { cursor } =

     

       499
       -
             let assoc = [] in

     

       500
       -
             let assoc = match cursor with

     

       501
       -
               | Some c -> ("cursor", Cursor.yojson_of_t c) :: assoc

     

       502
       -
               | None -> assoc

     

       503
       -
             in

     

       504
       -
             `Assoc assoc

     

       505
       -
           

     

       506
       -
           let t_of_yojson = function

     

       507
       -
             | `Assoc fields ->

     

       508
       -
               let cursor = List.assoc_opt "cursor" fields |> Option.map Cursor.t_of_yojson in

     

       509
       -
               { cursor }

     

       510
       -
             | j -> Util.json_error "Expected object for PromptsList.Request.t" j

     

       511
       -
             

     

       512
       -
         end

     

       513
       -
         

     

       514
       -
         module Response = struct

     

       515
       -
           type t = {

     

       516
       -
             prompts: Prompt.t list;

     

       517
       -
             next_cursor: Cursor.t option;

     

       518
       -
           }

     

       519
       -
           

     

       520
       -
           let yojson_of_t { prompts; next_cursor } =

     

       521
       -
             let assoc = [

     

       522
       -
               ("prompts", `List (List.map Prompt.yojson_of_t prompts));

     

       523
       -
             ] in

     

       524
       -
             let assoc = match next_cursor with

     

       525
       -
               | Some c -> ("nextCursor", Cursor.yojson_of_t c) :: assoc

     

       526
       -
               | None -> assoc

     

       527
       -
             in

     

       528
       -
             `Assoc assoc

     

       529
       -
           

     

       530
       -
           let t_of_yojson = function

     

       531
       -
             | `Assoc fields as json ->

     

       532
       -
               let prompts = match List.assoc_opt "prompts" fields with

     

       533
       -
                 | Some (`List items) -> List.map Prompt.t_of_yojson items

     

       534
       -
                 | _ -> Util.json_error "Missing or invalid 'prompts' field" json

     

       535
       -
               in

     

       536
       -
               let next_cursor = List.assoc_opt "nextCursor" fields |> Option.map Cursor.t_of_yojson in

     

       537
       -
               { prompts; next_cursor }

     

       538
       -
             | j -> Util.json_error "Expected object for PromptsList.Response.t" j

     

       539
       -
             

     

       540
       -
         end

     

       541
       -
         

     

       542
       -
         (* Request/response creation helpers *)

     

       543
       -
         let create_request ?cursor ?id () =

     

       544
       -
           let id = match id with

     

       545
       -
             | Some i -> i

     

       546
       -
             | None -> `Int (Random.int 10000)

     

       547
       -
           in

     

       548
       -
           let params = Request.yojson_of_t { cursor } in

     

       549
       -
           JSONRPCMessage.create_request ~id ~meth:Method.PromptsList ~params:(Some params) ()

     

       550
       -
         

     

       551
       -
         let create_response ~id ~prompts ?next_cursor () =

     

       552
       -
           let result = Response.yojson_of_t { prompts; next_cursor } in

     

       553
       -
           JSONRPCMessage.create_response ~id ~result

     

       554
       -
       end

     

       555
       -
       

     

       556
       -
       (* Prompts/Get *)

     

       557
       -
       module PromptsGet = struct

     

       558
       -
         module Request = struct

     

       559
       -
           type t = {

     

       560
       -
             name: string;

     

       561
       -
             arguments: (string * string) list;

     

       562
       -
           }

     

       563
       -
           

     

       564
       -
           let yojson_of_t { name; arguments } =

     

       565
       -
             let args_json = `Assoc (List.map (fun (k, v) -> (k, `String v)) arguments) in

     

       566
       -
             `Assoc [

     

       567
       -
               ("name", `String name);

     

       568
       -
               ("arguments", args_json);

     

       569
       -
             ]

     

       570
       -
           

     

       571
       -
           let t_of_yojson = function

     

       572
       -
             | `Assoc fields as json ->

     

       573
       -
               let name = match List.assoc_opt "name" fields with

     

       574
       -
                 | Some (`String s) -> s

     

       575
       -
                 | _ -> Util.json_error "Missing or invalid 'name' field" json

     

       576
       -
               in

     

       577
       -
               let arguments = match List.assoc_opt "arguments" fields with

     

       578
       -
                 | Some (`Assoc args) -> 

     

       579
       -
                   List.map (fun (k, v) -> 

     

       580
       -
                     match v with

     

       581
       -
                     | `String s -> (k, s)

     

       582
       -
                     | _ -> Util.json_error "Expected string value for argument" v

     

       583
       -
                   ) args

     

       584
       -
                 | _ -> []

     

       585
       -
               in

     

       586
       -
               { name; arguments }

     

       587
       -
             | j -> Util.json_error "Expected object for PromptsGet.Request.t" j

     

       588
       -
             

     

       589
       -
         end

     

       590
       -
         

     

       591
       -
         module Response = struct

     

       592
       -
           type t = {

     

       593
       -
             description: string option;

     

       594
       -
             messages: PromptMessage.t list;

     

       595
       -
           }

     

       596
       -
           

     

       597
       -
           let yojson_of_t { description; messages } =

     

       598
       -
             let assoc = [

     

       599
       -
               ("messages", `List (List.map PromptMessage.yojson_of_t messages));

     

       600
       -
             ] in

     

       601
       -
             let assoc = match description with

     

       602
       -
               | Some desc -> ("description", `String desc) :: assoc

     

       603
       -
               | None -> assoc

     

       604
       -
             in

     

       605
       -
             `Assoc assoc

     

       606
       -
           

     

       607
       -
           let t_of_yojson = function

     

       608
       -
             | `Assoc fields as json ->

     

       609
       -
               let messages = match List.assoc_opt "messages" fields with

     

       610
       -
                 | Some (`List items) -> List.map PromptMessage.t_of_yojson items

     

       611
       -
                 | _ -> Util.json_error "Missing or invalid 'messages' field" json

     

       612
       -
               in

     

       613
       -
               let description = List.assoc_opt "description" fields |> Option.map (function

     

       614
       -
                 | `String s -> s

     

       615
       -
                 | j -> Util.json_error "Expected string for description" j

     

       616
       -
               ) in

     

       617
       -
               { description; messages }

     

       618
       -
             | j -> Util.json_error "Expected object for PromptsGet.Response.t" j

     

       619
       -
             

     

       620
       -
         end

     

       621
       -
         

     

       622
       -
         (* Request/response creation helpers *)

     

       623
       -
         let create_request ~name ~arguments ?id () =

     

       624
       -
           let id = match id with

     

       625
       -
             | Some i -> i

     

       626
       -
             | None -> `Int (Random.int 10000)

     

       627
       -
           in

     

       628
       -
           let params = Request.yojson_of_t { name; arguments } in

     

       629
       -
           JSONRPCMessage.create_request ~id ~meth:Method.PromptsGet ~params:(Some params) ()

     

       630
       -
         

     

       631
       -
         let create_response ~id ?description ~messages () =

     

       632
       -
           let result = Response.yojson_of_t { description; messages } in

     

       633
       -
           JSONRPCMessage.create_response ~id ~result

     

       634
       -
       end

     

       635
       -
       

     

       636
       -
       (* List Changed Notifications *)

     

       637
       -
       module ListChanged = struct

     

       638
       -
         (* No parameters for these notifications *)

     

       639
       -
         

     

       640
       -
         let create_resources_notification () =

     

       641
       -
           JSONRPCMessage.create_notification ~meth:Method.ResourcesListChanged ()

     

       642
       -
         

     

       643
       -
         let create_tools_notification () =

     

       644
       -
           JSONRPCMessage.create_notification ~meth:Method.ToolsListChanged ()

     

       645
       -
         

     

       646
       -
         let create_prompts_notification () =

     

       647
       -
           JSONRPCMessage.create_notification ~meth:Method.PromptsListChanged ()

     

       648
       -
       end

     

       649
       -
       

     

       650
       -
       (* Resource Updated Notification *)

     

       651
       -
       module ResourceUpdated = struct

     

       652
       -
         module Notification = struct

     

       653
       -
           type t = {

     

       654
       -
             uri: string;

     

       655
       -
           }

     

       656
       -
           

     

       657
       -
           let yojson_of_t { uri } =

     

       658
       -
             `Assoc [

     

       659
       -
               ("uri", `String uri);

     

       660
       -
             ]

     

       661
       -
           

     

       662
       -
           let t_of_yojson = function

     

       663
       -
             | `Assoc fields as json ->

     

       664
       -
               let uri = match List.assoc_opt "uri" fields with

     

       665
       -
                 | Some (`String s) -> s

     

       666
       -
                 | _ -> Util.json_error "Missing or invalid 'uri' field" json

     

       667
       -
               in

     

       668
       -
               { uri }

     

       669
       -
             | j -> Util.json_error "Expected object for ResourceUpdated.Notification.t" j

     

       670
       -
             

     

       671
       -
         end

     

       672
       -
         

     

       673
       -
         let create_notification ~uri () =

     

       674
       -
           let params = Notification.yojson_of_t { uri } in

     

       675
       -
           JSONRPCMessage.create_notification ~meth:Method.ResourcesUpdated ~params:(Some params) ()

     

       676
       -
       end

     

       677
       -
       

     

       678
       -
       (* Progress Notification *)

     

       679
       -
       module Progress = struct

     

       680
       -
         module Notification = struct

     

       681
       -
           type t = {

     

       682
       -
             progress: float;

     

       683
       -
             total: float;

     

       684
       -
             progress_token: ProgressToken.t;

     

       685
       -
           }

     

       686
       -
           

     

       687
       -
           let yojson_of_t { progress; total; progress_token } =

     

       688
       -
             `Assoc [

     

       689
       -
               ("progress", `Float progress);

     

       690
       -
               ("total", `Float total);

     

       691
       -
               ("progressToken", ProgressToken.yojson_of_t progress_token);

     

       692
       -
             ]

     

       693
       -
           

     

       694
       -
           let t_of_yojson = function

     

       695
       -
             | `Assoc fields as json ->

     

       696
       -
               let progress = match List.assoc_opt "progress" fields with

     

       697
       -
                 | Some (`Float f) -> f

     

       698
       -
                 | _ -> Util.json_error "Missing or invalid 'progress' field" json

     

       699
       -
               in

     

       700
       -
               let total = match List.assoc_opt "total" fields with

     

       701
       -
                 | Some (`Float f) -> f

     

       702
       -
                 | _ -> Util.json_error "Missing or invalid 'total' field" json

     

       703
       -
               in

     

       704
       -
               let progress_token = match List.assoc_opt "progressToken" fields with

     

       705
       -
                 | Some token -> ProgressToken.t_of_yojson token

     

       706
       -
                 | _ -> Util.json_error "Missing or invalid 'progressToken' field" json

     

       707
       -
               in

     

       708
       -
               { progress; total; progress_token }

     

       709
       -
             | j -> Util.json_error "Expected object for Progress.Notification.t" j

     

       710
       -
             

     

       711
       -
         end

     

       712
       -
         

     

       713
       -
         let create_notification ~progress ~total ~progress_token () =

     

       714
       -
           let params = Notification.yojson_of_t { progress; total; progress_token } in

     

       715
       -
           JSONRPCMessage.create_notification ~meth:Method.Progress ~params:(Some params) ()

     

       716
       -
       end

     

       717
       -
       

     

       718
       -
       (* Type aliases for backward compatibility *)

     

       719
       -
       type request = ResourcesList.Request.t

     

       720
       -
       type response = ResourcesList.Response.t 

     

       721
       -
       type resource = ResourcesList.Resource.t

     

       722
       -
       type resource_content = ResourcesRead.ResourceContent.t

     

       723
       -
       type tool = ToolsList.Tool.t

     

       724
       -
       type tool_content = ToolsCall.ToolContent.t

     

       725
       -
       type prompt = PromptsList.Prompt.t

     

       726
       -
       type prompt_argument = PromptsList.PromptArgument.t

-264

lib/mcp_rpc.mli

···

       1
       -
       (** Mcp_message - High-level RPC message definitions for Model Context Protocol *)

     

       2
       -
       

     

       3
       -
       open Mcp

     

       4
       -
       open Jsonrpc

     

       5
       -
       

     

       6
       -
       (** Resources/List - Request to list available resources *)

     

       7
       -
       module ResourcesList : sig

     

       8
       -
         (** Request parameters *)

     

       9
       -
         module Request : sig

     

       10
       -
           type t = {

     

       11
       -
             cursor: Cursor.t option; (** Optional pagination cursor *)

     

       12
       -
           }

     

       13
       -
           include Json.Jsonable.S with type t := t

     

       14
       -
         end

     

       15
       -
         

     

       16
       -
         (** Resource definition *)

     

       17
       -
         module Resource : sig

     

       18
       -
           type t = {

     

       19
       -
             uri: string; (** Unique identifier for the resource *)

     

       20
       -
             name: string; (** Human-readable name *)

     

       21
       -
             description: string option; (** Optional description *)

     

       22
       -
             mime_type: string option; (** Optional MIME type *)

     

       23
       -
             size: int option; (** Optional size in bytes *)

     

       24
       -
           }

     

       25
       -
           include Json.Jsonable.S with type t := t

     

       26
       -
         end

     

       27
       -
         

     

       28
       -
         (** Response result *)

     

       29
       -
         module Response : sig

     

       30
       -
           type t = {

     

       31
       -
             resources: Resource.t list; (** List of available resources *)

     

       32
       -
             next_cursor: Cursor.t option; (** Optional cursor for the next page *)

     

       33
       -
           }

     

       34
       -
           include Json.Jsonable.S with type t := t

     

       35
       -
         end

     

       36
       -
         

     

       37
       -
         (** Create a resources/list request *)

     

       38
       -
         val create_request : ?cursor:Cursor.t -> ?id:RequestId.t -> unit -> JSONRPCMessage.t

     

       39
       -
         

     

       40
       -
         (** Create a resources/list response *)

     

       41
       -
         val create_response : id:RequestId.t -> resources:Resource.t list -> ?next_cursor:Cursor.t -> unit -> JSONRPCMessage.t

     

       42
       -
       end

     

       43
       -
       

     

       44
       -
       (** Resources/Read - Request to read resource contents *)

     

       45
       -
       module ResourcesRead : sig

     

       46
       -
         (** Request parameters *)

     

       47
       -
         module Request : sig

     

       48
       -
           type t = {

     

       49
       -
             uri: string; (** URI of the resource to read *)

     

       50
       -
           }

     

       51
       -
           include Json.Jsonable.S with type t := t

     

       52
       -
         end

     

       53
       -
         

     

       54
       -
         (** Resource content *)

     

       55
       -
         module ResourceContent : sig

     

       56
       -
           type t = 

     

       57
       -
             | TextResource of TextResourceContents.t (** Text content *)

     

       58
       -
             | BlobResource of BlobResourceContents.t (** Binary content *)

     

       59
       -
           include Json.Jsonable.S with type t := t

     

       60
       -
         end

     

       61
       -
         

     

       62
       -
         (** Response result *)

     

       63
       -
         module Response : sig

     

       64
       -
           type t = {

     

       65
       -
             contents: ResourceContent.t list; (** List of resource contents *)

     

       66
       -
           }

     

       67
       -
           include Json.Jsonable.S with type t := t

     

       68
       -
         end

     

       69
       -
         

     

       70
       -
         (** Create a resources/read request *)

     

       71
       -
         val create_request : uri:string -> ?id:RequestId.t -> unit -> JSONRPCMessage.t

     

       72
       -
         

     

       73
       -
         (** Create a resources/read response *)

     

       74
       -
         val create_response : id:RequestId.t -> contents:ResourceContent.t list -> unit -> JSONRPCMessage.t

     

       75
       -
       end

     

       76
       -
       

     

       77
       -
       (** Tools/List - Request to list available tools *)

     

       78
       -
       module ToolsList : sig

     

       79
       -
         (** Request parameters *)

     

       80
       -
         module Request : sig

     

       81
       -
           type t = {

     

       82
       -
             cursor: Cursor.t option; (** Optional pagination cursor *)

     

       83
       -
           }

     

       84
       -
           include Json.Jsonable.S with type t := t

     

       85
       -
         end

     

       86
       -
         

     

       87
       -
         (** Tool definition *)

     

       88
       -
         module Tool : sig

     

       89
       -
           type t = {

     

       90
       -
             name: string; (** Unique identifier for the tool *)

     

       91
       -
             description: string option; (** Human-readable description *)

     

       92
       -
             input_schema: Json.t; (** JSON Schema defining expected parameters *)

     

       93
       -
             annotations: Json.t option; (** Optional properties describing tool behavior *)

     

       94
       -
           }

     

       95
       -
           include Json.Jsonable.S with type t := t

     

       96
       -
         end

     

       97
       -
         

     

       98
       -
         (** Response result *)

     

       99
       -
         module Response : sig

     

       100
       -
           type t = {

     

       101
       -
             tools: Tool.t list; (** List of available tools *)

     

       102
       -
             next_cursor: Cursor.t option; (** Optional cursor for the next page *)

     

       103
       -
           }

     

       104
       -
           include Json.Jsonable.S with type t := t

     

       105
       -
         end

     

       106
       -
         

     

       107
       -
         (** Create a tools/list request *)

     

       108
       -
         val create_request : ?cursor:Cursor.t -> ?id:RequestId.t -> unit -> JSONRPCMessage.t

     

       109
       -
         

     

       110
       -
         (** Create a tools/list response *)

     

       111
       -
         val create_response : id:RequestId.t -> tools:Tool.t list -> ?next_cursor:Cursor.t -> unit -> JSONRPCMessage.t

     

       112
       -
       end

     

       113
       -
       

     

       114
       -
       (** Tools/Call - Request to invoke a tool *)

     

       115
       -
       module ToolsCall : sig

     

       116
       -
         (** Request parameters *)

     

       117
       -
         module Request : sig

     

       118
       -
           type t = {

     

       119
       -
             name: string; (** Name of the tool to call *)

     

       120
       -
             arguments: Json.t; (** Arguments for the tool invocation *)

     

       121
       -
           }

     

       122
       -
           include Json.Jsonable.S with type t := t

     

       123
       -
         end

     

       124
       -
         

     

       125
       -
         (** Tool content *)

     

       126
       -
         module ToolContent : sig

     

       127
       -
           type t = 

     

       128
       -
             | Text of TextContent.t (** Text content *)

     

       129
       -
             | Image of ImageContent.t (** Image content *)

     

       130
       -
             | Audio of AudioContent.t (** Audio content *)

     

       131
       -
             | Resource of EmbeddedResource.t (** Resource content *)

     

       132
       -
           include Json.Jsonable.S with type t := t

     

       133
       -
         end

     

       134
       -
         

     

       135
       -
         (** Response result *)

     

       136
       -
         module Response : sig

     

       137
       -
           type t = {

     

       138
       -
             content: ToolContent.t list; (** List of content items returned by the tool *)

     

       139
       -
             is_error: bool; (** Whether the result represents an error *)

     

       140
       -
           }

     

       141
       -
           include Json.Jsonable.S with type t := t

     

       142
       -
         end

     

       143
       -
         

     

       144
       -
         (** Create a tools/call request *)

     

       145
       -
         val create_request : name:string -> arguments:Json.t -> ?id:RequestId.t -> unit -> JSONRPCMessage.t

     

       146
       -
         

     

       147
       -
         (** Create a tools/call response *)

     

       148
       -
         val create_response : id:RequestId.t -> content:ToolContent.t list -> is_error:bool -> unit -> JSONRPCMessage.t

     

       149
       -
       end

     

       150
       -
       

     

       151
       -
       (** Prompts/List - Request to list available prompts *)

     

       152
       -
       module PromptsList : sig

     

       153
       -
         (** Prompt argument *)

     

       154
       -
         module PromptArgument : sig

     

       155
       -
           type t = {

     

       156
       -
             name: string; (** Name of the argument *)

     

       157
       -
             description: string option; (** Description of the argument *)

     

       158
       -
             required: bool; (** Whether the argument is required *)

     

       159
       -
           }

     

       160
       -
           include Json.Jsonable.S with type t := t

     

       161
       -
         end

     

       162
       -
         

     

       163
       -
         (** Prompt definition *)

     

       164
       -
         module Prompt : sig

     

       165
       -
           type t = {

     

       166
       -
             name: string; (** Unique identifier for the prompt *)

     

       167
       -
             description: string option; (** Human-readable description *)

     

       168
       -
             arguments: PromptArgument.t list; (** Arguments for customization *)

     

       169
       -
           }

     

       170
       -
           include Json.Jsonable.S with type t := t

     

       171
       -
         end

     

       172
       -
         

     

       173
       -
         (** Request parameters *)

     

       174
       -
         module Request : sig

     

       175
       -
           type t = {

     

       176
       -
             cursor: Cursor.t option; (** Optional pagination cursor *)

     

       177
       -
           }

     

       178
       -
           include Json.Jsonable.S with type t := t

     

       179
       -
         end

     

       180
       -
         

     

       181
       -
         (** Response result *)

     

       182
       -
         module Response : sig

     

       183
       -
           type t = {

     

       184
       -
             prompts: Prompt.t list; (** List of available prompts *)

     

       185
       -
             next_cursor: Cursor.t option; (** Optional cursor for the next page *)

     

       186
       -
           }

     

       187
       -
           include Json.Jsonable.S with type t := t

     

       188
       -
         end

     

       189
       -
         

     

       190
       -
         (** Create a prompts/list request *)

     

       191
       -
         val create_request : ?cursor:Cursor.t -> ?id:RequestId.t -> unit -> JSONRPCMessage.t

     

       192
       -
         

     

       193
       -
         (** Create a prompts/list response *)

     

       194
       -
         val create_response : id:RequestId.t -> prompts:Prompt.t list -> ?next_cursor:Cursor.t -> unit -> JSONRPCMessage.t

     

       195
       -
       end

     

       196
       -
       

     

       197
       -
       (** Prompts/Get - Request to get a prompt with arguments *)

     

       198
       -
       module PromptsGet : sig

     

       199
       -
         (** Request parameters *)

     

       200
       -
         module Request : sig

     

       201
       -
           type t = {

     

       202
       -
             name: string; (** Name of the prompt to get *)

     

       203
       -
             arguments: (string * string) list; (** Arguments for the prompt *)

     

       204
       -
           }

     

       205
       -
           include Json.Jsonable.S with type t := t

     

       206
       -
         end

     

       207
       -
         

     

       208
       -
         (** Response result *)

     

       209
       -
         module Response : sig

     

       210
       -
           type t = {

     

       211
       -
             description: string option; (** Description of the prompt *)

     

       212
       -
             messages: PromptMessage.t list; (** List of messages in the prompt *)

     

       213
       -
           }

     

       214
       -
           include Json.Jsonable.S with type t := t

     

       215
       -
         end

     

       216
       -
         

     

       217
       -
         (** Create a prompts/get request *)

     

       218
       -
         val create_request : name:string -> arguments:(string * string) list -> ?id:RequestId.t -> unit -> JSONRPCMessage.t

     

       219
       -
         

     

       220
       -
         (** Create a prompts/get response *)

     

       221
       -
         val create_response : id:RequestId.t -> ?description:string -> messages:PromptMessage.t list -> unit -> JSONRPCMessage.t

     

       222
       -
       end

     

       223
       -
       

     

       224
       -
       (** List Changed Notifications *)

     

       225
       -
       module ListChanged : sig

     

       226
       -
         (** Create a resources/list_changed notification *)

     

       227
       -
         val create_resources_notification : unit -> JSONRPCMessage.t

     

       228
       -
         

     

       229
       -
         (** Create a tools/list_changed notification *)

     

       230
       -
         val create_tools_notification : unit -> JSONRPCMessage.t

     

       231
       -
         

     

       232
       -
         (** Create a prompts/list_changed notification *)

     

       233
       -
         val create_prompts_notification : unit -> JSONRPCMessage.t

     

       234
       -
       end

     

       235
       -
       

     

       236
       -
       (** Resource Updated Notification *)

     

       237
       -
       module ResourceUpdated : sig

     

       238
       -
         (** Notification parameters *)

     

       239
       -
         module Notification : sig

     

       240
       -
           type t = {

     

       241
       -
             uri: string; (** URI of the updated resource *)

     

       242
       -
           }

     

       243
       -
           include Json.Jsonable.S with type t := t

     

       244
       -
         end

     

       245
       -
         

     

       246
       -
         (** Create a resources/updated notification *)

     

       247
       -
         val create_notification : uri:string -> unit -> JSONRPCMessage.t

     

       248
       -
       end

     

       249
       -
       

     

       250
       -
       (** Progress Notification *)

     

       251
       -
       module Progress : sig

     

       252
       -
         (** Notification parameters *)

     

       253
       -
         module Notification : sig

     

       254
       -
           type t = {

     

       255
       -
             progress: float; (** Current progress value *)

     

       256
       -
             total: float; (** Total progress value *)

     

       257
       -
             progress_token: ProgressToken.t; (** Token identifying the operation *)

     

       258
       -
           }

     

       259
       -
           include Json.Jsonable.S with type t := t

     

       260
       -
         end

     

       261
       -
         

     

       262
       -
         (** Create a progress notification *)

     

       263
       -
         val create_notification : progress:float -> total:float -> progress_token:ProgressToken.t -> unit -> JSONRPCMessage.t

     

       264
       -
       end

+122 -174

lib/mcp_sdk.ml

···

       14
        
           | Warning -> "WARNING"

     

       15
        
           | Error -> "ERROR"

     

       16
        
       

     

       17
       -
         let logf level fmt =

     

       18
       -
           Printf.fprintf stderr "[%s] " (string_of_level level);

     

       19
       -
           Printf.kfprintf (fun oc -> Printf.fprintf oc "\n"; flush oc) stderr fmt

     

       20
        
       

     

       21
       -
         let debugf fmt = logf Debug fmt

     

       22
       -
         let infof fmt = logf Info fmt

     

       23
       -
         let warningf fmt = logf Warning fmt

     

       24
       -
         let errorf fmt = logf Error fmt

     

       25
       -
         

     

       26
       -
         (* Backward compatibility functions that take a simple string *)

     

       27
       -
         let log level msg = logf level "%s" msg

     

       28
       -
         let debug msg = debugf "%s" msg

     

       29
       -
         let info msg = infof "%s" msg

     

       30
       -
         let warning msg = warningf "%s" msg

     

       31
       -
         let error msg = errorf "%s" msg

     

       32
        
       end

     

       33
        
       

     

       34
        
       (* Context for tools and resources *)

     
···

       36
        
         type t = {

     

       37
        
           request_id: RequestId.t option;

     

       38
        
           lifespan_context: (string * Json.t) list;

     

       39
       -
           progress_token: ProgressToken.t option;

     

       40
        
         }

     

       41
        
       

     

       42
       -
         let create ?request_id ?progress_token ?(lifespan_context=[]) () =

     

       43
       -
           { request_id; lifespan_context; progress_token }

     

       44
        
       

     

       45
        
         let get_context_value ctx key =

     

       46
        
           List.assoc_opt key ctx.lifespan_context

     
···

       53
        
               ("total", `Float total);

     

       54
        
               ("progressToken", ProgressToken.yojson_of_t token)

     

       55
        
             ] in

     

       56
       -
             Some (create_notification ~meth:Method.Progress ~params:(Some params) ())

     

       57
        
           | _ -> None

     

       58
        
       end

     

       59
        
       

     
···

       81
        
             | None -> assoc

     

       82
        
           in

     

       83
        
           `Assoc assoc

     

       84
       -
           

     

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

     

       86
       -
         let to_rpc_tool_list_tool (tool:t) =

     

       87
       -
           Mcp_rpc.ToolsList.Tool.{

     

       88
       -
             name = tool.name;

     

       89
       -
             description = tool.description;

     

       90
       -
             input_schema = tool.input_schema;

     

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

     

       92
       -
           }

     

       93
       -
       

     

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

     

       95
       -
         let to_rpc_tools_list tools =

     

       96
       -
           List.map to_rpc_tool_list_tool tools

     

       97
       -
       

     

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

     

       99
       -
         let rpc_content_to_mcp_content content =

     

       100
       -
           List.map (function

     

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

     

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

     

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

     

       104
       -
                 Mcp.Image { 

     

       105
       -
                   ImageContent.mime_type = i.mime_type;

     

       106
       -
                   data = i.data;

     

       107
       -
                   annotations = None

     

       108
       -
                 }

     

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

     

       110
       -
                 Mcp.Audio {

     

       111
       -
                   AudioContent.mime_type = a.mime_type;

     

       112
       -
                   data = a.data;

     

       113
       -
                   annotations = None

     

       114
       -
                 }

     

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

     

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

     

       117
       -
                 let uri = match r with 

     

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

     

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

     

       120
       -
                 in

     

       121
       -
                 let text_content = match r with

     

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

     

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

     

       124
       -
                 in

     

       125
       -
                 let mime_type = match r with

     

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

     

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

     

       128
       -
                 in

     

       129
       -
                 let text_resource = {

     

       130
       -
                   TextResourceContents.uri;

     

       131
       -
                   text = text_content;

     

       132
       -
                   mime_type

     

       133
       -
                 } in

     

       134
       -
                 Mcp.Resource {

     

       135
       -
                   EmbeddedResource.resource = `Text text_resource;

     

       136
       -
                   annotations = None

     

       137
       -
                 }

     

       138
       -
           ) content

     

       139
       -
       

     

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

     

       141
       -
         let mcp_content_to_rpc_content content =

     

       142
       -
           List.map (function

     

       143
       -
             | Mcp.Text t -> 

     

       144
       -
                 Mcp_rpc.ToolsCall.ToolContent.Text t

     

       145
       -
             | Mcp.Image img -> 

     

       146
       -
                 Mcp_rpc.ToolsCall.ToolContent.Image img

     

       147
       -
             | Mcp.Audio aud -> 

     

       148
       -
                 Mcp_rpc.ToolsCall.ToolContent.Audio aud

     

       149
       -
             | Mcp.Resource res -> 

     

       150
       -
                 let resource_data = match res.resource with

     

       151
       -
                   | `Text txt -> `Text txt

     

       152
       -
                   | `Blob blob -> `Blob blob

     

       153
       -
                 in

     

       154
       -
                 let resource = {

     

       155
       -
                   EmbeddedResource.resource = resource_data;

     

       156
       -
                   annotations = res.annotations

     

       157
       -
                 } in

     

       158
       -
                 Mcp_rpc.ToolsCall.ToolContent.Resource resource

     

       159
       -
           ) content

     

       160
       -
           

     

       161
       -
         (* Create a tool result with content *)

     

       162
       -
         let create_tool_result content ~is_error =

     

       163
       -
           `Assoc [

     

       164
       -
             ("content", `List (List.map Mcp.yojson_of_content content));

     

       165
       -
             ("isError", `Bool is_error);

     

       166
       -
           ]

     

       167
       -
       

     

       168
       -
         (* Create a tool error result with structured content *)

     

       169
       -
         let create_error_result error =

     

       170
       -
           Log.errorf "Error result: %s" error;

     

       171
       -
           create_tool_result [Mcp.make_text_content error] ~is_error:true

     

       172
       -
         

     

       173
       -
         (* Handle tool execution errors *)

     

       174
       -
         let handle_execution_error err =

     

       175
       -
           create_error_result (Printf.sprintf "Error executing tool: %s" err)

     

       176
       -
         

     

       177
       -
         (* Handle unknown tool error *)

     

       178
       -
         let handle_unknown_tool_error name =

     

       179
       -
           create_error_result (Printf.sprintf "Unknown tool: %s" name)

     

       180
       -
         

     

       181
       -
         (* Handle general tool execution exception *)

     

       182
       -
         let handle_execution_exception exn =

     

       183
       -
           create_error_result (Printf.sprintf "Internal error: %s" (Printexc.to_string exn))

     

       184
        
       end

     

       185
        
       

     

       186
        
       (* Resources for the MCP server *)

     
···

       210
        
             | None -> assoc

     

       211
        
           in

     

       212
        
           `Assoc assoc

     

       213
       -
           

     

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

     

       215
       -
         let to_rpc_resource_list_resource (resource:t) =

     

       216
       -
           Mcp_rpc.ResourcesList.Resource.{

     

       217
       -
             uri = resource.uri_template;

     

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

     

       219
       -
             description = resource.description;

     

       220
       -
             mime_type = resource.mime_type;

     

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

     

       222
       -
           }

     

       223
       -
           

     

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

     

       225
       -
         let to_rpc_resources_list resources =

     

       226
       -
           List.map to_rpc_resource_list_resource resources

     

       227
        
       end

     

       228
        
       

     

       229
        
       (* Prompts for the MCP server *)

     
···

       254
        
         let create_argument ~name ?description ?(required=false) () =

     

       255
        
           { name; description; required }

     

       256
        
       

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       257
        
         let to_json prompt =

     

       258
        
           let assoc = [

     

       259
        
             ("name", `String prompt.name);

     
···

       284
        
             assoc

     

       285
        
           in

     

       286
        
           `Assoc assoc

     

       287
       -
           

     

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

     

       289
       -
         let argument_to_rpc_prompt_argument (arg:argument) =

     

       290
       -
           Mcp_rpc.PromptsList.PromptArgument.{

     

       291
       -
             name = arg.name;

     

       292
       -
             description = arg.description;

     

       293
       -
             required = arg.required;

     

       294
       -
           }

     

       295
       -
           

     

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

     

       297
       -
         let to_rpc_prompt_list_prompt (prompt:t) =

     

       298
       -
           Mcp_rpc.PromptsList.Prompt.{

     

       299
       -
             name = prompt.name;

     

       300
       -
             description = prompt.description;

     

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

     

       302
       -
           }

     

       303
       -
         

     

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

     

       305
       -
         let to_rpc_prompts_list prompts =

     

       306
       -
           List.map to_rpc_prompt_list_prompt prompts

     

       307
       -
           

     

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

     

       309
       -
         let message_to_rpc_prompt_message msg =

     

       310
       -
           {

     

       311
       -
             PromptMessage.role = msg.role;

     

       312
       -
             PromptMessage.content = msg.content;

     

       313
       -
           }

     

       314
       -
           

     

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

     

       316
       -
         let messages_to_rpc_prompt_messages messages =

     

       317
       -
           List.map message_to_rpc_prompt_message messages

     

       318
        
       end

     

       319
        
       

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       320
        
       let make_tool_schema properties required =

     

       321
        
         let props = List.map (fun (name, schema_type, description) ->

     

       322
        
           (name, `Assoc [

     
···

       336
        
         name: string;

     

       337
        
         version: string;

     

       338
        
         protocol_version: string;

     

       339
       -
         lifespan_context: (string * Json.t) list;

     

       340
        
         mutable capabilities: Json.t;

     

       341
        
         mutable tools: Tool.t list;

     

       342
        
         mutable resources: Resource.t list;

     

       343
        
         mutable prompts: Prompt.t list;

     

       344
       -
       } 

     

       345
       -
       

     

       346
       -
       let name { name; _ } = name

     

       347
       -
       let version { version; _ } = version

     

       348
       -
       let capabilities { capabilities; _ } = capabilities

     

       349
       -
       let lifespan_context { lifespan_context; _ } = lifespan_context

     

       350
       -
       let protocol_version { protocol_version; _ } = protocol_version

     

       351
       -
       let tools { tools; _ } = tools

     

       352
       -
       let resources { resources; _ } = resources

     

       353
       -
       let prompts { prompts; _ } = prompts

     

       354
        
       

     

       355
        
       (* Create a new server *)

     

       356
        
       let create_server ~name ?(version="0.1.0") ?(protocol_version="2024-11-05") () =

     
···

       363
        
           resources = [];

     

       364
        
           prompts = [];

     

       365
        
           lifespan_context = [];

     

       0
        
       
     

       0
        
       
     

       366
        
         }

     

       367
        
       

     

       368
        
       (* Default capabilities for the server *)

     
···

       495
        
         let capabilities = default_capabilities ~with_tools ~with_resources ~with_prompts () in

     

       496
        
         set_capabilities server capabilities;

     

       497
        
         server

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0

···

       14
        
           | Warning -> "WARNING"

     

       15
        
           | Error -> "ERROR"

     

       16
        
       

     

       17
       +
         let log level msg =

     

       18
       +
           Printf.eprintf "[%s] %s\n" (string_of_level level) msg;

     

       19
       +
           flush stderr

     

       20
        
       

     

       21
       +
         let debug = log Debug

     

       22
       +
         let info = log Info

     

       23
       +
         let warning = log Warning

     

       24
       +
         let error = log Error

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       25
        
       end

     

       26
        
       

     

       27
        
       (* Context for tools and resources *)

     
···

       29
        
         type t = {

     

       30
        
           request_id: RequestId.t option;

     

       31
        
           lifespan_context: (string * Json.t) list;

     

       32
       +
           mutable progress_token: ProgressToken.t option;

     

       33
        
         }

     

       34
        
       

     

       35
       +
         let create ?request_id ?(lifespan_context=[]) () =

     

       36
       +
           { request_id; lifespan_context; progress_token = None }

     

       37
        
       

     

       38
        
         let get_context_value ctx key =

     

       39
        
           List.assoc_opt key ctx.lifespan_context

     
···

       46
        
               ("total", `Float total);

     

       47
        
               ("progressToken", ProgressToken.yojson_of_t token)

     

       48
        
             ] in

     

       49
       +
             Some (create_notification ~method_:"notifications/progress" ~params:(Some params) ())

     

       50
        
           | _ -> None

     

       51
        
       end

     

       52
        
       

     
···

       74
        
             | None -> assoc

     

       75
        
           in

     

       76
        
           `Assoc assoc

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       77
        
       end

     

       78
        
       

     

       79
        
       (* Resources for the MCP server *)

     
···

       103
        
             | None -> assoc

     

       104
        
           in

     

       105
        
           `Assoc assoc

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       106
        
       end

     

       107
        
       

     

       108
        
       (* Prompts for the MCP server *)

     
···

       133
        
         let create_argument ~name ?description ?(required=false) () =

     

       134
        
           { name; description; required }

     

       135
        
       

     

       136
       +
         let yojson_of_message { role; content } =

     

       137
       +
           `Assoc [

     

       138
       +
             ("role", Role.yojson_of_t role);

     

       139
       +
             ("content", yojson_of_content content);

     

       140
       +
           ]

     

       141
       +
       

     

       142
       +
         (* This function must match the structure expected by the PromptMessage module in mcp.ml *)

     

       143
       +
         let message_of_yojson json =

     

       144
       +
           match json with

     

       145
       +
           | `Assoc fields -> begin

     

       146
       +
               let role = match List.assoc_opt "role" fields with

     

       147
       +
                 | Some json -> begin

     

       148
       +
                     Role.t_of_yojson json

     

       149
       +
                   end

     

       150
       +
                 | None -> begin

     

       151
       +
                     raise (Json.Of_json ("Missing role field", `Assoc fields))

     

       152
       +
                   end

     

       153
       +
               in

     

       154
       +
               let content = match List.assoc_opt "content" fields with

     

       155
       +
                 | Some json -> begin

     

       156
       +
                     content_of_yojson json

     

       157
       +
                   end

     

       158
       +
                 | None -> begin

     

       159
       +
                     raise (Json.Of_json ("Missing content field", `Assoc fields))

     

       160
       +
                   end

     

       161
       +
               in

     

       162
       +
               { role; content }

     

       163
       +
             end

     

       164
       +
           | j -> begin

     

       165
       +
               raise (Json.Of_json ("Expected object for PromptMessage", j))

     

       166
       +
             end

     

       167
       +
       

     

       168
        
         let to_json prompt =

     

       169
        
           let assoc = [

     

       170
        
             ("name", `String prompt.name);

     
···

       195
        
             assoc

     

       196
        
           in

     

       197
        
           `Assoc assoc

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       198
        
       end

     

       199
        
       

     

       200
       +
       (* Helper functions for creating common objects *)

     

       201
       +
       let make_text_content text =

     

       202
       +
         Text (TextContent.{ text; annotations = None })

     

       203
       +
       

     

       204
       +
       let make_text_content_with_annotations text annotations =

     

       205
       +
         Text (TextContent.{ text; annotations = Some annotations })

     

       206
       +
       

     

       207
       +
       let make_image_content data mime_type =

     

       208
       +
         Image (ImageContent.{ data; mime_type; annotations = None })

     

       209
       +
       

     

       210
       +
       let make_image_content_with_annotations data mime_type annotations =

     

       211
       +
         Image (ImageContent.{ data; mime_type; annotations = Some annotations })

     

       212
       +
       

     

       213
       +
       let make_audio_content data mime_type =

     

       214
       +
         Audio (AudioContent.{ data; mime_type; annotations = None })

     

       215
       +
       

     

       216
       +
       let make_audio_content_with_annotations data mime_type annotations =

     

       217
       +
         Audio (AudioContent.{ data; mime_type; annotations = Some annotations })

     

       218
       +
       

     

       219
       +
       let make_text_resource_content uri text ?mime_type () =

     

       220
       +
         Resource (EmbeddedResource.{

     

       221
       +
           resource = `Text TextResourceContents.{ uri; text; mime_type };

     

       222
       +
           annotations = None

     

       223
       +
         })

     

       224
       +
       

     

       225
       +
       let make_blob_resource_content uri blob ?mime_type () =

     

       226
       +
         Resource (EmbeddedResource.{

     

       227
       +
           resource = `Blob BlobResourceContents.{ uri; blob; mime_type };

     

       228
       +
           annotations = None

     

       229
       +
         })

     

       230
       +
       

     

       231
        
       let make_tool_schema properties required =

     

       232
        
         let props = List.map (fun (name, schema_type, description) ->

     

       233
        
           (name, `Assoc [

     
···

       247
        
         name: string;

     

       248
        
         version: string;

     

       249
        
         protocol_version: string;

     

       0
        
       
     

       250
        
         mutable capabilities: Json.t;

     

       251
        
         mutable tools: Tool.t list;

     

       252
        
         mutable resources: Resource.t list;

     

       253
        
         mutable prompts: Prompt.t list;

     

       254
       +
         mutable lifespan_context: (string * Json.t) list;

     

       255
       +
         mutable startup_hook: (unit -> unit) option;

     

       256
       +
         mutable shutdown_hook: (unit -> unit) option;

     

       257
       +
       }

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       258
        
       

     

       259
        
       (* Create a new server *)

     

       260
        
       let create_server ~name ?(version="0.1.0") ?(protocol_version="2024-11-05") () =

     
···

       267
        
           resources = [];

     

       268
        
           prompts = [];

     

       269
        
           lifespan_context = [];

     

       270
       +
           startup_hook = None;

     

       271
       +
           shutdown_hook = None;

     

       272
        
         }

     

       273
        
       

     

       274
        
       (* Default capabilities for the server *)

     
···

       401
        
         let capabilities = default_capabilities ~with_tools ~with_resources ~with_prompts () in

     

       402
        
         set_capabilities server capabilities;

     

       403
        
         server

     

       404
       +
       

     

       405
       +
       (* Set startup and shutdown hooks *)

     

       406
       +
       let set_startup_hook server hook =

     

       407
       +
         server.startup_hook <- Some hook

     

       408
       +
       

     

       409
       +
       let set_shutdown_hook server hook =

     

       410
       +
         server.shutdown_hook <- Some hook

     

       411
       +
       

     

       412
       +
       (* Transport type for server *)

     

       413
       +
       type transport_type = 

     

       414
       +
         | Stdio  (* Read/write to stdin/stdout *)

     

       415
       +
         | Http   (* HTTP server - to be implemented *)

     

       416
       +
       

     

       417
       +
       (* Run server with stdio transport *)

     

       418
       +
       let run_server server =

     

       419
       +
         (* Setup *)

     

       420
       +
         Printexc.record_backtrace true;

     

       421
       +
         

     

       422
       +
         Log.info (Printf.sprintf "%s server starting" server.name);

     

       423
       +
         Log.debug (Printf.sprintf "Protocol version: %s" server.protocol_version);

     

       424
       +
         Log.debug (Printf.sprintf "Server info: %s v%s" server.name server.version);

     

       425
       +
         

     

       426
       +
         (* Initialize capabilities if not already set *)

     

       427
       +
         if server.capabilities = `Assoc [] then

     

       428
       +
           ignore (configure_server server ());

     

       429
       +
         

     

       430
       +
         (* Run startup hook if provided *)

     

       431
       +
         (match server.startup_hook with

     

       432
       +
          | Some hook -> hook ()

     

       433
       +
          | None -> ());

     

       434
       +
         

     

       435
       +
         (* This function will be replaced by a full implementation in the mcp_server module *)

     

       436
       +
         Log.info "Server initialized and ready."

     

       437
       +
       

     

       438
       +
       (* Placeholder for running server with different transports *)

     

       439
       +
       let run_server_with_transport server transport =

     

       440
       +
         match transport with

     

       441
       +
         | Http ->

     

       442
       +
             Log.info "HTTP server not implemented in this version, using stdio instead";

     

       443
       +
             run_server server

     

       444
       +
         | Stdio ->

     

       445
       +
             run_server server

+59 -68

lib/mcp_sdk.mli

···

       12
        
       

     

       13
        
         val string_of_level : level -> string

     

       14
        
       

     

       15
       -
         (** Format-string based logging functions *)

     

       16
       -
         val logf : level -> ('a, out_channel, unit) format -> 'a

     

       17
       -
         val debugf : ('a, out_channel, unit) format -> 'a

     

       18
       -
         val infof : ('a, out_channel, unit) format -> 'a

     

       19
       -
         val warningf : ('a, out_channel, unit) format -> 'a

     

       20
       -
         val errorf : ('a, out_channel, unit) format -> 'a

     

       21
       -
       

     

       22
       -
         (** Simple string logging functions (for backward compatibility) *)

     

       23
        
         val log : level -> string -> unit

     

       24
        
         val debug : string -> unit

     

       25
        
         val info : string -> unit

     
···

       29
        
       

     

       30
        
       (** Context for tools and resources *)

     

       31
        
       module Context : sig

     

       32
       -
         type t

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       33
        
       

     

       34
       -
         val create : ?request_id:RequestId.t -> ?progress_token:ProgressToken.t -> ?lifespan_context:(string * Json.t) list -> unit -> t

     

       35
        
         val get_context_value : t -> string -> Json.t option

     

       36
        
         val report_progress : t -> float -> float -> JSONRPCMessage.t option

     

       37
        
       end

     
···

       49
        
       

     

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

     

       51
        
         val to_json : t -> Json.t

     

       52
       -
         

     

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

     

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

     

       55
       -
         

     

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

     

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

     

       58
       -
         

     

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

     

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

     

       61
       -
         

     

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

     

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

     

       64
       -
         

     

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

     

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

     

       67
       -
         

     

       68
       -
         (** Create a tool error result with structured content *)

     

       69
       -
         val create_error_result : string -> Json.t

     

       70
       -
         

     

       71
       -
         (** Handle tool execution errors *)

     

       72
       -
         val handle_execution_error : string -> Json.t

     

       73
       -
         

     

       74
       -
         (** Handle unknown tool error *)

     

       75
       -
         val handle_unknown_tool_error : string -> Json.t

     

       76
       -
         

     

       77
       -
         (** Handle general tool execution exception *)

     

       78
       -
         val handle_execution_exception : exn -> Json.t

     

       79
        
       end

     

       80
        
       

     

       81
        
       (** Resources for the MCP server *)

     
···

       91
        
       

     

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

     

       93
        
         val to_json : t -> Json.t

     

       94
       -
         

     

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

     

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

     

       97
       -
         

     

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

     

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

     

       100
        
       end

     

       101
        
       

     

       102
        
       (** Prompts for the MCP server *)

     
···

       123
        
       

     

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

     

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

     

       0
        
       
     

       0
        
       
     

       126
        
         val to_json : t -> Json.t

     

       127
       -
         

     

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

     

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

     

       130
       -
         

     

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

     

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

     

       133
       -
         

     

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

     

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

     

       136
       -
         

     

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

     

       138
       -
         val message_to_rpc_prompt_message : message -> PromptMessage.t

     

       139
       -
         

     

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

     

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

     

       142
        
       end

     

       143
        
       

     

       144
        
       (** Main server type *)

     

       145
       -
       type server

     

       146
       -
       

     

       147
       -
       val name : server -> string

     

       148
       -
       val version : server -> string

     

       149
       -
       val protocol_version : server -> string

     

       150
       -
       val capabilities : server -> Json.t

     

       151
       -
       val tools : server -> Tool.t list

     

       152
       -
       val resources : server -> Resource.t list

     

       153
       -
       val prompts : server -> Prompt.t list

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       154
        
       

     

       155
        
       (** Create a new server *)

     

       156
        
       val create_server : name:string -> ?version:string -> ?protocol_version:string -> unit -> server

     
···

       158
        
       (** Default capabilities for the server *)

     

       159
        
       val default_capabilities : ?with_tools:bool -> ?with_resources:bool -> ?with_prompts:bool -> unit -> Json.t

     

       160
        
       

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       161
        
       (** Create and register a tool in one step *)

     

       162
        
       val add_tool : server -> name:string -> ?description:string -> ?schema_properties:(string * string * string) list -> ?schema_required:string list -> (Json.t -> Json.t) -> Tool.t

     

       163
        
       

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       164
        
       (** Create and register a resource in one step *)

     

       165
        
       val add_resource : server -> uri_template:string -> ?description:string -> ?mime_type:string -> (string list -> string) -> Resource.t

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       166
        
       

     

       167
        
       (** Create and register a prompt in one step *)

     

       168
        
       val add_prompt : server -> name:string -> ?description:string -> ?arguments:(string * string option * bool) list -> ((string * string) list -> Prompt.message list) -> Prompt.t

     

       169
        
       

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       170
        
       (** Configure server with default capabilities based on registered components *)

     

       171
        
       val configure_server : server -> ?with_tools:bool -> ?with_resources:bool -> ?with_prompts:bool -> unit -> server

     

       172
        
       

     

       173
       -
       val make_tool_schema : (string * string * string) list -> string list -> Json.t

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0

···

       12
        
       

     

       13
        
         val string_of_level : level -> string

     

       14
        
       

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       15
        
         val log : level -> string -> unit

     

       16
        
         val debug : string -> unit

     

       17
        
         val info : string -> unit

     
···

       21
        
       

     

       22
        
       (** Context for tools and resources *)

     

       23
        
       module Context : sig

     

       24
       +
         type t = {

     

       25
       +
           request_id: RequestId.t option;

     

       26
       +
           lifespan_context: (string * Json.t) list;

     

       27
       +
           mutable progress_token: ProgressToken.t option;

     

       28
       +
         }

     

       29
        
       

     

       30
       +
         val create : ?request_id:RequestId.t -> ?lifespan_context:(string * Json.t) list -> unit -> t

     

       31
        
         val get_context_value : t -> string -> Json.t option

     

       32
        
         val report_progress : t -> float -> float -> JSONRPCMessage.t option

     

       33
        
       end

     
···

       45
        
       

     

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

     

       47
        
         val to_json : t -> Json.t

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       48
        
       end

     

       49
        
       

     

       50
        
       (** Resources for the MCP server *)

     
···

       60
        
       

     

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

     

       62
        
         val to_json : t -> Json.t

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       63
        
       end

     

       64
        
       

     

       65
        
       (** Prompts for the MCP server *)

     
···

       86
        
       

     

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

     

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

     

       89
       +
         val yojson_of_message : message -> Json.t

     

       90
       +
         val message_of_yojson : Json.t -> message

     

       91
        
         val to_json : t -> Json.t

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       92
        
       end

     

       93
        
       

     

       94
        
       (** Main server type *)

     

       95
       +
       type server = {

     

       96
       +
         name: string;

     

       97
       +
         version: string;

     

       98
       +
         protocol_version: string;

     

       99
       +
         mutable capabilities: Json.t;

     

       100
       +
         mutable tools: Tool.t list;

     

       101
       +
         mutable resources: Resource.t list;

     

       102
       +
         mutable prompts: Prompt.t list;

     

       103
       +
         mutable lifespan_context: (string * Json.t) list;

     

       104
       +
         mutable startup_hook: (unit -> unit) option;

     

       105
       +
         mutable shutdown_hook: (unit -> unit) option;

     

       106
       +
       }

     

       107
        
       

     

       108
        
       (** Create a new server *)

     

       109
        
       val create_server : name:string -> ?version:string -> ?protocol_version:string -> unit -> server

     
···

       111
        
       (** Default capabilities for the server *)

     

       112
        
       val default_capabilities : ?with_tools:bool -> ?with_resources:bool -> ?with_prompts:bool -> unit -> Json.t

     

       113
        
       

     

       114
       +
       (** Register a tool with the server *)

     

       115
       +
       val register_tool : server -> Tool.t -> Tool.t

     

       116
       +
       

     

       117
        
       (** Create and register a tool in one step *)

     

       118
        
       val add_tool : server -> name:string -> ?description:string -> ?schema_properties:(string * string * string) list -> ?schema_required:string list -> (Json.t -> Json.t) -> Tool.t

     

       119
        
       

     

       120
       +
       (** Register a resource with the server *)

     

       121
       +
       val register_resource : server -> Resource.t -> Resource.t

     

       122
       +
       

     

       123
        
       (** Create and register a resource in one step *)

     

       124
        
       val add_resource : server -> uri_template:string -> ?description:string -> ?mime_type:string -> (string list -> string) -> Resource.t

     

       125
       +
       

     

       126
       +
       (** Register a prompt with the server *)

     

       127
       +
       val register_prompt : server -> Prompt.t -> Prompt.t

     

       128
        
       

     

       129
        
       (** Create and register a prompt in one step *)

     

       130
        
       val add_prompt : server -> name:string -> ?description:string -> ?arguments:(string * string option * bool) list -> ((string * string) list -> Prompt.message list) -> Prompt.t

     

       131
        
       

     

       132
       +
       (** Set server capabilities *)

     

       133
       +
       val set_capabilities : server -> Json.t -> unit

     

       134
       +
       

     

       135
        
       (** Configure server with default capabilities based on registered components *)

     

       136
        
       val configure_server : server -> ?with_tools:bool -> ?with_resources:bool -> ?with_prompts:bool -> unit -> server

     

       137
        
       

     

       138
       +
       (** Set startup hook *)

     

       139
       +
       val set_startup_hook : server -> (unit -> unit) -> unit

     

       140
       +
       

     

       141
       +
       (** Set shutdown hook *)

     

       142
       +
       val set_shutdown_hook : server -> (unit -> unit) -> unit

     

       143
       +
       

     

       144
       +
       (** Run the server using stdio transport (legacy method) *)

     

       145
       +
       val run_server : server -> unit

     

       146
       +
       

     

       147
       +
       (** Transport type for the server *)

     

       148
       +
       type transport_type = 

     

       149
       +
         | Stdio  (** Read/write to stdin/stdout *)

     

       150
       +
         | Http   (** HTTP server - to be implemented *)

     

       151
       +
       

     

       152
       +
       (** Create and start a server with the specified transport *)

     

       153
       +
       val run_server_with_transport : server -> transport_type -> unit

     

       154
       +
       

     

       155
       +
       (** Helper functions for creating common objects *)

     

       156
       +
       val make_text_content : string -> content

     

       157
       +
       val make_text_content_with_annotations : string -> Annotated.annotation -> content

     

       158
       +
       val make_image_content : string -> string -> content

     

       159
       +
       val make_image_content_with_annotations : string -> string -> Annotated.annotation -> content

     

       160
       +
       val make_audio_content : string -> string -> content

     

       161
       +
       val make_audio_content_with_annotations : string -> string -> Annotated.annotation -> content

     

       162
       +
       val make_text_resource_content : string -> string -> ?mime_type:string -> unit -> content

     

       163
       +
       val make_blob_resource_content : string -> string -> ?mime_type:string -> unit -> content

     

       164
       +
       val make_tool_schema : (string * string * string) list -> string list -> Json.t

+512 -271

lib/mcp_server.ml

···

       1
        
       open Mcp

     

       2
       -
       open Jsonrpc

     

       3
        
       open Mcp_sdk

     

       4
        
       

     

       5
       -
       (* Process initialize request *)

     

       6
       -
       let handle_initialize server req =

     

       7
       -
         Log.debug "Processing initialize request";

     

       8
       -
         let result = match req.JSONRPCMessage.params with

     

       9
       -
           | Some params -> 

     

       10
       -
               let req_data = Initialize.Request.t_of_yojson params in

     

       11
       -
               Log.debugf "Client info: %s v%s" 

     

       12
       -
                 req_data.client_info.name req_data.client_info.version;

     

       13
       -
               Log.debugf "Client protocol version: %s" req_data.protocol_version;

     

       14
       -
               

     

       15
       -
               (* Create initialize response *)

     

       16
       -
               let result = Initialize.Result.create

     

       17
       -
                 ~capabilities:(capabilities server)

     

       18
       -
                 ~server_info:Implementation.{ 

     

       19
       -
                   name = name server; 

     

       20
       -
                   version = version server 

     

       21
       -
                 }

     

       22
       -
                 ~protocol_version:(protocol_version server)

     

       23
       -
                 ~instructions:(Printf.sprintf "This server provides tools for %s." (name server))

     

       24
       -
                 ()

     

       25
       -
               in

     

       26
       -
               Initialize.Result.yojson_of_t result

     

       27
       -
           | None -> 

     

       28
       -
               Log.error "Missing params for initialize request";

     

       29
       -
               `Assoc [("error", `String "Missing params for initialize request")]

     

       30
       -
         in

     

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

     

       32
       -
       

     

       33
       -
       (* Process tools/list request *)

     

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

     

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

     

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

     

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

     

       38
       -
         Some response

     

       39
       -
       

     

       40
       -
       (* Process prompts/list request *)

     

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

     

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

     

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

     

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

     

       45
       -
         Some response

     

       46
       -
       

     

       47
       -
       (* Process resources/list request *)

     

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

     

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

     

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

     

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

     

       52
       -
         Some response

     

       53
       -
       

     

       54
       -
       (* Extract the tool name from params *)

     

       55
       -
       let extract_tool_name params =

     

       56
       -
         match List.assoc_opt "name" params with

     

       57
       -
           | Some (`String name) -> 

     

       58
       -
               Log.debugf "Tool name: %s" name;

     

       59
       -
               Some name

     

       60
       -
           | _ -> 

     

       61
       -
               Log.error "Missing or invalid 'name' parameter in tool call";

     

       62
       -
               None

     

       63
       -
       

     

       64
       -
       (* Extract the tool arguments from params *)

     

       65
       -
       let extract_tool_arguments params =

     

       66
       -
         match List.assoc_opt "arguments" params with

     

       67
       -
           | Some (args) -> 

     

       68
       -
               Log.debugf "Tool arguments: %s" (Yojson.Safe.to_string args);

     

       69
       -
               args

     

       70
       -
           | _ -> 

     

       71
       -
               Log.debug "No arguments provided for tool call, using empty object";

     

       72
       -
               `Assoc [] (* Empty arguments is valid *)

     

       73
       -
       

     

       74
       -
       (* Create a proper JSONRPC error with code and data *)

     

       75
       -
       let create_jsonrpc_error id code message ?data () =

     

       76
       -
         let error_code = ErrorCode.to_int code in

     

       77
       -
         let error_data = match data with

     

       78
       -
           | Some d -> d

     

       79
       -
           | None -> `Null

     

       80
       -
         in

     

       81
       -
         create_error ~id ~code:error_code ~message ~data:(Some error_data) ()

     

       82
       -
       

     

       83
       -
       

     

       84
       -
       (* Execute a tool *)

     

       85
       -
       let execute_tool server ctx name args =

     

       86
       -
         try

     

       87
       -
           let tool = List.find (fun t -> t.Tool.name = name) (tools server) in

     

       88
       -
           Log.debugf "Found tool: %s" name;

     

       89
       -
           

     

       90
       -
           (* Call the tool handler *)

     

       91
       -
           match tool.handler ctx args with

     

       92
       -
           | Ok result -> 

     

       93
       -
               Log.debug "Tool execution succeeded";

     

       94
       -
               result

     

       95
       -
           | Error err -> Tool.handle_execution_error err

     

       96
       -
         with

     

       97
       -
         | Not_found -> Tool.handle_unknown_tool_error name

     

       98
       -
         | exn -> Tool.handle_execution_exception exn

     

       99
       -
       

     

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

     

       101
       -
       let json_to_rpc_content json =

     

       102
       -
         match json with

     

       103
       -
         | `Assoc fields ->

     

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

     

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

     

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

     

       107
       -
                let rpc_content = Tool.mcp_content_to_rpc_content mcp_content in

     

       108
       -
                (rpc_content, is_error)

     

       109
       -
            | _ -> 

     

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

     

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

     

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

     

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

     

       114
       -
         | _ ->

     

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

     

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

     

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

     

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

     

       119
       -
       

     

       120
       -
       (* Process tools/call request *)

     

       121
       -
       let handle_tools_call server req =

     

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

     

       123
       -
         match req.JSONRPCMessage.params with

     

       124
       -
         | Some (`Assoc params) ->

     

       125
       -
           (match extract_tool_name params with

     

       126
       -
           | Some name ->

     

       127
       -
               let args = extract_tool_arguments params in

     

       128
       -
               

     

       129
       -
               (* Create context for this request *)

     

       130
       -
               let ctx = Context.create 

     

       131
       -
                 ?request_id:(Some req.id)

     

       132
       -
                 ?progress_token:req.progress_token

     

       133
       -
                 ~lifespan_context:[("tools/call", `Assoc params)] 

     

       134
       -
                 () 

     

       135
       -
               in

     

       136
       -
                       

     

       137
       -
               (* Execute the tool *)

     

       138
       -
               let result_json = execute_tool server ctx name args in

     

       139
       -
               

     

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

     

       141
       -
               let content, is_error = json_to_rpc_content result_json in

     

       142
       -
               

     

       143
       -
               (* Create the RPC response *)

     

       144
       -
               let response = Mcp_rpc.ToolsCall.create_response 

     

       145
       -
                 ~id:req.id 

     

       146
       -
                 ~content 

     

       147
       -
                 ~is_error 

     

       148
       -
                 () 

     

       149
       -
               in

     

       150
       -
               

     

       151
       -
               Some response

     

       152
       -
           | None ->

     

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

     

       154
       -
         | _ ->

     

       155
       -
           Log.error "Invalid params format for tools/call";

     

       156
       -
           Some (create_jsonrpc_error req.id InvalidParams "Invalid params format for tools/call" ())

     

       157
        
       

     

       158
       -
       (* Process ping request *)

     

       159
       -
       let handle_ping (req:JSONRPCMessage.request) =

     

       160
       -
         Log.debug "Processing ping request";

     

       161
       -
         Some (create_response ~id:req.JSONRPCMessage.id ~result:(`Assoc []))

     

       162
        
       

     

       163
       -
       (* Handle notifications/initialized *)

     

       164
       -
       let handle_initialized (notif:JSONRPCMessage.notification) =

     

       165
       -
         Log.debug "Client initialization complete - Server is now ready to receive requests";

     

       166
       -
         Log.debugf "Notification params: %s" 

     

       167
       -
           (match notif.JSONRPCMessage.params with

     

       168
       -
             | Some p -> Yojson.Safe.to_string p

     

       169
       -
             | None -> "null");

     

       170
       -
         None

     

       171
        
       

     

       172
       -
       (* Process a single message using the MCP SDK *)

     

       173
        
       let process_message server message =

     

       174
        
         try

     

       175
       -
           Log.debugf "Processing message: %s" (Yojson.Safe.to_string message);

     

       176
        
           match JSONRPCMessage.t_of_yojson message with

     

       177
       -
           | JSONRPCMessage.Request req ->

     

       178
       -
             Log.debugf "Received request with method: %s" (Method.to_string req.meth);

     

       179
       -
             (match req.meth with

     

       180
       -
              | Method.Initialize -> handle_initialize server req

     

       181
       -
              | Method.ToolsList -> handle_tools_list server req

     

       182
       -
              | Method.ToolsCall -> handle_tools_call server req

     

       183
       -
              | Method.PromptsList -> handle_prompts_list server req

     

       184
       -
              | Method.ResourcesList -> handle_resources_list server req

     

       185
       -
              | _ -> 

     

       186
       -
                 Log.errorf "Unknown method received: %s" (Method.to_string req.meth);

     

       187
       -
                 Some (create_jsonrpc_error req.id MethodNotFound ("Method not found: " ^ (Method.to_string req.meth)) ()))

     

       188
       -
           | JSONRPCMessage.Notification notif ->

     

       189
       -
             Log.debugf "Received notification with method: %s" (Method.to_string notif.meth);

     

       190
       -
             (match notif.meth with

     

       191
       -
              | Method.Initialized -> handle_initialized notif

     

       192
       -
              | _ ->

     

       193
       -
                 Log.debugf "Ignoring notification: %s" (Method.to_string notif.meth);

     

       194
       -
                 None)

     

       195
       -
           | JSONRPCMessage.Response _ ->

     

       196
       -
             Log.error "Unexpected response message received";

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       197
        
             None

     

       198
       -
           | JSONRPCMessage.Error _ ->

     

       199
       -
             Log.error "Unexpected error message received";

     

       0
        
       
     

       0
        
       
     

       200
        
             None

     

       201
       -
         with

     

       202
       -
         | Json.Of_json (msg, _) ->

     

       203
       -
           Log.errorf "JSON error: %s" msg;

     

       204
       -
           (* Can't respond with error because we don't have a request ID *)

     

       205
       -
           None

     

       206
       -
         | Yojson.Json_error msg -> 

     

       207
       -
           Log.errorf "JSON parse error: %s" msg;

     

       208
       -
           (* Can't respond with error because we don't have a request ID *)

     

       209
       -
           None

     

       210
       -
         | exc ->

     

       211
       -
           Log.errorf "Exception during message processing: %s" (Printexc.to_string exc);

     

       212
       -
           Log.errorf "Backtrace: %s" (Printexc.get_backtrace());

     

       213
       -
           Log.errorf "Message was: %s" (Yojson.Safe.to_string message);

     

       214
       -
           None

     

       215
        
       

     

       216
       -
       (* Extract a request ID from a potentially malformed message *)

     

       217
       -
       let extract_request_id json =

     

       218
        
         try

     

       219
       -
           match json with

     

       220
       -
           | `Assoc fields ->

     

       221
       -
             (match List.assoc_opt "id" fields with

     

       222
       -
              | Some (`Int id) -> Some (`Int id)

     

       223
       -
              | Some (`String id) -> Some (`String id)

     

       224
       -
              | _ -> None)

     

       225
       -
           | _ -> None

     

       226
       -
         with _ -> None

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       227
        
       

     

       228
       -
       (* Handle processing for an input line *)

     

       229
       -
       let process_input_line server line =

     

       230
       -
         if line = "" then (

     

       231
       -
           Log.debug "Empty line received, ignoring";

     

       232
       -
           None

     

       233
       -
         ) else (

     

       234
       -
           Log.debugf "Raw input: %s" line;

     

       235
       -
           try

     

       236
       -
             let json = Yojson.Safe.from_string line in

     

       237
       -
             Log.debug "Successfully parsed JSON";

     

       238
       -
             

     

       239
       -
             (* Process the message *)

     

       240
       -
             process_message server json

     

       241
       -
           with

     

       242
       -
           | Yojson.Json_error msg -> begin

     

       243
       -
               Log.errorf "Error parsing JSON: %s" msg;

     

       244
       -
               Log.errorf "Input was: %s" line;

     

       245
       -
               None

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       246
        
           end

     

       247
       -
         )

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       248
        
       

     

       249
       -
       (* Send a response to the client *)

     

       250
       -
       let send_response stdout response =

     

       251
       -
         let response_json = JSONRPCMessage.yojson_of_t response in

     

       252
       -
         let response_str = Yojson.Safe.to_string response_json in

     

       253
       -
         Log.debugf "Sending response: %s" response_str;

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       254
        
         

     

       255
       -
         (* Write the response followed by a newline *)

     

       256
       -
         Eio.Flow.copy_string response_str stdout;

     

       257
       -
         Eio.Flow.copy_string "\n" stdout

     

       258
       -
       

     

       259
       -
       (* Run the MCP server with the given server configuration *)

     

       260
       -
       let run_server env server =

     

       261
       -
         let stdin = Eio.Stdenv.stdin env in

     

       262
       -
         let stdout = Eio.Stdenv.stdout env in

     

       263
       -
       

     

       264
       -
         Log.debugf "Starting MCP server: %s v%s" (name server) (version server);

     

       265
       -
         Log.debugf "Protocol version: %s" (protocol_version server);

     

       266
        
       

     

       267
       -
         (* Enable exception backtraces *)

     

       268
       -
         Printexc.record_backtrace true;

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       269
        
         

     

       270
       -
         let buf = Eio.Buf_read.of_flow stdin ~initial_size:100 ~max_size:1_000_000 in

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       271
        
         

     

       272
       -
         (* Main processing loop *)

     

       273
       -
         try

     

       274
       -
           while true do

     

       275
       -
             Log.debug "Waiting for message...";

     

       276
       -
             let line = Eio.Buf_read.line buf in

     

       277
        
             

     

       278
       -
             (* Process the input and send response if needed *)

     

       279
       -
             match process_input_line server line with

     

       280
       -
             | Some response -> send_response stdout response

     

       281
       -
             | None -> Log.debug "No response needed for this message"

     

       282
       -
           done

     

       283
       -
         with

     

       284
       -
         | End_of_file -> 

     

       285
       -
             Log.debug "End of file received on stdin";

     

       286
       -
             ()

     

       287
       -
         | Eio.Exn.Io _ as exn ->

     

       288
       -
             Log.errorf "I/O error while reading: %s" (Printexc.to_string exn);

     

       289
       -
             ()

     

       290
       -
         | exn ->

     

       291
       -
             Log.errorf "Exception while reading: %s" (Printexc.to_string exn);

     

       292
       -
             ()

     

       0
        
       
     

       0

···

       1
        
       open Mcp

     

       0
        
       
     

       2
        
       open Mcp_sdk

     

       3
        
       

     

       4
       +
       (* MCP Server module for handling JSON-RPC communication *)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       5
        
       

     

       6
       +
       (** Server types *)

     

       7
       +
       type transport_type = 

     

       8
       +
         | Stdio  (* Read/write to stdin/stdout *)

     

       9
       +
         | Http   (* HTTP server - to be implemented *)

     

       10
        
       

     

       11
       +
       type t = {

     

       12
       +
         server: Mcp_sdk.server;

     

       13
       +
         transport: transport_type;

     

       14
       +
         mutable running: bool;

     

       15
       +
       }

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       16
        
       

     

       17
       +
       (** Process a single message *)

     

       18
        
       let process_message server message =

     

       19
        
         try

     

       20
       +
           Log.debug "Parsing message as JSONRPC message...";

     

       21
        
           match JSONRPCMessage.t_of_yojson message with

     

       22
       +
           | JSONRPCMessage.Request req -> begin

     

       23
       +
               Log.debug (Printf.sprintf "Received request with method: %s" req.method_);

     

       24
       +
               match req.method_ with

     

       25
       +
               | "initialize" -> begin

     

       26
       +
                   Log.debug "Processing initialize request";

     

       27
       +
                   let result = match req.params with

     

       28
       +
                   | Some params -> begin

     

       29
       +
                       Log.debug "Parsing initialize request params...";

     

       30
       +
                       let req_params = Initialize.Request.t_of_yojson params in

     

       31
       +
                       Log.debug (Printf.sprintf "Client info: %s v%s" 

     

       32
       +
                                    req_params.client_info.name 

     

       33
       +
                                    req_params.client_info.version);

     

       34
       +
                       Log.debug (Printf.sprintf "Client protocol version: %s" req_params.protocol_version);

     

       35
       +
                       

     

       36
       +
                       (* Check protocol version compatibility *)

     

       37
       +
                       if req_params.protocol_version <> server.protocol_version then begin

     

       38
       +
                         Log.debug (Printf.sprintf "Protocol version mismatch: client=%s server=%s" 

     

       39
       +
                                     req_params.protocol_version server.protocol_version);

     

       40
       +
                       end;

     

       41
       +
                       

     

       42
       +
                       Initialize.Result.create

     

       43
       +
                         ~capabilities:server.capabilities

     

       44
       +
                         ~server_info:Implementation.{ name = server.name; version = server.version }

     

       45
       +
                         ~protocol_version:server.protocol_version

     

       46
       +
                         ?instructions:(Some "MCP Server") (* TODO: Allow customization *)

     

       47
       +
                         ()

     

       48
       +
                     end

     

       49
       +
                   | None -> begin

     

       50
       +
                       Log.error "Missing params for initialize request";

     

       51
       +
                       Initialize.Result.create

     

       52
       +
                         ~capabilities:server.capabilities

     

       53
       +
                         ~server_info:Implementation.{ name = server.name; version = server.version }

     

       54
       +
                         ~protocol_version:server.protocol_version

     

       55
       +
                         ()

     

       56
       +
                     end

     

       57
       +
                   in

     

       58
       +
                   Some (create_response ~id:req.id ~result:(Initialize.Result.yojson_of_t result))

     

       59
       +
                 end

     

       60
       +
                

     

       61
       +
               | "tools/list" -> begin

     

       62
       +
                   Log.debug "Processing tools/list request";

     

       63
       +
                   let tools_json = List.map Mcp_sdk.Tool.to_json server.tools in

     

       64
       +
                   let result = `Assoc [("tools", `List tools_json)] in

     

       65
       +
                   Some (create_response ~id:req.id ~result)

     

       66
       +
                 end

     

       67
       +
                

     

       68
       +
               | "tools/call" -> begin

     

       69
       +
                   Log.debug "Processing tools/call request";

     

       70
       +
                   match req.params with

     

       71
       +
                   | Some (`Assoc params) -> begin

     

       72
       +
                       let name = match List.assoc_opt "name" params with

     

       73
       +
                       | Some (`String name) -> begin

     

       74
       +
                           Log.debug (Printf.sprintf "Tool name: %s" name);

     

       75
       +
                           name

     

       76
       +
                         end

     

       77
       +
                       | _ -> begin

     

       78
       +
                           Log.error "Missing or invalid 'name' parameter in tool call";

     

       79
       +
                           failwith "Missing or invalid 'name' parameter"

     

       80
       +
                         end

     

       81
       +
                       in

     

       82
       +
                       let args = match List.assoc_opt "arguments" params with

     

       83
       +
                       | Some args -> begin

     

       84
       +
                           Log.debug (Printf.sprintf "Tool arguments: %s" (Yojson.Safe.to_string args));

     

       85
       +
                           args

     

       86
       +
                         end

     

       87
       +
                       | _ -> begin

     

       88
       +
                           Log.debug "No arguments provided for tool call, using empty object";

     

       89
       +
                           `Assoc [] (* Empty arguments is valid *)

     

       90
       +
                         end

     

       91
       +
                       in

     

       92
       +
                       let progress_token = req.progress_token in

     

       93
       +
                       

     

       94
       +
                       (* Find the tool *)

     

       95
       +
                       let tool_opt = List.find_opt (fun t -> t.Mcp_sdk.Tool.name = name) server.tools in

     

       96
       +
                       match tool_opt with

     

       97
       +
                       | Some tool -> begin

     

       98
       +
                           Log.debug (Printf.sprintf "Found tool: %s" name);

     

       99
       +
                           let ctx = Mcp_sdk.Context.create 

     

       100
       +
                               ?request_id:(Some req.id) 

     

       101
       +
                               ~lifespan_context:server.lifespan_context 

     

       102
       +
                               () 

     

       103
       +
                           in

     

       104
       +
                           ctx.progress_token <- progress_token;

     

       105
       +
                           

     

       106
       +
                           (* Call the handler *)

     

       107
       +
                           let result = match tool.handler ctx args with

     

       108
       +
                           | Ok json -> begin

     

       109
       +
                               `Assoc [

     

       110
       +
                                 ("content", `List [Mcp.yojson_of_content (Text (TextContent.{ 

     

       111
       +
                                   text = Yojson.Safe.to_string json;

     

       112
       +
                                   annotations = None 

     

       113
       +
                                 }))]);

     

       114
       +
                                 ("isError", `Bool false)

     

       115
       +
                               ]

     

       116
       +
                             end

     

       117
       +
                           | Error err -> begin

     

       118
       +
                               `Assoc [

     

       119
       +
                                 ("content", `List [Mcp.yojson_of_content (Text (TextContent.{ 

     

       120
       +
                                   text = err;

     

       121
       +
                                   annotations = None 

     

       122
       +
                                 }))]);

     

       123
       +
                                 ("isError", `Bool true)

     

       124
       +
                               ]

     

       125
       +
                             end

     

       126
       +
                           in

     

       127
       +
                           Some (create_response ~id:req.id ~result)

     

       128
       +
                         end

     

       129
       +
                       | None -> begin

     

       130
       +
                           Log.error (Printf.sprintf "Tool not found: %s" name);

     

       131
       +
                           let error_content = TextContent.{

     

       132
       +
                             text = Printf.sprintf "Unknown tool: %s" name;

     

       133
       +
                             annotations = None

     

       134
       +
                           } in

     

       135
       +
                           let result = `Assoc [

     

       136
       +
                             ("content", `List [Mcp.yojson_of_content (Text error_content)]);

     

       137
       +
                             ("isError", `Bool true)

     

       138
       +
                           ] in

     

       139
       +
                           Some (create_response ~id:req.id ~result)

     

       140
       +
                         end

     

       141
       +
                     end

     

       142
       +
                   | _ -> begin

     

       143
       +
                       Log.error "Invalid params format for tools/call";

     

       144
       +
                       Some (create_error ~id:req.id ~code:ErrorCode.invalid_params ~message:"Invalid params for tools/call" ())

     

       145
       +
                     end

     

       146
       +
                 end

     

       147
       +
                   

     

       148
       +
               | "resources/list" -> begin

     

       149
       +
                   Log.debug "Processing resources/list request";

     

       150
       +
                   if server.resources <> [] then begin

     

       151
       +
                     let resources_json = List.map Mcp_sdk.Resource.to_json server.resources in

     

       152
       +
                     let result = `Assoc [("resources", `List resources_json)] in

     

       153
       +
                     Some (create_response ~id:req.id ~result)

     

       154
       +
                   end else begin

     

       155
       +
                     Some (create_error ~id:req.id ~code:ErrorCode.method_not_found ~message:"Resources not supported" ())

     

       156
       +
                   end

     

       157
       +
                 end

     

       158
       +
                  

     

       159
       +
               | "prompts/list" -> begin

     

       160
       +
                   Log.debug "Processing prompts/list request";

     

       161
       +
                   if server.prompts <> [] then begin

     

       162
       +
                     let prompts_json = List.map Mcp_sdk.Prompt.to_json server.prompts in

     

       163
       +
                     let result = `Assoc [("prompts", `List prompts_json)] in

     

       164
       +
                     Some (create_response ~id:req.id ~result)

     

       165
       +
                   end else begin

     

       166
       +
                     Some (create_error ~id:req.id ~code:ErrorCode.method_not_found ~message:"Prompts not supported" ())

     

       167
       +
                   end

     

       168
       +
                 end

     

       169
       +
                  

     

       170
       +
               | "prompts/get" -> begin

     

       171
       +
                   Log.debug "Processing prompts/get request";

     

       172
       +
                   if server.prompts <> [] then begin

     

       173
       +
                     match req.params with

     

       174
       +
                     | Some (`Assoc params) -> begin

     

       175
       +
                         (* Extract prompt name *)

     

       176
       +
                         let name = match List.assoc_opt "name" params with

     

       177
       +
                         | Some (`String name) -> begin 

     

       178
       +
                             Log.debug (Printf.sprintf "Prompt name: %s" name);

     

       179
       +
                             name

     

       180
       +
                           end

     

       181
       +
                         | _ -> begin

     

       182
       +
                             Log.error "Missing or invalid 'name' parameter in prompt request";

     

       183
       +
                             failwith "Missing or invalid 'name' parameter"

     

       184
       +
                           end

     

       185
       +
                         in

     

       186
       +
                         

     

       187
       +
                         (* Extract arguments if any *)

     

       188
       +
                         let arguments = match List.assoc_opt "arguments" params with

     

       189
       +
                         | Some (`Assoc args) -> begin

     

       190
       +
                             Log.debug (Printf.sprintf "Prompt arguments: %s" (Yojson.Safe.to_string (`Assoc args)));

     

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

     

       192
       +
                               match v with 

     

       193
       +
                               | `String s -> begin (k, s) end

     

       194
       +
                               | _ -> begin (k, Yojson.Safe.to_string v) end

     

       195
       +
                             ) args

     

       196
       +
                           end

     

       197
       +
                         | _ -> begin

     

       198
       +
                             []

     

       199
       +
                           end

     

       200
       +
                         in

     

       201
       +
                         

     

       202
       +
                         (* Find the prompt *)

     

       203
       +
                         let prompt_opt = List.find_opt (fun p -> p.Mcp_sdk.Prompt.name = name) server.prompts in

     

       204
       +
                         match prompt_opt with

     

       205
       +
                         | Some prompt -> begin

     

       206
       +
                             Log.debug (Printf.sprintf "Found prompt: %s" name);

     

       207
       +
                             let ctx = Mcp_sdk.Context.create 

     

       208
       +
                                 ?request_id:(Some req.id) 

     

       209
       +
                                 ~lifespan_context:server.lifespan_context 

     

       210
       +
                                 () 

     

       211
       +
                             in

     

       212
       +
                             

     

       213
       +
                             (* Call the prompt handler *)

     

       214
       +
                             match prompt.handler ctx arguments with

     

       215
       +
                             | Ok messages -> begin

     

       216
       +
                                 Log.debug (Printf.sprintf "Prompt handler returned %d messages" (List.length messages));

     

       217
       +
                                 

     

       218
       +
                                 (* Important: We need to directly use yojson_of_message which preserves MIME types *)

     

       219
       +
                                 let messages_json = List.map Prompt.yojson_of_message messages in

     

       220
       +
                                 

     

       221
       +
                                 (* Debug output *)

     

       222
       +
                                 Log.debug (Printf.sprintf "Messages JSON: %s" (Yojson.Safe.to_string (`List messages_json)));

     

       223
       +
                                 

     

       224
       +
                                 (* Verify one message if available to check structure *)

     

       225
       +
                                 if List.length messages > 0 then begin

     

       226
       +
                                   let first_msg = List.hd messages in

     

       227
       +
                                   let content_debug = match first_msg.content with

     

       228
       +
                                   | Text t -> begin

     

       229
       +
                                       Printf.sprintf "Text content: %s" t.text

     

       230
       +
                                     end

     

       231
       +
                                   | Image i -> begin

     

       232
       +
                                       Printf.sprintf "Image content (mime: %s)" i.mime_type

     

       233
       +
                                     end

     

       234
       +
                                   | Audio a -> begin

     

       235
       +
                                       Printf.sprintf "Audio content (mime: %s)" a.mime_type

     

       236
       +
                                     end

     

       237
       +
                                   | Resource r -> begin

     

       238
       +
                                       "Resource content"

     

       239
       +
                                     end

     

       240
       +
                                   in

     

       241
       +
                                   Log.debug (Printf.sprintf "First message content type: %s" content_debug);

     

       242
       +
                                 end;

     

       243
       +
                                 

     

       244
       +
                                 let result = `Assoc [

     

       245
       +
                                   ("messages", `List messages_json);

     

       246
       +
                                   ("description", match prompt.description with 

     

       247
       +
                                     | Some d -> begin `String d end 

     

       248
       +
                                     | None -> begin `Null end)

     

       249
       +
                                 ] in

     

       250
       +
                                 Some (create_response ~id:req.id ~result)

     

       251
       +
                               end

     

       252
       +
                             | Error err -> begin

     

       253
       +
                                 Log.error (Printf.sprintf "Error processing prompt: %s" err);

     

       254
       +
                                 Some (create_error ~id:req.id ~code:ErrorCode.internal_error ~message:err ())

     

       255
       +
                               end

     

       256
       +
                           end

     

       257
       +
                         | None -> begin

     

       258
       +
                             Log.error (Printf.sprintf "Prompt not found: %s" name);

     

       259
       +
                             Some (create_error ~id:req.id ~code:ErrorCode.invalid_params ~message:(Printf.sprintf "Prompt not found: %s" name) ())

     

       260
       +
                           end

     

       261
       +
                       end

     

       262
       +
                     | _ -> begin

     

       263
       +
                         Log.error "Invalid params format for prompts/get";

     

       264
       +
                         Some (create_error ~id:req.id ~code:ErrorCode.invalid_params ~message:"Invalid params format" ())

     

       265
       +
                       end

     

       266
       +
                   end else begin

     

       267
       +
                     Some (create_error ~id:req.id ~code:ErrorCode.method_not_found ~message:"Prompts not supported" ())

     

       268
       +
                   end

     

       269
       +
                 end

     

       270
       +
                  

     

       271
       +
               | "ping" -> begin

     

       272
       +
                   Log.debug "Processing ping request";

     

       273
       +
                   Some (create_response ~id:req.id ~result:(`Assoc []))

     

       274
       +
                 end

     

       275
       +
                

     

       276
       +
               | _ -> begin

     

       277
       +
                   Log.error (Printf.sprintf "Unknown method received: %s" req.method_);

     

       278
       +
                   Some (create_error ~id:req.id ~code:ErrorCode.method_not_found ~message:("Method not found: " ^ req.method_) ())

     

       279
       +
                 end

     

       280
       +
             end

     

       281
       +
                

     

       282
       +
           | JSONRPCMessage.Notification notif -> begin

     

       283
       +
               Log.debug (Printf.sprintf "Received notification with method: %s" notif.method_);

     

       284
       +
               match notif.method_ with

     

       285
       +
               | "notifications/initialized" -> begin

     

       286
       +
                   Log.debug "Client initialization complete - Server is now ready to receive requests";

     

       287
       +
                   None

     

       288
       +
                 end

     

       289
       +
               | _ -> begin

     

       290
       +
                   Log.debug (Printf.sprintf "Ignoring notification: %s" notif.method_);

     

       291
       +
                   None

     

       292
       +
                 end

     

       293
       +
             end

     

       294
       +
                

     

       295
       +
           | JSONRPCMessage.Response _ -> begin

     

       296
       +
               Log.error "Unexpected response message received";

     

       297
       +
               None

     

       298
       +
             end

     

       299
       +
             

     

       300
       +
           | JSONRPCMessage.Error _ -> begin

     

       301
       +
               Log.error "Unexpected error message received";

     

       302
       +
               None

     

       303
       +
             end

     

       304
       +
         with

     

       305
       +
         | Failure msg -> begin

     

       306
       +
             Log.error (Printf.sprintf "JSON error in message processing: %s" msg);

     

       307
        
             None

     

       308
       +
           end

     

       309
       +
         | exc -> begin

     

       310
       +
             Log.error (Printf.sprintf "Exception during message processing: %s" (Printexc.to_string exc));

     

       311
       +
             Log.error (Printf.sprintf "Backtrace: %s" (Printexc.get_backtrace()));

     

       312
        
             None

     

       313
       +
           end

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       314
        
       

     

       315
       +
       (** Read a single message from stdin *)

     

       316
       +
       let read_stdio_message () =

     

       317
        
         try

     

       318
       +
           Log.debug "Reading line from stdin...";

     

       319
       +
           let line = read_line () in

     

       320
       +
           if line = "" then begin

     

       321
       +
             Log.debug "Empty line received, ignoring";

     

       322
       +
             None

     

       323
       +
           end else begin

     

       324
       +
             Log.debug (Printf.sprintf "Raw input: %s" (String.sub line 0 (min 100 (String.length line))));

     

       325
       +
             try

     

       326
       +
               let json = Yojson.Safe.from_string line in

     

       327
       +
               Log.debug "Successfully parsed JSON";

     

       328
       +
               Some json

     

       329
       +
             with

     

       330
       +
             | Yojson.Json_error msg -> begin

     

       331
       +
                 Log.error (Printf.sprintf "Error parsing JSON: %s" msg);

     

       332
       +
                 Log.error (Printf.sprintf "Input was: %s" (String.sub line 0 (min 100 (String.length line))));

     

       333
       +
                 None

     

       334
       +
               end

     

       335
       +
           end

     

       336
       +
         with

     

       337
       +
         | End_of_file -> begin

     

       338
       +
             Log.debug "End of file received on stdin";

     

       339
       +
             None

     

       340
       +
           end

     

       341
       +
         | Sys_error msg -> begin

     

       342
       +
             Log.error (Printf.sprintf "System error while reading: %s" msg);

     

       343
       +
             None

     

       344
       +
           end

     

       345
       +
         | exc -> begin

     

       346
       +
             Log.error (Printf.sprintf "Exception while reading: %s" (Printexc.to_string exc));

     

       347
       +
             None

     

       348
       +
           end

     

       349
        
       

     

       350
       +
       (** Run stdio server with enhanced error handling *)

     

       351
       +
       let rec run_stdio_server mcp_server =

     

       352
       +
         try begin

     

       353
       +
           if not mcp_server.running then begin

     

       354
       +
             Log.debug "Server stopped";

     

       355
       +
             ()

     

       356
       +
           end else begin

     

       357
       +
             match read_stdio_message () with

     

       358
       +
             | Some json -> begin

     

       359
       +
                 Log.debug "Processing message...";

     

       360
       +
                 try begin

     

       361
       +
                   match process_message mcp_server.server json with

     

       362
       +
                   | Some response -> begin

     

       363
       +
                       let response_json = JSONRPCMessage.yojson_of_t response in

     

       364
       +
                       let response_str = Yojson.Safe.to_string response_json in

     

       365
       +
                       Log.debug (Printf.sprintf "Sending response: %s" 

     

       366
       +
                                   (String.sub response_str 0 (min 100 (String.length response_str))));

     

       367
       +
                       Printf.printf "%s\n" response_str;

     

       368
       +
                       flush stdout;

     

       369
       +
                       (* Give client time to process *)

     

       370
       +
                       Unix.sleepf 0.01;

     

       371
       +
                     end

     

       372
       +
                   | None -> begin

     

       373
       +
                       Log.debug "No response needed"

     

       374
       +
                     end

     

       375
       +
                   end with

     

       376
       +
                   | exc -> begin

     

       377
       +
                       Log.error (Printf.sprintf "ERROR in message processing: %s" (Printexc.to_string exc));

     

       378
       +
                       Log.error (Printf.sprintf "Backtrace: %s" (Printexc.get_backtrace()));

     

       379
       +
                       (* Try to extract ID and send an error response *)

     

       380
       +
                       try begin

     

       381
       +
                         let id_opt = match Yojson.Safe.Util.member "id" json with

     

       382
       +
                           | `Int i -> Some (`Int i)

     

       383
       +
                           | `String s -> Some (`String s)

     

       384
       +
                           | _ -> None

     

       385
       +
                         in

     

       386
       +
                         match id_opt with

     

       387
       +
                         | Some id -> begin

     

       388
       +
                             let error_resp = create_error ~id ~code:ErrorCode.internal_error ~message:(Printexc.to_string exc) () in

     

       389
       +
                             let error_json = JSONRPCMessage.yojson_of_t error_resp in

     

       390
       +
                             let error_str = Yojson.Safe.to_string error_json in

     

       391
       +
                             Printf.printf "%s\n" error_str;

     

       392
       +
                             flush stdout;

     

       393
       +
                           end

     

       394
       +
                         | None -> begin

     

       395
       +
                             Log.error "Could not extract request ID to send error response"

     

       396
       +
                           end

     

       397
       +
                         end with

     

       398
       +
                         | e -> begin

     

       399
       +
                             Log.error (Printf.sprintf "Failed to send error response: %s" (Printexc.to_string e))

     

       400
       +
                           end

     

       401
       +
                     end;

     

       402
       +
                 run_stdio_server mcp_server

     

       403
       +
               end

     

       404
       +
             | None -> begin

     

       405
       +
                 if mcp_server.running then begin

     

       406
       +
                   (* No message received, but server is still running *)

     

       407
       +
                   Unix.sleepf 0.1;  (* Small sleep to prevent CPU spinning *)

     

       408
       +
                   run_stdio_server mcp_server

     

       409
       +
                 end else begin

     

       410
       +
                   Log.debug "Server stopped during message processing"

     

       411
       +
                 end

     

       412
       +
               end

     

       413
        
           end

     

       414
       +
         end with

     

       415
       +
         | exc -> begin

     

       416
       +
             Log.error (Printf.sprintf "FATAL ERROR in server main loop: %s" (Printexc.to_string exc));

     

       417
       +
             Log.error (Printf.sprintf "Backtrace: %s" (Printexc.get_backtrace()));

     

       418
       +
             (* Try to continue anyway *)

     

       419
       +
             if mcp_server.running then begin

     

       420
       +
               Unix.sleepf 0.1;

     

       421
       +
               run_stdio_server mcp_server

     

       422
       +
             end

     

       423
       +
           end

     

       424
        
       

     

       425
       +
       (** Create an MCP server *)

     

       426
       +
       let create ~server ~transport () =

     

       427
       +
         { server; transport; running = false }

     

       428
       +
       

     

       429
       +
       (** HTTP server placeholder (to be fully implemented) *)

     

       430
       +
       let run_http_server mcp_server port =

     

       431
       +
         Log.info (Printf.sprintf "%s HTTP server starting on port %d" mcp_server.server.name port);

     

       432
       +
         Log.info "HTTP transport is a placeholder and not fully implemented yet";

     

       433
       +
         

     

       434
       +
         (* This would be where we'd set up cohttp server *)

     

       435
       +
         (*

     

       436
       +
         let callback _conn req body =

     

       437
       +
           let uri = req |> Cohttp.Request.uri in

     

       438
       +
           let meth = req |> Cohttp.Request.meth |> Cohttp.Code.string_of_method in

     

       439
       +
           

     

       440
       +
           (* Handle only POST /jsonrpc endpoint *)

     

       441
       +
           match (meth, Uri.path uri) with

     

       442
       +
           | "POST", "/jsonrpc" ->

     

       443
       +
             (* Read the body *)

     

       444
       +
             Cohttp_lwt.Body.to_string body >>= fun body_str ->

     

       445
       +
             

     

       446
       +
             (* Parse JSON *)

     

       447
       +
             let json = try Some (Yojson.Safe.from_string body_str) with _ -> None in

     

       448
       +
             match json with

     

       449
       +
             | Some json_msg ->

     

       450
       +
               (* Process the message *)

     

       451
       +
               let response_opt = process_message mcp_server.server json_msg in

     

       452
       +
               (match response_opt with

     

       453
       +
               | Some response ->

     

       454
       +
                 let response_json = JSONRPCMessage.yojson_of_t response in

     

       455
       +
                 let response_str = Yojson.Safe.to_string response_json in

     

       456
       +
                 Cohttp_lwt_unix.Server.respond_string

     

       457
       +
                   ~status:`OK

     

       458
       +
                   ~body:response_str

     

       459
       +
                   ~headers:(Cohttp.Header.init_with "Content-Type" "application/json")

     

       460
       +
                   ()

     

       461
       +
               | None ->

     

       462
       +
                 Cohttp_lwt_unix.Server.respond_string

     

       463
       +
                   ~status:`OK

     

       464
       +
                   ~body:"{}"

     

       465
       +
                   ~headers:(Cohttp.Header.init_with "Content-Type" "application/json")

     

       466
       +
                   ())

     

       467
       +
             | None ->

     

       468
       +
               Cohttp_lwt_unix.Server.respond_string

     

       469
       +
                 ~status:`Bad_request

     

       470
       +
                 ~body:"{\"error\":\"Invalid JSON\"}"

     

       471
       +
                 ~headers:(Cohttp.Header.init_with "Content-Type" "application/json")

     

       472
       +
                 ()

     

       473
       +
           | _ ->

     

       474
       +
             (* Return 404 for any other routes *)

     

       475
       +
             Cohttp_lwt_unix.Server.respond_string

     

       476
       +
               ~status:`Not_found

     

       477
       +
               ~body:"Not found"

     

       478
       +
               ()

     

       479
       +
         in

     

       480
       +
         

     

       481
       +
         (* Create and start the server *)

     

       482
       +
         let server = Cohttp_lwt_unix.Server.create

     

       483
       +
           ~mode:(`TCP (`Port port))

     

       484
       +
           (Cohttp_lwt_unix.Server.make ~callback ())

     

       485
       +
         in

     

       486
        
         

     

       487
       +
         (* Run the server *)

     

       488
       +
         Lwt_main.run server

     

       489
       +
         *)

     

       490
       +
         

     

       491
       +
         (* For now, just wait until the server is stopped *)

     

       492
       +
         while mcp_server.running do

     

       493
       +
           Unix.sleep 1

     

       494
       +
         done

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       495
        
       

     

       496
       +
       (** Start the server based on transport type *)

     

       497
       +
       let start server =

     

       498
       +
         server.running <- true;

     

       499
       +
         

     

       500
       +
         (* Run startup hook if provided *)

     

       501
       +
         (match server.server.startup_hook with

     

       502
       +
         | Some hook -> begin hook () end

     

       503
       +
         | None -> begin () end);

     

       504
        
         

     

       505
       +
         (* Install signal handler *)

     

       506
       +
         Sys.(set_signal sigint (Signal_handle (fun _ -> 

     

       507
       +
           Log.debug "Received interrupt signal, stopping server...";

     

       508
       +
           server.running <- false

     

       509
       +
         )));

     

       510
        
         

     

       511
       +
         match server.transport with

     

       512
       +
         | Stdio -> begin

     

       513
       +
             (* Setup stdout and stderr *)

     

       514
       +
             set_binary_mode_out stdout false;

     

       515
       +
             Log.info (Printf.sprintf "%s server started with stdio transport" server.server.name);

     

       516
        
             

     

       517
       +
             (* Run the server loop *)

     

       518
       +
             run_stdio_server server

     

       519
       +
           end

     

       520
       +
         | Http -> begin

     

       521
       +
             (* HTTP server placeholder *)

     

       522
       +
             run_http_server server 8080

     

       523
       +
           end

     

       524
       +
       

     

       525
       +
       (** Stop the server *)

     

       526
       +
       let stop server =

     

       527
       +
         Log.info "Stopping server...";

     

       528
       +
         server.running <- false;

     

       529
       +
         

     

       530
       +
         (* Run shutdown hook if provided *)

     

       531
       +
         match server.server.shutdown_hook with

     

       532
       +
         | Some hook -> begin hook () end

     

       533
       +
         | None -> begin () end

+54

lib/mcp_server.mli

···

       1
       +
       (** MCP Server module - full implementation *)

     

       2
       +
       

     

       3
       +
       (** Transport type for server *)

     

       4
       +
       type transport_type = 

     

       5
       +
         | Stdio  (** Read/write to stdin/stdout *)

     

       6
       +
         | Http   (** HTTP server - to be implemented *)

     

       7
       +
       

     

       8
       +
       (** Server type *)

     

       9
       +
       type t = {

     

       10
       +
         server: Mcp_sdk.server;

     

       11
       +
         transport: transport_type;

     

       12
       +
         mutable running: bool;

     

       13
       +
       }

     

       14
       +
       

     

       15
       +
       (** Create an MCP server 

     

       16
       +
           @param server The Mcp_sdk server to use

     

       17
       +
           @param transport The transport type to use

     

       18
       +
       *)

     

       19
       +
       val create : server:Mcp_sdk.server -> transport:transport_type -> unit -> t

     

       20
       +
       

     

       21
       +
       (** Start the server

     

       22
       +
           This function will block until the server is stopped.

     

       23
       +
           @param server The server to start

     

       24
       +
       *)

     

       25
       +
       val start : t -> unit

     

       26
       +
       

     

       27
       +
       (** Stop the server

     

       28
       +
           This will set the running flag to false and invoke the shutdown hook.

     

       29
       +
           @param server The server to stop

     

       30
       +
       *)

     

       31
       +
       val stop : t -> unit

     

       32
       +
       

     

       33
       +
       (** Process a single message 

     

       34
       +
           @param server The Mcp_sdk server to use

     

       35
       +
           @param message The JSON message to process

     

       36
       +
           @return An optional response message

     

       37
       +
       *)

     

       38
       +
       val process_message : Mcp_sdk.server -> Yojson.Safe.t -> Mcp.JSONRPCMessage.t option

     

       39
       +
       

     

       40
       +
       (** Run stdio server implementation 

     

       41
       +
           @param mcp_server The mcp_server to run

     

       42
       +
       *)

     

       43
       +
       val run_stdio_server : t -> unit

     

       44
       +
       

     

       45
       +
       (** Read a message from stdio

     

       46
       +
           @return An optional JSON message

     

       47
       +
       *)

     

       48
       +
       val read_stdio_message : unit -> Yojson.Safe.t option

     

       49
       +
       

     

       50
       +
       (** Run HTTP server implementation (placeholder)

     

       51
       +
           @param mcp_server The mcp_server to run

     

       52
       +
           @param port The port to listen on

     

       53
       +
       *)

     

       54
       +
       val run_http_server : t -> int -> unit

-29

mcp.opam

···

       1
       -
       # This file is generated by dune, edit dune-project instead

     

       2
       -
       opam-version: "2.0"

     

       3
       -
       synopsis: "Model Context Protocol for LLMs"

     

       4
       -
       description: "This is all still a work in progress"

     

       5
       -
       maintainer: ["anil@recoil.org"]

     

       6
       -
       authors: ["Anil Madhavapeddy"]

     

       7
       -
       license: "ISC"

     

       8
       -
       depends: [

     

       9
       -
         "dune" {>= "3.17"}

     

       10
       -
         "ocaml" {>= "5.2.0"}

     

       11
       -
         "jsonrpc"

     

       12
       -
         "eio_main"

     

       13
       -
         "eio"

     

       14
       -
         "odoc" {with-doc}

     

       15
       -
       ]

     

       16
       -
       build: [

     

       17
       -
         ["dune" "subst"] {dev}

     

       18
       -
         [

     

       19
       -
           "dune"

     

       20
       -
           "build"

     

       21
       -
           "-p"

     

       22
       -
           name

     

       23
       -
           "-j"

     

       24
       -
           jobs

     

       25
       -
           "@install"

     

       26
       -
           "@runtest" {with-test}

     

       27
       -
           "@doc" {with-doc}

     

       28
       -
         ]

     

       29
       -
       ]

+178

spec/00-arch.md

···

       1
       +
       ---

     

       2
       +
       title: Architecture

     

       3
       +
       cascade:

     

       4
       +
         type: docs

     

       5
       +
       weight: 10

     

       6
       +
       ---

     

       7
       +
       

     

       8
       +
       The Model Context Protocol (MCP) follows a client-host-server architecture where each

     

       9
       +
       host can run multiple client instances. This architecture enables users to integrate AI

     

       10
       +
       capabilities across applications while maintaining clear security boundaries and

     

       11
       +
       isolating concerns. Built on JSON-RPC, MCP provides a stateful session protocol focused

     

       12
       +
       on context exchange and sampling coordination between clients and servers.

     

       13
       +
       

     

       14
       +
       ## Core Components

     

       15
       +
       

     

       16
       +
       ```mermaid

     

       17
       +
       graph LR

     

       18
       +
           subgraph "Application Host Process"

     

       19
       +
               H[Host]

     

       20
       +
               C1[Client 1]

     

       21
       +
               C2[Client 2]

     

       22
       +
               C3[Client 3]

     

       23
       +
               H --> C1

     

       24
       +
               H --> C2

     

       25
       +
               H --> C3

     

       26
       +
           end

     

       27
       +
       

     

       28
       +
           subgraph "Local machine"

     

       29
       +
               S1[Server 1<br>Files & Git]

     

       30
       +
               S2[Server 2<br>Database]

     

       31
       +
               R1[("Local<br>Resource A")]

     

       32
       +
               R2[("Local<br>Resource B")]

     

       33
       +
       

     

       34
       +
               C1 --> S1

     

       35
       +
               C2 --> S2

     

       36
       +
               S1 <--> R1

     

       37
       +
               S2 <--> R2

     

       38
       +
           end

     

       39
       +
       

     

       40
       +
           subgraph "Internet"

     

       41
       +
               S3[Server 3<br>External APIs]

     

       42
       +
               R3[("Remote<br>Resource C")]

     

       43
       +
       

     

       44
       +
               C3 --> S3

     

       45
       +
               S3 <--> R3

     

       46
       +
           end

     

       47
       +
       ```

     

       48
       +
       

     

       49
       +
       ### Host

     

       50
       +
       

     

       51
       +
       The host process acts as the container and coordinator:

     

       52
       +
       

     

       53
       +
       - Creates and manages multiple client instances

     

       54
       +
       - Controls client connection permissions and lifecycle

     

       55
       +
       - Enforces security policies and consent requirements

     

       56
       +
       - Handles user authorization decisions

     

       57
       +
       - Coordinates AI/LLM integration and sampling

     

       58
       +
       - Manages context aggregation across clients

     

       59
       +
       

     

       60
       +
       ### Clients

     

       61
       +
       

     

       62
       +
       Each client is created by the host and maintains an isolated server connection:

     

       63
       +
       

     

       64
       +
       - Establishes one stateful session per server

     

       65
       +
       - Handles protocol negotiation and capability exchange

     

       66
       +
       - Routes protocol messages bidirectionally

     

       67
       +
       - Manages subscriptions and notifications

     

       68
       +
       - Maintains security boundaries between servers

     

       69
       +
       

     

       70
       +
       A host application creates and manages multiple clients, with each client having a 1:1

     

       71
       +
       relationship with a particular server.

     

       72
       +
       

     

       73
       +
       ### Servers

     

       74
       +
       

     

       75
       +
       Servers provide specialized context and capabilities:

     

       76
       +
       

     

       77
       +
       - Expose resources, tools and prompts via MCP primitives

     

       78
       +
       - Operate independently with focused responsibilities

     

       79
       +
       - Request sampling through client interfaces

     

       80
       +
       - Must respect security constraints

     

       81
       +
       - Can be local processes or remote services

     

       82
       +
       

     

       83
       +
       ## Design Principles

     

       84
       +
       

     

       85
       +
       MCP is built on several key design principles that inform its architecture and

     

       86
       +
       implementation:

     

       87
       +
       

     

       88
       +
       1. **Servers should be extremely easy to build**

     

       89
       +
       

     

       90
       +
          - Host applications handle complex orchestration responsibilities

     

       91
       +
          - Servers focus on specific, well-defined capabilities

     

       92
       +
          - Simple interfaces minimize implementation overhead

     

       93
       +
          - Clear separation enables maintainable code

     

       94
       +
       

     

       95
       +
       2. **Servers should be highly composable**

     

       96
       +
       

     

       97
       +
          - Each server provides focused functionality in isolation

     

       98
       +
          - Multiple servers can be combined seamlessly

     

       99
       +
          - Shared protocol enables interoperability

     

       100
       +
          - Modular design supports extensibility

     

       101
       +
       

     

       102
       +
       3. **Servers should not be able to read the whole conversation, nor "see into" other

     

       103
       +
          servers**

     

       104
       +
       

     

       105
       +
          - Servers receive only necessary contextual information

     

       106
       +
          - Full conversation history stays with the host

     

       107
       +
          - Each server connection maintains isolation

     

       108
       +
          - Cross-server interactions are controlled by the host

     

       109
       +
          - Host process enforces security boundaries

     

       110
       +
       

     

       111
       +
       4. **Features can be added to servers and clients progressively**

     

       112
       +
          - Core protocol provides minimal required functionality

     

       113
       +
          - Additional capabilities can be negotiated as needed

     

       114
       +
          - Servers and clients evolve independently

     

       115
       +
          - Protocol designed for future extensibility

     

       116
       +
          - Backwards compatibility is maintained

     

       117
       +
       

     

       118
       +
       ## Capability Negotiation

     

       119
       +
       

     

       120
       +
       The Model Context Protocol uses a capability-based negotiation system where clients and

     

       121
       +
       servers explicitly declare their supported features during initialization. Capabilities

     

       122
       +
       determine which protocol features and primitives are available during a session.

     

       123
       +
       

     

       124
       +
       - Servers declare capabilities like resource subscriptions, tool support, and prompt

     

       125
       +
         templates

     

       126
       +
       - Clients declare capabilities like sampling support and notification handling

     

       127
       +
       - Both parties must respect declared capabilities throughout the session

     

       128
       +
       - Additional capabilities can be negotiated through extensions to the protocol

     

       129
       +
       

     

       130
       +
       ```mermaid

     

       131
       +
       sequenceDiagram

     

       132
       +
           participant Host

     

       133
       +
           participant Client

     

       134
       +
           participant Server

     

       135
       +
       

     

       136
       +
           Host->>+Client: Initialize client

     

       137
       +
           Client->>+Server: Initialize session with capabilities

     

       138
       +
           Server-->>Client: Respond with supported capabilities

     

       139
       +
       

     

       140
       +
           Note over Host,Server: Active Session with Negotiated Features

     

       141
       +
       

     

       142
       +
           loop Client Requests

     

       143
       +
               Host->>Client: User- or model-initiated action

     

       144
       +
               Client->>Server: Request (tools/resources)

     

       145
       +
               Server-->>Client: Response

     

       146
       +
               Client-->>Host: Update UI or respond to model

     

       147
       +
           end

     

       148
       +
       

     

       149
       +
           loop Server Requests

     

       150
       +
               Server->>Client: Request (sampling)

     

       151
       +
               Client->>Host: Forward to AI

     

       152
       +
               Host-->>Client: AI response

     

       153
       +
               Client-->>Server: Response

     

       154
       +
           end

     

       155
       +
       

     

       156
       +
           loop Notifications

     

       157
       +
               Server--)Client: Resource updates

     

       158
       +
               Client--)Server: Status changes

     

       159
       +
           end

     

       160
       +
       

     

       161
       +
           Host->>Client: Terminate

     

       162
       +
           Client->>-Server: End session

     

       163
       +
           deactivate Server

     

       164
       +
       ```

     

       165
       +
       

     

       166
       +
       Each capability unlocks specific protocol features for use during the session. For

     

       167
       +
       example:

     

       168
       +
       

     

       169
       +
       - Implemented [server features]({{< ref "../server" >}}) must be advertised in the

     

       170
       +
         server's capabilities

     

       171
       +
       - Emitting resource subscription notifications requires the server to declare

     

       172
       +
         subscription support

     

       173
       +
       - Tool invocation requires the server to declare tool capabilities

     

       174
       +
       - [Sampling]({{< ref "../client" >}}) requires the client to declare support in its

     

       175
       +
         capabilities

     

       176
       +
       

     

       177
       +
       This capability negotiation ensures clients and servers have a clear understanding of

     

       178
       +
       supported functionality while maintaining protocol extensibility.

spec/README.md

···

       1
       +
       These specifications are snapshots from

     

       2
       +
       https://github.com/modelcontextprotocol/specification/tree/main/docs/specification/2025-03-26

     

       3
       +
       

     

       4
       +
       to help with the agentic prompting.

+386

spec/authorization.md

···

       1
       +
       ---

     

       2
       +
       title: Authorization

     

       3
       +
       type: docs

     

       4
       +
       weight: 15

     

       5
       +
       ---

     

       6
       +
       

     

       7
       +
       {{< callout type="info" >}} **Protocol Revision**: 2025-03-26 {{< /callout >}}

     

       8
       +
       

     

       9
       +
       ## 1. Introduction

     

       10
       +
       

     

       11
       +
       ### 1.1 Purpose and Scope

     

       12
       +
       

     

       13
       +
       The Model Context Protocol provides authorization capabilities at the transport level,

     

       14
       +
       enabling MCP clients to make requests to restricted MCP servers on behalf of resource

     

       15
       +
       owners. This specification defines the authorization flow for HTTP-based transports.

     

       16
       +
       

     

       17
       +
       ### 1.2 Protocol Requirements

     

       18
       +
       

     

       19
       +
       Authorization is **OPTIONAL** for MCP implementations. When supported:

     

       20
       +
       

     

       21
       +
       - Implementations using an HTTP-based transport **SHOULD** conform to this specification.

     

       22
       +
       - Implementations using an STDIO transport **SHOULD NOT** follow this specification, and

     

       23
       +
         instead retrieve credentials from the environment.

     

       24
       +
       - Implementations using alternative transports **MUST** follow established security best

     

       25
       +
         practices for their protocol.

     

       26
       +
       

     

       27
       +
       ### 1.3 Standards Compliance

     

       28
       +
       

     

       29
       +
       This authorization mechanism is based on established specifications listed below, but

     

       30
       +
       implements a selected subset of their features to ensure security and interoperability

     

       31
       +
       while maintaining simplicity:

     

       32
       +
       

     

       33
       +
       - [OAuth 2.1 IETF DRAFT](https://datatracker.ietf.org/doc/html/draft-ietf-oauth-v2-1-12)

     

       34
       +
       - OAuth 2.0 Authorization Server Metadata

     

       35
       +
         ([RFC8414](https://datatracker.ietf.org/doc/html/rfc8414))

     

       36
       +
       - OAuth 2.0 Dynamic Client Registration Protocol

     

       37
       +
         ([RFC7591](https://datatracker.ietf.org/doc/html/rfc7591))

     

       38
       +
       

     

       39
       +
       ## 2. Authorization Flow

     

       40
       +
       

     

       41
       +
       ### 2.1 Overview

     

       42
       +
       

     

       43
       +
       1. MCP auth implementations **MUST** implement OAuth 2.1 with appropriate security

     

       44
       +
          measures for both confidential and public clients.

     

       45
       +
       

     

       46
       +
       2. MCP auth implementations **SHOULD** support the OAuth 2.0 Dynamic Client Registration

     

       47
       +
          Protocol ([RFC7591](https://datatracker.ietf.org/doc/html/rfc7591)).

     

       48
       +
       

     

       49
       +
       3. MCP servers **SHOULD** and MCP clients **MUST** implement OAuth 2.0 Authorization

     

       50
       +
          Server Metadata ([RFC8414](https://datatracker.ietf.org/doc/html/rfc8414)). Servers

     

       51
       +
          that do not support Authorization Server Metadata **MUST** follow the default URI

     

       52
       +
          schema.

     

       53
       +
       

     

       54
       +
       ### 2.2 Basic OAuth 2.1 Authorization

     

       55
       +
       

     

       56
       +
       When authorization is required and not yet proven by the client, servers **MUST** respond

     

       57
       +
       with _HTTP 401 Unauthorized_.

     

       58
       +
       

     

       59
       +
       Clients initiate the

     

       60
       +
       [OAuth 2.1 IETF DRAFT](https://datatracker.ietf.org/doc/html/draft-ietf-oauth-v2-1-12)

     

       61
       +
       authorization flow after receiving the _HTTP 401 Unauthorized_.

     

       62
       +
       

     

       63
       +
       The following demonstrates the basic OAuth 2.1 for public clients using PKCE.

     

       64
       +
       

     

       65
       +
       ```mermaid

     

       66
       +
       sequenceDiagram

     

       67
       +
           participant B as User-Agent (Browser)

     

       68
       +
           participant C as Client

     

       69
       +
           participant M as MCP Server

     

       70
       +
       

     

       71
       +
           C->>M: MCP Request

     

       72
       +
           M->>C: HTTP 401 Unauthorized

     

       73
       +
           Note over C: Generate code_verifier and code_challenge

     

       74
       +
           C->>B: Open browser with authorization URL + code_challenge

     

       75
       +
           B->>M: GET /authorize

     

       76
       +
           Note over M: User logs in and authorizes

     

       77
       +
           M->>B: Redirect to callback URL with auth code

     

       78
       +
           B->>C: Callback with authorization code

     

       79
       +
           C->>M: Token Request with code + code_verifier

     

       80
       +
           M->>C: Access Token (+ Refresh Token)

     

       81
       +
           C->>M: MCP Request with Access Token

     

       82
       +
           Note over C,M: Begin standard MCP message exchange

     

       83
       +
       ```

     

       84
       +
       

     

       85
       +
       ### 2.3 Server Metadata Discovery

     

       86
       +
       

     

       87
       +
       For server capability discovery:

     

       88
       +
       

     

       89
       +
       - MCP clients _MUST_ follow the OAuth 2.0 Authorization Server Metadata protocol defined

     

       90
       +
         in [RFC8414](https://datatracker.ietf.org/doc/html/rfc8414).

     

       91
       +
       - MCP server _SHOULD_ follow the OAuth 2.0 Authorization Server Metadata protocol.

     

       92
       +
       - MCP servers that do not support the OAuth 2.0 Authorization Server Metadata protocol,

     

       93
       +
         _MUST_ support fallback URLs.

     

       94
       +
       

     

       95
       +
       The discovery flow is illustrated below:

     

       96
       +
       

     

       97
       +
       ```mermaid

     

       98
       +
       sequenceDiagram

     

       99
       +
           participant C as Client

     

       100
       +
           participant S as Server

     

       101
       +
       

     

       102
       +
           C->>S: GET /.well-known/oauth-authorization-server

     

       103
       +
           alt Discovery Success

     

       104
       +
               S->>C: 200 OK + Metadata Document

     

       105
       +
               Note over C: Use endpoints from metadata

     

       106
       +
           else Discovery Failed

     

       107
       +
               S->>C: 404 Not Found

     

       108
       +
               Note over C: Fall back to default endpoints

     

       109
       +
           end

     

       110
       +
           Note over C: Continue with authorization flow

     

       111
       +
       ```

     

       112
       +
       

     

       113
       +
       #### 2.3.1 Server Metadata Discovery Headers

     

       114
       +
       

     

       115
       +
       MCP clients _SHOULD_ include the header `MCP-Protocol-Version: <protocol-version>` during

     

       116
       +
       Server Metadata Discovery to allow the MCP server to respond based on the MCP protocol

     

       117
       +
       version.

     

       118
       +
       

     

       119
       +
       For example: `MCP-Protocol-Version: 2024-11-05`

     

       120
       +
       

     

       121
       +
       #### 2.3.2 Authorization Base URL

     

       122
       +
       

     

       123
       +
       The authorization base URL **MUST** be determined from the MCP server URL by discarding

     

       124
       +
       any existing `path` component. For example:

     

       125
       +
       

     

       126
       +
       If the MCP server URL is `https://api.example.com/v1/mcp`, then:

     

       127
       +
       

     

       128
       +
       - The authorization base URL is `https://api.example.com`

     

       129
       +
       - The metadata endpoint **MUST** be at

     

       130
       +
         `https://api.example.com/.well-known/oauth-authorization-server`

     

       131
       +
       

     

       132
       +
       This ensures authorization endpoints are consistently located at the root level of the

     

       133
       +
       domain hosting the MCP server, regardless of any path components in the MCP server URL.

     

       134
       +
       

     

       135
       +
       #### 2.3.3 Fallbacks for Servers without Metadata Discovery

     

       136
       +
       

     

       137
       +
       For servers that do not implement OAuth 2.0 Authorization Server Metadata, clients

     

       138
       +
       **MUST** use the following default endpoint paths relative to the authorization base URL

     

       139
       +
       (as defined in [Section 2.3.2](#232-authorization-base-url)):

     

       140
       +
       

     

       141
       +
       | Endpoint               | Default Path | Description                          |

     

       142
       +
       | ---------------------- | ------------ | ------------------------------------ |

     

       143
       +
       | Authorization Endpoint | /authorize   | Used for authorization requests      |

     

       144
       +
       | Token Endpoint         | /token       | Used for token exchange & refresh    |

     

       145
       +
       | Registration Endpoint  | /register    | Used for dynamic client registration |

     

       146
       +
       

     

       147
       +
       For example, with an MCP server hosted at `https://api.example.com/v1/mcp`, the default

     

       148
       +
       endpoints would be:

     

       149
       +
       

     

       150
       +
       - `https://api.example.com/authorize`

     

       151
       +
       - `https://api.example.com/token`

     

       152
       +
       - `https://api.example.com/register`

     

       153
       +
       

     

       154
       +
       Clients **MUST** first attempt to discover endpoints via the metadata document before

     

       155
       +
       falling back to default paths. When using default paths, all other protocol requirements

     

       156
       +
       remain unchanged.

     

       157
       +
       

     

       158
       +
       ### 2.3 Dynamic Client Registration

     

       159
       +
       

     

       160
       +
       MCP clients and servers **SHOULD** support the

     

       161
       +
       [OAuth 2.0 Dynamic Client Registration Protocol](https://datatracker.ietf.org/doc/html/rfc7591)

     

       162
       +
       to allow MCP clients to obtain OAuth client IDs without user interaction. This provides a

     

       163
       +
       standardized way for clients to automatically register with new servers, which is crucial

     

       164
       +
       for MCP because:

     

       165
       +
       

     

       166
       +
       - Clients cannot know all possible servers in advance

     

       167
       +
       - Manual registration would create friction for users

     

       168
       +
       - It enables seamless connection to new servers

     

       169
       +
       - Servers can implement their own registration policies

     

       170
       +
       

     

       171
       +
       Any MCP servers that _do not_ support Dynamic Client Registration need to provide

     

       172
       +
       alternative ways to obtain a client ID (and, if applicable, client secret). For one of

     

       173
       +
       these servers, MCP clients will have to either:

     

       174
       +
       

     

       175
       +
       1. Hardcode a client ID (and, if applicable, client secret) specifically for that MCP

     

       176
       +
          server, or

     

       177
       +
       2. Present a UI to users that allows them to enter these details, after registering an

     

       178
       +
          OAuth client themselves (e.g., through a configuration interface hosted by the

     

       179
       +
          server).

     

       180
       +
       

     

       181
       +
       ### 2.4 Authorization Flow Steps

     

       182
       +
       

     

       183
       +
       The complete Authorization flow proceeds as follows:

     

       184
       +
       

     

       185
       +
       ```mermaid

     

       186
       +
       sequenceDiagram

     

       187
       +
           participant B as User-Agent (Browser)

     

       188
       +
           participant C as Client

     

       189
       +
           participant M as MCP Server

     

       190
       +
       

     

       191
       +
           C->>M: GET /.well-known/oauth-authorization-server

     

       192
       +
           alt Server Supports Discovery

     

       193
       +
               M->>C: Authorization Server Metadata

     

       194
       +
           else No Discovery

     

       195
       +
               M->>C: 404 (Use default endpoints)

     

       196
       +
           end

     

       197
       +
       

     

       198
       +
           alt Dynamic Client Registration

     

       199
       +
               C->>M: POST /register

     

       200
       +
               M->>C: Client Credentials

     

       201
       +
           end

     

       202
       +
       

     

       203
       +
           Note over C: Generate PKCE Parameters

     

       204
       +
           C->>B: Open browser with authorization URL + code_challenge

     

       205
       +
           B->>M: Authorization Request

     

       206
       +
           Note over M: User /authorizes

     

       207
       +
           M->>B: Redirect to callback with authorization code

     

       208
       +
           B->>C: Authorization code callback

     

       209
       +
           C->>M: Token Request + code_verifier

     

       210
       +
           M->>C: Access Token (+ Refresh Token)

     

       211
       +
           C->>M: API Requests with Access Token

     

       212
       +
       ```

     

       213
       +
       

     

       214
       +
       #### 2.4.1 Decision Flow Overview

     

       215
       +
       

     

       216
       +
       ```mermaid

     

       217
       +
       flowchart TD

     

       218
       +
           A[Start Auth Flow] --> B{Check Metadata Discovery}

     

       219
       +
           B -->|Available| C[Use Metadata Endpoints]

     

       220
       +
           B -->|Not Available| D[Use Default Endpoints]

     

       221
       +
       

     

       222
       +
           C --> G{Check Registration Endpoint}

     

       223
       +
           D --> G

     

       224
       +
       

     

       225
       +
           G -->|Available| H[Perform Dynamic Registration]

     

       226
       +
           G -->|Not Available| I[Alternative Registration Required]

     

       227
       +
       

     

       228
       +
           H --> J[Start OAuth Flow]

     

       229
       +
           I --> J

     

       230
       +
       

     

       231
       +
           J --> K[Generate PKCE Parameters]

     

       232
       +
           K --> L[Request Authorization]

     

       233
       +
           L --> M[User Authorization]

     

       234
       +
           M --> N[Exchange Code for Tokens]

     

       235
       +
           N --> O[Use Access Token]

     

       236
       +
       ```

     

       237
       +
       

     

       238
       +
       ### 2.5 Access Token Usage

     

       239
       +
       

     

       240
       +
       #### 2.5.1 Token Requirements

     

       241
       +
       

     

       242
       +
       Access token handling **MUST** conform to

     

       243
       +
       [OAuth 2.1 Section 5](https://datatracker.ietf.org/doc/html/draft-ietf-oauth-v2-1-12#section-5)

     

       244
       +
       requirements for resource requests. Specifically:

     

       245
       +
       

     

       246
       +
       1. MCP client **MUST** use the Authorization request header field

     

       247
       +
          [Section 5.1.1](https://datatracker.ietf.org/doc/html/draft-ietf-oauth-v2-1-12#section-5.1.1):

     

       248
       +
       

     

       249
       +
       ```

     

       250
       +
       Authorization: Bearer <access-token>

     

       251
       +
       ```

     

       252
       +
       

     

       253
       +
       Note that authorization **MUST** be included in every HTTP request from client to server,

     

       254
       +
       even if they are part of the same logical session.

     

       255
       +
       

     

       256
       +
       2. Access tokens **MUST NOT** be included in the URI query string

     

       257
       +
       

     

       258
       +
       Example request:

     

       259
       +
       

     

       260
       +
       ```http

     

       261
       +
       GET /v1/contexts HTTP/1.1

     

       262
       +
       Host: mcp.example.com

     

       263
       +
       Authorization: Bearer eyJhbGciOiJIUzI1NiIs...

     

       264
       +
       ```

     

       265
       +
       

     

       266
       +
       #### 2.5.2 Token Handling

     

       267
       +
       

     

       268
       +
       Resource servers **MUST** validate access tokens as described in

     

       269
       +
       [Section 5.2](https://datatracker.ietf.org/doc/html/draft-ietf-oauth-v2-1-12#section-5.2).

     

       270
       +
       If validation fails, servers **MUST** respond according to

     

       271
       +
       [Section 5.3](https://datatracker.ietf.org/doc/html/draft-ietf-oauth-v2-1-12#section-5.3)

     

       272
       +
       error handling requirements. Invalid or expired tokens **MUST** receive a HTTP 401

     

       273
       +
       response.

     

       274
       +
       

     

       275
       +
       ### 2.6 Security Considerations

     

       276
       +
       

     

       277
       +
       The following security requirements **MUST** be implemented:

     

       278
       +
       

     

       279
       +
       1. Clients **MUST** securely store tokens following OAuth 2.0 best practices

     

       280
       +
       2. Servers **SHOULD** enforce token expiration and rotation

     

       281
       +
       3. All authorization endpoints **MUST** be served over HTTPS

     

       282
       +
       4. Servers **MUST** validate redirect URIs to prevent open redirect vulnerabilities

     

       283
       +
       5. Redirect URIs **MUST** be either localhost URLs or HTTPS URLs

     

       284
       +
       

     

       285
       +
       ### 2.7 Error Handling

     

       286
       +
       

     

       287
       +
       Servers **MUST** return appropriate HTTP status codes for authorization errors:

     

       288
       +
       

     

       289
       +
       | Status Code | Description  | Usage                                      |

     

       290
       +
       | ----------- | ------------ | ------------------------------------------ |

     

       291
       +
       | 401         | Unauthorized | Authorization required or token invalid    |

     

       292
       +
       | 403         | Forbidden    | Invalid scopes or insufficient permissions |

     

       293
       +
       | 400         | Bad Request  | Malformed authorization request            |

     

       294
       +
       

     

       295
       +
       ### 2.8 Implementation Requirements

     

       296
       +
       

     

       297
       +
       1. Implementations **MUST** follow OAuth 2.1 security best practices

     

       298
       +
       2. PKCE is **REQUIRED** for all clients

     

       299
       +
       3. Token rotation **SHOULD** be implemented for enhanced security

     

       300
       +
       4. Token lifetimes **SHOULD** be limited based on security requirements

     

       301
       +
       

     

       302
       +
       ### 2.9 Third-Party Authorization Flow

     

       303
       +
       

     

       304
       +
       #### 2.9.1 Overview

     

       305
       +
       

     

       306
       +
       MCP servers **MAY** support delegated authorization through third-party authorization

     

       307
       +
       servers. In this flow, the MCP server acts as both an OAuth client (to the third-party

     

       308
       +
       auth server) and an OAuth authorization server (to the MCP client).

     

       309
       +
       

     

       310
       +
       #### 2.9.2 Flow Description

     

       311
       +
       

     

       312
       +
       The third-party authorization flow comprises these steps:

     

       313
       +
       

     

       314
       +
       1. MCP client initiates standard OAuth flow with MCP server

     

       315
       +
       2. MCP server redirects user to third-party authorization server

     

       316
       +
       3. User authorizes with third-party server

     

       317
       +
       4. Third-party server redirects back to MCP server with authorization code

     

       318
       +
       5. MCP server exchanges code for third-party access token

     

       319
       +
       6. MCP server generates its own access token bound to the third-party session

     

       320
       +
       7. MCP server completes original OAuth flow with MCP client

     

       321
       +
       

     

       322
       +
       ```mermaid

     

       323
       +
       sequenceDiagram

     

       324
       +
           participant B as User-Agent (Browser)

     

       325
       +
           participant C as MCP Client

     

       326
       +
           participant M as MCP Server

     

       327
       +
           participant T as Third-Party Auth Server

     

       328
       +
       

     

       329
       +
           C->>M: Initial OAuth Request

     

       330
       +
           M->>B: Redirect to Third-Party /authorize

     

       331
       +
           B->>T: Authorization Request

     

       332
       +
           Note over T: User authorizes

     

       333
       +
           T->>B: Redirect to MCP Server callback

     

       334
       +
           B->>M: Authorization code

     

       335
       +
           M->>T: Exchange code for token

     

       336
       +
           T->>M: Third-party access token

     

       337
       +
           Note over M: Generate bound MCP token

     

       338
       +
           M->>B: Redirect to MCP Client callback

     

       339
       +
           B->>C: MCP authorization code

     

       340
       +
           C->>M: Exchange code for token

     

       341
       +
           M->>C: MCP access token

     

       342
       +
       ```

     

       343
       +
       

     

       344
       +
       #### 2.9.3 Session Binding Requirements

     

       345
       +
       

     

       346
       +
       MCP servers implementing third-party authorization **MUST**:

     

       347
       +
       

     

       348
       +
       1. Maintain secure mapping between third-party tokens and issued MCP tokens

     

       349
       +
       2. Validate third-party token status before honoring MCP tokens

     

       350
       +
       3. Implement appropriate token lifecycle management

     

       351
       +
       4. Handle third-party token expiration and renewal

     

       352
       +
       

     

       353
       +
       #### 2.9.4 Security Considerations

     

       354
       +
       

     

       355
       +
       When implementing third-party authorization, servers **MUST**:

     

       356
       +
       

     

       357
       +
       1. Validate all redirect URIs

     

       358
       +
       2. Securely store third-party credentials

     

       359
       +
       3. Implement appropriate session timeout handling

     

       360
       +
       4. Consider security implications of token chaining

     

       361
       +
       5. Implement proper error handling for third-party auth failures

     

       362
       +
       

     

       363
       +
       ## 3. Best Practices

     

       364
       +
       

     

       365
       +
       #### 3.1 Local clients as Public OAuth 2.1 Clients

     

       366
       +
       

     

       367
       +
       We strongly recommend that local clients implement OAuth 2.1 as a public client:

     

       368
       +
       

     

       369
       +
       1. Utilizing code challenges (PKCE) for authorization requests to prevent interception

     

       370
       +
          attacks

     

       371
       +
       2. Implementing secure token storage appropriate for the local system

     

       372
       +
       3. Following token refresh best practices to maintain sessions

     

       373
       +
       4. Properly handling token expiration and renewal

     

       374
       +
       

     

       375
       +
       #### 3.2 Authorization Metadata Discovery

     

       376
       +
       

     

       377
       +
       We strongly recommend that all clients implement metadata discovery. This reduces the

     

       378
       +
       need for users to provide endpoints manually or clients to fallback to the defined

     

       379
       +
       defaults.

     

       380
       +
       

     

       381
       +
       #### 3.3 Dynamic Client Registration

     

       382
       +
       

     

       383
       +
       Since clients do not know the set of MCP servers in advance, we strongly recommend the

     

       384
       +
       implementation of dynamic client registration. This allows applications to automatically

     

       385
       +
       register with the MCP server, and removes the need for users to obtain client ids

     

       386
       +
       manually.

+239

spec/lifecycle.md

···

       1
       +
       ---

     

       2
       +
       title: Lifecycle

     

       3
       +
       type: docs

     

       4
       +
       weight: 30

     

       5
       +
       ---

     

       6
       +
       

     

       7
       +
       {{< callout type="info" >}} **Protocol Revision**: 2025-03-26 {{< /callout >}}

     

       8
       +
       

     

       9
       +
       The Model Context Protocol (MCP) defines a rigorous lifecycle for client-server

     

       10
       +
       connections that ensures proper capability negotiation and state management.

     

       11
       +
       

     

       12
       +
       1. **Initialization**: Capability negotiation and protocol version agreement

     

       13
       +
       2. **Operation**: Normal protocol communication

     

       14
       +
       3. **Shutdown**: Graceful termination of the connection

     

       15
       +
       

     

       16
       +
       ```mermaid

     

       17
       +
       sequenceDiagram

     

       18
       +
           participant Client

     

       19
       +
           participant Server

     

       20
       +
       

     

       21
       +
           Note over Client,Server: Initialization Phase

     

       22
       +
           activate Client

     

       23
       +
           Client->>+Server: initialize request

     

       24
       +
           Server-->>Client: initialize response

     

       25
       +
           Client--)Server: initialized notification

     

       26
       +
       

     

       27
       +
           Note over Client,Server: Operation Phase

     

       28
       +
           rect rgb(200, 220, 250)

     

       29
       +
               note over Client,Server: Normal protocol operations

     

       30
       +
           end

     

       31
       +
       

     

       32
       +
           Note over Client,Server: Shutdown

     

       33
       +
           Client--)-Server: Disconnect

     

       34
       +
           deactivate Server

     

       35
       +
           Note over Client,Server: Connection closed

     

       36
       +
       ```

     

       37
       +
       

     

       38
       +
       ## Lifecycle Phases

     

       39
       +
       

     

       40
       +
       ### Initialization

     

       41
       +
       

     

       42
       +
       The initialization phase **MUST** be the first interaction between client and server.

     

       43
       +
       During this phase, the client and server:

     

       44
       +
       

     

       45
       +
       - Establish protocol version compatibility

     

       46
       +
       - Exchange and negotiate capabilities

     

       47
       +
       - Share implementation details

     

       48
       +
       

     

       49
       +
       The client **MUST** initiate this phase by sending an `initialize` request containing:

     

       50
       +
       

     

       51
       +
       - Protocol version supported

     

       52
       +
       - Client capabilities

     

       53
       +
       - Client implementation information

     

       54
       +
       

     

       55
       +
       ```json

     

       56
       +
       {

     

       57
       +
         "jsonrpc": "2.0",

     

       58
       +
         "id": 1,

     

       59
       +
         "method": "initialize",

     

       60
       +
         "params": {

     

       61
       +
           "protocolVersion": "2024-11-05",

     

       62
       +
           "capabilities": {

     

       63
       +
             "roots": {

     

       64
       +
               "listChanged": true

     

       65
       +
             },

     

       66
       +
             "sampling": {}

     

       67
       +
           },

     

       68
       +
           "clientInfo": {

     

       69
       +
             "name": "ExampleClient",

     

       70
       +
             "version": "1.0.0"

     

       71
       +
           }

     

       72
       +
         }

     

       73
       +
       }

     

       74
       +
       ```

     

       75
       +
       

     

       76
       +
       The initialize request **MUST NOT** be part of a JSON-RPC

     

       77
       +
       [batch](https://www.jsonrpc.org/specification#batch), as other requests and notifications

     

       78
       +
       are not possible until initialization has completed. This also permits backwards

     

       79
       +
       compatibility with prior protocol versions that do not explicitly support JSON-RPC

     

       80
       +
       batches.

     

       81
       +
       

     

       82
       +
       The server **MUST** respond with its own capabilities and information:

     

       83
       +
       

     

       84
       +
       ```json

     

       85
       +
       {

     

       86
       +
         "jsonrpc": "2.0",

     

       87
       +
         "id": 1,

     

       88
       +
         "result": {

     

       89
       +
           "protocolVersion": "2024-11-05",

     

       90
       +
           "capabilities": {

     

       91
       +
             "logging": {},

     

       92
       +
             "prompts": {

     

       93
       +
               "listChanged": true

     

       94
       +
             },

     

       95
       +
             "resources": {

     

       96
       +
               "subscribe": true,

     

       97
       +
               "listChanged": true

     

       98
       +
             },

     

       99
       +
             "tools": {

     

       100
       +
               "listChanged": true

     

       101
       +
             }

     

       102
       +
           },

     

       103
       +
           "serverInfo": {

     

       104
       +
             "name": "ExampleServer",

     

       105
       +
             "version": "1.0.0"

     

       106
       +
           }

     

       107
       +
         }

     

       108
       +
       }

     

       109
       +
       ```

     

       110
       +
       

     

       111
       +
       After successful initialization, the client **MUST** send an `initialized` notification

     

       112
       +
       to indicate it is ready to begin normal operations:

     

       113
       +
       

     

       114
       +
       ```json

     

       115
       +
       {

     

       116
       +
         "jsonrpc": "2.0",

     

       117
       +
         "method": "notifications/initialized"

     

       118
       +
       }

     

       119
       +
       ```

     

       120
       +
       

     

       121
       +
       - The client **SHOULD NOT** send requests other than

     

       122
       +
         [pings]({{< ref "utilities/ping" >}}) before the server has responded to the

     

       123
       +
         `initialize` request.

     

       124
       +
       - The server **SHOULD NOT** send requests other than

     

       125
       +
         [pings]({{< ref "utilities/ping" >}}) and

     

       126
       +
         [logging]({{< ref "../server/utilities/logging" >}}) before receiving the `initialized`

     

       127
       +
         notification.

     

       128
       +
       

     

       129
       +
       #### Version Negotiation

     

       130
       +
       

     

       131
       +
       In the `initialize` request, the client **MUST** send a protocol version it supports.

     

       132
       +
       This **SHOULD** be the _latest_ version supported by the client.

     

       133
       +
       

     

       134
       +
       If the server supports the requested protocol version, it **MUST** respond with the same

     

       135
       +
       version. Otherwise, the server **MUST** respond with another protocol version it

     

       136
       +
       supports. This **SHOULD** be the _latest_ version supported by the server.

     

       137
       +
       

     

       138
       +
       If the client does not support the version in the server's response, it **SHOULD**

     

       139
       +
       disconnect.

     

       140
       +
       

     

       141
       +
       #### Capability Negotiation

     

       142
       +
       

     

       143
       +
       Client and server capabilities establish which optional protocol features will be

     

       144
       +
       available during the session.

     

       145
       +
       

     

       146
       +
       Key capabilities include:

     

       147
       +
       

     

       148
       +
       | Category | Capability     | Description                                                                |

     

       149
       +
       | -------- | -------------- | -------------------------------------------------------------------------- |

     

       150
       +
       | Client   | `roots`        | Ability to provide filesystem [roots]({{< ref "../client/roots" >}})       |

     

       151
       +
       | Client   | `sampling`     | Support for LLM [sampling]({{< ref "../client/sampling" >}}) requests      |

     

       152
       +
       | Client   | `experimental` | Describes support for non-standard experimental features                   |

     

       153
       +
       | Server   | `prompts`      | Offers [prompt templates]({{< ref "../server/prompts" >}})                 |

     

       154
       +
       | Server   | `resources`    | Provides readable [resources]({{< ref "../server/resources" >}})           |

     

       155
       +
       | Server   | `tools`        | Exposes callable [tools]({{< ref "../server/tools" >}})                    |

     

       156
       +
       | Server   | `logging`      | Emits structured [log messages]({{< ref "../server/utilities/logging" >}}) |

     

       157
       +
       | Server   | `experimental` | Describes support for non-standard experimental features                   |

     

       158
       +
       

     

       159
       +
       Capability objects can describe sub-capabilities like:

     

       160
       +
       

     

       161
       +
       - `listChanged`: Support for list change notifications (for prompts, resources, and

     

       162
       +
         tools)

     

       163
       +
       - `subscribe`: Support for subscribing to individual items' changes (resources only)

     

       164
       +
       

     

       165
       +
       ### Operation

     

       166
       +
       

     

       167
       +
       During the operation phase, the client and server exchange messages according to the

     

       168
       +
       negotiated capabilities.

     

       169
       +
       

     

       170
       +
       Both parties **SHOULD**:

     

       171
       +
       

     

       172
       +
       - Respect the negotiated protocol version

     

       173
       +
       - Only use capabilities that were successfully negotiated

     

       174
       +
       

     

       175
       +
       ### Shutdown

     

       176
       +
       

     

       177
       +
       During the shutdown phase, one side (usually the client) cleanly terminates the protocol

     

       178
       +
       connection. No specific shutdown messages are defined—instead, the underlying transport

     

       179
       +
       mechanism should be used to signal connection termination:

     

       180
       +
       

     

       181
       +
       #### stdio

     

       182
       +
       

     

       183
       +
       For the stdio [transport]({{< ref "transports" >}}), the client **SHOULD** initiate

     

       184
       +
       shutdown by:

     

       185
       +
       

     

       186
       +
       1. First, closing the input stream to the child process (the server)

     

       187
       +
       2. Waiting for the server to exit, or sending `SIGTERM` if the server does not exit

     

       188
       +
          within a reasonable time

     

       189
       +
       3. Sending `SIGKILL` if the server does not exit within a reasonable time after `SIGTERM`

     

       190
       +
       

     

       191
       +
       The server **MAY** initiate shutdown by closing its output stream to the client and

     

       192
       +
       exiting.

     

       193
       +
       

     

       194
       +
       #### HTTP

     

       195
       +
       

     

       196
       +
       For HTTP [transports]({{< ref "transports" >}}), shutdown is indicated by closing the

     

       197
       +
       associated HTTP connection(s).

     

       198
       +
       

     

       199
       +
       ## Timeouts

     

       200
       +
       

     

       201
       +
       Implementations **SHOULD** establish timeouts for all sent requests, to prevent hung

     

       202
       +
       connections and resource exhaustion. When the request has not received a success or error

     

       203
       +
       response within the timeout period, the sender **SHOULD** issue a [cancellation

     

       204
       +
       notification]({{< ref "utilities/cancellation" >}}) for that request and stop waiting for

     

       205
       +
       a response.

     

       206
       +
       

     

       207
       +
       SDKs and other middleware **SHOULD** allow these timeouts to be configured on a

     

       208
       +
       per-request basis.

     

       209
       +
       

     

       210
       +
       Implementations **MAY** choose to reset the timeout clock when receiving a [progress

     

       211
       +
       notification]({{< ref "utilities/progress" >}}) corresponding to the request, as this

     

       212
       +
       implies that work is actually happening. However, implementations **SHOULD** always

     

       213
       +
       enforce a maximum timeout, regardless of progress notifications, to limit the impact of a

     

       214
       +
       misbehaving client or server.

     

       215
       +
       

     

       216
       +
       ## Error Handling

     

       217
       +
       

     

       218
       +
       Implementations **SHOULD** be prepared to handle these error cases:

     

       219
       +
       

     

       220
       +
       - Protocol version mismatch

     

       221
       +
       - Failure to negotiate required capabilities

     

       222
       +
       - Request [timeouts](#timeouts)

     

       223
       +
       

     

       224
       +
       Example initialization error:

     

       225
       +
       

     

       226
       +
       ```json

     

       227
       +
       {

     

       228
       +
         "jsonrpc": "2.0",

     

       229
       +
         "id": 1,

     

       230
       +
         "error": {

     

       231
       +
           "code": -32602,

     

       232
       +
           "message": "Unsupported protocol version",

     

       233
       +
           "data": {

     

       234
       +
             "supported": ["2024-11-05"],

     

       235
       +
             "requested": "1.0.0"

     

       236
       +
           }

     

       237
       +
         }

     

       238
       +
       }

     

       239
       +
       ```

+265

spec/prompts.md

···

       1
       +
       ---

     

       2
       +
       title: Prompts

     

       3
       +
       weight: 10

     

       4
       +
       ---

     

       5
       +
       

     

       6
       +
       {{< callout type="info" >}} **Protocol Revision**: 2025-03-26 {{< /callout >}}

     

       7
       +
       

     

       8
       +
       The Model Context Protocol (MCP) provides a standardized way for servers to expose prompt

     

       9
       +
       templates to clients. Prompts allow servers to provide structured messages and

     

       10
       +
       instructions for interacting with language models. Clients can discover available

     

       11
       +
       prompts, retrieve their contents, and provide arguments to customize them.

     

       12
       +
       

     

       13
       +
       ## User Interaction Model

     

       14
       +
       

     

       15
       +
       Prompts are designed to be **user-controlled**, meaning they are exposed from servers to

     

       16
       +
       clients with the intention of the user being able to explicitly select them for use.

     

       17
       +
       

     

       18
       +
       Typically, prompts would be triggered through user-initiated commands in the user

     

       19
       +
       interface, which allows users to naturally discover and invoke available prompts.

     

       20
       +
       

     

       21
       +
       For example, as slash commands:

     

       22
       +
       

     

       23
       +
       ![Example of prompt exposed as slash command](slash-command.png)

     

       24
       +
       

     

       25
       +
       However, implementors are free to expose prompts through any interface pattern that suits

     

       26
       +
       their needs&mdash;the protocol itself does not mandate any specific user interaction

     

       27
       +
       model.

     

       28
       +
       

     

       29
       +
       ## Capabilities

     

       30
       +
       

     

       31
       +
       Servers that support prompts **MUST** declare the `prompts` capability during

     

       32
       +
       [initialization]({{< ref "../basic/lifecycle#initialization" >}}):

     

       33
       +
       

     

       34
       +
       /draft`json { "capabilities": { "prompts": { "listChanged": true } } }

     

       35
       +
       

     

       36
       +
       ````

     

       37
       +
       

     

       38
       +
       `listChanged` indicates whether the server will emit notifications when the list of

     

       39
       +
       available prompts changes.

     

       40
       +
       

     

       41
       +
       ## Protocol Messages

     

       42
       +
       

     

       43
       +
       ### Listing Prompts

     

       44
       +
       

     

       45
       +
       To retrieve available prompts, clients send a `prompts/list` request. This operation

     

       46
       +
       supports [pagination]({{< ref "utilities/pagination" >}}).

     

       47
       +
       

     

       48
       +
       **Request:**

     

       49
       +
       

     

       50
       +
       ```json

     

       51
       +
       {

     

       52
       +
         "jsonrpc": "2.0",

     

       53
       +
         "id": 1,

     

       54
       +
         "method": "prompts/list",

     

       55
       +
         "params": {

     

       56
       +
           "cursor": "optional-cursor-value"

     

       57
       +
         }

     

       58
       +
       }

     

       59
       +
       ````

     

       60
       +
       

     

       61
       +
       **Response:**

     

       62
       +
       

     

       63
       +
       ```json

     

       64
       +
       {

     

       65
       +
         "jsonrpc": "2.0",

     

       66
       +
         "id": 1,

     

       67
       +
         "result": {

     

       68
       +
           "prompts": [

     

       69
       +
             {

     

       70
       +
               "name": "code_review",

     

       71
       +
               "description": "Asks the LLM to analyze code quality and suggest improvements",

     

       72
       +
               "arguments": [

     

       73
       +
                 {

     

       74
       +
                   "name": "code",

     

       75
       +
                   "description": "The code to review",

     

       76
       +
                   "required": true

     

       77
       +
                 }

     

       78
       +
               ]

     

       79
       +
             }

     

       80
       +
           ],

     

       81
       +
           "nextCursor": "next-page-cursor"

     

       82
       +
         }

     

       83
       +
       }

     

       84
       +
       ```

     

       85
       +
       

     

       86
       +
       ### Getting a Prompt

     

       87
       +
       

     

       88
       +
       To retrieve a specific prompt, clients send a `prompts/get` request. Arguments may be

     

       89
       +
       auto-completed through [the completion API]({{< ref "utilities/completion" >}}).

     

       90
       +
       

     

       91
       +
       **Request:**

     

       92
       +
       

     

       93
       +
       ```json

     

       94
       +
       {

     

       95
       +
         "jsonrpc": "2.0",

     

       96
       +
         "id": 2,

     

       97
       +
         "method": "prompts/get",

     

       98
       +
         "params": {

     

       99
       +
           "name": "code_review",

     

       100
       +
           "arguments": {

     

       101
       +
             "code": "def hello():\n    print('world')"

     

       102
       +
           }

     

       103
       +
         }

     

       104
       +
       }

     

       105
       +
       ```

     

       106
       +
       

     

       107
       +
       **Response:**

     

       108
       +
       

     

       109
       +
       ```json

     

       110
       +
       {

     

       111
       +
         "jsonrpc": "2.0",

     

       112
       +
         "id": 2,

     

       113
       +
         "result": {

     

       114
       +
           "description": "Code review prompt",

     

       115
       +
           "messages": [

     

       116
       +
             {

     

       117
       +
               "role": "user",

     

       118
       +
               "content": {

     

       119
       +
                 "type": "text",

     

       120
       +
                 "text": "Please review this Python code:\ndef hello():\n    print('world')"

     

       121
       +
               }

     

       122
       +
             }

     

       123
       +
           ]

     

       124
       +
         }

     

       125
       +
       }

     

       126
       +
       ```

     

       127
       +
       

     

       128
       +
       ### List Changed Notification

     

       129
       +
       

     

       130
       +
       When the list of available prompts changes, servers that declared the `listChanged`

     

       131
       +
       capability **SHOULD** send a notification:

     

       132
       +
       

     

       133
       +
       ```json

     

       134
       +
       {

     

       135
       +
         "jsonrpc": "2.0",

     

       136
       +
         "method": "notifications/prompts/list_changed"

     

       137
       +
       }

     

       138
       +
       ```

     

       139
       +
       

     

       140
       +
       ## Message Flow

     

       141
       +
       

     

       142
       +
       ```mermaid

     

       143
       +
       sequenceDiagram

     

       144
       +
           participant Client

     

       145
       +
           participant Server

     

       146
       +
       

     

       147
       +
           Note over Client,Server: Discovery

     

       148
       +
           Client->>Server: prompts/list

     

       149
       +
           Server-->>Client: List of prompts

     

       150
       +
       

     

       151
       +
           Note over Client,Server: Usage

     

       152
       +
           Client->>Server: prompts/get

     

       153
       +
           Server-->>Client: Prompt content

     

       154
       +
       

     

       155
       +
           opt listChanged

     

       156
       +
             Note over Client,Server: Changes

     

       157
       +
             Server--)Client: prompts/list_changed

     

       158
       +
             Client->>Server: prompts/list

     

       159
       +
             Server-->>Client: Updated prompts

     

       160
       +
           end

     

       161
       +
       ```

     

       162
       +
       

     

       163
       +
       ## Data Types

     

       164
       +
       

     

       165
       +
       ### Prompt

     

       166
       +
       

     

       167
       +
       A prompt definition includes:

     

       168
       +
       

     

       169
       +
       - `name`: Unique identifier for the prompt

     

       170
       +
       - `description`: Optional human-readable description

     

       171
       +
       - `arguments`: Optional list of arguments for customization

     

       172
       +
       

     

       173
       +
       ### PromptMessage

     

       174
       +
       

     

       175
       +
       Messages in a prompt can contain:

     

       176
       +
       

     

       177
       +
       - `role`: Either "user" or "assistant" to indicate the speaker

     

       178
       +
       - `content`: One of the following content types:

     

       179
       +
       

     

       180
       +
       #### Text Content

     

       181
       +
       

     

       182
       +
       Text content represents plain text messages:

     

       183
       +
       

     

       184
       +
       ```json

     

       185
       +
       {

     

       186
       +
         "type": "text",

     

       187
       +
         "text": "The text content of the message"

     

       188
       +
       }

     

       189
       +
       ```

     

       190
       +
       

     

       191
       +
       This is the most common content type used for natural language interactions.

     

       192
       +
       

     

       193
       +
       #### Image Content

     

       194
       +
       

     

       195
       +
       Image content allows including visual information in messages:

     

       196
       +
       

     

       197
       +
       ```json

     

       198
       +
       {

     

       199
       +
         "type": "image",

     

       200
       +
         "data": "base64-encoded-image-data",

     

       201
       +
         "mimeType": "image/png"

     

       202
       +
       }

     

       203
       +
       ```

     

       204
       +
       

     

       205
       +
       The image data **MUST** be base64-encoded and include a valid MIME type. This enables

     

       206
       +
       multi-modal interactions where visual context is important.

     

       207
       +
       

     

       208
       +
       #### Audio Content

     

       209
       +
       

     

       210
       +
       Audio content allows including audio information in messages:

     

       211
       +
       

     

       212
       +
       ```json

     

       213
       +
       {

     

       214
       +
         "type": "audio",

     

       215
       +
         "data": "base64-encoded-audio-data",

     

       216
       +
         "mimeType": "audio/wav"

     

       217
       +
       }

     

       218
       +
       ```

     

       219
       +
       

     

       220
       +
       The audio data MUST be base64-encoded and include a valid MIME type. This enables

     

       221
       +
       multi-modal interactions where audio context is important.

     

       222
       +
       

     

       223
       +
       #### Embedded Resources

     

       224
       +
       

     

       225
       +
       Embedded resources allow referencing server-side resources directly in messages:

     

       226
       +
       

     

       227
       +
       ```json

     

       228
       +
       {

     

       229
       +
         "type": "resource",

     

       230
       +
         "resource": {

     

       231
       +
           "uri": "resource://example",

     

       232
       +
           "mimeType": "text/plain",

     

       233
       +
           "text": "Resource content"

     

       234
       +
         }

     

       235
       +
       }

     

       236
       +
       ```

     

       237
       +
       

     

       238
       +
       Resources can contain either text or binary (blob) data and **MUST** include:

     

       239
       +
       

     

       240
       +
       - A valid resource URI

     

       241
       +
       - The appropriate MIME type

     

       242
       +
       - Either text content or base64-encoded blob data

     

       243
       +
       

     

       244
       +
       Embedded resources enable prompts to seamlessly incorporate server-managed content like

     

       245
       +
       documentation, code samples, or other reference materials directly into the conversation

     

       246
       +
       flow.

     

       247
       +
       

     

       248
       +
       ## Error Handling

     

       249
       +
       

     

       250
       +
       Servers **SHOULD** return standard JSON-RPC errors for common failure cases:

     

       251
       +
       

     

       252
       +
       - Invalid prompt name: `-32602` (Invalid params)

     

       253
       +
       - Missing required arguments: `-32602` (Invalid params)

     

       254
       +
       - Internal errors: `-32603` (Internal error)

     

       255
       +
       

     

       256
       +
       ## Implementation Considerations

     

       257
       +
       

     

       258
       +
       1. Servers **SHOULD** validate prompt arguments before processing

     

       259
       +
       2. Clients **SHOULD** handle pagination for large prompt lists

     

       260
       +
       3. Both parties **SHOULD** respect capability negotiation

     

       261
       +
       

     

       262
       +
       ## Security

     

       263
       +
       

     

       264
       +
       Implementations **MUST** carefully validate all prompt inputs and outputs to prevent

     

       265
       +
       injection attacks or unauthorized access to resources.

+357

spec/resources.md

···

       1
       +
       ---

     

       2
       +
       title: Resources

     

       3
       +
       type: docs

     

       4
       +
       weight: 20

     

       5
       +
       ---

     

       6
       +
       

     

       7
       +
       {{< callout type="info" >}} **Protocol Revision**: 2025-03-26 {{< /callout >}}

     

       8
       +
       

     

       9
       +
       The Model Context Protocol (MCP) provides a standardized way for servers to expose

     

       10
       +
       resources to clients. Resources allow servers to share data that provides context to

     

       11
       +
       language models, such as files, database schemas, or application-specific information.

     

       12
       +
       Each resource is uniquely identified by a

     

       13
       +
       [URI](https://datatracker.ietf.org/doc/html/rfc3986).

     

       14
       +
       

     

       15
       +
       ## User Interaction Model

     

       16
       +
       

     

       17
       +
       Resources in MCP are designed to be **application-driven**, with host applications

     

       18
       +
       determining how to incorporate context based on their needs.

     

       19
       +
       

     

       20
       +
       For example, applications could:

     

       21
       +
       

     

       22
       +
       - Expose resources through UI elements for explicit selection, in a tree or list view

     

       23
       +
       - Allow the user to search through and filter available resources

     

       24
       +
       - Implement automatic context inclusion, based on heuristics or the AI model's selection

     

       25
       +
       

     

       26
       +
       ![Example of resource context picker](resource-picker.png)

     

       27
       +
       

     

       28
       +
       However, implementations are free to expose resources through any interface pattern that

     

       29
       +
       suits their needs&mdash;the protocol itself does not mandate any specific user

     

       30
       +
       interaction model.

     

       31
       +
       

     

       32
       +
       ## Capabilities

     

       33
       +
       

     

       34
       +
       Servers that support resources **MUST** declare the `resources` capability:

     

       35
       +
       

     

       36
       +
       ```json

     

       37
       +
       {

     

       38
       +
         "capabilities": {

     

       39
       +
           "resources": {

     

       40
       +
             "subscribe": true,

     

       41
       +
             "listChanged": true

     

       42
       +
           }

     

       43
       +
         }

     

       44
       +
       }

     

       45
       +
       ```

     

       46
       +
       

     

       47
       +
       The capability supports two optional features:

     

       48
       +
       

     

       49
       +
       - `subscribe`: whether the client can subscribe to be notified of changes to individual

     

       50
       +
         resources.

     

       51
       +
       - `listChanged`: whether the server will emit notifications when the list of available

     

       52
       +
         resources changes.

     

       53
       +
       

     

       54
       +
       Both `subscribe` and `listChanged` are optional&mdash;servers can support neither,

     

       55
       +
       either, or both:

     

       56
       +
       

     

       57
       +
       ```json

     

       58
       +
       {

     

       59
       +
         "capabilities": {

     

       60
       +
           "resources": {} // Neither feature supported

     

       61
       +
         }

     

       62
       +
       }

     

       63
       +
       ```

     

       64
       +
       

     

       65
       +
       ```json

     

       66
       +
       {

     

       67
       +
         "capabilities": {

     

       68
       +
           "resources": {

     

       69
       +
             "subscribe": true // Only subscriptions supported

     

       70
       +
           }

     

       71
       +
         }

     

       72
       +
       }

     

       73
       +
       ```

     

       74
       +
       

     

       75
       +
       ```json

     

       76
       +
       {

     

       77
       +
         "capabilities": {

     

       78
       +
           "resources": {

     

       79
       +
             "listChanged": true // Only list change notifications supported

     

       80
       +
           }

     

       81
       +
         }

     

       82
       +
       }

     

       83
       +
       ```

     

       84
       +
       

     

       85
       +
       ## Protocol Messages

     

       86
       +
       

     

       87
       +
       ### Listing Resources

     

       88
       +
       

     

       89
       +
       To discover available resources, clients send a `resources/list` request. This operation

     

       90
       +
       supports [pagination]({{< ref "utilities/pagination" >}}).

     

       91
       +
       

     

       92
       +
       **Request:**

     

       93
       +
       

     

       94
       +
       ```json

     

       95
       +
       {

     

       96
       +
         "jsonrpc": "2.0",

     

       97
       +
         "id": 1,

     

       98
       +
         "method": "resources/list",

     

       99
       +
         "params": {

     

       100
       +
           "cursor": "optional-cursor-value"

     

       101
       +
         }

     

       102
       +
       }

     

       103
       +
       ```

     

       104
       +
       

     

       105
       +
       **Response:**

     

       106
       +
       

     

       107
       +
       ```json

     

       108
       +
       {

     

       109
       +
         "jsonrpc": "2.0",

     

       110
       +
         "id": 1,

     

       111
       +
         "result": {

     

       112
       +
           "resources": [

     

       113
       +
             {

     

       114
       +
               "uri": "file:///project/src/main.rs",

     

       115
       +
               "name": "main.rs",

     

       116
       +
               "description": "Primary application entry point",

     

       117
       +
               "mimeType": "text/x-rust"

     

       118
       +
             }

     

       119
       +
           ],

     

       120
       +
           "nextCursor": "next-page-cursor"

     

       121
       +
         }

     

       122
       +
       }

     

       123
       +
       ```

     

       124
       +
       

     

       125
       +
       ### Reading Resources

     

       126
       +
       

     

       127
       +
       To retrieve resource contents, clients send a `resources/read` request:

     

       128
       +
       

     

       129
       +
       **Request:**

     

       130
       +
       

     

       131
       +
       ```json

     

       132
       +
       {

     

       133
       +
         "jsonrpc": "2.0",

     

       134
       +
         "id": 2,

     

       135
       +
         "method": "resources/read",

     

       136
       +
         "params": {

     

       137
       +
           "uri": "file:///project/src/main.rs"

     

       138
       +
         }

     

       139
       +
       }

     

       140
       +
       ```

     

       141
       +
       

     

       142
       +
       **Response:**

     

       143
       +
       

     

       144
       +
       ```json

     

       145
       +
       {

     

       146
       +
         "jsonrpc": "2.0",

     

       147
       +
         "id": 2,

     

       148
       +
         "result": {

     

       149
       +
           "contents": [

     

       150
       +
             {

     

       151
       +
               "uri": "file:///project/src/main.rs",

     

       152
       +
               "mimeType": "text/x-rust",

     

       153
       +
               "text": "fn main() {\n    println!(\"Hello world!\");\n}"

     

       154
       +
             }

     

       155
       +
           ]

     

       156
       +
         }

     

       157
       +
       }

     

       158
       +
       ```

     

       159
       +
       

     

       160
       +
       ### Resource Templates

     

       161
       +
       

     

       162
       +
       Resource templates allow servers to expose parameterized resources using

     

       163
       +
       [URI templates](https://datatracker.ietf.org/doc/html/rfc6570). Arguments may be

     

       164
       +
       auto-completed through [the completion API]({{< ref "utilities/completion" >}}).

     

       165
       +
       

     

       166
       +
       **Request:**

     

       167
       +
       

     

       168
       +
       ```json

     

       169
       +
       {

     

       170
       +
         "jsonrpc": "2.0",

     

       171
       +
         "id": 3,

     

       172
       +
         "method": "resources/templates/list"

     

       173
       +
       }

     

       174
       +
       ```

     

       175
       +
       

     

       176
       +
       **Response:**

     

       177
       +
       

     

       178
       +
       ```json

     

       179
       +
       {

     

       180
       +
         "jsonrpc": "2.0",

     

       181
       +
         "id": 3,

     

       182
       +
         "result": {

     

       183
       +
           "resourceTemplates": [

     

       184
       +
             {

     

       185
       +
               "uriTemplate": "file:///{path}",

     

       186
       +
               "name": "Project Files",

     

       187
       +
               "description": "Access files in the project directory",

     

       188
       +
               "mimeType": "application/octet-stream"

     

       189
       +
             }

     

       190
       +
           ]

     

       191
       +
         }

     

       192
       +
       }

     

       193
       +
       ```

     

       194
       +
       

     

       195
       +
       ### List Changed Notification

     

       196
       +
       

     

       197
       +
       When the list of available resources changes, servers that declared the `listChanged`

     

       198
       +
       capability **SHOULD** send a notification:

     

       199
       +
       

     

       200
       +
       ```json

     

       201
       +
       {

     

       202
       +
         "jsonrpc": "2.0",

     

       203
       +
         "method": "notifications/resources/list_changed"

     

       204
       +
       }

     

       205
       +
       ```

     

       206
       +
       

     

       207
       +
       ### Subscriptions

     

       208
       +
       

     

       209
       +
       The protocol supports optional subscriptions to resource changes. Clients can subscribe

     

       210
       +
       to specific resources and receive notifications when they change:

     

       211
       +
       

     

       212
       +
       **Subscribe Request:**

     

       213
       +
       

     

       214
       +
       ```json

     

       215
       +
       {

     

       216
       +
         "jsonrpc": "2.0",

     

       217
       +
         "id": 4,

     

       218
       +
         "method": "resources/subscribe",

     

       219
       +
         "params": {

     

       220
       +
           "uri": "file:///project/src/main.rs"

     

       221
       +
         }

     

       222
       +
       }

     

       223
       +
       ```

     

       224
       +
       

     

       225
       +
       **Update Notification:**

     

       226
       +
       

     

       227
       +
       ```json

     

       228
       +
       {

     

       229
       +
         "jsonrpc": "2.0",

     

       230
       +
         "method": "notifications/resources/updated",

     

       231
       +
         "params": {

     

       232
       +
           "uri": "file:///project/src/main.rs"

     

       233
       +
         }

     

       234
       +
       }

     

       235
       +
       ```

     

       236
       +
       

     

       237
       +
       ## Message Flow

     

       238
       +
       

     

       239
       +
       ```mermaid

     

       240
       +
       sequenceDiagram

     

       241
       +
           participant Client

     

       242
       +
           participant Server

     

       243
       +
       

     

       244
       +
           Note over Client,Server: Resource Discovery

     

       245
       +
           Client->>Server: resources/list

     

       246
       +
           Server-->>Client: List of resources

     

       247
       +
       

     

       248
       +
           Note over Client,Server: Resource Access

     

       249
       +
           Client->>Server: resources/read

     

       250
       +
           Server-->>Client: Resource contents

     

       251
       +
       

     

       252
       +
           Note over Client,Server: Subscriptions

     

       253
       +
           Client->>Server: resources/subscribe

     

       254
       +
           Server-->>Client: Subscription confirmed

     

       255
       +
       

     

       256
       +
           Note over Client,Server: Updates

     

       257
       +
           Server--)Client: notifications/resources/updated

     

       258
       +
           Client->>Server: resources/read

     

       259
       +
           Server-->>Client: Updated contents

     

       260
       +
       ```

     

       261
       +
       

     

       262
       +
       ## Data Types

     

       263
       +
       

     

       264
       +
       ### Resource

     

       265
       +
       

     

       266
       +
       A resource definition includes:

     

       267
       +
       

     

       268
       +
       - `uri`: Unique identifier for the resource

     

       269
       +
       - `name`: Human-readable name

     

       270
       +
       - `description`: Optional description

     

       271
       +
       - `mimeType`: Optional MIME type

     

       272
       +
       - `size`: Optional size in bytes

     

       273
       +
       

     

       274
       +
       ### Resource Contents

     

       275
       +
       

     

       276
       +
       Resources can contain either text or binary data:

     

       277
       +
       

     

       278
       +
       #### Text Content

     

       279
       +
       

     

       280
       +
       ```json

     

       281
       +
       {

     

       282
       +
         "uri": "file:///example.txt",

     

       283
       +
         "mimeType": "text/plain",

     

       284
       +
         "text": "Resource content"

     

       285
       +
       }

     

       286
       +
       ```

     

       287
       +
       

     

       288
       +
       #### Binary Content

     

       289
       +
       

     

       290
       +
       ```json

     

       291
       +
       {

     

       292
       +
         "uri": "file:///example.png",

     

       293
       +
         "mimeType": "image/png",

     

       294
       +
         "blob": "base64-encoded-data"

     

       295
       +
       }

     

       296
       +
       ```

     

       297
       +
       

     

       298
       +
       ## Common URI Schemes

     

       299
       +
       

     

       300
       +
       The protocol defines several standard URI schemes. This list not

     

       301
       +
       exhaustive&mdash;implementations are always free to use additional, custom URI schemes.

     

       302
       +
       

     

       303
       +
       ### https://

     

       304
       +
       

     

       305
       +
       Used to represent a resource available on the web.

     

       306
       +
       

     

       307
       +
       Servers **SHOULD** use this scheme only when the client is able to fetch and load the

     

       308
       +
       resource directly from the web on its own—that is, it doesn’t need to read the resource

     

       309
       +
       via the MCP server.

     

       310
       +
       

     

       311
       +
       For other use cases, servers **SHOULD** prefer to use another URI scheme, or define a

     

       312
       +
       custom one, even if the server will itself be downloading resource contents over the

     

       313
       +
       internet.

     

       314
       +
       

     

       315
       +
       ### file://

     

       316
       +
       

     

       317
       +
       Used to identify resources that behave like a filesystem. However, the resources do not

     

       318
       +
       need to map to an actual physical filesystem.

     

       319
       +
       

     

       320
       +
       MCP servers **MAY** identify file:// resources with an

     

       321
       +
       [XDG MIME type](https://specifications.freedesktop.org/shared-mime-info-spec/0.14/ar01s02.html#id-1.3.14),

     

       322
       +
       like `inode/directory`, to represent non-regular files (such as directories) that don’t

     

       323
       +
       otherwise have a standard MIME type.

     

       324
       +
       

     

       325
       +
       ### git://

     

       326
       +
       

     

       327
       +
       Git version control integration.

     

       328
       +
       

     

       329
       +
       ## Error Handling

     

       330
       +
       

     

       331
       +
       Servers **SHOULD** return standard JSON-RPC errors for common failure cases:

     

       332
       +
       

     

       333
       +
       - Resource not found: `-32002`

     

       334
       +
       - Internal errors: `-32603`

     

       335
       +
       

     

       336
       +
       Example error:

     

       337
       +
       

     

       338
       +
       ```json

     

       339
       +
       {

     

       340
       +
         "jsonrpc": "2.0",

     

       341
       +
         "id": 5,

     

       342
       +
         "error": {

     

       343
       +
           "code": -32002,

     

       344
       +
           "message": "Resource not found",

     

       345
       +
           "data": {

     

       346
       +
             "uri": "file:///nonexistent.txt"

     

       347
       +
           }

     

       348
       +
         }

     

       349
       +
       }

     

       350
       +
       ```

     

       351
       +
       

     

       352
       +
       ## Security Considerations

     

       353
       +
       

     

       354
       +
       1. Servers **MUST** validate all resource URIs

     

       355
       +
       2. Access controls **SHOULD** be implemented for sensitive resources

     

       356
       +
       3. Binary data **MUST** be properly encoded

     

       357
       +
       4. Resource permissions **SHOULD** be checked before operations

spec/slash-command.png

This is a binary file and will not be displayed.

+299

spec/tools.md

···

       1
       +
       ---

     

       2
       +
       title: Tools

     

       3
       +
       type: docs

     

       4
       +
       weight: 40

     

       5
       +
       ---

     

       6
       +
       

     

       7
       +
       {{< callout type="info" >}} **Protocol Revision**: 2025-03-26 {{< /callout >}}

     

       8
       +
       

     

       9
       +
       The Model Context Protocol (MCP) allows servers to expose tools that can be invoked by

     

       10
       +
       language models. Tools enable models to interact with external systems, such as querying

     

       11
       +
       databases, calling APIs, or performing computations. Each tool is uniquely identified by

     

       12
       +
       a name and includes metadata describing its schema.

     

       13
       +
       

     

       14
       +
       ## User Interaction Model

     

       15
       +
       

     

       16
       +
       Tools in MCP are designed to be **model-controlled**, meaning that the language model can

     

       17
       +
       discover and invoke tools automatically based on its contextual understanding and the

     

       18
       +
       user's prompts.

     

       19
       +
       

     

       20
       +
       However, implementations are free to expose tools through any interface pattern that

     

       21
       +
       suits their needs&mdash;the protocol itself does not mandate any specific user

     

       22
       +
       interaction model.

     

       23
       +
       

     

       24
       +
       {{< callout type="warning" >}} For trust & safety and security, there **SHOULD** always

     

       25
       +
       be a human in the loop with the ability to deny tool invocations.

     

       26
       +
       

     

       27
       +
       Applications **SHOULD**:

     

       28
       +
       

     

       29
       +
       - Provide UI that makes clear which tools are being exposed to the AI model

     

       30
       +
       - Insert clear visual indicators when tools are invoked

     

       31
       +
       - Present confirmation prompts to the user for operations, to ensure a human is in the

     

       32
       +
         loop {{< /callout >}}

     

       33
       +
       

     

       34
       +
       ## Capabilities

     

       35
       +
       

     

       36
       +
       Servers that support tools **MUST** declare the `tools` capability:

     

       37
       +
       

     

       38
       +
       ```json

     

       39
       +
       {

     

       40
       +
         "capabilities": {

     

       41
       +
           "tools": {

     

       42
       +
             "listChanged": true

     

       43
       +
           }

     

       44
       +
         }

     

       45
       +
       }

     

       46
       +
       ```

     

       47
       +
       

     

       48
       +
       `listChanged` indicates whether the server will emit notifications when the list of

     

       49
       +
       available tools changes.

     

       50
       +
       

     

       51
       +
       ## Protocol Messages

     

       52
       +
       

     

       53
       +
       ### Listing Tools

     

       54
       +
       

     

       55
       +
       To discover available tools, clients send a `tools/list` request. This operation supports

     

       56
       +
       [pagination]({{< ref "utilities/pagination" >}}).

     

       57
       +
       

     

       58
       +
       **Request:**

     

       59
       +
       

     

       60
       +
       ```json

     

       61
       +
       {

     

       62
       +
         "jsonrpc": "2.0",

     

       63
       +
         "id": 1,

     

       64
       +
         "method": "tools/list",

     

       65
       +
         "params": {

     

       66
       +
           "cursor": "optional-cursor-value"

     

       67
       +
         }

     

       68
       +
       }

     

       69
       +
       ```

     

       70
       +
       

     

       71
       +
       **Response:**

     

       72
       +
       

     

       73
       +
       ```json

     

       74
       +
       {

     

       75
       +
         "jsonrpc": "2.0",

     

       76
       +
         "id": 1,

     

       77
       +
         "result": {

     

       78
       +
           "tools": [

     

       79
       +
             {

     

       80
       +
               "name": "get_weather",

     

       81
       +
               "description": "Get current weather information for a location",

     

       82
       +
               "inputSchema": {

     

       83
       +
                 "type": "object",

     

       84
       +
                 "properties": {

     

       85
       +
                   "location": {

     

       86
       +
                     "type": "string",

     

       87
       +
                     "description": "City name or zip code"

     

       88
       +
                   }

     

       89
       +
                 },

     

       90
       +
                 "required": ["location"]

     

       91
       +
               }

     

       92
       +
             }

     

       93
       +
           ],

     

       94
       +
           "nextCursor": "next-page-cursor"

     

       95
       +
         }

     

       96
       +
       }

     

       97
       +
       ```

     

       98
       +
       

     

       99
       +
       ### Calling Tools

     

       100
       +
       

     

       101
       +
       To invoke a tool, clients send a `tools/call` request:

     

       102
       +
       

     

       103
       +
       **Request:**

     

       104
       +
       

     

       105
       +
       ```json

     

       106
       +
       {

     

       107
       +
         "jsonrpc": "2.0",

     

       108
       +
         "id": 2,

     

       109
       +
         "method": "tools/call",

     

       110
       +
         "params": {

     

       111
       +
           "name": "get_weather",

     

       112
       +
           "arguments": {

     

       113
       +
             "location": "New York"

     

       114
       +
           }

     

       115
       +
         }

     

       116
       +
       }

     

       117
       +
       ```

     

       118
       +
       

     

       119
       +
       **Response:**

     

       120
       +
       

     

       121
       +
       ```json

     

       122
       +
       {

     

       123
       +
         "jsonrpc": "2.0",

     

       124
       +
         "id": 2,

     

       125
       +
         "result": {

     

       126
       +
           "content": [

     

       127
       +
             {

     

       128
       +
               "type": "text",

     

       129
       +
               "text": "Current weather in New York:\nTemperature: 72°F\nConditions: Partly cloudy"

     

       130
       +
             }

     

       131
       +
           ],

     

       132
       +
           "isError": false

     

       133
       +
         }

     

       134
       +
       }

     

       135
       +
       ```

     

       136
       +
       

     

       137
       +
       ### List Changed Notification

     

       138
       +
       

     

       139
       +
       When the list of available tools changes, servers that declared the `listChanged`

     

       140
       +
       capability **SHOULD** send a notification:

     

       141
       +
       

     

       142
       +
       ```json

     

       143
       +
       {

     

       144
       +
         "jsonrpc": "2.0",

     

       145
       +
         "method": "notifications/tools/list_changed"

     

       146
       +
       }

     

       147
       +
       ```

     

       148
       +
       

     

       149
       +
       ## Message Flow

     

       150
       +
       

     

       151
       +
       ```mermaid

     

       152
       +
       sequenceDiagram

     

       153
       +
           participant LLM

     

       154
       +
           participant Client

     

       155
       +
           participant Server

     

       156
       +
       

     

       157
       +
           Note over Client,Server: Discovery

     

       158
       +
           Client->>Server: tools/list

     

       159
       +
           Server-->>Client: List of tools

     

       160
       +
       

     

       161
       +
           Note over Client,LLM: Tool Selection

     

       162
       +
           LLM->>Client: Select tool to use

     

       163
       +
       

     

       164
       +
           Note over Client,Server: Invocation

     

       165
       +
           Client->>Server: tools/call

     

       166
       +
           Server-->>Client: Tool result

     

       167
       +
           Client->>LLM: Process result

     

       168
       +
       

     

       169
       +
           Note over Client,Server: Updates

     

       170
       +
           Server--)Client: tools/list_changed

     

       171
       +
           Client->>Server: tools/list

     

       172
       +
           Server-->>Client: Updated tools

     

       173
       +
       ```

     

       174
       +
       

     

       175
       +
       ## Data Types

     

       176
       +
       

     

       177
       +
       ### Tool

     

       178
       +
       

     

       179
       +
       A tool definition includes:

     

       180
       +
       

     

       181
       +
       - `name`: Unique identifier for the tool

     

       182
       +
       - `description`: Human-readable description of functionality

     

       183
       +
       - `inputSchema`: JSON Schema defining expected parameters

     

       184
       +
       - `annotations`: optional properties describing tool behavior

     

       185
       +
       

     

       186
       +
       {{< callout type="warning" >}} For trust & safety and security, clients **MUST** consider

     

       187
       +
       tool annotations to be untrusted unless they come from trusted servers. {{< /callout >}}

     

       188
       +
       

     

       189
       +
       ### Tool Result

     

       190
       +
       

     

       191
       +
       Tool results can contain multiple content items of different types:

     

       192
       +
       

     

       193
       +
       #### Text Content

     

       194
       +
       

     

       195
       +
       ```json

     

       196
       +
       {

     

       197
       +
         "type": "text",

     

       198
       +
         "text": "Tool result text"

     

       199
       +
       }

     

       200
       +
       ```

     

       201
       +
       

     

       202
       +
       #### Image Content

     

       203
       +
       

     

       204
       +
       ```json

     

       205
       +
       {

     

       206
       +
         "type": "image",

     

       207
       +
         "data": "base64-encoded-data",

     

       208
       +
         "mimeType": "image/png"

     

       209
       +
       }

     

       210
       +
       ```

     

       211
       +
       

     

       212
       +
       #### Audio Content

     

       213
       +
       

     

       214
       +
       ```json

     

       215
       +
       {

     

       216
       +
         "type": "audio",

     

       217
       +
         "data": "base64-encoded-audio-data",

     

       218
       +
         "mimeType": "audio/wav"

     

       219
       +
       }

     

       220
       +
       ```

     

       221
       +
       

     

       222
       +
       #### Embedded Resources

     

       223
       +
       

     

       224
       +
       [Resources]({{< ref "resources" >}}) **MAY** be embedded, to provide additional context

     

       225
       +
       or data, behind a URI that can be subscribed to or fetched again by the client later:

     

       226
       +
       

     

       227
       +
       ```json

     

       228
       +
       {

     

       229
       +
         "type": "resource",

     

       230
       +
         "resource": {

     

       231
       +
           "uri": "resource://example",

     

       232
       +
           "mimeType": "text/plain",

     

       233
       +
           "text": "Resource content"

     

       234
       +
         }

     

       235
       +
       }

     

       236
       +
       ```

     

       237
       +
       

     

       238
       +
       ## Error Handling

     

       239
       +
       

     

       240
       +
       Tools use two error reporting mechanisms:

     

       241
       +
       

     

       242
       +
       1. **Protocol Errors**: Standard JSON-RPC errors for issues like:

     

       243
       +
       

     

       244
       +
          - Unknown tools

     

       245
       +
          - Invalid arguments

     

       246
       +
          - Server errors

     

       247
       +
       

     

       248
       +
       2. **Tool Execution Errors**: Reported in tool results with `isError: true`:

     

       249
       +
          - API failures

     

       250
       +
          - Invalid input data

     

       251
       +
          - Business logic errors

     

       252
       +
       

     

       253
       +
       Example protocol error:

     

       254
       +
       

     

       255
       +
       ```json

     

       256
       +
       {

     

       257
       +
         "jsonrpc": "2.0",

     

       258
       +
         "id": 3,

     

       259
       +
         "error": {

     

       260
       +
           "code": -32602,

     

       261
       +
           "message": "Unknown tool: invalid_tool_name"

     

       262
       +
         }

     

       263
       +
       }

     

       264
       +
       ```

     

       265
       +
       

     

       266
       +
       Example tool execution error:

     

       267
       +
       

     

       268
       +
       ```json

     

       269
       +
       {

     

       270
       +
         "jsonrpc": "2.0",

     

       271
       +
         "id": 4,

     

       272
       +
         "result": {

     

       273
       +
           "content": [

     

       274
       +
             {

     

       275
       +
               "type": "text",

     

       276
       +
               "text": "Failed to fetch weather data: API rate limit exceeded"

     

       277
       +
             }

     

       278
       +
           ],

     

       279
       +
           "isError": true

     

       280
       +
         }

     

       281
       +
       }

     

       282
       +
       ```

     

       283
       +
       

     

       284
       +
       ## Security Considerations

     

       285
       +
       

     

       286
       +
       1. Servers **MUST**:

     

       287
       +
       

     

       288
       +
          - Validate all tool inputs

     

       289
       +
          - Implement proper access controls

     

       290
       +
          - Rate limit tool invocations

     

       291
       +
          - Sanitize tool outputs

     

       292
       +
       

     

       293
       +
       2. Clients **SHOULD**:

     

       294
       +
          - Prompt for user confirmation on sensitive operations

     

       295
       +
          - Show tool inputs to the user before calling the server, to avoid malicious or

     

       296
       +
            accidental data exfiltration

     

       297
       +
          - Validate tool results before passing to LLM

     

       298
       +
          - Implement timeouts for tool calls

     

       299
       +
          - Log tool usage for audit purposes

+278

spec/transports.md

···

       1
       +
       ---

     

       2
       +
       title: Transports

     

       3
       +
       type: docs

     

       4
       +
       weight: 10

     

       5
       +
       ---

     

       6
       +
       

     

       7
       +
       {{< callout type="info" >}} **Protocol Revision**: 2025-03-26 {{< /callout >}}

     

       8
       +
       

     

       9
       +
       MCP uses JSON-RPC to encode messages. JSON-RPC messages **MUST** be UTF-8 encoded.

     

       10
       +
       

     

       11
       +
       The protocol currently defines two standard transport mechanisms for client-server

     

       12
       +
       communication:

     

       13
       +
       

     

       14
       +
       1. [stdio](#stdio), communication over standard in and standard out

     

       15
       +
       2. [Streamable HTTP](#streamable-http)

     

       16
       +
       

     

       17
       +
       Clients **SHOULD** support stdio whenever possible.

     

       18
       +
       

     

       19
       +
       It is also possible for clients and servers to implement

     

       20
       +
       [custom transports](#custom-transports) in a pluggable fashion.

     

       21
       +
       

     

       22
       +
       ## stdio

     

       23
       +
       

     

       24
       +
       In the **stdio** transport:

     

       25
       +
       

     

       26
       +
       - The client launches the MCP server as a subprocess.

     

       27
       +
       - The server reads JSON-RPC messages from its standard input (`stdin`) and sends messages

     

       28
       +
         to its standard output (`stdout`).

     

       29
       +
       - Messages may be JSON-RPC requests, notifications, responses—or a JSON-RPC

     

       30
       +
         [batch](https://www.jsonrpc.org/specification#batch) containing one or more requests

     

       31
       +
         and/or notifications.

     

       32
       +
       - Messages are delimited by newlines, and **MUST NOT** contain embedded newlines.

     

       33
       +
       - The server **MAY** write UTF-8 strings to its standard error (`stderr`) for logging

     

       34
       +
         purposes. Clients **MAY** capture, forward, or ignore this logging.

     

       35
       +
       - The server **MUST NOT** write anything to its `stdout` that is not a valid MCP message.

     

       36
       +
       - The client **MUST NOT** write anything to the server's `stdin` that is not a valid MCP

     

       37
       +
         message.

     

       38
       +
       

     

       39
       +
       ```mermaid

     

       40
       +
       sequenceDiagram

     

       41
       +
           participant Client

     

       42
       +
           participant Server Process

     

       43
       +
       

     

       44
       +
           Client->>+Server Process: Launch subprocess

     

       45
       +
           loop Message Exchange

     

       46
       +
               Client->>Server Process: Write to stdin

     

       47
       +
               Server Process->>Client: Write to stdout

     

       48
       +
               Server Process--)Client: Optional logs on stderr

     

       49
       +
           end

     

       50
       +
           Client->>Server Process: Close stdin, terminate subprocess

     

       51
       +
           deactivate Server Process

     

       52
       +
       ```

     

       53
       +
       

     

       54
       +
       ## Streamable HTTP

     

       55
       +
       

     

       56
       +
       {{< callout type="info" >}} This replaces the [HTTP+SSE

     

       57
       +
       transport]({{< ref "/specification/2024-11-05/basic/transports#http-with-sse" >}}) from

     

       58
       +
       protocol version 2024-11-05. See the [backwards compatibility](#backwards-compatibility)

     

       59
       +
       guide below. {{< /callout >}}

     

       60
       +
       

     

       61
       +
       In the **Streamable HTTP** transport, the server operates as an independent process that

     

       62
       +
       can handle multiple client connections. This transport uses HTTP POST and GET requests.

     

       63
       +
       Server can optionally make use of

     

       64
       +
       [Server-Sent Events](https://en.wikipedia.org/wiki/Server-sent_events) (SSE) to stream

     

       65
       +
       multiple server messages. This permits basic MCP servers, as well as more feature-rich

     

       66
       +
       servers supporting streaming and server-to-client notifications and requests.

     

       67
       +
       

     

       68
       +
       The server **MUST** provide a single HTTP endpoint path (hereafter referred to as the

     

       69
       +
       **MCP endpoint**) that supports both POST and GET methods. For example, this could be a

     

       70
       +
       URL like `https://example.com/mcp`.

     

       71
       +
       

     

       72
       +
       ### Sending Messages to the Server

     

       73
       +
       

     

       74
       +
       Every JSON-RPC message sent from the client **MUST** be a new HTTP POST request to the

     

       75
       +
       MCP endpoint.

     

       76
       +
       

     

       77
       +
       1. The client **MUST** use HTTP POST to send JSON-RPC messages to the MCP endpoint.

     

       78
       +
       2. The client **MUST** include an `Accept` header, listing both `application/json` and

     

       79
       +
          `text/event-stream` as supported content types.

     

       80
       +
       3. The body of the POST request **MUST** be one of the following:

     

       81
       +
          - A single JSON-RPC _request_, _notification_, or _response_

     

       82
       +
          - An array [batching](https://www.jsonrpc.org/specification#batch) one or more

     

       83
       +
            _requests and/or notifications_

     

       84
       +
          - An array [batching](https://www.jsonrpc.org/specification#batch) one or more

     

       85
       +
            _responses_

     

       86
       +
       4. If the input consists solely of (any number of) JSON-RPC _responses_ or

     

       87
       +
          _notifications_:

     

       88
       +
          - If the server accepts the input, the server **MUST** return HTTP status code 202

     

       89
       +
            Accepted with no body.

     

       90
       +
          - If the server cannot accept the input, it **MUST** return an HTTP error status code

     

       91
       +
            (e.g., 400 Bad Request). The HTTP response body **MAY** comprise a JSON-RPC _error

     

       92
       +
            response_ that has no `id`.

     

       93
       +
       5. If the input contains any number of JSON-RPC _requests_, the server **MUST** either

     

       94
       +
          return `Content-Type: text/event-stream`, to initiate an SSE stream, or

     

       95
       +
          `Content-Type: application/json`, to return one JSON object. The client **MUST**

     

       96
       +
          support both these cases.

     

       97
       +
       6. If the server initiates an SSE stream:

     

       98
       +
          - The SSE stream **SHOULD** eventually include one JSON-RPC _response_ per each

     

       99
       +
            JSON-RPC _request_ sent in the POST body. These _responses_ **MAY** be

     

       100
       +
            [batched](https://www.jsonrpc.org/specification#batch).

     

       101
       +
          - The server **MAY** send JSON-RPC _requests_ and _notifications_ before sending a

     

       102
       +
            JSON-RPC _response_. These messages **SHOULD** relate to the originating client

     

       103
       +
            _request_. These _requests_ and _notifications_ **MAY** be

     

       104
       +
            [batched](https://www.jsonrpc.org/specification#batch).

     

       105
       +
          - The server **SHOULD NOT** close the SSE stream before sending a JSON-RPC _response_

     

       106
       +
            per each received JSON-RPC _request_, unless the [session](#session-management)

     

       107
       +
            expires.

     

       108
       +
          - After all JSON-RPC _responses_ have been sent, the server **SHOULD** close the SSE

     

       109
       +
            stream.

     

       110
       +
          - Disconnection **MAY** occur at any time (e.g., due to network conditions).

     

       111
       +
            Therefore:

     

       112
       +
            - Disconnection **SHOULD NOT** be interpreted as the client cancelling its request.

     

       113
       +
            - To cancel, the client **SHOULD** explicitly send an MCP `CancelledNotification`.

     

       114
       +
            - To avoid message loss due to disconnection, the server **MAY** make the stream

     

       115
       +
              [resumable](#resumability-and-redelivery).

     

       116
       +
       

     

       117
       +
       ### Listening for Messages from the Server

     

       118
       +
       

     

       119
       +
       1. The client **MAY** issue an HTTP GET to the MCP endpoint. This can be used to open an

     

       120
       +
          SSE stream, allowing the server to communicate to the client, without the client first

     

       121
       +
          sending data via HTTP POST.

     

       122
       +
       2. The client **MUST** include an `Accept` header, listing `text/event-stream` as a

     

       123
       +
          supported content type.

     

       124
       +
       3. The server **MUST** either return `Content-Type: text/event-stream` in response to

     

       125
       +
          this HTTP GET, or else return HTTP 405 Method Not Allowed, indicating that the server

     

       126
       +
          does not offer an SSE stream at this endpoint.

     

       127
       +
       4. If the server initiates an SSE stream:

     

       128
       +
          - The server **MAY** send JSON-RPC _requests_ and _notifications_ on the stream. These

     

       129
       +
            _requests_ and _notifications_ **MAY** be

     

       130
       +
            [batched](https://www.jsonrpc.org/specification#batch).

     

       131
       +
          - These messages **SHOULD** be unrelated to any concurrently-running JSON-RPC

     

       132
       +
            _request_ from the client.

     

       133
       +
          - The server **MUST NOT** send a JSON-RPC _response_ on the stream **unless**

     

       134
       +
            [resuming](#resumability-and-redelivery) a stream associated with a previous client

     

       135
       +
            request.

     

       136
       +
          - The server **MAY** close the SSE stream at any time.

     

       137
       +
          - The client **MAY** close the SSE stream at any time.

     

       138
       +
       

     

       139
       +
       ### Multiple Connections

     

       140
       +
       

     

       141
       +
       1. The client **MAY** remain connected to multiple SSE streams simultaneously.

     

       142
       +
       2. The server **MUST** send each of its JSON-RPC messages on only one of the connected

     

       143
       +
          streams; that is, it **MUST NOT** broadcast the same message across multiple streams.

     

       144
       +
          - The risk of message loss **MAY** be mitigated by making the stream

     

       145
       +
            [resumable](#resumability-and-redelivery).

     

       146
       +
       

     

       147
       +
       ### Resumability and Redelivery

     

       148
       +
       

     

       149
       +
       To support resuming broken connections, and redelivering messages that might otherwise be

     

       150
       +
       lost:

     

       151
       +
       

     

       152
       +
       1. Servers **MAY** attach an `id` field to their SSE events, as described in the

     

       153
       +
          [SSE standard](https://html.spec.whatwg.org/multipage/server-sent-events.html#event-stream-interpretation).

     

       154
       +
          - If present, the ID **MUST** be globally unique across all streams within that

     

       155
       +
            [session](#session-management)—or all streams with that specific client, if session

     

       156
       +
            management is not in use.

     

       157
       +
       2. If the client wishes to resume after a broken connection, it **SHOULD** issue an HTTP

     

       158
       +
          GET to the MCP endpoint, and include the

     

       159
       +
          [`Last-Event-ID`](https://html.spec.whatwg.org/multipage/server-sent-events.html#the-last-event-id-header)

     

       160
       +
          header to indicate the last event ID it received.

     

       161
       +
          - The server **MAY** use this header to replay messages that would have been sent

     

       162
       +
            after the last event ID, _on the stream that was disconnected_, and to resume the

     

       163
       +
            stream from that point.

     

       164
       +
          - The server **MUST NOT** replay messages that would have been delivered on a

     

       165
       +
            different stream.

     

       166
       +
       

     

       167
       +
       In other words, these event IDs should be assigned by servers on a _per-stream_ basis, to

     

       168
       +
       act as a cursor within that particular stream.

     

       169
       +
       

     

       170
       +
       ### Session Management

     

       171
       +
       

     

       172
       +
       An MCP "session" consists of logically related interactions between a client and a

     

       173
       +
       server, beginning with the [initialization phase]({{< ref "lifecycle" >}}). To support

     

       174
       +
       servers which want to establish stateful sessions:

     

       175
       +
       

     

       176
       +
       1. A server using the Streamable HTTP transport **MAY** assign a session ID at

     

       177
       +
          initialization time, by including it in an `Mcp-Session-Id` header on the HTTP

     

       178
       +
          response containing the `InitializeResult`.

     

       179
       +
          - The session ID **SHOULD** be globally unique and cryptographically secure (e.g., a

     

       180
       +
            securely generated UUID, a JWT, or a cryptographic hash).

     

       181
       +
          - The session ID **MUST** only contain visible ASCII characters (ranging from 0x21 to

     

       182
       +
            0x7E).

     

       183
       +
       2. If an `Mcp-Session-Id` is returned by the server during initialization, clients using

     

       184
       +
          the Streamable HTTP transport **MUST** include it in the `Mcp-Session-Id` header on

     

       185
       +
          all of their subsequent HTTP requests.

     

       186
       +
          - Servers that require a session ID **SHOULD** respond to requests without an

     

       187
       +
            `Mcp-Session-Id` header (other than initialization) with HTTP 400 Bad Request.

     

       188
       +
       3. The server **MAY** terminate the session at any time, after which it **MUST** respond

     

       189
       +
          to requests containing that session ID with HTTP 404 Not Found.

     

       190
       +
       4. When a client receives HTTP 404 in response to a request containing an

     

       191
       +
          `Mcp-Session-Id`, it **MUST** start a new session by sending a new `InitializeRequest`

     

       192
       +
          without a session ID attached.

     

       193
       +
       5. Clients that no longer need a particular session (e.g., because the user is leaving

     

       194
       +
          the client application) **SHOULD** send an HTTP DELETE to the MCP endpoint with the

     

       195
       +
          `Mcp-Session-Id` header, to explicitly terminate the session.

     

       196
       +
          - The server **MAY** respond to this request with HTTP 405 Method Not Allowed,

     

       197
       +
            indicating that the server does not allow clients to terminate sessions.

     

       198
       +
       

     

       199
       +
       ### Sequence Diagram

     

       200
       +
       

     

       201
       +
       ```mermaid

     

       202
       +
       sequenceDiagram

     

       203
       +
           participant Client

     

       204
       +
           participant Server

     

       205
       +
       

     

       206
       +
           note over Client, Server: initialization

     

       207
       +
       

     

       208
       +
           Client->>+Server: POST InitializeRequest

     

       209
       +
           Server->>-Client: InitializeResponse<br>Mcp-Session-Id: 1868a90c...

     

       210
       +
       

     

       211
       +
           Client->>+Server: POST InitializedNotification<br>Mcp-Session-Id: 1868a90c...

     

       212
       +
           Server->>-Client: 202 Accepted

     

       213
       +
       

     

       214
       +
           note over Client, Server: client requests

     

       215
       +
           Client->>+Server: POST ... request ...<br>Mcp-Session-Id: 1868a90c...

     

       216
       +
       

     

       217
       +
           alt single HTTP response

     

       218
       +
             Server->>Client: ... response ...

     

       219
       +
           else server opens SSE stream

     

       220
       +
             loop while connection remains open

     

       221
       +
                 Server-)Client: ... SSE messages from server ...

     

       222
       +
             end

     

       223
       +
             Server-)Client: SSE event: ... response ...

     

       224
       +
           end

     

       225
       +
           deactivate Server

     

       226
       +
       

     

       227
       +
           note over Client, Server: client notifications/responses

     

       228
       +
           Client->>+Server: POST ... notification/response ...<br>Mcp-Session-Id: 1868a90c...

     

       229
       +
           Server->>-Client: 202 Accepted

     

       230
       +
       

     

       231
       +
           note over Client, Server: server requests

     

       232
       +
           Client->>+Server: GET<br>Mcp-Session-Id: 1868a90c...

     

       233
       +
           loop while connection remains open

     

       234
       +
               Server-)Client: ... SSE messages from server ...

     

       235
       +
           end

     

       236
       +
           deactivate Server

     

       237
       +
       

     

       238
       +
       ```

     

       239
       +
       

     

       240
       +
       ### Backwards Compatibility

     

       241
       +
       

     

       242
       +
       Clients and servers can maintain backwards compatibility with the deprecated [HTTP+SSE

     

       243
       +
       transport]({{< ref "/specification/2024-11-05/basic/transports#http-with-sse" >}}) (from

     

       244
       +
       protocol version 2024-11-05) as follows:

     

       245
       +
       

     

       246
       +
       **Servers** wanting to support older clients should:

     

       247
       +
       

     

       248
       +
       - Continue to host both the SSE and POST endpoints of the old transport, alongside the

     

       249
       +
         new "MCP endpoint" defined for the Streamable HTTP transport.

     

       250
       +
         - It is also possible to combine the old POST endpoint and the new MCP endpoint, but

     

       251
       +
           this may introduce unneeded complexity.

     

       252
       +
       

     

       253
       +
       **Clients** wanting to support older servers should:

     

       254
       +
       

     

       255
       +
       1. Accept an MCP server URL from the user, which may point to either a server using the

     

       256
       +
          old transport or the new transport.

     

       257
       +
       2. Attempt to POST an `InitializeRequest` to the server URL, with an `Accept` header as

     

       258
       +
          defined above:

     

       259
       +
          - If it succeeds, the client can assume this is a server supporting the new Streamable

     

       260
       +
            HTTP transport.

     

       261
       +
          - If it fails with an HTTP 4xx status code (e.g., 405 Method Not Allowed or 404 Not

     

       262
       +
            Found):

     

       263
       +
            - Issue a GET request to the server URL, expecting that this will open an SSE stream

     

       264
       +
              and return an `endpoint` event as the first event.

     

       265
       +
            - When the `endpoint` event arrives, the client can assume this is a server running

     

       266
       +
              the old HTTP+SSE transport, and should use that transport for all subsequent

     

       267
       +
              communication.

     

       268
       +
       

     

       269
       +
       ## Custom Transports

     

       270
       +
       

     

       271
       +
       Clients and servers **MAY** implement additional custom transport mechanisms to suit

     

       272
       +
       their specific needs. The protocol is transport-agnostic and can be implemented over any

     

       273
       +
       communication channel that supports bidirectional message exchange.

     

       274
       +
       

     

       275
       +
       Implementers who choose to support custom transports **MUST** ensure they preserve the

     

       276
       +
       JSON-RPC message format and lifecycle requirements defined by MCP. Custom transports

     

       277
       +
       **SHOULD** document their specific connection establishment and message exchange patterns

     

       278
       +
       to aid interoperability.

Compare changes