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

-1

.gitignore

···

       1
        
       jsonrpc.mli

     

       2
        
       _build

     

       3
        
       CLAUDE.md

     

       4
       -
       *.install

···

       1
        
       jsonrpc.mli

     

       2
        
       _build

     

       3
        
       CLAUDE.md

     

       0

.ocamlformat

This is a binary file and will not be displayed.

+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

+113 -68

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 =

     

       6
        
         match json with

     

       7
       -
         | `Assoc fields -> (

     

       8
       -
             match List.assoc_opt name fields with

     

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

     

       10
       -
             | _ ->

     

       11
       -
                 raise

     

       12
       -
                   (Failure (Printf.sprintf "Missing or invalid parameter: %s" name)))

     

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

     

       14
        
       

     

       15
        
       (* Create a server *)

     

       16
       -
       let server =

     

       17
       -
         create_server ~name:"OCaml MCP Capitalizer" ~version:"0.1.0"

     

       18
       -
           ~protocol_version:"2024-11-05" ()

     

       19
       -
         |> fun server ->

     

       20
       -
         (* Set default capabilities *)

     

       21
       -
         configure_server server ~with_tools:true ~with_resources:true

     

       22
       -
           ~with_prompts:true ()

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       23
        
       

     

       24
        
       (* Define and register a capitalize tool *)

     

       25
       -
       let _ =

     

       26
       -
         add_tool server ~name:"capitalize"

     

       27
       -
           ~description:"Capitalizes the provided text"

     

       28
       -
           ~schema_properties:[ ("text", "string", "The text to capitalize") ]

     

       29
       -
           ~schema_required:[ "text" ]

     

       30
       -
           (fun args ->

     

       31
       -
             try

     

       32
       -
               let text = get_string_param args "text" in

     

       33
       -
               let capitalized_text = String.uppercase_ascii text in

     

       34
       -
               TextContent.yojson_of_t

     

       35
       -
                 TextContent.{ text = capitalized_text; annotations = None }

     

       36
       -
             with Failure msg ->

     

       37
       -
               Logs.err (fun m -> m "Error in capitalize tool: %s" msg);

     

       38
       -
               TextContent.yojson_of_t

     

       39
       -
                 TextContent.

     

       40
       -
                   { text = Printf.sprintf "Error: %s" msg; annotations = None })

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       41
        
       

     

       42
       -
       (* Define and register a resource template example *)

     

       43
       -
       let _ =

     

       44
       -
         add_resource_template server ~uri_template:"greeting://{name}"

     

       45
       -
           ~name:"Greeting" ~description:"Get a greeting for a name"

     

       46
       -
           ~mime_type:"text/plain" (fun params ->

     

       47
       -
             match params with

     

       48
       -
             | [ name ] ->

     

       49
       -
                 Printf.sprintf "Hello, %s! Welcome to the OCaml MCP server." name

     

       50
       -
             | _ -> "Hello, world! Welcome to the OCaml MCP server.")

     

       0
        
       
     

       51
        
       

     

       52
        
       (* Define and register a prompt example *)

     

       53
       -
       let _ =

     

       54
       -
         add_prompt server ~name:"capitalize-prompt"

     

       55
       -
           ~description:"A prompt to help with text capitalization"

     

       56
       -
           ~arguments:[ ("text", Some "The text to be capitalized", true) ]

     

       57
       -
           (fun args ->

     

       58
       -
             let text =

     

       59
       -
               try List.assoc "text" args with Not_found -> "No text provided"

     

       60
       -
             in

     

       61
       -
             [

     

       62
       -
               Prompt.

     

       63
       -
                 {

     

       64
       -
                   role = `User;

     

       65
       -
                   content =

     

       66
       -
                     Mcp.make_text_content

     

       67
       -
                       "Please help me capitalize the following text:";

     

       68
       -
                 };

     

       69
       -
               Prompt.{ role = `User; content = Mcp.make_text_content text };

     

       70
       -
               Prompt.

     

       71
       -
                 {

     

       72
       -
                   role = `Assistant;

     

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

     

       74
       -
                 };

     

       75
       -
               Prompt.

     

       76
       -
                 {

     

       77
       -
                   role = `Assistant;

     

       78
       -
                   content = Mcp.make_text_content (String.uppercase_ascii text);

     

       79
       -
                 };

     

       80
       -
             ])

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       81
        
       

     

       0
        
       
     

       82
        
       let () =

     

       83
       -
         Logs.set_reporter (Logs.format_reporter ());

     

       84
       -
         Eio_main.run @@ fun env -> Mcp_server.run_stdio_server env server

     

       0
        
       
     

       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 =

     

       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)))

     

       0
        
       
     

       0
        
       
     

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

     

       13
        
       

     

       14
        
       (* Create a server *)

     

       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

     

       40
       +
         ~name:"capitalize"

     

       41
       +
         ~description:"Capitalizes the provided text"

     

       42
       +
         ~schema_properties:[

     

       43
       +
           ("text", "string", "The text to capitalize")

     

       44
       +
         ]

     

       45
       +
         ~schema_required:["text"]

     

       46
       +
         (fun args ->

     

       47
       +
           try

     

       48
       +
             let text = get_string_param args "text" in

     

       49
       +
             let capitalized_text = String.uppercase_ascii text in

     

       50
       +
             TextContent.yojson_of_t TextContent.{

     

       51
       +
               text = capitalized_text;

     

       52
       +
               annotations = None

     

       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

     

       60
       +
             }

     

       61
       +
         )

     

       62
        
       

     

       63
       +
       (* Define and register a resource example *)

     

       64
       +
       let _ = add_resource server

     

       65
       +
         ~uri_template:"greeting://{name}"

     

       66
       +
         ~description:"Get a greeting for a name"

     

       67
       +
         ~mime_type:"text/plain"

     

       68
       +
         (fun params ->

     

       69
       +
           match params with

     

       70
       +
           | [name] -> Printf.sprintf "Hello, %s! Welcome to the OCaml MCP server." name

     

       71
       +
           | _ -> "Hello, world! Welcome to the OCaml MCP server."

     

       72
       +
         )

     

       73
        
       

     

       74
        
       (* Define and register a prompt example *)

     

       75
       +
       let _ = add_prompt server

     

       76
       +
         ~name:"capitalize-prompt"

     

       77
       +
         ~description:"A prompt to help with text capitalization"

     

       78
       +
         ~arguments:[

     

       79
       +
           ("text", Some "The text to be capitalized", true)

     

       80
       +
         ]

     

       81
       +
         (fun args ->

     

       82
       +
           let text = 

     

       83
       +
             try

     

       84
       +
               List.assoc "text" args

     

       85
       +
             with

     

       86
       +
             | Not_found -> "No text provided"

     

       87
       +
           in

     

       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

+33 -21

bin/dune

···

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       1
        
       (executable

     

       2
        
        (name capitalize_sdk)

     

       3
        
        (modules capitalize_sdk)

     

       4
       -
        (libraries logs mcp mcp_server yojson eio_main eio))

     

       0
        
       
     

       5
        
       

     

       6
        
       (executable

     

       7
       -
        (name multimodal_sdk)

     

       8
       -
        (modules multimodal_sdk)

     

       9
       -
        (libraries logs 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

     

       16
       -
         (:standard -w -32 -w -33))

     

       17
       -
        (libraries

     

       18
       -
         logs

     

       19
       -
         mcp

     

       20
       -
         mcp_sdk

     

       21
       -
         mcp_server

     

       22
       -
         yojson

     

       23
       -
         eio_main

     

       24
       -
         eio

     

       25
       -
         compiler-libs.toplevel))

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       26
        
       

     

       27
        
       (executable

     

       28
       -
        (name markdown_book_sdk)

     

       29
       -
        (modules markdown_book_sdk)

     

       30
       -
        (libraries logs mcp mcp_sdk mcp_server yojson eio_main eio))

     

       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

-721

bin/markdown_book_sdk.ml

···

       1
       -
       open Mcp_sdk

     

       2
       -
       

     

       3
       -
       (* Helper module for working with markdown book chapters *)

     

       4
       -
       module BookChapter = struct

     

       5
       -
         type t = { id : string; title : string; contents : string }

     

       6
       -
       

     

       7
       -
         (* Book chapters as a series of markdown files *)

     

       8
       -
         let chapters =

     

       9
       -
           [

     

       10
       -
             {

     

       11
       -
               id = "chapter1";

     

       12
       -
               title = "# Introduction to OCaml";

     

       13
       -
               contents =

     

       14
       -
                 {|

     

       15
       -
       # Introduction to OCaml

     

       16
       -
       

     

       17
       -
       OCaml is a general-purpose, multi-paradigm programming language which extends the Caml dialect of ML with object-oriented features.

     

       18
       -
       

     

       19
       -
       ## Key Features

     

       20
       -
       

     

       21
       -
       - **Strong Static Typing**: Catch errors at compile time rather than runtime

     

       22
       -
       - **Type Inference**: No need to annotate every variable with a type

     

       23
       -
       - **Pattern Matching**: Express complex control flow in a clear and concise way

     

       24
       -
       - **Functional Programming**: First-class functions and immutability

     

       25
       -
       - **Module System**: Powerful abstraction capabilities with modules and functors

     

       26
       -
       - **Performance**: Native code compilation with excellent performance characteristics

     

       27
       -
       

     

       28
       -
       ## History

     

       29
       -
       

     

       30
       -
       OCaml was created in 1996 by Xavier Leroy, Jérôme Vouillon, Damien Doligez, and Didier Rémy at INRIA in France. It evolved from the Caml language, which itself was an implementation of ML.

     

       31
       -
       

     

       32
       -
       ## Why OCaml?

     

       33
       -
       

     

       34
       -
       OCaml offers a unique combination of features that make it particularly well-suited for certain domains:

     

       35
       -
       

     

       36
       -
       - **Program Correctness**: The strong type system catches many errors at compile time

     

       37
       -
       - **Symbolic Computing**: Excellent for manipulating complex data structures and symbolic expressions

     

       38
       -
       - **Systems Programming**: Can be used for low-level systems programming with high safety guarantees

     

       39
       -
       - **Web Development**: Modern frameworks like Dream make web development straightforward

     

       40
       -
       

     

       41
       -
       In the following chapters, we'll explore the language features in depth and learn how to leverage OCaml's strengths for building robust, maintainable software.

     

       42
       -
       |};

     

       43
       -
             };

     

       44
       -
             {

     

       45
       -
               id = "chapter2";

     

       46
       -
               title = "# Basic Syntax and Types";

     

       47
       -
               contents =

     

       48
       -
                 {|

     

       49
       -
       # Basic Syntax and Types

     

       50
       -
       

     

       51
       -
       OCaml has a clean, consistent syntax that emphasizes readability and minimizes boilerplate.

     

       52
       -
       

     

       53
       -
       ## Variables and Basic Types

     

       54
       -
       

     

       55
       -
       In OCaml, variables are immutable by default. Once a value is bound to a name, that binding cannot change.

     

       56
       -
       

     

       57
       -
       ```ocaml

     

       58
       -
       (* Binding a value to a name *)

     

       59
       -
       let x = 42

     

       60
       -
       let greeting = "Hello, World!"

     

       61
       -
       

     

       62
       -
       (* OCaml has type inference *)

     

       63
       -
       (* These are equivalent: *)

     

       64
       -
       let x = 42

     

       65
       -
       let x : int = 42

     

       66
       -
       ```

     

       67
       -
       

     

       68
       -
       ## Basic Types

     

       69
       -
       

     

       70
       -
       - `int`: Integer numbers

     

       71
       -
       - `float`: Floating-point numbers

     

       72
       -
       - `bool`: Boolean values (`true` or `false`)

     

       73
       -
       - `char`: Single characters

     

       74
       -
       - `string`: Text strings

     

       75
       -
       - `unit`: The empty tuple, written `()`

     

       76
       -
       

     

       77
       -
       ## Functions

     

       78
       -
       

     

       79
       -
       Functions in OCaml are first-class values:

     

       80
       -
       

     

       81
       -
       ```ocaml

     

       82
       -
       (* A simple function *)

     

       83
       -
       let add x y = x + y

     

       84
       -
       

     

       85
       -
       (* With type annotations *)

     

       86
       -
       let add (x : int) (y : int) : int = x + y

     

       87
       -
       

     

       88
       -
       (* Anonymous (lambda) function *)

     

       89
       -
       let increment = fun x -> x + 1

     

       90
       -
       

     

       91
       -
       (* Partial application *)

     

       92
       -
       let add5 = add 5

     

       93
       -
       let fifteen = add5 10  (* equals 15 *)

     

       94
       -
       ```

     

       95
       -
       

     

       96
       -
       ## Control Flow

     

       97
       -
       

     

       98
       -
       OCaml uses expressions rather than statements for control flow:

     

       99
       -
       

     

       100
       -
       ```ocaml

     

       101
       -
       (* If expression *)

     

       102
       -
       let abs x =

     

       103
       -
         if x < 0 then -x else x

     

       104
       -
       

     

       105
       -
       (* Match expression (pattern matching) *)

     

       106
       -
       let describe_sign x =

     

       107
       -
         match x with

     

       108
       -
         | x when x < 0 -> "negative"

     

       109
       -
         | 0 -> "zero"

     

       110
       -
         | _ -> "positive"

     

       111
       -
       ```

     

       112
       -
       

     

       113
       -
       ## Recursion

     

       114
       -
       

     

       115
       -
       Functions need the `rec` keyword to be recursive:

     

       116
       -
       

     

       117
       -
       ```ocaml

     

       118
       -
       (* Recursive function *)

     

       119
       -
       let rec factorial n =

     

       120
       -
         if n <= 1 then 1 else n * factorial (n - 1)

     

       121
       -
       

     

       122
       -
       (* Mutually recursive functions *)

     

       123
       -
       let rec is_even n =

     

       124
       -
         if n = 0 then true else is_odd (n - 1)

     

       125
       -
       and is_odd n =

     

       126
       -
         if n = 0 then false else is_even (n - 1)

     

       127
       -
       ```

     

       128
       -
       

     

       129
       -
       This introduction to basic syntax sets the foundation for understanding OCaml's more advanced features, which we'll explore in the next chapters.

     

       130
       -
       |};

     

       131
       -
             };

     

       132
       -
             {

     

       133
       -
               id = "chapter3";

     

       134
       -
               title = "# Data Structures";

     

       135
       -
               contents =

     

       136
       -
                 {|

     

       137
       -
       # Data Structures

     

       138
       -
       

     

       139
       -
       OCaml provides several built-in data structures and makes it easy to define custom ones.

     

       140
       -
       

     

       141
       -
       ## Tuples

     

       142
       -
       

     

       143
       -
       Tuples are fixed-length collections of values that can have different types:

     

       144
       -
       

     

       145
       -
       ```ocaml

     

       146
       -
       (* A pair of an int and a string *)

     

       147
       -
       let person = (42, "Alice")

     

       148
       -
       

     

       149
       -
       (* Extracting values with pattern matching *)

     

       150
       -
       let (age, name) = person

     

       151
       -
       

     

       152
       -
       (* Accessing elements *)

     

       153
       -
       let age = fst person  (* For pairs only *)

     

       154
       -
       let name = snd person  (* For pairs only *)

     

       155
       -
       ```

     

       156
       -
       

     

       157
       -
       ## Records

     

       158
       -
       

     

       159
       -
       Records are named collections of values:

     

       160
       -
       

     

       161
       -
       ```ocaml

     

       162
       -
       (* Defining a record type *)

     

       163
       -
       type person = {

     

       164
       -
         name: string;

     

       165
       -
         age: int;

     

       166
       -
         email: string option;

     

       167
       -
       }

     

       168
       -
       

     

       169
       -
       (* Creating a record *)

     

       170
       -
       let alice = {

     

       171
       -
         name = "Alice";

     

       172
       -
         age = 42;

     

       173
       -
         email = Some "alice@example.com";

     

       174
       -
       }

     

       175
       -
       

     

       176
       -
       (* Accessing fields *)

     

       177
       -
       let alices_name = alice.name

     

       178
       -
       

     

       179
       -
       (* Functional update (creates a new record) *)

     

       180
       -
       let alice_birthday = { alice with age = alice.age + 1 }

     

       181
       -
       ```

     

       182
       -
       

     

       183
       -
       ## Variants

     

       184
       -
       

     

       185
       -
       Variants (also called algebraic data types) represent values that can be one of several cases:

     

       186
       -
       

     

       187
       -
       ```ocaml

     

       188
       -
       (* Defining a variant type *)

     

       189
       -
       type shape =

     

       190
       -
         | Circle of float  (* radius *)

     

       191
       -
         | Rectangle of float * float  (* width, height *)

     

       192
       -
         | Triangle of float * float * float  (* sides *)

     

       193
       -
       

     

       194
       -
       (* Creating variants *)

     

       195
       -
       let my_circle = Circle 2.5

     

       196
       -
       let my_rectangle = Rectangle (4.0, 6.0)

     

       197
       -
       

     

       198
       -
       (* Pattern matching with variants *)

     

       199
       -
       let area shape =

     

       200
       -
         match shape with

     

       201
       -
         | Circle r -> Float.pi *. r *. r

     

       202
       -
         | Rectangle (w, h) -> w *. h

     

       203
       -
         | Triangle (a, b, c) ->

     

       204
       -
             let s = (a +. b +. c) /. 2.0 in

     

       205
       -
             sqrt (s *. (s -. a) *. (s -. b) *. (s -. c))

     

       206
       -
       ```

     

       207
       -
       

     

       208
       -
       ## Lists

     

       209
       -
       

     

       210
       -
       Lists are immutable linked lists of elements of the same type:

     

       211
       -
       

     

       212
       -
       ```ocaml

     

       213
       -
       (* Creating lists *)

     

       214
       -
       let empty = []

     

       215
       -
       let numbers = [1; 2; 3; 4; 5]

     

       216
       -
       let constructed = 1 :: 2 :: 3 :: []

     

       217
       -
       

     

       218
       -
       (* Pattern matching with lists *)

     

       219
       -
       let rec sum_list lst =

     

       220
       -
         match lst with

     

       221
       -
         | [] -> 0

     

       222
       -
         | head :: tail -> head + sum_list tail

     

       223
       -
       

     

       224
       -
       (* Common list functions *)

     

       225
       -
       let doubled = List.map (fun x -> x * 2) numbers

     

       226
       -
       let evens = List.filter (fun x -> x mod 2 = 0) numbers

     

       227
       -
       let sum = List.fold_left (+) 0 numbers

     

       228
       -
       ```

     

       229
       -
       

     

       230
       -
       ## Arrays

     

       231
       -
       

     

       232
       -
       Arrays provide mutable, fixed-size collections with O(1) random access:

     

       233
       -
       

     

       234
       -
       ```ocaml

     

       235
       -
       (* Creating arrays *)

     

       236
       -
       let arr = [|1; 2; 3; 4; 5|]

     

       237
       -
       

     

       238
       -
       (* Accessing elements (0-indexed) *)

     

       239
       -
       let first = arr.(0)

     

       240
       -
       

     

       241
       -
       (* Modifying elements *)

     

       242
       -
       let () = arr.(0) <- 10

     

       243
       -
       

     

       244
       -
       (* Array functions *)

     

       245
       -
       let doubled = Array.map (fun x -> x * 2) arr

     

       246
       -
       ```

     

       247
       -
       

     

       248
       -
       ## Option Type

     

       249
       -
       

     

       250
       -
       The option type represents values that might be absent:

     

       251
       -
       

     

       252
       -
       ```ocaml

     

       253
       -
       (* Option type *)

     

       254
       -
       type 'a option = None | Some of 'a

     

       255
       -
       

     

       256
       -
       (* Using options *)

     

       257
       -
       let safe_divide x y =

     

       258
       -
         if y = 0 then None else Some (x / y)

     

       259
       -
       

     

       260
       -
       (* Working with options *)

     

       261
       -
       match safe_divide 10 2 with

     

       262
       -
       | None -> print_endline "Division by zero"

     

       263
       -
       | Some result -> Printf.printf "Result: %d\n" result

     

       264
       -
       ```

     

       265
       -
       

     

       266
       -
       These data structures form the backbone of OCaml programming and allow for expressing complex data relationships in a type-safe way.

     

       267
       -
       |};

     

       268
       -
             };

     

       269
       -
             {

     

       270
       -
               id = "chapter4";

     

       271
       -
               title = "# Modules and Functors";

     

       272
       -
               contents =

     

       273
       -
                 {|

     

       274
       -
       # Modules and Functors

     

       275
       -
       

     

       276
       -
       OCaml's module system is one of its most powerful features. It allows for organizing code into reusable components with clear interfaces.

     

       277
       -
       

     

       278
       -
       ## Basic Modules

     

       279
       -
       

     

       280
       -
       A module is a collection of related definitions (types, values, submodules, etc.):

     

       281
       -
       

     

       282
       -
       ```ocaml

     

       283
       -
       (* Defining a module *)

     

       284
       -
       module Math = struct

     

       285
       -
         let pi = 3.14159

     

       286
       -
         let square x = x *. x

     

       287
       -
         let cube x = x *. x *. x

     

       288
       -
       end

     

       289
       -
       

     

       290
       -
       (* Using a module *)

     

       291
       -
       let area_of_circle r = Math.pi *. Math.square r

     

       292
       -
       ```

     

       293
       -
       

     

       294
       -
       ## Module Signatures

     

       295
       -
       

     

       296
       -
       Module signatures define the interface of a module, hiding implementation details:

     

       297
       -
       

     

       298
       -
       ```ocaml

     

       299
       -
       (* Defining a signature *)

     

       300
       -
       module type MATH = sig

     

       301
       -
         val pi : float

     

       302
       -
         val square : float -> float

     

       303
       -
         val cube : float -> float

     

       304
       -
       end

     

       305
       -
       

     

       306
       -
       (* Implementing a signature *)

     

       307
       -
       module Math : MATH = struct

     

       308
       -
         let pi = 3.14159

     

       309
       -
         let square x = x *. x

     

       310
       -
         let cube x = x *. x *. x

     

       311
       -
       

     

       312
       -
         (* This is hidden because it's not in the signature *)

     

       313
       -
         let private_helper x = x +. 1.0

     

       314
       -
       end

     

       315
       -
       ```

     

       316
       -
       

     

       317
       -
       ## Functors

     

       318
       -
       

     

       319
       -
       Functors are functions from modules to modules, allowing for higher-order modularity:

     

       320
       -
       

     

       321
       -
       ```ocaml

     

       322
       -
       (* Module signature for collections *)

     

       323
       -
       module type COLLECTION = sig

     

       324
       -
         type 'a t

     

       325
       -
         val empty : 'a t

     

       326
       -
         val add : 'a -> 'a t -> 'a t

     

       327
       -
         val mem : 'a -> 'a t -> bool

     

       328
       -
       end

     

       329
       -
       

     

       330
       -
       (* Functor that creates a set implementation given an element type with comparison *)

     

       331
       -
       module MakeSet (Element : sig type t val compare : t -> t -> int end) : COLLECTION with type 'a t = Element.t list = struct

     

       332
       -
         type 'a t = Element.t list

     

       333
       -
       

     

       334
       -
         let empty = []

     

       335
       -
       

     

       336
       -
         let rec add x lst =

     

       337
       -
           match lst with

     

       338
       -
           | [] -> [x]

     

       339
       -
           | y :: ys ->

     

       340
       -
               let c = Element.compare x y in

     

       341
       -
               if c < 0 then x :: lst

     

       342
       -
               else if c = 0 then lst  (* Element already exists *)

     

       343
       -
               else y :: add x ys

     

       344
       -
       

     

       345
       -
         let rec mem x lst =

     

       346
       -
           match lst with

     

       347
       -
           | [] -> false

     

       348
       -
           | y :: ys ->

     

       349
       -
               let c = Element.compare x y in

     

       350
       -
               if c = 0 then true

     

       351
       -
               else if c < 0 then false

     

       352
       -
               else mem x ys

     

       353
       -
       end

     

       354
       -
       

     

       355
       -
       (* Creating an integer set *)

     

       356
       -
       module IntElement = struct

     

       357
       -
         type t = int

     

       358
       -
         let compare = Int.compare

     

       359
       -
       end

     

       360
       -
       

     

       361
       -
       module IntSet = MakeSet(IntElement)

     

       362
       -
       

     

       363
       -
       (* Using the set *)

     

       364
       -
       let my_set = IntSet.empty

     

       365
       -
                    |> IntSet.add 3

     

       366
       -
                    |> IntSet.add 1

     

       367
       -
                    |> IntSet.add 4

     

       368
       -
                    |> IntSet.add 1  (* Duplicate, not added *)

     

       369
       -
       

     

       370
       -
       let has_three = IntSet.mem 3 my_set  (* true *)

     

       371
       -
       let has_five = IntSet.mem 5 my_set   (* false *)

     

       372
       -
       ```

     

       373
       -
       

     

       374
       -
       ## First-Class Modules

     

       375
       -
       

     

       376
       -
       OCaml also supports first-class modules, allowing modules to be passed as values:

     

       377
       -
       

     

       378
       -
       ```ocaml

     

       379
       -
       (* Module type for number operations *)

     

       380
       -
       module type NUMBER = sig

     

       381
       -
         type t

     

       382
       -
         val zero : t

     

       383
       -
         val add : t -> t -> t

     

       384
       -
         val to_string : t -> string

     

       385
       -
       end

     

       386
       -
       

     

       387
       -
       (* Implementations for different number types *)

     

       388
       -
       module Int : NUMBER with type t = int = struct

     

       389
       -
         type t = int

     

       390
       -
         let zero = 0

     

       391
       -
         let add = (+)

     

       392
       -
         let to_string = string_of_int

     

       393
       -
       end

     

       394
       -
       

     

       395
       -
       module Float : NUMBER with type t = float = struct

     

       396
       -
         type t = float

     

       397
       -
         let zero = 0.0

     

       398
       -
         let add = (+.)

     

       399
       -
         let to_string = string_of_float

     

       400
       -
       end

     

       401
       -
       

     

       402
       -
       (* Function that works with any NUMBER module *)

     

       403
       -
       let sum_as_string (type a) (module N : NUMBER with type t = a) numbers =

     

       404
       -
         let sum = List.fold_left N.add N.zero numbers in

     

       405
       -
         N.to_string sum

     

       406
       -
       

     

       407
       -
       (* Using first-class modules *)

     

       408
       -
       let int_sum = sum_as_string (module Int) [1; 2; 3; 4]

     

       409
       -
       let float_sum = sum_as_string (module Float) [1.0; 2.5; 3.7]

     

       410
       -
       ```

     

       411
       -
       

     

       412
       -
       ## Open and Include

     

       413
       -
       

     

       414
       -
       OCaml provides ways to bring module contents into scope:

     

       415
       -
       

     

       416
       -
       ```ocaml

     

       417
       -
       (* Open brings module contents into scope temporarily *)

     

       418
       -
       let area =

     

       419
       -
         let open Math in

     

       420
       -
         pi *. square 2.0

     

       421
       -
       

     

       422
       -
       (* Local opening with the modern syntax *)

     

       423
       -
       let area = Math.(pi *. square 2.0)

     

       424
       -
       

     

       425
       -
       (* Include actually extends a module with another module's contents *)

     

       426
       -
       module ExtendedMath = struct

     

       427
       -
         include Math

     

       428
       -
         let tau = 2.0 *. pi

     

       429
       -
         let circumference r = tau *. r

     

       430
       -
       end

     

       431
       -
       ```

     

       432
       -
       

     

       433
       -
       The module system enables OCaml programmers to build highly modular, reusable code with clear boundaries between components.

     

       434
       -
       |};

     

       435
       -
             };

     

       436
       -
             {

     

       437
       -
               id = "chapter5";

     

       438
       -
               title = "# Advanced Features";

     

       439
       -
               contents =

     

       440
       -
                 {|

     

       441
       -
       # Advanced Features

     

       442
       -
       

     

       443
       -
       OCaml offers several advanced features that set it apart from other languages. This chapter explores some of the more powerful language constructs.

     

       444
       -
       

     

       445
       -
       ## Polymorphic Variants

     

       446
       -
       

     

       447
       -
       Unlike regular variants, polymorphic variants don't need to be predefined:

     

       448
       -
       

     

       449
       -
       ```ocaml

     

       450
       -
       (* Using polymorphic variants directly *)

     

       451
       -
       let weekend = `Saturday | `Sunday

     

       452
       -
       let is_weekend day =

     

       453
       -
         match day with

     

       454
       -
         | `Saturday | `Sunday -> true

     

       455
       -
         | `Monday .. `Friday -> false

     

       456
       -
       

     

       457
       -
       (* Can be used in mixed contexts *)

     

       458
       -
       let shape_area = function

     

       459
       -
         | `Circle r -> Float.pi *. r *. r

     

       460
       -
         | `Rectangle (w, h) -> w *. h

     

       461
       -
         | `Triangle (b, h) -> 0.5 *. b *. h

     

       462
       -
         | `Regular_polygon(n, s) when n >= 3 ->

     

       463
       -
             let apothem = s /. (2.0 *. tan (Float.pi /. float_of_int n)) in

     

       464
       -
             n *. s *. apothem /. 2.0

     

       465
       -
         | _ -> failwith "Invalid shape"

     

       466
       -
       ```

     

       467
       -
       

     

       468
       -
       ## Objects and Classes

     

       469
       -
       

     

       470
       -
       OCaml supports object-oriented programming:

     

       471
       -
       

     

       472
       -
       ```ocaml

     

       473
       -
       (* Simple class definition *)

     

       474
       -
       class point x_init y_init =

     

       475
       -
         object (self)

     

       476
       -
           val mutable x = x_init

     

       477
       -
           val mutable y = y_init

     

       478
       -
       

     

       479
       -
           method get_x = x

     

       480
       -
           method get_y = y

     

       481
       -
           method move dx dy = x <- x + dx; y <- y + dy

     

       482
       -
           method distance_from_origin =

     

       483
       -
             sqrt (float_of_int (x * x + y * y))

     

       484
       -
       

     

       485
       -
           (* Private method *)

     

       486
       -
           method private to_string =

     

       487
       -
             Printf.sprintf "(%d, %d)" x y

     

       488
       -
       

     

       489
       -
           (* Calling another method *)

     

       490
       -
           method print = print_endline self#to_string

     

       491
       -
         end

     

       492
       -
       

     

       493
       -
       (* Using a class *)

     

       494
       -
       let p = new point 3 4

     

       495
       -
       let () = p#move 2 1

     

       496
       -
       let d = p#distance_from_origin

     

       497
       -
       ```

     

       498
       -
       

     

       499
       -
       ## Generalized Algebraic Data Types (GADTs)

     

       500
       -
       

     

       501
       -
       GADTs provide more type control than regular variants:

     

       502
       -
       

     

       503
       -
       ```ocaml

     

       504
       -
       (* A GADT for type-safe expressions *)

     

       505
       -
       type _ expr =

     

       506
       -
         | Int : int -> int expr

     

       507
       -
         | Bool : bool -> bool expr

     

       508
       -
         | Add : int expr * int expr -> int expr

     

       509
       -
         | Eq : 'a expr * 'a expr -> bool expr

     

       510
       -
       

     

       511
       -
       (* Type-safe evaluation *)

     

       512
       -
       let rec eval : type a. a expr -> a = function

     

       513
       -
         | Int n -> n

     

       514
       -
         | Bool b -> b

     

       515
       -
         | Add (e1, e2) -> eval e1 + eval e2

     

       516
       -
         | Eq (e1, e2) -> eval e1 = eval e2

     

       517
       -
       

     

       518
       -
       (* These expressions are statically type-checked *)

     

       519
       -
       let e1 = Add (Int 1, Int 2)         (* OK: int expr *)

     

       520
       -
       let e2 = Eq (Int 1, Int 2)          (* OK: bool expr *)

     

       521
       -
       (* let e3 = Add (Int 1, Bool true)  (* Type error! *) *)

     

       522
       -
       (* let e4 = Eq (Int 1, Bool true)   (* Type error! *) *)

     

       523
       -
       ```

     

       524
       -
       

     

       525
       -
       ## Type Extensions

     

       526
       -
       

     

       527
       -
       OCaml allows extending existing types:

     

       528
       -
       

     

       529
       -
       ```ocaml

     

       530
       -
       (* Original type *)

     

       531
       -
       type shape = Circle of float | Rectangle of float * float

     

       532
       -
       

     

       533
       -
       (* Extending the type in another module *)

     

       534
       -
       type shape += Triangle of float * float * float

     

       535
       -
       

     

       536
       -
       (* Pattern matching must now handle unknown cases *)

     

       537
       -
       let area = function

     

       538
       -
         | Circle r -> Float.pi *. r *. r

     

       539
       -
         | Rectangle (w, h) -> w *. h

     

       540
       -
         | Triangle (a, b, c) ->

     

       541
       -
             let s = (a +. b +. c) /. 2.0 in

     

       542
       -
             sqrt (s *. (s -. a) *. (s -. b) *. (s -. c))

     

       543
       -
         | _ -> failwith "Unknown shape"

     

       544
       -
       ```

     

       545
       -
       

     

       546
       -
       ## Effects and Effect Handlers

     

       547
       -
       

     

       548
       -
       OCaml 5 introduced algebraic effects for managing control flow:

     

       549
       -
       

     

       550
       -
       ```ocaml

     

       551
       -
       (* Defining an effect *)

     

       552
       -
       type _ Effect.t += Ask : string -> string Effect.t

     

       553
       -
       

     

       554
       -
       (* Handler for the Ask effect *)

     

       555
       -
       let prompt_user () =

     

       556
       -
         Effect.Deep.try_with

     

       557
       -
           (fun () ->

     

       558
       -
               let name = Effect.perform (Ask "What is your name?") in

     

       559
       -
               Printf.printf "Hello, %s!\n" name)

     

       560
       -
           { Effect.Deep.effc = fun (type a) (effect : a Effect.t) ->

     

       561
       -
               match effect with

     

       562
       -
               | Ask prompt -> fun k ->

     

       563
       -
                   Printf.printf "%s " prompt;

     

       564
       -
                   let response = read_line () in

     

       565
       -
                   k response

     

       566
       -
               | _ -> None }

     

       567
       -
       ```

     

       568
       -
       

     

       569
       -
       ## Higher-Ranked Polymorphism

     

       570
       -
       

     

       571
       -
       Using the `Obj.magic` escape hatch (with caution):

     

       572
       -
       

     

       573
       -
       ```ocaml

     

       574
       -
       (* This would normally not be permitted due to rank-2 polymorphism *)

     

       575
       -
       let apply_to_all_types f =

     

       576
       -
         let magic_f : 'a -> string = Obj.magic f in

     

       577
       -
         [

     

       578
       -
           magic_f 42;

     

       579
       -
           magic_f "hello";

     

       580
       -
           magic_f 3.14;

     

       581
       -
           magic_f true;

     

       582
       -
         ]

     

       583
       -
       

     

       584
       -
       (* Usage - with great care! *)

     

       585
       -
       let result = apply_to_all_types (fun x -> Printf.sprintf "Value: %s" (Obj.magic x))

     

       586
       -
       ```

     

       587
       -
       

     

       588
       -
       ## Metaprogramming with PPX

     

       589
       -
       

     

       590
       -
       OCaml's PPX system enables powerful metaprogramming:

     

       591
       -
       

     

       592
       -
       ```ocaml

     

       593
       -
       (* With ppx_deriving *)

     

       594
       -
       type person = {

     

       595
       -
         name: string;

     

       596
       -
         age: int;

     

       597
       -
         email: string option;

     

       598
       -
       } [@@deriving show, eq, ord]

     

       599
       -
       

     

       600
       -
       (* With ppx_sexp_conv *)

     

       601
       -
       type config = {

     

       602
       -
         server: string;

     

       603
       -
         port: int;

     

       604
       -
         timeout: float;

     

       605
       -
       } [@@deriving sexp]

     

       606
       -
       

     

       607
       -
       (* With ppx_let for monadic operations *)

     

       608
       -
       let computation =

     

       609
       -
         [%m.let

     

       610
       -
           let* x = get_value_from_db "key1" in

     

       611
       -
           let* y = get_value_from_db "key2" in

     

       612
       -
           return (x + y)

     

       613
       -
         ]

     

       614
       -
       ```

     

       615
       -
       

     

       616
       -
       ## Modules for Advanced Typing

     

       617
       -
       

     

       618
       -
       Using modules to encode complex type relationships:

     

       619
       -
       

     

       620
       -
       ```ocaml

     

       621
       -
       (* Phantom types for added type safety *)

     

       622
       -
       module SafeString : sig

     

       623
       -
         type 'a t

     

       624
       -
       

     

       625
       -
         (* Constructors for different string types *)

     

       626
       -
         val of_raw : string -> [`Raw] t

     

       627
       -
         val sanitize : [`Raw] t -> [`Sanitized] t

     

       628
       -
         val validate : [`Sanitized] t -> [`Validated] t option

     

       629
       -
       

     

       630
       -
         (* Operations that require specific string types *)

     

       631
       -
         val to_html : [`Sanitized] t -> string

     

       632
       -
         val to_sql : [`Validated] t -> string

     

       633
       -
       

     

       634
       -
         (* Common operations for all string types *)

     

       635
       -
         val length : _ t -> int

     

       636
       -
         val concat : _ t -> _ t -> [`Raw] t

     

       637
       -
       end = struct

     

       638
       -
         type 'a t = string

     

       639
       -
       

     

       640
       -
         let of_raw s = s

     

       641
       -
         let sanitize s = String.map (function '<' | '>' -> '_' | c -> c) s

     

       642
       -
         let validate s = if String.length s > 0 then Some s else None

     

       643
       -
       

     

       644
       -
         let to_html s = s

     

       645
       -
         let to_sql s = "'" ^ String.map (function '\'' -> '\'' | c -> c) s ^ "'"

     

       646
       -
       

     

       647
       -
         let length = String.length

     

       648
       -
         let concat s1 s2 = s1 ^ s2

     

       649
       -
       end

     

       650
       -
       ```

     

       651
       -
       

     

       652
       -
       These advanced features make OCaml a uniquely powerful language for expressing complex programs with strong guarantees about correctness.

     

       653
       -
       |};

     

       654
       -
             };

     

       655
       -
           ]

     

       656
       -
       

     

       657
       -
         (* Get a chapter by ID *)

     

       658
       -
         let get_by_id id =

     

       659
       -
           try Some (List.find (fun c -> c.id = id) chapters) with Not_found -> None

     

       660
       -
       

     

       661
       -
         (* Get chapter titles *)

     

       662
       -
         let get_all_titles () = List.map (fun c -> (c.id, c.title)) chapters

     

       663
       -
       end

     

       664
       -
       

     

       665
       -
       (* Create a server *)

     

       666
       -
       let server =

     

       667
       -
         create_server ~name:"OCaml MCP Book Resource Example" ~version:"0.1.0" ()

     

       668
       -
         |> fun server ->

     

       669
       -
         (* Set default capabilities *)

     

       670
       -
         configure_server server ~with_tools:false ~with_resources:true

     

       671
       -
           ~with_resource_templates:true ~with_prompts:false ()

     

       672
       -
       

     

       673
       -
       (* Add a resource template to get book chapters *)

     

       674
       -
       let _ =

     

       675
       -
         add_resource_template server ~uri_template:"book/chapter/{id}"

     

       676
       -
           ~name:"Chapter Resource"

     

       677
       -
           ~description:"Get a specific chapter from the OCaml book by its ID"

     

       678
       -
           ~mime_type:"text/markdown" (fun params ->

     

       679
       -
             match params with

     

       680
       -
             | [ id ] -> (

     

       681
       -
                 match BookChapter.get_by_id id with

     

       682
       -
                 | Some chapter -> chapter.contents

     

       683
       -
                 | None ->

     

       684
       -
                     Printf.sprintf "# Error\n\nChapter with ID '%s' not found." id)

     

       685
       -
             | _ -> "# Error\n\nInvalid parameters. Expected chapter ID.")

     

       686
       -
       

     

       687
       -
       (* Add a regular resource to get table of contents (no variables) *)

     

       688
       -
       let _ =

     

       689
       -
         add_resource server ~uri:"book/toc" ~name:"Table of Contents"

     

       690
       -
           ~description:"Get the table of contents for the OCaml book"

     

       691
       -
           ~mime_type:"text/markdown" (fun _params ->

     

       692
       -
             let titles = BookChapter.get_all_titles () in

     

       693
       -
             let toc =

     

       694
       -
               "# OCaml Book - Table of Contents\n\n"

     

       695
       -
               ^ (List.mapi

     

       696
       -
                    (fun i (id, title) ->

     

       697
       -
                      Printf.sprintf "%d. [%s](book/chapter/%s)\n" (i + 1)

     

       698
       -
                        (String.sub title 2 (String.length title - 2))

     

       699
       -
                        (* Remove "# " prefix *)

     

       700
       -
                        id)

     

       701
       -
                    titles

     

       702
       -
                 |> String.concat "")

     

       703
       -
             in

     

       704
       -
             toc)

     

       705
       -
       

     

       706
       -
       (* Add a regular resource for a complete book (no variables) *)

     

       707
       -
       let _ =

     

       708
       -
         add_resource server ~uri:"book/complete" ~name:"Full contents"

     

       709
       -
           ~description:"Get the complete OCaml book as a single document"

     

       710
       -
           ~mime_type:"text/markdown" (fun _params ->

     

       711
       -
             let chapter_contents =

     

       712
       -
               List.map (fun c -> c.BookChapter.contents) BookChapter.chapters

     

       713
       -
             in

     

       714
       -
             let content =

     

       715
       -
               "# The OCaml Book\n\n*A comprehensive guide to OCaml programming*\n\n"

     

       716
       -
               ^ String.concat "\n\n---\n\n" chapter_contents

     

       717
       -
             in

     

       718
       -
             content)

     

       719
       -
       

     

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

     

       721
       -
       let () = Eio_main.run @@ fun env -> Mcp_server.run_stdio_server env 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;

-433

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
       -
             | _ ->

     

       10
       -
                 raise

     

       11
       -
                   (Failure (Printf.sprintf "Missing or invalid parameter: %s" name)))

     

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

     

       13
       -
       

     

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

     

       15
       -
       let get_int_param json name =

     

       16
       -
         match json with

     

       17
       -
         | `Assoc fields -> (

     

       18
       -
             match List.assoc_opt name fields with

     

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

     

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

     

       21
       -
             | _ ->

     

       22
       -
                 raise

     

       23
       -
                   (Failure (Printf.sprintf "Missing or invalid parameter: %s" name)))

     

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

     

       25
       -
       

     

       26
       -
       (* Base64 encoding - simplified version *)

     

       27
       -
       module Base64 = struct

     

       28
       -
         let encode_char idx =

     

       29
       -
           "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/".[idx]

     

       30
       -
       

     

       31
       -
         let encode s =

     

       32
       -
           let len = String.length s in

     

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

     

       34
       -
       

     

       35
       -
           let rec loop i j =

     

       36
       -
             if i >= len then j

     

       37
       -
             else

     

       38
       -
               let n =

     

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

     

       40
       -
                 let n =

     

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

     

       42
       -
                 in

     

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

     

       44
       -
               in

     

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

     

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

     

       47
       -
               Bytes.set result (j + 2)

     

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

     

       49
       -
               Bytes.set result (j + 3)

     

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

     

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

     

       52
       -
           in

     

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

     

       54
       -
       end

     

       55
       -
       

     

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

     

       57
       -
       let generate_random_image width height =

     

       58
       -
         (* Ensure dimensions are reasonable *)

     

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

     

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

     

       61
       -
       

     

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

     

       63
       -
         let buf = Buffer.create 1024 in

     

       64
       -
       

     

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

     

       66
       -
         Buffer.add_string buf "GIF89a";

     

       67
       -
       

     

       68
       -
         (* Logical Screen Descriptor *)

     

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

     

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

     

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

     

       72
       -
       

     

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

     

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

     

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

     

       76
       -
       

     

       77
       -
         (* Packed fields - 1 byte:

     

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

     

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

     

       80
       -
            Sort Flag - 1 bit (0)

     

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

     

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

     

       83
       -
       

     

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

     

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

     

       86
       -
       

     

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

     

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

     

       89
       -
       

     

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

     

       91
       -
         (* Simple 8-color palette *)

     

       92
       -
         Buffer.add_string buf "\xFF\xFF\xFF";

     

       93
       -
         (* White (0) *)

     

       94
       -
         Buffer.add_string buf "\xFF\x00\x00";

     

       95
       -
         (* Red (1) *)

     

       96
       -
         Buffer.add_string buf "\x00\xFF\x00";

     

       97
       -
         (* Green (2) *)

     

       98
       -
         Buffer.add_string buf "\x00\x00\xFF";

     

       99
       -
         (* Blue (3) *)

     

       100
       -
         Buffer.add_string buf "\xFF\xFF\x00";

     

       101
       -
         (* Yellow (4) *)

     

       102
       -
         Buffer.add_string buf "\xFF\x00\xFF";

     

       103
       -
         (* Magenta (5) *)

     

       104
       -
         Buffer.add_string buf "\x00\xFF\xFF";

     

       105
       -
         (* Cyan (6) *)

     

       106
       -
         Buffer.add_string buf "\x00\x00\x00";

     

       107
       -
       

     

       108
       -
         (* Black (7) *)

     

       109
       -
       

     

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

     

       111
       -
         Buffer.add_char buf (Char.chr 0x21);

     

       112
       -
         (* Extension Introducer *)

     

       113
       -
         Buffer.add_char buf (Char.chr 0xF9);

     

       114
       -
         (* Graphic Control Label *)

     

       115
       -
         Buffer.add_char buf (Char.chr 0x04);

     

       116
       -
         (* Block Size *)

     

       117
       -
         Buffer.add_char buf (Char.chr 0x01);

     

       118
       -
         (* Packed field: 1 bit for transparency *)

     

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

     

       120
       -
         (* Delay time (1/100s) - 2 bytes *)

     

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

     

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

     

       123
       -
         (* Transparent color index *)

     

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

     

       125
       -
       

     

       126
       -
         (* Block terminator *)

     

       127
       -
       

     

       128
       -
         (* Image Descriptor *)

     

       129
       -
         Buffer.add_char buf (Char.chr 0x2C);

     

       130
       -
         (* Image Separator *)

     

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

     

       132
       -
         (* Left position - 2 bytes *)

     

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

     

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

     

       135
       -
         (* Top position - 2 bytes *)

     

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

     

       137
       -
       

     

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

     

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

     

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

     

       141
       -
       

     

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

     

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

     

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

     

       145
       -
       

     

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

     

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

     

       148
       -
       

     

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

     

       150
       -
         Buffer.add_char buf (Char.chr 0x03);

     

       151
       -
       

     

       152
       -
         (* Minimum code size 3 for 8 colors *)

     

       153
       -
       

     

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

     

       155
       -
         let step = width / 8 in

     

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

     

       157
       -
       

     

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

     

       159
       -
         (* Start with Clear code *)

     

       160
       -
         Buffer.add_char image_data (Char.chr 0x08);

     

       161
       -
       

     

       162
       -
         (* Clear code 8 *)

     

       163
       -
       

     

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

     

       165
       -
         for y = 0 to height - 1 do

     

       166
       -
           for x = 0 to width - 1 do

     

       167
       -
             (* Checkerboard pattern with different colors *)

     

       168
       -
             let color =

     

       169
       -
               if ((x / step) + (y / step)) mod 2 = 0 then 3 (* Blue *)

     

       170
       -
               else 1 (* Red *)

     

       171
       -
             in

     

       172
       -
             Buffer.add_char image_data (Char.chr color)

     

       173
       -
           done

     

       174
       -
         done;

     

       175
       -
       

     

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

     

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

     

       178
       -
       

     

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

     

       180
       -
         let data = Buffer.contents image_data in

     

       181
       -
         let data_len = String.length data in

     

       182
       -
         let pos = ref 0 in

     

       183
       -
       

     

       184
       -
         while !pos < data_len do

     

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

     

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

     

       187
       -
           for i = 0 to chunk_size - 1 do

     

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

     

       189
       -
           done;

     

       190
       -
           pos := !pos + chunk_size

     

       191
       -
         done;

     

       192
       -
       

     

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

     

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

     

       195
       -
       

     

       196
       -
         (* GIF Trailer *)

     

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

     

       198
       -
       

     

       199
       -
         (* Base64 encode the GIF data *)

     

       200
       -
         Base64.encode (Buffer.contents buf)

     

       201
       -
       

     

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

     

       203
       -
       let write_int32_le buf n =

     

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

     

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

     

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

     

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

     

       208
       -
       

     

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

     

       210
       -
       let write_int16_le buf n =

     

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

     

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

     

       213
       -
       

     

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

     

       215
       -
       let generate_sine_wave_audio frequency duration =

     

       216
       -
         (* WAV header *)

     

       217
       -
         let sample_rate = 8000 in

     

       218
       -
         let num_samples = sample_rate * duration in

     

       219
       -
         let header_buf = Buffer.create 44 in

     

       220
       -
       

     

       221
       -
         (* Fill WAV header properly *)

     

       222
       -
         Buffer.add_string header_buf "RIFF";

     

       223
       -
         write_int32_le header_buf (36 + (num_samples * 2));

     

       224
       -
         (* File size minus 8 *)

     

       225
       -
         Buffer.add_string header_buf "WAVE";

     

       226
       -
       

     

       227
       -
         (* Format chunk *)

     

       228
       -
         Buffer.add_string header_buf "fmt ";

     

       229
       -
         write_int32_le header_buf 16;

     

       230
       -
         (* Format chunk size *)

     

       231
       -
         write_int16_le header_buf 1;

     

       232
       -
         (* PCM format *)

     

       233
       -
         write_int16_le header_buf 1;

     

       234
       -
         (* Mono *)

     

       235
       -
         write_int32_le header_buf sample_rate;

     

       236
       -
         (* Sample rate *)

     

       237
       -
         write_int32_le header_buf (sample_rate * 2);

     

       238
       -
         (* Byte rate *)

     

       239
       -
         write_int16_le header_buf 2;

     

       240
       -
         (* Block align *)

     

       241
       -
         write_int16_le header_buf 16;

     

       242
       -
       

     

       243
       -
         (* Bits per sample *)

     

       244
       -
       

     

       245
       -
         (* Data chunk *)

     

       246
       -
         Buffer.add_string header_buf "data";

     

       247
       -
         write_int32_le header_buf (num_samples * 2);

     

       248
       -
       

     

       249
       -
         (* Data size *)

     

       250
       -
       

     

       251
       -
         (* Generate sine wave samples *)

     

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

     

       253
       -
         let amplitude = 16384.0 in

     

       254
       -
         (* 16-bit with headroom *)

     

       255
       -
       

     

       256
       -
         for i = 0 to num_samples - 1 do

     

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

     

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

     

       259
       -
           let sample = int_of_float value in

     

       260
       -
       

     

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

     

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

     

       263
       -
           write_int16_le samples_buf sample

     

       264
       -
         done;

     

       265
       -
       

     

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

     

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

     

       268
       -
         Base64.encode wav_data

     

       269
       -
       

     

       270
       -
       (* Create a server *)

     

       271
       -
       let server =

     

       272
       -
         create_server ~name:"OCaml MCP Multimodal Example" ~version:"0.1.0"

     

       273
       -
           ~protocol_version:"2024-11-05" ()

     

       274
       -
         |> fun server ->

     

       275
       -
         (* Set default capabilities *)

     

       276
       -
         configure_server server ~with_tools:true ~with_resources:true

     

       277
       -
           ~with_prompts:true ()

     

       278
       -
       

     

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

     

       280
       -
       let _ =

     

       281
       -
         add_tool server ~name:"multimodal_demo"

     

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

     

       283
       -
           ~schema_properties:

     

       284
       -
             [

     

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

     

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

     

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

     

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

     

       289
       -
               ("message", "string", "Text message to include");

     

       290
       -
             ]

     

       291
       -
           ~schema_required:[ "message" ]

     

       292
       -
           (fun args ->

     

       293
       -
             try

     

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

     

       295
       -
               let message = get_string_param args "message" in

     

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

     

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

     

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

     

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

     

       300
       -
       

     

       301
       -
               (* Generate image and audio data *)

     

       302
       -
               let image_data = generate_random_image width height in

     

       303
       -
               let audio_data =

     

       304
       -
                 generate_sine_wave_audio (float_of_int frequency) duration

     

       305
       -
               in

     

       306
       -
       

     

       307
       -
               (* Create a multimodal tool result *)

     

       308
       -
               Tool.create_tool_result

     

       309
       -
                 [

     

       310
       -
                   Mcp.make_text_content message;

     

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

     

       312
       -
                   Mcp.make_audio_content audio_data "audio/wav";

     

       313
       -
                 ]

     

       314
       -
                 ~is_error:false

     

       315
       -
             with Failure msg ->

     

       316
       -
               Logs.err (fun m -> m "Error in multimodal tool: %s" msg);

     

       317
       -
               Tool.create_tool_result

     

       318
       -
                 [ Mcp.make_text_content (Printf.sprintf "Error: %s" msg) ]

     

       319
       -
                 ~is_error:true)

     

       320
       -
       

     

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

     

       322
       -
       let _ =

     

       323
       -
         add_tool server ~name:"generate_image"

     

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

     

       325
       -
           ~schema_properties:

     

       326
       -
             [

     

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

     

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

     

       329
       -
             ]

     

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

     

       331
       -
           (fun args ->

     

       332
       -
             try

     

       333
       -
               let width = get_int_param args "width" in

     

       334
       -
               let height = get_int_param args "height" in

     

       335
       -
       

     

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

     

       337
       -
                 Tool.create_tool_result

     

       338
       -
                   [

     

       339
       -
                     Mcp.make_text_content

     

       340
       -
                       "Error: Dimensions must be between 1 and 1024 pixels";

     

       341
       -
                   ]

     

       342
       -
                   ~is_error:true

     

       343
       -
               else

     

       344
       -
                 let image_data = generate_random_image width height in

     

       345
       -
                 Tool.create_tool_result

     

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

     

       347
       -
                   ~is_error:false

     

       348
       -
             with Failure msg ->

     

       349
       -
               Logs.err (fun m -> m "Error in generate_image tool: %s" msg);

     

       350
       -
               Tool.create_tool_result

     

       351
       -
                 [ Mcp.make_text_content (Printf.sprintf "Error: %s" msg) ]

     

       352
       -
                 ~is_error:true)

     

       353
       -
       

     

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

     

       355
       -
       let _ =

     

       356
       -
         add_tool server ~name:"generate_audio"

     

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

     

       358
       -
           ~schema_properties:

     

       359
       -
             [

     

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

     

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

     

       362
       -
             ]

     

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

     

       364
       -
           (fun args ->

     

       365
       -
             try

     

       366
       -
               let frequency = get_int_param args "frequency" in

     

       367
       -
               let duration = get_int_param args "duration" in

     

       368
       -
       

     

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

     

       370
       -
                 Tool.create_tool_result

     

       371
       -
                   [

     

       372
       -
                     Mcp.make_text_content

     

       373
       -
                       "Error: Frequency must be between 20Hz and 20,000Hz";

     

       374
       -
                   ]

     

       375
       -
                   ~is_error:true

     

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

     

       377
       -
                 Tool.create_tool_result

     

       378
       -
                   [

     

       379
       -
                     Mcp.make_text_content

     

       380
       -
                       "Error: Duration must be between 1 and 10 seconds";

     

       381
       -
                   ]

     

       382
       -
                   ~is_error:true

     

       383
       -
               else

     

       384
       -
                 let audio_data =

     

       385
       -
                   generate_sine_wave_audio (float_of_int frequency) duration

     

       386
       -
                 in

     

       387
       -
                 Tool.create_tool_result

     

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

     

       389
       -
                   ~is_error:false

     

       390
       -
             with Failure msg ->

     

       391
       -
               Logs.err (fun m -> m "Error in generate_audio tool: %s" msg);

     

       392
       -
               Tool.create_tool_result

     

       393
       -
                 [ Mcp.make_text_content (Printf.sprintf "Error: %s" msg) ]

     

       394
       -
                 ~is_error:true)

     

       395
       -
       

     

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

     

       397
       -
       let _ =

     

       398
       -
         add_resource_template server ~uri_template:"multimodal://{name}"

     

       399
       -
           ~name:"Multimodal Greeting"

     

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

     

       401
       -
           ~mime_type:"application/json" (fun params ->

     

       402
       -
             match params with

     

       403
       -
             | [ name ] ->

     

       404
       -
                 let greeting =

     

       405
       -
                   Printf.sprintf "Hello, %s! Welcome to the multimodal MCP example."

     

       406
       -
                     name

     

       407
       -
                 in

     

       408
       -
                 let image_data = generate_random_image 128 128 in

     

       409
       -
                 let audio_data = generate_sine_wave_audio 440.0 1 in

     

       410
       -
       

     

       411
       -
                 Printf.sprintf

     

       412
       -
                   {|

     

       413
       -
               {

     

       414
       -
                 "greeting": "%s",

     

       415
       -
                 "image": {

     

       416
       -
                   "data": "%s",

     

       417
       -
                   "mimeType": "image/gif"

     

       418
       -
                 },

     

       419
       -
                 "audio": {

     

       420
       -
                   "data": "%s",

     

       421
       -
                   "mimeType": "audio/wav"

     

       422
       -
                 }

     

       423
       -
               }

     

       424
       -
             |}

     

       425
       -
                   greeting image_data audio_data

     

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

     

       427
       -
       

     

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

     

       429
       -
       let () =

     

       430
       -
         Logs.set_reporter (Logs.format_reporter ());

     

       431
       -
         Random.self_init ();

     

       432
       -
         (* Initialize random generator *)

     

       433
       -
         Eio_main.run @@ fun env -> Mcp_server.run_stdio_server env server

-161

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 =

     

       45
       -
             capture_output (fun fmt -> 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 [ ("success", `Bool true); ("output", `String output) ]

     

       51
       -
           else

     

       52
       -
             `Assoc

     

       53
       -
               [

     

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

     

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

     

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

     

       57
       -
               ]

     

       58
       -
         with e ->

     

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

     

       60
       -
           let error_msg =

     

       61
       -
             match e with

     

       62
       -
             | Syntaxerr.Error err ->

     

       63
       -
                 let msg =

     

       64
       -
                   match err with

     

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

     

       66
       -
                   | Syntaxerr.Expecting _ ->

     

       67
       -
                       "Syntax error: Expecting a different token"

     

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

     

       69
       -
                   | Syntaxerr.Applicative_path _ ->

     

       70
       -
                       "Syntax error: Invalid applicative path"

     

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

     

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

     

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

     

       74
       -
                 in

     

       75
       -
                 msg

     

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

     

       77
       -
                 let msg =

     

       78
       -
                   match err with

     

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

     

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

     

       81
       -
                   | Lexer.Unterminated_comment _ ->

     

       82
       -
                       "Lexer error: Unterminated comment"

     

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

     

       84
       -
                   | Lexer.Unterminated_string_in_comment _ ->

     

       85
       -
                       "Lexer error: Unterminated string in comment"

     

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

     

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

     

       88
       -
                 in

     

       89
       -
                 msg

     

       90
       -
             | _ -> Printexc.to_string e

     

       91
       -
           in

     

       92
       -
           `Assoc [ ("success", `Bool false); ("error", `String error_msg) ]

     

       93
       -
       

     

       94
       -
       (* Create evaluation server *)

     

       95
       -
       let server =

     

       96
       -
         create_server ~name:"OCaml Evaluation Server" ~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

     

       107
       -
           let _ = initialize_toploop () in

     

       108
       -
           toplevel_initialized := true

     

       109
       -
       

     

       110
       -
       (* Register eval tool *)

     

       111
       -
       let _ =

     

       112
       -
         add_tool server ~name:"ocaml_eval"

     

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

     

       114
       -
           ~schema_properties:[ ("code", "string", "OCaml code to evaluate") ]

     

       115
       -
           ~schema_required:[ "code" ]

     

       116
       -
           (fun args ->

     

       117
       -
             ensure_toploop_initialized ();

     

       118
       -
       

     

       119
       -
             try

     

       120
       -
               (* Extract code parameter *)

     

       121
       -
               let code = get_string_param args "code" in

     

       122
       -
       

     

       123
       -
               (* Execute the code *)

     

       124
       -
               let result = evaluate_phrase code in

     

       125
       -
       

     

       126
       -
               (* Return formatted result *)

     

       127
       -
               let success =

     

       128
       -
                 match result with

     

       129
       -
                 | `Assoc fields -> (

     

       130
       -
                     match List.assoc_opt "success" fields with

     

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

     

       132
       -
                     | _ -> false)

     

       133
       -
                 | _ -> false

     

       134
       -
               in

     

       135
       -
       

     

       136
       -
               let output =

     

       137
       -
                 match result with

     

       138
       -
                 | `Assoc fields -> (

     

       139
       -
                     match List.assoc_opt "output" fields with

     

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

     

       141
       -
                     | _ -> (

     

       142
       -
                         match List.assoc_opt "error" fields with

     

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

     

       144
       -
                         | _ -> "Unknown result"))

     

       145
       -
                 | _ -> "Unknown result"

     

       146
       -
               in

     

       147
       -
       

     

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

     

       149
       -
               Tool.create_tool_result

     

       150
       -
                 [ Mcp.make_text_content output ]

     

       151
       -
                 ~is_error:(not success)

     

       152
       -
             with Failure msg ->

     

       153
       -
               Logs.err (fun m -> m "Error in OCaml eval tool: %s" msg);

     

       154
       -
               Tool.create_tool_result

     

       155
       -
                 [ Mcp.make_text_content (Printf.sprintf "Error: %s" msg) ]

     

       156
       -
                 ~is_error:true)

     

       157
       -
       

     

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

     

       159
       -
       let () =

     

       160
       -
         Logs.set_reporter (Logs.format_reporter ());

     

       161
       -
         Eio_main.run @@ fun env -> Mcp_server.run_stdio_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

-20

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
       -
         http

     

       18
       -
         cohttp-eio

     

       19
       -
         eio_main

     

       20
       -
         eio

     

       21
       -
         logs))

···

       1
        
       (lang dune 3.17)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0

+11 -22

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

     

       13
       -
         (:standard -w -67 -w -27 -w -32 -w -33 -w -34)))

     

       14
        
       

     

       15
        
       (library

     

       16
       -
        (name mcp_sdk)

     

       17
       -
        (public_name mcp.sdk)

     

       18
       -
        (libraries mcp mcp_rpc jsonrpc unix yojson logs logs.fmt)

     

       19
       -
        (modules mcp_sdk)

     

       20
       -
        (flags

     

       21
       -
         (:standard -w -67 -w -27 -w -32)))

     

       22
       -
       

     

       23
       -
       (library

     

       24
       -
        (name mcp_server)

     

       25
       -
        (public_name mcp.server)

     

       26
       -
        (libraries mcp_sdk jsonrpc eio_main eio http cohttp-eio)

     

       27
       -
        (modules mcp_server))

···

       1
        
       (library

     

       2
       +
         (name mcp)

     

       3
       +
         (libraries jsonrpc unix yojson)

     

       4
       +
         (modules mcp))

     

       0
        
       
     

       5
        
       

     

       6
        
       (library

     

       7
       +
         (name mcp_sdk)

     

       8
       +
         (libraries mcp jsonrpc unix yojson)

     

       9
       +
         (modules mcp_sdk)

     

       10
       +
         (flags (:standard -w -67 -w -27 -w -32)))

     

       0
        
       
     

       0
        
       
     

       11
        
       

     

       12
        
       (library

     

       13
       +
         (name mcp_server)

     

       14
       +
         (libraries mcp mcp_sdk jsonrpc unix yojson)

     

       15
       +
         (modules mcp_server)

     

       16
       +
         (flags (:standard -w -67 -w -27 -w -32 -w -8 -w -11 -w -33)))

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0

+899 -655

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

     

       18
       -
           |> Option.map (function

     

       19
       -
                | `String s -> s

     

       20
       -
                | j -> json_error "Expected string for %s" j name)

     

       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
       -
           | _ ->

     

       57
       -
               json_error "Field '%s' missing or not equal to '%s'" json name

     

       58
       -
                 expected_value

     

       59
       -
       end

     

       60
       -
       

     

       61
       -
       (* Error codes for JSON-RPC *)

     

       62
        
       module ErrorCode = struct

     

       63
       -
         type t =

     

       64
       -
           | ParseError (* -32700 - Invalid JSON *)

     

       65
       -
           | InvalidRequest (* -32600 - Invalid JSON-RPC request *)

     

       66
       -
           | MethodNotFound (* -32601 - Method not available *)

     

       67
       -
           | InvalidParams (* -32602 - Invalid method parameters *)

     

       68
       -
           | InternalError (* -32603 - Internal JSON-RPC error *)

     

       69
       -
           | ResourceNotFound

     

       70
       -
             (* -32002 - Custom MCP error: requested resource not found *)

     

       71
       -
           | AuthRequired (* -32001 - Custom MCP error: authentication required *)

     

       72
       -
           | CustomError of int (* For any other error codes *)

     

       73
       -
       

     

       74
       -
         (* Convert the error code to its integer representation *)

     

       75
       -
         let to_int = function

     

       76
       -
           | ParseError -> -32700

     

       77
       -
           | InvalidRequest -> -32600

     

       78
       -
           | MethodNotFound -> -32601

     

       79
       -
           | InvalidParams -> -32602

     

       80
       -
           | InternalError -> -32603

     

       81
       -
           | ResourceNotFound -> -32002

     

       82
       -
           | AuthRequired -> -32001

     

       83
       -
           | CustomError code -> code

     

       84
       -
       

     

       85
       -
         (* Get error message for standard error codes *)

     

       86
       -
         let to_message = function

     

       87
       -
           | ParseError -> "Parse error"

     

       88
       -
           | InvalidRequest -> "Invalid Request"

     

       89
       -
           | MethodNotFound -> "Method not found"

     

       90
       -
           | InvalidParams -> "Invalid params"

     

       91
       -
           | InternalError -> "Internal error"

     

       92
       -
           | ResourceNotFound -> "Resource not found"

     

       93
       -
           | AuthRequired -> "Authentication required"

     

       94
       -
           | CustomError _ -> "Error"

     

       95
       -
       end

     

       96
       -
       

     

       97
       -
       (* Protocol method types *)

     

       98
       -
       module Method = struct

     

       99
       -
         (* Method type representing all MCP protocol methods *)

     

       100
       -
         type t =

     

       101
       -
           (* Initialization and lifecycle methods *)

     

       102
       -
           | Initialize

     

       103
       -
           | Initialized

     

       104
       -
           (* Resource methods *)

     

       105
       -
           | ResourcesList

     

       106
       -
           | ResourcesRead

     

       107
       -
           | ResourceTemplatesList

     

       108
       -
           | ResourcesSubscribe

     

       109
       -
           | ResourcesListChanged

     

       110
       -
           | ResourcesUpdated

     

       111
       -
           (* Tool methods *)

     

       112
       -
           | ToolsList

     

       113
       -
           | ToolsCall

     

       114
       -
           | ToolsListChanged

     

       115
       -
           (* Prompt methods *)

     

       116
       -
           | PromptsList

     

       117
       -
           | PromptsGet

     

       118
       -
           | PromptsListChanged

     

       119
       -
           (* Progress notifications *)

     

       120
       -
           | Progress

     

       121
       -
       

     

       122
       -
         (* Convert method type to string representation *)

     

       123
       -
         let to_string = function

     

       124
       -
           | Initialize -> "initialize"

     

       125
       -
           | Initialized -> "notifications/initialized"

     

       126
       -
           | ResourcesList -> "resources/list"

     

       127
       -
           | ResourcesRead -> "resources/read"

     

       128
       -
           | ResourceTemplatesList -> "resources/templates/list"

     

       129
       -
           | ResourcesSubscribe -> "resources/subscribe"

     

       130
       -
           | ResourcesListChanged -> "notifications/resources/list_changed"

     

       131
       -
           | ResourcesUpdated -> "notifications/resources/updated"

     

       132
       -
           | ToolsList -> "tools/list"

     

       133
       -
           | ToolsCall -> "tools/call"

     

       134
       -
           | ToolsListChanged -> "notifications/tools/list_changed"

     

       135
       -
           | PromptsList -> "prompts/list"

     

       136
       -
           | PromptsGet -> "prompts/get"

     

       137
       -
           | PromptsListChanged -> "notifications/prompts/list_changed"

     

       138
       -
           | Progress -> "notifications/progress"

     

       139
       -
       

     

       140
       -
         (* Convert string to method type *)

     

       141
       -
         let of_string = function

     

       142
       -
           | "initialize" -> Initialize

     

       143
       -
           | "notifications/initialized" -> Initialized

     

       144
       -
           | "resources/list" -> ResourcesList

     

       145
       -
           | "resources/read" -> ResourcesRead

     

       146
       -
           | "resources/templates/list" -> ResourceTemplatesList

     

       147
       -
           | "resources/subscribe" -> ResourcesSubscribe

     

       148
       -
           | "notifications/resources/list_changed" -> ResourcesListChanged

     

       149
       -
           | "notifications/resources/updated" -> ResourcesUpdated

     

       150
       -
           | "tools/list" -> ToolsList

     

       151
       -
           | "tools/call" -> ToolsCall

     

       152
       -
           | "notifications/tools/list_changed" -> ToolsListChanged

     

       153
       -
           | "prompts/list" -> PromptsList

     

       154
       -
           | "prompts/get" -> PromptsGet

     

       155
       -
           | "notifications/prompts/list_changed" -> PromptsListChanged

     

       156
       -
           | "notifications/progress" -> Progress

     

       157
       -
           | s -> failwith ("Unknown MCP method: " ^ s)

     

       158
        
       end

     

       159
        
       

     

       160
        
       (* Common types *)

     
···

       162
        
       module Role = struct

     

       163
        
         type t = [ `User | `Assistant ]

     

       164
        
       

     

       165
       -
         let to_string = function `User -> "user" | `Assistant -> "assistant"

     

       0
        
       
     

       0
        
       
     

       166
        
       

     

       167
        
         let of_string = function

     

       168
        
           | "user" -> `User

     

       169
        
           | "assistant" -> `Assistant

     

       170
       -
           | s -> Util.json_error "Unknown role: %s" (`String s) s

     

       171
        
       

     

       172
        
         let yojson_of_t t = `String (to_string t)

     

       173
       -
       

     

       174
        
         let t_of_yojson = function

     

       175
        
           | `String s -> of_string s

     

       176
       -
           | j -> Util.json_error "Expected string for Role" j

     

       177
        
       end

     

       178
        
       

     

       179
        
       module ProgressToken = struct

     
···

       188
        
         type t = string

     

       189
        
       

     

       190
        
         let yojson_of_t t = `String t

     

       191
       -
       

     

       192
        
         let t_of_yojson = function

     

       193
        
           | `String s -> s

     

       194
       -
           | j -> Util.json_error "Expected string for Cursor" j

     

       195
        
       end

     

       196
        
       

     

       197
        
       (* Annotations *)

     

       198
        
       

     

       199
        
       module Annotated = struct

     

       200
       -
         type t = { annotations : annotation option }

     

       201
       -
         and annotation = { audience : Role.t list option; priority : float option }

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       202
        
       

     

       203
        
         let yojson_of_annotation { audience; priority } =

     

       204
        
           let assoc = [] in

     

       205
       -
           let assoc =

     

       206
       -
             match audience with

     

       207
       -
             | Some audience ->

     

       208
       -
                 ("audience", `List (List.map Role.yojson_of_t audience)) :: assoc

     

       209
        
             | None -> assoc

     

       210
        
           in

     

       211
       -
           let assoc =

     

       212
       -
             match priority with

     

       213
        
             | Some priority -> ("priority", `Float priority) :: assoc

     

       214
        
             | None -> assoc

     

       215
        
           in

     
···

       217
        
       

     

       218
        
         let annotation_of_yojson = function

     

       219
        
           | `Assoc fields ->

     

       220
       -
               let audience =

     

       221
       -
                 List.assoc_opt "audience" fields

     

       222
       -
                 |> Option.map (function

     

       223
       -
                      | `List items -> List.map Role.t_of_yojson items

     

       224
       -
                      | j -> Util.json_error "Expected list for audience" j)

     

       225
       -
               in

     

       226
       -
               let priority =

     

       227
       -
                 List.assoc_opt "priority" fields

     

       228
       -
                 |> Option.map (function

     

       229
       -
                      | `Float f -> f

     

       230
       -
                      | j -> Util.json_error "Expected float for priority" j)

     

       231
       -
               in

     

       232
       -
               { audience; priority }

     

       233
       -
           | j -> Util.json_error "Expected object for annotation" j

     

       234
        
       

     

       235
        
         let yojson_of_t { annotations } =

     

       236
        
           match annotations with

     

       237
       -
           | Some annotations ->

     

       238
       -
               `Assoc [ ("annotations", yojson_of_annotation annotations) ]

     

       239
        
           | None -> `Assoc []

     

       240
        
       

     

       241
        
         let t_of_yojson = function

     

       242
        
           | `Assoc fields ->

     

       243
       -
               let annotations =

     

       244
       -
                 List.assoc_opt "annotations" fields |> Option.map annotation_of_yojson

     

       245
       -
               in

     

       246
       -
               { annotations }

     

       247
       -
           | j -> Util.json_error "Expected object for Annotated" j

     

       248
        
       end

     

       249
        
       

     

       250
        
       (* Content types *)

     

       251
        
       

     

       252
        
       module TextContent = struct

     

       253
       -
         type t = { text : string; annotations : Annotated.annotation option }

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       254
        
       

     

       255
        
         let yojson_of_t { text; annotations } =

     

       256
       -
           let assoc = [ ("text", `String text); ("type", `String "text") ] in

     

       257
       -
           let assoc =

     

       258
       -
             match annotations with

     

       259
       -
             | Some annotations ->

     

       260
       -
                 ("annotations", Annotated.yojson_of_annotation annotations) :: assoc

     

       0
        
       
     

       261
        
             | None -> assoc

     

       262
        
           in

     

       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;

     

       269
       -
               let annotations =

     

       270
       -
                 List.assoc_opt "annotations" fields

     

       271
       -
                 |> Option.map Annotated.annotation_of_yojson

     

       272
       -
               in

     

       273
       -
               { text; annotations }

     

       274
       -
           | j -> Util.json_error "Expected object for TextContent" j

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       275
        
       end

     

       276
        
       

     

       277
        
       module ImageContent = struct

     

       278
        
         type t = {

     

       279
       -
           data : string;

     

       280
       -
           mime_type : string;

     

       281
       -
           annotations : Annotated.annotation option;

     

       282
        
         }

     

       283
        
       

     

       284
        
         let yojson_of_t { data; mime_type; annotations } =

     

       285
       -
           let assoc =

     

       286
       -
             [

     

       287
       -
               ("type", `String "image");

     

       288
       -
               ("data", `String data);

     

       289
       -
               ("mimeType", `String mime_type);

     

       290
       -
             ]

     

       291
       -
           in

     

       292
       -
           let assoc =

     

       293
       -
             match annotations with

     

       294
       -
             | Some annotations ->

     

       295
       -
                 ("annotations", Annotated.yojson_of_annotation annotations) :: assoc

     

       296
        
             | None -> assoc

     

       297
        
           in

     

       298
        
           `Assoc assoc

     

       299
        
       

     

       300
        
         let t_of_yojson = function

     

       301
       -
           | `Assoc fields as json ->

     

       302
       -
               let data = Util.get_string_field fields "data" json in

     

       303
       -
               let mime_type = Util.get_string_field fields "mimeType" json in

     

       304
       -
               Util.verify_string_field fields "type" "image" json;

     

       305
       -
               let annotations =

     

       306
       -
                 List.assoc_opt "annotations" fields

     

       307
       -
                 |> Option.map Annotated.annotation_of_yojson

     

       308
       -
               in

     

       309
       -
               { data; mime_type; annotations }

     

       310
       -
           | j -> Util.json_error "Expected object for ImageContent" j

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       311
        
       end

     

       312
        
       

     

       313
        
       module AudioContent = struct

     

       314
        
         type t = {

     

       315
       -
           data : string;

     

       316
       -
           mime_type : string;

     

       317
       -
           annotations : Annotated.annotation option;

     

       318
        
         }

     

       319
        
       

     

       320
        
         let yojson_of_t { data; mime_type; annotations } =

     

       321
       -
           let assoc =

     

       322
       -
             [

     

       323
       -
               ("type", `String "audio");

     

       324
       -
               ("data", `String data);

     

       325
       -
               ("mimeType", `String mime_type);

     

       326
       -
             ]

     

       327
       -
           in

     

       328
       -
           let assoc =

     

       329
       -
             match annotations with

     

       330
       -
             | Some annotations ->

     

       331
       -
                 ("annotations", Annotated.yojson_of_annotation annotations) :: assoc

     

       332
        
             | None -> assoc

     

       333
        
           in

     

       334
        
           `Assoc assoc

     

       335
        
       

     

       336
        
         let t_of_yojson = function

     

       337
       -
           | `Assoc fields as json ->

     

       338
       -
               let data = Util.get_string_field fields "data" json in

     

       339
       -
               let mime_type = Util.get_string_field fields "mimeType" json in

     

       340
       -
               Util.verify_string_field fields "type" "audio" json;

     

       341
       -
               let annotations =

     

       342
       -
                 List.assoc_opt "annotations" fields

     

       343
       -
                 |> Option.map Annotated.annotation_of_yojson

     

       344
       -
               in

     

       345
       -
               { data; mime_type; annotations }

     

       346
       -
           | j -> Util.json_error "Expected object for AudioContent" j

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       347
        
       end

     

       348
        
       

     

       349
        
       module ResourceContents = struct

     

       350
       -
         type t = { uri : string; mime_type : string option }

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       351
        
       

     

       352
        
         let yojson_of_t { uri; mime_type } =

     

       353
       -
           let assoc = [ ("uri", `String uri) ] in

     

       354
       -
           let assoc =

     

       355
       -
             match mime_type with

     

       0
        
       
     

       356
        
             | Some mime_type -> ("mimeType", `String mime_type) :: assoc

     

       357
        
             | None -> assoc

     

       358
        
           in

     

       359
        
           `Assoc assoc

     

       360
        
       

     

       361
        
         let t_of_yojson = function

     

       362
       -
           | `Assoc fields as json ->

     

       363
       -
               let uri = Util.get_string_field fields "uri" json in

     

       364
       -
               let mime_type = Util.get_optional_string_field fields "mimeType" in

     

       365
       -
               { uri; mime_type }

     

       366
       -
           | j -> Util.json_error "Expected object for ResourceContents" j

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       367
        
       end

     

       368
        
       

     

       369
        
       module TextResourceContents = struct

     

       370
       -
         type t = { uri : string; text : string; mime_type : string option }

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       371
        
       

     

       372
        
         let yojson_of_t { uri; text; mime_type } =

     

       373
       -
           let assoc = [ ("uri", `String uri); ("text", `String text) ] in

     

       374
       -
           let assoc =

     

       375
       -
             match mime_type with

     

       0
        
       
     

       0
        
       
     

       376
        
             | Some mime_type -> ("mimeType", `String mime_type) :: assoc

     

       377
        
             | None -> assoc

     

       378
        
           in

     

       379
        
           `Assoc assoc

     

       380
        
       

     

       381
        
         let t_of_yojson = function

     

       382
       -
           | `Assoc fields as json ->

     

       383
       -
               let uri = Util.get_string_field fields "uri" json in

     

       384
       -
               let text = Util.get_string_field fields "text" json in

     

       385
       -
               let mime_type = Util.get_optional_string_field fields "mimeType" in

     

       386
       -
               { uri; text; mime_type }

     

       387
       -
           | j -> Util.json_error "Expected object for TextResourceContents" j

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       388
        
       end

     

       389
        
       

     

       390
        
       module BlobResourceContents = struct

     

       391
       -
         type t = { uri : string; blob : string; mime_type : string option }

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       392
        
       

     

       393
        
         let yojson_of_t { uri; blob; mime_type } =

     

       394
       -
           let assoc = [ ("uri", `String uri); ("blob", `String blob) ] in

     

       395
       -
           let assoc =

     

       396
       -
             match mime_type with

     

       0
        
       
     

       0
        
       
     

       397
        
             | Some mime_type -> ("mimeType", `String mime_type) :: assoc

     

       398
        
             | None -> assoc

     

       399
        
           in

     

       400
        
           `Assoc assoc

     

       401
        
       

     

       402
        
         let t_of_yojson = function

     

       403
       -
           | `Assoc fields as json ->

     

       404
       -
               let uri = Util.get_string_field fields "uri" json in

     

       405
       -
               let blob = Util.get_string_field fields "blob" json in

     

       406
       -
               let mime_type = Util.get_optional_string_field fields "mimeType" in

     

       407
       -
               { uri; blob; mime_type }

     

       408
       -
           | j -> Util.json_error "Expected object for BlobResourceContents" j

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       409
        
       end

     

       410
        
       

     

       411
        
       module EmbeddedResource = struct

     

       412
        
         type t = {

     

       413
       -
           resource :

     

       414
       -
             [ `Text of TextResourceContents.t | `Blob of BlobResourceContents.t ];

     

       415
       -
           annotations : Annotated.annotation option;

     

       416
        
         }

     

       417
        
       

     

       418
        
         let yojson_of_t { resource; annotations } =

     

       419
       -
           let resource_json =

     

       420
       -
             match resource with

     

       421
        
             | `Text txt -> TextResourceContents.yojson_of_t txt

     

       422
        
             | `Blob blob -> BlobResourceContents.yojson_of_t blob

     

       423
        
           in

     

       424
       -
           let assoc = [ ("resource", resource_json); ("type", `String "resource") ] in

     

       425
       -
           let assoc =

     

       426
       -
             match annotations with

     

       427
       -
             | Some annotations ->

     

       428
       -
                 ("annotations", Annotated.yojson_of_annotation annotations) :: assoc

     

       0
        
       
     

       429
        
             | None -> assoc

     

       430
        
           in

     

       431
        
           `Assoc assoc

     

       432
        
       

     

       433
        
         let t_of_yojson = function

     

       434
       -
           | `Assoc fields as json ->

     

       435
       -
               Util.verify_string_field fields "type" "resource" json;

     

       436
       -
               let resource_fields =

     

       437
       -
                 match List.assoc_opt "resource" fields with

     

       438
       -
                 | Some (`Assoc res_fields) -> res_fields

     

       439
       -
                 | _ -> Util.json_error "Missing or invalid 'resource' field" json

     

       440
       -
               in

     

       441
       -
               let resource =

     

       442
       -
                 if List.mem_assoc "text" resource_fields then

     

       443
       -
                   `Text (TextResourceContents.t_of_yojson (`Assoc resource_fields))

     

       444
       -
                 else if List.mem_assoc "blob" resource_fields then

     

       445
       -
                   `Blob (BlobResourceContents.t_of_yojson (`Assoc resource_fields))

     

       446
        
                 else

     

       447
       -
                   Util.json_error "Invalid resource content" (`Assoc resource_fields)

     

       448
       -
               in

     

       449
       -
               let annotations =

     

       450
       -
                 List.assoc_opt "annotations" fields

     

       451
       -
                 |> Option.map Annotated.annotation_of_yojson

     

       452
       -
               in

     

       453
       -
               { resource; annotations }

     

       454
       -
           | 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
        
       
     

       455
        
       end

     

       456
        
       

     

       457
       -
       type content =

     

       458
        
         | Text of TextContent.t

     

       459
        
         | Image of ImageContent.t

     

       460
        
         | Audio of AudioContent.t

     
···

       467
        
         | Resource r -> EmbeddedResource.yojson_of_t r

     

       468
        
       

     

       469
        
       let content_of_yojson = function

     

       470
       -
         | `Assoc fields as json -> (

     

       471
       -
             match List.assoc_opt "type" fields with

     

       472
       -
             | Some (`String "text") -> Text (TextContent.t_of_yojson json)

     

       473
       -
             | Some (`String "image") -> Image (ImageContent.t_of_yojson json)

     

       474
       -
             | Some (`String "audio") -> Audio (AudioContent.t_of_yojson json)

     

       475
       -
             | Some (`String "resource") ->

     

       476
       -
                 Resource (EmbeddedResource.t_of_yojson json)

     

       477
       -
             | _ -> Util.json_error "Invalid or missing content type" json)

     

       478
       -
         | 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
        
       
     

       479
        
       

     

       480
        
       (* Message types *)

     

       481
        
       

     

       482
        
       module PromptMessage = struct

     

       483
       -
         type t = { role : Role.t; content : content }

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       484
        
       

     

       485
        
         let yojson_of_t { role; content } =

     

       486
       -
           `Assoc

     

       487
       -
             [

     

       488
       -
               ("role", Role.yojson_of_t role); ("content", yojson_of_content content);

     

       489
       -
             ]

     

       490
        
       

     

       491
        
         let t_of_yojson = function

     

       492
       -
           | `Assoc fields as json ->

     

       493
       -
               let role =

     

       494
       -
                 match List.assoc_opt "role" fields with

     

       495
       -
                 | Some json -> Role.t_of_yojson json

     

       496
       -
                 | None -> Util.json_error "Missing role field" json

     

       497
       -
               in

     

       498
       -
               let content =

     

       499
       -
                 match List.assoc_opt "content" fields with

     

       500
       -
                 | Some json -> content_of_yojson json

     

       501
       -
                 | None -> Util.json_error "Missing content field" json

     

       502
       -
               in

     

       503
       -
               { role; content }

     

       504
       -
           | j -> Util.json_error "Expected object for PromptMessage" j

     

       505
        
       end

     

       506
        
       

     

       507
        
       module SamplingMessage = struct

     

       508
        
         type t = {

     

       509
       -
           role : Role.t;

     

       510
       -
           content :

     

       511
       -
             [ `Text of TextContent.t

     

       512
       -
             | `Image of ImageContent.t

     

       513
       -
             | `Audio of AudioContent.t ];

     

       514
        
         }

     

       515
        
       

     

       516
        
         let yojson_of_t { role; content } =

     

       517
       -
           let content_json =

     

       518
       -
             match content with

     

       519
        
             | `Text t -> TextContent.yojson_of_t t

     

       520
        
             | `Image i -> ImageContent.yojson_of_t i

     

       521
       -
             | `Audio a -> AudioContent.yojson_of_t a

     

       522
        
           in

     

       523
       -
           `Assoc [ ("role", Role.yojson_of_t role); ("content", content_json) ]

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       524
        
       

     

       525
        
         let t_of_yojson = function

     

       526
       -
           | `Assoc fields as json ->

     

       527
       -
               let role =

     

       528
       -
                 match List.assoc_opt "role" fields with

     

       529
       -
                 | Some json -> Role.t_of_yojson json

     

       530
       -
                 | None -> Util.json_error "Missing role field" json

     

       531
       -
               in

     

       532
       -
               let content_obj =

     

       533
       -
                 match List.assoc_opt "content" fields with

     

       534
       -
                 | Some (`Assoc content_fields) -> content_fields

     

       535
       -
                 | _ -> Util.json_error "Missing or invalid content field" json

     

       536
       -
               in

     

       537
       -
               let content_type =

     

       538
       -
                 match List.assoc_opt "type" content_obj with

     

       539
       -
                 | Some (`String ty) -> ty

     

       540
       -
                 | _ ->

     

       541
       -
                     Util.json_error "Missing or invalid content type"

     

       542
       -
                       (`Assoc content_obj)

     

       543
       -
               in

     

       544
       -
               let content =

     

       545
       -
                 match content_type with

     

       546
       -
                 | "text" -> `Text (TextContent.t_of_yojson (`Assoc content_obj))

     

       547
       -
                 | "image" -> `Image (ImageContent.t_of_yojson (`Assoc content_obj))

     

       548
       -
                 | "audio" -> `Audio (AudioContent.t_of_yojson (`Assoc content_obj))

     

       549
       -
                 | _ ->

     

       550
       -
                     Util.json_error "Invalid content type: %s" (`Assoc content_obj)

     

       551
       -
                       content_type

     

       552
       -
               in

     

       553
       -
               { role; content }

     

       554
       -
           | j -> Util.json_error "Expected object for SamplingMessage" j

     

       555
        
       end

     

       556
        
       

     

       557
        
       (* Implementation info *)

     

       558
        
       

     

       559
        
       module Implementation = struct

     

       560
       -
         type t = { name : string; version : string }

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       561
        
       

     

       562
        
         let yojson_of_t { name; version } =

     

       563
       -
           `Assoc [ ("name", `String name); ("version", `String version) ]

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       564
        
       

     

       565
        
         let t_of_yojson = function

     

       566
       -
           | `Assoc fields as json ->

     

       567
       -
               let name = Util.get_string_field fields "name" json in

     

       568
       -
               let version = Util.get_string_field fields "version" json in

     

       569
       -
               { name; version }

     

       570
       -
           | j -> Util.json_error "Expected object for Implementation" j

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       571
        
       end

     

       572
        
       

     

       573
        
       (* JSONRPC Message types *)

     

       0
        
       
     

       574
        
       

     

       575
        
       module JSONRPCMessage = struct

     

       576
       -
         type notification = { meth : Method.t; params : Json.t option }

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       577
        
       

     

       578
        
         type request = {

     

       579
       -
           id : RequestId.t;

     

       580
       -
           meth : Method.t;

     

       581
       -
           params : Json.t option;

     

       582
       -
           progress_token : ProgressToken.t option;

     

       583
        
         }

     

       584
        
       

     

       585
       -
         type response = { id : RequestId.t; result : Json.t }

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       586
        
       

     

       587
        
         type error = {

     

       588
       -
           id : RequestId.t;

     

       589
       -
           code : int;

     

       590
       -
           message : string;

     

       591
       -
           data : Json.t option;

     

       592
        
         }

     

       593
        
       

     

       594
        
         type t =

     
···

       597
        
           | Response of response

     

       598
        
           | Error of error

     

       599
        
       

     

       600
       -
         let yojson_of_notification (n : notification) =

     

       601
       -
           let assoc =

     

       602
       -
             [

     

       603
       -
               ("jsonrpc", `String "2.0"); ("method", `String (Method.to_string n.meth));

     

       604
       -
             ]

     

       605
       -
           in

     

       606
       -
           let assoc =

     

       607
       -
             match n.params with

     

       608
        
             | Some params -> ("params", params) :: assoc

     

       609
        
             | None -> assoc

     

       610
        
           in

     

       611
        
           `Assoc assoc

     

       612
        
       

     

       613
       -
         let yojson_of_request (r : request) =

     

       614
       -
           let assoc =

     

       615
       -
             [

     

       616
       -
               ("jsonrpc", `String "2.0");

     

       617
       -
               ("id", Id.yojson_of_t r.id);

     

       618
       -
               ("method", `String (Method.to_string r.meth));

     

       619
       -
             ]

     

       620
       -
           in

     

       621
       -
           let assoc =

     

       622
       -
             match r.params with

     

       623
        
             | Some params ->

     

       624
       -
                 let params_json =

     

       625
       -
                   match params with

     

       626
       -
                   | `Assoc fields ->

     

       627
       -
                       let fields =

     

       628
       -
                         match r.progress_token with

     

       629
       -
                         | Some token ->

     

       630
       -
                             let meta =

     

       631
       -
                               `Assoc

     

       632
       -
                                 [ ("progressToken", ProgressToken.yojson_of_t token) ]

     

       633
       -
                             in

     

       634
       -
                             ("_meta", meta) :: fields

     

       635
       -
                         | None -> fields

     

       636
       -
                       in

     

       637
       -
                       `Assoc fields

     

       638
       -
                   | _ -> params

     

       639
       -
                 in

     

       640
       -
                 ("params", params_json) :: assoc

     

       641
        
             | None -> assoc

     

       642
        
           in

     

       643
        
           `Assoc assoc

     

       644
        
       

     

       645
       -
         let yojson_of_response (r : response) =

     

       646
       -
           `Assoc

     

       647
       -
             [

     

       648
       -
               ("jsonrpc", `String "2.0");

     

       649
       -
               ("id", Id.yojson_of_t r.id);

     

       650
       -
               ("result", r.result);

     

       651
       -
             ]

     

       652
        
       

     

       653
       -
         let yojson_of_error (e : error) =

     

       654
       -
           let error_assoc =

     

       655
       -
             [ ("code", `Int e.code); ("message", `String e.message) ]

     

       656
       -
           in

     

       657
       -
           let error_assoc =

     

       658
       -
             match e.data with

     

       659
        
             | Some data -> ("data", data) :: error_assoc

     

       660
        
             | None -> error_assoc

     

       661
        
           in

     

       662
       -
           `Assoc

     

       663
       -
             [

     

       664
       -
               ("jsonrpc", `String "2.0");

     

       665
       -
               ("id", Id.yojson_of_t e.id);

     

       666
       -
               ("error", `Assoc error_assoc);

     

       667
       -
             ]

     

       668
        
       

     

       669
        
         let yojson_of_t = function

     

       670
        
           | Notification n -> yojson_of_notification n

     
···

       674
        
       

     

       675
        
         let notification_of_yojson = function

     

       676
        
           | `Assoc fields ->

     

       677
       -
               let meth =

     

       678
       -
                 match List.assoc_opt "method" fields with

     

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

     

       680
       -
                     try Method.of_string s

     

       681
       -
                     with Failure msg -> Util.json_error "%s" (`String s) msg)

     

       682
       -
                 | _ ->

     

       683
       -
                     Util.json_error "Missing or invalid 'method' field"

     

       684
       -
                       (`Assoc fields)

     

       685
       -
               in

     

       686
       -
               let params = List.assoc_opt "params" fields in

     

       687
       -
               { meth; params }

     

       688
       -
           | j -> Util.json_error "Expected object for notification" j

     

       689
        
       

     

       690
        
         let request_of_yojson = function

     

       691
        
           | `Assoc fields ->

     

       692
       -
               let id =

     

       693
       -
                 match List.assoc_opt "id" fields with

     

       694
       -
                 | Some id_json -> Id.t_of_yojson id_json

     

       695
       -
                 | _ -> Util.json_error "Missing or invalid 'id' field" (`Assoc fields)

     

       696
       -
               in

     

       697
       -
               let meth =

     

       698
       -
                 match List.assoc_opt "method" fields with

     

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

     

       700
       -
                     try Method.of_string s

     

       701
       -
                     with Failure msg -> Util.json_error "%s" (`String s) msg)

     

       702
       -
                 | _ ->

     

       703
       -
                     Util.json_error "Missing or invalid 'method' field"

     

       704
       -
                       (`Assoc fields)

     

       705
       -
               in

     

       706
       -
               let params = List.assoc_opt "params" fields in

     

       707
       -
               let progress_token =

     

       708
       -
                 match params with

     

       709
       -
                 | Some (`Assoc param_fields) -> (

     

       710
       -
                     match List.assoc_opt "_meta" param_fields with

     

       711
       -
                     | Some (`Assoc meta_fields) -> (

     

       712
       -
                         match List.assoc_opt "progressToken" meta_fields with

     

       713
       -
                         | Some token_json ->

     

       714
       -
                             Some (ProgressToken.t_of_yojson token_json)

     

       715
       -
                         | None -> None)

     

       716
       -
                     | _ -> None)

     

       717
       -
                 | _ -> None

     

       718
       -
               in

     

       719
       -
               { id; meth; params; progress_token }

     

       720
       -
           | j -> Util.json_error "Expected object for request" j

     

       721
        
       

     

       722
        
         let response_of_yojson = function

     

       723
        
           | `Assoc fields ->

     

       724
       -
               let id =

     

       725
       -
                 match List.assoc_opt "id" fields with

     

       726
       -
                 | Some id_json -> Id.t_of_yojson id_json

     

       727
       -
                 | _ -> Util.json_error "Missing or invalid 'id' field" (`Assoc fields)

     

       728
       -
               in

     

       729
       -
               let result =

     

       730
       -
                 match List.assoc_opt "result" fields with

     

       731
       -
                 | Some result -> result

     

       732
       -
                 | _ -> Util.json_error "Missing 'result' field" (`Assoc fields)

     

       733
       -
               in

     

       734
       -
               { id; result }

     

       735
       -
           | j -> Util.json_error "Expected object for response" j

     

       736
        
       

     

       737
        
         let error_of_yojson = function

     

       738
       -
           | `Assoc fields as json ->

     

       739
       -
               let id =

     

       740
       -
                 match List.assoc_opt "id" fields with

     

       741
       -
                 | Some id_json -> Id.t_of_yojson id_json

     

       742
       -
                 | _ -> Util.json_error "Missing or invalid 'id' field" json

     

       743
       -
               in

     

       744
       -
               let error =

     

       745
       -
                 match List.assoc_opt "error" fields with

     

       746
       -
                 | Some (`Assoc error_fields) -> error_fields

     

       747
       -
                 | _ -> Util.json_error "Missing or invalid 'error' field" json

     

       748
       -
               in

     

       749
       -
               let code =

     

       750
       -
                 match List.assoc_opt "code" error with

     

       751
       -
                 | Some (`Int code) -> code

     

       752
       -
                 | _ ->

     

       753
       -
                     Util.json_error "Missing or invalid 'code' field in error"

     

       754
       -
                       (`Assoc error)

     

       755
       -
               in

     

       756
       -
               let message =

     

       757
       -
                 match List.assoc_opt "message" error with

     

       758
       -
                 | Some (`String msg) -> msg

     

       759
       -
                 | _ ->

     

       760
       -
                     Util.json_error "Missing or invalid 'message' field in error"

     

       761
       -
                       (`Assoc error)

     

       762
       -
               in

     

       763
       -
               let data = List.assoc_opt "data" error in

     

       764
       -
               { id; code; message; data }

     

       765
       -
           | j -> Util.json_error "Expected object for error" j

     

       766
        
       

     

       767
        
         let t_of_yojson json =

     

       768
        
           match json with

     

       769
        
           | `Assoc fields ->

     

       770
       -
               let _jsonrpc =

     

       771
       -
                 match List.assoc_opt "jsonrpc" fields with

     

       772
       -
                 | Some (`String "2.0") -> ()

     

       773
       -
                 | _ -> Util.json_error "Missing or invalid 'jsonrpc' field" json

     

       774
       -
               in

     

       775
       -
               if List.mem_assoc "method" fields then

     

       776
       -
                 if List.mem_assoc "id" fields then Request (request_of_yojson json)

     

       777
       -
                 else Notification (notification_of_yojson json)

     

       778
       -
               else if List.mem_assoc "result" fields then

     

       779
       -
                 Response (response_of_yojson json)

     

       780
       -
               else if List.mem_assoc "error" fields then Error (error_of_yojson json)

     

       781
       -
               else Util.json_error "Invalid JSONRPC message format" json

     

       782
       -
           | j -> Util.json_error "Expected object for JSONRPC message" j

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       783
        
       

     

       784
       -
         let create_notification ?(params = None) ~meth () =

     

       785
       -
           Notification { meth; params }

     

       786
        
       

     

       787
       -
         let create_request ?(params = None) ?(progress_token = None) ~id ~meth () =

     

       788
       -
           Request { id; meth; params; progress_token }

     

       789
        
       

     

       790
       -
         let create_response ~id ~result = Response { id; result }

     

       0
        
       
     

       791
        
       

     

       792
       -
         let create_error ~id ~code ~message ?(data = None) () =

     

       793
        
           Error { id; code; message; data }

     

       794
        
       end

     

       795
        
       

     
···

       798
        
       module Initialize = struct

     

       799
        
         module Request = struct

     

       800
        
           type t = {

     

       801
       -
             capabilities : Json.t; (* ClientCapabilities *)

     

       802
       -
             client_info : Implementation.t;

     

       803
       -
             protocol_version : string;

     

       804
        
           }

     

       805
        
       

     

       806
        
           let yojson_of_t { capabilities; client_info; protocol_version } =

     

       807
       -
             `Assoc

     

       808
       -
               [

     

       809
       -
                 ("capabilities", capabilities);

     

       810
       -
                 ("clientInfo", Implementation.yojson_of_t client_info);

     

       811
       -
                 ("protocolVersion", `String protocol_version);

     

       812
       -
               ]

     

       813
        
       

     

       814
        
           let t_of_yojson = function

     

       815
       -
             | `Assoc fields as json ->

     

       816
       -
                 let capabilities =

     

       817
       -
                   match List.assoc_opt "capabilities" fields with

     

       818
       -
                   | Some json -> json

     

       819
       -
                   | None -> Util.json_error "Missing capabilities field" json

     

       820
       -
                 in

     

       821
       -
                 let client_info =

     

       822
       -
                   match List.assoc_opt "clientInfo" fields with

     

       823
       -
                   | Some json -> Implementation.t_of_yojson json

     

       824
       -
                   | None -> Util.json_error "Missing clientInfo field" json

     

       825
       -
                 in

     

       826
       -
                 let protocol_version =

     

       827
       -
                   Util.get_string_field fields "protocolVersion" json

     

       828
       -
                 in

     

       829
       -
                 { capabilities; client_info; protocol_version }

     

       830
       -
             | j -> Util.json_error "Expected object for InitializeRequest" j

     

       831
        
       

     

       832
        
           let create ~capabilities ~client_info ~protocol_version =

     

       833
        
             { capabilities; client_info; protocol_version }

     

       834
        
       

     

       835
        
           let to_jsonrpc ~id t =

     

       836
        
             let params = yojson_of_t t in

     

       837
       -
             JSONRPCMessage.create_request ~id ~meth:Method.Initialize

     

       838
       -
               ~params:(Some params) ()

     

       839
        
         end

     

       840
        
       

     

       841
        
         module Result = struct

     

       842
        
           type t = {

     

       843
       -
             capabilities : Json.t; (* ServerCapabilities *)

     

       844
       -
             server_info : Implementation.t;

     

       845
       -
             protocol_version : string;

     

       846
       -
             instructions : string option;

     

       847
       -
             meta : Json.t option;

     

       848
        
           }

     

       849
        
       

     

       850
       -
           let yojson_of_t

     

       851
       -
               { capabilities; server_info; protocol_version; instructions; meta } =

     

       852
       -
             let assoc =

     

       853
       -
               [

     

       854
       -
                 ("capabilities", capabilities);

     

       855
       -
                 ("serverInfo", Implementation.yojson_of_t server_info);

     

       856
       -
                 ("protocolVersion", `String protocol_version);

     

       857
       -
               ]

     

       858
       -
             in

     

       859
       -
             let assoc =

     

       860
       -
               match instructions with

     

       861
        
               | Some instr -> ("instructions", `String instr) :: assoc

     

       862
        
               | None -> assoc

     

       863
        
             in

     

       864
       -
             let assoc =

     

       865
       -
               match meta with Some meta -> ("_meta", meta) :: assoc | None -> assoc

     

       0
        
       
     

       866
        
             in

     

       867
        
             `Assoc assoc

     

       868
        
       

     

       869
        
           let t_of_yojson = function

     

       870
       -
             | `Assoc fields as json ->

     

       871
       -
                 let capabilities =

     

       872
       -
                   match List.assoc_opt "capabilities" fields with

     

       873
       -
                   | Some json -> json

     

       874
       -
                   | None -> Util.json_error "Missing capabilities field" json

     

       875
       -
                 in

     

       876
       -
                 let server_info =

     

       877
       -
                   match List.assoc_opt "serverInfo" fields with

     

       878
       -
                   | Some json -> Implementation.t_of_yojson json

     

       879
       -
                   | None -> Util.json_error "Missing serverInfo field" json

     

       880
       -
                 in

     

       881
       -
                 let protocol_version =

     

       882
       -
                   Util.get_string_field fields "protocolVersion" json

     

       883
       -
                 in

     

       884
       -
                 let instructions =

     

       885
       -
                   Util.get_optional_string_field fields "instructions"

     

       886
       -
                 in

     

       887
       -
                 let meta = List.assoc_opt "_meta" fields in

     

       888
       -
                 { capabilities; server_info; protocol_version; instructions; meta }

     

       889
       -
             | j -> Util.json_error "Expected object for InitializeResult" j

     

       890
        
       

     

       891
       -
           let create ~capabilities ~server_info ~protocol_version ?instructions ?meta

     

       892
       -
               () =

     

       893
        
             { capabilities; server_info; protocol_version; instructions; meta }

     

       894
        
       

     

       895
        
           let to_jsonrpc ~id t =

     
···

       899
        
       

     

       900
        
       module Initialized = struct

     

       901
        
         module Notification = struct

     

       902
       -
           type t = { meta : Json.t option }

     

       0
        
       
     

       0
        
       
     

       903
        
       

     

       904
        
           let yojson_of_t { meta } =

     

       905
        
             let assoc = [] in

     

       906
       -
             let assoc =

     

       907
       -
               match meta with Some meta -> ("_meta", meta) :: assoc | None -> assoc

     

       0
        
       
     

       908
        
             in

     

       909
        
             `Assoc assoc

     

       910
        
       

     

       911
        
           let t_of_yojson = function

     

       912
        
             | `Assoc fields ->

     

       913
       -
                 let meta = List.assoc_opt "_meta" fields in

     

       914
       -
                 { meta }

     

       915
       -
             | j -> Util.json_error "Expected object for InitializedNotification" j

     

       916
        
       

     

       917
        
           let create ?meta () = { meta }

     

       918
        
       

     

       919
        
           let to_jsonrpc t =

     

       920
       -
             let params =

     

       921
       -
               match yojson_of_t t with `Assoc [] -> None | json -> Some json

     

       0
        
       
     

       922
        
             in

     

       923
       -
             JSONRPCMessage.create_notification ~meth:Method.Initialized ~params ()

     

       924
        
         end

     

       925
        
       end

     

       926
        
       

     

       927
        
       (* Export the main interface for using the MCP protocol *)

     

       928
        
       

     

       929
       -
       let parse_message json = JSONRPCMessage.t_of_yojson json

     

       930
       -
       

     

       931
       -
       let create_notification ?(params = None) ~meth () =

     

       932
       -
         JSONRPCMessage.create_notification ~params ~meth ()

     

       933
       -
       

     

       934
       -
       let create_request ?(params = None) ?(progress_token = None) ~id ~meth () =

     

       935
       -
         JSONRPCMessage.create_request ~params ~progress_token ~id ~meth ()

     

       936
        
       

     

       0
        
       
     

       0
        
       
     

       937
        
       let create_response = JSONRPCMessage.create_response

     

       938
        
       let create_error = JSONRPCMessage.create_error

     

       939
        
       

     

       940
       -
       (* Content type constructors *)

     

       941
       -
       let make_text_content text = Text TextContent.{ text; annotations = None }

     

       942
       -
       

     

       943
       -
       let make_image_content data mime_type =

     

       944
       -
         Image ImageContent.{ data; mime_type; annotations = None }

     

       945
       -
       

     

       946
       -
       let make_audio_content data mime_type =

     

       947
       -
         Audio AudioContent.{ data; mime_type; annotations = None }

     

       948
       -
       

     

       949
       -
       let make_resource_text_content uri text mime_type =

     

       950
       -
         Resource

     

       951
       -
           EmbeddedResource.

     

       952
       -
             {

     

       953
       -
               resource = `Text TextResourceContents.{ uri; text; mime_type };

     

       954
       -
               annotations = None;

     

       955
       -
             }

     

       956
       -
       

     

       957
       -
       let make_resource_blob_content uri blob mime_type =

     

       958
       -
         Resource

     

       959
       -
           EmbeddedResource.

     

       960
       -
             {

     

       961
       -
               resource = `Blob BlobResourceContents.{ uri; blob; mime_type };

     

       962
       -
               annotations = None;

     

       963
       -
             }

···

       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
        
       
     

       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
        
       
     

       13
        
       end

     

       14
        
       

     

       15
        
       (* Common types *)

     
···

       17
        
       module Role = struct

     

       18
        
         type t = [ `User | `Assistant ]

     

       19
        
       

     

       20
       +
         let to_string = function

     

       21
       +
           | `User -> "user"

     

       22
       +
           | `Assistant -> "assistant"

     

       23
        
       

     

       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)

     

       0
        
       
     

       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

     
···

       44
        
         type t = string

     

       45
        
       

     

       46
        
         let yojson_of_t t = `String t

     

       0
        
       
     

       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 *)

     

       53
        
       

     

       54
        
       module Annotated = struct

     

       55
       +
         type t = {

     

       56
       +
           annotations: annotation option;

     

       57
       +
         }

     

       58
       +
         and annotation = {

     

       59
       +
           audience: Role.t list option;

     

       60
       +
           priority: float option;

     

       61
       +
         }

     

       62
        
       

     

       63
        
         let yojson_of_annotation { audience; priority } =

     

       64
        
           let assoc = [] in

     

       65
       +
           let assoc = match audience with

     

       66
       +
             | Some audience -> ("audience", `List (List.map Role.yojson_of_t audience)) :: assoc

     

       0
        
       
     

       0
        
       
     

       67
        
             | None -> assoc

     

       68
        
           in

     

       69
       +
           let assoc = match priority with

     

       0
        
       
     

       70
        
             | Some priority -> ("priority", `Float priority) :: assoc

     

       71
        
             | None -> assoc

     

       72
        
           in

     
···

       74
        
       

     

       75
        
         let annotation_of_yojson = function

     

       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))

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       87
        
       

     

       88
        
         let yojson_of_t { annotations } =

     

       89
        
           match annotations with

     

       90
       +
           | Some annotations -> `Assoc [ "annotations", yojson_of_annotation annotations ]

     

       0
        
       
     

       91
        
           | None -> `Assoc []

     

       92
        
       

     

       93
        
         let t_of_yojson = function

     

       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))

     

       0
        
       
     

       0
        
       
     

       98
        
       end

     

       99
        
       

     

       100
        
       (* Content types *)

     

       101
        
       

     

       102
        
       module TextContent = struct

     

       103
       +
         type t = {

     

       104
       +
           text: string;

     

       105
       +
           annotations: Annotated.annotation option;

     

       106
       +
         }

     

       107
        
       

     

       108
        
         let yojson_of_t { text; annotations } =

     

       109
       +
           let assoc = [

     

       110
       +
             ("text", `String text);

     

       111
       +
             ("type", `String "text");

     

       112
       +
           ] in

     

       113
       +
           let assoc = match annotations with

     

       114
       +
             | Some annotations -> ("annotations", Annotated.yojson_of_annotation annotations) :: assoc

     

       115
        
             | None -> assoc

     

       116
        
           in

     

       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

     

       135
        
         type t = {

     

       136
       +
           data: string;

     

       137
       +
           mime_type: string;

     

       138
       +
           annotations: Annotated.annotation option;

     

       139
        
         }

     

       140
        
       

     

       141
        
         let yojson_of_t { data; mime_type; annotations } =

     

       142
       +
           let assoc = [

     

       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

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       149
        
             | None -> assoc

     

       150
        
           in

     

       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

     

       173
        
         type t = {

     

       174
       +
           data: string;

     

       175
       +
           mime_type: string;

     

       176
       +
           annotations: Annotated.annotation option;

     

       177
        
         }

     

       178
        
       

     

       179
        
         let yojson_of_t { data; mime_type; annotations } =

     

       180
       +
           let assoc = [

     

       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

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       187
        
             | None -> assoc

     

       188
        
           in

     

       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

     

       211
       +
         type t = {

     

       212
       +
           uri: string;

     

       213
       +
           mime_type: string option;

     

       214
       +
         }

     

       215
        
       

     

       216
        
         let yojson_of_t { uri; mime_type } =

     

       217
       +
           let assoc = [

     

       218
       +
             ("uri", `String uri);

     

       219
       +
           ] in

     

       220
       +
           let assoc = match mime_type with

     

       221
        
             | Some mime_type -> ("mimeType", `String mime_type) :: assoc

     

       222
        
             | None -> assoc

     

       223
        
           in

     

       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

     

       241
       +
         type t = {

     

       242
       +
           uri: string;

     

       243
       +
           text: string;

     

       244
       +
           mime_type: string option;

     

       245
       +
         }

     

       246
        
       

     

       247
        
         let yojson_of_t { uri; text; mime_type } =

     

       248
       +
           let assoc = [

     

       249
       +
             ("uri", `String uri);

     

       250
       +
             ("text", `String text);

     

       251
       +
           ] in

     

       252
       +
           let assoc = match mime_type with

     

       253
        
             | Some mime_type -> ("mimeType", `String mime_type) :: assoc

     

       254
        
             | None -> assoc

     

       255
        
           in

     

       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

     

       277
       +
         type t = {

     

       278
       +
           uri: string;

     

       279
       +
           blob: string;

     

       280
       +
           mime_type: string option;

     

       281
       +
         }

     

       282
        
       

     

       283
        
         let yojson_of_t { uri; blob; mime_type } =

     

       284
       +
           let assoc = [

     

       285
       +
             ("uri", `String uri);

     

       286
       +
             ("blob", `String blob);

     

       287
       +
           ] in

     

       288
       +
           let assoc = match mime_type with

     

       289
        
             | Some mime_type -> ("mimeType", `String mime_type) :: assoc

     

       290
        
             | None -> assoc

     

       291
        
           in

     

       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

     

       313
        
         type t = {

     

       314
       +
           resource: [ `Text of TextResourceContents.t | `Blob of BlobResourceContents.t ];

     

       315
       +
           annotations: Annotated.annotation option;

     

       0
        
       
     

       316
        
         }

     

       317
        
       

     

       318
        
         let yojson_of_t { resource; annotations } =

     

       319
       +
           let resource_json = match resource with

     

       0
        
       
     

       320
        
             | `Text txt -> TextResourceContents.yojson_of_t txt

     

       321
        
             | `Blob blob -> BlobResourceContents.yojson_of_t blob

     

       322
        
           in

     

       323
       +
           let assoc = [

     

       324
       +
             ("resource", resource_json);

     

       325
       +
             ("type", `String "resource");

     

       326
       +
           ] in

     

       327
       +
           let assoc = match annotations with

     

       328
       +
             | Some annotations -> ("annotations", Annotated.yojson_of_annotation annotations) :: assoc

     

       329
        
             | None -> assoc

     

       330
        
           in

     

       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))

     

       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))

     

       0
        
       
     

       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 = 

     

       392
        
         | Text of TextContent.t

     

       393
        
         | Image of ImageContent.t

     

       394
        
         | Audio of AudioContent.t

     
···

       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
        
       

     

       773
        
       module PromptMessage = struct

     

       774
       +
         type t = {

     

       775
       +
           role: Role.t;

     

       776
       +
           content: content;

     

       777
       +
         }

     

       778
        
       

     

       779
        
         let yojson_of_t { role; content } =

     

       780
       +
           `Assoc [

     

       781
       +
             ("role", Role.yojson_of_t role);

     

       782
       +
             ("content", yojson_of_content content);

     

       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))

     

       0
        
       
     

       0
        
       
     

       797
        
       end

     

       798
        
       

     

       799
        
       module SamplingMessage = struct

     

       800
        
         type t = {

     

       801
       +
           role: Role.t;

     

       802
       +
           content: [ `Text of TextContent.t | `Image of ImageContent.t ];

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       803
        
         }

     

       804
        
       

     

       805
        
         let yojson_of_t { role; content } =

     

       806
       +
           let content_json = match content with

     

       0
        
       
     

       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);

     

       812
       +
             ("content", content_json);

     

       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))

     

       828
       +
             in

     

       829
       +
             { role; content }

     

       830
       +
           | j -> raise (Json.Of_json ("Expected object for SamplingMessage", j))

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       831
        
       end

     

       832
        
       

     

       833
        
       (* Implementation info *)

     

       834
        
       

     

       835
        
       module Implementation = struct

     

       836
       +
         type t = {

     

       837
       +
           name: string;

     

       838
       +
           version: string;

     

       839
       +
         }

     

       840
        
       

     

       841
        
         let yojson_of_t { name; version } =

     

       842
       +
           `Assoc [

     

       843
       +
             ("name", `String name);

     

       844
       +
             ("version", `String version);

     

       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
        
         }

     

       876
        
       

     

       877
       +
         type response = {

     

       878
       +
           id: RequestId.t;

     

       879
       +
           result: Json.t;

     

       880
       +
         }

     

       881
        
       

     

       882
        
         type error = {

     

       883
       +
           id: RequestId.t;

     

       884
       +
           code: int;

     

       885
       +
           message: string;

     

       886
       +
           data: Json.t option;

     

       887
        
         }

     

       888
        
       

     

       889
        
         type t =

     
···

       892
        
           | Response of response

     

       893
        
           | Error of error

     

       894
        
       

     

       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

     

       0
        
       
     

       0
        
       
     

       901
        
             | Some params -> ("params", params) :: assoc

     

       902
        
             | None -> assoc

     

       903
        
           in

     

       904
        
           `Assoc assoc

     

       905
        
       

     

       906
       +
         let yojson_of_request (r: request) =

     

       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

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       913
        
             | Some params ->

     

       914
       +
               let params_json = match params with

     

       915
       +
                 | `Assoc fields ->

     

       916
       +
                   let fields = match r.progress_token with

     

       917
       +
                     | Some token ->

     

       918
       +
                       let meta = `Assoc [ "progressToken", ProgressToken.yojson_of_t token ] in

     

       919
       +
                       ("_meta", meta) :: fields

     

       920
       +
                     | None -> fields

     

       921
       +
                   in

     

       922
       +
                   `Assoc fields

     

       923
       +
                 | _ -> params

     

       924
       +
               in

     

       925
       +
               ("params", params_json) :: assoc

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       926
        
             | None -> assoc

     

       927
        
           in

     

       928
        
           `Assoc assoc

     

       929
        
       

     

       930
       +
         let yojson_of_response (r: response) =

     

       931
       +
           `Assoc [

     

       932
       +
             ("jsonrpc", `String "2.0");

     

       933
       +
             ("id", Id.yojson_of_t r.id);

     

       934
       +
             ("result", r.result);

     

       935
       +
           ]

     

       0
        
       
     

       936
        
       

     

       937
       +
         let yojson_of_error (e: error) =

     

       938
       +
           let error_assoc = [

     

       939
       +
             ("code", `Int e.code);

     

       940
       +
             ("message", `String e.message);

     

       941
       +
           ] in

     

       942
       +
           let error_assoc = match e.data with

     

       943
        
             | Some data -> ("data", data) :: error_assoc

     

       944
        
             | None -> error_assoc

     

       945
        
           in

     

       946
       +
           `Assoc [

     

       947
       +
             ("jsonrpc", `String "2.0");

     

       948
       +
             ("id", Id.yojson_of_t e.id);

     

       949
       +
             ("error", `Assoc error_assoc);

     

       950
       +
           ]

     

       0
        
       
     

       951
        
       

     

       952
        
         let yojson_of_t = function

     

       953
        
           | Notification n -> yojson_of_notification n

     
···

       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))

     

       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))

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       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))

     

       977
       +
             in

     

       978
       +
             let params = List.assoc_opt "params" fields in

     

       979
       +
             let progress_token = 

     

       980
       +
               match params with

     

       981
       +
               | Some (`Assoc param_fields) -> 

     

       982
       +
                 (match List.assoc_opt "_meta" param_fields with

     

       983
       +
                  | Some (`Assoc meta_fields) -> 

     

       984
       +
                    (match List.assoc_opt "progressToken" meta_fields with

     

       985
       +
                     | Some token_json -> Some (ProgressToken.t_of_yojson token_json)

     

       986
       +
                     | None -> None)

     

       987
       +
                  | _ -> None)

     

       988
       +
               | _ -> None

     

       989
       +
             in

     

       990
       +
             { id; method_; params; progress_token }

     

       991
       +
           | j -> raise (Json.Of_json ("Expected object for request", j))

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       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))

     

       0
        
       
     

       0
        
       
     

       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))

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       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

     

       1037
       +
                 Request (request_of_yojson json)

     

       1038
       +
               else

     

       1039
       +
                 Notification (notification_of_yojson json)

     

       1040
       +
             else if List.mem_assoc "result" fields then

     

       1041
       +
               Response (response_of_yojson json)

     

       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 }

     

       1056
        
       

     

       1057
       +
         let create_error ~id ~code ~message ?(data=None) () =

     

       1058
        
           Error { id; code; message; data }

     

       1059
        
       end

     

       1060
        
       

     
···

       1063
        
       module Initialize = struct

     

       1064
        
         module Request = struct

     

       1065
        
           type t = {

     

       1066
       +
             capabilities: Json.t; (* ClientCapabilities *)

     

       1067
       +
             client_info: Implementation.t;

     

       1068
       +
             protocol_version: string;

     

       1069
        
           }

     

       1070
        
       

     

       1071
        
           let yojson_of_t { capabilities; client_info; protocol_version } =

     

       1072
       +
             `Assoc [

     

       1073
       +
               ("capabilities", capabilities);

     

       1074
       +
               ("clientInfo", Implementation.yojson_of_t client_info);

     

       1075
       +
               ("protocolVersion", `String protocol_version);

     

       1076
       +
             ]

     

       0
        
       
     

       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))

     

       0
        
       
     

       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) ()

     

       0
        
       
     

       1101
        
         end

     

       1102
        
       

     

       1103
        
         module Result = struct

     

       1104
        
           type t = {

     

       1105
       +
             capabilities: Json.t; (* ServerCapabilities *)

     

       1106
       +
             server_info: Implementation.t;

     

       1107
       +
             protocol_version: string;

     

       1108
       +
             instructions: string option;

     

       1109
       +
             meta: Json.t option;

     

       1110
        
           }

     

       1111
        
       

     

       1112
       +
           let yojson_of_t { capabilities; server_info; protocol_version; instructions; meta } =

     

       1113
       +
             let assoc = [

     

       1114
       +
               ("capabilities", capabilities);

     

       1115
       +
               ("serverInfo", Implementation.yojson_of_t server_info);

     

       1116
       +
               ("protocolVersion", `String protocol_version);

     

       1117
       +
             ] in

     

       1118
       +
             let assoc = match instructions with

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       1119
        
               | Some instr -> ("instructions", `String instr) :: assoc

     

       1120
        
               | None -> assoc

     

       1121
        
             in

     

       1122
       +
             let assoc = match meta with

     

       1123
       +
               | Some meta -> ("_meta", meta) :: assoc

     

       1124
       +
               | None -> assoc

     

       1125
        
             in

     

       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 () =

     

       0
        
       
     

       1151
        
             { capabilities; server_info; protocol_version; instructions; meta }

     

       1152
        
       

     

       1153
        
           let to_jsonrpc ~id t =

     
···

       1157
        
       

     

       1158
        
       module Initialized = struct

     

       1159
        
         module Notification = struct

     

       1160
       +
           type t = {

     

       1161
       +
             meta: Json.t option;

     

       1162
       +
           }

     

       1163
        
       

     

       1164
        
           let yojson_of_t { meta } =

     

       1165
        
             let assoc = [] in

     

       1166
       +
             let assoc = match meta with

     

       1167
       +
               | Some meta -> ("_meta", meta) :: assoc

     

       1168
       +
               | None -> assoc

     

       1169
        
             in

     

       1170
        
             `Assoc assoc

     

       1171
        
       

     

       1172
        
           let t_of_yojson = function

     

       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
        
       

     

       1180
        
           let to_jsonrpc t =

     

       1181
       +
             let params = match yojson_of_t t with

     

       1182
       +
               | `Assoc [] -> None

     

       1183
       +
               | json -> Some json

     

       1184
        
             in

     

       1185
       +
             JSONRPCMessage.create_notification ~method_:"notifications/initialized" ~params ()

     

       1186
        
         end

     

       1187
        
       end

     

       1188
        
       

     

       1189
        
       (* Export the main interface for using the MCP protocol *)

     

       1190
        
       

     

       1191
       +
       let parse_message json =

     

       1192
       +
         JSONRPCMessage.t_of_yojson json

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       1193
        
       

     

       1194
       +
       let create_notification = JSONRPCMessage.create_notification

     

       1195
       +
       let create_request = JSONRPCMessage.create_request

     

       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
        
       
     

       0
        
       
     

       0
        
       
     

       0

+231 -957

lib/mcp.mli

···

       1
       -
       (** MCP - Model Context Protocol implementation

     

       2
       -
       

     

       3
       -
           The Model Context Protocol (MCP) is a standardized protocol for AI agents to

     

       4
       -
           exchange context with servers. This module provides the core OCaml

     

       5
       -
           implementation of MCP including all message types, content representations,

     

       6
       -
           and serialization functionality.

     

       7
       -
       

     

       8
       -
           MCP Architecture:

     

       9
       -
           - Uses JSON-RPC 2.0 as its underlying message format with UTF-8 encoding

     

       10
       -
           - Follows a client-server model where clients (often LLM-integrated

     

       11
       -
             applications) communicate with MCP servers

     

       12
       -
           - Supports multiple transport methods including stdio and streamable HTTP

     

       13
       -
           - Implements a three-phase connection lifecycle: initialization, operation,

     

       14
       -
             and shutdown

     

       15
       -
           - Provides capability negotiation during initialization to determine

     

       16
       -
             available features

     

       17
       -
           - Offers four primary context exchange mechanisms: 1. Resources:

     

       18
       -
             Server-exposed data that provides context to language models 2. Tools:

     

       19
       -
             Server-exposed functionality that can be invoked by language models 3.

     

       20
       -
             Prompts: Server-defined templates for structuring interactions with models

     

       21
       -
             4. Sampling: Client-exposed ability to generate completions from LLMs

     

       22
       -
           - Supports multimodal content types: text, images, audio, and embedded

     

       23
       -
             resources

     

       24
       -
           - Includes standardized error handling with defined error codes

     

       25
       -
       

     

       26
       -
           This implementation follows Protocol Revision 2025-03-26. *)

     

       27
        
       

     

       28
        
       open Jsonrpc

     

       29
        
       

     

       30
       -
       (** Utility functions for JSON parsing *)

     

       31
       -
       module Util : sig

     

       32
       -
         val json_error : ('a, unit, string, 'b) format4 -> Json.t -> 'a

     

       33
       -
         (** Helper to raise a Json.Of_json exception with formatted message

     

       34
       -
             @param fmt Format string for the error message

     

       35
       -
             @param json JSON value to include in the exception

     

       36
       -
             @return Never returns, always raises an exception

     

       37
       -
             @raise Json.Of_json with the formatted message and JSON value *)

     

       38
       -
       

     

       39
       -
         val get_string_field : (string * Json.t) list -> string -> Json.t -> string

     

       40
       -
         (** Extract a string field from JSON object or raise an error

     

       41
       -
             @param fields Assoc list of fields from JSON object

     

       42
       -
             @param name Field name to extract

     

       43
       -
             @param json Original JSON for error context

     

       44
       -
             @return The string value of the field

     

       45
       -
             @raise Json.Of_json if the field is missing or not a string *)

     

       46
       -
       

     

       47
       -
         val get_optional_string_field :

     

       48
       -
           (string * Json.t) list -> string -> string option

     

       49
       -
         (** Extract an optional string field from JSON object

     

       50
       -
             @param fields Assoc list of fields from JSON object

     

       51
       -
             @param name Field name to extract

     

       52
       -
             @return Some string if present and a string, None if missing

     

       53
       -
             @raise Json.Of_json if the field exists but is not a string *)

     

       54
       -
       

     

       55
       -
         val get_int_field : (string * Json.t) list -> string -> Json.t -> int

     

       56
       -
         (** Extract an int field from JSON object or raise an error

     

       57
       -
             @param fields Assoc list of fields from JSON object

     

       58
       -
             @param name Field name to extract

     

       59
       -
             @param json Original JSON for error context

     

       60
       -
             @return The int value of the field

     

       61
       -
             @raise Json.Of_json if the field is missing or not an int *)

     

       62
       -
       

     

       63
       -
         val get_float_field : (string * Json.t) list -> string -> Json.t -> float

     

       64
       -
         (** Extract a float field from JSON object or raise an error

     

       65
       -
             @param fields Assoc list of fields from JSON object

     

       66
       -
             @param name Field name to extract

     

       67
       -
             @param json Original JSON for error context

     

       68
       -
             @return The float value of the field

     

       69
       -
             @raise Json.Of_json if the field is missing or not a float *)

     

       70
       -
       

     

       71
       -
         val get_bool_field : (string * Json.t) list -> string -> Json.t -> bool

     

       72
       -
         (** Extract a boolean field from JSON object or raise an error

     

       73
       -
             @param fields Assoc list of fields from JSON object

     

       74
       -
             @param name Field name to extract

     

       75
       -
             @param json Original JSON for error context

     

       76
       -
             @return The boolean value of the field

     

       77
       -
             @raise Json.Of_json if the field is missing or not a boolean *)

     

       78
       -
       

     

       79
       -
         val get_object_field :

     

       80
       -
           (string * Json.t) list -> string -> Json.t -> (string * Json.t) list

     

       81
       -
         (** Extract an object field from JSON object or raise an error

     

       82
       -
             @param fields Assoc list of fields from JSON object

     

       83
       -
             @param name Field name to extract

     

       84
       -
             @param json Original JSON for error context

     

       85
       -
             @return The object as an assoc list

     

       86
       -
             @raise Json.Of_json if the field is missing or not an object *)

     

       87
       -
       

     

       88
       -
         val get_list_field : (string * Json.t) list -> string -> Json.t -> Json.t list

     

       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 verify_string_field :

     

       97
       -
           (string * Json.t) list -> string -> string -> Json.t -> unit

     

       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
       -
       end

     

       106
       -
       

     

       107
       -
       (** Error codes for JSON-RPC *)

     

       108
        
       module ErrorCode : sig

     

       109
       -
         (** Standard JSON-RPC error codes with MCP-specific additions *)

     

       110
       -
         type t =

     

       111
       -
           | ParseError  (** -32700 - Invalid JSON *)

     

       112
       -
           | InvalidRequest  (** -32600 - Invalid JSON-RPC request *)

     

       113
       -
           | MethodNotFound  (** -32601 - Method not available *)

     

       114
       -
           | InvalidParams  (** -32602 - Invalid method parameters *)

     

       115
       -
           | InternalError  (** -32603 - Internal JSON-RPC error *)

     

       116
       -
           | ResourceNotFound

     

       117
       -
               (** -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
       -
         val to_int : t -> int

     

       122
       -
         (** Convert the error code to its integer representation

     

       123
       -
             @param code The error code to convert

     

       124
       -
             @return The integer error code as defined in the JSON-RPC spec *)

     

       125
       -
       

     

       126
       -
         val to_message : t -> string

     

       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
       -
       end

     

       131
       -
       

     

       132
       -
       (** MCP Protocol Methods - Algebraic data type representing all MCP methods *)

     

       133
       -
       module Method : sig

     

       134
       -
         (** Method type representing all MCP protocol methods *)

     

       135
       -
         type t =

     

       136
       -
           (* Initialization and lifecycle methods *)

     

       137
       -
           | Initialize  (** Start the MCP lifecycle *)

     

       138
       -
           | Initialized  (** Signal readiness after initialization *)

     

       139
       -
           (* Resource methods *)

     

       140
       -
           | ResourcesList  (** Discover available resources *)

     

       141
       -
           | ResourcesRead  (** Retrieve resource contents *)

     

       142
       -
           | ResourceTemplatesList  (** List available resource templates *)

     

       143
       -
           | ResourcesSubscribe  (** Subscribe to resource changes *)

     

       144
       -
           | ResourcesListChanged  (** Resource list has changed *)

     

       145
       -
           | ResourcesUpdated  (** Resource has been updated *)

     

       146
       -
           (* Tool methods *)

     

       147
       -
           | ToolsList  (** Discover available tools *)

     

       148
       -
           | ToolsCall  (** Invoke a tool *)

     

       149
       -
           | ToolsListChanged  (** Tool list has changed *)

     

       150
       -
           (* Prompt methods *)

     

       151
       -
           | PromptsList  (** Discover available prompts *)

     

       152
       -
           | PromptsGet  (** Retrieve a prompt template with arguments *)

     

       153
       -
           | PromptsListChanged  (** Prompt list has changed *)

     

       154
       -
           (* Progress notifications *)

     

       155
       -
           | Progress  (** Progress update for long-running operations *)

     

       156
       -
       

     

       157
       -
         val to_string : t -> string

     

       158
       -
         (** Convert method type to string representation

     

       159
       -
             @param meth The method to convert

     

       160
       -
             @return

     

       161
       -
               The string representation of the method (e.g., "initialize",

     

       162
       -
               "resources/list") *)

     

       163
       -
       

     

       164
       -
         val of_string : string -> t

     

       165
       -
         (** Convert string to method type

     

       166
       -
             @param s The string representation of the method

     

       167
       -
             @return The corresponding method type

     

       168
       -
             @raise Failure if the string is not a valid MCP method *)

     

       169
        
       end

     

       170
        
       

     

       171
        
       (** Common types *)

     
···

       173
        
       (** Roles for conversation participants *)

     

       174
        
       module Role : sig

     

       175
        
         type t = [ `User | `Assistant ]

     

       176
       -
         (** Role represents conversation participants in MCP messages. Roles can be

     

       177
       -
             either 'user' or 'assistant', determining the source of each message in a

     

       178
       -
             conversation. *)

     

       179
        
       

     

       180
       -
         include Json.Jsonable.S with type t := t

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       181
        
       end

     

       182
        
       

     

       183
        
       (** Progress tokens for long-running operations *)

     

       184
        
       module ProgressToken : sig

     

       185
        
         type t = [ `String of string | `Int of int ]

     

       186
       -
         (** Progress tokens identify long-running operations and enable servers to

     

       187
       -
             provide progress updates to clients. This is used to track operations that

     

       188
       -
             may take significant time to complete. *)

     

       189
        
       

     

       190
        
         include Json.Jsonable.S with type t := t

     

       191
        
       end

     
···

       193
        
       (** Request IDs *)

     

       194
        
       module RequestId : sig

     

       195
        
         type t = [ `String of string | `Int of int ]

     

       196
       -
         (** Request IDs uniquely identify JSON-RPC requests, allowing responses to be

     

       197
       -
             correlated with their originating requests. They can be either string or

     

       198
       -
             integer values. *)

     

       199
        
       

     

       200
        
         include Json.Jsonable.S with type t := t

     

       201
        
       end

     
···

       203
        
       (** Cursors for pagination *)

     

       204
        
       module Cursor : sig

     

       205
        
         type t = string

     

       206
       -
         (** Cursors enable pagination in list operations for resources, tools, and

     

       207
       -
             prompts. When a server has more items than can be returned in a single

     

       208
       -
             response, it provides a cursor for the client to retrieve subsequent

     

       209
       -
             pages. *)

     

       210
        
       

     

       211
       -
         include Json.Jsonable.S with type t := t

     

       0
        
       
     

       212
        
       end

     

       213
        
       

     

       214
        
       (** Annotations for objects *)

     

       215
        
       module Annotated : sig

     

       216
       -
         type t = { annotations : annotation option }

     

       217
       -
         (** Annotations provide metadata for content objects, allowing role-specific

     

       218
       -
             targeting and priority settings. *)

     

       219
       -
       

     

       220
        
         and annotation = {

     

       221
       -
           audience : Role.t list option;

     

       222
       -
               (** Optional list of roles that should receive this content *)

     

       223
       -
           priority : float option;  (** Optional priority value for this content *)

     

       224
        
         }

     

       225
        
       

     

       226
       -
         include Json.Jsonable.S with type t := t

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       227
        
       end

     

       228
        
       

     

       229
       -
       (** Text content - Core textual message representation in MCP *)

     

       230
        
       module TextContent : sig

     

       231
        
         type t = {

     

       232
       -
           text : string;  (** The actual text content as a UTF-8 encoded string *)

     

       233
       -
           annotations : Annotated.annotation option;

     

       234
       -
               (** Optional annotations for audience targeting and priority.

     

       235
       -
                   Annotations can restrict content visibility to specific roles

     

       236
       -
                   (user/assistant) and indicate relative importance of different

     

       237
       -
                   content elements. *)

     

       238
        
         }

     

       239
       -
         (** TextContent represents plain text messages in MCP conversations. This is

     

       240
       -
             the most common content type used for natural language interactions

     

       241
       -
             between users and assistants. Text content is used in prompts, tool

     

       242
       -
             results, and model responses.

     

       243
        
       

     

       244
       -
             In JSON-RPC, this is represented as:

     

       245
       -
             {v

     

       246
       -
             {

     

       247
       -
               "type": "text",

     

       248
       -
               "text": "The text content of the message"

     

       249
       -
             }

     

       250
       -
             v}

     

       251
       -
       

     

       252
       -
             For security, implementations must sanitize text content to prevent

     

       253
       -
             injection attacks or unauthorized access to resources. *)

     

       254
       -
       

     

       255
       -
         include Json.Jsonable.S with type t := t

     

       256
        
       end

     

       257
        
       

     

       258
       -
       (** Image content - Visual data representation in MCP *)

     

       259
        
       module ImageContent : sig

     

       260
        
         type t = {

     

       261
       -
           data : string;

     

       262
       -
               (** Base64-encoded image data. All binary image data must be encoded

     

       263
       -
                   using standard base64 encoding (RFC 4648) to safely transmit within

     

       264
       -
                   JSON. *)

     

       265
       -
           mime_type : string;

     

       266
       -
               (** MIME type of the image (e.g., "image/png", "image/jpeg",

     

       267
       -
                   "image/gif", "image/svg+xml"). This field is required and must

     

       268
       -
                   accurately represent the image format to ensure proper handling by

     

       269
       -
                   clients. *)

     

       270
       -
           annotations : Annotated.annotation option;

     

       271
       -
               (** Optional annotations for audience targeting and priority.

     

       272
       -
                   Annotations can restrict content visibility to specific roles

     

       273
       -
                   (user/assistant) and indicate relative importance of different

     

       274
       -
                   content elements. *)

     

       275
        
         }

     

       276
       -
         (** ImageContent enables including visual information in MCP messages,

     

       277
       -
             supporting multimodal interactions where visual context is important.

     

       278
        
       

     

       279
       -
             Images can be used in several scenarios:

     

       280
       -
             - As user inputs for visual understanding tasks

     

       281
       -
             - As context for generating descriptions or analysis

     

       282
       -
             - As outputs from tools that generate visualizations

     

       283
       -
             - As part of prompt templates with visual components

     

       284
       -
       

     

       285
       -
             In JSON-RPC, this is represented as:

     

       286
       -
             {v

     

       287
       -
             {

     

       288
       -
               "type": "image",

     

       289
       -
               "data": "base64-encoded-image-data",

     

       290
       -
               "mimeType": "image/png"

     

       291
       -
             }

     

       292
       -
             v}

     

       293
       -
       

     

       294
       -
             The data MUST be base64-encoded to ensure safe transmission in JSON.

     

       295
       -
             Common mime types include image/png, image/jpeg, image/gif, and

     

       296
       -
             image/svg+xml. *)

     

       297
       -
       

     

       298
       -
         include Json.Jsonable.S with type t := t

     

       299
        
       end

     

       300
        
       

     

       301
       -
       (** Audio content - Sound data representation in MCP *)

     

       302
        
       module AudioContent : sig

     

       303
        
         type t = {

     

       304
       -
           data : string;

     

       305
       -
               (** Base64-encoded audio data. All binary audio data must be encoded

     

       306
       -
                   using standard base64 encoding (RFC 4648) to safely transmit within

     

       307
       -
                   JSON. *)

     

       308
       -
           mime_type : string;

     

       309
       -
               (** MIME type of the audio (e.g., "audio/wav", "audio/mp3", "audio/ogg",

     

       310
       -
                   "audio/mpeg"). This field is required and must accurately represent

     

       311
       -
                   the audio format to ensure proper handling by clients. *)

     

       312
       -
           annotations : Annotated.annotation option;

     

       313
       -
               (** Optional annotations for audience targeting and priority.

     

       314
       -
                   Annotations can restrict content visibility to specific roles

     

       315
       -
                   (user/assistant) and indicate relative importance of different

     

       316
       -
                   content elements. *)

     

       317
        
         }

     

       318
       -
         (** AudioContent enables including audio information in MCP messages,

     

       319
       -
             supporting multimodal interactions where audio context is important.

     

       320
        
       

     

       321
       -
             Audio can be used in several scenarios:

     

       322
       -
             - As user inputs for speech recognition or audio analysis

     

       323
       -
             - As context for transcription or sound classification tasks

     

       324
       -
             - As outputs from tools that generate audio samples

     

       325
       -
             - As part of prompt templates with audio components

     

       326
       -
       

     

       327
       -
             In JSON-RPC, this is represented as:

     

       328
       -
             {v

     

       329
       -
             {

     

       330
       -
               "type": "audio",

     

       331
       -
               "data": "base64-encoded-audio-data",

     

       332
       -
               "mimeType": "audio/wav"

     

       333
       -
             }

     

       334
       -
             v}

     

       335
       -
       

     

       336
       -
             The data MUST be base64-encoded to ensure safe transmission in JSON.

     

       337
       -
             Common mime types include audio/wav, audio/mp3, audio/ogg, and audio/mpeg.

     

       338
       -
         *)

     

       339
       -
       

     

       340
       -
         include Json.Jsonable.S with type t := t

     

       341
        
       end

     

       342
        
       

     

       343
       -
       (** Base resource contents - Core resource metadata in MCP *)

     

       344
        
       module ResourceContents : sig

     

       345
        
         type t = {

     

       346
       -
           uri : string;

     

       347
       -
               (** URI that uniquely identifies the resource.

     

       348
       -
       

     

       349
       -
                   Resources use standard URI schemes including:

     

       350
       -
                   - file:// - For filesystem-like resources

     

       351
       -
                   - https:// - For web-accessible resources

     

       352
       -
                   - git:// - For version control integration

     

       353
       -
       

     

       354
       -
                   The URI serves as a stable identifier even if the underlying content

     

       355
       -
                   changes. *)

     

       356
       -
           mime_type : string option;

     

       357
       -
               (** Optional MIME type of the resource content to aid in client

     

       358
       -
                   rendering. Common MIME types include text/plain, application/json,

     

       359
       -
                   image/png, etc. For directories, the XDG MIME type inode/directory

     

       360
       -
                   may be used. *)

     

       361
        
         }

     

       362
       -
         (** ResourceContents provides basic metadata for resources in MCP.

     

       363
        
       

     

       364
       -
             Resources are server-exposed data that provides context to language

     

       365
       -
             models, such as files, database schemas, or application-specific

     

       366
       -
             information. Each resource is uniquely identified by a URI.

     

       367
       -
       

     

       368
       -
             The MCP resources architecture is designed to be application-driven, with

     

       369
       -
             host applications determining how to incorporate context based on their

     

       370
       -
             needs.

     

       371
       -
       

     

       372
       -
             In the protocol, resources are discovered via the 'resources/list'

     

       373
       -
             endpoint and retrieved via the 'resources/read' endpoint. Servers that

     

       374
       -
             support resources must declare the 'resources' capability during

     

       375
       -
             initialization. *)

     

       376
       -
       

     

       377
       -
         include Json.Jsonable.S with type t := t

     

       378
        
       end

     

       379
        
       

     

       380
       -
       (** Text resource contents - Textual resource data *)

     

       381
        
       module TextResourceContents : sig

     

       382
        
         type t = {

     

       383
       -
           uri : string;

     

       384
       -
               (** URI that uniquely identifies the resource. This URI can be

     

       385
       -
                   referenced in subsequent requests to fetch updates. *)

     

       386
       -
           text : string;

     

       387
       -
               (** The actual text content of the resource as a UTF-8 encoded string.

     

       388
       -
                   This may be sanitized by the server to remove sensitive information.

     

       389
       -
               *)

     

       390
       -
           mime_type : string option;

     

       391
       -
               (** Optional MIME type of the text content to aid in client rendering.

     

       392
       -
                   Common text MIME types include: text/plain, text/markdown,

     

       393
       -
                   text/x-python, application/json, text/html, text/csv, etc. *)

     

       394
        
         }

     

       395
       -
         (** TextResourceContents represents a text-based resource in MCP.

     

       396
        
       

     

       397
       -
             Text resources are used for sharing code snippets, documentation, logs,

     

       398
       -
             configuration files, and other textual information with language models.

     

       399
       -
       

     

       400
       -
             The server handles access control and security, ensuring that only

     

       401
       -
             authorized resources are shared with clients.

     

       402
       -
       

     

       403
       -
             In JSON-RPC, this is represented as:

     

       404
       -
             {v

     

       405
       -
             {

     

       406
       -
               "uri": "file:///example.txt",

     

       407
       -
               "mimeType": "text/plain",

     

       408
       -
               "text": "Resource content"

     

       409
       -
             }

     

       410
       -
             v} *)

     

       411
       -
       

     

       412
       -
         include Json.Jsonable.S with type t := t

     

       413
        
       end

     

       414
        
       

     

       415
       -
       (** Binary resource contents - Binary resource data *)

     

       416
        
       module BlobResourceContents : sig

     

       417
        
         type t = {

     

       418
       -
           uri : string;

     

       419
       -
               (** URI that uniquely identifies the resource. This URI can be

     

       420
       -
                   referenced in subsequent requests to fetch updates. *)

     

       421
       -
           blob : string;

     

       422
       -
               (** Base64-encoded binary data using standard base64 encoding (RFC

     

       423
       -
                   4648). This encoding ensures that binary data can be safely

     

       424
       -
                   transmitted in JSON. *)

     

       425
       -
           mime_type : string option;

     

       426
       -
               (** Optional MIME type of the binary content to aid in client rendering.

     

       427
       -
                   Common binary MIME types include: image/png, image/jpeg,

     

       428
       -
                   application/pdf, audio/wav, video/mp4, application/octet-stream,

     

       429
       -
                   etc. *)

     

       430
        
         }

     

       431
       -
         (** BlobResourceContents represents a binary resource in MCP.

     

       432
        
       

     

       433
       -
             Binary resources allow sharing non-textual data like images, audio files,

     

       434
       -
             PDFs, and other binary formats with language models that support

     

       435
       -
             processing such content.

     

       436
       -
       

     

       437
       -
             In JSON-RPC, this is represented as:

     

       438
       -
             {v

     

       439
       -
             {

     

       440
       -
               "uri": "file:///example.png",

     

       441
       -
               "mimeType": "image/png",

     

       442
       -
               "blob": "base64-encoded-data"

     

       443
       -
             }

     

       444
       -
             v}

     

       445
       -
       

     

       446
       -
             Binary data MUST be properly base64-encoded to ensure safe transmission in

     

       447
       -
             JSON payloads. *)

     

       448
       -
       

     

       449
       -
         include Json.Jsonable.S with type t := t

     

       450
        
       end

     

       451
        
       

     

       452
       -
       (** Embedded resource - Resource included directly in messages *)

     

       453
        
       module EmbeddedResource : sig

     

       454
        
         type t = {

     

       455
       -
           resource :

     

       456
       -
             [ `Text of TextResourceContents.t | `Blob of BlobResourceContents.t ];

     

       457
       -
               (** The resource content, either as text or binary blob. *)

     

       458
       -
           annotations : Annotated.annotation option;

     

       459
       -
               (** Optional annotations for audience targeting and priority.

     

       460
       -
                   Annotations can restrict resource visibility to specific roles

     

       461
       -
                   (user/assistant) and indicate relative importance of different

     

       462
       -
                   content elements. *)

     

       463
        
         }

     

       464
       -
         (** EmbeddedResource allows referencing server-side resources directly in MCP

     

       465
       -
             messages, enabling seamless incorporation of managed content.

     

       466
        
       

     

       467
       -
             Embedded resources can be included in:

     

       468
       -
             - Tool results to provide rich context

     

       469
       -
             - Prompt templates to include reference materials

     

       470
       -
             - Messages to provide additional context to language models

     

       471
       -
       

     

       472
       -
             In contrast to direct content (TextContent, ImageContent, AudioContent),

     

       473
       -
             embedded resources have the advantage of being persistently stored on the

     

       474
       -
             server with a stable URI, allowing later retrieval and updates through the

     

       475
       -
             resources API.

     

       476
       -
       

     

       477
       -
             For example, a tool might return an embedded resource containing a chart

     

       478
       -
             or a large dataset that the client can later reference or update. *)

     

       479
       -
       

     

       480
       -
         include Json.Jsonable.S with type t := t

     

       481
        
       end

     

       482
        
       

     

       483
       -
       (** Content type used in messages - Unified multimodal content representation in

     

       484
       -
           MCP *)

     

       485
       -
       type content =

     

       486
        
         | Text of TextContent.t

     

       487
       -
             (** Text content for natural language messages. This is the most common

     

       488
       -
                 content type for user-assistant interactions. *)

     

       489
        
         | Image of ImageContent.t

     

       490
       -
             (** Image content for visual data. Used for sharing visual context in

     

       491
       -
                 multimodal conversations. *)

     

       492
        
         | Audio of AudioContent.t

     

       493
       -
             (** Audio content for audio data. Used for sharing audio context in

     

       494
       -
                 multimodal conversations. *)

     

       495
        
         | Resource of EmbeddedResource.t

     

       496
       -
             (** Resource content for referencing server-side resources. Used for

     

       497
       -
                 incorporating managed server content with stable URIs. *)

     

       498
        
       

     

       499
        
       val yojson_of_content : content -> Json.t

     

       500
       -
       (** Convert content to Yojson representation

     

       501
       -
           @param content The content to convert

     

       502
       -
           @return JSON representation of the content *)

     

       503
       -
       

     

       504
        
       val content_of_yojson : Json.t -> content

     

       505
       -
       (** Convert Yojson representation to content

     

       506
       -
           @param json JSON representation of content

     

       507
       -
           @return Parsed content object *)

     

       508
        
       

     

       509
       -
       (** Message for prompts - Template messages in the MCP prompts feature *)

     

       510
        
       module PromptMessage : sig

     

       511
        
         type t = {

     

       512
       -
           role : Role.t;

     

       513
       -
               (** The role of the message sender (user or assistant). Prompt templates

     

       514
       -
                   typically alternate between user and assistant messages to create a

     

       515
       -
                   conversation structure. *)

     

       516
       -
           content : content;

     

       517
       -
               (** The message content, which can be text, image, audio, or resource.

     

       518
       -
                   This unified content type supports rich multimodal prompts. *)

     

       519
        
         }

     

       520
       -
         (** PromptMessage represents a message in an MCP prompt template, containing a

     

       521
       -
             role and content which can be customized with arguments.

     

       522
       -
       

     

       523
       -
             Prompt messages are part of prompt templates exposed by servers through

     

       524
       -
             the prompts/get endpoint. They define structured conversation templates

     

       525
       -
             that can be instantiated with user-provided arguments.

     

       526
        
       

     

       527
       -
             The prompt feature is designed to be user-controlled, with prompts

     

       528
       -
             typically exposed through UI elements like slash commands that users can

     

       529
       -
             explicitly select.

     

       530
       -
       

     

       531
       -
             In JSON-RPC, prompt messages are represented as:

     

       532
       -
             {v

     

       533
       -
             {

     

       534
       -
               "role": "user",

     

       535
       -
               "content": {

     

       536
       -
                 "type": "text",

     

       537
       -
                 "text": "Please review this code: ${code}"

     

       538
       -
               }

     

       539
       -
             }

     

       540
       -
             v}

     

       541
       -
       

     

       542
       -
             Where $code would be replaced with a user-provided argument. *)

     

       543
       -
       

     

       544
       -
         include Json.Jsonable.S with type t := t

     

       545
        
       end

     

       546
        
       

     

       547
       -
       (** Message for sampling - Messages used in LLM completion requests *)

     

       548
        
       module SamplingMessage : sig

     

       549
        
         type t = {

     

       550
       -
           role : Role.t;

     

       551
       -
               (** The role of the message sender (user or assistant). Typically, a

     

       552
       -
                   sampling request will contain multiple messages representing a

     

       553
       -
                   conversation history, with alternating roles. *)

     

       554
       -
           content :

     

       555
       -
             [ `Text of TextContent.t

     

       556
       -
             | `Image of ImageContent.t

     

       557
       -
             | `Audio of AudioContent.t ];

     

       558
       -
               (** The message content, restricted to text, image, or audio (no

     

       559
       -
                   resources). Resources are not included since sampling messages

     

       560
       -
                   represent the actual context window for the LLM, not template

     

       561
       -
                   definitions. *)

     

       562
        
         }

     

       563
       -
         (** SamplingMessage represents a message in an MCP sampling request, used for

     

       564
       -
             AI model generation based on a prompt.

     

       565
        
       

     

       566
       -
             The sampling feature allows clients to expose language model capabilities

     

       567
       -
             to servers, enabling servers to request completions from the client's LLM.

     

       568
       -
             This is effectively the reverse of the normal MCP flow, with the server

     

       569
       -
             requesting generative capabilities from the client.

     

       570
       -
       

     

       571
       -
             Sampling messages differ from prompt messages in that they don't support

     

       572
       -
             embedded resources, as they represent the actual context window being sent

     

       573
       -
             to the LLM rather than template definitions.

     

       574
       -
       

     

       575
       -
             Clients that support sampling must declare the 'sampling' capability

     

       576
       -
             during initialization. *)

     

       577
       -
       

     

       578
       -
         include Json.Jsonable.S with type t := t

     

       579
        
       end

     

       580
        
       

     

       581
        
       (** Implementation information *)

     

       582
        
       module Implementation : sig

     

       583
        
         type t = {

     

       584
       -
           name : string;  (** Name of the implementation *)

     

       585
       -
           version : string;  (** Version of the implementation *)

     

       586
        
         }

     

       587
       -
         (** Implementation provides metadata about client and server implementations,

     

       588
       -
             used during the initialization phase to identify each party. *)

     

       589
        
       

     

       590
       -
         include Json.Jsonable.S with type t := t

     

       0
        
       
     

       591
        
       end

     

       592
        
       

     

       593
       -
       (** JSONRPC message types - Core message protocol for MCP

     

       594
       -
       

     

       595
       -
           MCP uses JSON-RPC 2.0 as its underlying messaging protocol. All MCP messages

     

       596
       -
           are encoded as JSON-RPC 2.0 messages with UTF-8 encoding, following the

     

       597
       -
           standard JSON-RPC message formats with some MCP-specific extensions.

     

       598
       -
       

     

       599
       -
           MCP defines four message types: 1. Notifications: One-way messages that

     

       600
       -
           don't expect a response 2. Requests: Messages that expect a corresponding

     

       601
       -
           response 3. Responses: Replies to requests with successful results 4.

     

       602
       -
           Errors: Replies to requests with error information

     

       603
       -
       

     

       604
       -
           These can be transported over multiple transport mechanisms:

     

       605
       -
           - stdio: Communication over standard input/output

     

       606
       -
           - Streamable HTTP: HTTP POST/GET with SSE for server streaming

     

       607
       -
           - Custom transports: Implementation-specific transports

     

       608
       -
       

     

       609
       -
           Messages may be sent individually or as part of a JSON-RPC batch. *)

     

       610
        
       module JSONRPCMessage : sig

     

       611
        
         type notification = {

     

       612
       -
           meth : Method.t;

     

       613
       -
               (** Method for the notification, using the Method.t type to ensure type

     

       614
       -
                   safety. Examples: Method.Initialized, Method.ResourcesUpdated *)

     

       615
       -
           params : Json.t option;

     

       616
       -
               (** Optional parameters for the notification as arbitrary JSON. The

     

       617
       -
                   structure depends on the specific notification method. *)

     

       618
        
         }

     

       619
       -
         (** Notification represents a JSON-RPC notification (one-way message without a

     

       620
       -
             response).

     

       621
       -
       

     

       622
       -
             Notifications are used for events that don't require a response, such as:

     

       623
       -
             - The 'initialized' notification completing initialization

     

       624
       -
             - Resource change notifications

     

       625
       -
             - Progress updates for long-running operations

     

       626
       -
             - List changed notifications for tools, resources, and prompts

     

       627
       -
       

     

       628
       -
             In JSON-RPC, notifications are identified by the absence of an 'id' field:

     

       629
       -
             {v

     

       630
       -
             {

     

       631
       -
               "jsonrpc": "2.0",

     

       632
       -
               "method": "notifications/resources/updated",

     

       633
       -
               "params": {

     

       634
       -
                 "uri": "file:///project/src/main.rs"

     

       635
       -
               }

     

       636
       -
             }

     

       637
       -
             v} *)

     

       638
        
       

     

       639
        
         type request = {

     

       640
       -
           id : RequestId.t;

     

       641
       -
               (** Unique identifier for the request, which will be echoed in the

     

       642
       -
                   response. This can be a string or integer and should be unique

     

       643
       -
                   within the session. *)

     

       644
       -
           meth : Method.t;

     

       645
       -
               (** Method for the request, using the Method.t type to ensure type

     

       646
       -
                   safety. Examples: Method.Initialize, Method.ResourcesRead,

     

       647
       -
                   Method.ToolsCall *)

     

       648
       -
           params : Json.t option;

     

       649
       -
               (** Optional parameters for the request as arbitrary JSON. The structure

     

       650
       -
                   depends on the specific request method. *)

     

       651
       -
           progress_token : ProgressToken.t option;

     

       652
       -
               (** Optional progress token for long-running operations. If provided,

     

       653
       -
                   the server can send progress notifications using this token to

     

       654
       -
                   inform the client about the operation's status. *)

     

       655
        
         }

     

       656
       -
         (** Request represents a JSON-RPC request that expects a response.

     

       657
       -
       

     

       658
       -
             Requests are used for operations that require a response, such as:

     

       659
       -
             - Initialization

     

       660
       -
             - Listing resources, tools, or prompts

     

       661
       -
             - Reading resources

     

       662
       -
             - Calling tools

     

       663
       -
             - Getting prompts

     

       664
       -
       

     

       665
       -
             In JSON-RPC, requests include an 'id' field that correlates with the

     

       666
       -
             response:

     

       667
       -
             {v

     

       668
       -
             {

     

       669
       -
               "jsonrpc": "2.0",

     

       670
       -
               "id": 1,

     

       671
       -
               "method": "resources/read",

     

       672
       -
               "params": {

     

       673
       -
                 "uri": "file:///project/src/main.rs"

     

       674
       -
               }

     

       675
       -
             }

     

       676
       -
             v} *)

     

       677
        
       

     

       678
        
         type response = {

     

       679
       -
           id : RequestId.t;

     

       680
       -
               (** ID matching the original request, allowing clients to correlate

     

       681
       -
                   responses with their originating requests, especially important when

     

       682
       -
                   multiple requests are in flight. *)

     

       683
       -
           result : Json.t;

     

       684
       -
               (** Result of the successful request as arbitrary JSON. The structure

     

       685
       -
                   depends on the specific request method that was called. *)

     

       686
        
         }

     

       687
       -
         (** Response represents a successful JSON-RPC response to a request.

     

       688
       -
       

     

       689
       -
             Responses are sent in reply to requests and contain the successful result.

     

       690
       -
             Each response must include the same ID as its corresponding request.

     

       691
       -
       

     

       692
       -
             In JSON-RPC, responses include the 'id' field matching the request:

     

       693
       -
             {v

     

       694
       -
             {

     

       695
       -
               "jsonrpc": "2.0",

     

       696
       -
               "id": 1,

     

       697
       -
               "result": {

     

       698
       -
                 "contents": [

     

       699
       -
                   {

     

       700
       -
                     "uri": "file:///project/src/main.rs",

     

       701
       -
                     "mimeType": "text/x-rust",

     

       702
       -
                     "text": "fn main() {\n    println!(\"Hello world!\");\n}"

     

       703
       -
                   }

     

       704
       -
                 ]

     

       705
       -
               }

     

       706
       -
             }

     

       707
       -
             v} *)

     

       708
        
       

     

       709
        
         type error = {

     

       710
       -
           id : RequestId.t;

     

       711
       -
               (** ID matching the original request, allowing clients to correlate

     

       712
       -
                   errors with their originating requests. *)

     

       713
       -
           code : int;

     

       714
       -
               (** Error code indicating the type of error, following the JSON-RPC

     

       715
       -
                   standard. Common codes include:

     

       716
       -
                   - -32700: Parse error

     

       717
       -
                   - -32600: Invalid request

     

       718
       -
                   - -32601: Method not found

     

       719
       -
                   - -32602: Invalid params

     

       720
       -
                   - -32603: Internal error

     

       721
       -
                   - -32002: Resource not found (MCP-specific)

     

       722
       -
                   - -32001: Authentication required (MCP-specific) *)

     

       723
       -
           message : string;

     

       724
       -
               (** Human-readable error message describing the issue. This should be

     

       725
       -
                   concise but informative enough for debugging. *)

     

       726
       -
           data : Json.t option;

     

       727
       -
               (** Optional additional error data as arbitrary JSON. This can provide

     

       728
       -
                   more context about the error, such as which resource wasn't found or

     

       729
       -
                   which parameter was invalid. *)

     

       730
        
         }

     

       731
       -
         (** Error represents an error response to a JSON-RPC request.

     

       732
        
       

     

       733
       -
             Errors are sent in reply to requests when processing fails. Each error

     

       734
       -
             must include the same ID as its corresponding request.

     

       735
       -
       

     

       736
       -
             MCP defines several standard error codes:

     

       737
       -
             - Standard JSON-RPC errors (-32700 to -32603)

     

       738
       -
             - MCP-specific errors (-32002 for resource not found, etc.)

     

       739
       -
       

     

       740
       -
             In JSON-RPC, errors follow this structure:

     

       741
       -
             {v

     

       742
       -
             {

     

       743
       -
               "jsonrpc": "2.0",

     

       744
       -
               "id": 1,

     

       745
       -
               "error": {

     

       746
       -
                 "code": -32002,

     

       747
       -
                 "message": "Resource not found",

     

       748
       -
                 "data": {

     

       749
       -
                   "uri": "file:///nonexistent.txt"

     

       750
       -
                 }

     

       751
       -
               }

     

       752
       -
             }

     

       753
       -
             v} *)

     

       754
       -
       

     

       755
       -
         (** Union type for all JSON-RPC message kinds, providing a single type that

     

       756
       -
             can represent any MCP message. *)

     

       757
        
         type t =

     

       758
        
           | Notification of notification

     

       759
        
           | Request of request

     
···

       761
        
           | Error of error

     

       762
        
       

     

       763
        
         val yojson_of_notification : notification -> Json.t

     

       764
       -
         (** Convert notification to Yojson representation

     

       765
       -
             @param notification The notification to convert

     

       766
       -
             @return JSON representation of the notification *)

     

       767
       -
       

     

       768
        
         val yojson_of_request : request -> Json.t

     

       769
       -
         (** Convert request to Yojson representation

     

       770
       -
             @param request The request to convert

     

       771
       -
             @return JSON representation of the request *)

     

       772
       -
       

     

       773
        
         val yojson_of_response : response -> Json.t

     

       774
       -
         (** Convert response to Yojson representation

     

       775
       -
             @param response The response to convert

     

       776
       -
             @return JSON representation of the response *)

     

       777
       -
       

     

       778
        
         val yojson_of_error : error -> Json.t

     

       779
       -
         (** Convert error to Yojson representation

     

       780
       -
             @param error The error to convert

     

       781
       -
             @return JSON representation of the error *)

     

       782
       -
       

     

       783
        
         val yojson_of_t : t -> Json.t

     

       784
       -
         (** Convert any message to Yojson representation

     

       785
       -
             @param message The message to convert

     

       786
       -
             @return JSON representation of the message *)

     

       787
        
       

     

       788
        
         val notification_of_yojson : Json.t -> notification

     

       789
       -
         (** Convert Yojson representation to notification

     

       790
       -
             @param json JSON representation of a notification

     

       791
       -
             @return Parsed notification object

     

       792
       -
             @raise Parse error if the JSON is not a valid notification *)

     

       793
       -
       

     

       794
        
         val request_of_yojson : Json.t -> request

     

       795
       -
         (** Convert Yojson representation to request

     

       796
       -
             @param json JSON representation of a request

     

       797
       -
             @return Parsed request object

     

       798
       -
             @raise Parse error if the JSON is not a valid request *)

     

       799
       -
       

     

       800
        
         val response_of_yojson : Json.t -> response

     

       801
       -
         (** Convert Yojson representation to response

     

       802
       -
             @param json JSON representation of a response

     

       803
       -
             @return Parsed response object

     

       804
       -
             @raise Parse error if the JSON is not a valid response *)

     

       805
       -
       

     

       806
        
         val error_of_yojson : Json.t -> error

     

       807
       -
         (** Convert Yojson representation to error

     

       808
       -
             @param json JSON representation of an error

     

       809
       -
             @return Parsed error object

     

       810
       -
             @raise Parse error if the JSON is not a valid error *)

     

       811
       -
       

     

       812
        
         val t_of_yojson : Json.t -> t

     

       813
       -
         (** Convert Yojson representation to any message

     

       814
       -
             @param json JSON representation of any message type

     

       815
       -
             @return Parsed message object

     

       816
       -
             @raise Parse error if the JSON is not a valid message *)

     

       817
        
       

     

       818
       -
         val create_notification : ?params:Json.t option -> meth:Method.t -> unit -> t

     

       819
       -
         (** Create a new notification message

     

       820
       -
             @param params Optional parameters for the notification

     

       821
       -
             @param meth Method name for the notification

     

       822
       -
             @return A new JSON-RPC notification message *)

     

       823
       -
       

     

       824
       -
         val create_request :

     

       825
       -
           ?params:Json.t option ->

     

       826
       -
           ?progress_token:ProgressToken.t option ->

     

       827
       -
           id:RequestId.t ->

     

       828
       -
           meth:Method.t ->

     

       829
       -
           unit ->

     

       830
       -
           t

     

       831
       -
         (** Create a new request message

     

       832
       -
             @param params Optional parameters for the request

     

       833
       -
             @param progress_token Optional progress token for long-running operations

     

       834
       -
             @param id Unique identifier for the request

     

       835
       -
             @param meth Method name for the request

     

       836
       -
             @return A new JSON-RPC request message *)

     

       837
       -
       

     

       838
        
         val create_response : id:RequestId.t -> result:Json.t -> t

     

       839
       -
         (** Create a new response message

     

       840
       -
             @param id ID matching the original request

     

       841
       -
             @param result Result of the successful request

     

       842
       -
             @return A new JSON-RPC response message *)

     

       843
       -
       

     

       844
       -
         val create_error :

     

       845
       -
           id:RequestId.t ->

     

       846
       -
           code:int ->

     

       847
       -
           message:string ->

     

       848
       -
           ?data:Json.t option ->

     

       849
       -
           unit ->

     

       850
       -
           t

     

       851
       -
         (** Create a new error message

     

       852
       -
             @param id ID matching the original request

     

       853
       -
             @param code Error code indicating the type of error

     

       854
       -
             @param message Human-readable error message

     

       855
       -
             @param data Optional additional error data

     

       856
       -
             @return A new JSON-RPC error message *)

     

       857
        
       end

     

       858
        
       

     

       859
       -
       (** Initialize request/response - The first phase of the MCP lifecycle

     

       860
       -
       

     

       861
       -
           The initialization phase is the mandatory first interaction between client

     

       862
       -
           and server. During this phase, the protocol version is negotiated and

     

       863
       -
           capabilities are exchanged to determine which optional features will be

     

       864
       -
           available during the session.

     

       865
       -
       

     

       866
       -
           This follows a strict sequence: 1. Client sends an InitializeRequest

     

       867
       -
           containing its capabilities and protocol version 2. Server responds with an

     

       868
       -
           InitializeResult containing its capabilities and protocol version 3. Client

     

       869
       -
           sends an InitializedNotification to signal it's ready for normal operations

     

       870
       -
       

     

       871
       -
           The Initialize module handles steps 1 and 2 of this process. *)

     

       872
        
       module Initialize : sig

     

       873
        
         (** Initialize request *)

     

       874
        
         module Request : sig

     

       875
        
           type t = {

     

       876
       -
             capabilities : Json.t;

     

       877
       -
                 (** ClientCapabilities that define supported optional features. This

     

       878
       -
                     includes which optional protocol features the client supports,

     

       879
       -
                     such as 'roots' (filesystem access), 'sampling' (LLM generation),

     

       880
       -
                     and any experimental features. *)

     

       881
       -
             client_info : Implementation.t;

     

       882
       -
                 (** Client implementation details (name and version) used for

     

       883
       -
                     identification and debugging. Helps servers understand which

     

       884
       -
                     client they're working with. *)

     

       885
       -
             protocol_version : string;

     

       886
       -
                 (** MCP protocol version supported by the client, formatted as

     

       887
       -
                     YYYY-MM-DD according to the MCP versioning scheme. Example:

     

       888
       -
                     "2025-03-26" *)

     

       889
        
           }

     

       890
       -
           (** InitializeRequest starts the MCP lifecycle, negotiating capabilities and

     

       891
       -
               protocol versions between client and server. This is always the first

     

       892
       -
               message sent by the client and MUST NOT be part of a JSON-RPC batch.

     

       893
        
       

     

       894
       -
               The client SHOULD send the latest protocol version it supports. If the

     

       895
       -
               server does not support this version, it will respond with a version it

     

       896
       -
               does support, and the client must either use that version or disconnect.

     

       897
       -
           *)

     

       898
       -
       

     

       899
       -
           include Json.Jsonable.S with type t := t

     

       900
       -
       

     

       901
       -
           val create :

     

       902
       -
             capabilities:Json.t ->

     

       903
       -
             client_info:Implementation.t ->

     

       904
       -
             protocol_version:string ->

     

       905
       -
             t

     

       906
       -
           (** Create a new initialization request

     

       907
       -
               @param capabilities

     

       908
       -
                 Client capabilities that define supported optional features

     

       909
       -
               @param client_info Client implementation details

     

       910
       -
               @param protocol_version MCP protocol version supported by the client

     

       911
       -
               @return A new initialization request *)

     

       912
        
       

     

       0
        
       
     

       913
        
           val to_jsonrpc : id:RequestId.t -> t -> JSONRPCMessage.t

     

       914
       -
           (** Convert to JSON-RPC message

     

       915
       -
               @param id Unique request identifier

     

       916
       -
               @param t Initialization request

     

       917
       -
               @return JSON-RPC message containing the initialization request *)

     

       918
        
         end

     

       919
        
       

     

       920
        
         (** Initialize result *)

     

       921
        
         module Result : sig

     

       922
        
           type t = {

     

       923
       -
             capabilities : Json.t;

     

       924
       -
                 (** ServerCapabilities that define supported optional features. This

     

       925
       -
                     declares which server features are available, including:

     

       926
       -
                     - prompts: Server provides prompt templates

     

       927
       -
                     - resources: Server provides readable resources

     

       928
       -
                     - tools: Server exposes callable tools

     

       929
       -
                     - logging: Server emits structured log messages

     

       930
       -
       

     

       931
       -
                     Each capability may have sub-capabilities like:

     

       932
       -
                     - listChanged: Server will notify when available items change

     

       933
       -
                     - subscribe: Clients can subscribe to individual resources *)

     

       934
       -
             server_info : Implementation.t;

     

       935
       -
                 (** Server implementation details (name and version) used for

     

       936
       -
                     identification and debugging. Helps clients understand which

     

       937
       -
                     server they're working with. *)

     

       938
       -
             protocol_version : string;

     

       939
       -
                 (** MCP protocol version supported by the server, formatted as

     

       940
       -
                     YYYY-MM-DD. If the server supports the client's requested version,

     

       941
       -
                     it responds with the same version. Otherwise, it responds with a

     

       942
       -
                     version it does support. *)

     

       943
       -
             instructions : string option;

     

       944
       -
                 (** Optional instructions for using the server. These can provide

     

       945
       -
                     human-readable guidance on how to interact with this specific

     

       946
       -
                     server implementation. *)

     

       947
       -
             meta : Json.t option;

     

       948
       -
                 (** Optional additional metadata as arbitrary JSON. Can contain

     

       949
       -
                     server-specific information not covered by the standard fields. *)

     

       950
        
           }

     

       951
       -
           (** InitializeResult is the server's response to an initialization request,

     

       952
       -
               completing capability negotiation and establishing the protocol version.

     

       953
       -
       

     

       954
       -
               After receiving this message, the client must send an

     

       955
       -
               InitializedNotification. The server should not send any requests other

     

       956
       -
               than pings and logging before receiving the initialized notification. *)

     

       957
       -
       

     

       958
       -
           include Json.Jsonable.S with type t := t

     

       959
        
       

     

       960
       -
           val create :

     

       961
       -
             capabilities:Json.t ->

     

       962
       -
             server_info:Implementation.t ->

     

       963
       -
             protocol_version:string ->

     

       964
       -
             ?instructions:string ->

     

       965
       -
             ?meta:Json.t ->

     

       966
       -
             unit ->

     

       967
       -
             t

     

       968
       -
           (** Create a new initialization result

     

       969
       -
               @param capabilities

     

       970
       -
                 Server capabilities that define supported optional features

     

       971
       -
               @param server_info Server implementation details

     

       972
       -
               @param protocol_version MCP protocol version supported by the server

     

       973
       -
               @param instructions Optional instructions for using the server

     

       974
       -
               @param meta Optional additional metadata

     

       975
       -
               @return A new initialization result *)

     

       976
        
       

     

       0
        
       
     

       977
        
           val to_jsonrpc : id:RequestId.t -> t -> JSONRPCMessage.t

     

       978
       -
           (** Convert to JSON-RPC message

     

       979
       -
               @param id ID matching the original request

     

       980
       -
               @param t Initialization result

     

       981
       -
               @return JSON-RPC message containing the initialization result *)

     

       982
        
         end

     

       983
        
       end

     

       984
        
       

     

       985
       -
       (** Initialized notification - Completes the initialization phase of the MCP

     

       986
       -
           lifecycle *)

     

       987
        
       module Initialized : sig

     

       988
        
         module Notification : sig

     

       989
        
           type t = {

     

       990
       -
             meta : Json.t option;

     

       991
       -
                 (** Optional additional metadata as arbitrary JSON. Can contain

     

       992
       -
                     client-specific information not covered by the standard fields. *)

     

       993
        
           }

     

       994
       -
           (** InitializedNotification is sent by the client after receiving the

     

       995
       -
               initialization response, indicating it's ready to begin normal

     

       996
       -
               operations. This completes the three-step initialization process, after

     

       997
       -
               which both client and server can freely exchange messages according to

     

       998
       -
               the negotiated capabilities.

     

       999
        
       

     

       1000
       -
               Only after this notification has been sent should the client begin

     

       1001
       -
               normal operations like listing resources, calling tools, or requesting

     

       1002
       -
               prompts. *)

     

       1003
       -
       

     

       1004
       -
           include Json.Jsonable.S with type t := t

     

       1005
        
       

     

       1006
        
           val create : ?meta:Json.t -> unit -> t

     

       1007
       -
           (** Create a new initialized notification

     

       1008
       -
               @param meta Optional additional metadata

     

       1009
       -
               @return A new initialized notification *)

     

       1010
       -
       

     

       1011
        
           val to_jsonrpc : t -> JSONRPCMessage.t

     

       1012
       -
           (** Convert to JSON-RPC message

     

       1013
       -
               @param t Initialized notification

     

       1014
       -
               @return JSON-RPC message containing the initialized notification *)

     

       1015
        
         end

     

       1016
        
       end

     

       1017
        
       

     

       1018
       -
       val parse_message : Json.t -> JSONRPCMessage.t

     

       1019
       -
       (** Parse a JSON message into an MCP message

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       1020
        
       

     

       1021
       -
           This function takes a raw JSON value and parses it into a structured MCP

     

       1022
       -
           message. It's the primary entry point for processing incoming JSON-RPC

     

       1023
       -
           messages in the MCP protocol.

     

       1024
        
       

     

       1025
       -
           The function determines the message type (notification, request, response,

     

       1026
       -
           or error) based on the presence and values of specific fields:

     

       1027
       -
           - A message with "method" but no "id" is a notification

     

       1028
       -
           - A message with "method" and "id" is a request

     

       1029
       -
           - A message with "id" and "result" is a response

     

       1030
       -
           - A message with "id" and "error" is an error

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       1031
        
       

     

       1032
       -
           @param json

     

       1033
       -
             The JSON message to parse, typically received from the transport layer

     

       1034
       -
           @return The parsed MCP message as a structured JSONRPCMessage.t value

     

       1035
       -
           @raise Parse error if the JSON cannot be parsed as a valid MCP message *)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       1036
        
       

     

       1037
       -
       val create_notification :

     

       1038
       -
         ?params:Json.t option -> meth:Method.t -> unit -> JSONRPCMessage.t

     

       1039
       -
       (** Create a new notification message

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       1040
        
       

     

       1041
       -
           Notifications are one-way messages that don't expect a response. This is a

     

       1042
       -
           convenience wrapper around JSONRPCMessage.create_notification.

     

       0
        
       
     

       1043
        
       

     

       1044
       -
           Common notifications in MCP include:

     

       1045
       -
           - "notifications/initialized" - Sent after initialization

     

       1046
       -
           - "notifications/progress" - Updates on long-running operations

     

       1047
       -
           - "notifications/resources/updated" - Resource content changed

     

       1048
       -
           - "notifications/prompts/list_changed" - Available prompts changed

     

       1049
       -
           - "notifications/tools/list_changed" - Available tools changed

     

       1050
        
       

     

       1051
       -
           @param params Optional parameters for the notification as a JSON value

     

       1052
       -
           @param meth Method type for the notification

     

       1053
       -
           @return A new JSON-RPC notification message *)

     

       1054
        
       

     

       1055
       -
       val create_request :

     

       1056
       -
         ?params:Json.t option ->

     

       1057
       -
         ?progress_token:ProgressToken.t option ->

     

       1058
       -
         id:RequestId.t ->

     

       1059
       -
         meth:Method.t ->

     

       1060
       -
         unit ->

     

       1061
       -
         JSONRPCMessage.t

     

       1062
       -
       (** Create a new request message

     

       1063
        
       

     

       1064
       -
           Requests are messages that expect a corresponding response. This is a

     

       1065
       -
           convenience wrapper around JSONRPCMessage.create_request.

     

       0
        
       
     

       1066
        
       

     

       1067
       -
           Common requests in MCP include:

     

       1068
       -
           - "initialize" - Start the MCP lifecycle

     

       1069
       -
           - "resources/list" - Discover available resources

     

       1070
       -
           - "resources/read" - Retrieve resource contents

     

       1071
       -
           - "tools/list" - Discover available tools

     

       1072
       -
           - "tools/call" - Invoke a tool

     

       1073
       -
           - "prompts/list" - Discover available prompts

     

       1074
       -
           - "prompts/get" - Retrieve a prompt template

     

       1075
        
       

     

       1076
       -
           @param params Optional parameters for the request as a JSON value

     

       1077
       -
           @param progress_token

     

       1078
       -
             Optional progress token for long-running operations that can report

     

       1079
       -
             progress updates

     

       1080
       -
           @param id

     

       1081
       -
             Unique identifier for the request, used to correlate with the response

     

       1082
       -
           @param meth Method type for the request

     

       1083
       -
           @return A new JSON-RPC request message *)

     

       1084
        
       

     

       1085
       -
       val create_response : id:RequestId.t -> result:Json.t -> JSONRPCMessage.t

     

       1086
       -
       (** Create a new response message

     

       1087
        
       

     

       1088
       -
           Responses are sent in reply to requests and contain successful results. This

     

       1089
       -
           is a convenience wrapper around JSONRPCMessage.create_response.

     

       0
        
       
     

       0
        
       
     

       1090
        
       

     

       1091
       -
           Each response must include the same ID as its corresponding request to allow

     

       1092
       -
           the client to correlate them, especially when multiple requests are in

     

       1093
       -
           flight simultaneously.

     

       1094
        
       

     

       1095
       -
           @param id ID matching the original request

     

       1096
       -
           @param result Result of the successful request as a JSON value

     

       1097
       -
           @return A new JSON-RPC response message *)

     

       1098
        
       

     

       1099
       -
       val create_error :

     

       1100
       -
         id:RequestId.t ->

     

       1101
       -
         code:int ->

     

       1102
       -
         message:string ->

     

       1103
       -
         ?data:Json.t option ->

     

       1104
       -
         unit ->

     

       1105
       -
         JSONRPCMessage.t

     

       1106
       -
       (** Create a new error message

     

       1107
        
       

     

       1108
       -
           Errors are sent in reply to requests when processing fails. This is a

     

       1109
       -
           convenience wrapper around JSONRPCMessage.create_error.

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       1110
        
       

     

       1111
       -
           MCP uses standard JSON-RPC error codes as well as some protocol-specific

     

       1112
       -
           codes:

     

       1113
       -
           - -32700: Parse error (invalid JSON)

     

       1114
       -
           - -32600: Invalid request (malformed JSON-RPC)

     

       1115
       -
           - -32601: Method not found

     

       1116
       -
           - -32602: Invalid parameters

     

       1117
       -
           - -32603: Internal error

     

       1118
       -
           - -32002: Resource not found (MCP-specific)

     

       1119
       -
           - -32001: Authentication required (MCP-specific)

     

       1120
        
       

     

       1121
       -
           @param id ID matching the original request

     

       1122
       -
           @param code Error code indicating the type of error

     

       1123
       -
           @param message Human-readable error message describing the issue

     

       1124
       -
           @param data Optional additional error data providing more context

     

       1125
       -
           @return A new JSON-RPC error message *)

     

       1126
        
       

     

       1127
       -
       val make_text_content : string -> content

     

       1128
       -
       (** Create a new text content object

     

       1129
       -
           @param text The text content

     

       1130
       -
           @return A content value with the text *)

     

       1131
        
       

     

       1132
       -
       val make_image_content : string -> string -> content

     

       1133
       -
       (** Create a new image content object

     

       1134
       -
           @param data Base64-encoded image data

     

       1135
       -
           @param mime_type MIME type of the image (e.g., "image/png", "image/jpeg")

     

       1136
       -
           @return A content value with the image *)

     

       1137
        
       

     

       1138
       -
       val make_audio_content : string -> string -> content

     

       1139
       -
       (** Create a new audio content object

     

       1140
       -
           @param data Base64-encoded audio data

     

       1141
       -
           @param mime_type MIME type of the audio (e.g., "audio/wav", "audio/mp3")

     

       1142
       -
           @return A content value with the audio *)

     

       1143
        
       

     

       1144
       -
       val make_resource_text_content : string -> string -> string option -> content

     

       1145
       -
       (** Create a new text resource content object

     

       1146
       -
           @param uri URI that uniquely identifies the resource

     

       1147
       -
           @param text The text content of the resource

     

       1148
       -
           @param mime_type Optional MIME type of the text content

     

       1149
       -
           @return A content value with the text resource *)

     

       1150
        
       

     

       1151
       -
       val make_resource_blob_content : string -> string -> string option -> content

     

       1152
       -
       (** Create a new binary resource content object

     

       1153
       -
           @param uri URI that uniquely identifies the resource

     

       1154
       -
           @param blob Base64-encoded binary data

     

       1155
       -
           @param mime_type Optional MIME type of the binary content

     

       1156
       -
           @return A content value with the binary resource *)

···

       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
        
       
     

       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
        
       
     

       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
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       15
        
       end

     

       16
        
       

     

       17
        
       (** Common types *)

     
···

       19
        
       (** Roles for conversation participants *)

     

       20
        
       module Role : sig

     

       21
        
         type t = [ `User | `Assistant ]

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       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

     

       32
        
         type t = [ `String of string | `Int of int ]

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       33
        
       

     

       34
        
         include Json.Jsonable.S with type t := t

     

       35
        
       end

     
···

       37
        
       (** Request IDs *)

     

       38
        
       module RequestId : sig

     

       39
        
         type t = [ `String of string | `Int of int ]

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       40
        
       

     

       41
        
         include Json.Jsonable.S with type t := t

     

       42
        
       end

     
···

       44
        
       (** Cursors for pagination *)

     

       45
        
       module Cursor : sig

     

       46
        
         type t = string

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       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

     

       54
       +
         type t = {

     

       55
       +
           annotations: annotation option;

     

       56
       +
         }

     

       0
        
       
     

       57
        
         and annotation = {

     

       58
       +
           audience: Role.t list option;

     

       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

     

       71
        
         type t = {

     

       72
       +
           text: string;

     

       73
       +
           annotations: Annotated.annotation option;

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       74
        
         }

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       75
        
       

     

       76
       +
         val yojson_of_t : t -> Json.t

     

       77
       +
         val t_of_yojson : Json.t -> t

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       78
        
       end

     

       79
        
       

     

       80
       +
       (** Image content *)

     

       81
        
       module ImageContent : sig

     

       82
        
         type t = {

     

       83
       +
           data: string;

     

       84
       +
           mime_type: string;

     

       85
       +
           annotations: Annotated.annotation option;

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       86
        
         }

     

       0
        
       
     

       0
        
       
     

       87
        
       

     

       88
       +
         val yojson_of_t : t -> Json.t

     

       89
       +
         val t_of_yojson : Json.t -> t

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       90
        
       end

     

       91
        
       

     

       92
       +
       (** Audio content *)

     

       93
        
       module AudioContent : sig

     

       94
        
         type t = {

     

       95
       +
           data: string;

     

       96
       +
           mime_type: string;

     

       97
       +
           annotations: Annotated.annotation option;

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       98
        
         }

     

       0
        
       
     

       0
        
       
     

       99
        
       

     

       100
       +
         val yojson_of_t : t -> Json.t

     

       101
       +
         val t_of_yojson : Json.t -> t

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       102
        
       end

     

       103
        
       

     

       104
       +
       (** Base resource contents *)

     

       105
        
       module ResourceContents : sig

     

       106
        
         type t = {

     

       107
       +
           uri: string;

     

       108
       +
           mime_type: string option;

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       109
        
         }

     

       0
        
       
     

       110
        
       

     

       111
       +
         val yojson_of_t : t -> Json.t

     

       112
       +
         val t_of_yojson : Json.t -> t

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       113
        
       end

     

       114
        
       

     

       115
       +
       (** Text resource contents *)

     

       116
        
       module TextResourceContents : sig

     

       117
        
         type t = {

     

       118
       +
           uri: string;

     

       119
       +
           text: string;

     

       120
       +
           mime_type: string option;

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       121
        
         }

     

       0
        
       
     

       122
        
       

     

       123
       +
         val yojson_of_t : t -> Json.t

     

       124
       +
         val t_of_yojson : Json.t -> t

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       125
        
       end

     

       126
        
       

     

       127
       +
       (** Binary resource contents *)

     

       128
        
       module BlobResourceContents : sig

     

       129
        
         type t = {

     

       130
       +
           uri: string;

     

       131
       +
           blob: string;

     

       132
       +
           mime_type: string option;

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       133
        
         }

     

       0
        
       
     

       134
        
       

     

       135
       +
         val yojson_of_t : t -> Json.t

     

       136
       +
         val t_of_yojson : Json.t -> t

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       137
        
       end

     

       138
        
       

     

       139
       +
       (** Embedded resource *)

     

       140
        
       module EmbeddedResource : sig

     

       141
        
         type t = {

     

       142
       +
           resource: [ `Text of TextResourceContents.t | `Blob of BlobResourceContents.t ];

     

       143
       +
           annotations: Annotated.annotation option;

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       144
        
         }

     

       0
        
       
     

       0
        
       
     

       145
        
       

     

       146
       +
         val yojson_of_t : t -> Json.t

     

       147
       +
         val t_of_yojson : Json.t -> t

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       148
        
       end

     

       149
        
       

     

       150
       +
       (** Content type used in messages *)

     

       151
       +
       type content = 

     

       0
        
       
     

       152
        
         | Text of TextContent.t

     

       0
        
       
     

       0
        
       
     

       153
        
         | Image of ImageContent.t

     

       0
        
       
     

       0
        
       
     

       154
        
         | Audio of AudioContent.t

     

       0
        
       
     

       0
        
       
     

       155
        
         | Resource of EmbeddedResource.t

     

       0
        
       
     

       0
        
       
     

       156
        
       

     

       157
        
       val yojson_of_content : content -> Json.t

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       158
        
       val content_of_yojson : Json.t -> content

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       159
        
       

     

       160
       +
       (** Message for prompts *)

     

       161
        
       module PromptMessage : sig

     

       162
        
         type t = {

     

       163
       +
           role: Role.t;

     

       164
       +
           content: content;

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       165
        
         }

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       166
        
       

     

       167
       +
         val yojson_of_t : t -> Json.t

     

       168
       +
         val t_of_yojson : Json.t -> t

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       169
        
       end

     

       170
        
       

     

       171
       +
       (** Message for sampling *)

     

       172
        
       module SamplingMessage : sig

     

       173
        
         type t = {

     

       174
       +
           role: Role.t;

     

       175
       +
           content: [ `Text of TextContent.t | `Image of ImageContent.t ];

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       176
        
         }

     

       0
        
       
     

       0
        
       
     

       177
        
       

     

       178
       +
         val yojson_of_t : t -> Json.t

     

       179
       +
         val t_of_yojson : Json.t -> t

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       180
        
       end

     

       181
        
       

     

       182
        
       (** Implementation information *)

     

       183
        
       module Implementation : sig

     

       184
        
         type t = {

     

       185
       +
           name: string;

     

       186
       +
           version: string;

     

       187
        
         }

     

       0
        
       
     

       0
        
       
     

       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
        
       
     

       194
        
       module JSONRPCMessage : sig

     

       195
        
         type notification = {

     

       196
       +
           method_: string;

     

       197
       +
           params: Json.t option;

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       198
        
         }

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       199
        
       

     

       200
        
         type request = {

     

       201
       +
           id: RequestId.t;

     

       202
       +
           method_: string;

     

       203
       +
           params: Json.t option;

     

       204
       +
           progress_token: ProgressToken.t option;

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       205
        
         }

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       206
        
       

     

       207
        
         type response = {

     

       208
       +
           id: RequestId.t;

     

       209
       +
           result: Json.t;

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       210
        
         }

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       211
        
       

     

       212
        
         type error = {

     

       213
       +
           id: RequestId.t;

     

       214
       +
           code: int;

     

       215
       +
           message: string;

     

       216
       +
           data: Json.t option;

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       217
        
         }

     

       0
        
       
     

       218
        
       

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       219
        
         type t =

     

       220
        
           | Notification of notification

     

       221
        
           | Request of request

     
···

       223
        
           | Error of error

     

       224
        
       

     

       225
        
         val yojson_of_notification : notification -> Json.t

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       226
        
         val yojson_of_request : request -> Json.t

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       227
        
         val yojson_of_response : response -> Json.t

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       228
        
         val yojson_of_error : error -> Json.t

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       229
        
         val yojson_of_t : t -> Json.t

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       230
        
       

     

       231
        
         val notification_of_yojson : Json.t -> notification

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       232
        
         val request_of_yojson : Json.t -> request

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       233
        
         val response_of_yojson : Json.t -> response

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       234
        
         val error_of_yojson : Json.t -> error

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       235
        
         val t_of_yojson : Json.t -> t

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       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
        
       
     

       239
        
         val create_response : id:RequestId.t -> result:Json.t -> t

     

       240
       +
         val create_error : id:RequestId.t -> code:int -> message:string -> ?data:Json.t option -> unit -> t

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       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

     

       247
        
           type t = {

     

       248
       +
             capabilities: Json.t; (** ClientCapabilities *)

     

       249
       +
             client_info: Implementation.t;

     

       250
       +
             protocol_version: string;

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       251
        
           }

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       252
        
       

     

       253
       +
           val yojson_of_t : t -> Json.t

     

       254
       +
           val t_of_yojson : Json.t -> t

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       255
        
       

     

       256
       +
           val create : capabilities:Json.t -> client_info:Implementation.t -> protocol_version:string -> t

     

       257
        
           val to_jsonrpc : id:RequestId.t -> t -> JSONRPCMessage.t

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       258
        
         end

     

       259
        
       

     

       260
        
         (** Initialize result *)

     

       261
        
         module Result : sig

     

       262
        
           type t = {

     

       263
       +
             capabilities: Json.t; (** ServerCapabilities *)

     

       264
       +
             server_info: Implementation.t;

     

       265
       +
             protocol_version: string;

     

       266
       +
             instructions: string option;

     

       267
       +
             meta: Json.t option;

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       268
        
           }

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       269
        
       

     

       270
       +
           val yojson_of_t : t -> Json.t

     

       271
       +
           val t_of_yojson : Json.t -> t

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       272
        
       

     

       273
       +
           val create : capabilities:Json.t -> server_info:Implementation.t -> protocol_version:string -> ?instructions:string -> ?meta:Json.t -> unit -> t

     

       274
        
           val to_jsonrpc : id:RequestId.t -> t -> JSONRPCMessage.t

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       275
        
         end

     

       276
        
       end

     

       277
        
       

     

       278
       +
       (** Initialized notification *)

     

       0
        
       
     

       279
        
       module Initialized : sig

     

       280
        
         module Notification : sig

     

       281
        
           type t = {

     

       282
       +
             meta: Json.t option;

     

       0
        
       
     

       0
        
       
     

       283
        
           }

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       284
        
       

     

       285
       +
           val yojson_of_t : t -> Json.t

     

       286
       +
           val t_of_yojson : Json.t -> t

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       287
        
       

     

       288
        
           val create : ?meta:Json.t -> unit -> t

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       289
        
           val to_jsonrpc : t -> JSONRPCMessage.t

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       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
       +
         }

     

       300
        
       

     

       301
       +
         val yojson_of_t : t -> Json.t

     

       302
       +
         val t_of_yojson : Json.t -> t

     

       303
       +
       end

     

       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

     

       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
       +
         }

     

       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
       +
         }

     

       341
        
       

     

       342
       +
         val yojson_of_t : t -> Json.t

     

       343
       +
         val t_of_yojson : Json.t -> t

     

       344
       +
       end

     

       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

     

       355
        
       

     

       356
       +
       (** Prompt Reference *)

     

       357
       +
       module PromptReference : sig

     

       358
       +
         type t = {

     

       359
       +
           name: string;

     

       360
       +
         }

     

       0
        
       
     

       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
       +
           }

     

       0
        
       
     

       373
        
       

     

       374
       +
           val yojson_of_t : t -> Json.t

     

       375
       +
           val t_of_yojson : Json.t -> t

     

       376
       +
         end

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       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

     

       0
        
       
     

       388
        
       

     

       389
       +
           val yojson_of_reference : reference -> Json.t

     

       390
       +
           val reference_of_yojson : Json.t -> reference

     

       0
        
       
     

       391
        
       

     

       392
       +
           val create : argument:Argument.t -> ref:reference -> t

     

       393
       +
           val to_params : t -> Json.t

     

       394
       +
         end

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       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
       +
           }

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       407
        
       

     

       408
       +
           val yojson_of_completion : completion -> Json.t

     

       409
       +
           val completion_of_yojson : Json.t -> completion

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       410
        
       

     

       411
       +
           val yojson_of_t : t -> Json.t

     

       412
       +
           val t_of_yojson : Json.t -> t

     

       0
        
       
     

       0
        
       
     

       413
        
       

     

       414
       +
           val create : completion:completion -> ?meta:Json.t -> unit -> t

     

       415
       +
           val to_result : t -> Json.t

     

       416
       +
         end

     

       417
       +
       end

     

       0
        
       
     

       418
        
       

     

       419
       +
       (** Parse a JSON message into an MCP message *)

     

       420
       +
       val parse_message : Json.t -> JSONRPCMessage.t

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       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

     

       0
        
       
     

       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
     

       0
        
       
     

       0
        
       
     

       0

-833

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 = { cursor : Cursor.t option }

     

       10
       -
       

     

       11
       -
           let yojson_of_t { cursor } =

     

       12
       -
             let assoc = [] in

     

       13
       -
             let assoc =

     

       14
       -
               match cursor with

     

       15
       -
               | Some c -> ("cursor", Cursor.yojson_of_t c) :: assoc

     

       16
       -
               | None -> assoc

     

       17
       -
             in

     

       18
       -
             `Assoc assoc

     

       19
       -
       

     

       20
       -
           let t_of_yojson = function

     

       21
       -
             | `Assoc fields ->

     

       22
       -
                 let cursor =

     

       23
       -
                   List.assoc_opt "cursor" fields |> Option.map Cursor.t_of_yojson

     

       24
       -
                 in

     

       25
       -
                 { cursor }

     

       26
       -
             | j -> Util.json_error "Expected object for ResourcesList.Request.t" j

     

       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 = [ ("uri", `String uri); ("name", `String name) ] in

     

       40
       -
             let assoc =

     

       41
       -
               match description with

     

       42
       -
               | Some desc -> ("description", `String desc) :: assoc

     

       43
       -
               | None -> assoc

     

       44
       -
             in

     

       45
       -
             let assoc =

     

       46
       -
               match mime_type with

     

       47
       -
               | Some mime -> ("mimeType", `String mime) :: assoc

     

       48
       -
               | None -> assoc

     

       49
       -
             in

     

       50
       -
             let assoc =

     

       51
       -
               match size with Some s -> ("size", `Int s) :: assoc | None -> assoc

     

       52
       -
             in

     

       53
       -
             `Assoc assoc

     

       54
       -
       

     

       55
       -
           let t_of_yojson = function

     

       56
       -
             | `Assoc fields as json ->

     

       57
       -
                 let uri =

     

       58
       -
                   match List.assoc_opt "uri" fields with

     

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

     

       60
       -
                   | _ -> Util.json_error "Missing or invalid 'uri' field" json

     

       61
       -
                 in

     

       62
       -
                 let name =

     

       63
       -
                   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 =

     

       68
       -
                   List.assoc_opt "description" fields

     

       69
       -
                   |> Option.map (function

     

       70
       -
                        | `String s -> s

     

       71
       -
                        | j -> Util.json_error "Expected string for description" j)

     

       72
       -
                 in

     

       73
       -
                 let mime_type =

     

       74
       -
                   List.assoc_opt "mimeType" fields

     

       75
       -
                   |> Option.map (function

     

       76
       -
                        | `String s -> s

     

       77
       -
                        | j -> Util.json_error "Expected string for mimeType" j)

     

       78
       -
                 in

     

       79
       -
                 let size =

     

       80
       -
                   List.assoc_opt "size" fields

     

       81
       -
                   |> Option.map (function

     

       82
       -
                        | `Int i -> i

     

       83
       -
                        | j -> Util.json_error "Expected int for size" j)

     

       84
       -
                 in

     

       85
       -
                 { uri; name; description; mime_type; size }

     

       86
       -
             | j -> Util.json_error "Expected object for ResourcesList.Resource.t" j

     

       87
       -
         end

     

       88
       -
       

     

       89
       -
         module Response = struct

     

       90
       -
           type t = { resources : Resource.t list; next_cursor : Cursor.t option }

     

       91
       -
       

     

       92
       -
           let yojson_of_t { resources; next_cursor } =

     

       93
       -
             let assoc =

     

       94
       -
               [ ("resources", `List (List.map Resource.yojson_of_t resources)) ]

     

       95
       -
             in

     

       96
       -
             let assoc =

     

       97
       -
               match next_cursor with

     

       98
       -
               | Some c -> ("nextCursor", Cursor.yojson_of_t c) :: assoc

     

       99
       -
               | None -> assoc

     

       100
       -
             in

     

       101
       -
             `Assoc assoc

     

       102
       -
       

     

       103
       -
           let t_of_yojson = function

     

       104
       -
             | `Assoc fields as json ->

     

       105
       -
                 let resources =

     

       106
       -
                   match List.assoc_opt "resources" fields with

     

       107
       -
                   | Some (`List items) -> List.map Resource.t_of_yojson items

     

       108
       -
                   | _ -> Util.json_error "Missing or invalid 'resources' field" json

     

       109
       -
                 in

     

       110
       -
                 let next_cursor =

     

       111
       -
                   List.assoc_opt "nextCursor" fields |> Option.map Cursor.t_of_yojson

     

       112
       -
                 in

     

       113
       -
                 { resources; next_cursor }

     

       114
       -
             | j -> Util.json_error "Expected object for ResourcesList.Response.t" j

     

       115
       -
         end

     

       116
       -
       

     

       117
       -
         (* Request/response creation helpers *)

     

       118
       -
         let create_request ?cursor ?id () =

     

       119
       -
           let id = match id with Some i -> i | None -> `Int (Random.int 10000) in

     

       120
       -
           let params = Request.yojson_of_t { cursor } in

     

       121
       -
           JSONRPCMessage.create_request ~id ~meth:Method.ResourcesList

     

       122
       -
             ~params:(Some params) ()

     

       123
       -
       

     

       124
       -
         let create_response ~id ~resources ?next_cursor () =

     

       125
       -
           let result = Response.yojson_of_t { resources; next_cursor } in

     

       126
       -
           JSONRPCMessage.create_response ~id ~result

     

       127
       -
       end

     

       128
       -
       

     

       129
       -
       (* Resources/Templates/List *)

     

       130
       -
       module ListResourceTemplatesRequest = struct

     

       131
       -
         type t = { cursor : Cursor.t option }

     

       132
       -
       

     

       133
       -
         let yojson_of_t { cursor } =

     

       134
       -
           let assoc = [] in

     

       135
       -
           let assoc =

     

       136
       -
             match cursor with

     

       137
       -
             | Some c -> ("cursor", Cursor.yojson_of_t c) :: assoc

     

       138
       -
             | None -> assoc

     

       139
       -
           in

     

       140
       -
           `Assoc assoc

     

       141
       -
       

     

       142
       -
         let t_of_yojson = function

     

       143
       -
           | `Assoc fields ->

     

       144
       -
               let cursor =

     

       145
       -
                 List.assoc_opt "cursor" fields |> Option.map Cursor.t_of_yojson

     

       146
       -
               in

     

       147
       -
               { cursor }

     

       148
       -
           | j ->

     

       149
       -
               Util.json_error "Expected object for ListResourceTemplatesRequest.t" j

     

       150
       -
       end

     

       151
       -
       

     

       152
       -
       (* Resources/Templates/List Response *)

     

       153
       -
       module ListResourceTemplatesResult = struct

     

       154
       -
         module ResourceTemplate = struct

     

       155
       -
           type t = {

     

       156
       -
             uri_template : string;

     

       157
       -
             name : string;

     

       158
       -
             description : string option;

     

       159
       -
             mime_type : string option;

     

       160
       -
           }

     

       161
       -
       

     

       162
       -
           let yojson_of_t { uri_template; name; description; mime_type } =

     

       163
       -
             let assoc =

     

       164
       -
               [ ("uriTemplate", `String uri_template); ("name", `String name) ]

     

       165
       -
             in

     

       166
       -
             let assoc =

     

       167
       -
               match description with

     

       168
       -
               | Some desc -> ("description", `String desc) :: assoc

     

       169
       -
               | None -> assoc

     

       170
       -
             in

     

       171
       -
             let assoc =

     

       172
       -
               match mime_type with

     

       173
       -
               | Some mime -> ("mimeType", `String mime) :: assoc

     

       174
       -
               | None -> assoc

     

       175
       -
             in

     

       176
       -
             `Assoc assoc

     

       177
       -
       

     

       178
       -
           let t_of_yojson = function

     

       179
       -
             | `Assoc fields as json ->

     

       180
       -
                 let uri_template =

     

       181
       -
                   match List.assoc_opt "uriTemplate" fields with

     

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

     

       183
       -
                   | _ -> Util.json_error "Missing or invalid 'uriTemplate' field" json

     

       184
       -
                 in

     

       185
       -
                 let name =

     

       186
       -
                   match List.assoc_opt "name" fields with

     

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

     

       188
       -
                   | _ -> Util.json_error "Missing or invalid 'name' field" json

     

       189
       -
                 in

     

       190
       -
                 let description =

     

       191
       -
                   List.assoc_opt "description" fields

     

       192
       -
                   |> Option.map (function

     

       193
       -
                        | `String s -> s

     

       194
       -
                        | j -> Util.json_error "Expected string for description" j)

     

       195
       -
                 in

     

       196
       -
                 let mime_type =

     

       197
       -
                   List.assoc_opt "mimeType" fields

     

       198
       -
                   |> Option.map (function

     

       199
       -
                        | `String s -> s

     

       200
       -
                        | j -> Util.json_error "Expected string for mimeType" j)

     

       201
       -
                 in

     

       202
       -
                 { uri_template; name; description; mime_type }

     

       203
       -
             | j ->

     

       204
       -
                 Util.json_error

     

       205
       -
                   "Expected object for ListResourceTemplatesResult.ResourceTemplate.t"

     

       206
       -
                   j

     

       207
       -
         end

     

       208
       -
       

     

       209
       -
         type t = {

     

       210
       -
           resource_templates : ResourceTemplate.t list;

     

       211
       -
           next_cursor : Cursor.t option;

     

       212
       -
         }

     

       213
       -
       

     

       214
       -
         let yojson_of_t { resource_templates; next_cursor } =

     

       215
       -
           let assoc =

     

       216
       -
             [

     

       217
       -
               ( "resourceTemplates",

     

       218
       -
                 `List (List.map ResourceTemplate.yojson_of_t resource_templates) );

     

       219
       -
             ]

     

       220
       -
           in

     

       221
       -
           let assoc =

     

       222
       -
             match next_cursor with

     

       223
       -
             | Some c -> ("nextCursor", Cursor.yojson_of_t c) :: assoc

     

       224
       -
             | None -> assoc

     

       225
       -
           in

     

       226
       -
           `Assoc assoc

     

       227
       -
       

     

       228
       -
         let t_of_yojson = function

     

       229
       -
           | `Assoc fields as json ->

     

       230
       -
               let resource_templates =

     

       231
       -
                 match List.assoc_opt "resourceTemplates" fields with

     

       232
       -
                 | Some (`List items) -> List.map ResourceTemplate.t_of_yojson items

     

       233
       -
                 | _ ->

     

       234
       -
                     Util.json_error "Missing or invalid 'resourceTemplates' field"

     

       235
       -
                       json

     

       236
       -
               in

     

       237
       -
               let next_cursor =

     

       238
       -
                 List.assoc_opt "nextCursor" fields |> Option.map Cursor.t_of_yojson

     

       239
       -
               in

     

       240
       -
               { resource_templates; next_cursor }

     

       241
       -
           | j -> Util.json_error "Expected object for ListResourceTemplatesResult.t" j

     

       242
       -
       

     

       243
       -
         (* Request/response creation helpers *)

     

       244
       -
         let create_request ?cursor ?id () =

     

       245
       -
           let id = match id with Some i -> i | None -> `Int (Random.int 10000) in

     

       246
       -
           let params = ListResourceTemplatesRequest.yojson_of_t { cursor } in

     

       247
       -
           JSONRPCMessage.create_request ~id ~meth:Method.ResourceTemplatesList

     

       248
       -
             ~params:(Some params) ()

     

       249
       -
       

     

       250
       -
         let create_response ~id ~resource_templates ?next_cursor () =

     

       251
       -
           let result = yojson_of_t { resource_templates; next_cursor } in

     

       252
       -
           JSONRPCMessage.create_response ~id ~result

     

       253
       -
       end

     

       254
       -
       

     

       255
       -
       (* Resources/Read *)

     

       256
       -
       module ResourcesRead = struct

     

       257
       -
         module Request = struct

     

       258
       -
           type t = { uri : string }

     

       259
       -
       

     

       260
       -
           let yojson_of_t { uri } = `Assoc [ ("uri", `String uri) ]

     

       261
       -
       

     

       262
       -
           let t_of_yojson = function

     

       263
       -
             | `Assoc fields as json ->

     

       264
       -
                 let uri =

     

       265
       -
                   match List.assoc_opt "uri" fields with

     

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

     

       267
       -
                   | _ -> Util.json_error "Missing or invalid 'uri' field" json

     

       268
       -
                 in

     

       269
       -
                 { uri }

     

       270
       -
             | j -> Util.json_error "Expected object for ResourcesRead.Request.t" j

     

       271
       -
         end

     

       272
       -
       

     

       273
       -
         module ResourceContent = struct

     

       274
       -
           type t =

     

       275
       -
             | TextResource of TextResourceContents.t

     

       276
       -
             | BlobResource of BlobResourceContents.t

     

       277
       -
       

     

       278
       -
           let yojson_of_t = function

     

       279
       -
             | TextResource tr -> TextResourceContents.yojson_of_t tr

     

       280
       -
             | BlobResource br -> BlobResourceContents.yojson_of_t br

     

       281
       -
       

     

       282
       -
           let t_of_yojson json =

     

       283
       -
             match json with

     

       284
       -
             | `Assoc fields ->

     

       285
       -
                 if List.mem_assoc "text" fields then

     

       286
       -
                   TextResource (TextResourceContents.t_of_yojson json)

     

       287
       -
                 else if List.mem_assoc "blob" fields then

     

       288
       -
                   BlobResource (BlobResourceContents.t_of_yojson json)

     

       289
       -
                 else Util.json_error "Invalid resource content" json

     

       290
       -
             | j ->

     

       291
       -
                 Util.json_error "Expected object for ResourcesRead.ResourceContent.t"

     

       292
       -
                   j

     

       293
       -
         end

     

       294
       -
       

     

       295
       -
         module Response = struct

     

       296
       -
           type t = { contents : ResourceContent.t list }

     

       297
       -
       

     

       298
       -
           let yojson_of_t { contents } =

     

       299
       -
             `Assoc

     

       300
       -
               [ ("contents", `List (List.map ResourceContent.yojson_of_t contents)) ]

     

       301
       -
       

     

       302
       -
           let t_of_yojson = function

     

       303
       -
             | `Assoc fields as json ->

     

       304
       -
                 let contents =

     

       305
       -
                   match List.assoc_opt "contents" fields with

     

       306
       -
                   | Some (`List items) -> List.map ResourceContent.t_of_yojson items

     

       307
       -
                   | _ -> Util.json_error "Missing or invalid 'contents' field" json

     

       308
       -
                 in

     

       309
       -
                 { contents }

     

       310
       -
             | j -> Util.json_error "Expected object for ResourcesRead.Response.t" j

     

       311
       -
         end

     

       312
       -
       

     

       313
       -
         (* Request/response creation helpers *)

     

       314
       -
         let create_request ~uri ?id () =

     

       315
       -
           let id = match id with Some i -> i | None -> `Int (Random.int 10000) in

     

       316
       -
           let params = Request.yojson_of_t { uri } in

     

       317
       -
           JSONRPCMessage.create_request ~id ~meth:Method.ResourcesRead

     

       318
       -
             ~params:(Some params) ()

     

       319
       -
       

     

       320
       -
         let create_response ~id ~contents () =

     

       321
       -
           let result = Response.yojson_of_t { contents } in

     

       322
       -
           JSONRPCMessage.create_response ~id ~result

     

       323
       -
       end

     

       324
       -
       

     

       325
       -
       (* Tools/List *)

     

       326
       -
       module ToolsList = struct

     

       327
       -
         module Request = struct

     

       328
       -
           type t = { cursor : Cursor.t option }

     

       329
       -
       

     

       330
       -
           let yojson_of_t { cursor } =

     

       331
       -
             let assoc = [] in

     

       332
       -
             let assoc =

     

       333
       -
               match cursor with

     

       334
       -
               | Some c -> ("cursor", Cursor.yojson_of_t c) :: assoc

     

       335
       -
               | None -> assoc

     

       336
       -
             in

     

       337
       -
             `Assoc assoc

     

       338
       -
       

     

       339
       -
           let t_of_yojson = function

     

       340
       -
             | `Assoc fields ->

     

       341
       -
                 let cursor =

     

       342
       -
                   List.assoc_opt "cursor" fields |> Option.map Cursor.t_of_yojson

     

       343
       -
                 in

     

       344
       -
                 { cursor }

     

       345
       -
             | j -> Util.json_error "Expected object for ToolsList.Request.t" j

     

       346
       -
         end

     

       347
       -
       

     

       348
       -
         module Tool = struct

     

       349
       -
           type t = {

     

       350
       -
             name : string;

     

       351
       -
             description : string option;

     

       352
       -
             input_schema : Json.t;

     

       353
       -
             annotations : Json.t option;

     

       354
       -
           }

     

       355
       -
       

     

       356
       -
           let yojson_of_t { name; description; input_schema; annotations } =

     

       357
       -
             let assoc = [ ("name", `String name); ("inputSchema", input_schema) ] in

     

       358
       -
             let assoc =

     

       359
       -
               match description with

     

       360
       -
               | Some desc -> ("description", `String desc) :: assoc

     

       361
       -
               | None -> assoc

     

       362
       -
             in

     

       363
       -
             let assoc =

     

       364
       -
               match annotations with

     

       365
       -
               | Some anno -> ("annotations", anno) :: assoc

     

       366
       -
               | None -> assoc

     

       367
       -
             in

     

       368
       -
             `Assoc assoc

     

       369
       -
       

     

       370
       -
           let t_of_yojson = function

     

       371
       -
             | `Assoc fields as json ->

     

       372
       -
                 let name =

     

       373
       -
                   match List.assoc_opt "name" fields with

     

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

     

       375
       -
                   | _ -> Util.json_error "Missing or invalid 'name' field" json

     

       376
       -
                 in

     

       377
       -
                 let description =

     

       378
       -
                   List.assoc_opt "description" fields

     

       379
       -
                   |> Option.map (function

     

       380
       -
                        | `String s -> s

     

       381
       -
                        | j -> Util.json_error "Expected string for description" j)

     

       382
       -
                 in

     

       383
       -
                 let input_schema =

     

       384
       -
                   match List.assoc_opt "inputSchema" fields with

     

       385
       -
                   | Some schema -> schema

     

       386
       -
                   | None -> Util.json_error "Missing 'inputSchema' field" json

     

       387
       -
                 in

     

       388
       -
                 let annotations = List.assoc_opt "annotations" fields in

     

       389
       -
                 { name; description; input_schema; annotations }

     

       390
       -
             | j -> Util.json_error "Expected object for ToolsList.Tool.t" j

     

       391
       -
         end

     

       392
       -
       

     

       393
       -
         module Response = struct

     

       394
       -
           type t = { tools : Tool.t list; next_cursor : Cursor.t option }

     

       395
       -
       

     

       396
       -
           let yojson_of_t { tools; next_cursor } =

     

       397
       -
             let assoc = [ ("tools", `List (List.map Tool.yojson_of_t tools)) ] in

     

       398
       -
             let assoc =

     

       399
       -
               match next_cursor with

     

       400
       -
               | Some c -> ("nextCursor", Cursor.yojson_of_t c) :: assoc

     

       401
       -
               | None -> assoc

     

       402
       -
             in

     

       403
       -
             `Assoc assoc

     

       404
       -
       

     

       405
       -
           let t_of_yojson = function

     

       406
       -
             | `Assoc fields as json ->

     

       407
       -
                 let tools =

     

       408
       -
                   match List.assoc_opt "tools" fields with

     

       409
       -
                   | Some (`List items) -> List.map Tool.t_of_yojson items

     

       410
       -
                   | _ -> Util.json_error "Missing or invalid 'tools' field" json

     

       411
       -
                 in

     

       412
       -
                 let next_cursor =

     

       413
       -
                   List.assoc_opt "nextCursor" fields |> Option.map Cursor.t_of_yojson

     

       414
       -
                 in

     

       415
       -
                 { tools; next_cursor }

     

       416
       -
             | j -> Util.json_error "Expected object for ToolsList.Response.t" j

     

       417
       -
         end

     

       418
       -
       

     

       419
       -
         (* Request/response creation helpers *)

     

       420
       -
         let create_request ?cursor ?id () =

     

       421
       -
           let id = match id with Some i -> i | None -> `Int (Random.int 10000) in

     

       422
       -
           let params = Request.yojson_of_t { cursor } in

     

       423
       -
           JSONRPCMessage.create_request ~id ~meth:Method.ToolsList

     

       424
       -
             ~params:(Some params) ()

     

       425
       -
       

     

       426
       -
         let create_response ~id ~tools ?next_cursor () =

     

       427
       -
           let result = Response.yojson_of_t { tools; next_cursor } in

     

       428
       -
           JSONRPCMessage.create_response ~id ~result

     

       429
       -
       end

     

       430
       -
       

     

       431
       -
       (* Tools/Call *)

     

       432
       -
       module ToolsCall = struct

     

       433
       -
         module Request = struct

     

       434
       -
           type t = { name : string; arguments : Json.t }

     

       435
       -
       

     

       436
       -
           let yojson_of_t { name; arguments } =

     

       437
       -
             `Assoc [ ("name", `String name); ("arguments", arguments) ]

     

       438
       -
       

     

       439
       -
           let t_of_yojson = function

     

       440
       -
             | `Assoc fields as json ->

     

       441
       -
                 let name =

     

       442
       -
                   match List.assoc_opt "name" fields with

     

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

     

       444
       -
                   | _ -> Util.json_error "Missing or invalid 'name' field" json

     

       445
       -
                 in

     

       446
       -
                 let arguments =

     

       447
       -
                   match List.assoc_opt "arguments" fields with

     

       448
       -
                   | Some json -> json

     

       449
       -
                   | None -> Util.json_error "Missing 'arguments' field" json

     

       450
       -
                 in

     

       451
       -
                 { name; arguments }

     

       452
       -
             | j -> Util.json_error "Expected object for ToolsCall.Request.t" j

     

       453
       -
         end

     

       454
       -
       

     

       455
       -
         module ToolContent = struct

     

       456
       -
           type t =

     

       457
       -
             | Text of TextContent.t

     

       458
       -
             | Image of ImageContent.t

     

       459
       -
             | Audio of AudioContent.t

     

       460
       -
             | Resource of EmbeddedResource.t

     

       461
       -
       

     

       462
       -
           let yojson_of_t = function

     

       463
       -
             | Text t -> TextContent.yojson_of_t t

     

       464
       -
             | Image i -> ImageContent.yojson_of_t i

     

       465
       -
             | Audio a -> AudioContent.yojson_of_t a

     

       466
       -
             | Resource r -> EmbeddedResource.yojson_of_t r

     

       467
       -
       

     

       468
       -
           let t_of_yojson json =

     

       469
       -
             match json with

     

       470
       -
             | `Assoc fields -> (

     

       471
       -
                 match List.assoc_opt "type" fields with

     

       472
       -
                 | Some (`String "text") -> Text (TextContent.t_of_yojson json)

     

       473
       -
                 | Some (`String "image") -> Image (ImageContent.t_of_yojson json)

     

       474
       -
                 | Some (`String "audio") -> Audio (AudioContent.t_of_yojson json)

     

       475
       -
                 | Some (`String "resource") ->

     

       476
       -
                     Resource (EmbeddedResource.t_of_yojson json)

     

       477
       -
                 | _ -> Util.json_error "Invalid or missing content type" json)

     

       478
       -
             | j -> Util.json_error "Expected object for ToolsCall.ToolContent.t" j

     

       479
       -
         end

     

       480
       -
       

     

       481
       -
         module Response = struct

     

       482
       -
           type t = { content : ToolContent.t list; is_error : bool }

     

       483
       -
       

     

       484
       -
           let yojson_of_t { content; is_error } =

     

       485
       -
             `Assoc

     

       486
       -
               [

     

       487
       -
                 ("content", `List (List.map ToolContent.yojson_of_t content));

     

       488
       -
                 ("isError", `Bool is_error);

     

       489
       -
               ]

     

       490
       -
       

     

       491
       -
           let t_of_yojson = function

     

       492
       -
             | `Assoc fields as json ->

     

       493
       -
                 let content =

     

       494
       -
                   match List.assoc_opt "content" fields with

     

       495
       -
                   | Some (`List items) -> List.map ToolContent.t_of_yojson items

     

       496
       -
                   | _ -> Util.json_error "Missing or invalid 'content' field" json

     

       497
       -
                 in

     

       498
       -
                 let is_error =

     

       499
       -
                   match List.assoc_opt "isError" fields with

     

       500
       -
                   | Some (`Bool b) -> b

     

       501
       -
                   | _ -> false

     

       502
       -
                 in

     

       503
       -
                 { content; is_error }

     

       504
       -
             | j -> Util.json_error "Expected object for ToolsCall.Response.t" j

     

       505
       -
         end

     

       506
       -
       

     

       507
       -
         (* Request/response creation helpers *)

     

       508
       -
         let create_request ~name ~arguments ?id () =

     

       509
       -
           let id = match id with Some i -> i | None -> `Int (Random.int 10000) in

     

       510
       -
           let params = Request.yojson_of_t { name; arguments } in

     

       511
       -
           JSONRPCMessage.create_request ~id ~meth:Method.ToolsCall

     

       512
       -
             ~params:(Some params) ()

     

       513
       -
       

     

       514
       -
         let create_response ~id ~content ~is_error () =

     

       515
       -
           let result = Response.yojson_of_t { content; is_error } in

     

       516
       -
           JSONRPCMessage.create_response ~id ~result

     

       517
       -
       end

     

       518
       -
       

     

       519
       -
       (* Prompts/List *)

     

       520
       -
       module PromptsList = struct

     

       521
       -
         module PromptArgument = struct

     

       522
       -
           type t = { name : string; description : string option; required : bool }

     

       523
       -
       

     

       524
       -
           let yojson_of_t { name; description; required } =

     

       525
       -
             let assoc = [ ("name", `String name) ] in

     

       526
       -
             let assoc =

     

       527
       -
               match description with

     

       528
       -
               | Some desc -> ("description", `String desc) :: assoc

     

       529
       -
               | None -> assoc

     

       530
       -
             in

     

       531
       -
             let assoc =

     

       532
       -
               if required then ("required", `Bool true) :: assoc else assoc

     

       533
       -
             in

     

       534
       -
             `Assoc assoc

     

       535
       -
       

     

       536
       -
           let t_of_yojson = function

     

       537
       -
             | `Assoc fields as json ->

     

       538
       -
                 let name =

     

       539
       -
                   match List.assoc_opt "name" fields with

     

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

     

       541
       -
                   | _ -> Util.json_error "Missing or invalid 'name' field" json

     

       542
       -
                 in

     

       543
       -
                 let description =

     

       544
       -
                   List.assoc_opt "description" fields

     

       545
       -
                   |> Option.map (function

     

       546
       -
                        | `String s -> s

     

       547
       -
                        | j -> Util.json_error "Expected string for description" j)

     

       548
       -
                 in

     

       549
       -
                 let required =

     

       550
       -
                   match List.assoc_opt "required" fields with

     

       551
       -
                   | Some (`Bool b) -> b

     

       552
       -
                   | _ -> false

     

       553
       -
                 in

     

       554
       -
                 { name; description; required }

     

       555
       -
             | j ->

     

       556
       -
                 Util.json_error "Expected object for PromptsList.PromptArgument.t" j

     

       557
       -
         end

     

       558
       -
       

     

       559
       -
         module Prompt = struct

     

       560
       -
           type t = {

     

       561
       -
             name : string;

     

       562
       -
             description : string option;

     

       563
       -
             arguments : PromptArgument.t list;

     

       564
       -
           }

     

       565
       -
       

     

       566
       -
           let yojson_of_t { name; description; arguments } =

     

       567
       -
             let assoc = [ ("name", `String name) ] in

     

       568
       -
             let assoc =

     

       569
       -
               match description with

     

       570
       -
               | Some desc -> ("description", `String desc) :: assoc

     

       571
       -
               | None -> assoc

     

       572
       -
             in

     

       573
       -
             let assoc =

     

       574
       -
               if arguments <> [] then

     

       575
       -
                 ("arguments", `List (List.map PromptArgument.yojson_of_t arguments))

     

       576
       -
                 :: assoc

     

       577
       -
               else assoc

     

       578
       -
             in

     

       579
       -
             `Assoc assoc

     

       580
       -
       

     

       581
       -
           let t_of_yojson = function

     

       582
       -
             | `Assoc fields as json ->

     

       583
       -
                 let name =

     

       584
       -
                   match List.assoc_opt "name" fields with

     

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

     

       586
       -
                   | _ -> Util.json_error "Missing or invalid 'name' field" json

     

       587
       -
                 in

     

       588
       -
                 let description =

     

       589
       -
                   List.assoc_opt "description" fields

     

       590
       -
                   |> Option.map (function

     

       591
       -
                        | `String s -> s

     

       592
       -
                        | j -> Util.json_error "Expected string for description" j)

     

       593
       -
                 in

     

       594
       -
                 let arguments =

     

       595
       -
                   match List.assoc_opt "arguments" fields with

     

       596
       -
                   | Some (`List items) -> List.map PromptArgument.t_of_yojson items

     

       597
       -
                   | _ -> []

     

       598
       -
                 in

     

       599
       -
                 { name; description; arguments }

     

       600
       -
             | j -> Util.json_error "Expected object for PromptsList.Prompt.t" j

     

       601
       -
         end

     

       602
       -
       

     

       603
       -
         module Request = struct

     

       604
       -
           type t = { cursor : Cursor.t option }

     

       605
       -
       

     

       606
       -
           let yojson_of_t { cursor } =

     

       607
       -
             let assoc = [] in

     

       608
       -
             let assoc =

     

       609
       -
               match cursor with

     

       610
       -
               | Some c -> ("cursor", Cursor.yojson_of_t c) :: assoc

     

       611
       -
               | None -> assoc

     

       612
       -
             in

     

       613
       -
             `Assoc assoc

     

       614
       -
       

     

       615
       -
           let t_of_yojson = function

     

       616
       -
             | `Assoc fields ->

     

       617
       -
                 let cursor =

     

       618
       -
                   List.assoc_opt "cursor" fields |> Option.map Cursor.t_of_yojson

     

       619
       -
                 in

     

       620
       -
                 { cursor }

     

       621
       -
             | j -> Util.json_error "Expected object for PromptsList.Request.t" j

     

       622
       -
         end

     

       623
       -
       

     

       624
       -
         module Response = struct

     

       625
       -
           type t = { prompts : Prompt.t list; next_cursor : Cursor.t option }

     

       626
       -
       

     

       627
       -
           let yojson_of_t { prompts; next_cursor } =

     

       628
       -
             let assoc =

     

       629
       -
               [ ("prompts", `List (List.map Prompt.yojson_of_t prompts)) ]

     

       630
       -
             in

     

       631
       -
             let assoc =

     

       632
       -
               match next_cursor with

     

       633
       -
               | Some c -> ("nextCursor", Cursor.yojson_of_t c) :: assoc

     

       634
       -
               | None -> assoc

     

       635
       -
             in

     

       636
       -
             `Assoc assoc

     

       637
       -
       

     

       638
       -
           let t_of_yojson = function

     

       639
       -
             | `Assoc fields as json ->

     

       640
       -
                 let prompts =

     

       641
       -
                   match List.assoc_opt "prompts" fields with

     

       642
       -
                   | Some (`List items) -> List.map Prompt.t_of_yojson items

     

       643
       -
                   | _ -> Util.json_error "Missing or invalid 'prompts' field" json

     

       644
       -
                 in

     

       645
       -
                 let next_cursor =

     

       646
       -
                   List.assoc_opt "nextCursor" fields |> Option.map Cursor.t_of_yojson

     

       647
       -
                 in

     

       648
       -
                 { prompts; next_cursor }

     

       649
       -
             | j -> Util.json_error "Expected object for PromptsList.Response.t" j

     

       650
       -
         end

     

       651
       -
       

     

       652
       -
         (* Request/response creation helpers *)

     

       653
       -
         let create_request ?cursor ?id () =

     

       654
       -
           let id = match id with Some i -> i | None -> `Int (Random.int 10000) in

     

       655
       -
           let params = Request.yojson_of_t { cursor } in

     

       656
       -
           JSONRPCMessage.create_request ~id ~meth:Method.PromptsList

     

       657
       -
             ~params:(Some params) ()

     

       658
       -
       

     

       659
       -
         let create_response ~id ~prompts ?next_cursor () =

     

       660
       -
           let result = Response.yojson_of_t { prompts; next_cursor } in

     

       661
       -
           JSONRPCMessage.create_response ~id ~result

     

       662
       -
       end

     

       663
       -
       

     

       664
       -
       (* Prompts/Get *)

     

       665
       -
       module PromptsGet = struct

     

       666
       -
         module Request = struct

     

       667
       -
           type t = { name : string; arguments : (string * string) list }

     

       668
       -
       

     

       669
       -
           let yojson_of_t { name; arguments } =

     

       670
       -
             let args_json =

     

       671
       -
               `Assoc (List.map (fun (k, v) -> (k, `String v)) arguments)

     

       672
       -
             in

     

       673
       -
             `Assoc [ ("name", `String name); ("arguments", args_json) ]

     

       674
       -
       

     

       675
       -
           let t_of_yojson = function

     

       676
       -
             | `Assoc fields as json ->

     

       677
       -
                 let name =

     

       678
       -
                   match List.assoc_opt "name" fields with

     

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

     

       680
       -
                   | _ -> Util.json_error "Missing or invalid 'name' field" json

     

       681
       -
                 in

     

       682
       -
                 let arguments =

     

       683
       -
                   match List.assoc_opt "arguments" fields with

     

       684
       -
                   | Some (`Assoc args) ->

     

       685
       -
                       List.map

     

       686
       -
                         (fun (k, v) ->

     

       687
       -
                           match v with

     

       688
       -
                           | `String s -> (k, s)

     

       689
       -
                           | _ ->

     

       690
       -
                               Util.json_error "Expected string value for argument" v)

     

       691
       -
                         args

     

       692
       -
                   | _ -> []

     

       693
       -
                 in

     

       694
       -
                 { name; arguments }

     

       695
       -
             | j -> Util.json_error "Expected object for PromptsGet.Request.t" j

     

       696
       -
         end

     

       697
       -
       

     

       698
       -
         module Response = struct

     

       699
       -
           type t = { description : string option; messages : PromptMessage.t list }

     

       700
       -
       

     

       701
       -
           let yojson_of_t { description; messages } =

     

       702
       -
             let assoc =

     

       703
       -
               [ ("messages", `List (List.map PromptMessage.yojson_of_t messages)) ]

     

       704
       -
             in

     

       705
       -
             let assoc =

     

       706
       -
               match description with

     

       707
       -
               | Some desc -> ("description", `String desc) :: assoc

     

       708
       -
               | None -> assoc

     

       709
       -
             in

     

       710
       -
             `Assoc assoc

     

       711
       -
       

     

       712
       -
           let t_of_yojson = function

     

       713
       -
             | `Assoc fields as json ->

     

       714
       -
                 let messages =

     

       715
       -
                   match List.assoc_opt "messages" fields with

     

       716
       -
                   | Some (`List items) -> List.map PromptMessage.t_of_yojson items

     

       717
       -
                   | _ -> Util.json_error "Missing or invalid 'messages' field" json

     

       718
       -
                 in

     

       719
       -
                 let description =

     

       720
       -
                   List.assoc_opt "description" fields

     

       721
       -
                   |> Option.map (function

     

       722
       -
                        | `String s -> s

     

       723
       -
                        | j -> Util.json_error "Expected string for description" j)

     

       724
       -
                 in

     

       725
       -
                 { description; messages }

     

       726
       -
             | j -> Util.json_error "Expected object for PromptsGet.Response.t" j

     

       727
       -
         end

     

       728
       -
       

     

       729
       -
         (* Request/response creation helpers *)

     

       730
       -
         let create_request ~name ~arguments ?id () =

     

       731
       -
           let id = match id with Some i -> i | None -> `Int (Random.int 10000) in

     

       732
       -
           let params = Request.yojson_of_t { name; arguments } in

     

       733
       -
           JSONRPCMessage.create_request ~id ~meth:Method.PromptsGet

     

       734
       -
             ~params:(Some params) ()

     

       735
       -
       

     

       736
       -
         let create_response ~id ?description ~messages () =

     

       737
       -
           let result = Response.yojson_of_t { description; messages } in

     

       738
       -
           JSONRPCMessage.create_response ~id ~result

     

       739
       -
       end

     

       740
       -
       

     

       741
       -
       (* List Changed Notifications *)

     

       742
       -
       module ListChanged = struct

     

       743
       -
         (* No parameters for these notifications *)

     

       744
       -
       

     

       745
       -
         let create_resources_notification () =

     

       746
       -
           JSONRPCMessage.create_notification ~meth:Method.ResourcesListChanged ()

     

       747
       -
       

     

       748
       -
         let create_tools_notification () =

     

       749
       -
           JSONRPCMessage.create_notification ~meth:Method.ToolsListChanged ()

     

       750
       -
       

     

       751
       -
         let create_prompts_notification () =

     

       752
       -
           JSONRPCMessage.create_notification ~meth:Method.PromptsListChanged ()

     

       753
       -
       end

     

       754
       -
       

     

       755
       -
       (* Resource Updated Notification *)

     

       756
       -
       module ResourceUpdated = struct

     

       757
       -
         module Notification = struct

     

       758
       -
           type t = { uri : string }

     

       759
       -
       

     

       760
       -
           let yojson_of_t { uri } = `Assoc [ ("uri", `String uri) ]

     

       761
       -
       

     

       762
       -
           let t_of_yojson = function

     

       763
       -
             | `Assoc fields as json ->

     

       764
       -
                 let uri =

     

       765
       -
                   match List.assoc_opt "uri" fields with

     

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

     

       767
       -
                   | _ -> Util.json_error "Missing or invalid 'uri' field" json

     

       768
       -
                 in

     

       769
       -
                 { uri }

     

       770
       -
             | j ->

     

       771
       -
                 Util.json_error "Expected object for ResourceUpdated.Notification.t" j

     

       772
       -
         end

     

       773
       -
       

     

       774
       -
         let create_notification ~uri () =

     

       775
       -
           let params = Notification.yojson_of_t { uri } in

     

       776
       -
           JSONRPCMessage.create_notification ~meth:Method.ResourcesUpdated

     

       777
       -
             ~params:(Some params) ()

     

       778
       -
       end

     

       779
       -
       

     

       780
       -
       (* Progress Notification *)

     

       781
       -
       module Progress = struct

     

       782
       -
         module Notification = struct

     

       783
       -
           type t = {

     

       784
       -
             progress : float;

     

       785
       -
             total : float;

     

       786
       -
             progress_token : ProgressToken.t;

     

       787
       -
           }

     

       788
       -
       

     

       789
       -
           let yojson_of_t { progress; total; progress_token } =

     

       790
       -
             `Assoc

     

       791
       -
               [

     

       792
       -
                 ("progress", `Float progress);

     

       793
       -
                 ("total", `Float total);

     

       794
       -
                 ("progressToken", ProgressToken.yojson_of_t progress_token);

     

       795
       -
               ]

     

       796
       -
       

     

       797
       -
           let t_of_yojson = function

     

       798
       -
             | `Assoc fields as json ->

     

       799
       -
                 let progress =

     

       800
       -
                   match List.assoc_opt "progress" fields with

     

       801
       -
                   | Some (`Float f) -> f

     

       802
       -
                   | _ -> Util.json_error "Missing or invalid 'progress' field" json

     

       803
       -
                 in

     

       804
       -
                 let total =

     

       805
       -
                   match List.assoc_opt "total" fields with

     

       806
       -
                   | Some (`Float f) -> f

     

       807
       -
                   | _ -> Util.json_error "Missing or invalid 'total' field" json

     

       808
       -
                 in

     

       809
       -
                 let progress_token =

     

       810
       -
                   match List.assoc_opt "progressToken" fields with

     

       811
       -
                   | Some token -> ProgressToken.t_of_yojson token

     

       812
       -
                   | _ ->

     

       813
       -
                       Util.json_error "Missing or invalid 'progressToken' field" json

     

       814
       -
                 in

     

       815
       -
                 { progress; total; progress_token }

     

       816
       -
             | j -> Util.json_error "Expected object for Progress.Notification.t" j

     

       817
       -
         end

     

       818
       -
       

     

       819
       -
         let create_notification ~progress ~total ~progress_token () =

     

       820
       -
           let params = Notification.yojson_of_t { progress; total; progress_token } in

     

       821
       -
           JSONRPCMessage.create_notification ~meth:Method.Progress

     

       822
       -
             ~params:(Some params) ()

     

       823
       -
       end

     

       824
       -
       

     

       825
       -
       (* Type aliases for backward compatibility *)

     

       826
       -
       type request = ResourcesList.Request.t

     

       827
       -
       type response = ResourcesList.Response.t

     

       828
       -
       type resource = ResourcesList.Resource.t

     

       829
       -
       type resource_content = ResourcesRead.ResourceContent.t

     

       830
       -
       type tool = ToolsList.Tool.t

     

       831
       -
       type tool_content = ToolsCall.ToolContent.t

     

       832
       -
       type prompt = PromptsList.Prompt.t

     

       833
       -
       type prompt_argument = PromptsList.PromptArgument.t

-366

lib/mcp_rpc.mli

···

       1
       -
       (** Mcp_message - High-level RPC message definitions for Model Context Protocol

     

       2
       -
       *)

     

       3
       -
       

     

       4
       -
       open Mcp

     

       5
       -
       open Jsonrpc

     

       6
       -
       

     

       7
       -
       (** Resources/List - Request to list available resources *)

     

       8
       -
       module ResourcesList : sig

     

       9
       -
         (** Request parameters *)

     

       10
       -
         module Request : sig

     

       11
       -
           type t = { 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
       -
       

     

       26
       -
           include Json.Jsonable.S with type t := t

     

       27
       -
         end

     

       28
       -
       

     

       29
       -
         (** Response result *)

     

       30
       -
         module Response : sig

     

       31
       -
           type t = {

     

       32
       -
             resources : Resource.t list;  (** List of available resources *)

     

       33
       -
             next_cursor : Cursor.t option;  (** Optional cursor for the next page *)

     

       34
       -
           }

     

       35
       -
       

     

       36
       -
           include Json.Jsonable.S with type t := t

     

       37
       -
         end

     

       38
       -
       

     

       39
       -
         val create_request :

     

       40
       -
           ?cursor:Cursor.t -> ?id:RequestId.t -> unit -> JSONRPCMessage.t

     

       41
       -
         (** Create a resources/list request *)

     

       42
       -
       

     

       43
       -
         val create_response :

     

       44
       -
           id:RequestId.t ->

     

       45
       -
           resources:Resource.t list ->

     

       46
       -
           ?next_cursor:Cursor.t ->

     

       47
       -
           unit ->

     

       48
       -
           JSONRPCMessage.t

     

       49
       -
         (** Create a resources/list response *)

     

       50
       -
       end

     

       51
       -
       

     

       52
       -
       (** Resources/Templates/List - Request to list available resource templates *)

     

       53
       -
       module ListResourceTemplatesRequest : sig

     

       54
       -
         type t = { cursor : Cursor.t option  (** Optional pagination cursor *) }

     

       55
       -
       

     

       56
       -
         include Json.Jsonable.S with type t := t

     

       57
       -
       end

     

       58
       -
       

     

       59
       -
       (** Resources/Templates/List - Response with resource templates *)

     

       60
       -
       module ListResourceTemplatesResult : sig

     

       61
       -
         (** Resource Template definition *)

     

       62
       -
         module ResourceTemplate : sig

     

       63
       -
           type t = {

     

       64
       -
             uri_template : string;  (** URI template for the resource *)

     

       65
       -
             name : string;  (** Human-readable name *)

     

       66
       -
             description : string option;  (** Optional description *)

     

       67
       -
             mime_type : string option;  (** Optional MIME type *)

     

       68
       -
           }

     

       69
       -
       

     

       70
       -
           include Json.Jsonable.S with type t := t

     

       71
       -
         end

     

       72
       -
       

     

       73
       -
         type t = {

     

       74
       -
           resource_templates : ResourceTemplate.t list;

     

       75
       -
               (** List of available resource templates *)

     

       76
       -
           next_cursor : Cursor.t option;  (** Optional cursor for the next page *)

     

       77
       -
         }

     

       78
       -
       

     

       79
       -
         include Json.Jsonable.S with type t := t

     

       80
       -
       

     

       81
       -
         val create_request :

     

       82
       -
           ?cursor:Cursor.t -> ?id:RequestId.t -> unit -> JSONRPCMessage.t

     

       83
       -
         (** Create a resources/templates/list request *)

     

       84
       -
       

     

       85
       -
         val create_response :

     

       86
       -
           id:RequestId.t ->

     

       87
       -
           resource_templates:ResourceTemplate.t list ->

     

       88
       -
           ?next_cursor:Cursor.t ->

     

       89
       -
           unit ->

     

       90
       -
           JSONRPCMessage.t

     

       91
       -
         (** Create a resources/templates/list response *)

     

       92
       -
       end

     

       93
       -
       

     

       94
       -
       (** Resources/Read - Request to read resource contents *)

     

       95
       -
       module ResourcesRead : sig

     

       96
       -
         (** Request parameters *)

     

       97
       -
         module Request : sig

     

       98
       -
           type t = { uri : string  (** URI of the resource to read *) }

     

       99
       -
       

     

       100
       -
           include Json.Jsonable.S with type t := t

     

       101
       -
         end

     

       102
       -
       

     

       103
       -
         (** Resource content *)

     

       104
       -
         module ResourceContent : sig

     

       105
       -
           type t =

     

       106
       -
             | TextResource of TextResourceContents.t  (** Text content *)

     

       107
       -
             | BlobResource of BlobResourceContents.t  (** Binary content *)

     

       108
       -
       

     

       109
       -
           include Json.Jsonable.S with type t := t

     

       110
       -
         end

     

       111
       -
       

     

       112
       -
         (** Response result *)

     

       113
       -
         module Response : sig

     

       114
       -
           type t = {

     

       115
       -
             contents : ResourceContent.t list;  (** List of resource contents *)

     

       116
       -
           }

     

       117
       -
       

     

       118
       -
           include Json.Jsonable.S with type t := t

     

       119
       -
         end

     

       120
       -
       

     

       121
       -
         val create_request : uri:string -> ?id:RequestId.t -> unit -> JSONRPCMessage.t

     

       122
       -
         (** Create a resources/read request *)

     

       123
       -
       

     

       124
       -
         val create_response :

     

       125
       -
           id:RequestId.t ->

     

       126
       -
           contents:ResourceContent.t list ->

     

       127
       -
           unit ->

     

       128
       -
           JSONRPCMessage.t

     

       129
       -
         (** Create a resources/read response *)

     

       130
       -
       end

     

       131
       -
       

     

       132
       -
       (** Tools/List - Request to list available tools *)

     

       133
       -
       module ToolsList : sig

     

       134
       -
         (** Request parameters *)

     

       135
       -
         module Request : sig

     

       136
       -
           type t = { cursor : Cursor.t option  (** Optional pagination cursor *) }

     

       137
       -
       

     

       138
       -
           include Json.Jsonable.S with type t := t

     

       139
       -
         end

     

       140
       -
       

     

       141
       -
         (** Tool definition *)

     

       142
       -
         module Tool : sig

     

       143
       -
           type t = {

     

       144
       -
             name : string;  (** Unique identifier for the tool *)

     

       145
       -
             description : string option;  (** Human-readable description *)

     

       146
       -
             input_schema : Json.t;  (** JSON Schema defining expected parameters *)

     

       147
       -
             annotations : Json.t option;

     

       148
       -
                 (** Optional properties describing tool behavior *)

     

       149
       -
           }

     

       150
       -
       

     

       151
       -
           include Json.Jsonable.S with type t := t

     

       152
       -
         end

     

       153
       -
       

     

       154
       -
         (** Response result *)

     

       155
       -
         module Response : sig

     

       156
       -
           type t = {

     

       157
       -
             tools : Tool.t list;  (** List of available tools *)

     

       158
       -
             next_cursor : Cursor.t option;  (** Optional cursor for the next page *)

     

       159
       -
           }

     

       160
       -
       

     

       161
       -
           include Json.Jsonable.S with type t := t

     

       162
       -
         end

     

       163
       -
       

     

       164
       -
         val create_request :

     

       165
       -
           ?cursor:Cursor.t -> ?id:RequestId.t -> unit -> JSONRPCMessage.t

     

       166
       -
         (** Create a tools/list request *)

     

       167
       -
       

     

       168
       -
         val create_response :

     

       169
       -
           id:RequestId.t ->

     

       170
       -
           tools:Tool.t list ->

     

       171
       -
           ?next_cursor:Cursor.t ->

     

       172
       -
           unit ->

     

       173
       -
           JSONRPCMessage.t

     

       174
       -
         (** Create a tools/list response *)

     

       175
       -
       end

     

       176
       -
       

     

       177
       -
       (** Tools/Call - Request to invoke a tool *)

     

       178
       -
       module ToolsCall : sig

     

       179
       -
         (** Request parameters *)

     

       180
       -
         module Request : sig

     

       181
       -
           type t = {

     

       182
       -
             name : string;  (** Name of the tool to call *)

     

       183
       -
             arguments : Json.t;  (** Arguments for the tool invocation *)

     

       184
       -
           }

     

       185
       -
       

     

       186
       -
           include Json.Jsonable.S with type t := t

     

       187
       -
         end

     

       188
       -
       

     

       189
       -
         (** Tool content *)

     

       190
       -
         module ToolContent : sig

     

       191
       -
           type t =

     

       192
       -
             | Text of TextContent.t  (** Text content *)

     

       193
       -
             | Image of ImageContent.t  (** Image content *)

     

       194
       -
             | Audio of AudioContent.t  (** Audio content *)

     

       195
       -
             | Resource of EmbeddedResource.t  (** Resource content *)

     

       196
       -
       

     

       197
       -
           include Json.Jsonable.S with type t := t

     

       198
       -
         end

     

       199
       -
       

     

       200
       -
         (** Response result *)

     

       201
       -
         module Response : sig

     

       202
       -
           type t = {

     

       203
       -
             content : ToolContent.t list;

     

       204
       -
                 (** List of content items returned by the tool *)

     

       205
       -
             is_error : bool;  (** Whether the result represents an error *)

     

       206
       -
           }

     

       207
       -
       

     

       208
       -
           include Json.Jsonable.S with type t := t

     

       209
       -
         end

     

       210
       -
       

     

       211
       -
         val create_request :

     

       212
       -
           name:string ->

     

       213
       -
           arguments:Json.t ->

     

       214
       -
           ?id:RequestId.t ->

     

       215
       -
           unit ->

     

       216
       -
           JSONRPCMessage.t

     

       217
       -
         (** Create a tools/call request *)

     

       218
       -
       

     

       219
       -
         val create_response :

     

       220
       -
           id:RequestId.t ->

     

       221
       -
           content:ToolContent.t list ->

     

       222
       -
           is_error:bool ->

     

       223
       -
           unit ->

     

       224
       -
           JSONRPCMessage.t

     

       225
       -
         (** Create a tools/call response *)

     

       226
       -
       end

     

       227
       -
       

     

       228
       -
       (** Prompts/List - Request to list available prompts *)

     

       229
       -
       module PromptsList : sig

     

       230
       -
         (** Prompt argument *)

     

       231
       -
         module PromptArgument : sig

     

       232
       -
           type t = {

     

       233
       -
             name : string;  (** Name of the argument *)

     

       234
       -
             description : string option;  (** Description of the argument *)

     

       235
       -
             required : bool;  (** Whether the argument is required *)

     

       236
       -
           }

     

       237
       -
       

     

       238
       -
           include Json.Jsonable.S with type t := t

     

       239
       -
         end

     

       240
       -
       

     

       241
       -
         (** Prompt definition *)

     

       242
       -
         module Prompt : sig

     

       243
       -
           type t = {

     

       244
       -
             name : string;  (** Unique identifier for the prompt *)

     

       245
       -
             description : string option;  (** Human-readable description *)

     

       246
       -
             arguments : PromptArgument.t list;  (** Arguments for customization *)

     

       247
       -
           }

     

       248
       -
       

     

       249
       -
           include Json.Jsonable.S with type t := t

     

       250
       -
         end

     

       251
       -
       

     

       252
       -
         (** Request parameters *)

     

       253
       -
         module Request : sig

     

       254
       -
           type t = { cursor : Cursor.t option  (** Optional pagination cursor *) }

     

       255
       -
       

     

       256
       -
           include Json.Jsonable.S with type t := t

     

       257
       -
         end

     

       258
       -
       

     

       259
       -
         (** Response result *)

     

       260
       -
         module Response : sig

     

       261
       -
           type t = {

     

       262
       -
             prompts : Prompt.t list;  (** List of available prompts *)

     

       263
       -
             next_cursor : Cursor.t option;  (** Optional cursor for the next page *)

     

       264
       -
           }

     

       265
       -
       

     

       266
       -
           include Json.Jsonable.S with type t := t

     

       267
       -
         end

     

       268
       -
       

     

       269
       -
         val create_request :

     

       270
       -
           ?cursor:Cursor.t -> ?id:RequestId.t -> unit -> JSONRPCMessage.t

     

       271
       -
         (** Create a prompts/list request *)

     

       272
       -
       

     

       273
       -
         val create_response :

     

       274
       -
           id:RequestId.t ->

     

       275
       -
           prompts:Prompt.t list ->

     

       276
       -
           ?next_cursor:Cursor.t ->

     

       277
       -
           unit ->

     

       278
       -
           JSONRPCMessage.t

     

       279
       -
         (** Create a prompts/list response *)

     

       280
       -
       end

     

       281
       -
       

     

       282
       -
       (** Prompts/Get - Request to get a prompt with arguments *)

     

       283
       -
       module PromptsGet : sig

     

       284
       -
         (** Request parameters *)

     

       285
       -
         module Request : sig

     

       286
       -
           type t = {

     

       287
       -
             name : string;  (** Name of the prompt to get *)

     

       288
       -
             arguments : (string * string) list;  (** Arguments for the prompt *)

     

       289
       -
           }

     

       290
       -
       

     

       291
       -
           include Json.Jsonable.S with type t := t

     

       292
       -
         end

     

       293
       -
       

     

       294
       -
         (** Response result *)

     

       295
       -
         module Response : sig

     

       296
       -
           type t = {

     

       297
       -
             description : string option;  (** Description of the prompt *)

     

       298
       -
             messages : PromptMessage.t list;  (** List of messages in the prompt *)

     

       299
       -
           }

     

       300
       -
       

     

       301
       -
           include Json.Jsonable.S with type t := t

     

       302
       -
         end

     

       303
       -
       

     

       304
       -
         val create_request :

     

       305
       -
           name:string ->

     

       306
       -
           arguments:(string * string) list ->

     

       307
       -
           ?id:RequestId.t ->

     

       308
       -
           unit ->

     

       309
       -
           JSONRPCMessage.t

     

       310
       -
         (** Create a prompts/get request *)

     

       311
       -
       

     

       312
       -
         val create_response :

     

       313
       -
           id:RequestId.t ->

     

       314
       -
           ?description:string ->

     

       315
       -
           messages:PromptMessage.t list ->

     

       316
       -
           unit ->

     

       317
       -
           JSONRPCMessage.t

     

       318
       -
         (** Create a prompts/get response *)

     

       319
       -
       end

     

       320
       -
       

     

       321
       -
       (** List Changed Notifications *)

     

       322
       -
       module ListChanged : sig

     

       323
       -
         val create_resources_notification : unit -> JSONRPCMessage.t

     

       324
       -
         (** Create a resources/list_changed notification *)

     

       325
       -
       

     

       326
       -
         val create_tools_notification : unit -> JSONRPCMessage.t

     

       327
       -
         (** Create a tools/list_changed notification *)

     

       328
       -
       

     

       329
       -
         val create_prompts_notification : unit -> JSONRPCMessage.t

     

       330
       -
         (** Create a prompts/list_changed notification *)

     

       331
       -
       end

     

       332
       -
       

     

       333
       -
       (** Resource Updated Notification *)

     

       334
       -
       module ResourceUpdated : sig

     

       335
       -
         (** Notification parameters *)

     

       336
       -
         module Notification : sig

     

       337
       -
           type t = { uri : string  (** URI of the updated resource *) }

     

       338
       -
       

     

       339
       -
           include Json.Jsonable.S with type t := t

     

       340
       -
         end

     

       341
       -
       

     

       342
       -
         val create_notification : uri:string -> unit -> JSONRPCMessage.t

     

       343
       -
         (** Create a resources/updated notification *)

     

       344
       -
       end

     

       345
       -
       

     

       346
       -
       (** Progress Notification *)

     

       347
       -
       module Progress : sig

     

       348
       -
         (** Notification parameters *)

     

       349
       -
         module Notification : sig

     

       350
       -
           type t = {

     

       351
       -
             progress : float;  (** Current progress value *)

     

       352
       -
             total : float;  (** Total progress value *)

     

       353
       -
             progress_token : ProgressToken.t;  (** Token identifying the operation *)

     

       354
       -
           }

     

       355
       -
       

     

       356
       -
           include Json.Jsonable.S with type t := t

     

       357
       -
         end

     

       358
       -
       

     

       359
       -
         val create_notification :

     

       360
       -
           progress:float ->

     

       361
       -
           total:float ->

     

       362
       -
           progress_token:ProgressToken.t ->

     

       363
       -
           unit ->

     

       364
       -
           JSONRPCMessage.t

     

       365
       -
         (** Create a progress notification *)

     

       366
       -
       end

+293 -399

lib/mcp_sdk.ml

···

       3
        
       

     

       4
        
       (* SDK version *)

     

       5
        
       let version = "0.1.0"

     

       6
       -
       let src = Logs.Src.create "mcp.sdk" ~doc:"mcp.sdk logging"

     

       7
        
       

     

       8
       -
       module Log = (val Logs.src_log src : Logs.LOG)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       9
        
       

     

       10
        
       (* Context for tools and resources *)

     

       11
        
       module Context = struct

     

       12
        
         type t = {

     

       13
       -
           request_id : RequestId.t option;

     

       14
       -
           lifespan_context : (string * Json.t) list;

     

       15
       -
           progress_token : ProgressToken.t option;

     

       16
        
         }

     

       17
        
       

     

       18
       -
         let create ?request_id ?progress_token ?(lifespan_context = []) () =

     

       19
       -
           { request_id; lifespan_context; progress_token }

     

       20
       -
       

     

       21
       -
         let get_context_value ctx key = List.assoc_opt key ctx.lifespan_context

     

       22
        
       

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       23
        
         let report_progress ctx value total =

     

       24
       -
           match (ctx.progress_token, ctx.request_id) with

     

       25
        
           | Some token, Some _id ->

     

       26
       -
               let params =

     

       27
       -
                 `Assoc

     

       28
       -
                   [

     

       29
       -
                     ("progress", `Float value);

     

       30
       -
                     ("total", `Float total);

     

       31
       -
                     ("progressToken", ProgressToken.yojson_of_t token);

     

       32
       -
                   ]

     

       33
       -
               in

     

       34
       -
               Some

     

       35
       -
                 (create_notification ~meth:Method.Progress ~params:(Some params) ())

     

       36
        
           | _ -> None

     

       37
        
       end

     

       38
        
       

     
···

       41
        
         type handler = Context.t -> Json.t -> (Json.t, string) result

     

       42
        
       

     

       43
        
         type t = {

     

       44
       -
           name : string;

     

       45
       -
           description : string option;

     

       46
       -
           input_schema : Json.t; (* JSON Schema *)

     

       47
       -
           handler : handler;

     

       48
        
         }

     

       49
        
       

     

       50
       -
         let create ~name ?description ~input_schema ~handler () =

     

       51
        
           { name; description; input_schema; handler }

     

       52
        
       

     

       53
        
         let to_json tool =

     

       54
       -
           let assoc =

     

       55
       -
             [ ("name", `String tool.name); ("inputSchema", tool.input_schema) ]

     

       56
       -
           in

     

       57
       -
           let assoc =

     

       58
       -
             match tool.description with

     

       59
        
             | Some desc -> ("description", `String desc) :: assoc

     

       60
        
             | None -> assoc

     

       61
        
           in

     

       62
        
           `Assoc assoc

     

       63
       -
       

     

       64
       -
         (* Convert to Mcp_rpc.ToolsList.Tool.t *)

     

       65
       -
         let to_rpc_tool_list_tool (tool : t) =

     

       66
       -
           Mcp_rpc.ToolsList.Tool.

     

       67
       -
             {

     

       68
       -
               name = tool.name;

     

       69
       -
               description = tool.description;

     

       70
       -
               input_schema = tool.input_schema;

     

       71
       -
               annotations = None;

     

       72
       -
               (* Could be extended to support annotations *)

     

       73
       -
             }

     

       74
       -
       

     

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

     

       76
       -
         let to_rpc_tools_list tools = List.map to_rpc_tool_list_tool tools

     

       77
       -
       

     

       78
       -
         (* Convert Mcp_rpc.ToolsCall response content to Mcp.content list *)

     

       79
       -
         let rpc_content_to_mcp_content content =

     

       80
       -
           List.map

     

       81
       -
             (function

     

       82
       -
               | Mcp_rpc.ToolsCall.ToolContent.Text t ->

     

       83
       -
                   Mcp.Text { TextContent.text = t.text; annotations = None }

     

       84
       -
               | Mcp_rpc.ToolsCall.ToolContent.Image i ->

     

       85
       -
                   Mcp.Image

     

       86
       -
                     {

     

       87
       -
                       ImageContent.mime_type = i.mime_type;

     

       88
       -
                       data = i.data;

     

       89
       -
                       annotations = None;

     

       90
       -
                     }

     

       91
       -
               | Mcp_rpc.ToolsCall.ToolContent.Audio a ->

     

       92
       -
                   Mcp.Audio

     

       93
       -
                     {

     

       94
       -
                       AudioContent.mime_type = a.mime_type;

     

       95
       -
                       data = a.data;

     

       96
       -
                       annotations = None;

     

       97
       -
                     }

     

       98
       -
               | Mcp_rpc.ToolsCall.ToolContent.Resource r ->

     

       99
       -
                   (* Create a simple text resource from the embedded resource *)

     

       100
       -
                   let uri =

     

       101
       -
                     match r with

     

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

     

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

     

       104
       -
                   in

     

       105
       -
                   let text_content =

     

       106
       -
                     match r with

     

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

     

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

     

       109
       -
                   in

     

       110
       -
                   let mime_type =

     

       111
       -
                     match r with

     

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

     

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

     

       114
       -
                   in

     

       115
       -
                   let text_resource =

     

       116
       -
                     { TextResourceContents.uri; text = text_content; mime_type }

     

       117
       -
                   in

     

       118
       -
                   Mcp.Resource

     

       119
       -
                     {

     

       120
       -
                       EmbeddedResource.resource = `Text text_resource;

     

       121
       -
                       annotations = None;

     

       122
       -
                     })

     

       123
       -
             content

     

       124
       -
       

     

       125
       -
         (* Convert Mcp.content list to Mcp_rpc.ToolsCall.ToolContent.t list *)

     

       126
       -
         let mcp_content_to_rpc_content content =

     

       127
       -
           List.map

     

       128
       -
             (function

     

       129
       -
               | Mcp.Text t -> Mcp_rpc.ToolsCall.ToolContent.Text t

     

       130
       -
               | Mcp.Image img -> Mcp_rpc.ToolsCall.ToolContent.Image img

     

       131
       -
               | Mcp.Audio aud -> Mcp_rpc.ToolsCall.ToolContent.Audio aud

     

       132
       -
               | Mcp.Resource res ->

     

       133
       -
                   let resource_data =

     

       134
       -
                     match res.resource with

     

       135
       -
                     | `Text txt -> `Text txt

     

       136
       -
                     | `Blob blob -> `Blob blob

     

       137
       -
                   in

     

       138
       -
                   let resource =

     

       139
       -
                     {

     

       140
       -
                       EmbeddedResource.resource = resource_data;

     

       141
       -
                       annotations = res.annotations;

     

       142
       -
                     }

     

       143
       -
                   in

     

       144
       -
                   Mcp_rpc.ToolsCall.ToolContent.Resource resource)

     

       145
       -
             content

     

       146
       -
       

     

       147
       -
         (* Create a tool result with content *)

     

       148
       -
         let create_tool_result content ~is_error =

     

       149
       -
           `Assoc

     

       150
       -
             [

     

       151
       -
               ("content", `List (List.map Mcp.yojson_of_content content));

     

       152
       -
               ("isError", `Bool is_error);

     

       153
       -
             ]

     

       154
       -
       

     

       155
       -
         (* Create a tool error result with structured content *)

     

       156
       -
         let create_error_result error =

     

       157
       -
           Logs.err (fun m -> m "Error result: %s" error);

     

       158
       -
           create_tool_result [ Mcp.make_text_content error ] ~is_error:true

     

       159
       -
       

     

       160
       -
         (* Handle tool execution errors *)

     

       161
       -
         let handle_execution_error err =

     

       162
       -
           create_error_result (Printf.sprintf "Error executing tool: %s" err)

     

       163
       -
       

     

       164
       -
         (* Handle unknown tool error *)

     

       165
       -
         let handle_unknown_tool_error name =

     

       166
       -
           create_error_result (Printf.sprintf "Unknown tool: %s" name)

     

       167
       -
       

     

       168
       -
         (* Handle general tool execution exception *)

     

       169
       -
         let handle_execution_exception exn =

     

       170
       -
           create_error_result

     

       171
       -
             (Printf.sprintf "Internal error: %s" (Printexc.to_string exn))

     

       172
        
       end

     

       173
        
       

     

       174
        
       (* Resources for the MCP server *)

     
···

       176
        
         type handler = Context.t -> string list -> (string, string) result

     

       177
        
       

     

       178
        
         type t = {

     

       179
       -
           uri : string; (* For resources, this is the exact URI (no variables) *)

     

       180
       -
           name : string;

     

       181
       -
           description : string option;

     

       182
       -
           mime_type : string option;

     

       183
       -
           handler : handler;

     

       184
        
         }

     

       185
        
       

     

       186
       -
         let create ~uri ~name ?description ?mime_type ~handler () =

     

       187
       -
           (* Validate that the URI doesn't contain template variables *)

     

       188
       -
           if String.contains uri '{' || String.contains uri '}' then

     

       189
       -
             Logs.warn (fun m ->

     

       190
       -
                 m

     

       191
       -
                   "Resource '%s' contains template variables. Consider using \

     

       192
       -
                    add_resource_template instead."

     

       193
       -
                   uri);

     

       194
       -
           { uri; name; description; mime_type; handler }

     

       195
        
       

     

       196
        
         let to_json resource =

     

       197
       -
           let assoc =

     

       198
       -
             [ ("uri", `String resource.uri); ("name", `String resource.name) ]

     

       199
       -
           in

     

       200
       -
           let assoc =

     

       201
       -
             match resource.description with

     

       202
        
             | Some desc -> ("description", `String desc) :: assoc

     

       203
        
             | None -> assoc

     

       204
        
           in

     

       205
       -
           let assoc =

     

       206
       -
             match resource.mime_type with

     

       207
        
             | Some mime -> ("mimeType", `String mime) :: assoc

     

       208
        
             | None -> assoc

     

       209
        
           in

     

       210
        
           `Assoc assoc

     

       211
       -
       

     

       212
       -
         (* Convert to Mcp_rpc.ResourcesList.Resource.t *)

     

       213
       -
         let to_rpc_resource_list_resource (resource : t) =

     

       214
       -
           Mcp_rpc.ResourcesList.Resource.

     

       215
       -
             {

     

       216
       -
               uri = resource.uri;

     

       217
       -
               name = resource.name;

     

       218
       -
               description = resource.description;

     

       219
       -
               mime_type = resource.mime_type;

     

       220
       -
               size = None;

     

       221
       -
               (* 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 *)

     

       230
        
       module Prompt = struct

     

       231
        
         type argument = {

     

       232
       -
           name : string;

     

       233
       -
           description : string option;

     

       234
       -
           required : bool;

     

       235
        
         }

     

       236
        
       

     

       237
       -
         type message = { role : Role.t; content : content }

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       238
        
       

     

       239
       -
         type handler =

     

       240
       -
           Context.t -> (string * string) list -> (message list, string) result

     

       241
        
       

     

       242
        
         type t = {

     

       243
       -
           name : string;

     

       244
       -
           description : string option;

     

       245
       -
           arguments : argument list;

     

       246
       -
           handler : handler;

     

       247
        
         }

     

       248
        
       

     

       249
       -
         let create ~name ?description ?(arguments = []) ~handler () =

     

       250
        
           { name; description; arguments; handler }

     

       251
        
       

     

       252
       -
         let create_argument ~name ?description ?(required = false) () =

     

       253
        
           { name; description; required }

     

       254
        
       

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       255
        
         let to_json prompt =

     

       256
       -
           let assoc = [ ("name", `String prompt.name) ] in

     

       257
       -
           let assoc =

     

       258
       -
             match prompt.description with

     

       0
        
       
     

       259
        
             | Some desc -> ("description", `String desc) :: assoc

     

       260
        
             | None -> assoc

     

       261
        
           in

     

       262
       -
           let assoc =

     

       263
       -
             if prompt.arguments <> [] then

     

       264
       -
               let args =

     

       265
       -
                 List.map

     

       266
       -
                   (fun (arg : argument) ->

     

       267
       -
                     let arg_assoc = [ ("name", `String arg.name) ] in

     

       268
       -
                     let arg_assoc =

     

       269
       -
                       match arg.description with

     

       270
       -
                       | Some desc -> ("description", `String desc) :: arg_assoc

     

       271
       -
                       | None -> arg_assoc

     

       272
       -
                     in

     

       273
       -
                     let arg_assoc =

     

       274
       -
                       if arg.required then ("required", `Bool true) :: arg_assoc

     

       275
       -
                       else arg_assoc

     

       276
       -
                     in

     

       277
       -
                     `Assoc arg_assoc)

     

       278
       -
                   prompt.arguments

     

       279
        
               in

     

       280
       -
               ("arguments", `List args) :: assoc

     

       281
       -
             else assoc

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       282
        
           in

     

       283
        
           `Assoc assoc

     

       284
       -
       

     

       285
       -
         (* Convert argument to Mcp_rpc.PromptsList.PromptArgument.t *)

     

       286
       -
         let argument_to_rpc_prompt_argument (arg : argument) =

     

       287
       -
           Mcp_rpc.PromptsList.PromptArgument.

     

       288
       -
             {

     

       289
       -
               name = arg.name;

     

       290
       -
               description = arg.description;

     

       291
       -
               required = arg.required;

     

       292
       -
             }

     

       293
       -
       

     

       294
       -
         (* Convert to Mcp_rpc.PromptsList.Prompt.t *)

     

       295
       -
         let to_rpc_prompt_list_prompt (prompt : t) =

     

       296
       -
           Mcp_rpc.PromptsList.Prompt.

     

       297
       -
             {

     

       298
       -
               name = prompt.name;

     

       299
       -
               description = prompt.description;

     

       300
       -
               arguments = List.map argument_to_rpc_prompt_argument prompt.arguments;

     

       301
       -
             }

     

       302
        
       

     

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

     

       304
       -
         let to_rpc_prompts_list prompts = List.map to_rpc_prompt_list_prompt prompts

     

       0
        
       
     

       305
        
       

     

       306
       -
         (* Convert message to Mcp_rpc.PromptMessage.t *)

     

       307
       -
         let message_to_rpc_prompt_message msg =

     

       308
       -
           { PromptMessage.role = msg.role; PromptMessage.content = msg.content }

     

       309
        
       

     

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

     

       311
       -
         let messages_to_rpc_prompt_messages messages =

     

       312
       -
           List.map message_to_rpc_prompt_message messages

     

       313
       -
       end

     

       314
        
       

     

       315
       -
       let make_tool_schema properties required =

     

       316
       -
         let props =

     

       317
       -
           List.map

     

       318
       -
             (fun (name, schema_type, description) ->

     

       319
       -
               ( name,

     

       320
       -
                 `Assoc

     

       321
       -
                   [

     

       322
       -
                     ("type", `String schema_type); ("description", `String description);

     

       323
       -
                   ] ))

     

       324
       -
             properties

     

       325
       -
         in

     

       326
       -
         let required_json = `List (List.map (fun name -> `String name) required) in

     

       327
       -
         `Assoc

     

       328
       -
           [

     

       329
       -
             ("type", `String "object");

     

       330
       -
             ("properties", `Assoc props);

     

       331
       -
             ("required", required_json);

     

       332
       -
           ]

     

       333
        
       

     

       334
       -
       (* Resource Templates for the MCP server *)

     

       335
       -
       module ResourceTemplate = struct

     

       336
       -
         type handler = Context.t -> string list -> (string, string) result

     

       337
        
       

     

       338
       -
         type t = {

     

       339
       -
           uri_template : string;

     

       340
       -
           name : string;

     

       341
       -
           description : string option;

     

       342
       -
           mime_type : string option;

     

       343
       -
           handler : handler;

     

       344
       -
         }

     

       345
        
       

     

       346
       -
         let create ~uri_template ~name ?description ?mime_type ~handler () =

     

       347
       -
           { uri_template; name; description; mime_type; handler }

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       348
        
       

     

       349
       -
         let to_json resource_template =

     

       350
       -
           let assoc =

     

       351
       -
             [

     

       352
       -
               ("uriTemplate", `String resource_template.uri_template);

     

       353
       -
               ("name", `String resource_template.name);

     

       354
       -
             ]

     

       355
       -
           in

     

       356
       -
           let assoc =

     

       357
       -
             match resource_template.description with

     

       358
       -
             | Some desc -> ("description", `String desc) :: assoc

     

       359
       -
             | None -> assoc

     

       360
       -
           in

     

       361
       -
           let assoc =

     

       362
       -
             match resource_template.mime_type with

     

       363
       -
             | Some mime -> ("mimeType", `String mime) :: assoc

     

       364
       -
             | None -> assoc

     

       365
       -
           in

     

       366
       -
           `Assoc assoc

     

       367
        
       

     

       368
       -
         (* Convert to Mcp_rpc.ResourceTemplatesList.ResourceTemplate.t *)

     

       369
       -
         let to_rpc_resource_template (template : t) =

     

       370
       -
           Mcp_rpc.ListResourceTemplatesResult.ResourceTemplate.

     

       371
       -
             {

     

       372
       -
               uri_template = template.uri_template;

     

       373
       -
               name = template.name;

     

       374
       -
               description = template.description;

     

       375
       -
               mime_type = template.mime_type;

     

       376
       -
             }

     

       377
       -
       

     

       378
       -
         (* Convert a list of ResourceTemplate.t to the format needed for resources/templates/list response *)

     

       379
       -
         let to_rpc_resource_templates_list templates =

     

       380
       -
           List.map to_rpc_resource_template templates

     

       381
       -
       end

     

       382
        
       

     

       383
        
       (* Main server type *)

     

       384
        
       type server = {

     

       385
       -
         name : string;

     

       386
       -
         version : string;

     

       387
       -
         protocol_version : string;

     

       388
       -
         lifespan_context : (string * Json.t) list;

     

       389
       -
         mutable capabilities : Json.t;

     

       390
       -
         mutable tools : Tool.t list;

     

       391
       -
         mutable resources : Resource.t list;

     

       392
       -
         mutable resource_templates : ResourceTemplate.t list;

     

       393
       -
         mutable prompts : Prompt.t list;

     

       0
        
       
     

       394
        
       }

     

       395
        
       

     

       396
       -
       let name { name; _ } = name

     

       397
       -
       let version { version; _ } = version

     

       398
       -
       let capabilities { capabilities; _ } = capabilities

     

       399
       -
       let lifespan_context { lifespan_context; _ } = lifespan_context

     

       400
       -
       let protocol_version { protocol_version; _ } = protocol_version

     

       401
       -
       let tools { tools; _ } = tools

     

       402
       -
       let resources { resources; _ } = resources

     

       403
       -
       let resource_templates { resource_templates; _ } = resource_templates

     

       404
       -
       let prompts { prompts; _ } = prompts

     

       405
       -
       

     

       406
        
       (* Create a new server *)

     

       407
       -
       let create_server ~name ?(version = "0.1.0") ?(protocol_version = "2024-11-05")

     

       408
       -
           () =

     

       409
       -
         {

     

       410
        
           name;

     

       411
        
           version;

     

       412
        
           protocol_version;

     

       413
        
           capabilities = `Assoc [];

     

       414
        
           tools = [];

     

       415
        
           resources = [];

     

       416
       -
           resource_templates = [];

     

       417
        
           prompts = [];

     

       418
        
           lifespan_context = [];

     

       0
        
       
     

       0
        
       
     

       419
        
         }

     

       420
        
       

     

       421
        
       (* Default capabilities for the server *)

     

       422
       -
       let default_capabilities ?(with_tools = true) ?(with_resources = false)

     

       423
       -
           ?(with_resource_templates = false) ?(with_prompts = false) () =

     

       424
        
         let caps = [] in

     

       425
       -
         let caps =

     

       426
       -
           if with_tools then ("tools", `Assoc [ ("listChanged", `Bool true) ]) :: caps

     

       427
       -
           else caps

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       428
        
         in

     

       429
       -
         let caps =

     

       430
        
           if with_resources then

     

       431
       -
             ( "resources",

     

       432
       -
               `Assoc [ ("listChanged", `Bool true); ("subscribe", `Bool false) ] )

     

       433
       -
             :: caps

     

       0
        
       
     

       434
        
           else if not with_resources then

     

       435
       -
             ( "resources",

     

       436
       -
               `Assoc [ ("listChanged", `Bool false); ("subscribe", `Bool false) ] )

     

       437
       -
             :: caps

     

       438
       -
           else caps

     

       439
       -
         in

     

       440
       -
         let caps =

     

       441
       -
           if with_resource_templates then

     

       442
       -
             ("resourceTemplates", `Assoc [ ("listChanged", `Bool true) ]) :: caps

     

       443
       -
           else if not with_resource_templates then

     

       444
       -
             ("resourceTemplates", `Assoc [ ("listChanged", `Bool false) ]) :: caps

     

       445
       -
           else caps

     

       446
        
         in

     

       447
       -
         let caps =

     

       448
        
           if with_prompts then

     

       449
       -
             ("prompts", `Assoc [ ("listChanged", `Bool true) ]) :: caps

     

       0
        
       
     

       0
        
       
     

       450
        
           else if not with_prompts then

     

       451
       -
             ("prompts", `Assoc [ ("listChanged", `Bool false) ]) :: caps

     

       452
       -
           else caps

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       453
        
         in

     

       454
        
         `Assoc caps

     

       455
        
       

     
···

       459
        
         tool

     

       460
        
       

     

       461
        
       (* Create and register a tool in one step *)

     

       462
       -
       let add_tool server ~name ?description ?(schema_properties = [])

     

       463
       -
           ?(schema_required = []) handler =

     

       464
        
         let input_schema = make_tool_schema schema_properties schema_required in

     

       465
        
         let handler' ctx args =

     

       466
       -
           try Ok (handler args) with exn -> Error (Printexc.to_string exn)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       467
        
         in

     

       468
       -
         let tool =

     

       469
       -
           Tool.create ~name ?description ~input_schema ~handler:handler' ()

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       470
        
         in

     

       471
        
         register_tool server tool

     

       472
        
       

     
···

       476
        
         resource

     

       477
        
       

     

       478
        
       (* Create and register a resource in one step *)

     

       479
       -
       let add_resource server ~uri ~name ?description ?mime_type handler =

     

       480
        
         let handler' _ctx params =

     

       481
       -
           try Ok (handler params) with exn -> Error (Printexc.to_string exn)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       482
        
         in

     

       483
       -
         let resource =

     

       484
       -
           Resource.create ~uri ~name ?description ?mime_type ~handler:handler' ()

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       485
        
         in

     

       486
        
         register_resource server resource

     

       487
        
       

     

       488
       -
       (* Register a resource template *)

     

       489
       -
       let register_resource_template server template =

     

       490
       -
         server.resource_templates <- template :: server.resource_templates;

     

       491
       -
         template

     

       492
       -
       

     

       493
       -
       (* Create and register a resource template in one step *)

     

       494
       -
       let add_resource_template server ~uri_template ~name ?description ?mime_type

     

       495
       -
           handler =

     

       496
       -
         let handler' _ctx params =

     

       497
       -
           try Ok (handler params) with exn -> Error (Printexc.to_string exn)

     

       498
       -
         in

     

       499
       -
         let template =

     

       500
       -
           ResourceTemplate.create ~uri_template ~name ?description ?mime_type

     

       501
       -
             ~handler:handler' ()

     

       502
       -
         in

     

       503
       -
         register_resource_template server template

     

       504
       -
       

     

       505
        
       (* Register a prompt *)

     

       506
        
       let register_prompt server prompt =

     

       507
        
         server.prompts <- prompt :: server.prompts;

     

       508
        
         prompt

     

       509
        
       

     

       510
        
       (* Create and register a prompt in one step *)

     

       511
       -
       let add_prompt server ~name ?description ?(arguments = []) handler =

     

       512
       -
         let prompt_args =

     

       513
       -
           List.map

     

       514
       -
             (fun (name, desc, required) ->

     

       515
       -
               Prompt.create_argument ~name ?description:desc ~required ())

     

       516
       -
             arguments

     

       517
       -
         in

     

       518
        
         let handler' _ctx args =

     

       519
       -
           try Ok (handler args) with exn -> Error (Printexc.to_string exn)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       520
        
         in

     

       521
       -
         let prompt =

     

       522
       -
           Prompt.create ~name ?description ~arguments:prompt_args ~handler:handler' ()

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       523
        
         in

     

       524
        
         register_prompt server prompt

     

       525
        
       

     

       526
        
       (* Set server capabilities *)

     

       527
       -
       let set_capabilities server capabilities = server.capabilities <- capabilities

     

       0
        
       
     

       528
        
       

     

       529
        
       (* Configure server with default capabilities based on registered components *)

     

       530
       -
       let configure_server server ?with_tools ?with_resources ?with_resource_templates

     

       531
       -
           ?with_prompts () =

     

       532
       -
         let with_tools =

     

       533
       -
           match with_tools with Some b -> b | None -> server.tools <> []

     

       534
        
         in

     

       535
       -
         let with_resources =

     

       536
       -
           match with_resources with Some b -> b | None -> server.resources <> []

     

       0
        
       
     

       537
        
         in

     

       538
       -
         let with_resource_templates =

     

       539
       -
           match with_resource_templates with

     

       540
        
           | Some b -> b

     

       541
       -
           | None -> server.resource_templates <> []

     

       542
       -
         in

     

       543
       -
         let with_prompts =

     

       544
       -
           match with_prompts with Some b -> b | None -> server.prompts <> []

     

       545
       -
         in

     

       546
       -
         let capabilities =

     

       547
       -
           default_capabilities ~with_tools ~with_resources ~with_resource_templates

     

       548
       -
             ~with_prompts ()

     

       549
        
         in

     

       0
        
       
     

       550
        
         set_capabilities server capabilities;

     

       551
        
         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

···

       3
        
       

     

       4
        
       (* SDK version *)

     

       5
        
       let version = "0.1.0"

     

       0
        
       
     

       6
        
       

     

       7
       +
       (* Logging utilities *)

     

       8
       +
       module Log = struct

     

       9
       +
         type level = Debug | Info | Warning | Error

     

       10
       +
       

     

       11
       +
         let string_of_level = function

     

       12
       +
           | Debug -> "DEBUG"

     

       13
       +
           | Info -> "INFO"

     

       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

     

       25
       +
       end

     

       26
        
       

     

       27
        
       (* Context for tools and resources *)

     

       28
        
       module Context = struct

     

       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 }

     

       0
        
       
     

       0
        
       
     

       37
        
       

     

       38
       +
         let get_context_value ctx key =

     

       39
       +
           List.assoc_opt key ctx.lifespan_context

     

       40
       +
         

     

       41
        
         let report_progress ctx value total =

     

       42
       +
           match ctx.progress_token, ctx.request_id with

     

       43
        
           | Some token, Some _id ->

     

       44
       +
             let params = `Assoc [

     

       45
       +
               ("progress", `Float value);

     

       46
       +
               ("total", `Float total);

     

       47
       +
               ("progressToken", ProgressToken.yojson_of_t token)

     

       48
       +
             ] in

     

       49
       +
             Some (create_notification ~method_:"notifications/progress" ~params:(Some params) ())

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       50
        
           | _ -> None

     

       51
        
       end

     

       52
        
       

     
···

       55
        
         type handler = Context.t -> Json.t -> (Json.t, string) result

     

       56
        
       

     

       57
        
         type t = {

     

       58
       +
           name: string;

     

       59
       +
           description: string option;

     

       60
       +
           input_schema: Json.t;  (* JSON Schema *)

     

       61
       +
           handler: handler;

     

       62
        
         }

     

       63
        
       

     

       64
       +
         let create ~name ?description ~input_schema ~handler () = 

     

       65
        
           { name; description; input_schema; handler }

     

       66
        
       

     

       67
        
         let to_json tool =

     

       68
       +
           let assoc = [

     

       69
       +
             ("name", `String tool.name);

     

       70
       +
             ("inputSchema", tool.input_schema);

     

       71
       +
           ] in

     

       72
       +
           let assoc = match tool.description with

     

       73
        
             | Some desc -> ("description", `String desc) :: assoc

     

       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
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       77
        
       end

     

       78
        
       

     

       79
        
       (* Resources for the MCP server *)

     
···

       81
        
         type handler = Context.t -> string list -> (string, string) result

     

       82
        
       

     

       83
        
         type t = {

     

       84
       +
           uri_template: string;

     

       85
       +
           description: string option;

     

       86
       +
           mime_type: string option;

     

       87
       +
           handler: handler;

     

       0
        
       
     

       88
        
         }

     

       89
        
       

     

       90
       +
         let create ~uri_template ?description ?mime_type ~handler () = 

     

       91
       +
           { uri_template; description; mime_type; handler }

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       92
        
       

     

       93
        
         let to_json resource =

     

       94
       +
           let assoc = [

     

       95
       +
             ("uriTemplate", `String resource.uri_template);

     

       96
       +
           ] in

     

       97
       +
           let assoc = match resource.description with

     

       0
        
       
     

       98
        
             | Some desc -> ("description", `String desc) :: assoc

     

       99
        
             | None -> assoc

     

       100
        
           in

     

       101
       +
           let assoc = match resource.mime_type with

     

       0
        
       
     

       102
        
             | Some mime -> ("mimeType", `String mime) :: assoc

     

       103
        
             | None -> assoc

     

       104
        
           in

     

       105
        
           `Assoc assoc

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       106
        
       end

     

       107
        
       

     

       108
        
       (* Prompts for the MCP server *)

     

       109
        
       module Prompt = struct

     

       110
        
         type argument = {

     

       111
       +
           name: string;

     

       112
       +
           description: string option;

     

       113
       +
           required: bool;

     

       114
        
         }

     

       115
        
       

     

       116
       +
         type message = {

     

       117
       +
           role: Role.t;

     

       118
       +
           content: content;

     

       119
       +
         }

     

       120
        
       

     

       121
       +
         type handler = Context.t -> (string * string) list -> (message list, string) result

     

       0
        
       
     

       122
        
       

     

       123
        
         type t = {

     

       124
       +
           name: string;

     

       125
       +
           description: string option;

     

       126
       +
           arguments: argument list;

     

       127
       +
           handler: handler;

     

       128
        
         }

     

       129
        
       

     

       130
       +
         let create ~name ?description ?(arguments=[]) ~handler () = 

     

       131
        
           { name; description; arguments; handler }

     

       132
        
       

     

       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);

     

       171
       +
           ] in

     

       172
       +
           let assoc = match prompt.description with

     

       173
        
             | Some desc -> ("description", `String desc) :: assoc

     

       174
        
             | None -> assoc

     

       175
        
           in

     

       176
       +
           let assoc = if prompt.arguments <> [] then

     

       177
       +
             let args = List.map (fun (arg: argument) ->

     

       178
       +
               let arg_assoc = [

     

       179
       +
                 ("name", `String arg.name);

     

       180
       +
               ] in

     

       181
       +
               let arg_assoc = match arg.description with

     

       182
       +
                 | Some desc -> ("description", `String desc) :: arg_assoc

     

       183
       +
                 | None -> arg_assoc

     

       184
       +
               in

     

       185
       +
               let arg_assoc = 

     

       186
       +
                 if arg.required then

     

       187
       +
                   ("required", `Bool true) :: arg_assoc

     

       188
       +
                 else

     

       189
       +
                   arg_assoc

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       190
        
               in

     

       191
       +
               `Assoc arg_assoc

     

       192
       +
             ) prompt.arguments in

     

       193
       +
             ("arguments", `List args) :: assoc

     

       194
       +
           else

     

       195
       +
             assoc

     

       196
        
           in

     

       197
        
           `Assoc assoc

     

       198
       +
       end

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       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 })

     

       0
        
       
     

       206
        
       

     

       207
       +
       let make_image_content data mime_type =

     

       208
       +
         Image (ImageContent.{ data; mime_type; annotations = None })

     

       0
        
       
     

       0
        
       
     

       209
        
       

     

       210
       +
       let make_image_content_with_annotations data mime_type annotations =

     

       211
       +
         Image (ImageContent.{ data; mime_type; annotations = Some annotations })

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       212
        
       

     

       213
       +
       let make_audio_content data mime_type =

     

       214
       +
         Audio (AudioContent.{ data; mime_type; annotations = None })

     

       0
        
       
     

       215
        
       

     

       216
       +
       let make_audio_content_with_annotations data mime_type annotations =

     

       217
       +
         Audio (AudioContent.{ data; mime_type; annotations = Some annotations })

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       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
       +
         })

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       230
        
       

     

       231
       +
       let make_tool_schema properties required =

     

       232
       +
         let props = List.map (fun (name, schema_type, description) ->

     

       233
       +
           (name, `Assoc [

     

       234
       +
             ("type", `String schema_type);

     

       235
       +
             ("description", `String description)

     

       236
       +
           ])

     

       237
       +
         ) properties in

     

       238
       +
         let required_json = `List (List.map (fun name -> `String name) required) in

     

       239
       +
         `Assoc [

     

       240
       +
           ("type", `String "object");

     

       241
       +
           ("properties", `Assoc props);

     

       242
       +
           ("required", required_json)

     

       243
       +
         ]

     

       0
        
       
     

       244
        
       

     

       245
        
       (* Main server type *)

     

       246
        
       type server = {

     

       247
       +
         name: string;

     

       248
       +
         version: string;

     

       249
       +
         protocol_version: string;

     

       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
        
       }

     

       258
        
       

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       259
        
       (* Create a new server *)

     

       260
       +
       let create_server ~name ?(version="0.1.0") ?(protocol_version="2024-11-05") () =

     

       261
       +
         { 

     

       0
        
       
     

       262
        
           name;

     

       263
        
           version;

     

       264
        
           protocol_version;

     

       265
        
           capabilities = `Assoc [];

     

       266
        
           tools = [];

     

       267
        
           resources = [];

     

       0
        
       
     

       268
        
           prompts = [];

     

       269
        
           lifespan_context = [];

     

       270
       +
           startup_hook = None;

     

       271
       +
           shutdown_hook = None;

     

       272
        
         }

     

       273
        
       

     

       274
        
       (* Default capabilities for the server *)

     

       275
       +
       let default_capabilities ?(with_tools=true) ?(with_resources=false) ?(with_prompts=false) () =

     

       0
        
       
     

       276
        
         let caps = [] in

     

       277
       +
         let caps = 

     

       278
       +
           if with_tools then

     

       279
       +
             ("tools", `Assoc [

     

       280
       +
               ("listChanged", `Bool true)

     

       281
       +
             ]) :: caps

     

       282
       +
           else

     

       283
       +
             caps

     

       284
        
         in

     

       285
       +
         let caps = 

     

       286
        
           if with_resources then

     

       287
       +
             ("resources", `Assoc [

     

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

     

       289
       +
               ("subscribe", `Bool false)

     

       290
       +
             ]) :: caps

     

       291
        
           else if not with_resources then

     

       292
       +
             ("resources", `Assoc [

     

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

     

       294
       +
               ("subscribe", `Bool false)

     

       295
       +
             ]) :: caps

     

       296
       +
           else

     

       297
       +
             caps

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       298
        
         in

     

       299
       +
         let caps = 

     

       300
        
           if with_prompts then

     

       301
       +
             ("prompts", `Assoc [

     

       302
       +
               ("listChanged", `Bool true)

     

       303
       +
             ]) :: caps

     

       304
        
           else if not with_prompts then

     

       305
       +
             ("prompts", `Assoc [

     

       306
       +
               ("listChanged", `Bool false)

     

       307
       +
             ]) :: caps

     

       308
       +
           else

     

       309
       +
             caps

     

       310
        
         in

     

       311
        
         `Assoc caps

     

       312
        
       

     
···

       316
        
         tool

     

       317
        
       

     

       318
        
       (* Create and register a tool in one step *)

     

       319
       +
       let add_tool server ~name ?description ?(schema_properties=[]) ?(schema_required=[]) handler =

     

       0
        
       
     

       320
        
         let input_schema = make_tool_schema schema_properties schema_required in

     

       321
        
         let handler' ctx args =

     

       322
       +
           try

     

       323
       +
             Ok (handler args)

     

       324
       +
           with exn ->

     

       325
       +
             Error (Printexc.to_string exn)

     

       326
        
         in

     

       327
       +
         let tool = Tool.create

     

       328
       +
           ~name

     

       329
       +
           ?description

     

       330
       +
           ~input_schema

     

       331
       +
           ~handler:handler'

     

       332
       +
           ()

     

       333
        
         in

     

       334
        
         register_tool server tool

     

       335
        
       

     
···

       339
        
         resource

     

       340
        
       

     

       341
        
       (* Create and register a resource in one step *)

     

       342
       +
       let add_resource server ~uri_template ?description ?mime_type handler =

     

       343
        
         let handler' _ctx params =

     

       344
       +
           try

     

       345
       +
             Ok (handler params)

     

       346
       +
           with exn ->

     

       347
       +
             Error (Printexc.to_string exn)

     

       348
        
         in

     

       349
       +
         let resource = Resource.create

     

       350
       +
           ~uri_template

     

       351
       +
           ?description

     

       352
       +
           ?mime_type

     

       353
       +
           ~handler:handler'

     

       354
       +
           ()

     

       355
        
         in

     

       356
        
         register_resource server resource

     

       357
        
       

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       358
        
       (* Register a prompt *)

     

       359
        
       let register_prompt server prompt =

     

       360
        
         server.prompts <- prompt :: server.prompts;

     

       361
        
         prompt

     

       362
        
       

     

       363
        
       (* Create and register a prompt in one step *)

     

       364
       +
       let add_prompt server ~name ?description ?(arguments=[]) handler =

     

       365
       +
         let prompt_args = List.map (fun (name, desc, required) ->

     

       366
       +
           Prompt.create_argument ~name ?description:desc ~required ()

     

       367
       +
         ) arguments in

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       368
        
         let handler' _ctx args =

     

       369
       +
           try

     

       370
       +
             Ok (handler args)

     

       371
       +
           with exn ->

     

       372
       +
             Error (Printexc.to_string exn)

     

       373
        
         in

     

       374
       +
         let prompt = Prompt.create

     

       375
       +
           ~name

     

       376
       +
           ?description

     

       377
       +
           ~arguments:prompt_args

     

       378
       +
           ~handler:handler'

     

       379
       +
           ()

     

       380
        
         in

     

       381
        
         register_prompt server prompt

     

       382
        
       

     

       383
        
       (* Set server capabilities *)

     

       384
       +
       let set_capabilities server capabilities =

     

       385
       +
         server.capabilities <- capabilities

     

       386
        
       

     

       387
        
       (* Configure server with default capabilities based on registered components *)

     

       388
       +
       let configure_server server ?with_tools ?with_resources ?with_prompts () =

     

       389
       +
         let with_tools = match with_tools with

     

       390
       +
           | Some b -> b

     

       391
       +
           | None -> server.tools <> []

     

       392
        
         in

     

       393
       +
         let with_resources = match with_resources with

     

       394
       +
           | Some b -> b

     

       395
       +
           | None -> server.resources <> []

     

       396
        
         in

     

       397
       +
         let with_prompts = match with_prompts with

     

       0
        
       
     

       398
        
           | Some b -> b

     

       399
       +
           | None -> server.prompts <> []

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       400
        
         in

     

       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

+102 -203

lib/mcp_sdk.mli

···

       3
        
       open Mcp

     

       4
        
       open Jsonrpc

     

       5
        
       

     

       6
       -
       val version : string

     

       7
        
       (** SDK version *)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       8
        
       

     

       9
        
       (** Context for tools and resources *)

     

       10
        
       module Context : sig

     

       11
       -
         type t

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       12
        
       

     

       13
       -
         val create :

     

       14
       -
           ?request_id:RequestId.t ->

     

       15
       -
           ?progress_token:ProgressToken.t ->

     

       16
       -
           ?lifespan_context:(string * Json.t) list ->

     

       17
       -
           unit ->

     

       18
       -
           t

     

       19
       -
       

     

       20
        
         val get_context_value : t -> string -> Json.t option

     

       21
        
         val report_progress : t -> float -> float -> JSONRPCMessage.t option

     

       22
        
       end

     
···

       26
        
         type handler = Context.t -> Json.t -> (Json.t, string) result

     

       27
        
       

     

       28
        
         type t = {

     

       29
       -
           name : string;

     

       30
       -
           description : string option;

     

       31
       -
           input_schema : Json.t;

     

       32
       -
           handler : handler;

     

       33
        
         }

     

       34
        
       

     

       35
       -
         val create :

     

       36
       -
           name:string ->

     

       37
       -
           ?description:string ->

     

       38
       -
           input_schema:Json.t ->

     

       39
       -
           handler:handler ->

     

       40
       -
           unit ->

     

       41
       -
           t

     

       42
       -
       

     

       43
        
         val to_json : t -> Json.t

     

       44
       -
       

     

       45
       -
         val to_rpc_tool_list_tool : t -> Mcp_rpc.ToolsList.Tool.t

     

       46
       -
         (** Convert to Mcp_rpc.ToolsList.Tool.t *)

     

       47
       -
       

     

       48
       -
         val to_rpc_tools_list : t list -> Mcp_rpc.ToolsList.Tool.t list

     

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

     

       50
       -
       

     

       51
       -
         val rpc_content_to_mcp_content :

     

       52
       -
           Mcp_rpc.ToolsCall.ToolContent.t list -> Mcp.content list

     

       53
       -
         (** Convert Mcp_rpc.ToolsCall response content to Mcp.content list *)

     

       54
       -
       

     

       55
       -
         val mcp_content_to_rpc_content :

     

       56
       -
           Mcp.content list -> Mcp_rpc.ToolsCall.ToolContent.t list

     

       57
       -
         (** Convert Mcp.content list to Mcp_rpc.ToolsCall.ToolContent.t list *)

     

       58
       -
       

     

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

     

       60
       -
         (** Create a tool result with content *)

     

       61
       -
       

     

       62
       -
         val create_error_result : string -> Json.t

     

       63
       -
         (** Create a tool error result with structured content *)

     

       64
       -
       

     

       65
       -
         val handle_execution_error : string -> Json.t

     

       66
       -
         (** Handle tool execution errors *)

     

       67
       -
       

     

       68
       -
         val handle_unknown_tool_error : string -> Json.t

     

       69
       -
         (** Handle unknown tool error *)

     

       70
       -
       

     

       71
       -
         val handle_execution_exception : exn -> Json.t

     

       72
       -
         (** Handle general tool execution exception *)

     

       73
        
       end

     

       74
        
       

     

       75
        
       (** Resources for the MCP server *)

     
···

       77
        
         type handler = Context.t -> string list -> (string, string) result

     

       78
        
       

     

       79
        
         type t = {

     

       80
       -
           uri : string;

     

       81
       -
           name : string;

     

       82
       -
           description : string option;

     

       83
       -
           mime_type : string option;

     

       84
       -
           handler : handler;

     

       85
       -
         }

     

       86
       -
       

     

       87
       -
         val create :

     

       88
       -
           uri:string ->

     

       89
       -
           name:string ->

     

       90
       -
           ?description:string ->

     

       91
       -
           ?mime_type:string ->

     

       92
       -
           handler:handler ->

     

       93
       -
           unit ->

     

       94
       -
           t

     

       95
       -
       

     

       96
       -
         val to_json : t -> Json.t

     

       97
       -
       

     

       98
       -
         val to_rpc_resource_list_resource : t -> Mcp_rpc.ResourcesList.Resource.t

     

       99
       -
         (** Convert to Mcp_rpc.ResourcesList.Resource.t *)

     

       100
       -
       

     

       101
       -
         val to_rpc_resources_list : t list -> Mcp_rpc.ResourcesList.Resource.t list

     

       102
       -
         (** Convert a list of Resource.t to the format needed for resources/list

     

       103
       -
             response *)

     

       104
       -
       end

     

       105
       -
       

     

       106
       -
       (** Resource Templates for the MCP server *)

     

       107
       -
       module ResourceTemplate : sig

     

       108
       -
         type handler = Context.t -> string list -> (string, string) result

     

       109
       -
       

     

       110
       -
         type t = {

     

       111
       -
           uri_template : string;

     

       112
       -
           name : string;

     

       113
       -
           description : string option;

     

       114
       -
           mime_type : string option;

     

       115
       -
           handler : handler;

     

       116
        
         }

     

       117
        
       

     

       118
       -
         val create :

     

       119
       -
           uri_template:string ->

     

       120
       -
           name:string ->

     

       121
       -
           ?description:string ->

     

       122
       -
           ?mime_type:string ->

     

       123
       -
           handler:handler ->

     

       124
       -
           unit ->

     

       125
       -
           t

     

       126
       -
       

     

       127
        
         val to_json : t -> Json.t

     

       128
       -
       

     

       129
       -
         val to_rpc_resource_template :

     

       130
       -
           t -> Mcp_rpc.ListResourceTemplatesResult.ResourceTemplate.t

     

       131
       -
         (** Convert to Mcp_rpc.ResourceTemplatesList.ResourceTemplate.t *)

     

       132
       -
       

     

       133
       -
         val to_rpc_resource_templates_list :

     

       134
       -
           t list -> Mcp_rpc.ListResourceTemplatesResult.ResourceTemplate.t list

     

       135
       -
         (** Convert a list of ResourceTemplate.t to the format needed for

     

       136
       -
             resources/templates/list response *)

     

       137
        
       end

     

       138
        
       

     

       139
        
       (** Prompts for the MCP server *)

     

       140
        
       module Prompt : sig

     

       141
        
         type argument = {

     

       142
       -
           name : string;

     

       143
       -
           description : string option;

     

       144
       -
           required : bool;

     

       145
        
         }

     

       146
        
       

     

       147
       -
         type message = { role : Role.t; content : content }

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       148
        
       

     

       149
       -
         type handler =

     

       150
       -
           Context.t -> (string * string) list -> (message list, string) result

     

       151
        
       

     

       152
        
         type t = {

     

       153
       -
           name : string;

     

       154
       -
           description : string option;

     

       155
       -
           arguments : argument list;

     

       156
       -
           handler : handler;

     

       157
        
         }

     

       158
        
       

     

       159
       -
         val create :

     

       160
       -
           name:string ->

     

       161
       -
           ?description:string ->

     

       162
       -
           ?arguments:argument list ->

     

       163
       -
           handler:handler ->

     

       164
       -
           unit ->

     

       165
       -
           t

     

       166
       -
       

     

       167
       -
         val create_argument :

     

       168
       -
           name:string -> ?description:string -> ?required:bool -> unit -> argument

     

       169
       -
       

     

       170
        
         val to_json : t -> Json.t

     

       171
       -
       

     

       172
       -
         val argument_to_rpc_prompt_argument :

     

       173
       -
           argument -> Mcp_rpc.PromptsList.PromptArgument.t

     

       174
       -
         (** Convert argument to Mcp_rpc.PromptsList.PromptArgument.t *)

     

       175
       -
       

     

       176
       -
         val to_rpc_prompt_list_prompt : t -> Mcp_rpc.PromptsList.Prompt.t

     

       177
       -
         (** Convert to Mcp_rpc.PromptsList.Prompt.t *)

     

       178
       -
       

     

       179
       -
         val to_rpc_prompts_list : t list -> Mcp_rpc.PromptsList.Prompt.t list

     

       180
       -
         (** Convert a list of Prompt.t to the format needed for prompts/list response

     

       181
       -
         *)

     

       182
       -
       

     

       183
       -
         val message_to_rpc_prompt_message : message -> PromptMessage.t

     

       184
       -
         (** Convert message to Mcp_rpc.PromptMessage.t *)

     

       185
       -
       

     

       186
       -
         val messages_to_rpc_prompt_messages : message list -> PromptMessage.t list

     

       187
       -
         (** Convert a list of messages to the format needed for prompts/get response

     

       188
       -
         *)

     

       189
        
       end

     

       190
        
       

     

       191
       -
       type server

     

       192
        
       (** Main server type *)

     

       193
       -
       

     

       194
       -
       val name : server -> string

     

       195
       -
       val version : server -> string

     

       196
       -
       val protocol_version : server -> string

     

       197
       -
       val capabilities : server -> Json.t

     

       198
       -
       val tools : server -> Tool.t list

     

       199
       -
       val resources : server -> Resource.t list

     

       200
       -
       val resource_templates : server -> ResourceTemplate.t list

     

       201
       -
       val prompts : server -> Prompt.t list

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       202
        
       

     

       203
       -
       val create_server :

     

       204
       -
         name:string -> ?version:string -> ?protocol_version:string -> unit -> server

     

       205
        
       (** Create a new server *)

     

       0
        
       
     

       206
        
       

     

       207
       -
       val default_capabilities :

     

       208
       -
         ?with_tools:bool ->

     

       209
       -
         ?with_resources:bool ->

     

       210
       -
         ?with_resource_templates:bool ->

     

       211
       -
         ?with_prompts:bool ->

     

       212
       -
         unit ->

     

       213
       -
         Json.t

     

       214
        
       (** Default capabilities for the server *)

     

       0
        
       
     

       215
        
       

     

       216
       -
       val add_tool :

     

       217
       -
         server ->

     

       218
       -
         name:string ->

     

       219
       -
         ?description:string ->

     

       220
       -
         ?schema_properties:(string * string * string) list ->

     

       221
       -
         ?schema_required:string list ->

     

       222
       -
         (Json.t -> Json.t) ->

     

       223
       -
         Tool.t

     

       224
        
       (** Create and register a tool in one step *)

     

       0
        
       
     

       225
        
       

     

       226
       -
       val add_resource :

     

       227
       -
         server ->

     

       228
       -
         uri:string ->

     

       229
       -
         name:string ->

     

       230
       -
         ?description:string ->

     

       231
       -
         ?mime_type:string ->

     

       232
       -
         (string list -> string) ->

     

       233
       -
         Resource.t

     

       234
        
       (** Create and register a resource in one step *)

     

       0
        
       
     

       235
        
       

     

       236
       -
       val add_resource_template :

     

       237
       -
         server ->

     

       238
       -
         uri_template:string ->

     

       239
       -
         name:string ->

     

       240
       -
         ?description:string ->

     

       241
       -
         ?mime_type:string ->

     

       242
       -
         (string list -> string) ->

     

       243
       -
         ResourceTemplate.t

     

       244
       -
       (** Create and register a resource template in one step *)

     

       245
        
       

     

       246
       -
       val add_prompt :

     

       247
       -
         server ->

     

       248
       -
         name:string ->

     

       249
       -
         ?description:string ->

     

       250
       -
         ?arguments:(string * string option * bool) list ->

     

       251
       -
         ((string * string) list -> Prompt.message list) ->

     

       252
       -
         Prompt.t

     

       253
        
       (** Create and register a prompt in one step *)

     

       0
        
       
     

       254
        
       

     

       255
       -
       val configure_server :

     

       256
       -
         server ->

     

       257
       -
         ?with_tools:bool ->

     

       258
       -
         ?with_resources:bool ->

     

       259
       -
         ?with_resource_templates:bool ->

     

       260
       -
         ?with_prompts:bool ->

     

       261
       -
         unit ->

     

       262
       -
         server

     

       263
        
       (** Configure server with default capabilities based on registered components *)

     

       0
        
       
     

       264
        
       

     

       265
       -
       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

···

       3
        
       open Mcp

     

       4
        
       open Jsonrpc

     

       5
        
       

     

       0
        
       
     

       6
        
       (** SDK version *)

     

       7
       +
       val version : string

     

       8
       +
       

     

       9
       +
       (** Logging utilities *)

     

       10
       +
       module Log : sig

     

       11
       +
         type level = Debug | Info | Warning | Error

     

       12
       +
       

     

       13
       +
         val string_of_level : level -> string

     

       14
       +
       

     

       15
       +
         val log : level -> string -> unit

     

       16
       +
         val debug : string -> unit

     

       17
       +
         val info : string -> unit

     

       18
       +
         val warning : string -> unit

     

       19
       +
         val error : string -> unit

     

       20
       +
       end

     

       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

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       31
        
         val get_context_value : t -> string -> Json.t option

     

       32
        
         val report_progress : t -> float -> float -> JSONRPCMessage.t option

     

       33
        
       end

     
···

       37
        
         type handler = Context.t -> Json.t -> (Json.t, string) result

     

       38
        
       

     

       39
        
         type t = {

     

       40
       +
           name: string;

     

       41
       +
           description: string option;

     

       42
       +
           input_schema: Json.t;

     

       43
       +
           handler: handler;

     

       44
        
         }

     

       45
        
       

     

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

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       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
        
       
     

       0
        
       
     

       0
        
       
     

       48
        
       end

     

       49
        
       

     

       50
        
       (** Resources for the MCP server *)

     
···

       52
        
         type handler = Context.t -> string list -> (string, string) result

     

       53
        
       

     

       54
        
         type t = {

     

       55
       +
           uri_template: string;

     

       56
       +
           description: string option;

     

       57
       +
           mime_type: string option;

     

       58
       +
           handler: handler;

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       59
        
         }

     

       60
        
       

     

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

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       62
        
         val to_json : t -> Json.t

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       63
        
       end

     

       64
        
       

     

       65
        
       (** Prompts for the MCP server *)

     

       66
        
       module Prompt : sig

     

       67
        
         type argument = {

     

       68
       +
           name: string;

     

       69
       +
           description: string option;

     

       70
       +
           required: bool;

     

       71
        
         }

     

       72
        
       

     

       73
       +
         type message = {

     

       74
       +
           role: Role.t;

     

       75
       +
           content: content;

     

       76
       +
         }

     

       77
        
       

     

       78
       +
         type handler = Context.t -> (string * string) list -> (message list, string) result

     

       0
        
       
     

       79
        
       

     

       80
        
         type t = {

     

       81
       +
           name: string;

     

       82
       +
           description: string option;

     

       83
       +
           arguments: argument list;

     

       84
       +
           handler: handler;

     

       85
        
         }

     

       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

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       91
        
         val to_json : t -> Json.t

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       92
        
       end

     

       93
        
       

     

       0
        
       
     

       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
        
       

     

       0
        
       
     

       0
        
       
     

       108
        
       (** Create a new server *)

     

       109
       +
       val create_server : name:string -> ?version:string -> ?protocol_version:string -> unit -> server

     

       110
        
       

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       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
       +
       

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       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
       +
       

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       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

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       128
        
       

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       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
       +
       

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       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

+507 -539

lib/mcp_server.ml

···

       1
        
       open Mcp

     

       2
       -
       open Jsonrpc

     

       3
        
       open Mcp_sdk

     

       4
        
       

     

       5
       -
       let src = Logs.Src.create "mcp.sdk" ~doc:"mcp.sdk logging"

     

       6
       -
       

     

       7
       -
       module Log = (val Logs.src_log src : Logs.LOG)

     

       8
       -
       

     

       9
       -
       (* Create a proper JSONRPC error with code and data *)

     

       10
       -
       let create_jsonrpc_error id code message ?data () =

     

       11
       -
         let error_code = ErrorCode.to_int code in

     

       12
       -
         let error_data = match data with Some d -> d | None -> `Null in

     

       13
       -
         create_error ~id ~code:error_code ~message ~data:(Some error_data) ()

     

       14
       -
       

     

       15
       -
       (* Process initialize request *)

     

       16
       -
       let handle_initialize server req =

     

       17
       -
         Log.debug (fun m -> m "Processing initialize request");

     

       18
       -
         let result =

     

       19
       -
           match req.JSONRPCMessage.params with

     

       20
       -
           | Some params ->

     

       21
       -
               let req_data = Initialize.Request.t_of_yojson params in

     

       22
       -
               Logs.debug (fun m ->

     

       23
       -
                   m "Client info: %s v%s" req_data.client_info.name

     

       24
       -
                     req_data.client_info.version);

     

       25
       -
               Log.debug (fun m ->

     

       26
       -
                   m "Client protocol version: %s" req_data.protocol_version);

     

       27
       -
       

     

       28
       -
               (* Create initialize response *)

     

       29
       -
               let result =

     

       30
       -
                 Initialize.Result.create ~capabilities:(capabilities server)

     

       31
       -
                   ~server_info:

     

       32
       -
                     Implementation.{ name = name server; version = version server }

     

       33
       -
                   ~protocol_version:(protocol_version server)

     

       34
       -
                   ~instructions:

     

       35
       -
                     (Printf.sprintf "This server provides tools for %s." (name server))

     

       36
       -
                   ()

     

       37
       -
               in

     

       38
       -
               Initialize.Result.yojson_of_t result

     

       39
       -
           | None ->

     

       40
       -
               Log.err (fun m -> m "Missing params for initialize request");

     

       41
       -
               `Assoc [ ("error", `String "Missing params for initialize request") ]

     

       42
       -
         in

     

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

     

       44
       -
       

     

       45
       -
       (* Process tools/list request *)

     

       46
       -
       let handle_tools_list server (req : JSONRPCMessage.request) =

     

       47
       -
         Log.debug (fun m -> m "Processing tools/list request");

     

       48
       -
         let tools_list = Tool.to_rpc_tools_list (tools server) in

     

       49
       -
         let response =

     

       50
       -
           Mcp_rpc.ToolsList.create_response ~id:req.id ~tools:tools_list ()

     

       51
       -
         in

     

       52
       -
         Some response

     

       53
       -
       

     

       54
       -
       (* Process prompts/list request *)

     

       55
       -
       let handle_prompts_list server (req : JSONRPCMessage.request) =

     

       56
       -
         Log.debug (fun m -> m "Processing prompts/list request");

     

       57
       -
         let prompts_list = Prompt.to_rpc_prompts_list (prompts server) in

     

       58
       -
         let response =

     

       59
       -
           Mcp_rpc.PromptsList.create_response ~id:req.id ~prompts:prompts_list ()

     

       60
       -
         in

     

       61
       -
         Some response

     

       62
       -
       

     

       63
       -
       (* Process resources/list request *)

     

       64
       -
       let handle_resources_list server (req : JSONRPCMessage.request) =

     

       65
       -
         Log.debug (fun m -> m "Processing resources/list request");

     

       66
       -
         let resources_list = Resource.to_rpc_resources_list (resources server) in

     

       67
       -
         let response =

     

       68
       -
           Mcp_rpc.ResourcesList.create_response ~id:req.id ~resources:resources_list

     

       69
       -
             ()

     

       70
       -
         in

     

       71
       -
         Some response

     

       72
       -
       

     

       73
       -
       (* Process resources/templates/list request *)

     

       74
       -
       let handle_resource_templates_list server (req : JSONRPCMessage.request) =

     

       75
       -
         Log.debug (fun m -> m "Processing resources/templates/list request");

     

       76
       -
         let templates_list =

     

       77
       -
           ResourceTemplate.to_rpc_resource_templates_list (resource_templates server)

     

       78
       -
         in

     

       79
       -
         let response =

     

       80
       -
           Mcp_rpc.ListResourceTemplatesResult.create_response ~id:req.id

     

       81
       -
             ~resource_templates:templates_list ()

     

       82
       -
         in

     

       83
       -
         Some response

     

       84
       -
       

     

       85
       -
       (* Utility module for resource template matching *)

     

       86
       -
       module Resource_matcher = struct

     

       87
       -
         (* Define variants for resource handling result *)

     

       88
       -
         type resource_match =

     

       89
       -
           | DirectResource of Resource.t * string list

     

       90
       -
           | TemplateResource of ResourceTemplate.t * string list

     

       91
       -
           | NoMatch

     

       92
       -
       

     

       93
       -
         (* Extract parameters from a template URI *)

     

       94
       -
         let extract_template_vars template_uri uri =

     

       95
       -
           (* Simple template variable extraction - could be enhanced with regex *)

     

       96
       -
           let template_parts = String.split_on_char '/' template_uri in

     

       97
       -
           let uri_parts = String.split_on_char '/' uri in

     

       98
       -
       

     

       99
       -
           if List.length template_parts <> List.length uri_parts then None

     

       100
       -
           else

     

       101
       -
             (* Match parts and extract variables *)

     

       102
       -
             let rec match_parts tparts uparts acc =

     

       103
       -
               match (tparts, uparts) with

     

       104
       -
               | [], [] -> Some (List.rev acc)

     

       105
       -
               | th :: tt, uh :: ut ->

     

       106
       -
                   (* Check if this part is a template variable *)

     

       107
       -
                   if

     

       108
       -
                     String.length th > 2

     

       109
       -
                     && String.get th 0 = '{'

     

       110
       -
                     && String.get th (String.length th - 1) = '}'

     

       111
       -
                   then

     

       112
       -
                     (* Extract variable value and continue *)

     

       113
       -
                     match_parts tt ut (uh :: acc)

     

       114
       -
                   else if th = uh then

     

       115
       -
                     (* Fixed part matches, continue *)

     

       116
       -
                     match_parts tt ut acc

     

       117
       -
                   else

     

       118
       -
                     (* Fixed part doesn't match, fail *)

     

       119
       -
                     None

     

       120
       -
               | _, _ -> None

     

       121
       -
             in

     

       122
       -
             match_parts template_parts uri_parts []

     

       123
       -
       

     

       124
       -
         (* Find a matching resource or template for a URI *)

     

       125
       -
         let find_match server uri =

     

       126
       -
           (* Try direct resource match first *)

     

       127
       -
           match

     

       128
       -
             List.find_opt

     

       129
       -
               (fun resource -> resource.Resource.uri = uri)

     

       130
       -
               (resources server)

     

       131
       -
           with

     

       132
       -
           | Some resource -> DirectResource (resource, [])

     

       133
       -
           | None ->

     

       134
       -
               (* Try template match next *)

     

       135
       -
               let templates = resource_templates server in

     

       136
        
       

     

       137
       -
               (* Try each template to see if it matches *)

     

       138
       -
               let rec try_templates templates =

     

       139
       -
                 match templates with

     

       140
       -
                 | [] -> NoMatch

     

       141
       -
                 | template :: rest -> (

     

       142
       -
                     match

     

       143
       -
                       extract_template_vars template.ResourceTemplate.uri_template uri

     

       144
       -
                     with

     

       145
       -
                     | Some params -> TemplateResource (template, params)

     

       146
       -
                     | None -> try_templates rest)

     

       147
       -
               in

     

       148
       -
               try_templates templates

     

       149
       -
       end

     

       150
       -
       

     

       151
       -
       (* Process resources/read request *)

     

       152
       -
       let handle_resources_read server (req : JSONRPCMessage.request) =

     

       153
       -
         Log.debug (fun m -> m "Processing resources/read request");

     

       154
       -
         match req.JSONRPCMessage.params with

     

       155
       -
         | None ->

     

       156
       -
             Log.err (fun m -> m "Missing params for resources/read request");

     

       157
       -
             Some

     

       158
       -
               (create_jsonrpc_error req.id ErrorCode.InvalidParams

     

       159
       -
                  "Missing params for resources/read request" ())

     

       160
       -
         | Some params -> (

     

       161
       -
             let req_data = Mcp_rpc.ResourcesRead.Request.t_of_yojson params in

     

       162
       -
             let uri = req_data.uri in

     

       163
       -
             Log.debug (fun m -> m "Resource URI: %s" uri);

     

       164
       -
       

     

       165
       -
             (* Find matching resource or template *)

     

       166
       -
             match Resource_matcher.find_match server uri with

     

       167
       -
             | Resource_matcher.DirectResource (resource, params) -> (

     

       168
       -
                 (* Create context for this request *)

     

       169
       -
                 let ctx =

     

       170
       -
                   Context.create ?request_id:(Some req.id)

     

       171
       -
                     ?progress_token:req.progress_token

     

       172
       -
                     ~lifespan_context:

     

       173
       -
                       [ ("resources/read", `Assoc [ ("uri", `String uri) ]) ]

     

       174
       -
                     ()

     

       175
       -
                 in

     

       176
        
       

     

       177
       -
                 Log.debug (fun m -> m "Handling direct resource: %s" resource.name);

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       178
        
       

     

       179
       -
                 (* Call the resource handler *)

     

       180
       -
                 match resource.handler ctx params with

     

       181
       -
                 | Ok content ->

     

       182
       -
                     (* Create text resource content *)

     

       183
       -
                     let mime_type =

     

       184
       -
                       match resource.mime_type with

     

       185
       -
                       | Some mime -> mime

     

       186
       -
                       | None -> "text/plain"

     

       187
       -
                     in

     

       188
       -
                     let text_resource =

     

       189
       -
                       {

     

       190
       -
                         TextResourceContents.uri;

     

       191
       -
                         text = content;

     

       192
       -
                         mime_type = Some mime_type;

     

       193
       -
                       }

     

       194
       -
                     in

     

       195
       -
                     let resource_content =

     

       196
       -
                       Mcp_rpc.ResourcesRead.ResourceContent.TextResource text_resource

     

       197
       -
                     in

     

       198
       -
                     let response =

     

       199
       -
                       Mcp_rpc.ResourcesRead.create_response ~id:req.id

     

       200
       -
                         ~contents:[ resource_content ] ()

     

       201
       -
                     in

     

       202
       -
                     Some response

     

       203
       -
                 | Error err ->

     

       204
       -
                     Log.err (fun m -> m "Error reading resource: %s" err);

     

       205
       -
                     Some

     

       206
       -
                       (create_jsonrpc_error req.id ErrorCode.InternalError

     

       207
       -
                          ("Error reading resource: " ^ err)

     

       208
       -
                          ()))

     

       209
       -
             | Resource_matcher.TemplateResource (template, params) -> (

     

       210
       -
                 (* Create context for this request *)

     

       211
       -
                 let ctx =

     

       212
       -
                   Context.create ?request_id:(Some req.id)

     

       213
       -
                     ?progress_token:req.progress_token

     

       214
       -
                     ~lifespan_context:

     

       215
       -
                       [ ("resources/read", `Assoc [ ("uri", `String uri) ]) ]

     

       216
       -
                     ()

     

       217
       -
                 in

     

       218
       -
       

     

       219
       -
                 Log.debug (fun m ->

     

       220
       -
                     m "Handling resource template: %s with params: [%s]" template.name

     

       221
       -
                       (String.concat ", " params));

     

       222
       -
       

     

       223
       -
                 (* Call the template handler *)

     

       224
       -
                 match template.handler ctx params with

     

       225
       -
                 | Ok content ->

     

       226
       -
                     (* Create text resource content *)

     

       227
       -
                     let mime_type =

     

       228
       -
                       match template.mime_type with

     

       229
       -
                       | Some mime -> mime

     

       230
       -
                       | None -> "text/plain"

     

       231
       -
                     in

     

       232
       -
                     let text_resource =

     

       233
       -
                       {

     

       234
       -
                         TextResourceContents.uri;

     

       235
       -
                         text = content;

     

       236
       -
                         mime_type = Some mime_type;

     

       237
       -
                       }

     

       238
       -
                     in

     

       239
       -
                     let resource_content =

     

       240
       -
                       Mcp_rpc.ResourcesRead.ResourceContent.TextResource text_resource

     

       241
       -
                     in

     

       242
       -
                     let response =

     

       243
       -
                       Mcp_rpc.ResourcesRead.create_response ~id:req.id

     

       244
       -
                         ~contents:[ resource_content ] ()

     

       245
       -
                     in

     

       246
       -
                     Some response

     

       247
       -
                 | Error err ->

     

       248
       -
                     Log.err (fun m -> m "Error reading resource template: %s" err);

     

       249
       -
                     Some

     

       250
       -
                       (create_jsonrpc_error req.id ErrorCode.InternalError

     

       251
       -
                          ("Error reading resource template: " ^ err)

     

       252
       -
                          ()))

     

       253
       -
             | Resource_matcher.NoMatch ->

     

       254
       -
                 Log.err (fun m -> m "Resource not found: %s" uri);

     

       255
       -
                 Some

     

       256
       -
                   (create_jsonrpc_error req.id ErrorCode.InvalidParams

     

       257
       -
                      ("Resource not found: " ^ uri)

     

       258
       -
                      ()))

     

       259
       -
       

     

       260
       -
       (* Extract the tool name from params *)

     

       261
       -
       let extract_tool_name params =

     

       262
       -
         match List.assoc_opt "name" params with

     

       263
       -
         | Some (`String name) ->

     

       264
       -
             Log.debug (fun m -> m "Tool name: %s" name);

     

       265
       -
             Some name

     

       266
       -
         | _ ->

     

       267
       -
             Log.err (fun m -> m "Missing or invalid 'name' parameter in tool call");

     

       268
       -
             None

     

       269
       -
       

     

       270
       -
       (* Extract the tool arguments from params *)

     

       271
       -
       let extract_tool_arguments params =

     

       272
       -
         match List.assoc_opt "arguments" params with

     

       273
       -
         | Some args ->

     

       274
       -
             Log.debug (fun m -> m "Tool arguments: %s" (Yojson.Safe.to_string args));

     

       275
       -
             args

     

       276
       -
         | _ ->

     

       277
       -
             Log.debug (fun m ->

     

       278
       -
                 m "No arguments provided for tool call, using empty object");

     

       279
       -
             `Assoc [] (* Empty arguments is valid *)

     

       280
       -
       

     

       281
       -
       (* Execute a tool *)

     

       282
       -
       let execute_tool server ctx name args =

     

       283
       -
         try

     

       284
       -
           let tool = List.find (fun t -> t.Tool.name = name) (tools server) in

     

       285
       -
           Log.debug (fun m -> m "Found tool: %s" name);

     

       286
       -
       

     

       287
       -
           (* Call the tool handler *)

     

       288
       -
           match tool.handler ctx args with

     

       289
       -
           | Ok result ->

     

       290
       -
               Log.debug (fun m -> m "Tool execution succeeded");

     

       291
       -
               result

     

       292
       -
           | Error err -> Tool.handle_execution_error err

     

       293
       -
         with

     

       294
       -
         | Not_found -> Tool.handle_unknown_tool_error name

     

       295
       -
         | exn -> Tool.handle_execution_exception exn

     

       296
       -
       

     

       297
       -
       (* Convert JSON tool result to RPC content format *)

     

       298
       -
       let json_to_rpc_content json =

     

       299
       -
         match json with

     

       300
       -
         | `Assoc fields -> (

     

       301
       -
             match

     

       302
       -
               (List.assoc_opt "content" fields, List.assoc_opt "isError" fields)

     

       303
       -
             with

     

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

     

       305
       -
                 let mcp_content = List.map Mcp.content_of_yojson content_items in

     

       306
       -
                 let rpc_content = Tool.mcp_content_to_rpc_content mcp_content in

     

       307
       -
                 (rpc_content, is_error)

     

       308
       -
             | _ ->

     

       309
       -
                 (* Fallback for compatibility with older formats *)

     

       310
       -
                 let text = Yojson.Safe.to_string json in

     

       311
       -
                 let text_content = { TextContent.text; annotations = None } in

     

       312
       -
                 ([ Mcp_rpc.ToolsCall.ToolContent.Text text_content ], false))

     

       313
       -
         | _ ->

     

       314
       -
             (* Simple fallback for non-object results *)

     

       315
       -
             let text = Yojson.Safe.to_string json in

     

       316
       -
             let text_content = { TextContent.text; annotations = None } in

     

       317
       -
             ([ Mcp_rpc.ToolsCall.ToolContent.Text text_content ], false)

     

       318
       -
       

     

       319
       -
       (* Process tools/call request *)

     

       320
       -
       let handle_tools_call server req =

     

       321
       -
         Log.debug (fun m -> m "Processing tools/call request");

     

       322
       -
         match req.JSONRPCMessage.params with

     

       323
       -
         | Some (`Assoc params) -> (

     

       324
       -
             match extract_tool_name params with

     

       325
       -
             | Some name ->

     

       326
       -
                 let args = extract_tool_arguments params in

     

       327
       -
       

     

       328
       -
                 (* Create context for this request *)

     

       329
       -
                 let ctx =

     

       330
       -
                   Context.create ?request_id:(Some req.id)

     

       331
       -
                     ?progress_token:req.progress_token

     

       332
       -
                     ~lifespan_context:[ ("tools/call", `Assoc params) ]

     

       333
       -
                     ()

     

       334
       -
                 in

     

       335
       -
       

     

       336
       -
                 (* Execute the tool *)

     

       337
       -
                 let result_json = execute_tool server ctx name args in

     

       338
       -
       

     

       339
       -
                 (* Convert JSON result to RPC format *)

     

       340
       -
                 let content, is_error = json_to_rpc_content result_json in

     

       341
       -
       

     

       342
       -
                 (* Create the RPC response *)

     

       343
       -
                 let response =

     

       344
       -
                   Mcp_rpc.ToolsCall.create_response ~id:req.id ~content ~is_error ()

     

       345
       -
                 in

     

       346
       -
       

     

       347
       -
                 Some response

     

       348
       -
             | None ->

     

       349
       -
                 Some

     

       350
       -
                   (create_jsonrpc_error req.id InvalidParams

     

       351
       -
                      "Missing tool name parameter" ()))

     

       352
       -
         | _ ->

     

       353
       -
             Log.err (fun m -> m "Invalid params format for tools/call");

     

       354
       -
             Some

     

       355
       -
               (create_jsonrpc_error req.id InvalidParams

     

       356
       -
                  "Invalid params format for tools/call" ())

     

       357
       -
       

     

       358
       -
       (* Process ping request *)

     

       359
       -
       let handle_ping (req : JSONRPCMessage.request) =

     

       360
       -
         Log.debug (fun m -> m "Processing ping request");

     

       361
       -
         Some (create_response ~id:req.JSONRPCMessage.id ~result:(`Assoc []))

     

       362
       -
       

     

       363
       -
       (* Handle notifications/initialized *)

     

       364
       -
       let handle_initialized (notif : JSONRPCMessage.notification) =

     

       365
       -
         Log.debug (fun m ->

     

       366
       -
             m

     

       367
       -
               "Client initialization complete - Server is now ready to receive \

     

       368
       -
                requests\n\

     

       369
       -
               \ Notification params: %s"

     

       370
       -
               (match notif.JSONRPCMessage.params with

     

       371
       -
               | Some p -> Yojson.Safe.to_string p

     

       372
       -
               | None -> "null"));

     

       373
       -
         None

     

       374
       -
       

     

       375
       -
       (* Process a single message using the MCP SDK *)

     

       376
        
       let process_message server message =

     

       377
        
         try

     

       378
       -
           Log.debug (fun m ->

     

       379
       -
               m "Processing message: %s" (Yojson.Safe.to_string message));

     

       380
        
           match JSONRPCMessage.t_of_yojson message with

     

       381
       -
           | JSONRPCMessage.Request req -> (

     

       382
       -
               Log.debug (fun m ->

     

       383
       -
                   m "Received request with method: %s" (Method.to_string req.meth));

     

       384
       -
               match req.meth with

     

       385
       -
               | Method.Initialize -> handle_initialize server req

     

       386
       -
               | Method.ToolsList -> handle_tools_list server req

     

       387
       -
               | Method.ToolsCall -> handle_tools_call server req

     

       388
       -
               | Method.PromptsList -> handle_prompts_list server req

     

       389
       -
               | Method.ResourcesList -> handle_resources_list server req

     

       390
       -
               | Method.ResourcesRead -> handle_resources_read server req

     

       391
       -
               | Method.ResourceTemplatesList ->

     

       392
       -
                   handle_resource_templates_list server req

     

       393
       -
               | _ ->

     

       394
       -
                   Log.err (fun m ->

     

       395
       -
                       m "Unknown method received: %s" (Method.to_string req.meth));

     

       396
       -
                   Some

     

       397
       -
                     (create_jsonrpc_error req.id ErrorCode.MethodNotFound

     

       398
       -
                        ("Method not found: " ^ Method.to_string req.meth)

     

       399
       -
                        ()))

     

       400
       -
           | JSONRPCMessage.Notification notif -> (

     

       401
       -
               Log.debug (fun m ->

     

       402
       -
                   m "Received notification with method: %s"

     

       403
       -
                     (Method.to_string notif.meth));

     

       404
       -
               match notif.meth with

     

       405
       -
               | Method.Initialized -> handle_initialized notif

     

       406
       -
               | _ ->

     

       407
       -
                   Log.debug (fun m ->

     

       408
       -
                       m "Ignoring notification: %s" (Method.to_string notif.meth));

     

       409
       -
                   None)

     

       410
       -
           | JSONRPCMessage.Response _ ->

     

       411
       -
               Log.err (fun m -> m "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
        
       
     

       412
        
               None

     

       413
       -
           | JSONRPCMessage.Error _ ->

     

       414
       -
               Log.err (fun m -> m "Unexpected error message received");

     

       0
        
       
     

       0
        
       
     

       415
        
               None

     

       0
        
       
     

       416
        
         with

     

       417
       -
         | Json.Of_json (msg, _) ->

     

       418
       -
             Log.err (fun m -> m "JSON error: %s" msg);

     

       419
       -
             (* Can't respond with error because we don't have a request ID *)

     

       420
        
             None

     

       421
       -
         | Yojson.Json_error msg ->

     

       422
       -
             Log.err (fun m -> m "JSON parse error: %s" msg);

     

       423
       -
             (* Can't respond with error because we don't have a request ID *)

     

       424
       -
             None

     

       425
       -
         | exc ->

     

       426
       -
             Log.err (fun m ->

     

       427
       -
                 m

     

       428
       -
                   "Exception during message processing: %s\n\

     

       429
       -
                    Backtrace: %s\n\

     

       430
       -
                    Message was: %s"

     

       431
       -
                   (Printexc.to_string exc)

     

       432
       -
                   (Printexc.get_backtrace ())

     

       433
       -
                   (Yojson.Safe.to_string message));

     

       434
        
             None

     

       0
        
       
     

       435
        
       

     

       436
       -
       (* Extract a request ID from a potentially malformed message *)

     

       437
       -
       let extract_request_id json =

     

       438
        
         try

     

       439
       -
           match json with

     

       440
       -
           | `Assoc fields -> (

     

       441
       -
               match List.assoc_opt "id" fields with

     

       442
       -
               | Some (`Int id) -> Some (`Int id)

     

       443
       -
               | Some (`String id) -> Some (`String id)

     

       444
       -
               | _ -> None)

     

       445
       -
           | _ -> None

     

       446
       -
         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
        
       
     

       447
        
       

     

       448
       -
       (* Handle processing for an input line *)

     

       449
       -
       let process_input_line server line =

     

       450
       -
         if line = "" then (

     

       451
       -
           Log.debug (fun m -> m "Empty line received, ignoring");

     

       452
       -
           None)

     

       453
       -
         else (

     

       454
       -
           Log.debug (fun m -> m "Raw input: %s" line);

     

       455
       -
           try

     

       456
       -
             let json = Yojson.Safe.from_string line in

     

       457
       -
             Log.debug (fun m -> m "Successfully parsed JSON");

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       458
        
       

     

       459
       -
             (* Process the message *)

     

       460
       -
             process_message server json

     

       461
       -
           with Yojson.Json_error msg ->

     

       462
       -
             Log.err (fun m -> m "Error parsing JSON: %s" msg);

     

       463
       -
             Log.err (fun m -> m "Input was: %s" line);

     

       464
       -
             None)

     

       465
        
       

     

       466
       -
       (* Send a response to the client *)

     

       467
       -
       let send_response stdout response =

     

       468
       -
         let response_json = JSONRPCMessage.yojson_of_t response in

     

       469
       -
         let response_str = Yojson.Safe.to_string response_json in

     

       470
       -
         Log.debug (fun m -> m "Sending response: %s" response_str);

     

       471
       -
       

     

       472
       -
         (* Write the response followed by a newline *)

     

       473
       -
         Eio.Flow.copy_string response_str stdout;

     

       474
       -
         Eio.Flow.copy_string "\n" stdout

     

       475
       -
       

     

       476
       -
       (* Run the MCP server with the given server configuration *)

     

       477
       -
       let callback mcp_server _conn (request : Http.Request.t) body =

     

       478
       -
         match request.meth with

     

       479
       -
         | `POST -> (

     

       480
       -
             Log.debug (fun m -> m "Received POST request");

     

       481
       -
             let request_body_str =

     

       482
       -
               Eio.Buf_read.(parse_exn take_all) body ~max_size:max_int

     

       483
       -
             in

     

       484
       -
             match process_input_line mcp_server request_body_str with

     

       485
       -
             | Some mcp_response ->

     

       486
       -
                 let response_json = JSONRPCMessage.yojson_of_t mcp_response in

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       487
        
                 let response_str = Yojson.Safe.to_string response_json in

     

       488
       -
                 Log.debug (fun m -> m "Sending MCP response: %s" response_str);

     

       489
       -
                 let headers =

     

       490
       -
                   Http.Header.of_list [ ("Content-Type", "application/json") ]

     

       491
       -
                 in

     

       492
       -
                 Cohttp_eio.Server.respond ~status:`OK ~headers

     

       493
       -
                   ~body:(Cohttp_eio.Body.of_string response_str)

     

       494
        
                   ()

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       495
        
             | None ->

     

       496
       -
                 Log.debug (fun m -> m "No MCP response needed");

     

       497
       -
                 Cohttp_eio.Server.respond ~status:`No_content

     

       498
       -
                   ~body:(Cohttp_eio.Body.of_string "")

     

       499
       -
                   ())

     

       500
       -
         | _ ->

     

       501
       -
             Log.info (fun m ->

     

       502
       -
                 m "Unsupported method: %s" (Http.Method.to_string request.meth));

     

       503
       -
             Cohttp_eio.Server.respond ~status:`Method_not_allowed

     

       504
       -
               ~body:(Cohttp_eio.Body.of_string "Only POST is supported")

     

       0
        
       
     

       505
        
               ()

     

       506
       -
       

     

       507
       -
       let log_warning ex = Logs.warn (fun f -> f "%a" Eio.Exn.pp ex)

     

       508
       -
       

     

       509
       -
       (** run the server using http transport *)

     

       510
       -
       let run_server ?(port = 8080) ?(on_error = log_warning) env server =

     

       511
       -
         let net = Eio.Stdenv.net env in

     

       512
       -
         let addr = `Tcp (Eio.Net.Ipaddr.V4.loopback, port) in

     

       513
       -
       

     

       514
       -
         Log.info (fun m ->

     

       515
       -
             m "Starting http MCP server: %s v%s\nProtocol version: %s" (name server)

     

       516
       -
               (version server) (protocol_version server));

     

       517
       -
       

     

       518
       -
         Eio.Switch.run @@ fun sw ->

     

       519
       -
         let server_spec = Cohttp_eio.Server.make ~callback:(callback server) () in

     

       520
       -
       

     

       521
       -
         let server_socket =

     

       522
       -
           Eio.Net.listen net ~sw ~backlog:128 ~reuse_addr:true addr

     

       523
        
         in

     

       524
       -
         Log.info (fun m -> m "MCP HTTP Server listening on http://localhost:%d" port);

     

       525
       -
       

     

       526
       -
         Cohttp_eio.Server.run server_socket server_spec ~on_error

     

       527
       -
       

     

       528
       -
       (** run the server using the stdio transport *)

     

       529
       -
       let run_stdio_server env server =

     

       530
       -
         let stdin = Eio.Stdenv.stdin env in

     

       531
       -
         let stdout = Eio.Stdenv.stdout env in

     

       532
       -
       

     

       533
       -
         Log.info (fun m ->

     

       534
       -
             m "Starting stdio MCP server: %s v%s\nProtocol version: %s" (name server)

     

       535
       -
               (version server) (protocol_version server));

     

       536
       -
       

     

       537
       -
         (* Enable exception backtraces *)

     

       538
       -
         Printexc.record_backtrace true;

     

       539
       -
       

     

       540
       -
         let buf = Eio.Buf_read.of_flow stdin ~initial_size:100 ~max_size:1_000_000 in

     

       541
        
       

     

       542
       -
         (* Main processing loop *)

     

       543
       -
         try

     

       544
       -
           while true do

     

       545
       -
             Log.info (fun m -> m "Waiting for message...");

     

       546
       -
             let line = Eio.Buf_read.line buf in

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       547
        
       

     

       548
       -
             (* Process the input and send response if needed *)

     

       549
       -
             match process_input_line server line with

     

       550
       -
             | Some response -> send_response stdout response

     

       551
       -
             | None -> Log.info (fun m -> m "No response needed for this message")

     

       552
       -
           done

     

       553
       -
         with

     

       554
       -
         | End_of_file ->

     

       555
       -
             Log.debug (fun m -> m "End of file received on stdin");

     

       556
       -
             ()

     

       557
       -
         | Eio.Exn.Io _ as exn ->

     

       558
       -
             (* Only a warning since on Windows, once the client closes the connection, we normally fail with `I/O error while reading: Eio.Io Net Connection_reset Unix_error (Broken pipe, "stub_cstruct_read", "")` *)

     

       559
       -
             Log.warn (fun m ->

     

       560
       -
                 m "I/O error while reading: %s" (Printexc.to_string exn));

     

       561
       -
             ()

     

       562
       -
         | exn ->

     

       563
       -
             Log.err (fun m ->

     

       564
       -
                 m "Exception while reading: %s" (Printexc.to_string exn));

     

       565
       -
             ()

···

       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
        
       
     

       5
        
       

     

       6
       +
       (** Server types *)

     

       7
       +
       type transport_type = 

     

       8
       +
         | Stdio  (* Read/write to stdin/stdout *)

     

       9
       +
         | Http   (* HTTP server - to be implemented *)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       10
        
       

     

       11
       +
       type t = {

     

       12
       +
         server: Mcp_sdk.server;

     

       13
       +
         transport: transport_type;

     

       14
       +
         mutable running: bool;

     

       15
       +
       }

     

       16
        
       

     

       17
       +
       (** Process a single message *)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       18
        
       let process_message server message =

     

       19
        
         try

     

       20
       +
           Log.debug "Parsing message as JSONRPC message...";

     

       0
        
       
     

       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);

     

       0
        
       
     

       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()));

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       312
        
             None

     

       313
       +
           end

     

       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 }

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       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")

     

       0
        
       
     

       0
        
       
     

       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 ())

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       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
        
       
     

       0
        
       
     

       0
        
       
     

       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
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0

+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

-32

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
       -
         "http"

     

       13
       -
         "cohttp-eio"

     

       14
       -
         "eio_main"

     

       15
       -
         "eio"

     

       16
       -
         "logs"

     

       17
       -
         "odoc" {with-doc}

     

       18
       -
       ]

     

       19
       -
       build: [

     

       20
       -
         ["dune" "subst"] {dev}

     

       21
       -
         [

     

       22
       -
           "dune"

     

       23
       -
           "build"

     

       24
       -
           "-p"

     

       25
       -
           name

     

       26
       -
           "-j"

     

       27
       -
           jobs

     

       28
       -
           "@install"

     

       29
       -
           "@runtest" {with-test}

     

       30
       -
           "@doc" {with-doc}

     

       31
       -
         ]

     

       32
       -
       ]

+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