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

+330

bin/audio_example.ml

···

       1
       1
       +
       open Mcp

     

       2
       2
       +
       open Mcp_sdk

     

       3
       3
       +
       open Mcp_server

     

       4
       4
       +
       

     

       5
       5
       +
       (* WAV file format helper module *)

     

       6
       6
       +
       module Wav = struct

     

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

     

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

     

       9
       9
       +
           (* WAV parameters *)

     

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

     

       11
       11
       +
           let bits_per_sample = 16 in

     

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

     

       13
       13
       +
           let block_align = num_channels * bits_per_sample / 8 in

     

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

     

       15
       15
       +
           let data_size = num_samples * block_align in

     

       16
       16
       +
           

     

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

     

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

     

       19
       19
       +
           

     

       20
       20
       +
           (* Write WAV header *)

     

       21
       21
       +
           (* "RIFF" chunk *)

     

       22
       22
       +
           Buffer.add_string buffer "RIFF";

     

       23
       23
       +
           let file_size = 36 + data_size in

     

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

     

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

     

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

     

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

     

       28
       28
       +
           Buffer.add_string buffer "WAVE";

     

       29
       29
       +
           

     

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

     

       31
       31
       +
           Buffer.add_string buffer "fmt ";

     

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

     

       33
       33
       +
           Buffer.add_char buffer (char_of_int 0);

     

       34
       34
       +
           Buffer.add_char buffer (char_of_int 0);

     

       35
       35
       +
           Buffer.add_char buffer (char_of_int 0);

     

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

     

       37
       37
       +
           Buffer.add_char buffer (char_of_int 0);

     

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

     

       39
       39
       +
           Buffer.add_char buffer (char_of_int 0);

     

       40
       40
       +
           

     

       41
       41
       +
           (* Sample rate *)

     

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

     

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

     

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

     

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

     

       46
       46
       +
           

     

       47
       47
       +
           (* Byte rate *)

     

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

     

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

     

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

     

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

     

       52
       52
       +
           

     

       53
       53
       +
           (* Block align *)

     

       54
       54
       +
           Buffer.add_char buffer (char_of_int block_align);

     

       55
       55
       +
           Buffer.add_char buffer (char_of_int 0);

     

       56
       56
       +
           

     

       57
       57
       +
           (* Bits per sample *)

     

       58
       58
       +
           Buffer.add_char buffer (char_of_int bits_per_sample);

     

       59
       59
       +
           Buffer.add_char buffer (char_of_int 0);

     

       60
       60
       +
           

     

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

     

       62
       62
       +
           Buffer.add_string buffer "data";

     

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

     

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

     

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

     

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

     

       67
       67
       +
           

     

       68
       68
       +
           (* Generate sine wave data *)

     

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

     

       70
       70
       +
           for i = 0 to num_samples - 1 do

     

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

     

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

     

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

     

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

     

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

     

       76
       76
       +
           done;

     

       77
       77
       +
           

     

       78
       78
       +
           Buffer.contents buffer

     

       79
       79
       +
           

     

       80
       80
       +
         (* Encode binary data as base64 *)

     

       81
       81
       +
         let base64_encode data =

     

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

     

       83
       83
       +
           let alphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" in

     

       84
       84
       +
           

     

       85
       85
       +
           let encode_block i bytes =

     

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

     

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

     

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

     

       89
       89
       +
             

     

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

     

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

     

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

     

       93
       93
       +
             

     

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

     

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

     

       96
       96
       +
             else

     

       97
       97
       +
               Buffer.add_char buffer '=';

     

       98
       98
       +
               

     

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

     

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

     

       101
       101
       +
             else

     

       102
       102
       +
               Buffer.add_char buffer '=';

     

       103
       103
       +
           in

     

       104
       104
       +
           

     

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

     

       106
       106
       +
             encode_block i data

     

       107
       107
       +
           done;

     

       108
       108
       +
           

     

       109
       109
       +
           Buffer.contents buffer

     

       110
       110
       +
       end

     

       111
       111
       +
       

     

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

     

       113
       113
       +
       let get_string_param json name =

     

       114
       114
       +
         match json with

     

       115
       115
       +
         | `Assoc fields ->

     

       116
       116
       +
           (match List.assoc_opt name fields with

     

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

     

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

     

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

     

       120
       120
       +
       

     

       121
       121
       +
       (* Create a server *)

     

       122
       122
       +
       let server = create_server 

     

       123
       123
       +
         ~name:"OCaml MCP Audio Example" 

     

       124
       124
       +
         ~version:"0.1.0" 

     

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

     

       126
       126
       +
         ()

     

       127
       127
       +
       

     

       128
       128
       +
       (* Define startup and shutdown hooks *)

     

       129
       129
       +
       let startup () =

     

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

     

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

     

       132
       132
       +
         flush stderr;

     

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

     

       134
       134
       +
       

     

       135
       135
       +
       let shutdown () =

     

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

     

       137
       137
       +
         flush stderr;

     

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

     

       139
       139
       +
       

     

       140
       140
       +
       (* Register the hooks *)

     

       141
       141
       +
       let () =

     

       142
       142
       +
         set_startup_hook server startup;

     

       143
       143
       +
         set_shutdown_hook server shutdown

     

       144
       144
       +
       

     

       145
       145
       +
       (* Helper to create audio content *)

     

       146
       146
       +
       let make_audio_content data mime_type =

     

       147
       147
       +
         let audio_content = AudioContent.{

     

       148
       148
       +
           data;

     

       149
       149
       +
           mime_type;

     

       150
       150
       +
           annotations = None;

     

       151
       151
       +
         } in

     

       152
       152
       +
         Audio audio_content

     

       153
       153
       +
       

     

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

     

       155
       155
       +
       let _ = add_tool server

     

       156
       156
       +
         ~name:"generate_audio_description"

     

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

     

       158
       158
       +
         ~schema_properties:[

     

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

     

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

     

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

     

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

     

       163
       163
       +
         ]

     

       164
       164
       +
         ~schema_required:["text"]

     

       165
       165
       +
         (fun args ->

     

       166
       166
       +
           try

     

       167
       167
       +
             let text = get_string_param args "text" in

     

       168
       168
       +
             

     

       169
       169
       +
             (* Parse parameters with defaults *)

     

       170
       170
       +
             let frequency = 

     

       171
       171
       +
               try

     

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

     

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

     

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

     

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

     

       176
       176
       +
               with _ -> 440.0

     

       177
       177
       +
             in

     

       178
       178
       +
             

     

       179
       179
       +
             let duration = 

     

       180
       180
       +
               try

     

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

     

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

     

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

     

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

     

       185
       185
       +
               with _ -> 2.0

     

       186
       186
       +
             in

     

       187
       187
       +
             

     

       188
       188
       +
             let amplitude = 

     

       189
       189
       +
               try

     

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

     

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

     

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

     

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

     

       194
       194
       +
               with _ -> 0.8

     

       195
       195
       +
             in

     

       196
       196
       +
             

     

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

     

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

     

       199
       199
       +
             let wav_data = Wav.generate_sine_wave 

     

       200
       200
       +
               ~frequency 

     

       201
       201
       +
               ~duration 

     

       202
       202
       +
               ~sample_rate 

     

       203
       203
       +
               ~amplitude

     

       204
       204
       +
             in

     

       205
       205
       +
             

     

       206
       206
       +
             (* Encode WAV data as base64 *)

     

       207
       207
       +
             let base64_audio = Wav.base64_encode wav_data in

     

       208
       208
       +
             

     

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

     

       210
       210
       +
                         (int_of_float frequency) duration 

     

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

     

       212
       212
       +
             

     

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

     

       214
       214
       +
             CallToolResult.yojson_of_t CallToolResult.{

     

       215
       215
       +
               content = [

     

       216
       216
       +
                 Text TextContent.{ 

     

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

     

       218
       218
       +
                           text frequency duration; 

     

       219
       219
       +
                   annotations = None 

     

       220
       220
       +
                 };

     

       221
       221
       +
                 Audio AudioContent.{ 

     

       222
       222
       +
                   data = base64_audio; 

     

       223
       223
       +
                   mime_type = "audio/wav"; 

     

       224
       224
       +
                   annotations = None 

     

       225
       225
       +
                 }

     

       226
       226
       +
               ];

     

       227
       227
       +
               is_error = false;

     

       228
       228
       +
               meta = None

     

       229
       229
       +
             }

     

       230
       230
       +
           with

     

       231
       231
       +
           | Failure msg ->

     

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

     

       233
       233
       +
             CallToolResult.yojson_of_t CallToolResult.{

     

       234
       234
       +
               content = [

     

       235
       235
       +
                 Text TextContent.{ 

     

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

     

       237
       237
       +
                   annotations = None 

     

       238
       238
       +
                 }

     

       239
       239
       +
               ];

     

       240
       240
       +
               is_error = true;

     

       241
       241
       +
               meta = None

     

       242
       242
       +
             }

     

       243
       243
       +
         )

     

       244
       244
       +
       

     

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

     

       246
       246
       +
       let _ = add_prompt server

     

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

     

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

     

       249
       249
       +
         ~arguments:[

     

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

     

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

     

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

     

       253
       253
       +
         ]

     

       254
       254
       +
         (fun args ->

     

       255
       255
       +
           let description = 

     

       256
       256
       +
             try List.assoc "description" args

     

       257
       257
       +
             with Not_found -> "No description provided"

     

       258
       258
       +
           in

     

       259
       259
       +
           

     

       260
       260
       +
           (* Parse frequency with default *)

     

       261
       261
       +
           let frequency = 

     

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

     

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

     

       264
       264
       +
           in

     

       265
       265
       +
           

     

       266
       266
       +
           (* Parse duration with default *)

     

       267
       267
       +
           let duration =

     

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

     

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

     

       270
       270
       +
           in

     

       271
       271
       +
           

     

       272
       272
       +
           (* Generate WAV data *)

     

       273
       273
       +
           let sample_rate = 44100 in

     

       274
       274
       +
           let wav_data = Wav.generate_sine_wave 

     

       275
       275
       +
             ~frequency 

     

       276
       276
       +
             ~duration 

     

       277
       277
       +
             ~sample_rate 

     

       278
       278
       +
             ~amplitude:0.8

     

       279
       279
       +
           in

     

       280
       280
       +
           

     

       281
       281
       +
           (* Encode WAV data as base64 *)

     

       282
       282
       +
           let base64_audio = Wav.base64_encode wav_data in

     

       283
       283
       +
           

     

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

     

       285
       285
       +
                       frequency duration 

     

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

     

       287
       287
       +
           

     

       288
       288
       +
           [

     

       289
       289
       +
             Prompt.{ 

     

       290
       290
       +
               role = `User; 

     

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

     

       292
       292
       +
             };

     

       293
       293
       +
             Prompt.{ 

     

       294
       294
       +
               role = `User;

     

       295
       295
       +
               content = make_audio_content base64_audio "audio/wav" 

     

       296
       296
       +
             };

     

       297
       297
       +
             Prompt.{ 

     

       298
       298
       +
               role = `User; 

     

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

     

       300
       300
       +
                                             description frequency duration)

     

       301
       301
       +
             };

     

       302
       302
       +
             Prompt.{ 

     

       303
       303
       +
               role = `Assistant; 

     

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

     

       305
       305
       +
             }

     

       306
       306
       +
           ]

     

       307
       307
       +
         )

     

       308
       308
       +
       

     

       309
       309
       +
       (* Main function *)

     

       310
       310
       +
       let () =

     

       311
       311
       +
         (* Parse command line arguments *)

     

       312
       312
       +
         let transport_type = ref Mcp_server.Stdio in

     

       313
       313
       +
         let args = [

     

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

     

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

     

       316
       316
       +
         ] in

     

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

     

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

     

       319
       319
       +
       

     

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

     

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

     

       322
       322
       +
         flush stderr;

     

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

     

       324
       324
       +
         

     

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

     

       326
       326
       +
         ignore (configure_server server ());

     

       327
       327
       +
         

     

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

     

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

     

       330
       330
       +
         Mcp_server.start mcp_server

+48 -15

bin/capitalize_sdk.ml

···

       1
       1
        
       open Mcp

     

       2
       2
        
       open Mcp_sdk

     

       3
       3
       +
       open Mcp_server

     

       3
       4
        
       

     

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

     

       5
       6
        
       let get_string_param json name =

     
···

       14
       15
        
       let server = create_server 

     

       15
       16
        
         ~name:"OCaml MCP Capitalizer" 

     

       16
       17
        
         ~version:"0.1.0" 

     

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

     

       18
       18
       -
         fun server ->

     

       19
       19
       -
         (* Set default capabilities *)

     

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

     

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

     

       19
       19
       +
         ()

     

       20
       20
       +
       

     

       21
       21
       +
       (* Define startup and shutdown hooks *)

     

       22
       22
       +
       let startup () =

     

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

     

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

     

       25
       25
       +
         flush stderr;

     

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

     

       27
       27
       +
       

     

       28
       28
       +
       let shutdown () =

     

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

     

       30
       30
       +
         flush stderr;

     

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

     

       32
       32
       +
       

     

       33
       33
       +
       (* Register the hooks *)

     

       34
       34
       +
       let () =

     

       35
       35
       +
         set_startup_hook server startup;

     

       36
       36
       +
         set_shutdown_hook server shutdown

     

       21
       37
        
       

     

       22
       38
        
       (* Define and register a capitalize tool *)

     

       23
       39
        
       let _ = add_tool server

     
···

       37
       53
        
             }

     

       38
       54
        
           with

     

       39
       55
        
           | Failure msg ->

     

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

     

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

     

       41
       57
        
             TextContent.yojson_of_t TextContent.{

     

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

     

       43
       59
        
               annotations = None

     

       44
       60
        
             }

     

       45
       61
        
         )

     

       46
       62
        
       

     

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

     

       48
       48
       -
       let _ = add_resource_template server

     

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

     

       64
       64
       +
       let _ = add_resource server

     

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

     

       50
       50
       -
         ~name:"Greeting"

     

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

     

       52
       67
        
         ~mime_type:"text/plain"

     

       53
       68
        
         (fun params ->

     
···

       73
       88
        
           [

     

       74
       89
        
             Prompt.{ 

     

       75
       90
        
               role = `User; 

     

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

     

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

     

       77
       92
        
             };

     

       78
       93
        
             Prompt.{ 

     

       79
       94
        
               role = `User; 

     

       80
       80
       -
               content = Mcp.make_text_content text

     

       95
       95
       +
               content = make_text_content text

     

       81
       96
        
             };

     

       82
       97
        
             Prompt.{ 

     

       83
       98
        
               role = `Assistant; 

     

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

     

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

     

       85
       100
        
             };

     

       86
       101
        
             Prompt.{ 

     

       87
       102
        
               role = `Assistant; 

     

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

     

       103
       103
       +
               content = make_text_content (String.uppercase_ascii text)

     

       89
       104
        
             }

     

       90
       105
        
           ]

     

       91
       106
        
         )

     

       92
       107
        
       

     

       108
       108
       +
       (* Main function *)

     

       93
       109
        
       let () =

     

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

     

       95
       95
       -
         Eio_main.run @@ fun env->

     

       96
       96
       -
           Mcp_server.run_server env server

     

       110
       110
       +
         (* Parse command line arguments *)

     

       111
       111
       +
         let transport_type = ref Stdio in

     

       112
       112
       +
         let args = [

     

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

     

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

     

       115
       115
       +
         ] in

     

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

     

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

     

       118
       118
       +
       

     

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

     

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

     

       121
       121
       +
         flush stderr;

     

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

     

       123
       123
       +
         

     

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

     

       125
       125
       +
         ignore (configure_server server ());

     

       126
       126
       +
         

     

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

     

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

     

       129
       129
       +
         start mcp_server

+193

bin/completion_example.ml

···

       1
       1
       +
       open Mcp

     

       2
       2
       +
       open Mcp_sdk

     

       3
       3
       +
       open Mcp_server

     

       4
       4
       +
       

     

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

     

       6
       6
       +
       let get_string_param json name =

     

       7
       7
       +
         match json with

     

       8
       8
       +
         | `Assoc fields ->

     

       9
       9
       +
           (match List.assoc_opt name fields with

     

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

     

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

     

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

     

       13
       13
       +
       

     

       14
       14
       +
       (* Create a server *)

     

       15
       15
       +
       let server = create_server 

     

       16
       16
       +
         ~name:"OCaml MCP Completion Example" 

     

       17
       17
       +
         ~version:"0.1.0" 

     

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

     

       19
       19
       +
         ()

     

       20
       20
       +
       

     

       21
       21
       +
       (* Define startup and shutdown hooks *)

     

       22
       22
       +
       let startup () =

     

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

     

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

     

       25
       25
       +
         flush stderr;

     

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

     

       27
       27
       +
       

     

       28
       28
       +
       let shutdown () =

     

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

     

       30
       30
       +
         flush stderr;

     

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

     

       32
       32
       +
       

     

       33
       33
       +
       (* Register the hooks *)

     

       34
       34
       +
       let () =

     

       35
       35
       +
         set_startup_hook server startup;

     

       36
       36
       +
         set_shutdown_hook server shutdown

     

       37
       37
       +
       

     

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

     

       39
       39
       +
       let languages = [

     

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

     

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

     

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

     

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

     

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

     

       45
       45
       +
       ]

     

       46
       46
       +
       

     

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

     

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

     

       49
       49
       +
         Completion.Result.{

     

       50
       50
       +
           completion = {

     

       51
       51
       +
             values;

     

       52
       52
       +
             has_more = Some has_more;

     

       53
       53
       +
             total;

     

       54
       54
       +
           };

     

       55
       55
       +
           meta = None;

     

       56
       56
       +
         }

     

       57
       57
       +
       

     

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

     

       59
       59
       +
       let _ = add_tool server

     

       60
       60
       +
         ~name:"complete"

     

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

     

       62
       62
       +
         ~schema_properties:[

     

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

     

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

     

       65
       65
       +
         ]

     

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

     

       67
       67
       +
         (fun args ->

     

       68
       68
       +
           try

     

       69
       69
       +
             let argument_name = get_string_param args "argument_name" in

     

       70
       70
       +
             let argument_value = get_string_param args "argument_value" in

     

       71
       71
       +
             

     

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

     

       73
       73
       +
             

     

       74
       74
       +
             (* Handle different completion requests *)

     

       75
       75
       +
             let result = 

     

       76
       76
       +
               match argument_name with

     

       77
       77
       +
               | "language" ->

     

       78
       78
       +
                   (* Complete programming language names *)

     

       79
       79
       +
                   let matches = 

     

       80
       80
       +
                     List.filter 

     

       81
       81
       +
                       (fun (lang, _) -> 

     

       82
       82
       +
                         let lang_lower = String.lowercase_ascii lang in

     

       83
       83
       +
                         let arg_lower = String.lowercase_ascii argument_value in

     

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

     

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

     

       86
       86
       +
                       languages

     

       87
       87
       +
                   in

     

       88
       88
       +
                   let values = List.map fst matches in

     

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

     

       90
       90
       +
                   

     

       91
       91
       +
               | "feature" ->

     

       92
       92
       +
                   (* Complete programming language features *)

     

       93
       93
       +
                   let all_features = 

     

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

     

       95
       95
       +
                     List.sort_uniq String.compare

     

       96
       96
       +
                   in

     

       97
       97
       +
                   let matches =

     

       98
       98
       +
                     List.filter

     

       99
       99
       +
                       (fun feature -> 

     

       100
       100
       +
                         let feature_lower = String.lowercase_ascii feature in

     

       101
       101
       +
                         let arg_lower = String.lowercase_ascii argument_value in

     

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

     

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

     

       104
       104
       +
                       all_features

     

       105
       105
       +
                   in

     

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

     

       107
       107
       +
                   

     

       108
       108
       +
               | _ ->

     

       109
       109
       +
                   (* Default completions for unknown arguments *)

     

       110
       110
       +
                   create_completion ["unknown argument"] ()

     

       111
       111
       +
             in

     

       112
       112
       +
             

     

       113
       113
       +
             (* Convert to JSON and return *)

     

       114
       114
       +
             TextContent.yojson_of_t TextContent.{

     

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

     

       116
       116
       +
               annotations = None

     

       117
       117
       +
             }

     

       118
       118
       +
           with

     

       119
       119
       +
           | Failure msg ->

     

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

     

       121
       121
       +
               TextContent.yojson_of_t TextContent.{

     

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

     

       123
       123
       +
                 annotations = None

     

       124
       124
       +
               }

     

       125
       125
       +
         )

     

       126
       126
       +
       

     

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

     

       128
       128
       +
       let _ = add_prompt server

     

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

     

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

     

       131
       131
       +
         ~arguments:[

     

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

     

       133
       133
       +
         ]

     

       134
       134
       +
         (fun args ->

     

       135
       135
       +
           let language = 

     

       136
       136
       +
             try List.assoc "language" args

     

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

     

       138
       138
       +
           in

     

       139
       139
       +
           

     

       140
       140
       +
           let features =

     

       141
       141
       +
             try 

     

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

     

       143
       143
       +
               String.concat ", " features

     

       144
       144
       +
             with Not_found -> "unknown language"

     

       145
       145
       +
           in

     

       146
       146
       +
           

     

       147
       147
       +
           [

     

       148
       148
       +
             Prompt.{ 

     

       149
       149
       +
               role = `User; 

     

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

     

       151
       151
       +
             };

     

       152
       152
       +
             Prompt.{ 

     

       153
       153
       +
               role = `Assistant; 

     

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

     

       155
       155
       +
             }

     

       156
       156
       +
           ]

     

       157
       157
       +
         )

     

       158
       158
       +
       

     

       159
       159
       +
       (* Main function *)

     

       160
       160
       +
       let () =

     

       161
       161
       +
         (* Parse command line arguments *)

     

       162
       162
       +
         let transport_type = ref Stdio in

     

       163
       163
       +
         let args = [

     

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

     

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

     

       166
       166
       +
         ] in

     

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

     

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

     

       169
       169
       +
       

     

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

     

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

     

       172
       172
       +
         flush stderr;

     

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

     

       174
       174
       +
         

     

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

     

       176
       176
       +
         let capabilities = `Assoc [

     

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

     

       178
       178
       +
           ("prompts", `Assoc [

     

       179
       179
       +
             ("listChanged", `Bool true)

     

       180
       180
       +
           ]);

     

       181
       181
       +
           ("resources", `Assoc [

     

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

     

       183
       183
       +
             ("subscribe", `Bool true)

     

       184
       184
       +
           ]);

     

       185
       185
       +
           ("tools", `Assoc [

     

       186
       186
       +
             ("listChanged", `Bool true)

     

       187
       187
       +
           ])

     

       188
       188
       +
         ] in

     

       189
       189
       +
         set_capabilities server capabilities;

     

       190
       190
       +
         

     

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

     

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

     

       193
       193
       +
         start mcp_server

+33 -12

bin/dune

···

       1
       1
       +
       (executable

     

       2
       2
       +
        (name server)

     

       3
       3
       +
        (libraries mcp yojson unix)

     

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

     

       5
       5
       +
       

     

       1
       6
        
       (executable

     

       2
       7
        
        (name capitalize_sdk)

     

       3
       8
        
        (modules capitalize_sdk)

     

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

     

       9
       9
       +
        (libraries mcp mcp_sdk mcp_server yojson unix)

     

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

     

       11
       11
       +
       

     

       12
       12
       +
       (executable

     

       13
       13
       +
        (name audio_example)

     

       14
       14
       +
        (modules audio_example)

     

       15
       15
       +
        (libraries mcp mcp_sdk mcp_server yojson unix)

     

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

     

       17
       17
       +
       

     

       18
       18
       +
       (executable

     

       19
       19
       +
        (name resource_template_example)

     

       20
       20
       +
        (modules resource_template_example)

     

       21
       21
       +
        (libraries mcp mcp_sdk mcp_server yojson unix)

     

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

     

       5
       23
        
       

     

       6
       24
        
       (executable

     

       7
       7
       -
        (name multimodal_sdk)

     

       8
       8
       -
        (modules multimodal_sdk)

     

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

     

       25
       25
       +
        (name completion_example)

     

       26
       26
       +
        (modules completion_example)

     

       27
       27
       +
        (libraries mcp mcp_sdk mcp_server yojson unix)

     

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

     

       29
       29
       +
       

     

       10
       30
        
       

     

       11
       31
        
       (executable

     

       12
       12
       -
        (name ocaml_eval_sdk)

     

       13
       13
       -
        (modes byte)

     

       14
       14
       -
        (modules ocaml_eval_sdk)

     

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

     

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

     

       32
       32
       +
        (name image_generator_example)

     

       33
       33
       +
        (modules image_generator_example)

     

       34
       34
       +
        (libraries mcp mcp_sdk mcp_server yojson unix)

     

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

     

       17
       36
        
       

     

       18
       37
        
       (executable

     

       19
       19
       -
        (name markdown_book_sdk)

     

       20
       20
       -
        (modules markdown_book_sdk)

     

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

     

       38
       38
       +
        (name multimodal_example)

     

       39
       39
       +
        (modules multimodal_example)

     

       40
       40
       +
        (libraries mcp mcp_sdk mcp_server yojson unix)

     

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

     

       42
       42
       +

+468

bin/image_generator_example.ml

···

       1
       1
       +
       open Mcp

     

       2
       2
       +
       open Mcp_sdk

     

       3
       3
       +
       open Mcp_server

     

       4
       4
       +
       

     

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

     

       6
       6
       +
       

     

       7
       7
       +
       (* Base64 encoding helper *)

     

       8
       8
       +
       module Base64 = struct

     

       9
       9
       +
         let encode_char n =

     

       10
       10
       +
           "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/".[n]

     

       11
       11
       +
           

     

       12
       12
       +
         let encode_block i bytes =

     

       13
       13
       +
           let buffer = Buffer.create 4 in

     

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

     

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

     

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

     

       17
       17
       +
           

     

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

     

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

     

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

     

       21
       21
       +
           

     

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

     

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

     

       24
       24
       +
           else

     

       25
       25
       +
             Buffer.add_char buffer '=';

     

       26
       26
       +
             

     

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

     

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

     

       29
       29
       +
           else

     

       30
       30
       +
             Buffer.add_char buffer '=';

     

       31
       31
       +
           

     

       32
       32
       +
           Buffer.contents buffer

     

       33
       33
       +
           

     

       34
       34
       +
         let encode data =

     

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

     

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

     

       37
       37
       +
             Buffer.add_string buffer (encode_block i data)

     

       38
       38
       +
           done;

     

       39
       39
       +
           Buffer.contents buffer

     

       40
       40
       +
       end

     

       41
       41
       +
       

     

       42
       42
       +
       (* Image generation utilities *)

     

       43
       43
       +
       module ImageGenerator = struct

     

       44
       44
       +
         (* Simple PNG generation *)

     

       45
       45
       +
         let create_png width height pixels =

     

       46
       46
       +
           (* PNG signature *)

     

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

     

       48
       48
       +
           

     

       49
       49
       +
           (* IHDR chunk data *)

     

       50
       50
       +
           let ihdr_data = Bytes.create 13 in

     

       51
       51
       +
           (* Width - big endian *)

     

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

     

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

     

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

     

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

     

       56
       56
       +
           (* Height - big endian *)

     

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

     

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

     

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

     

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

     

       61
       61
       +
           (* Bit depth - 8 bits *)

     

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

     

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

     

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

     

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

     

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

     

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

     

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

     

       69
       69
       +
           

     

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

     

       71
       71
       +
           let calculate_crc data =

     

       72
       72
       +
             let crc = ref 0xffffffff in

     

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

     

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

     

       75
       75
       +
               crc := !crc lxor byte;

     

       76
       76
       +
               for _ = 0 to 7 do

     

       77
       77
       +
                 if !crc land 1 <> 0 then

     

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

     

       79
       79
       +
                 else

     

       80
       80
       +
                   crc := !crc lsr 1

     

       81
       81
       +
               done

     

       82
       82
       +
             done;

     

       83
       83
       +
             !crc lxor 0xffffffff

     

       84
       84
       +
           in

     

       85
       85
       +
           

     

       86
       86
       +
           (* Create IHDR chunk *)

     

       87
       87
       +
           let ihdr_chunk = Buffer.create 25 in

     

       88
       88
       +
           (* Length - 13 bytes *)

     

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

     

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

     

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

     

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

     

       93
       93
       +
           (* Chunk type - IHDR *)

     

       94
       94
       +
           Buffer.add_string ihdr_chunk "IHDR";

     

       95
       95
       +
           (* Chunk data *)

     

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

     

       97
       97
       +
           (* CRC *)

     

       98
       98
       +
           let ihdr_crc_data = Bytes.create 17 in

     

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

     

       100
       100
       +
           Bytes.blit ihdr_data 0 ihdr_crc_data 4 13;

     

       101
       101
       +
           let crc = calculate_crc ihdr_crc_data in

     

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

     

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

     

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

     

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

     

       106
       106
       +
           

     

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

     

       108
       108
       +
           let row_size = width * 4 in

     

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

     

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

     

       111
       111
       +
           (* Length *)

     

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

     

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

     

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

     

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

     

       116
       116
       +
           (* Chunk type - IDAT *)

     

       117
       117
       +
           Buffer.add_string idat_chunk "IDAT";

     

       118
       118
       +
           

     

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

     

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

     

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

     

       122
       122
       +
           

     

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

     

       124
       124
       +
           for y = 0 to height - 1 do

     

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

     

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

     

       127
       127
       +
             for x = 0 to width - 1 do

     

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

     

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

     

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

     

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

     

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

     

       133
       133
       +
             done

     

       134
       134
       +
           done;

     

       135
       135
       +
           

     

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

     

       137
       137
       +
           let adler = ref 1 in

     

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

     

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

     

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

     

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

     

       142
       142
       +
           

     

       143
       143
       +
           (* CRC *)

     

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

     

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

     

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

     

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

     

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

     

       149
       149
       +
           

     

       150
       150
       +
           (* Create IEND chunk *)

     

       151
       151
       +
           let iend_chunk = Buffer.create 12 in

     

       152
       152
       +
           (* Length - 0 bytes *)

     

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

     

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

     

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

     

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

     

       157
       157
       +
           (* Chunk type - IEND *)

     

       158
       158
       +
           Buffer.add_string iend_chunk "IEND";

     

       159
       159
       +
           (* CRC *)

     

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

     

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

     

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

     

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

     

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

     

       165
       165
       +
           

     

       166
       166
       +
           (* Combine all parts *)

     

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

     

       168
       168
       +
           (* PNG signature *)

     

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

     

       170
       170
       +
           (* IHDR chunk *)

     

       171
       171
       +
           Buffer.add_buffer result ihdr_chunk;

     

       172
       172
       +
           (* IDAT chunk *)

     

       173
       173
       +
           Buffer.add_buffer result idat_chunk;

     

       174
       174
       +
           (* IEND chunk *)

     

       175
       175
       +
           Buffer.add_buffer result iend_chunk;

     

       176
       176
       +
           

     

       177
       177
       +
           Buffer.contents result

     

       178
       178
       +
         

     

       179
       179
       +
         (* Generate random pixel art image *)

     

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

     

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

     

       182
       182
       +
           

     

       183
       183
       +
           (* Set random seed if provided *)

     

       184
       184
       +
           (match seed with

     

       185
       185
       +
            | Some s -> Random.init s

     

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

     

       187
       187
       +
           

     

       188
       188
       +
           (* Generate a random color palette *)

     

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

     

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

     

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

     

       192
       192
       +
           ) in

     

       193
       193
       +
           

     

       194
       194
       +
           (* Fill the pixel buffer *)

     

       195
       195
       +
           for y = 0 to height - 1 do

     

       196
       196
       +
             for x = 0 to width - 1 do

     

       197
       197
       +
               let color_idx = Random.int palette_size in

     

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

     

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

     

       200
       200
       +
               Bytes.set_uint8 pixels idx r;

     

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

     

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

     

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

     

       204
       204
       +
             done

     

       205
       205
       +
           done;

     

       206
       206
       +
           

     

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

     

       208
       208
       +
           let symmetry_type = Random.int 3 in

     

       209
       209
       +
           if symmetry_type > 0 then begin

     

       210
       210
       +
             for y = 0 to height - 1 do

     

       211
       211
       +
               for x = 0 to width / 2 do

     

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

     

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

     

       214
       214
       +
                   let mirror_x = width - 1 - x in

     

       215
       215
       +
                   if x <> mirror_x then begin

     

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

     

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

     

       218
       218
       +
                     for i = 0 to 3 do

     

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

     

       220
       220
       +
                     done

     

       221
       221
       +
                   end

     

       222
       222
       +
                 end

     

       223
       223
       +
               done

     

       224
       224
       +
             done;

     

       225
       225
       +
             

     

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

     

       227
       227
       +
             if symmetry_type = 2 then begin

     

       228
       228
       +
               for y = 0 to height / 2 do

     

       229
       229
       +
                 let mirror_y = height - 1 - y in

     

       230
       230
       +
                 if y <> mirror_y then begin

     

       231
       231
       +
                   for x = 0 to width - 1 do

     

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

     

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

     

       234
       234
       +
                     for i = 0 to 3 do

     

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

     

       236
       236
       +
                     done

     

       237
       237
       +
                   done

     

       238
       238
       +
                 end

     

       239
       239
       +
               done

     

       240
       240
       +
             end

     

       241
       241
       +
           end;

     

       242
       242
       +
           

     

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

     

       244
       244
       +
           let final_width = width * pixel_size in

     

       245
       245
       +
           let final_height = height * pixel_size in

     

       246
       246
       +
           

     

       247
       247
       +
           if pixel_size = 1 then

     

       248
       248
       +
             create_png width height pixels

     

       249
       249
       +
           else begin

     

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

     

       251
       251
       +
             

     

       252
       252
       +
             for y = 0 to height - 1 do

     

       253
       253
       +
               for x = 0 to width - 1 do

     

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

     

       255
       255
       +
                 for py = 0 to pixel_size - 1 do

     

       256
       256
       +
                   for px = 0 to pixel_size - 1 do

     

       257
       257
       +
                     let dst_x = x * pixel_size + px in

     

       258
       258
       +
                     let dst_y = y * pixel_size + py in

     

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

     

       260
       260
       +
                     for i = 0 to 3 do

     

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

     

       262
       262
       +
                     done

     

       263
       263
       +
                   done

     

       264
       264
       +
                 done

     

       265
       265
       +
               done

     

       266
       266
       +
             done;

     

       267
       267
       +
             

     

       268
       268
       +
             create_png final_width final_height scaled_pixels

     

       269
       269
       +
           end

     

       270
       270
       +
       end

     

       271
       271
       +
       

     

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

     

       273
       273
       +
       let get_param_int json name default =

     

       274
       274
       +
         match json with

     

       275
       275
       +
         | `Assoc fields ->

     

       276
       276
       +
           (match List.assoc_opt name fields with

     

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

     

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

     

       279
       279
       +
            | _ -> default)

     

       280
       280
       +
         | _ -> default

     

       281
       281
       +
       

     

       282
       282
       +
       (* Create a server *)

     

       283
       283
       +
       let server = create_server 

     

       284
       284
       +
         ~name:"OCaml MCP Image Generator" 

     

       285
       285
       +
         ~version:"0.1.0" 

     

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

     

       287
       287
       +
         ()

     

       288
       288
       +
       

     

       289
       289
       +
       (* Define startup and shutdown hooks *)

     

       290
       290
       +
       let startup () =

     

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

     

       292
       292
       +
         flush stderr;

     

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

     

       294
       294
       +
       

     

       295
       295
       +
       let shutdown () =

     

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

     

       297
       297
       +
         flush stderr;

     

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

     

       299
       299
       +
       

     

       300
       300
       +
       (* Register the hooks *)

     

       301
       301
       +
       let () =

     

       302
       302
       +
         set_startup_hook server startup;

     

       303
       303
       +
         set_shutdown_hook server shutdown

     

       304
       304
       +
       

     

       305
       305
       +
       (* Make an image content helper *)

     

       306
       306
       +
       let make_image_content data mime_type =

     

       307
       307
       +
         let image_content = ImageContent.{

     

       308
       308
       +
           data;

     

       309
       309
       +
           mime_type;

     

       310
       310
       +
           annotations = None;

     

       311
       311
       +
         } in

     

       312
       312
       +
         Image image_content

     

       313
       313
       +
       

     

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

     

       315
       315
       +
       let _ = add_tool server

     

       316
       316
       +
         ~name:"generate_random_pixel_art"

     

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

     

       318
       318
       +
         ~schema_properties:[

     

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

     

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

     

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

     

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

     

       323
       323
       +
         ]

     

       324
       324
       +
         ~schema_required:[]

     

       325
       325
       +
         (fun args ->

     

       326
       326
       +
           try

     

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

     

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

     

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

     

       330
       330
       +
             

     

       331
       331
       +
             (* Validate parameters *)

     

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

     

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

     

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

     

       335
       335
       +
             

     

       336
       336
       +
             (* Extract optional seed *)

     

       337
       337
       +
             let seed = match args with

     

       338
       338
       +
               | `Assoc fields ->

     

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

     

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

     

       341
       341
       +
                  | _ -> None)

     

       342
       342
       +
               | _ -> None

     

       343
       343
       +
             in

     

       344
       344
       +
             

     

       345
       345
       +
             (* Generate the image *)

     

       346
       346
       +
             let image_data = ImageGenerator.generate_random_image 

     

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

     

       348
       348
       +
             

     

       349
       349
       +
             (* Encode as base64 *)

     

       350
       350
       +
             let base64_data = Base64.encode image_data in

     

       351
       351
       +
             

     

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

     

       353
       353
       +
                        width height pixel_size);

     

       354
       354
       +
             

     

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

     

       356
       356
       +
             CallToolResult.yojson_of_t CallToolResult.{

     

       357
       357
       +
               content = [

     

       358
       358
       +
                 Text TextContent.{ 

     

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

     

       360
       360
       +
                           width height pixel_size;

     

       361
       361
       +
                   annotations = None 

     

       362
       362
       +
                 };

     

       363
       363
       +
                 Image ImageContent.{ 

     

       364
       364
       +
                   data = base64_data; 

     

       365
       365
       +
                   mime_type = "image/png"; 

     

       366
       366
       +
                   annotations = None 

     

       367
       367
       +
                 }

     

       368
       368
       +
               ];

     

       369
       369
       +
               is_error = false;

     

       370
       370
       +
               meta = None

     

       371
       371
       +
             }

     

       372
       372
       +
           with

     

       373
       373
       +
           | Failure msg ->

     

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

     

       375
       375
       +
             CallToolResult.yojson_of_t CallToolResult.{

     

       376
       376
       +
               content = [

     

       377
       377
       +
                 Text TextContent.{ 

     

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

     

       379
       379
       +
                   annotations = None 

     

       380
       380
       +
                 }

     

       381
       381
       +
               ];

     

       382
       382
       +
               is_error = true;

     

       383
       383
       +
               meta = None

     

       384
       384
       +
             }

     

       385
       385
       +
         )

     

       386
       386
       +
       

     

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

     

       388
       388
       +
       let _ = add_prompt server

     

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

     

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

     

       391
       391
       +
         ~arguments:[

     

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

     

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

     

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

     

       395
       395
       +
         ]

     

       396
       396
       +
         (fun args ->

     

       397
       397
       +
           (* Parse parameters with defaults *)

     

       398
       398
       +
           let width = 

     

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

     

       400
       400
       +
             with _ -> 16

     

       401
       401
       +
           in

     

       402
       402
       +
           let height = 

     

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

     

       404
       404
       +
             with _ -> 16

     

       405
       405
       +
           in

     

       406
       406
       +
           let pixel_size = 

     

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

     

       408
       408
       +
             with _ -> 8

     

       409
       409
       +
           in

     

       410
       410
       +
           

     

       411
       411
       +
           (* Validate parameters *)

     

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

     

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

     

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

     

       415
       415
       +
           

     

       416
       416
       +
           (* Generate image *)

     

       417
       417
       +
           let image_data = ImageGenerator.generate_random_image 

     

       418
       418
       +
             ~width ~height ~pixel_size () in

     

       419
       419
       +
           

     

       420
       420
       +
           (* Encode as base64 *)

     

       421
       421
       +
           let base64_data = Base64.encode image_data in

     

       422
       422
       +
           

     

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

     

       424
       424
       +
                      width height pixel_size);

     

       425
       425
       +
           

     

       426
       426
       +
           [

     

       427
       427
       +
             Prompt.{ 

     

       428
       428
       +
               role = `User; 

     

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

     

       430
       430
       +
             };

     

       431
       431
       +
             Prompt.{ 

     

       432
       432
       +
               role = `User;

     

       433
       433
       +
               content = make_image_content base64_data "image/png" 

     

       434
       434
       +
             };

     

       435
       435
       +
             Prompt.{ 

     

       436
       436
       +
               role = `User; 

     

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

     

       438
       438
       +
                                            width height)

     

       439
       439
       +
             };

     

       440
       440
       +
             Prompt.{ 

     

       441
       441
       +
               role = `Assistant; 

     

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

     

       443
       443
       +
             }

     

       444
       444
       +
           ]

     

       445
       445
       +
         )

     

       446
       446
       +
       

     

       447
       447
       +
       (* Main function *)

     

       448
       448
       +
       let () =

     

       449
       449
       +
         (* Parse command line arguments *)

     

       450
       450
       +
         let transport_type = ref Stdio in

     

       451
       451
       +
         let args = [

     

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

     

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

     

       454
       454
       +
         ] in

     

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

     

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

     

       457
       457
       +
       

     

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

     

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

     

       460
       460
       +
         flush stderr;

     

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

     

       462
       462
       +
         

     

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

     

       464
       464
       +
         ignore (configure_server server ());

     

       465
       465
       +
         

     

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

     

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

     

       468
       468
       +
         start mcp_server

-728

bin/markdown_book_sdk.ml

···

       1
       1
       -
       open Mcp_sdk

     

       2
       2
       -
       

     

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

     

       4
       4
       -
       module BookChapter = struct

     

       5
       5
       -
         type t = {

     

       6
       6
       -
           id: string;

     

       7
       7
       -
           title: string;

     

       8
       8
       -
           contents: string;

     

       9
       9
       -
         }

     

       10
       10
       -
       

     

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

     

       12
       12
       -
         let chapters = [

     

       13
       13
       -
           {

     

       14
       14
       -
             id = "chapter1";

     

       15
       15
       -
             title = "# Introduction to OCaml";

     

       16
       16
       -
             contents = {|

     

       17
       17
       -
       # Introduction to OCaml

     

       18
       18
       -
       

     

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

     

       20
       20
       -
       

     

       21
       21
       -
       ## Key Features

     

       22
       22
       -
       

     

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

     

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

     

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

     

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

     

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

     

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

     

       29
       29
       -
       

     

       30
       30
       -
       ## History

     

       31
       31
       -
       

     

       32
       32
       -
       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.

     

       33
       33
       -
       

     

       34
       34
       -
       ## Why OCaml?

     

       35
       35
       -
       

     

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

     

       37
       37
       -
       

     

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

     

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

     

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

     

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

     

       42
       42
       -
       

     

       43
       43
       -
       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.

     

       44
       44
       -
       |}

     

       45
       45
       -
           };

     

       46
       46
       -
           {

     

       47
       47
       -
             id = "chapter2";

     

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

     

       49
       49
       -
             contents = {|

     

       50
       50
       -
       # Basic Syntax and Types

     

       51
       51
       -
       

     

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

     

       53
       53
       -
       

     

       54
       54
       -
       ## Variables and Basic Types

     

       55
       55
       -
       

     

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

     

       57
       57
       -
       

     

       58
       58
       -
       ```ocaml

     

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

     

       60
       60
       -
       let x = 42

     

       61
       61
       -
       let greeting = "Hello, World!"

     

       62
       62
       -
       

     

       63
       63
       -
       (* OCaml has type inference *)

     

       64
       64
       -
       (* These are equivalent: *)

     

       65
       65
       -
       let x = 42

     

       66
       66
       -
       let x : int = 42

     

       67
       67
       -
       ```

     

       68
       68
       -
       

     

       69
       69
       -
       ## Basic Types

     

       70
       70
       -
       

     

       71
       71
       -
       - `int`: Integer numbers

     

       72
       72
       -
       - `float`: Floating-point numbers

     

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

     

       74
       74
       -
       - `char`: Single characters

     

       75
       75
       -
       - `string`: Text strings

     

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

     

       77
       77
       -
       

     

       78
       78
       -
       ## Functions

     

       79
       79
       -
       

     

       80
       80
       -
       Functions in OCaml are first-class values:

     

       81
       81
       -
       

     

       82
       82
       -
       ```ocaml

     

       83
       83
       -
       (* A simple function *)

     

       84
       84
       -
       let add x y = x + y

     

       85
       85
       -
       

     

       86
       86
       -
       (* With type annotations *)

     

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

     

       88
       88
       -
       

     

       89
       89
       -
       (* Anonymous (lambda) function *)

     

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

     

       91
       91
       -
       

     

       92
       92
       -
       (* Partial application *)

     

       93
       93
       -
       let add5 = add 5

     

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

     

       95
       95
       -
       ```

     

       96
       96
       -
       

     

       97
       97
       -
       ## Control Flow

     

       98
       98
       -
       

     

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

     

       100
       100
       -
       

     

       101
       101
       -
       ```ocaml

     

       102
       102
       -
       (* If expression *)

     

       103
       103
       -
       let abs x = 

     

       104
       104
       -
         if x < 0 then -x else x

     

       105
       105
       -
       

     

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

     

       107
       107
       -
       let describe_sign x =

     

       108
       108
       -
         match x with

     

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

     

       110
       110
       -
         | 0 -> "zero"

     

       111
       111
       -
         | _ -> "positive"

     

       112
       112
       -
       ```

     

       113
       113
       -
       

     

       114
       114
       -
       ## Recursion

     

       115
       115
       -
       

     

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

     

       117
       117
       -
       

     

       118
       118
       -
       ```ocaml

     

       119
       119
       -
       (* Recursive function *)

     

       120
       120
       -
       let rec factorial n =

     

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

     

       122
       122
       -
       

     

       123
       123
       -
       (* Mutually recursive functions *)

     

       124
       124
       -
       let rec is_even n =

     

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

     

       126
       126
       -
       and is_odd n =

     

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

     

       128
       128
       -
       ```

     

       129
       129
       -
       

     

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

     

       131
       131
       -
       |}

     

       132
       132
       -
           };

     

       133
       133
       -
           {

     

       134
       134
       -
             id = "chapter3";

     

       135
       135
       -
             title = "# Data Structures";

     

       136
       136
       -
             contents = {|

     

       137
       137
       -
       # Data Structures

     

       138
       138
       -
       

     

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

     

       140
       140
       -
       

     

       141
       141
       -
       ## Tuples

     

       142
       142
       -
       

     

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

     

       144
       144
       -
       

     

       145
       145
       -
       ```ocaml

     

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

     

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

     

       148
       148
       -
       

     

       149
       149
       -
       (* Extracting values with pattern matching *)

     

       150
       150
       -
       let (age, name) = person

     

       151
       151
       -
       

     

       152
       152
       -
       (* Accessing elements *)

     

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

     

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

     

       155
       155
       -
       ```

     

       156
       156
       -
       

     

       157
       157
       -
       ## Records

     

       158
       158
       -
       

     

       159
       159
       -
       Records are named collections of values:

     

       160
       160
       -
       

     

       161
       161
       -
       ```ocaml

     

       162
       162
       -
       (* Defining a record type *)

     

       163
       163
       -
       type person = {

     

       164
       164
       -
         name: string;

     

       165
       165
       -
         age: int;

     

       166
       166
       -
         email: string option;

     

       167
       167
       -
       }

     

       168
       168
       -
       

     

       169
       169
       -
       (* Creating a record *)

     

       170
       170
       -
       let alice = {

     

       171
       171
       -
         name = "Alice";

     

       172
       172
       -
         age = 42;

     

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

     

       174
       174
       -
       }

     

       175
       175
       -
       

     

       176
       176
       -
       (* Accessing fields *)

     

       177
       177
       -
       let alices_name = alice.name

     

       178
       178
       -
       

     

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

     

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

     

       181
       181
       -
       ```

     

       182
       182
       -
       

     

       183
       183
       -
       ## Variants

     

       184
       184
       -
       

     

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

     

       186
       186
       -
       

     

       187
       187
       -
       ```ocaml

     

       188
       188
       -
       (* Defining a variant type *)

     

       189
       189
       -
       type shape =

     

       190
       190
       -
         | Circle of float  (* radius *)

     

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

     

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

     

       193
       193
       -
       

     

       194
       194
       -
       (* Creating variants *)

     

       195
       195
       -
       let my_circle = Circle 2.5

     

       196
       196
       -
       let my_rectangle = Rectangle (4.0, 6.0)

     

       197
       197
       -
       

     

       198
       198
       -
       (* Pattern matching with variants *)

     

       199
       199
       -
       let area shape =

     

       200
       200
       -
         match shape with

     

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

     

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

     

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

     

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

     

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

     

       206
       206
       -
       ```

     

       207
       207
       -
       

     

       208
       208
       -
       ## Lists

     

       209
       209
       -
       

     

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

     

       211
       211
       -
       

     

       212
       212
       -
       ```ocaml

     

       213
       213
       -
       (* Creating lists *)

     

       214
       214
       -
       let empty = []

     

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

     

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

     

       217
       217
       -
       

     

       218
       218
       -
       (* Pattern matching with lists *)

     

       219
       219
       -
       let rec sum_list lst =

     

       220
       220
       -
         match lst with

     

       221
       221
       -
         | [] -> 0

     

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

     

       223
       223
       -
       

     

       224
       224
       -
       (* Common list functions *)

     

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

     

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

     

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

     

       228
       228
       -
       ```

     

       229
       229
       -
       

     

       230
       230
       -
       ## Arrays

     

       231
       231
       -
       

     

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

     

       233
       233
       -
       

     

       234
       234
       -
       ```ocaml

     

       235
       235
       -
       (* Creating arrays *)

     

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

     

       237
       237
       -
       

     

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

     

       239
       239
       -
       let first = arr.(0)

     

       240
       240
       -
       

     

       241
       241
       -
       (* Modifying elements *)

     

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

     

       243
       243
       -
       

     

       244
       244
       -
       (* Array functions *)

     

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

     

       246
       246
       -
       ```

     

       247
       247
       -
       

     

       248
       248
       -
       ## Option Type

     

       249
       249
       -
       

     

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

     

       251
       251
       -
       

     

       252
       252
       -
       ```ocaml

     

       253
       253
       -
       (* Option type *)

     

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

     

       255
       255
       -
       

     

       256
       256
       -
       (* Using options *)

     

       257
       257
       -
       let safe_divide x y =

     

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

     

       259
       259
       -
       

     

       260
       260
       -
       (* Working with options *)

     

       261
       261
       -
       match safe_divide 10 2 with

     

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

     

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

     

       264
       264
       -
       ```

     

       265
       265
       -
       

     

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

     

       267
       267
       -
       |}

     

       268
       268
       -
           };

     

       269
       269
       -
           {

     

       270
       270
       -
             id = "chapter4";

     

       271
       271
       -
             title = "# Modules and Functors";

     

       272
       272
       -
             contents = {|

     

       273
       273
       -
       # Modules and Functors

     

       274
       274
       -
       

     

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

     

       276
       276
       -
       

     

       277
       277
       -
       ## Basic Modules

     

       278
       278
       -
       

     

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

     

       280
       280
       -
       

     

       281
       281
       -
       ```ocaml

     

       282
       282
       -
       (* Defining a module *)

     

       283
       283
       -
       module Math = struct

     

       284
       284
       -
         let pi = 3.14159

     

       285
       285
       -
         let square x = x *. x

     

       286
       286
       -
         let cube x = x *. x *. x

     

       287
       287
       -
       end

     

       288
       288
       -
       

     

       289
       289
       -
       (* Using a module *)

     

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

     

       291
       291
       -
       ```

     

       292
       292
       -
       

     

       293
       293
       -
       ## Module Signatures

     

       294
       294
       -
       

     

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

     

       296
       296
       -
       

     

       297
       297
       -
       ```ocaml

     

       298
       298
       -
       (* Defining a signature *)

     

       299
       299
       -
       module type MATH = sig

     

       300
       300
       -
         val pi : float

     

       301
       301
       -
         val square : float -> float

     

       302
       302
       -
         val cube : float -> float

     

       303
       303
       -
       end

     

       304
       304
       -
       

     

       305
       305
       -
       (* Implementing a signature *)

     

       306
       306
       -
       module Math : MATH = struct

     

       307
       307
       -
         let pi = 3.14159

     

       308
       308
       -
         let square x = x *. x

     

       309
       309
       -
         let cube x = x *. x *. x

     

       310
       310
       -
         

     

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

     

       312
       312
       -
         let private_helper x = x +. 1.0

     

       313
       313
       -
       end

     

       314
       314
       -
       ```

     

       315
       315
       -
       

     

       316
       316
       -
       ## Functors

     

       317
       317
       -
       

     

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

     

       319
       319
       -
       

     

       320
       320
       -
       ```ocaml

     

       321
       321
       -
       (* Module signature for collections *)

     

       322
       322
       -
       module type COLLECTION = sig

     

       323
       323
       -
         type 'a t

     

       324
       324
       -
         val empty : 'a t

     

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

     

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

     

       327
       327
       -
       end

     

       328
       328
       -
       

     

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

     

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

     

       331
       331
       -
         type 'a t = Element.t list

     

       332
       332
       -
         

     

       333
       333
       -
         let empty = []

     

       334
       334
       -
         

     

       335
       335
       -
         let rec add x lst =

     

       336
       336
       -
           match lst with

     

       337
       337
       -
           | [] -> [x]

     

       338
       338
       -
           | y :: ys ->

     

       339
       339
       -
               let c = Element.compare x y in

     

       340
       340
       -
               if c < 0 then x :: lst

     

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

     

       342
       342
       -
               else y :: add x ys

     

       343
       343
       -
         

     

       344
       344
       -
         let rec mem x lst =

     

       345
       345
       -
           match lst with

     

       346
       346
       -
           | [] -> false

     

       347
       347
       -
           | y :: ys ->

     

       348
       348
       -
               let c = Element.compare x y in

     

       349
       349
       -
               if c = 0 then true

     

       350
       350
       -
               else if c < 0 then false

     

       351
       351
       -
               else mem x ys

     

       352
       352
       -
       end

     

       353
       353
       -
       

     

       354
       354
       -
       (* Creating an integer set *)

     

       355
       355
       -
       module IntElement = struct

     

       356
       356
       -
         type t = int

     

       357
       357
       -
         let compare = Int.compare

     

       358
       358
       -
       end

     

       359
       359
       -
       

     

       360
       360
       -
       module IntSet = MakeSet(IntElement)

     

       361
       361
       -
       

     

       362
       362
       -
       (* Using the set *)

     

       363
       363
       -
       let my_set = IntSet.empty

     

       364
       364
       -
                    |> IntSet.add 3

     

       365
       365
       -
                    |> IntSet.add 1

     

       366
       366
       -
                    |> IntSet.add 4

     

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

     

       368
       368
       -
       

     

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

     

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

     

       371
       371
       -
       ```

     

       372
       372
       -
       

     

       373
       373
       -
       ## First-Class Modules

     

       374
       374
       -
       

     

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

     

       376
       376
       -
       

     

       377
       377
       -
       ```ocaml

     

       378
       378
       -
       (* Module type for number operations *)

     

       379
       379
       -
       module type NUMBER = sig

     

       380
       380
       -
         type t

     

       381
       381
       -
         val zero : t

     

       382
       382
       -
         val add : t -> t -> t

     

       383
       383
       -
         val to_string : t -> string

     

       384
       384
       -
       end

     

       385
       385
       -
       

     

       386
       386
       -
       (* Implementations for different number types *)

     

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

     

       388
       388
       -
         type t = int

     

       389
       389
       -
         let zero = 0

     

       390
       390
       -
         let add = (+)

     

       391
       391
       -
         let to_string = string_of_int

     

       392
       392
       -
       end

     

       393
       393
       -
       

     

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

     

       395
       395
       -
         type t = float

     

       396
       396
       -
         let zero = 0.0

     

       397
       397
       -
         let add = (+.)

     

       398
       398
       -
         let to_string = string_of_float

     

       399
       399
       -
       end

     

       400
       400
       -
       

     

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

     

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

     

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

     

       404
       404
       -
         N.to_string sum

     

       405
       405
       -
       

     

       406
       406
       -
       (* Using first-class modules *)

     

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

     

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

     

       409
       409
       -
       ```

     

       410
       410
       -
       

     

       411
       411
       -
       ## Open and Include

     

       412
       412
       -
       

     

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

     

       414
       414
       -
       

     

       415
       415
       -
       ```ocaml

     

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

     

       417
       417
       -
       let area =

     

       418
       418
       -
         let open Math in

     

       419
       419
       -
         pi *. square 2.0

     

       420
       420
       -
       

     

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

     

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

     

       423
       423
       -
       

     

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

     

       425
       425
       -
       module ExtendedMath = struct

     

       426
       426
       -
         include Math

     

       427
       427
       -
         let tau = 2.0 *. pi

     

       428
       428
       -
         let circumference r = tau *. r

     

       429
       429
       -
       end

     

       430
       430
       -
       ```

     

       431
       431
       -
       

     

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

     

       433
       433
       -
       |}

     

       434
       434
       -
           };

     

       435
       435
       -
           {

     

       436
       436
       -
             id = "chapter5";

     

       437
       437
       -
             title = "# Advanced Features";

     

       438
       438
       -
             contents = {|

     

       439
       439
       -
       # Advanced Features

     

       440
       440
       -
       

     

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

     

       442
       442
       -
       

     

       443
       443
       -
       ## Polymorphic Variants

     

       444
       444
       -
       

     

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

     

       446
       446
       -
       

     

       447
       447
       -
       ```ocaml

     

       448
       448
       -
       (* Using polymorphic variants directly *)

     

       449
       449
       -
       let weekend = `Saturday | `Sunday

     

       450
       450
       -
       let is_weekend day =

     

       451
       451
       -
         match day with

     

       452
       452
       -
         | `Saturday | `Sunday -> true

     

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

     

       454
       454
       -
       

     

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

     

       456
       456
       -
       let shape_area = function

     

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

     

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

     

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

     

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

     

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

     

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

     

       463
       463
       -
         | _ -> failwith "Invalid shape"

     

       464
       464
       -
       ```

     

       465
       465
       -
       

     

       466
       466
       -
       ## Objects and Classes

     

       467
       467
       -
       

     

       468
       468
       -
       OCaml supports object-oriented programming:

     

       469
       469
       -
       

     

       470
       470
       -
       ```ocaml

     

       471
       471
       -
       (* Simple class definition *)

     

       472
       472
       -
       class point x_init y_init =

     

       473
       473
       -
         object (self)

     

       474
       474
       -
           val mutable x = x_init

     

       475
       475
       -
           val mutable y = y_init

     

       476
       476
       -
           

     

       477
       477
       -
           method get_x = x

     

       478
       478
       -
           method get_y = y

     

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

     

       480
       480
       -
           method distance_from_origin = 

     

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

     

       482
       482
       -
           

     

       483
       483
       -
           (* Private method *)

     

       484
       484
       -
           method private to_string = 

     

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

     

       486
       486
       -
           

     

       487
       487
       -
           (* Calling another method *)

     

       488
       488
       -
           method print = print_endline self#to_string

     

       489
       489
       -
         end

     

       490
       490
       -
       

     

       491
       491
       -
       (* Using a class *)

     

       492
       492
       -
       let p = new point 3 4

     

       493
       493
       -
       let () = p#move 2 1

     

       494
       494
       -
       let d = p#distance_from_origin

     

       495
       495
       -
       ```

     

       496
       496
       -
       

     

       497
       497
       -
       ## Generalized Algebraic Data Types (GADTs)

     

       498
       498
       -
       

     

       499
       499
       -
       GADTs provide more type control than regular variants:

     

       500
       500
       -
       

     

       501
       501
       -
       ```ocaml

     

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

     

       503
       503
       -
       type _ expr =

     

       504
       504
       -
         | Int : int -> int expr

     

       505
       505
       -
         | Bool : bool -> bool expr

     

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

     

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

     

       508
       508
       -
       

     

       509
       509
       -
       (* Type-safe evaluation *)

     

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

     

       511
       511
       -
         | Int n -> n

     

       512
       512
       -
         | Bool b -> b

     

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

     

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

     

       515
       515
       -
       

     

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

     

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

     

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

     

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

     

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

     

       521
       521
       -
       ```

     

       522
       522
       -
       

     

       523
       523
       -
       ## Type Extensions

     

       524
       524
       -
       

     

       525
       525
       -
       OCaml allows extending existing types:

     

       526
       526
       -
       

     

       527
       527
       -
       ```ocaml

     

       528
       528
       -
       (* Original type *)

     

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

     

       530
       530
       -
       

     

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

     

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

     

       533
       533
       -
       

     

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

     

       535
       535
       -
       let area = function

     

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

     

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

     

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

     

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

     

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

     

       541
       541
       -
         | _ -> failwith "Unknown shape"

     

       542
       542
       -
       ```

     

       543
       543
       -
       

     

       544
       544
       -
       ## Effects and Effect Handlers

     

       545
       545
       -
       

     

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

     

       547
       547
       -
       

     

       548
       548
       -
       ```ocaml

     

       549
       549
       -
       (* Defining an effect *)

     

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

     

       551
       551
       -
       

     

       552
       552
       -
       (* Handler for the Ask effect *)

     

       553
       553
       -
       let prompt_user () =

     

       554
       554
       -
         Effect.Deep.try_with

     

       555
       555
       -
           (fun () -> 

     

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

     

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

     

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

     

       559
       559
       -
               match effect with

     

       560
       560
       -
               | Ask prompt -> fun k ->

     

       561
       561
       -
                   Printf.printf "%s " prompt;

     

       562
       562
       -
                   let response = read_line () in

     

       563
       563
       -
                   k response

     

       564
       564
       -
               | _ -> None }

     

       565
       565
       -
       ```

     

       566
       566
       -
       

     

       567
       567
       -
       ## Higher-Ranked Polymorphism

     

       568
       568
       -
       

     

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

     

       570
       570
       -
       

     

       571
       571
       -
       ```ocaml

     

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

     

       573
       573
       -
       let apply_to_all_types f =

     

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

     

       575
       575
       -
         [

     

       576
       576
       -
           magic_f 42;

     

       577
       577
       -
           magic_f "hello";

     

       578
       578
       -
           magic_f 3.14;

     

       579
       579
       -
           magic_f true;

     

       580
       580
       -
         ]

     

       581
       581
       -
       

     

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

     

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

     

       584
       584
       -
       ```

     

       585
       585
       -
       

     

       586
       586
       -
       ## Metaprogramming with PPX

     

       587
       587
       -
       

     

       588
       588
       -
       OCaml's PPX system enables powerful metaprogramming:

     

       589
       589
       -
       

     

       590
       590
       -
       ```ocaml

     

       591
       591
       -
       (* With ppx_deriving *)

     

       592
       592
       -
       type person = {

     

       593
       593
       -
         name: string;

     

       594
       594
       -
         age: int;

     

       595
       595
       -
         email: string option;

     

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

     

       597
       597
       -
       

     

       598
       598
       -
       (* With ppx_sexp_conv *)

     

       599
       599
       -
       type config = {

     

       600
       600
       -
         server: string;

     

       601
       601
       -
         port: int;

     

       602
       602
       -
         timeout: float;

     

       603
       603
       -
       } [@@deriving sexp]

     

       604
       604
       -
       

     

       605
       605
       -
       (* With ppx_let for monadic operations *)

     

       606
       606
       -
       let computation = 

     

       607
       607
       -
         [%m.let

     

       608
       608
       -
           let* x = get_value_from_db "key1" in

     

       609
       609
       -
           let* y = get_value_from_db "key2" in

     

       610
       610
       -
           return (x + y)

     

       611
       611
       -
         ]

     

       612
       612
       -
       ```

     

       613
       613
       -
       

     

       614
       614
       -
       ## Modules for Advanced Typing

     

       615
       615
       -
       

     

       616
       616
       -
       Using modules to encode complex type relationships:

     

       617
       617
       -
       

     

       618
       618
       -
       ```ocaml

     

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

     

       620
       620
       -
       module SafeString : sig

     

       621
       621
       -
         type 'a t

     

       622
       622
       -
         

     

       623
       623
       -
         (* Constructors for different string types *)

     

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

     

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

     

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

     

       627
       627
       -
         

     

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

     

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

     

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

     

       631
       631
       -
         

     

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

     

       633
       633
       -
         val length : _ t -> int

     

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

     

       635
       635
       -
       end = struct

     

       636
       636
       -
         type 'a t = string

     

       637
       637
       -
         

     

       638
       638
       -
         let of_raw s = s

     

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

     

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

     

       641
       641
       -
         

     

       642
       642
       -
         let to_html s = s

     

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

     

       644
       644
       -
         

     

       645
       645
       -
         let length = String.length

     

       646
       646
       -
         let concat s1 s2 = s1 ^ s2

     

       647
       647
       -
       end

     

       648
       648
       -
       ```

     

       649
       649
       -
       

     

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

     

       651
       651
       -
       |}

     

       652
       652
       -
           };

     

       653
       653
       -
         ]

     

       654
       654
       -
       

     

       655
       655
       -
         (* Get a chapter by ID *)

     

       656
       656
       -
         let get_by_id id =

     

       657
       657
       -
           try Some (List.find (fun c -> c.id = id) chapters)

     

       658
       658
       -
           with Not_found -> None

     

       659
       659
       -
           

     

       660
       660
       -
         (* Get chapter titles *)

     

       661
       661
       -
         let get_all_titles () =

     

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

     

       663
       663
       -
       end

     

       664
       664
       -
       

     

       665
       665
       -
       (* Create a server *)

     

       666
       666
       -
       let server = create_server 

     

       667
       667
       -
         ~name:"OCaml MCP Book Resource Example" 

     

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

     

       669
       669
       -
         fun server ->

     

       670
       670
       -
           (* Set default capabilities *)

     

       671
       671
       -
           configure_server server 

     

       672
       672
       -
             ~with_tools:false 

     

       673
       673
       -
             ~with_resources:true

     

       674
       674
       -
             ~with_resource_templates:true

     

       675
       675
       -
             ~with_prompts:false ()

     

       676
       676
       -
       

     

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

     

       678
       678
       -
       let _ = add_resource_template server

     

       679
       679
       -
         ~uri_template:"book/chapter/{id}"

     

       680
       680
       -
         ~name:"Chapter Resource"

     

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

     

       682
       682
       -
         ~mime_type:"text/markdown"

     

       683
       683
       -
         (fun params ->

     

       684
       684
       -
           match params with

     

       685
       685
       -
           | [id] ->

     

       686
       686
       -
             (match BookChapter.get_by_id id with

     

       687
       687
       -
             | Some chapter -> chapter.contents

     

       688
       688
       -
             | None -> Printf.sprintf "# Error\n\nChapter with ID '%s' not found." id)

     

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

     

       690
       690
       -
         )

     

       691
       691
       -
       

     

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

     

       693
       693
       -
       let _ = add_resource server

     

       694
       694
       -
         ~uri:"book/toc"

     

       695
       695
       -
         ~name:"Table of Contents"

     

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

     

       697
       697
       -
         ~mime_type:"text/markdown"

     

       698
       698
       -
         (fun _params ->

     

       699
       699
       -
           let titles = BookChapter.get_all_titles() in

     

       700
       700
       -
           let toc = "# OCaml Book - Table of Contents\n\n" ^

     

       701
       701
       -
             (List.mapi (fun i (id, title) ->

     

       702
       702
       -
               Printf.sprintf "%d. [%s](book/chapter/%s)\n" 

     

       703
       703
       -
                 (i + 1) 

     

       704
       704
       -
                 (String.sub title 2 (String.length title - 2)) (* Remove "# " prefix *)

     

       705
       705
       -
                 id

     

       706
       706
       -
             ) titles |> String.concat "")

     

       707
       707
       -
           in

     

       708
       708
       -
           toc

     

       709
       709
       -
         )

     

       710
       710
       -
       

     

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

     

       712
       712
       -
       let _ = add_resource server

     

       713
       713
       -
         ~uri:"book/complete"

     

       714
       714
       -
         ~name:"Full contents"

     

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

     

       716
       716
       -
         ~mime_type:"text/markdown"

     

       717
       717
       -
         (fun _params ->

     

       718
       718
       -
           let chapter_contents = List.map (fun c -> c.BookChapter.contents) BookChapter.chapters in

     

       719
       719
       -
           let content = "# The OCaml Book\n\n*A comprehensive guide to OCaml programming*\n\n" ^

     

       720
       720
       -
             (String.concat "\n\n---\n\n" chapter_contents)

     

       721
       721
       -
           in

     

       722
       722
       -
           content

     

       723
       723
       -
         )

     

       724
       724
       -
       

     

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

     

       726
       726
       -
       let () =

     

       727
       727
       -
         Eio_main.run @@ fun env ->

     

       728
       728
       -
           Mcp_server.run_server env server

+502

bin/multimodal_example.ml

···

       1
       1
       +
       open Mcp

     

       2
       2
       +
       open Mcp_sdk

     

       3
       3
       +
       open Mcp_server

     

       4
       4
       +
       

     

       5
       5
       +
       (* Multimodal example MCP server *)

     

       6
       6
       +
       

     

       7
       7
       +
       (* Base64 encoding helper *)

     

       8
       8
       +
       module Base64 = struct

     

       9
       9
       +
         let encode_char n =

     

       10
       10
       +
           "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/".[n]

     

       11
       11
       +
           

     

       12
       12
       +
         let encode_block i bytes =

     

       13
       13
       +
           let buffer = Buffer.create 4 in

     

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

     

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

     

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

     

       17
       17
       +
           

     

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

     

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

     

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

     

       21
       21
       +
           

     

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

     

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

     

       24
       24
       +
           else

     

       25
       25
       +
             Buffer.add_char buffer '=';

     

       26
       26
       +
             

     

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

     

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

     

       29
       29
       +
           else

     

       30
       30
       +
             Buffer.add_char buffer '=';

     

       31
       31
       +
           

     

       32
       32
       +
           Buffer.contents buffer

     

       33
       33
       +
           

     

       34
       34
       +
         let encode data =

     

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

     

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

     

       37
       37
       +
             Buffer.add_string buffer (encode_block i data)

     

       38
       38
       +
           done;

     

       39
       39
       +
           Buffer.contents buffer

     

       40
       40
       +
       end

     

       41
       41
       +
       

     

       42
       42
       +
       (* Audio generator *)

     

       43
       43
       +
       module AudioGenerator = struct

     

       44
       44
       +
         (* Generate a simple sine wave *)

     

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

     

       46
       46
       +
           (* WAV parameters *)

     

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

     

       48
       48
       +
           let bits_per_sample = 16 in

     

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

     

       50
       50
       +
           let block_align = num_channels * bits_per_sample / 8 in

     

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

     

       52
       52
       +
           let data_size = num_samples * block_align in

     

       53
       53
       +
           

     

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

     

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

     

       56
       56
       +
           

     

       57
       57
       +
           (* Write WAV header *)

     

       58
       58
       +
           (* "RIFF" chunk *)

     

       59
       59
       +
           Buffer.add_string buffer "RIFF";

     

       60
       60
       +
           let file_size = 36 + data_size in

     

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

     

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

     

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

     

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

     

       65
       65
       +
           Buffer.add_string buffer "WAVE";

     

       66
       66
       +
           

     

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

     

       68
       68
       +
           Buffer.add_string buffer "fmt ";

     

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

     

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

     

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

     

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

     

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

     

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

     

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

     

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

     

       77
       77
       +
           

     

       78
       78
       +
           (* Sample rate *)

     

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

     

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

     

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

     

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

     

       83
       83
       +
           

     

       84
       84
       +
           (* Byte rate *)

     

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

     

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

     

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

     

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

     

       89
       89
       +
           

     

       90
       90
       +
           (* Block align *)

     

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

     

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

     

       93
       93
       +
           

     

       94
       94
       +
           (* Bits per sample *)

     

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

     

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

     

       97
       97
       +
           

     

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

     

       99
       99
       +
           Buffer.add_string buffer "data";

     

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

     

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

     

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

     

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

     

       104
       104
       +
           

     

       105
       105
       +
           (* Generate sine wave data *)

     

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

     

       107
       107
       +
           for i = 0 to num_samples - 1 do

     

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

     

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

     

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

     

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

     

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

     

       113
       113
       +
           done;

     

       114
       114
       +
           

     

       115
       115
       +
           Buffer.contents buffer

     

       116
       116
       +
       end

     

       117
       117
       +
       

     

       118
       118
       +
       (* Image generator *)

     

       119
       119
       +
       module ImageGenerator = struct

     

       120
       120
       +
         (* Simple PNG generation *)

     

       121
       121
       +
         let generate_simple_image width height color_str =

     

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

     

       123
       123
       +
           let r, g, b, a = 

     

       124
       124
       +
             try

     

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

     

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

     

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

     

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

     

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

     

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

     

       131
       131
       +
                        else 255 in

     

       132
       132
       +
                 (r, g, b, a)

     

       133
       133
       +
               else

     

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

     

       135
       135
       +
             with _ -> 

     

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

     

       137
       137
       +
           in

     

       138
       138
       +
           

     

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

     

       140
       140
       +
           (* PNG signature *)

     

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

     

       142
       142
       +
           

     

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

     

       144
       144
       +
           let buffer = Buffer.create 100 in

     

       145
       145
       +
           

     

       146
       146
       +
           (* PNG signature *)

     

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

     

       148
       148
       +
           

     

       149
       149
       +
           (* IHDR chunk *)

     

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

     

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

     

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

     

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

     

       154
       154
       +
           

     

       155
       155
       +
           Buffer.add_string buffer "IHDR";

     

       156
       156
       +
           

     

       157
       157
       +
           (* Width *)

     

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

     

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

     

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

     

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

     

       162
       162
       +
           

     

       163
       163
       +
           (* Height *)

     

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

     

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

     

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

     

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

     

       168
       168
       +
           

     

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

     

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

     

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

     

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

     

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

     

       174
       174
       +
           

     

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

     

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

     

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

     

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

     

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

     

       180
       180
       +
           

     

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

     

       182
       182
       +
           let pixels_per_row = width * 4 in

     

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

     

       184
       184
       +
           

     

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

     

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

     

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

     

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

     

       189
       189
       +
           

     

       190
       190
       +
           Buffer.add_string buffer "IDAT";

     

       191
       191
       +
           

     

       192
       192
       +
           (* Simple zlib header *)

     

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

     

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

     

       195
       195
       +
           

     

       196
       196
       +
           (* Raw image data *)

     

       197
       197
       +
           for _ = 0 to height - 1 do

     

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

     

       199
       199
       +
             for _ = 0 to width - 1 do

     

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

     

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

     

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

     

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

     

       204
       204
       +
             done

     

       205
       205
       +
           done;

     

       206
       206
       +
           

     

       207
       207
       +
           (* Dummy Adler32 checksum *)

     

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

     

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

     

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

     

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

     

       212
       212
       +
           

     

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

     

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

     

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

     

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

     

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

     

       218
       218
       +
           

     

       219
       219
       +
           (* IEND chunk *)

     

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

     

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

     

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

     

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

     

       224
       224
       +
           

     

       225
       225
       +
           Buffer.add_string buffer "IEND";

     

       226
       226
       +
           

     

       227
       227
       +
           (* IEND CRC - precomputed value *)

     

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

     

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

     

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

     

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

     

       232
       232
       +
           

     

       233
       233
       +
           Buffer.contents buffer

     

       234
       234
       +
       end

     

       235
       235
       +
       

     

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

     

       237
       237
       +
       let get_param_int json name default =

     

       238
       238
       +
         match json with

     

       239
       239
       +
         | `Assoc fields -> begin

     

       240
       240
       +
             match List.assoc_opt name fields with

     

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

     

       242
       242
       +
                 i

     

       243
       243
       +
               end

     

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

     

       245
       245
       +
                 int_of_float f

     

       246
       246
       +
               end

     

       247
       247
       +
             | _ -> begin

     

       248
       248
       +
                 default

     

       249
       249
       +
               end

     

       250
       250
       +
           end

     

       251
       251
       +
         | _ -> begin

     

       252
       252
       +
             default

     

       253
       253
       +
           end

     

       254
       254
       +
       

     

       255
       255
       +
       let get_param_float json name default =

     

       256
       256
       +
         match json with

     

       257
       257
       +
         | `Assoc fields -> begin

     

       258
       258
       +
             match List.assoc_opt name fields with

     

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

     

       260
       260
       +
                 float_of_int i

     

       261
       261
       +
               end

     

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

     

       263
       263
       +
                 f

     

       264
       264
       +
               end

     

       265
       265
       +
             | _ -> begin

     

       266
       266
       +
                 default

     

       267
       267
       +
               end

     

       268
       268
       +
           end

     

       269
       269
       +
         | _ -> begin

     

       270
       270
       +
             default

     

       271
       271
       +
           end

     

       272
       272
       +
       

     

       273
       273
       +
       let get_param_string json name default =

     

       274
       274
       +
         match json with

     

       275
       275
       +
         | `Assoc fields -> begin

     

       276
       276
       +
             match List.assoc_opt name fields with

     

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

     

       278
       278
       +
                 s

     

       279
       279
       +
               end

     

       280
       280
       +
             | _ -> begin

     

       281
       281
       +
                 default

     

       282
       282
       +
               end

     

       283
       283
       +
           end

     

       284
       284
       +
         | _ -> begin

     

       285
       285
       +
             default

     

       286
       286
       +
           end

     

       287
       287
       +
       

     

       288
       288
       +
       (* Create a server *)

     

       289
       289
       +
       let server = create_server 

     

       290
       290
       +
         ~name:"OCaml MCP Multimodal Example" 

     

       291
       291
       +
         ~version:"0.1.0" 

     

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

     

       293
       293
       +
         ()

     

       294
       294
       +
       

     

       295
       295
       +
       (* Define startup and shutdown hooks *)

     

       296
       296
       +
       let startup () =

     

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

     

       298
       298
       +
         flush stderr;

     

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

     

       300
       300
       +
       

     

       301
       301
       +
       let shutdown () =

     

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

     

       303
       303
       +
         flush stderr;

     

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

     

       305
       305
       +
       

     

       306
       306
       +
       (* Register the hooks *)

     

       307
       307
       +
       let () =

     

       308
       308
       +
         set_startup_hook server startup;

     

       309
       309
       +
         set_shutdown_hook server shutdown

     

       310
       310
       +
       

     

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

     

       312
       312
       +
       let _ = add_tool server

     

       313
       313
       +
         ~name:"generate_multimodal_response"

     

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

     

       315
       315
       +
         ~schema_properties:[

     

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

     

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

     

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

     

       319
       319
       +
         ]

     

       320
       320
       +
         ~schema_required:["message"]

     

       321
       321
       +
         (fun args ->

     

       322
       322
       +
           try

     

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

     

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

     

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

     

       326
       326
       +
             

     

       327
       327
       +
             (* Generate image *)

     

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

     

       329
       329
       +
             let image_base64 = Base64.encode image_data in

     

       330
       330
       +
             

     

       331
       331
       +
             (* Generate audio *)

     

       332
       332
       +
             let audio_data = AudioGenerator.generate_sine_wave 

     

       333
       333
       +
               ~frequency:(float_of_int frequency) 

     

       334
       334
       +
               ~duration:1.0 

     

       335
       335
       +
               ~sample_rate:8000 

     

       336
       336
       +
               ~amplitude:0.8 in

     

       337
       337
       +
             let audio_base64 = Base64.encode audio_data in

     

       338
       338
       +
             

     

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

     

       340
       340
       +
             CallToolResult.yojson_of_t CallToolResult.{

     

       341
       341
       +
               content = [

     

       342
       342
       +
                 Text TextContent.{ 

     

       343
       343
       +
                   text = message;

     

       344
       344
       +
                   annotations = None 

     

       345
       345
       +
                 };

     

       346
       346
       +
                 Image ImageContent.{ 

     

       347
       347
       +
                   data = image_base64; 

     

       348
       348
       +
                   mime_type = "image/png"; 

     

       349
       349
       +
                   annotations = None 

     

       350
       350
       +
                 };

     

       351
       351
       +
                 Audio AudioContent.{ 

     

       352
       352
       +
                   data = audio_base64; 

     

       353
       353
       +
                   mime_type = "audio/wav"; 

     

       354
       354
       +
                   annotations = None 

     

       355
       355
       +
                 }

     

       356
       356
       +
               ];

     

       357
       357
       +
               is_error = false;

     

       358
       358
       +
               meta = None

     

       359
       359
       +
             }

     

       360
       360
       +
           with

     

       361
       361
       +
           | Failure msg ->

     

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

     

       363
       363
       +
             CallToolResult.yojson_of_t CallToolResult.{

     

       364
       364
       +
               content = [

     

       365
       365
       +
                 Text TextContent.{ 

     

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

     

       367
       367
       +
                   annotations = None 

     

       368
       368
       +
                 }

     

       369
       369
       +
               ];

     

       370
       370
       +
               is_error = true;

     

       371
       371
       +
               meta = None

     

       372
       372
       +
             }

     

       373
       373
       +
         )

     

       374
       374
       +
       

     

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

     

       376
       376
       +
       let _ = add_prompt server

     

       377
       377
       +
         ~name:"multimodal-prompt"

     

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

     

       379
       379
       +
         ~arguments:[

     

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

     

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

     

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

     

       383
       383
       +
         ]

     

       384
       384
       +
         (fun args ->

     

       385
       385
       +
           (* Parse parameters with defaults *)

     

       386
       386
       +
           let message = 

     

       387
       387
       +
             try List.assoc "message" args

     

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

     

       389
       389
       +
           in

     

       390
       390
       +
           

     

       391
       391
       +
           let color = 

     

       392
       392
       +
             try List.assoc "color" args

     

       393
       393
       +
             with Not_found -> "#0000FF"

     

       394
       394
       +
           in

     

       395
       395
       +
           

     

       396
       396
       +
           let frequency = 

     

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

     

       398
       398
       +
             with _ -> 440

     

       399
       399
       +
           in

     

       400
       400
       +
           

     

       401
       401
       +
           (* Generate image *)

     

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

     

       403
       403
       +
           let image_base64 = Base64.encode image_data in

     

       404
       404
       +
           

     

       405
       405
       +
           (* Generate audio *)

     

       406
       406
       +
           let audio_data = AudioGenerator.generate_sine_wave 

     

       407
       407
       +
             ~frequency:(float_of_int frequency) 

     

       408
       408
       +
             ~duration:1.0 

     

       409
       409
       +
             ~sample_rate:8000 

     

       410
       410
       +
             ~amplitude:0.8 in

     

       411
       411
       +
           let audio_base64 = Base64.encode audio_data in

     

       412
       412
       +
           

     

       413
       413
       +
           (* Create a multimodal prompt *)

     

       414
       414
       +
           [

     

       415
       415
       +
             Prompt.{ 

     

       416
       416
       +
               role = `User; 

     

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

     

       418
       418
       +
             };

     

       419
       419
       +
             Prompt.{ 

     

       420
       420
       +
               role = `User; 

     

       421
       421
       +
               content = make_text_content message

     

       422
       422
       +
             };

     

       423
       423
       +
             Prompt.{ 

     

       424
       424
       +
               role = `User;

     

       425
       425
       +
               content = make_image_content image_base64 "image/png"

     

       426
       426
       +
             };

     

       427
       427
       +
             Prompt.{ 

     

       428
       428
       +
               role = `User;

     

       429
       429
       +
               content = make_audio_content audio_base64 "audio/wav"

     

       430
       430
       +
             };

     

       431
       431
       +
             Prompt.{ 

     

       432
       432
       +
               role = `Assistant; 

     

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

     

       434
       434
       +
             }

     

       435
       435
       +
           ]

     

       436
       436
       +
         )

     

       437
       437
       +
       

     

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

     

       439
       439
       +
       let _ = add_prompt server

     

       440
       440
       +
         ~name:"resource-prompt"

     

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

     

       442
       442
       +
         ~arguments:[

     

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

     

       444
       444
       +
         ]

     

       445
       445
       +
         (fun args ->

     

       446
       446
       +
           (* Sample resource texts *)

     

       447
       447
       +
           let resources = [

     

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

     

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

     

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

     

       451
       451
       +
           ] in

     

       452
       452
       +
           

     

       453
       453
       +
           (* Get the requested resource *)

     

       454
       454
       +
           let resource_id = 

     

       455
       455
       +
             try List.assoc "resource_id" args

     

       456
       456
       +
             with Not_found -> "doc1"

     

       457
       457
       +
           in

     

       458
       458
       +
           

     

       459
       459
       +
           (* Find the resource content *)

     

       460
       460
       +
           let resource_content = 

     

       461
       461
       +
             try List.assoc resource_id resources

     

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

     

       463
       463
       +
           in

     

       464
       464
       +
           

     

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

     

       466
       466
       +
           [

     

       467
       467
       +
             Prompt.{ 

     

       468
       468
       +
               role = `User; 

     

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

     

       470
       470
       +
             };

     

       471
       471
       +
             Prompt.{ 

     

       472
       472
       +
               role = `User;

     

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

     

       474
       474
       +
             };

     

       475
       475
       +
             Prompt.{ 

     

       476
       476
       +
               role = `User; 

     

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

     

       478
       478
       +
             };

     

       479
       479
       +
             Prompt.{ 

     

       480
       480
       +
               role = `Assistant; 

     

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

     

       482
       482
       +
             }

     

       483
       483
       +
           ]

     

       484
       484
       +
         )

     

       485
       485
       +
       

     

       486
       486
       +
       (* Main function *)

     

       487
       487
       +
       let () =

     

       488
       488
       +
         (* Parse command line arguments *)

     

       489
       489
       +
         let transport_type = ref Stdio in

     

       490
       490
       +
         let args = [

     

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

     

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

     

       493
       493
       +
         ] in

     

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

     

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

     

       496
       496
       +
       

     

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

     

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

     

       499
       499
       +
         

     

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

     

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

     

       502
       502
       +
         start mcp_server;

-371

bin/multimodal_sdk.ml

···

       1
       1
       -
       open Mcp_sdk

     

       2
       2
       -
       

     

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

     

       4
       4
       -
       let get_string_param json name =

     

       5
       5
       -
         match json with

     

       6
       6
       -
         | `Assoc fields ->

     

       7
       7
       -
           (match List.assoc_opt name fields with

     

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

     

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

     

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

     

       11
       11
       -
       

     

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

     

       13
       13
       -
       let get_int_param json name =

     

       14
       14
       -
         match json with

     

       15
       15
       -
         | `Assoc fields ->

     

       16
       16
       -
           (match List.assoc_opt name fields with

     

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

     

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

     

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

     

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

     

       21
       21
       -
       

     

       22
       22
       -
       (* Base64 encoding - simplified version *)

     

       23
       23
       -
       module Base64 = struct

     

       24
       24
       -
         let encode_char idx =

     

       25
       25
       -
           "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/".[idx]

     

       26
       26
       -
         

     

       27
       27
       -
         let encode s =

     

       28
       28
       -
           let len = String.length s in

     

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

     

       30
       30
       -
           

     

       31
       31
       -
           let rec loop i j =

     

       32
       32
       -
             if i >= len then j

     

       33
       33
       -
             else

     

       34
       34
       -
               let n =

     

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

     

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

     

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

     

       38
       38
       -
               in

     

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

     

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

     

       41
       41
       -
               Bytes.set result (j+2) 

     

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

     

       43
       43
       -
               Bytes.set result (j+3) 

     

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

     

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

     

       46
       46
       -
           in

     

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

     

       48
       48
       -
       end

     

       49
       49
       -
       

     

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

     

       51
       51
       -
       let generate_random_image width height =

     

       52
       52
       -
         (* Ensure dimensions are reasonable *)

     

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

     

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

     

       55
       55
       -
         

     

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

     

       57
       57
       -
         let buf = Buffer.create 1024 in

     

       58
       58
       -
         

     

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

     

       60
       60
       -
         Buffer.add_string buf "GIF89a";

     

       61
       61
       -
         

     

       62
       62
       -
         (* Logical Screen Descriptor *)

     

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

     

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

     

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

     

       66
       66
       -
         

     

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

     

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

     

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

     

       70
       70
       -
         

     

       71
       71
       -
         (* Packed fields - 1 byte:

     

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

     

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

     

       74
       74
       -
            Sort Flag - 1 bit (0)

     

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

     

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

     

       77
       77
       -
         

     

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

     

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

     

       80
       80
       -
         

     

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

     

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

     

       83
       83
       -
         

     

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

     

       85
       85
       -
         (* Simple 8-color palette *)

     

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

     

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

     

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

     

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

     

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

     

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

     

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

     

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

     

       94
       94
       -
         

     

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

     

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

     

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

     

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

     

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

     

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

     

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

     

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

     

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

     

       104
       104
       -
         

     

       105
       105
       -
         (* Image Descriptor *)

     

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

     

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

     

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

     

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

     

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

     

       111
       111
       -
         

     

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

     

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

     

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

     

       115
       115
       -
         

     

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

     

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

     

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

     

       119
       119
       -
         

     

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

     

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

     

       122
       122
       -
         

     

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

     

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

     

       125
       125
       -
         

     

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

     

       127
       127
       -
         let step = width / 8 in

     

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

     

       129
       129
       -
         

     

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

     

       131
       131
       -
         (* Start with Clear code *)

     

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

     

       133
       133
       -
         

     

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

     

       135
       135
       -
         for y = 0 to height - 1 do

     

       136
       136
       -
           for x = 0 to width - 1 do

     

       137
       137
       -
             (* Checkerboard pattern with different colors *)

     

       138
       138
       -
             let color =

     

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

     

       140
       140
       -
                 3  (* Blue *)

     

       141
       141
       -
               else

     

       142
       142
       -
                 1  (* Red *)

     

       143
       143
       -
             in

     

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

     

       145
       145
       -
           done

     

       146
       146
       -
         done;

     

       147
       147
       -
         

     

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

     

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

     

       150
       150
       -
         

     

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

     

       152
       152
       -
         let data = Buffer.contents image_data in

     

       153
       153
       -
         let data_len = String.length data in

     

       154
       154
       -
         let pos = ref 0 in

     

       155
       155
       -
         

     

       156
       156
       -
         while !pos < data_len do

     

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

     

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

     

       159
       159
       -
           for i = 0 to chunk_size - 1 do

     

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

     

       161
       161
       -
           done;

     

       162
       162
       -
           pos := !pos + chunk_size;

     

       163
       163
       -
         done;

     

       164
       164
       -
         

     

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

     

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

     

       167
       167
       -
         

     

       168
       168
       -
         (* GIF Trailer *)

     

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

     

       170
       170
       -
         

     

       171
       171
       -
         (* Base64 encode the GIF data *)

     

       172
       172
       -
         Base64.encode (Buffer.contents buf)

     

       173
       173
       -
       

     

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

     

       175
       175
       -
       let write_int32_le buf n =

     

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

     

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

     

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

     

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

     

       180
       180
       -
       

     

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

     

       182
       182
       -
       let write_int16_le buf n =

     

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

     

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

     

       185
       185
       -
       

     

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

     

       187
       187
       -
       let generate_sine_wave_audio frequency duration =

     

       188
       188
       -
         (* WAV header *)

     

       189
       189
       -
         let sample_rate = 8000 in

     

       190
       190
       -
         let num_samples = sample_rate * duration in

     

       191
       191
       -
         let header_buf = Buffer.create 44 in

     

       192
       192
       -
         

     

       193
       193
       -
         (* Fill WAV header properly *)

     

       194
       194
       -
         Buffer.add_string header_buf "RIFF";

     

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

     

       196
       196
       -
         Buffer.add_string header_buf "WAVE";

     

       197
       197
       -
         

     

       198
       198
       -
         (* Format chunk *)

     

       199
       199
       -
         Buffer.add_string header_buf "fmt ";

     

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

     

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

     

       202
       202
       -
         write_int16_le header_buf 1;  (* Mono *)

     

       203
       203
       -
         write_int32_le header_buf sample_rate; (* Sample rate *)

     

       204
       204
       -
         write_int32_le header_buf (sample_rate * 2); (* Byte rate *)

     

       205
       205
       -
         write_int16_le header_buf 2;  (* Block align *)

     

       206
       206
       -
         write_int16_le header_buf 16; (* Bits per sample *)

     

       207
       207
       -
         

     

       208
       208
       -
         (* Data chunk *)

     

       209
       209
       -
         Buffer.add_string header_buf "data";

     

       210
       210
       -
         write_int32_le header_buf (num_samples * 2); (* Data size *)

     

       211
       211
       -
         

     

       212
       212
       -
         (* Generate sine wave samples *)

     

       213
       213
       -
         let samples_buf = Buffer.create (num_samples * 2) in

     

       214
       214
       -
         let amplitude = 16384.0 in (* 16-bit with headroom *)

     

       215
       215
       -
         

     

       216
       216
       -
         for i = 0 to num_samples - 1 do

     

       217
       217
       -
           let t = float_of_int i /. float_of_int sample_rate in

     

       218
       218
       -
           let value = amplitude *. sin (2.0 *. Float.pi *. frequency *. t) in

     

       219
       219
       -
           let sample = int_of_float value in

     

       220
       220
       -
           

     

       221
       221
       -
           (* Convert to 16-bit little-endian *)

     

       222
       222
       -
           let sample = if sample < 0 then sample + 65536 else sample in

     

       223
       223
       -
           write_int16_le samples_buf sample;

     

       224
       224
       -
         done;

     

       225
       225
       -
         

     

       226
       226
       -
         (* Combine header and samples, then encode as Base64 *)

     

       227
       227
       -
         let wav_data = Buffer.contents header_buf ^ Buffer.contents samples_buf in

     

       228
       228
       -
         Base64.encode wav_data

     

       229
       229
       -
       

     

       230
       230
       -
       (* Create a server *)

     

       231
       231
       -
       let server = create_server 

     

       232
       232
       -
         ~name:"OCaml MCP Multimodal Example" 

     

       233
       233
       -
         ~version:"0.1.0" 

     

       234
       234
       -
         ~protocol_version:"2024-11-05" () |>

     

       235
       235
       -
         fun server ->

     

       236
       236
       -
           (* Set default capabilities *)

     

       237
       237
       -
           configure_server server ~with_tools:true ~with_resources:true ~with_prompts:true ()

     

       238
       238
       -
       

     

       239
       239
       -
       (* Define and register a multimodal tool that returns text, images, and audio *)

     

       240
       240
       -
       let _ = add_tool server

     

       241
       241
       -
         ~name:"multimodal_demo"

     

       242
       242
       -
         ~description:"Demonstrates multimodal content with text, image, and audio"

     

       243
       243
       -
         ~schema_properties:[

     

       244
       244
       -
           ("width", "integer", "Width of the generated image (pixels)");

     

       245
       245
       -
           ("height", "integer", "Height of the generated image (pixels)");

     

       246
       246
       -
           ("frequency", "integer", "Frequency of the generated audio tone (Hz)");

     

       247
       247
       -
           ("duration", "integer", "Duration of the generated audio (seconds)");

     

       248
       248
       -
           ("message", "string", "Text message to include")

     

       249
       249
       -
         ]

     

       250
       250
       -
         ~schema_required:["message"]

     

       251
       251
       -
         (fun args ->

     

       252
       252
       -
           try

     

       253
       253
       -
             (* Extract parameters with defaults if not provided *)

     

       254
       254
       -
             let message = get_string_param args "message" in

     

       255
       255
       -
             let width = try get_int_param args "width" with _ -> 128 in

     

       256
       256
       -
             let height = try get_int_param args "height" with _ -> 128 in

     

       257
       257
       -
             let frequency = try get_int_param args "frequency" with _ -> 440 in

     

       258
       258
       -
             let duration = try get_int_param args "duration" with _ -> 1 in

     

       259
       259
       -
             

     

       260
       260
       -
             (* Generate image and audio data *)

     

       261
       261
       -
             let image_data = generate_random_image width height in

     

       262
       262
       -
             let audio_data = generate_sine_wave_audio (float_of_int frequency) duration in

     

       263
       263
       -
             

     

       264
       264
       -
             (* Create a multimodal tool result *)

     

       265
       265
       -
             Tool.create_tool_result [

     

       266
       266
       -
               Mcp.make_text_content message;

     

       267
       267
       -
               Mcp.make_image_content image_data "image/gif";

     

       268
       268
       -
               Mcp.make_audio_content audio_data "audio/wav"

     

       269
       269
       -
             ] ~is_error:false

     

       270
       270
       -
           with

     

       271
       271
       -
           | Failure msg -> 

     

       272
       272
       -
             Log.errorf "Error in multimodal tool: %s" msg;

     

       273
       273
       -
             Tool.create_tool_result [Mcp.make_text_content (Printf.sprintf "Error: %s" msg)] ~is_error:true

     

       274
       274
       -
         )

     

       275
       275
       -
       

     

       276
       276
       -
       (* Define and register a tool for generating only images *)

     

       277
       277
       -
       let _ = add_tool server

     

       278
       278
       -
         ~name:"generate_image"

     

       279
       279
       -
         ~description:"Generates a random image with specified dimensions"

     

       280
       280
       -
         ~schema_properties:[

     

       281
       281
       -
           ("width", "integer", "Width of the generated image (pixels)");

     

       282
       282
       -
           ("height", "integer", "Height of the generated image (pixels)")

     

       283
       283
       -
         ]

     

       284
       284
       -
         ~schema_required:["width"; "height"]

     

       285
       285
       -
         (fun args ->

     

       286
       286
       -
           try

     

       287
       287
       -
             let width = get_int_param args "width" in

     

       288
       288
       -
             let height = get_int_param args "height" in

     

       289
       289
       -
             

     

       290
       290
       -
             if width < 1 || width > 1024 || height < 1 || height > 1024 then

     

       291
       291
       -
               Tool.create_tool_result 

     

       292
       292
       -
                 [Mcp.make_text_content "Error: Dimensions must be between 1 and 1024 pixels"] 

     

       293
       293
       -
                 ~is_error:true

     

       294
       294
       -
             else

     

       295
       295
       -
               let image_data = generate_random_image width height in

     

       296
       296
       -
               Tool.create_tool_result 

     

       297
       297
       -
                 [Mcp.make_image_content image_data "image/gif"]

     

       298
       298
       -
                 ~is_error:false

     

       299
       299
       -
           with

     

       300
       300
       -
           | Failure msg ->

     

       301
       301
       -
             Log.errorf "Error in generate_image tool: %s" msg;

     

       302
       302
       -
             Tool.create_tool_result [Mcp.make_text_content (Printf.sprintf "Error: %s" msg)] ~is_error:true

     

       303
       303
       -
         )

     

       304
       304
       -
       

     

       305
       305
       -
       (* Define and register a tool for generating only audio *)

     

       306
       306
       -
       let _ = add_tool server

     

       307
       307
       -
         ~name:"generate_audio"

     

       308
       308
       -
         ~description:"Generates an audio tone with specified frequency and duration"

     

       309
       309
       -
         ~schema_properties:[

     

       310
       310
       -
           ("frequency", "integer", "Frequency of the tone in Hz (20-20000)");

     

       311
       311
       -
           ("duration", "integer", "Duration of the tone in seconds (1-10)")

     

       312
       312
       -
         ]

     

       313
       313
       -
         ~schema_required:["frequency"; "duration"]

     

       314
       314
       -
         (fun args ->

     

       315
       315
       -
           try

     

       316
       316
       -
             let frequency = get_int_param args "frequency" in

     

       317
       317
       -
             let duration = get_int_param args "duration" in

     

       318
       318
       -
             

     

       319
       319
       -
             if frequency < 20 || frequency > 20000 then

     

       320
       320
       -
               Tool.create_tool_result 

     

       321
       321
       -
                 [Mcp.make_text_content "Error: Frequency must be between 20Hz and 20,000Hz"] 

     

       322
       322
       -
                 ~is_error:true

     

       323
       323
       -
             else if duration < 1 || duration > 10 then

     

       324
       324
       -
               Tool.create_tool_result 

     

       325
       325
       -
                 [Mcp.make_text_content "Error: Duration must be between 1 and 10 seconds"] 

     

       326
       326
       -
                 ~is_error:true

     

       327
       327
       -
             else

     

       328
       328
       -
               let audio_data = generate_sine_wave_audio (float_of_int frequency) duration in

     

       329
       329
       -
               Tool.create_tool_result 

     

       330
       330
       -
                 [Mcp.make_audio_content audio_data "audio/wav"]

     

       331
       331
       -
                 ~is_error:false

     

       332
       332
       -
           with

     

       333
       333
       -
           | Failure msg ->

     

       334
       334
       -
             Log.errorf "Error in generate_audio tool: %s" msg;

     

       335
       335
       -
             Tool.create_tool_result [Mcp.make_text_content (Printf.sprintf "Error: %s" msg)] ~is_error:true

     

       336
       336
       -
         )

     

       337
       337
       -
       

     

       338
       338
       -
       (* Define and register a resource template example with multimodal content *)

     

       339
       339
       -
       let _ = add_resource_template server

     

       340
       340
       -
         ~uri_template:"multimodal://{name}"

     

       341
       341
       -
         ~name:"Multimodal Greeting"

     

       342
       342
       -
         ~description:"Get a multimodal greeting with text, image and audio"

     

       343
       343
       -
         ~mime_type:"application/json"

     

       344
       344
       -
         (fun params ->

     

       345
       345
       -
           match params with

     

       346
       346
       -
           | [name] ->

     

       347
       347
       -
             let greeting = Printf.sprintf "Hello, %s! Welcome to the multimodal MCP example." name in

     

       348
       348
       -
             let image_data = generate_random_image 128 128 in

     

       349
       349
       -
             let audio_data = generate_sine_wave_audio 440.0 1 in

     

       350
       350
       -
             

     

       351
       351
       -
             Printf.sprintf {|

     

       352
       352
       -
               {

     

       353
       353
       -
                 "greeting": "%s",

     

       354
       354
       -
                 "image": {

     

       355
       355
       -
                   "data": "%s",

     

       356
       356
       -
                   "mimeType": "image/gif"

     

       357
       357
       -
                 },

     

       358
       358
       -
                 "audio": {

     

       359
       359
       -
                   "data": "%s",

     

       360
       360
       -
                   "mimeType": "audio/wav"

     

       361
       361
       -
                 }

     

       362
       362
       -
               }

     

       363
       363
       -
             |} greeting image_data audio_data

     

       364
       364
       -
           | _ -> Printf.sprintf {|{"error": "Invalid parameters"}|}

     

       365
       365
       -
         )

     

       366
       366
       -
       

     

       367
       367
       -
       (* Run the server with the default scheduler *)

     

       368
       368
       -
       let () =

     

       369
       369
       -
         Random.self_init();  (* Initialize random generator *)

     

       370
       370
       -
         Eio_main.run @@ fun env ->

     

       371
       371
       -
           Mcp_server.run_server env server

-166

bin/ocaml_eval_sdk.ml

···

       1
       1
       -
       open Mcp_sdk

     

       2
       2
       -
       open Mcp_rpc

     

       3
       3
       -
       

     

       4
       4
       -
       (* Set up the formatter for capturing evaluation output *)

     

       5
       5
       -
       let capture_output f =

     

       6
       6
       -
         let buffer = Buffer.create 1024 in

     

       7
       7
       -
         let fmt = Format.formatter_of_buffer buffer in

     

       8
       8
       -
         let result = f fmt in

     

       9
       9
       -
         Format.pp_print_flush fmt ();

     

       10
       10
       -
         (result, Buffer.contents buffer)

     

       11
       11
       -
       

     

       12
       12
       -
       (* Helper for extracting string value from JSON *)

     

       13
       13
       -
       let get_string_param json name =

     

       14
       14
       -
         match json with

     

       15
       15
       -
         | `Assoc fields ->

     

       16
       16
       -
           (match List.assoc_opt name fields with

     

       17
       17
       -
           | Some (`String value) -> value

     

       18
       18
       -
           | _ -> failwith (Printf.sprintf "Missing or invalid parameter: %s" name))

     

       19
       19
       -
         | _ -> failwith "Expected JSON object"

     

       20
       20
       -
           

     

       21
       21
       -
       (* Initialize the OCaml toploop with standard libraries *)

     

       22
       22
       -
       let initialize_toploop () =

     

       23
       23
       -
         (* Initialize the toplevel environment *)

     

       24
       24
       -
         Toploop.initialize_toplevel_env ();

     

       25
       25
       -
         

     

       26
       26
       -
         (* Set up the toplevel as if using the standard OCaml REPL *)

     

       27
       27
       -
         Clflags.nopervasives := false;

     

       28
       28
       -
         Clflags.real_paths := true;

     

       29
       29
       -
         Clflags.recursive_types := false;

     

       30
       30
       -
         Clflags.strict_sequence := false;

     

       31
       31
       -
         Clflags.applicative_functors := true;

     

       32
       32
       -
         

     

       33
       33
       -
         (* Return success message *)

     

       34
       34
       -
         "OCaml evaluation environment initialized"

     

       35
       35
       -
       

     

       36
       36
       -
       (* Evaluate an OCaml toplevel phrase *)

     

       37
       37
       -
       let evaluate_phrase phrase =

     

       38
       38
       -
         (* Parse the input text as a toplevel phrase *)

     

       39
       39
       -
         let lexbuf = Lexing.from_string phrase in

     

       40
       40
       -
         

     

       41
       41
       -
         (* Capture both success/failure status and output *)

     

       42
       42
       -
         try

     

       43
       43
       -
           let parsed_phrase = !Toploop.parse_toplevel_phrase lexbuf in

     

       44
       44
       -
           let (success, output) = capture_output (fun fmt -> 

     

       45
       45
       -
             Toploop.execute_phrase true fmt parsed_phrase

     

       46
       46
       -
           ) in

     

       47
       47
       -
           

     

       48
       48
       -
           (* Return structured result with status and captured output *)

     

       49
       49
       -
           if success then

     

       50
       50
       -
             `Assoc [

     

       51
       51
       -
               ("success", `Bool true);

     

       52
       52
       -
               ("output", `String output);

     

       53
       53
       -
             ]

     

       54
       54
       -
           else

     

       55
       55
       -
             `Assoc [

     

       56
       56
       -
               ("success", `Bool false);

     

       57
       57
       -
               ("error", `String "Execution failed");

     

       58
       58
       -
               ("output", `String output);

     

       59
       59
       -
             ]

     

       60
       60
       -
         with e ->

     

       61
       61
       -
           (* Handle parsing or other errors with more detailed messages *)

     

       62
       62
       -
           let error_msg = match e with

     

       63
       63
       -
           | Syntaxerr.Error err -> 

     

       64
       64
       -
               let msg = match err with

     

       65
       65
       -
               | Syntaxerr.Unclosed _ -> "Syntax error: Unclosed delimiter"

     

       66
       66
       -
               | Syntaxerr.Expecting _ -> "Syntax error: Expecting a different token"

     

       67
       67
       -
               | Syntaxerr.Not_expecting _ -> "Syntax error: Unexpected token"

     

       68
       68
       -
               | Syntaxerr.Applicative_path _ -> "Syntax error: Invalid applicative path"

     

       69
       69
       -
               | Syntaxerr.Variable_in_scope _ -> "Syntax error: Variable in scope"

     

       70
       70
       -
               | Syntaxerr.Other _ -> "Syntax error"

     

       71
       71
       -
               | _ -> "Syntax error (unknown kind)"

     

       72
       72
       -
               in

     

       73
       73
       -
               msg

     

       74
       74
       -
                 

     

       75
       75
       -
           | Lexer.Error (err, _) -> 

     

       76
       76
       -
               let msg = match err with

     

       77
       77
       -
               | Lexer.Illegal_character _ -> "Lexer error: Illegal character"

     

       78
       78
       -
               | Lexer.Illegal_escape _ -> "Lexer error: Illegal escape sequence"

     

       79
       79
       -
               | Lexer.Unterminated_comment _ -> "Lexer error: Unterminated comment"

     

       80
       80
       -
               | Lexer.Unterminated_string -> "Lexer error: Unterminated string"

     

       81
       81
       -
               | Lexer.Unterminated_string_in_comment _ -> "Lexer error: Unterminated string in comment"

     

       82
       82
       -
               | Lexer.Invalid_literal _ -> "Lexer error: Invalid literal"

     

       83
       83
       -
               | _ -> "Lexer error (unknown kind)"

     

       84
       84
       -
               in 

     

       85
       85
       -
               msg

     

       86
       86
       -
           | _ -> Printexc.to_string e

     

       87
       87
       -
           in

     

       88
       88
       -
           `Assoc [

     

       89
       89
       -
             ("success", `Bool false);

     

       90
       90
       -
             ("error", `String error_msg);

     

       91
       91
       -
           ]

     

       92
       92
       -
       

     

       93
       93
       -
       (* Create evaluation server *)

     

       94
       94
       -
       let server = create_server 

     

       95
       95
       -
         ~name:"OCaml Evaluation Server" 

     

       96
       96
       -
         ~version:"0.1.0" () |>

     

       97
       97
       -
         fun server ->

     

       98
       98
       -
           (* Set default capabilities *)

     

       99
       99
       -
           configure_server server ~with_tools:true ()

     

       100
       100
       -
       

     

       101
       101
       -
       (* Toplevel environment state management *)

     

       102
       102
       -
       let toplevel_initialized = ref false

     

       103
       103
       -
       

     

       104
       104
       -
       (* Initialize OCaml toplevel on first use *)

     

       105
       105
       -
       let ensure_toploop_initialized () =

     

       106
       106
       -
         if not !toplevel_initialized then begin

     

       107
       107
       -
           let _ = initialize_toploop () in

     

       108
       108
       -
           toplevel_initialized := true;

     

       109
       109
       -
         end

     

       110
       110
       -
       

     

       111
       111
       -
       (* Register eval tool *)

     

       112
       112
       -
       let _ = add_tool server

     

       113
       113
       -
         ~name:"ocaml_eval"

     

       114
       114
       -
         ~description:"Evaluates OCaml toplevel phrases and returns the result"

     

       115
       115
       -
         ~schema_properties:[

     

       116
       116
       -
           ("code", "string", "OCaml code to evaluate")

     

       117
       117
       -
         ]

     

       118
       118
       -
         ~schema_required:["code"]

     

       119
       119
       -
         (fun args ->

     

       120
       120
       -
           ensure_toploop_initialized ();

     

       121
       121
       -
           

     

       122
       122
       -
           try

     

       123
       123
       -
             (* Extract code parameter *)

     

       124
       124
       -
             let code = get_string_param args "code" in

     

       125
       125
       -
             

     

       126
       126
       -
             (* Execute the code *)

     

       127
       127
       -
             let result = evaluate_phrase code in

     

       128
       128
       -
             

     

       129
       129
       -
             (* Return formatted result *)

     

       130
       130
       -
             let success = match result with

     

       131
       131
       -
               | `Assoc fields -> (

     

       132
       132
       -
                 match List.assoc_opt "success" fields with

     

       133
       133
       -
                 | Some (`Bool true) -> true

     

       134
       134
       -
                 | _ -> false

     

       135
       135
       -
               )

     

       136
       136
       -
               | _ -> false

     

       137
       137
       -
             in

     

       138
       138
       -
             

     

       139
       139
       -
             let output = match result with

     

       140
       140
       -
               | `Assoc fields -> (

     

       141
       141
       -
                 match List.assoc_opt "output" fields with

     

       142
       142
       -
                 | Some (`String s) -> s

     

       143
       143
       -
                 | _ -> (

     

       144
       144
       -
                   match List.assoc_opt "error" fields with

     

       145
       145
       -
                   | Some (`String s) -> s

     

       146
       146
       -
                   | _ -> "Unknown result"

     

       147
       147
       -
                 )

     

       148
       148
       -
               )

     

       149
       149
       -
               | _ -> "Unknown result"

     

       150
       150
       -
             in

     

       151
       151
       -
             

     

       152
       152
       -
             (* Create a tool result with colorized output *)

     

       153
       153
       -
             Tool.create_tool_result [

     

       154
       154
       -
               Mcp.make_text_content output

     

       155
       155
       -
             ] ~is_error:(not success)

     

       156
       156
       -
             

     

       157
       157
       -
           with

     

       158
       158
       -
           | Failure msg ->

     

       159
       159
       -
             Log.errorf "Error in OCaml eval tool: %s" msg;

     

       160
       160
       -
             Tool.create_tool_result [Mcp.make_text_content (Printf.sprintf "Error: %s" msg)] ~is_error:true

     

       161
       161
       -
         )

     

       162
       162
       -
       

     

       163
       163
       -
       (* Run the server with the default scheduler *)

     

       164
       164
       -
       let () =

     

       165
       165
       -
         Eio_main.run @@ fun env->

     

       166
       166
       -
           Mcp_server.run_server env server

+186

bin/resource_template_example.ml

···

       1
       1
       +
       open Mcp

     

       2
       2
       +
       open Mcp_sdk

     

       3
       3
       +
       open Mcp_server

     

       4
       4
       +
       

     

       5
       5
       +
       (* Helper for extracting string value from JSON *)

     

       6
       6
       +
       let get_string_param json name =

     

       7
       7
       +
         match json with

     

       8
       8
       +
         | `Assoc fields ->

     

       9
       9
       +
           (match List.assoc_opt name fields with

     

       10
       10
       +
           | Some (`String value) -> value

     

       11
       11
       +
           | _ -> raise (Failure (Printf.sprintf "Missing or invalid parameter: %s" name)))

     

       12
       12
       +
         | _ -> raise (Failure "Expected JSON object")

     

       13
       13
       +
       

     

       14
       14
       +
       (* Create a server *)

     

       15
       15
       +
       let server = create_server 

     

       16
       16
       +
         ~name:"OCaml MCP Resource Template Example" 

     

       17
       17
       +
         ~version:"0.1.0" 

     

       18
       18
       +
         ~protocol_version:"2024-11-05" 

     

       19
       19
       +
         ()

     

       20
       20
       +
       

     

       21
       21
       +
       (* Define startup and shutdown hooks *)

     

       22
       22
       +
       let startup () =

     

       23
       23
       +
         (* Use stderr for direct printing to avoid interfering with JSON-RPC protocol *)

     

       24
       24
       +
         Printf.fprintf stderr "ResourceTemplateServer is starting up!\n";

     

       25
       25
       +
         flush stderr;

     

       26
       26
       +
         Log.info "ResourceTemplateServer is starting up!"

     

       27
       27
       +
       

     

       28
       28
       +
       let shutdown () =

     

       29
       29
       +
         Printf.fprintf stderr "ResourceTemplateServer is shutting down. Goodbye!\n";

     

       30
       30
       +
         flush stderr;

     

       31
       31
       +
         Log.info "ResourceTemplateServer is shutting down. Goodbye!"

     

       32
       32
       +
       

     

       33
       33
       +
       (* Register the hooks *)

     

       34
       34
       +
       let () =

     

       35
       35
       +
         set_startup_hook server startup;

     

       36
       36
       +
         set_shutdown_hook server shutdown

     

       37
       37
       +
       

     

       38
       38
       +
       (* Database of "documents" *)

     

       39
       39
       +
       let documents = [

     

       40
       40
       +
         ("doc1", "This is the first document content");

     

       41
       41
       +
         ("doc2", "This document contains information about OCaml");

     

       42
       42
       +
         ("doc3", "MCP protocol is a standard for LLM-based applications");

     

       43
       43
       +
         ("doc4", "Resource templates allow for parameterized resources");

     

       44
       44
       +
       ]

     

       45
       45
       +
       

     

       46
       46
       +
       (* Define and register a resource template for documents *)

     

       47
       47
       +
       let _ = add_resource server

     

       48
       48
       +
         ~uri_template:"document://{id}"

     

       49
       49
       +
         ~description:"Get a document by ID"

     

       50
       50
       +
         ~mime_type:"text/plain"

     

       51
       51
       +
         (fun params ->

     

       52
       52
       +
           match params with

     

       53
       53
       +
           | [id] -> 

     

       54
       54
       +
               begin

     

       55
       55
       +
                 try

     

       56
       56
       +
                   let content = List.assoc id documents in

     

       57
       57
       +
                   content

     

       58
       58
       +
                 with Not_found -> 

     

       59
       59
       +
                   Printf.sprintf "Error: Document '%s' not found" id

     

       60
       60
       +
               end

     

       61
       61
       +
           | _ -> "Error: Invalid document ID"

     

       62
       62
       +
         )

     

       63
       63
       +
       

     

       64
       64
       +
       (* Define and register a list documents resource *)

     

       65
       65
       +
       let _ = add_resource server

     

       66
       66
       +
         ~uri_template:"documents://list"

     

       67
       67
       +
         ~description:"List all available documents"

     

       68
       68
       +
         ~mime_type:"text/plain"

     

       69
       69
       +
         (fun _ ->

     

       70
       70
       +
           let doc_list = 

     

       71
       71
       +
             String.concat "\n" 

     

       72
       72
       +
               (List.map (fun (id, _) -> Printf.sprintf "- %s" id) documents)

     

       73
       73
       +
           in

     

       74
       74
       +
           Printf.sprintf "Available Documents:\n%s" doc_list

     

       75
       75
       +
         )

     

       76
       76
       +
       

     

       77
       77
       +
       (* Define and register a tool that uses resource references *)

     

       78
       78
       +
       let _ = add_tool server

     

       79
       79
       +
         ~name:"get_document"

     

       80
       80
       +
         ~description:"Gets a document by ID using resource references"

     

       81
       81
       +
         ~schema_properties:[

     

       82
       82
       +
           ("document_id", "string", "The ID of the document to retrieve");

     

       83
       83
       +
         ]

     

       84
       84
       +
         ~schema_required:["document_id"]

     

       85
       85
       +
         (fun args ->

     

       86
       86
       +
           try

     

       87
       87
       +
             let doc_id = get_string_param args "document_id" in

     

       88
       88
       +
             

     

       89
       89
       +
             (* Create a resource reference *)

     

       90
       90
       +
             let ref = ResourceReference.{ uri = Printf.sprintf "document://%s" doc_id } in

     

       91
       91
       +
             (* Convert to JSON for logging purposes *)

     

       92
       92
       +
             let _ = ResourceReference.yojson_of_t ref in

     

       93
       93
       +
             

     

       94
       94
       +
             (* Return the reference *)

     

       95
       95
       +
             CallToolResult.yojson_of_t CallToolResult.{

     

       96
       96
       +
               content = [

     

       97
       97
       +
                 Text TextContent.{ text = Printf.sprintf "Resource reference for document %s:" doc_id; annotations = None };

     

       98
       98
       +
                 Resource EmbeddedResource.{ 

     

       99
       99
       +
                   resource = `Text TextResourceContents.{

     

       100
       100
       +
                     uri = Printf.sprintf "document://%s" doc_id;

     

       101
       101
       +
                     text = (try List.assoc doc_id documents with Not_found -> "Not found");

     

       102
       102
       +
                     mime_type = Some "text/plain"

     

       103
       103
       +
                   };

     

       104
       104
       +
                   annotations = None

     

       105
       105
       +
                 }

     

       106
       106
       +
               ];

     

       107
       107
       +
               is_error = false;

     

       108
       108
       +
               meta = None

     

       109
       109
       +
             }

     

       110
       110
       +
           with

     

       111
       111
       +
           | Failure msg ->

     

       112
       112
       +
             Log.error (Printf.sprintf "Error in get_document tool: %s" msg);

     

       113
       113
       +
             CallToolResult.yojson_of_t CallToolResult.{

     

       114
       114
       +
               content = [

     

       115
       115
       +
                 Text TextContent.{ 

     

       116
       116
       +
                   text = Printf.sprintf "Error: %s" msg; 

     

       117
       117
       +
                   annotations = None 

     

       118
       118
       +
                 }

     

       119
       119
       +
               ];

     

       120
       120
       +
               is_error = true;

     

       121
       121
       +
               meta = None

     

       122
       122
       +
             }

     

       123
       123
       +
         )

     

       124
       124
       +
       

     

       125
       125
       +
       (* Define and register a prompt that uses resource templates *)

     

       126
       126
       +
       let _ = add_prompt server

     

       127
       127
       +
         ~name:"document-prompt"

     

       128
       128
       +
         ~description:"A prompt that references document resources"

     

       129
       129
       +
         ~arguments:[

     

       130
       130
       +
           ("document_id", Some "ID of the document to include in the prompt", true);

     

       131
       131
       +
         ]

     

       132
       132
       +
         (fun args ->

     

       133
       133
       +
           let doc_id = 

     

       134
       134
       +
             try List.assoc "document_id" args

     

       135
       135
       +
             with Not_found -> "doc1" (* Default to doc1 *)

     

       136
       136
       +
           in

     

       137
       137
       +
           

     

       138
       138
       +
           let doc_text = 

     

       139
       139
       +
             try List.assoc doc_id documents

     

       140
       140
       +
             with Not_found -> Printf.sprintf "Document '%s' not found" doc_id

     

       141
       141
       +
           in

     

       142
       142
       +
           

     

       143
       143
       +
           [

     

       144
       144
       +
             Prompt.{ 

     

       145
       145
       +
               role = `User; 

     

       146
       146
       +
               content = make_text_content (Printf.sprintf "Please summarize the following document (ID: %s):" doc_id)

     

       147
       147
       +
             };

     

       148
       148
       +
             Prompt.{ 

     

       149
       149
       +
               role = `User; 

     

       150
       150
       +
               content = Resource EmbeddedResource.{

     

       151
       151
       +
                 resource = `Text TextResourceContents.{

     

       152
       152
       +
                   uri = Printf.sprintf "document://%s" doc_id;

     

       153
       153
       +
                   text = doc_text;

     

       154
       154
       +
                   mime_type = Some "text/plain"

     

       155
       155
       +
                 };

     

       156
       156
       +
                 annotations = None

     

       157
       157
       +
               }

     

       158
       158
       +
             };

     

       159
       159
       +
             Prompt.{ 

     

       160
       160
       +
               role = `Assistant; 

     

       161
       161
       +
               content = make_text_content "I'll help summarize this document for you."

     

       162
       162
       +
             }

     

       163
       163
       +
           ]

     

       164
       164
       +
         )

     

       165
       165
       +
       

     

       166
       166
       +
       (* Main function *)

     

       167
       167
       +
       let () =

     

       168
       168
       +
         (* Parse command line arguments *)

     

       169
       169
       +
         let transport_type = ref Stdio in

     

       170
       170
       +
         let args = [

     

       171
       171
       +
           ("--http", Arg.Unit (fun () -> transport_type := Http), 

     

       172
       172
       +
            "Start server with HTTP transport (default is stdio)");

     

       173
       173
       +
         ] in

     

       174
       174
       +
         let usage_msg = "Usage: resource_template_example [--http]" in

     

       175
       175
       +
         Arg.parse args (fun _ -> ()) usage_msg;

     

       176
       176
       +
       

     

       177
       177
       +
         (* Instead of printing directly to stdout which messes up the JSON-RPC protocol,

     

       178
       178
       +
            use the logging system which sends output to stderr *)

     

       179
       179
       +
         Log.info "Starting ResourceTemplateServer...";

     

       180
       180
       +
         

     

       181
       181
       +
         (* Configure the server with appropriate capabilities *)

     

       182
       182
       +
         ignore (configure_server server ());

     

       183
       183
       +
         

     

       184
       184
       +
         (* Create and start MCP server with the selected transport *)

     

       185
       185
       +
         let mcp_server = create ~server ~transport:!transport_type () in

     

       186
       186
       +
         start mcp_server

+365

bin/server.ml

···

       1
       1
       +
       open Mcp

     

       2
       2
       +
       open Jsonrpc

     

       3
       3
       +
       

     

       4
       4
       +
       (* Logging utilities *)

     

       5
       5
       +
       let log_debug msg =

     

       6
       6
       +
         Printf.eprintf "[DEBUG] %s\n" msg;

     

       7
       7
       +
         flush stderr

     

       8
       8
       +
       

     

       9
       9
       +
       let log_error msg =

     

       10
       10
       +
         Printf.eprintf "[ERROR] %s\n" msg;

     

       11
       11
       +
         flush stderr

     

       12
       12
       +
       

     

       13
       13
       +
       (* Server state *)

     

       14
       14
       +
       let protocol_version = "2024-11-05"

     

       15
       15
       +
       let server_info = Implementation.{ name = "ocaml-mcp-capitalizer"; version = "0.1.0" }

     

       16
       16
       +
       let server_capabilities = `Assoc [

     

       17
       17
       +
         (* We support tools *)

     

       18
       18
       +
         ("tools", `Assoc [

     

       19
       19
       +
           ("listChanged", `Bool true)

     

       20
       20
       +
         ]);

     

       21
       21
       +
         (* We don't support resources - make this explicit *)

     

       22
       22
       +
         ("resources", `Assoc [

     

       23
       23
       +
           ("listChanged", `Bool false);

     

       24
       24
       +
           ("subscribe", `Bool false)

     

       25
       25
       +
         ]);

     

       26
       26
       +
         (* We don't support prompts - make this explicit *)

     

       27
       27
       +
         ("prompts", `Assoc [

     

       28
       28
       +
           ("listChanged", `Bool false)

     

       29
       29
       +
         ])

     

       30
       30
       +
       ]

     

       31
       31
       +
       

     

       32
       32
       +
       (* Tool implementation *)

     

       33
       33
       +
       module CapitalizeTool = struct

     

       34
       34
       +
         let name = "capitalize"

     

       35
       35
       +
         let description = "Capitalizes the provided text"

     

       36
       36
       +
         let input_schema = `Assoc [

     

       37
       37
       +
           ("type", `String "object");

     

       38
       38
       +
           ("properties", `Assoc [

     

       39
       39
       +
             ("text", `Assoc [

     

       40
       40
       +
               ("type", `String "string");

     

       41
       41
       +
               ("description", `String "The text to capitalize")

     

       42
       42
       +
             ])

     

       43
       43
       +
           ]);

     

       44
       44
       +
           ("required", `List [`String "text"])

     

       45
       45
       +
         ]

     

       46
       46
       +
       

     

       47
       47
       +
         let call json =

     

       48
       48
       +
           match json with

     

       49
       49
       +
           | `Assoc fields ->

     

       50
       50
       +
             (match List.assoc_opt "text" fields with

     

       51
       51
       +
              | Some (`String text) ->

     

       52
       52
       +
                let capitalized_text = String.uppercase_ascii text in

     

       53
       53
       +
                let content = TextContent.{ 

     

       54
       54
       +
                  text = capitalized_text;

     

       55
       55
       +
                  annotations = None 

     

       56
       56
       +
                } in

     

       57
       57
       +
                `Assoc [

     

       58
       58
       +
                  ("content", `List [TextContent.yojson_of_t content]);

     

       59
       59
       +
                  ("isError", `Bool false)

     

       60
       60
       +
                ]

     

       61
       61
       +
              | _ -> 

     

       62
       62
       +
                let error_content = TextContent.{

     

       63
       63
       +
                  text = "Missing or invalid 'text' parameter";

     

       64
       64
       +
                  annotations = None

     

       65
       65
       +
                } in

     

       66
       66
       +
                `Assoc [

     

       67
       67
       +
                  ("content", `List [TextContent.yojson_of_t error_content]);

     

       68
       68
       +
                  ("isError", `Bool true)

     

       69
       69
       +
                ])

     

       70
       70
       +
           | _ ->

     

       71
       71
       +
             let error_content = TextContent.{

     

       72
       72
       +
               text = "Invalid arguments format";

     

       73
       73
       +
               annotations = None

     

       74
       74
       +
             } in

     

       75
       75
       +
             `Assoc [

     

       76
       76
       +
               ("content", `List [TextContent.yojson_of_t error_content]);

     

       77
       77
       +
               ("isError", `Bool true)

     

       78
       78
       +
             ]

     

       79
       79
       +
       end

     

       80
       80
       +
       

     

       81
       81
       +
       (* Handle tool listing *)

     

       82
       82
       +
       let list_tools () =

     

       83
       83
       +
         let tool = `Assoc [

     

       84
       84
       +
           ("name", `String CapitalizeTool.name);

     

       85
       85
       +
           ("description", `String CapitalizeTool.description);

     

       86
       86
       +
           ("inputSchema", CapitalizeTool.input_schema)

     

       87
       87
       +
         ] in

     

       88
       88
       +
         `Assoc [

     

       89
       89
       +
           ("tools", `List [tool])

     

       90
       90
       +
         ]

     

       91
       91
       +
       

     

       92
       92
       +
       (* Handle tool calls *)

     

       93
       93
       +
       let call_tool name args =

     

       94
       94
       +
         if name = CapitalizeTool.name then

     

       95
       95
       +
           CapitalizeTool.call args

     

       96
       96
       +
         else

     

       97
       97
       +
           let error_content = TextContent.{

     

       98
       98
       +
             text = Printf.sprintf "Unknown tool: %s" name;

     

       99
       99
       +
             annotations = None

     

       100
       100
       +
           } in

     

       101
       101
       +
           `Assoc [

     

       102
       102
       +
             ("content", `List [TextContent.yojson_of_t error_content]);

     

       103
       103
       +
             ("isError", `Bool true)

     

       104
       104
       +
           ]

     

       105
       105
       +
       

     

       106
       106
       +
       (* Handle initialization *)

     

       107
       107
       +
       let handle_initialize id json =

     

       108
       108
       +
         try

     

       109
       109
       +
           log_debug (Printf.sprintf "Processing initialize request with id: %s" 

     

       110
       110
       +
             (match id with 

     

       111
       111
       +
              | `Int i -> string_of_int i 

     

       112
       112
       +
              | `String s -> s));

     

       113
       113
       +
           

     

       114
       114
       +
           log_debug (Printf.sprintf "Initialize params: %s" 

     

       115
       115
       +
             (match json with 

     

       116
       116
       +
              | Some j -> Yojson.Safe.to_string j 

     

       117
       117
       +
              | None -> "null"));

     

       118
       118
       +
           

     

       119
       119
       +
           let _ = match json with

     

       120
       120
       +
             | Some params -> 

     

       121
       121
       +
                 log_debug "Parsing initialize request params...";

     

       122
       122
       +
                 let req = Initialize.Request.t_of_yojson params in

     

       123
       123
       +
                 log_debug (Printf.sprintf "Client info: %s v%s" req.client_info.name req.client_info.version);

     

       124
       124
       +
                 log_debug (Printf.sprintf "Client protocol version: %s" req.protocol_version);

     

       125
       125
       +
                 

     

       126
       126
       +
                 (* Check protocol version compatibility *)

     

       127
       127
       +
                 if req.protocol_version <> protocol_version then

     

       128
       128
       +
                   log_debug (Printf.sprintf "Protocol version mismatch: client=%s server=%s - will use server version" 

     

       129
       129
       +
                     req.protocol_version protocol_version);

     

       130
       130
       +
                 

     

       131
       131
       +
                 req

     

       132
       132
       +
             | None -> 

     

       133
       133
       +
                 log_error "Missing params for initialize request";

     

       134
       134
       +
                 raise (Json.Of_json ("Missing params for initialize request", `Null))

     

       135
       135
       +
           in

     

       136
       136
       +
           

     

       137
       137
       +
           log_debug "Creating initialize response...";

     

       138
       138
       +
           let result = Initialize.Result.create

     

       139
       139
       +
             ~capabilities:server_capabilities

     

       140
       140
       +
             ~server_info

     

       141
       141
       +
             ~protocol_version

     

       142
       142
       +
             ~instructions:"This server provides a tool to capitalize text."

     

       143
       143
       +
             ()

     

       144
       144
       +
           in

     

       145
       145
       +
           

     

       146
       146
       +
           log_debug "Serializing initialize response...";

     

       147
       147
       +
           let response = create_response ~id ~result:(Initialize.Result.yojson_of_t result) in

     

       148
       148
       +
           log_debug "Initialize response created successfully";

     

       149
       149
       +
           response

     

       150
       150
       +
         with

     

       151
       151
       +
         | Json.Of_json (msg, _) ->

     

       152
       152
       +
           log_error (Printf.sprintf "JSON error in initialize: %s" msg);

     

       153
       153
       +
           create_error ~id ~code:(-32602) ~message:("Invalid params: " ^ msg) ()

     

       154
       154
       +
         | exc ->

     

       155
       155
       +
           log_error (Printf.sprintf "Exception in initialize: %s" (Printexc.to_string exc));

     

       156
       156
       +
           log_error (Printf.sprintf "Backtrace: %s" (Printexc.get_backtrace()));

     

       157
       157
       +
           create_error ~id ~code:(-32603) ~message:("Internal error: " ^ (Printexc.to_string exc)) ()

     

       158
       158
       +
       

     

       159
       159
       +
       (* Handle tools/list *)

     

       160
       160
       +
       let handle_list_tools id =

     

       161
       161
       +
         log_debug "Processing tools/list request";

     

       162
       162
       +
         let result = list_tools () in

     

       163
       163
       +
         log_debug (Printf.sprintf "Tools list result: %s" (Yojson.Safe.to_string result));

     

       164
       164
       +
         create_response ~id ~result

     

       165
       165
       +
       

     

       166
       166
       +
       (* Handle tools/call *)

     

       167
       167
       +
       let handle_call_tool id json =

     

       168
       168
       +
         try

     

       169
       169
       +
           log_debug (Printf.sprintf "Processing tool call request with id: %s" 

     

       170
       170
       +
             (match id with 

     

       171
       171
       +
              | `Int i -> string_of_int i 

     

       172
       172
       +
              | `String s -> s));

     

       173
       173
       +
           

     

       174
       174
       +
           log_debug (Printf.sprintf "Tool call params: %s" 

     

       175
       175
       +
             (match json with 

     

       176
       176
       +
              | Some j -> Yojson.Safe.to_string j 

     

       177
       177
       +
              | None -> "null"));

     

       178
       178
       +
           

     

       179
       179
       +
           match json with

     

       180
       180
       +
           | Some (`Assoc params) ->

     

       181
       181
       +
             let name = match List.assoc_opt "name" params with

     

       182
       182
       +
               | Some (`String name) -> 

     

       183
       183
       +
                   log_debug (Printf.sprintf "Tool name: %s" name);

     

       184
       184
       +
                   name

     

       185
       185
       +
               | _ -> 

     

       186
       186
       +
                   log_error "Missing or invalid 'name' parameter in tool call";

     

       187
       187
       +
                   raise (Json.Of_json ("Missing or invalid 'name' parameter", `Assoc params))

     

       188
       188
       +
             in

     

       189
       189
       +
             let args = match List.assoc_opt "arguments" params with

     

       190
       190
       +
               | Some (args) -> 

     

       191
       191
       +
                   log_debug (Printf.sprintf "Tool arguments: %s" (Yojson.Safe.to_string args));

     

       192
       192
       +
                   args

     

       193
       193
       +
               | _ -> 

     

       194
       194
       +
                   log_debug "No arguments provided for tool call, using empty object";

     

       195
       195
       +
                   `Assoc [] (* Empty arguments is valid *)

     

       196
       196
       +
             in

     

       197
       197
       +
             log_debug (Printf.sprintf "Calling tool: %s" name);

     

       198
       198
       +
             let result = call_tool name args in

     

       199
       199
       +
             log_debug (Printf.sprintf "Tool call result: %s" (Yojson.Safe.to_string result));

     

       200
       200
       +
             create_response ~id ~result

     

       201
       201
       +
           | _ ->

     

       202
       202
       +
             log_error "Invalid params format for tools/call";

     

       203
       203
       +
             create_error ~id ~code:(-32602) ~message:"Invalid params for tools/call" ()

     

       204
       204
       +
         with

     

       205
       205
       +
         | Json.Of_json (msg, _) ->

     

       206
       206
       +
           log_error (Printf.sprintf "JSON error in tool call: %s" msg);

     

       207
       207
       +
           create_error ~id ~code:(-32602) ~message:("Invalid params: " ^ msg) ()

     

       208
       208
       +
         | exc ->

     

       209
       209
       +
           log_error (Printf.sprintf "Exception in tool call: %s" (Printexc.to_string exc));

     

       210
       210
       +
           log_error (Printf.sprintf "Backtrace: %s" (Printexc.get_backtrace()));

     

       211
       211
       +
           create_error ~id ~code:(-32603) ~message:("Internal error: " ^ (Printexc.to_string exc)) ()

     

       212
       212
       +
       

     

       213
       213
       +
       (* Handle ping *)

     

       214
       214
       +
       let handle_ping id =

     

       215
       215
       +
         create_response ~id ~result:(`Assoc [])

     

       216
       216
       +
       

     

       217
       217
       +
       (* Process a single message *)

     

       218
       218
       +
       let process_message message =

     

       219
       219
       +
         try

     

       220
       220
       +
           log_debug "Parsing message as JSONRPC message...";

     

       221
       221
       +
           match JSONRPCMessage.t_of_yojson message with

     

       222
       222
       +
           | JSONRPCMessage.Request req ->

     

       223
       223
       +
             log_debug (Printf.sprintf "Received request with method: %s" req.method_);

     

       224
       224
       +
             (match req.method_ with

     

       225
       225
       +
              | "initialize" -> 

     

       226
       226
       +
                log_debug "Processing initialize request";

     

       227
       227
       +
                Some (handle_initialize req.id req.params)

     

       228
       228
       +
              | "tools/list" -> 

     

       229
       229
       +
                log_debug "Processing tools/list request";

     

       230
       230
       +
                Some (handle_list_tools req.id)

     

       231
       231
       +
              | "tools/call" -> 

     

       232
       232
       +
                log_debug "Processing tools/call request";

     

       233
       233
       +
                Some (handle_call_tool req.id req.params)

     

       234
       234
       +
              | "ping" -> 

     

       235
       235
       +
                log_debug "Processing ping request";

     

       236
       236
       +
                Some (handle_ping req.id)

     

       237
       237
       +
              | _ -> 

     

       238
       238
       +
                log_error (Printf.sprintf "Unknown method received: %s" req.method_);

     

       239
       239
       +
                Some (create_error ~id:req.id ~code:(-32601) ~message:("Method not found: " ^ req.method_) ()))

     

       240
       240
       +
           | JSONRPCMessage.Notification notif ->

     

       241
       241
       +
             log_debug (Printf.sprintf "Received notification with method: %s" notif.method_);

     

       242
       242
       +
             (match notif.method_ with

     

       243
       243
       +
              | "notifications/initialized" ->

     

       244
       244
       +
                log_debug "Client initialization complete - Server is now ready to receive requests";

     

       245
       245
       +
                log_debug (Printf.sprintf "Notification params: %s" 

     

       246
       246
       +
                  (match notif.params with

     

       247
       247
       +
                   | Some p -> Yojson.Safe.to_string p

     

       248
       248
       +
                   | None -> "null"));

     

       249
       249
       +
                None

     

       250
       250
       +
              | _ ->

     

       251
       251
       +
                log_debug (Printf.sprintf "Ignoring notification: %s" notif.method_);

     

       252
       252
       +
                None)

     

       253
       253
       +
           | JSONRPCMessage.Response _ ->

     

       254
       254
       +
             log_error "Unexpected response message received";

     

       255
       255
       +
             None

     

       256
       256
       +
           | JSONRPCMessage.Error _ ->

     

       257
       257
       +
             log_error "Unexpected error message received";

     

       258
       258
       +
             None

     

       259
       259
       +
         with

     

       260
       260
       +
         | exc ->

     

       261
       261
       +
           log_error (Printf.sprintf "Exception during message processing: %s" (Printexc.to_string exc));

     

       262
       262
       +
           log_error (Printf.sprintf "Backtrace: %s" (Printexc.get_backtrace()));

     

       263
       263
       +
           log_error (Printf.sprintf "Message was: %s" (Yojson.Safe.to_string message));

     

       264
       264
       +
           None

     

       265
       265
       +
       

     

       266
       266
       +
       (* Main loop *)

     

       267
       267
       +
       let rec read_message () =

     

       268
       268
       +
         try

     

       269
       269
       +
           log_debug "Attempting to read line from stdin...";

     

       270
       270
       +
           let line = read_line () in

     

       271
       271
       +
           if line = "" then (

     

       272
       272
       +
             log_debug "Empty line received, ignoring";

     

       273
       273
       +
             None

     

       274
       274
       +
           ) else (

     

       275
       275
       +
             log_debug (Printf.sprintf "Raw input: %s" line);

     

       276
       276
       +
             try

     

       277
       277
       +
               let json = Yojson.Safe.from_string line in

     

       278
       278
       +
               log_debug "Successfully parsed JSON";

     

       279
       279
       +
               Some json

     

       280
       280
       +
             with

     

       281
       281
       +
             | Yojson.Json_error msg -> 

     

       282
       282
       +
               log_error (Printf.sprintf "Error parsing JSON: %s" msg);

     

       283
       283
       +
               log_error (Printf.sprintf "Input was: %s" line);

     

       284
       284
       +
               read_message ()

     

       285
       285
       +
           )

     

       286
       286
       +
         with

     

       287
       287
       +
         | End_of_file -> 

     

       288
       288
       +
           log_debug "End of file received on stdin";

     

       289
       289
       +
           None

     

       290
       290
       +
         | Sys_error msg -> 

     

       291
       291
       +
           log_error (Printf.sprintf "System error while reading: %s" msg);

     

       292
       292
       +
           None

     

       293
       293
       +
         | exc ->

     

       294
       294
       +
           log_error (Printf.sprintf "Exception while reading: %s" (Printexc.to_string exc));

     

       295
       295
       +
           None

     

       296
       296
       +
       

     

       297
       297
       +
       let () =

     

       298
       298
       +
         try

     

       299
       299
       +
           (* Enable exception backtraces *)

     

       300
       300
       +
           Printexc.record_backtrace true;

     

       301
       301
       +
           

     

       302
       302
       +
           (* Enable line buffering for stdout *)

     

       303
       303
       +
           set_binary_mode_out stdout false;

     

       304
       304
       +
           

     

       305
       305
       +
           log_debug "MCP Capitalizer server started";

     

       306
       306
       +
           log_debug (Printf.sprintf "Protocol version: %s" protocol_version);

     

       307
       307
       +
           log_debug (Printf.sprintf "Server info: %s v%s" server_info.name server_info.version);

     

       308
       308
       +
           

     

       309
       309
       +
           (* Print environment info for debugging *)

     

       310
       310
       +
           log_debug "Environment variables:";

     

       311
       311
       +
           Unix.environment()

     

       312
       312
       +
           |> Array.iter (fun s -> 

     

       313
       313
       +
             try

     

       314
       314
       +
               let i = String.index s '=' in

     

       315
       315
       +
               let name = String.sub s 0 i in

     

       316
       316
       +
               if String.length name > 0 then

     

       317
       317
       +
                 log_debug (Printf.sprintf "  %s" s)

     

       318
       318
       +
             with Not_found -> ()

     

       319
       319
       +
           );

     

       320
       320
       +
           

     

       321
       321
       +
           let rec server_loop count =

     

       322
       322
       +
             log_debug (Printf.sprintf "Waiting for message #%d..." count);

     

       323
       323
       +
             match read_message () with

     

       324
       324
       +
             | Some json ->

     

       325
       325
       +
               log_debug (Printf.sprintf "Received message: %s" (Yojson.Safe.to_string json));

     

       326
       326
       +
               (match process_message json with

     

       327
       327
       +
                | Some response ->

     

       328
       328
       +
                  let response_json = JSONRPCMessage.yojson_of_t response in

     

       329
       329
       +
                  let response_str = Yojson.Safe.to_string response_json in

     

       330
       330
       +
                  log_debug (Printf.sprintf "Sending response: %s" response_str);

     

       331
       331
       +
                  (* Make sure we emit properly formatted JSON on a single line with a newline at the end *)

     

       332
       332
       +
                  Printf.printf "%s\n" response_str;

     

       333
       333
       +
                  flush stdout;

     

       334
       334
       +
                  (* Give the client a moment to process the response *)

     

       335
       335
       +
                  Unix.sleepf 0.01;

     

       336
       336
       +
                  server_loop (count + 1)

     

       337
       337
       +
                | None -> 

     

       338
       338
       +
                  log_debug "No response needed for this message";

     

       339
       339
       +
                  server_loop (count + 1))

     

       340
       340
       +
             | None -> 

     

       341
       341
       +
               log_debug "End of input stream, terminating server";

     

       342
       342
       +
               ()

     

       343
       343
       +
           in

     

       344
       344
       +
           

     

       345
       345
       +
           log_debug "Starting server loop...";

     

       346
       346
       +
           log_debug "Waiting for the initialize request...";

     

       347
       347
       +
           

     

       348
       348
       +
           (* Set up signal handler to gracefully exit *)

     

       349
       349
       +
           Sys.(set_signal sigint (Signal_handle (fun _ -> 

     

       350
       350
       +
             log_debug "Received interrupt signal, exiting...";

     

       351
       351
       +
             exit 0

     

       352
       352
       +
           )));

     

       353
       353
       +
           

     

       354
       354
       +
           server_loop 1;

     

       355
       355
       +
           log_debug "Server terminated normally";

     

       356
       356
       +
         with

     

       357
       357
       +
         | End_of_file ->

     

       358
       358
       +
           log_error "Unexpected end of file";

     

       359
       359
       +
         | Sys_error msg ->

     

       360
       360
       +
           log_error (Printf.sprintf "System error: %s" msg);

     

       361
       361
       +
         | Unix.Unix_error(err, func, arg) ->

     

       362
       362
       +
           log_error (Printf.sprintf "Unix error in %s(%s): %s" func arg (Unix.error_message err));

     

       363
       363
       +
         | exc ->

     

       364
       364
       +
           log_error (Printf.sprintf "Unhandled exception: %s" (Printexc.to_string exc));

     

       365
       365
       +
           log_error (Printf.sprintf "Backtrace: %s" (Printexc.get_backtrace()))

bin/server.mli

···

       1
       1
       +
       val process_message : Jsonrpc.Json.t -> Mcp.JSONRPCMessage.t option

     

       2
       2
       +
       val handle_initialize : Jsonrpc.Id.t -> Jsonrpc.Json.t option -> Mcp.JSONRPCMessage.t

     

       3
       3
       +
       val handle_list_tools : Jsonrpc.Id.t -> Mcp.JSONRPCMessage.t

     

       4
       4
       +
       val handle_call_tool : Jsonrpc.Id.t -> Jsonrpc.Json.t option -> Mcp.JSONRPCMessage.t

     

       5
       5
       +
       val handle_ping : Jsonrpc.Id.t -> Mcp.JSONRPCMessage.t

-21

dune-project

···

       1
       1
        
       (lang dune 3.17)

     

       2
       2
       -
       (name mcp)

     

       3
       3
       -
       

     

       4
       4
       -
       (license ISC)

     

       5
       5
       -
       (authors "Anil Madhavapeddy")

     

       6
       6
       -
       (maintainers "anil@recoil.org")

     

       7
       7
       -
       

     

       8
       8
       -
       (generate_opam_files true)

     

       9
       9
       -
       

     

       10
       10
       -
       (package

     

       11
       11
       -
        (name mcp)

     

       12
       12
       -
        (synopsis "Model Context Protocol for LLMs")

     

       13
       13
       -
        (description "This is all still a work in progress")

     

       14
       14
       -
        (depends

     

       15
       15
       -
         (ocaml (>= "5.2.0"))

     

       16
       16
       -
         jsonrpc

     

       17
       17
       -
         (yojson (< "3.0.0"))

     

       18
       18
       -
         http

     

       19
       19
       -
         cohttp-eio

     

       20
       20
       -
         eio_main

     

       21
       21
       -
         eio))

     

       22
       22
       -

+3 -13

lib/dune

···

       1
       1
        
       (library

     

       2
       2
        
         (name mcp)

     

       3
       3
       -
         (public_name mcp)

     

       4
       3
        
         (libraries jsonrpc unix yojson)

     

       5
       4
        
         (modules mcp))

     

       6
       6
       -
       

     

       7
       7
       -
       (library

     

       8
       8
       -
         (name mcp_rpc)

     

       9
       9
       -
         (public_name mcp.rpc)

     

       10
       10
       -
         (libraries mcp jsonrpc unix yojson)

     

       11
       11
       -
         (modules mcp_rpc)

     

       12
       12
       -
         (flags (:standard -w -67 -w -27 -w -32 -w -33 -w -34)))

     

       13
       5
        
       

     

       14
       6
        
       (library

     

       15
       7
        
         (name mcp_sdk)

     

       16
       16
       -
         (public_name mcp.sdk)

     

       17
       17
       -
         (libraries mcp mcp_rpc jsonrpc unix yojson)

     

       8
       8
       +
         (libraries mcp jsonrpc unix yojson)

     

       18
       9
        
         (modules mcp_sdk)

     

       19
       10
        
         (flags (:standard -w -67 -w -27 -w -32)))

     

       20
       11
        
       

     

       21
       12
        
       (library

     

       22
       13
        
         (name mcp_server)

     

       23
       23
       -
         (public_name mcp.server)

     

       24
       24
       -
         (libraries mcp_sdk jsonrpc eio_main eio http cohttp-eio)

     

       14
       14
       +
         (libraries mcp mcp_sdk jsonrpc unix yojson)

     

       25
       15
        
         (modules mcp_server)

     

       26
       26
       -
       )

     

       16
       16
       +
         (flags (:standard -w -67 -w -27 -w -32 -w -8 -w -11 -w -33)))

+601 -316

lib/mcp.ml

···

       1
       1
        
       open Jsonrpc

     

       2
       2
        
       

     

       3
       3
       -
       (* Utility functions for JSON parsing *)

     

       4
       4
       -
       module Util = struct

     

       5
       5
       -
         (* Helper to raise a Json.Of_json exception with formatted message *)

     

       6
       6
       -
         let json_error fmt json = 

     

       7
       7
       -
           Printf.ksprintf (fun msg -> raise (Json.Of_json (msg, json))) fmt

     

       8
       8
       -
         

     

       9
       9
       -
         (* Extract a string field from JSON object or raise an error *)

     

       10
       10
       -
         let get_string_field fields name json =

     

       11
       11
       -
           match List.assoc_opt name fields with

     

       12
       12
       -
           | Some (`String s) -> s

     

       13
       13
       -
           | _ -> json_error "Missing or invalid '%s' field" json name

     

       14
       14
       -
         

     

       15
       15
       -
         (* Extract an optional string field from JSON object *)

     

       16
       16
       -
         let get_optional_string_field fields name =

     

       17
       17
       -
           List.assoc_opt name fields |> Option.map (function

     

       18
       18
       -
             | `String s -> s

     

       19
       19
       -
             | j -> json_error "Expected string for %s" j name

     

       20
       20
       -
           )

     

       21
       21
       -
         

     

       22
       22
       -
         (* Extract an int field from JSON object or raise an error *)

     

       23
       23
       -
         let get_int_field fields name json =

     

       24
       24
       -
           match List.assoc_opt name fields with

     

       25
       25
       -
           | Some (`Int i) -> i

     

       26
       26
       -
           | _ -> json_error "Missing or invalid '%s' field" json name

     

       27
       27
       -
           

     

       28
       28
       -
         (* Extract a float field from JSON object or raise an error *)

     

       29
       29
       -
         let get_float_field fields name json =

     

       30
       30
       -
           match List.assoc_opt name fields with

     

       31
       31
       -
           | Some (`Float f) -> f

     

       32
       32
       -
           | _ -> json_error "Missing or invalid '%s' field" json name

     

       33
       33
       -
         

     

       34
       34
       -
         (* Extract a boolean field from JSON object or raise an error *)

     

       35
       35
       -
         let get_bool_field fields name json =

     

       36
       36
       -
           match List.assoc_opt name fields with

     

       37
       37
       -
           | Some (`Bool b) -> b

     

       38
       38
       -
           | _ -> json_error "Missing or invalid '%s' field" json name

     

       39
       39
       -
           

     

       40
       40
       -
         (* Extract an object field from JSON object or raise an error *)

     

       41
       41
       -
         let get_object_field fields name json =

     

       42
       42
       -
           match List.assoc_opt name fields with

     

       43
       43
       -
           | Some (`Assoc obj) -> obj

     

       44
       44
       -
           | _ -> json_error "Missing or invalid '%s' field" json name

     

       45
       45
       -
           

     

       46
       46
       -
         (* Extract a list field from JSON object or raise an error *)

     

       47
       47
       -
         let get_list_field fields name json =

     

       48
       48
       -
           match List.assoc_opt name fields with

     

       49
       49
       -
           | Some (`List items) -> items

     

       50
       50
       -
           | _ -> json_error "Missing or invalid '%s' field" json name

     

       51
       51
       -
           

     

       52
       52
       -
         (* Verify a specific string value in a field *)

     

       53
       53
       -
         let verify_string_field fields name expected_value json =

     

       54
       54
       -
           match List.assoc_opt name fields with

     

       55
       55
       -
           | Some (`String s) when s = expected_value -> ()

     

       56
       56
       -
           | _ -> json_error "Field '%s' missing or not equal to '%s'" json name expected_value

     

       57
       57
       -
       end

     

       58
       58
       -
       

     

       59
       59
       -
       (* Error codes for JSON-RPC *)

     

       3
       3
       +
       (* Standard error codes *)

     

       60
       4
        
       module ErrorCode = struct

     

       61
       61
       -
         type t = 

     

       62
       62
       -
           | ParseError       (* -32700 - Invalid JSON *)

     

       63
       63
       -
           | InvalidRequest   (* -32600 - Invalid JSON-RPC request *)

     

       64
       64
       -
           | MethodNotFound   (* -32601 - Method not available *)

     

       65
       65
       -
           | InvalidParams    (* -32602 - Invalid method parameters *)

     

       66
       66
       -
           | InternalError    (* -32603 - Internal JSON-RPC error *)

     

       67
       67
       -
           | ResourceNotFound (* -32002 - Custom MCP error: requested resource not found *)

     

       68
       68
       -
           | AuthRequired     (* -32001 - Custom MCP error: authentication required *)

     

       69
       69
       -
           | CustomError of int (* For any other error codes *)

     

       70
       70
       -
         

     

       71
       71
       -
         (* Convert the error code to its integer representation *)

     

       72
       72
       -
         let to_int = function

     

       73
       73
       -
           | ParseError -> -32700

     

       74
       74
       -
           | InvalidRequest -> -32600

     

       75
       75
       -
           | MethodNotFound -> -32601

     

       76
       76
       -
           | InvalidParams -> -32602

     

       77
       77
       -
           | InternalError -> -32603

     

       78
       78
       -
           | ResourceNotFound -> -32002

     

       79
       79
       -
           | AuthRequired -> -32001

     

       80
       80
       -
           | CustomError code -> code

     

       81
       81
       -
         

     

       82
       82
       -
         (* Get error message for standard error codes *)

     

       83
       83
       -
         let to_message = function

     

       84
       84
       -
           | ParseError -> "Parse error"

     

       85
       85
       -
           | InvalidRequest -> "Invalid Request"

     

       86
       86
       -
           | MethodNotFound -> "Method not found"

     

       87
       87
       -
           | InvalidParams -> "Invalid params"

     

       88
       88
       -
           | InternalError -> "Internal error"

     

       89
       89
       -
           | ResourceNotFound -> "Resource not found"

     

       90
       90
       -
           | AuthRequired -> "Authentication required"

     

       91
       91
       -
           | CustomError _ -> "Error"

     

       92
       92
       -
       end

     

       93
       93
       -
       

     

       94
       94
       -
       (* Protocol method types *)

     

       95
       95
       -
       module Method = struct

     

       96
       96
       -
         (* Method type representing all MCP protocol methods *)

     

       97
       97
       -
         type t =

     

       98
       98
       -
           (* Initialization and lifecycle methods *)

     

       99
       99
       -
           | Initialize

     

       100
       100
       -
           | Initialized

     

       101
       101
       -
           

     

       102
       102
       -
           (* Resource methods *)

     

       103
       103
       -
           | ResourcesList

     

       104
       104
       -
           | ResourcesRead

     

       105
       105
       -
           | ResourceTemplatesList

     

       106
       106
       -
           | ResourcesSubscribe

     

       107
       107
       -
           | ResourcesListChanged

     

       108
       108
       -
           | ResourcesUpdated

     

       109
       109
       -
           

     

       110
       110
       -
           (* Tool methods *)

     

       111
       111
       -
           | ToolsList

     

       112
       112
       -
           | ToolsCall

     

       113
       113
       -
           | ToolsListChanged

     

       114
       114
       -
           

     

       115
       115
       -
           (* Prompt methods *)

     

       116
       116
       -
           | PromptsList

     

       117
       117
       -
           | PromptsGet

     

       118
       118
       -
           | PromptsListChanged

     

       119
       119
       -
           

     

       120
       120
       -
           (* Progress notifications *)

     

       121
       121
       -
           | Progress

     

       122
       122
       -
         

     

       123
       123
       -
         (* Convert method type to string representation *)

     

       124
       124
       -
         let to_string = function

     

       125
       125
       -
           | Initialize -> "initialize"

     

       126
       126
       -
           | Initialized -> "notifications/initialized"

     

       127
       127
       -
           | ResourcesList -> "resources/list"

     

       128
       128
       -
           | ResourcesRead -> "resources/read"

     

       129
       129
       -
           | ResourceTemplatesList -> "resources/templates/list"

     

       130
       130
       -
           | ResourcesSubscribe -> "resources/subscribe"

     

       131
       131
       -
           | ResourcesListChanged -> "notifications/resources/list_changed"

     

       132
       132
       -
           | ResourcesUpdated -> "notifications/resources/updated"

     

       133
       133
       -
           | ToolsList -> "tools/list"

     

       134
       134
       -
           | ToolsCall -> "tools/call"

     

       135
       135
       -
           | ToolsListChanged -> "notifications/tools/list_changed"

     

       136
       136
       -
           | PromptsList -> "prompts/list"

     

       137
       137
       -
           | PromptsGet -> "prompts/get"

     

       138
       138
       -
           | PromptsListChanged -> "notifications/prompts/list_changed"

     

       139
       139
       -
           | Progress -> "notifications/progress"

     

       140
       140
       -
         

     

       141
       141
       -
         (* Convert string to method type *)

     

       142
       142
       -
         let of_string = function

     

       143
       143
       -
           | "initialize" -> Initialize

     

       144
       144
       -
           | "notifications/initialized" -> Initialized

     

       145
       145
       -
           | "resources/list" -> ResourcesList

     

       146
       146
       -
           | "resources/read" -> ResourcesRead

     

       147
       147
       -
           | "resources/templates/list" -> ResourceTemplatesList

     

       148
       148
       -
           | "resources/subscribe" -> ResourcesSubscribe

     

       149
       149
       -
           | "notifications/resources/list_changed" -> ResourcesListChanged

     

       150
       150
       -
           | "notifications/resources/updated" -> ResourcesUpdated

     

       151
       151
       -
           | "tools/list" -> ToolsList

     

       152
       152
       -
           | "tools/call" -> ToolsCall

     

       153
       153
       -
           | "notifications/tools/list_changed" -> ToolsListChanged

     

       154
       154
       -
           | "prompts/list" -> PromptsList

     

       155
       155
       -
           | "prompts/get" -> PromptsGet

     

       156
       156
       -
           | "notifications/prompts/list_changed" -> PromptsListChanged

     

       157
       157
       -
           | "notifications/progress" -> Progress

     

       158
       158
       -
           | s -> failwith ("Unknown MCP method: " ^ s)

     

       5
       5
       +
         let parse_error = -32700

     

       6
       6
       +
         let invalid_request = -32600

     

       7
       7
       +
         let method_not_found = -32601

     

       8
       8
       +
         let invalid_params = -32602

     

       9
       9
       +
         let internal_error = -32603

     

       10
       10
       +
         let resource_not_found = -32002

     

       11
       11
       +
         let server_error_start = -32000

     

       12
       12
       +
         let server_error_end = -32099

     

       159
       13
        
       end

     

       160
       14
        
       

     

       161
       15
        
       (* Common types *)

     
···

       170
       24
        
         let of_string = function

     

       171
       25
        
           | "user" -> `User

     

       172
       26
        
           | "assistant" -> `Assistant

     

       173
       173
       -
           | s -> Util.json_error "Unknown role: %s" (`String s) s

     

       27
       27
       +
           | s -> raise (Json.Of_json ("Unknown role: " ^ s, `String s))

     

       174
       28
        
       

     

       175
       29
        
         let yojson_of_t t = `String (to_string t)

     

       176
       30
        
         let t_of_yojson = function

     

       177
       31
        
           | `String s -> of_string s

     

       178
       178
       -
           | j -> Util.json_error "Expected string for Role" j

     

       32
       32
       +
           | j -> raise (Json.Of_json ("Expected string for Role", j))

     

       179
       33
        
       end

     

       180
       34
        
       

     

       181
       35
        
       module ProgressToken = struct

     
···

       192
       46
        
         let yojson_of_t t = `String t

     

       193
       47
        
         let t_of_yojson = function

     

       194
       48
        
           | `String s -> s

     

       195
       195
       -
           | j -> Util.json_error "Expected string for Cursor" j

     

       49
       49
       +
           | j -> raise (Json.Of_json ("Expected string for Cursor", j))

     

       196
       50
        
       end

     

       197
       51
        
       

     

       198
       52
        
       (* Annotations *)

     
···

       222
       76
        
           | `Assoc fields ->

     

       223
       77
        
             let audience = List.assoc_opt "audience" fields |> Option.map (function

     

       224
       78
        
               | `List items -> List.map Role.t_of_yojson items

     

       225
       225
       -
               | j -> Util.json_error "Expected list for audience" j

     

       79
       79
       +
               | j -> raise (Json.Of_json ("Expected list for audience", j))

     

       226
       80
        
             ) in

     

       227
       81
        
             let priority = List.assoc_opt "priority" fields |> Option.map (function

     

       228
       82
        
               | `Float f -> f

     

       229
       229
       -
               | j -> Util.json_error "Expected float for priority" j

     

       83
       83
       +
               | j -> raise (Json.Of_json ("Expected float for priority", j))

     

       230
       84
        
             ) in

     

       231
       85
        
             { audience; priority }

     

       232
       232
       -
           | j -> Util.json_error "Expected object for annotation" j

     

       86
       86
       +
           | j -> raise (Json.Of_json ("Expected object for annotation", j))

     

       233
       87
        
       

     

       234
       88
        
         let yojson_of_t { annotations } =

     

       235
       89
        
           match annotations with

     
···

       240
       94
        
           | `Assoc fields ->

     

       241
       95
        
             let annotations = List.assoc_opt "annotations" fields |> Option.map annotation_of_yojson in

     

       242
       96
        
             { annotations }

     

       243
       243
       -
           | j -> Util.json_error "Expected object for Annotated" j

     

       97
       97
       +
           | j -> raise (Json.Of_json ("Expected object for Annotated", j))

     

       244
       98
        
       end

     

       245
       99
        
       

     

       246
       100
        
       (* Content types *)

     
···

       263
       117
        
           `Assoc assoc

     

       264
       118
        
       

     

       265
       119
        
         let t_of_yojson = function

     

       266
       266
       -
           | `Assoc fields as json ->

     

       267
       267
       -
             let text = Util.get_string_field fields "text" json in

     

       268
       268
       -
             Util.verify_string_field fields "type" "text" json;

     

       120
       120
       +
           | `Assoc fields ->

     

       121
       121
       +
             let text = match List.assoc_opt "text" fields with

     

       122
       122
       +
               | Some (`String s) -> s

     

       123
       123
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'text' field", `Assoc fields))

     

       124
       124
       +
             in

     

       125
       125
       +
             let _ = match List.assoc_opt "type" fields with

     

       126
       126
       +
               | Some (`String "text") -> ()

     

       127
       127
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'type' field", `Assoc fields))

     

       128
       128
       +
             in

     

       269
       129
        
             let annotations = List.assoc_opt "annotations" fields |> Option.map Annotated.annotation_of_yojson in

     

       270
       130
        
             { text; annotations }

     

       271
       271
       -
           | j -> Util.json_error "Expected object for TextContent" j

     

       131
       131
       +
           | j -> raise (Json.Of_json ("Expected object for TextContent", j))

     

       272
       132
        
       end

     

       273
       133
        
       

     

       274
       134
        
       module ImageContent = struct

     
···

       280
       140
        
       

     

       281
       141
        
         let yojson_of_t { data; mime_type; annotations } =

     

       282
       142
        
           let assoc = [

     

       283
       283
       -
             ("type", `String "image");

     

       284
       143
        
             ("data", `String data);

     

       285
       144
        
             ("mimeType", `String mime_type);

     

       145
       145
       +
             ("type", `String "image");

     

       286
       146
        
           ] in

     

       287
       147
        
           let assoc = match annotations with

     

       288
       148
        
             | Some annotations -> ("annotations", Annotated.yojson_of_annotation annotations) :: assoc

     
···

       291
       151
        
           `Assoc assoc

     

       292
       152
        
       

     

       293
       153
        
         let t_of_yojson = function

     

       294
       294
       -
           | `Assoc fields as json ->

     

       295
       295
       -
             let data = Util.get_string_field fields "data" json in

     

       296
       296
       -
             let mime_type = Util.get_string_field fields "mimeType" json in

     

       297
       297
       -
             Util.verify_string_field fields "type" "image" json;

     

       154
       154
       +
           | `Assoc fields ->

     

       155
       155
       +
             let data = match List.assoc_opt "data" fields with

     

       156
       156
       +
               | Some (`String s) -> s

     

       157
       157
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'data' field", `Assoc fields))

     

       158
       158
       +
             in

     

       159
       159
       +
             let mime_type = match List.assoc_opt "mimeType" fields with

     

       160
       160
       +
               | Some (`String s) -> s

     

       161
       161
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'mimeType' field", `Assoc fields))

     

       162
       162
       +
             in

     

       163
       163
       +
             let _ = match List.assoc_opt "type" fields with

     

       164
       164
       +
               | Some (`String "image") -> ()

     

       165
       165
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'type' field", `Assoc fields))

     

       166
       166
       +
             in

     

       298
       167
        
             let annotations = List.assoc_opt "annotations" fields |> Option.map Annotated.annotation_of_yojson in

     

       299
       168
        
             { data; mime_type; annotations }

     

       300
       300
       -
           | j -> Util.json_error "Expected object for ImageContent" j

     

       169
       169
       +
           | j -> raise (Json.Of_json ("Expected object for ImageContent", j))

     

       301
       170
        
       end

     

       302
       171
        
       

     

       303
       172
        
       module AudioContent = struct

     
···

       309
       178
        
       

     

       310
       179
        
         let yojson_of_t { data; mime_type; annotations } =

     

       311
       180
        
           let assoc = [

     

       312
       312
       -
             ("type", `String "audio");

     

       313
       181
        
             ("data", `String data);

     

       314
       182
        
             ("mimeType", `String mime_type);

     

       183
       183
       +
             ("type", `String "audio");

     

       315
       184
        
           ] in

     

       316
       185
        
           let assoc = match annotations with

     

       317
       186
        
             | Some annotations -> ("annotations", Annotated.yojson_of_annotation annotations) :: assoc

     
···

       320
       189
        
           `Assoc assoc

     

       321
       190
        
       

     

       322
       191
        
         let t_of_yojson = function

     

       323
       323
       -
           | `Assoc fields as json ->

     

       324
       324
       -
             let data = Util.get_string_field fields "data" json in

     

       325
       325
       -
             let mime_type = Util.get_string_field fields "mimeType" json in

     

       326
       326
       -
             Util.verify_string_field fields "type" "audio" json;

     

       192
       192
       +
           | `Assoc fields ->

     

       193
       193
       +
             let data = match List.assoc_opt "data" fields with

     

       194
       194
       +
               | Some (`String s) -> s

     

       195
       195
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'data' field", `Assoc fields))

     

       196
       196
       +
             in

     

       197
       197
       +
             let mime_type = match List.assoc_opt "mimeType" fields with

     

       198
       198
       +
               | Some (`String s) -> s

     

       199
       199
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'mimeType' field", `Assoc fields))

     

       200
       200
       +
             in

     

       201
       201
       +
             let _ = match List.assoc_opt "type" fields with

     

       202
       202
       +
               | Some (`String "audio") -> ()

     

       203
       203
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'type' field", `Assoc fields))

     

       204
       204
       +
             in

     

       327
       205
        
             let annotations = List.assoc_opt "annotations" fields |> Option.map Annotated.annotation_of_yojson in

     

       328
       206
        
             { data; mime_type; annotations }

     

       329
       329
       -
           | j -> Util.json_error "Expected object for AudioContent" j

     

       207
       207
       +
           | j -> raise (Json.Of_json ("Expected object for AudioContent", j))

     

       330
       208
        
       end

     

       331
       209
        
       

     

       332
       210
        
       module ResourceContents = struct

     
···

       346
       224
        
           `Assoc assoc

     

       347
       225
        
       

     

       348
       226
        
         let t_of_yojson = function

     

       349
       349
       -
           | `Assoc fields as json ->

     

       350
       350
       -
             let uri = Util.get_string_field fields "uri" json in

     

       351
       351
       -
             let mime_type = Util.get_optional_string_field fields "mimeType" in

     

       227
       227
       +
           | `Assoc fields ->

     

       228
       228
       +
             let uri = match List.assoc_opt "uri" fields with

     

       229
       229
       +
               | Some (`String s) -> s

     

       230
       230
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'uri' field", `Assoc fields))

     

       231
       231
       +
             in

     

       232
       232
       +
             let mime_type = List.assoc_opt "mimeType" fields |> Option.map (function

     

       233
       233
       +
               | `String s -> s

     

       234
       234
       +
               | j -> raise (Json.Of_json ("Expected string for mimeType", j))

     

       235
       235
       +
             ) in

     

       352
       236
        
             { uri; mime_type }

     

       353
       353
       -
           | j -> Util.json_error "Expected object for ResourceContents" j

     

       237
       237
       +
           | j -> raise (Json.Of_json ("Expected object for ResourceContents", j))

     

       354
       238
        
       end

     

       355
       239
        
       

     

       356
       240
        
       module TextResourceContents = struct

     
···

       372
       256
        
           `Assoc assoc

     

       373
       257
        
       

     

       374
       258
        
         let t_of_yojson = function

     

       375
       375
       -
           | `Assoc fields as json ->

     

       376
       376
       -
             let uri = Util.get_string_field fields "uri" json in

     

       377
       377
       -
             let text = Util.get_string_field fields "text" json in

     

       378
       378
       -
             let mime_type = Util.get_optional_string_field fields "mimeType" in

     

       259
       259
       +
           | `Assoc fields ->

     

       260
       260
       +
             let uri = match List.assoc_opt "uri" fields with

     

       261
       261
       +
               | Some (`String s) -> s

     

       262
       262
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'uri' field", `Assoc fields))

     

       263
       263
       +
             in

     

       264
       264
       +
             let text = match List.assoc_opt "text" fields with

     

       265
       265
       +
               | Some (`String s) -> s

     

       266
       266
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'text' field", `Assoc fields))

     

       267
       267
       +
             in

     

       268
       268
       +
             let mime_type = List.assoc_opt "mimeType" fields |> Option.map (function

     

       269
       269
       +
               | `String s -> s

     

       270
       270
       +
               | j -> raise (Json.Of_json ("Expected string for mimeType", j))

     

       271
       271
       +
             ) in

     

       379
       272
        
             { uri; text; mime_type }

     

       380
       380
       -
           | j -> Util.json_error "Expected object for TextResourceContents" j

     

       273
       273
       +
           | j -> raise (Json.Of_json ("Expected object for TextResourceContents", j))

     

       381
       274
        
       end

     

       382
       275
        
       

     

       383
       276
        
       module BlobResourceContents = struct

     
···

       399
       292
        
           `Assoc assoc

     

       400
       293
        
       

     

       401
       294
        
         let t_of_yojson = function

     

       402
       402
       -
           | `Assoc fields as json ->

     

       403
       403
       -
             let uri = Util.get_string_field fields "uri" json in

     

       404
       404
       -
             let blob = Util.get_string_field fields "blob" json in

     

       405
       405
       -
             let mime_type = Util.get_optional_string_field fields "mimeType" in

     

       295
       295
       +
           | `Assoc fields ->

     

       296
       296
       +
             let uri = match List.assoc_opt "uri" fields with

     

       297
       297
       +
               | Some (`String s) -> s

     

       298
       298
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'uri' field", `Assoc fields))

     

       299
       299
       +
             in

     

       300
       300
       +
             let blob = match List.assoc_opt "blob" fields with

     

       301
       301
       +
               | Some (`String s) -> s

     

       302
       302
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'blob' field", `Assoc fields))

     

       303
       303
       +
             in

     

       304
       304
       +
             let mime_type = List.assoc_opt "mimeType" fields |> Option.map (function

     

       305
       305
       +
               | `String s -> s

     

       306
       306
       +
               | j -> raise (Json.Of_json ("Expected string for mimeType", j))

     

       307
       307
       +
             ) in

     

       406
       308
        
             { uri; blob; mime_type }

     

       407
       407
       -
           | j -> Util.json_error "Expected object for BlobResourceContents" j

     

       309
       309
       +
           | j -> raise (Json.Of_json ("Expected object for BlobResourceContents", j))

     

       408
       310
        
       end

     

       409
       311
        
       

     

       410
       312
        
       module EmbeddedResource = struct

     
···

       429
       331
        
           `Assoc assoc

     

       430
       332
        
       

     

       431
       333
        
         let t_of_yojson = function

     

       432
       432
       -
           | `Assoc fields as json ->

     

       433
       433
       -
             Util.verify_string_field fields "type" "resource" json;

     

       434
       434
       -
             let resource_fields = match List.assoc_opt "resource" fields with

     

       435
       435
       -
               | Some (`Assoc res_fields) -> res_fields

     

       436
       436
       -
               | _ -> Util.json_error "Missing or invalid 'resource' field" json

     

       334
       334
       +
           | `Assoc fields ->

     

       335
       335
       +
             let _ = match List.assoc_opt "type" fields with

     

       336
       336
       +
               | Some (`String "resource") -> ()

     

       337
       337
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'type' field", `Assoc fields))

     

       437
       338
        
             in

     

       438
       438
       -
             let resource = 

     

       439
       439
       -
               if List.mem_assoc "text" resource_fields then

     

       440
       440
       -
                 `Text (TextResourceContents.t_of_yojson (`Assoc resource_fields))

     

       441
       441
       -
               else if List.mem_assoc "blob" resource_fields then

     

       442
       442
       -
                 `Blob (BlobResourceContents.t_of_yojson (`Assoc resource_fields))

     

       443
       443
       -
               else

     

       444
       444
       -
                 Util.json_error "Invalid resource content" (`Assoc resource_fields)

     

       339
       339
       +
             let resource = match List.assoc_opt "resource" fields with

     

       340
       340
       +
               | Some (`Assoc res_fields) ->

     

       341
       341
       +
                 if List.mem_assoc "text" res_fields then

     

       342
       342
       +
                   `Text (TextResourceContents.t_of_yojson (`Assoc res_fields))

     

       343
       343
       +
                 else if List.mem_assoc "blob" res_fields then

     

       344
       344
       +
                   `Blob (BlobResourceContents.t_of_yojson (`Assoc res_fields))

     

       345
       345
       +
                 else

     

       346
       346
       +
                   raise (Json.Of_json ("Invalid resource content", `Assoc res_fields))

     

       347
       347
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'resource' field", `Assoc fields))

     

       445
       348
        
             in

     

       446
       349
        
             let annotations = List.assoc_opt "annotations" fields |> Option.map Annotated.annotation_of_yojson in

     

       447
       350
        
             { resource; annotations }

     

       448
       448
       -
           | j -> Util.json_error "Expected object for EmbeddedResource" j

     

       351
       351
       +
           | j -> raise (Json.Of_json ("Expected object for EmbeddedResource", j))

     

       352
       352
       +
       end

     

       353
       353
       +
       

     

       354
       354
       +
       (** Tool definition *)

     

       355
       355
       +
       module Tool = struct

     

       356
       356
       +
         type t = {

     

       357
       357
       +
           name: string;

     

       358
       358
       +
           description: string option;

     

       359
       359
       +
           input_schema: Json.t;

     

       360
       360
       +
         }

     

       361
       361
       +
       

     

       362
       362
       +
         let yojson_of_t { name; description; input_schema } =

     

       363
       363
       +
           let assoc = [

     

       364
       364
       +
             ("name", `String name);

     

       365
       365
       +
             ("inputSchema", input_schema);

     

       366
       366
       +
           ] in

     

       367
       367
       +
           let assoc = match description with

     

       368
       368
       +
             | Some desc -> ("description", `String desc) :: assoc

     

       369
       369
       +
             | None -> assoc

     

       370
       370
       +
           in

     

       371
       371
       +
           `Assoc assoc

     

       372
       372
       +
       

     

       373
       373
       +
         let t_of_yojson = function

     

       374
       374
       +
           | `Assoc fields ->

     

       375
       375
       +
             let name = match List.assoc_opt "name" fields with

     

       376
       376
       +
               | Some (`String s) -> s

     

       377
       377
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'name' field", `Assoc fields))

     

       378
       378
       +
             in

     

       379
       379
       +
             let description = match List.assoc_opt "description" fields with

     

       380
       380
       +
               | Some (`String s) -> Some s

     

       381
       381
       +
               | _ -> None

     

       382
       382
       +
             in

     

       383
       383
       +
             let input_schema = match List.assoc_opt "inputSchema" fields with

     

       384
       384
       +
               | Some json -> json

     

       385
       385
       +
               | _ -> raise (Json.Of_json ("Missing 'inputSchema' field", `Assoc fields))

     

       386
       386
       +
             in

     

       387
       387
       +
             { name; description; input_schema }

     

       388
       388
       +
           | j -> raise (Json.Of_json ("Expected object for Tool", j))

     

       449
       389
        
       end

     

       450
       390
        
       

     

       451
       391
        
       type content = 

     
···

       461
       401
        
         | Resource r -> EmbeddedResource.yojson_of_t r

     

       462
       402
        
       

     

       463
       403
        
       let content_of_yojson = function

     

       464
       464
       -
         | `Assoc fields as json ->

     

       404
       404
       +
         | `Assoc fields ->

     

       465
       405
        
           (match List.assoc_opt "type" fields with

     

       466
       466
       -
            | Some (`String "text") -> Text (TextContent.t_of_yojson json)

     

       467
       467
       -
            | Some (`String "image") -> Image (ImageContent.t_of_yojson json)

     

       468
       468
       -
            | Some (`String "audio") -> Audio (AudioContent.t_of_yojson json)

     

       469
       469
       -
            | Some (`String "resource") -> Resource (EmbeddedResource.t_of_yojson json)

     

       470
       470
       -
            | _ -> Util.json_error "Invalid or missing content type" json)

     

       471
       471
       -
         | j -> Util.json_error "Expected object for content" j

     

       406
       406
       +
            | Some (`String "text") -> Text (TextContent.t_of_yojson (`Assoc fields))

     

       407
       407
       +
            | Some (`String "image") -> Image (ImageContent.t_of_yojson (`Assoc fields))

     

       408
       408
       +
            | Some (`String "audio") -> Audio (AudioContent.t_of_yojson (`Assoc fields))

     

       409
       409
       +
            | Some (`String "resource") -> Resource (EmbeddedResource.t_of_yojson (`Assoc fields))

     

       410
       410
       +
            | _ -> raise (Json.Of_json ("Invalid or missing content type", `Assoc fields)))

     

       411
       411
       +
         | j -> raise (Json.Of_json ("Expected object for content", j))

     

       412
       412
       +
       

     

       413
       413
       +
       (** Tool result *)

     

       414
       414
       +
       module CallToolResult = struct

     

       415
       415
       +
         type t = {

     

       416
       416
       +
           content: content list;

     

       417
       417
       +
           is_error: bool;

     

       418
       418
       +
           meta: Json.t option;

     

       419
       419
       +
         }

     

       420
       420
       +
       

     

       421
       421
       +
         let yojson_of_t { content; is_error; meta } =

     

       422
       422
       +
           let assoc = [

     

       423
       423
       +
             ("content", `List (List.map yojson_of_content content));

     

       424
       424
       +
             ("isError", `Bool is_error);

     

       425
       425
       +
           ] in

     

       426
       426
       +
           let assoc = match meta with

     

       427
       427
       +
             | Some meta_json -> ("_meta", meta_json) :: assoc

     

       428
       428
       +
             | None -> assoc

     

       429
       429
       +
           in

     

       430
       430
       +
           `Assoc assoc

     

       431
       431
       +
       

     

       432
       432
       +
         let t_of_yojson = function

     

       433
       433
       +
           | `Assoc fields ->

     

       434
       434
       +
             let content = match List.assoc_opt "content" fields with

     

       435
       435
       +
               | Some (`List items) -> List.map content_of_yojson items

     

       436
       436
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'content' field", `Assoc fields))

     

       437
       437
       +
             in

     

       438
       438
       +
             let is_error = match List.assoc_opt "isError" fields with

     

       439
       439
       +
               | Some (`Bool b) -> b

     

       440
       440
       +
               | None -> false (* Default to false if not specified *)

     

       441
       441
       +
               | _ -> raise (Json.Of_json ("Invalid 'isError' field", `Assoc fields))

     

       442
       442
       +
             in

     

       443
       443
       +
             let meta = List.assoc_opt "_meta" fields in

     

       444
       444
       +
             { content; is_error; meta }

     

       445
       445
       +
           | j -> raise (Json.Of_json ("Expected object for CallToolResult", j))

     

       446
       446
       +
       end

     

       447
       447
       +
       

     

       448
       448
       +
       (** Resource definition *)

     

       449
       449
       +
       module Resource = struct

     

       450
       450
       +
         type t = {

     

       451
       451
       +
           name: string;

     

       452
       452
       +
           uri: string;

     

       453
       453
       +
           description: string option;

     

       454
       454
       +
           mime_type: string option;

     

       455
       455
       +
           size: int option;

     

       456
       456
       +
           annotations: Annotated.annotation option;

     

       457
       457
       +
         }

     

       458
       458
       +
       

     

       459
       459
       +
         let yojson_of_t { name; uri; description; mime_type; size; annotations } =

     

       460
       460
       +
           let assoc = [

     

       461
       461
       +
             ("name", `String name);

     

       462
       462
       +
             ("uri", `String uri);

     

       463
       463
       +
           ] in

     

       464
       464
       +
           let assoc = match description with

     

       465
       465
       +
             | Some desc -> ("description", `String desc) :: assoc

     

       466
       466
       +
             | None -> assoc

     

       467
       467
       +
           in

     

       468
       468
       +
           let assoc = match mime_type with

     

       469
       469
       +
             | Some mime -> ("mimeType", `String mime) :: assoc

     

       470
       470
       +
             | None -> assoc

     

       471
       471
       +
           in

     

       472
       472
       +
           let assoc = match size with

     

       473
       473
       +
             | Some s -> ("size", `Int s) :: assoc

     

       474
       474
       +
             | None -> assoc

     

       475
       475
       +
           in

     

       476
       476
       +
           let assoc = match annotations with

     

       477
       477
       +
             | Some ann -> ("annotations", Annotated.yojson_of_annotation ann) :: assoc

     

       478
       478
       +
             | None -> assoc

     

       479
       479
       +
           in

     

       480
       480
       +
           `Assoc assoc

     

       481
       481
       +
       

     

       482
       482
       +
         let t_of_yojson = function

     

       483
       483
       +
           | `Assoc fields ->

     

       484
       484
       +
             let name = match List.assoc_opt "name" fields with

     

       485
       485
       +
               | Some (`String s) -> s

     

       486
       486
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'name' field", `Assoc fields))

     

       487
       487
       +
             in

     

       488
       488
       +
             let uri = match List.assoc_opt "uri" fields with

     

       489
       489
       +
               | Some (`String s) -> s

     

       490
       490
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'uri' field", `Assoc fields))

     

       491
       491
       +
             in

     

       492
       492
       +
             let description = match List.assoc_opt "description" fields with

     

       493
       493
       +
               | Some (`String s) -> Some s

     

       494
       494
       +
               | _ -> None

     

       495
       495
       +
             in

     

       496
       496
       +
             let mime_type = match List.assoc_opt "mimeType" fields with

     

       497
       497
       +
               | Some (`String s) -> Some s

     

       498
       498
       +
               | _ -> None

     

       499
       499
       +
             in

     

       500
       500
       +
             let size = match List.assoc_opt "size" fields with

     

       501
       501
       +
               | Some (`Int s) -> Some s

     

       502
       502
       +
               | _ -> None

     

       503
       503
       +
             in

     

       504
       504
       +
             let annotations = match List.assoc_opt "annotations" fields with

     

       505
       505
       +
               | Some json -> Some (Annotated.annotation_of_yojson json)

     

       506
       506
       +
               | _ -> None

     

       507
       507
       +
             in

     

       508
       508
       +
             { name; uri; description; mime_type; size; annotations }

     

       509
       509
       +
           | j -> raise (Json.Of_json ("Expected object for Resource", j))

     

       510
       510
       +
       end

     

       511
       511
       +
       

     

       512
       512
       +
       (** Resource Template definition *)

     

       513
       513
       +
       module ResourceTemplate = struct

     

       514
       514
       +
         type t = {

     

       515
       515
       +
           name: string;

     

       516
       516
       +
           uri_template: string;

     

       517
       517
       +
           description: string option;

     

       518
       518
       +
           mime_type: string option;

     

       519
       519
       +
           annotations: Annotated.annotation option;

     

       520
       520
       +
         }

     

       521
       521
       +
       

     

       522
       522
       +
         let yojson_of_t { name; uri_template; description; mime_type; annotations } =

     

       523
       523
       +
           let assoc = [

     

       524
       524
       +
             ("name", `String name);

     

       525
       525
       +
             ("uriTemplate", `String uri_template);

     

       526
       526
       +
           ] in

     

       527
       527
       +
           let assoc = match description with

     

       528
       528
       +
             | Some desc -> ("description", `String desc) :: assoc

     

       529
       529
       +
             | None -> assoc

     

       530
       530
       +
           in

     

       531
       531
       +
           let assoc = match mime_type with

     

       532
       532
       +
             | Some mime -> ("mimeType", `String mime) :: assoc

     

       533
       533
       +
             | None -> assoc

     

       534
       534
       +
           in

     

       535
       535
       +
           let assoc = match annotations with

     

       536
       536
       +
             | Some ann -> ("annotations", Annotated.yojson_of_annotation ann) :: assoc

     

       537
       537
       +
             | None -> assoc

     

       538
       538
       +
           in

     

       539
       539
       +
           `Assoc assoc

     

       540
       540
       +
       

     

       541
       541
       +
         let t_of_yojson = function

     

       542
       542
       +
           | `Assoc fields ->

     

       543
       543
       +
             let name = match List.assoc_opt "name" fields with

     

       544
       544
       +
               | Some (`String s) -> s

     

       545
       545
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'name' field", `Assoc fields))

     

       546
       546
       +
             in

     

       547
       547
       +
             let uri_template = match List.assoc_opt "uriTemplate" fields with

     

       548
       548
       +
               | Some (`String s) -> s

     

       549
       549
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'uriTemplate' field", `Assoc fields))

     

       550
       550
       +
             in

     

       551
       551
       +
             let description = match List.assoc_opt "description" fields with

     

       552
       552
       +
               | Some (`String s) -> Some s

     

       553
       553
       +
               | _ -> None

     

       554
       554
       +
             in

     

       555
       555
       +
             let mime_type = match List.assoc_opt "mimeType" fields with

     

       556
       556
       +
               | Some (`String s) -> Some s

     

       557
       557
       +
               | _ -> None

     

       558
       558
       +
             in

     

       559
       559
       +
             let annotations = match List.assoc_opt "annotations" fields with

     

       560
       560
       +
               | Some json -> Some (Annotated.annotation_of_yojson json)

     

       561
       561
       +
               | _ -> None

     

       562
       562
       +
             in

     

       563
       563
       +
             { name; uri_template; description; mime_type; annotations }

     

       564
       564
       +
           | j -> raise (Json.Of_json ("Expected object for ResourceTemplate", j))

     

       565
       565
       +
       end

     

       566
       566
       +
       

     

       567
       567
       +
       (** Resource Reference *)

     

       568
       568
       +
       module ResourceReference = struct

     

       569
       569
       +
         type t = {

     

       570
       570
       +
           uri: string;

     

       571
       571
       +
         }

     

       572
       572
       +
       

     

       573
       573
       +
         let yojson_of_t { uri } =

     

       574
       574
       +
           `Assoc [

     

       575
       575
       +
             ("type", `String "ref/resource");

     

       576
       576
       +
             ("uri", `String uri);

     

       577
       577
       +
           ]

     

       578
       578
       +
       

     

       579
       579
       +
         let t_of_yojson = function

     

       580
       580
       +
           | `Assoc fields ->

     

       581
       581
       +
             let _ = match List.assoc_opt "type" fields with

     

       582
       582
       +
               | Some (`String "ref/resource") -> ()

     

       583
       583
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'type' field", `Assoc fields))

     

       584
       584
       +
             in

     

       585
       585
       +
             let uri = match List.assoc_opt "uri" fields with

     

       586
       586
       +
               | Some (`String s) -> s

     

       587
       587
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'uri' field", `Assoc fields))

     

       588
       588
       +
             in

     

       589
       589
       +
             { uri }

     

       590
       590
       +
           | j -> raise (Json.Of_json ("Expected object for ResourceReference", j))

     

       591
       591
       +
       end

     

       592
       592
       +
       

     

       593
       593
       +
       (** Prompt Reference *)

     

       594
       594
       +
       module PromptReference = struct

     

       595
       595
       +
         type t = {

     

       596
       596
       +
           name: string;

     

       597
       597
       +
         }

     

       598
       598
       +
       

     

       599
       599
       +
         let yojson_of_t { name } =

     

       600
       600
       +
           `Assoc [

     

       601
       601
       +
             ("type", `String "ref/prompt");

     

       602
       602
       +
             ("name", `String name);

     

       603
       603
       +
           ]

     

       604
       604
       +
       

     

       605
       605
       +
         let t_of_yojson = function

     

       606
       606
       +
           | `Assoc fields ->

     

       607
       607
       +
             let _ = match List.assoc_opt "type" fields with

     

       608
       608
       +
               | Some (`String "ref/prompt") -> ()

     

       609
       609
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'type' field", `Assoc fields))

     

       610
       610
       +
             in

     

       611
       611
       +
             let name = match List.assoc_opt "name" fields with

     

       612
       612
       +
               | Some (`String s) -> s

     

       613
       613
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'name' field", `Assoc fields))

     

       614
       614
       +
             in

     

       615
       615
       +
             { name }

     

       616
       616
       +
           | j -> raise (Json.Of_json ("Expected object for PromptReference", j))

     

       617
       617
       +
       end

     

       618
       618
       +
       

     

       619
       619
       +
       (** Completion support *)

     

       620
       620
       +
       module Completion = struct

     

       621
       621
       +
         

     

       622
       622
       +
         module Argument = struct

     

       623
       623
       +
           type t = {

     

       624
       624
       +
             name: string;

     

       625
       625
       +
             value: string;

     

       626
       626
       +
           }

     

       627
       627
       +
       

     

       628
       628
       +
           let yojson_of_t { name; value } =

     

       629
       629
       +
             `Assoc [

     

       630
       630
       +
               ("name", `String name);

     

       631
       631
       +
               ("value", `String value);

     

       632
       632
       +
             ]

     

       633
       633
       +
       

     

       634
       634
       +
           let t_of_yojson = function

     

       635
       635
       +
             | `Assoc fields ->

     

       636
       636
       +
               let name = match List.assoc_opt "name" fields with

     

       637
       637
       +
                 | Some (`String s) -> s

     

       638
       638
       +
                 | _ -> raise (Json.Of_json ("Missing or invalid 'name' field", `Assoc fields))

     

       639
       639
       +
               in

     

       640
       640
       +
               let value = match List.assoc_opt "value" fields with

     

       641
       641
       +
                 | Some (`String s) -> s

     

       642
       642
       +
                 | _ -> raise (Json.Of_json ("Missing or invalid 'value' field", `Assoc fields))

     

       643
       643
       +
               in

     

       644
       644
       +
               { name; value }

     

       645
       645
       +
             | j -> raise (Json.Of_json ("Expected object for Completion.Argument", j))

     

       646
       646
       +
         end

     

       647
       647
       +
       

     

       648
       648
       +
         module Request = struct

     

       649
       649
       +
           type reference = [ `Prompt of PromptReference.t | `Resource of ResourceReference.t ]

     

       650
       650
       +
       

     

       651
       651
       +
           type t = {

     

       652
       652
       +
             argument: Argument.t;

     

       653
       653
       +
             ref: reference;

     

       654
       654
       +
           }

     

       655
       655
       +
       

     

       656
       656
       +
           let yojson_of_reference = function

     

       657
       657
       +
             | `Prompt p -> PromptReference.yojson_of_t p

     

       658
       658
       +
             | `Resource r -> ResourceReference.yojson_of_t r

     

       659
       659
       +
       

     

       660
       660
       +
           let reference_of_yojson = function

     

       661
       661
       +
             | `Assoc fields ->

     

       662
       662
       +
               (match List.assoc_opt "type" fields with

     

       663
       663
       +
                | Some (`String "ref/prompt") -> `Prompt (PromptReference.t_of_yojson (`Assoc fields))

     

       664
       664
       +
                | Some (`String "ref/resource") -> `Resource (ResourceReference.t_of_yojson (`Assoc fields))

     

       665
       665
       +
                | _ -> raise (Json.Of_json ("Invalid or missing reference type", `Assoc fields)))

     

       666
       666
       +
             | j -> raise (Json.Of_json ("Expected object for reference", j))

     

       667
       667
       +
       

     

       668
       668
       +
           let yojson_of_t { argument; ref } =

     

       669
       669
       +
             `Assoc [

     

       670
       670
       +
               ("argument", Argument.yojson_of_t argument);

     

       671
       671
       +
               ("ref", yojson_of_reference ref);

     

       672
       672
       +
             ]

     

       673
       673
       +
       

     

       674
       674
       +
           let t_of_yojson = function

     

       675
       675
       +
             | `Assoc fields ->

     

       676
       676
       +
               let argument = match List.assoc_opt "argument" fields with

     

       677
       677
       +
                 | Some json -> Argument.t_of_yojson json

     

       678
       678
       +
                 | _ -> raise (Json.Of_json ("Missing argument field", `Assoc fields))

     

       679
       679
       +
               in

     

       680
       680
       +
               let ref = match List.assoc_opt "ref" fields with

     

       681
       681
       +
                 | Some json -> reference_of_yojson json

     

       682
       682
       +
                 | _ -> raise (Json.Of_json ("Missing ref field", `Assoc fields))

     

       683
       683
       +
               in

     

       684
       684
       +
               { argument; ref }

     

       685
       685
       +
             | j -> raise (Json.Of_json ("Expected object for Completion.Request", j))

     

       686
       686
       +
       

     

       687
       687
       +
           let create ~argument ~ref =

     

       688
       688
       +
             { argument; ref }

     

       689
       689
       +
       

     

       690
       690
       +
           let to_params t =

     

       691
       691
       +
             yojson_of_t t

     

       692
       692
       +
         end

     

       693
       693
       +
       

     

       694
       694
       +
         module Result = struct

     

       695
       695
       +
           type completion = {

     

       696
       696
       +
             values: string list;

     

       697
       697
       +
             has_more: bool option;

     

       698
       698
       +
             total: int option;

     

       699
       699
       +
           }

     

       700
       700
       +
       

     

       701
       701
       +
           type t = {

     

       702
       702
       +
             completion: completion;

     

       703
       703
       +
             meta: Json.t option;

     

       704
       704
       +
           }

     

       705
       705
       +
       

     

       706
       706
       +
           let yojson_of_completion { values; has_more; total } =

     

       707
       707
       +
             let assoc = [

     

       708
       708
       +
               ("values", `List (List.map (fun s -> `String s) values));

     

       709
       709
       +
             ] in

     

       710
       710
       +
             let assoc = match has_more with

     

       711
       711
       +
               | Some b -> ("hasMore", `Bool b) :: assoc

     

       712
       712
       +
               | None -> assoc

     

       713
       713
       +
             in

     

       714
       714
       +
             let assoc = match total with

     

       715
       715
       +
               | Some n -> ("total", `Int n) :: assoc

     

       716
       716
       +
               | None -> assoc

     

       717
       717
       +
             in

     

       718
       718
       +
             `Assoc assoc

     

       719
       719
       +
       

     

       720
       720
       +
           let completion_of_yojson = function

     

       721
       721
       +
             | `Assoc fields ->

     

       722
       722
       +
               let values = match List.assoc_opt "values" fields with

     

       723
       723
       +
                 | Some (`List items) -> 

     

       724
       724
       +
                   List.map (function

     

       725
       725
       +
                     | `String s -> s

     

       726
       726
       +
                     | _ -> raise (Json.Of_json ("Expected string in values array", `List items))

     

       727
       727
       +
                   ) items

     

       728
       728
       +
                 | _ -> raise (Json.Of_json ("Missing or invalid 'values' field", `Assoc fields))

     

       729
       729
       +
               in

     

       730
       730
       +
               let has_more = match List.assoc_opt "hasMore" fields with

     

       731
       731
       +
                 | Some (`Bool b) -> Some b

     

       732
       732
       +
                 | None -> None

     

       733
       733
       +
                 | _ -> raise (Json.Of_json ("Invalid 'hasMore' field", `Assoc fields))

     

       734
       734
       +
               in

     

       735
       735
       +
               let total = match List.assoc_opt "total" fields with

     

       736
       736
       +
                 | Some (`Int n) -> Some n

     

       737
       737
       +
                 | None -> None

     

       738
       738
       +
                 | _ -> raise (Json.Of_json ("Invalid 'total' field", `Assoc fields))

     

       739
       739
       +
               in

     

       740
       740
       +
               { values; has_more; total }

     

       741
       741
       +
             | j -> raise (Json.Of_json ("Expected object for completion", j))

     

       742
       742
       +
       

     

       743
       743
       +
           let yojson_of_t { completion; meta } =

     

       744
       744
       +
             let assoc = [

     

       745
       745
       +
               ("completion", yojson_of_completion completion);

     

       746
       746
       +
             ] in

     

       747
       747
       +
             let assoc = match meta with

     

       748
       748
       +
               | Some meta_json -> ("_meta", meta_json) :: assoc

     

       749
       749
       +
               | None -> assoc

     

       750
       750
       +
             in

     

       751
       751
       +
             `Assoc assoc

     

       752
       752
       +
       

     

       753
       753
       +
           let t_of_yojson = function

     

       754
       754
       +
             | `Assoc fields ->

     

       755
       755
       +
               let completion = match List.assoc_opt "completion" fields with

     

       756
       756
       +
                 | Some json -> completion_of_yojson json

     

       757
       757
       +
                 | _ -> raise (Json.Of_json ("Missing completion field", `Assoc fields))

     

       758
       758
       +
               in

     

       759
       759
       +
               let meta = List.assoc_opt "_meta" fields in

     

       760
       760
       +
               { completion; meta }

     

       761
       761
       +
             | j -> raise (Json.Of_json ("Expected object for Completion.Result", j))

     

       762
       762
       +
       

     

       763
       763
       +
           let create ~completion ?meta () =

     

       764
       764
       +
             { completion; meta }

     

       765
       765
       +
       

     

       766
       766
       +
           let to_result t =

     

       767
       767
       +
             yojson_of_t t

     

       768
       768
       +
         end

     

       769
       769
       +
       end

     

       472
       770
        
       

     

       473
       771
        
       (* Message types *)

     

       474
       772
        
       

     
···

       485
       783
        
           ]

     

       486
       784
        
       

     

       487
       785
        
         let t_of_yojson = function

     

       488
       488
       -
           | `Assoc fields as json ->

     

       786
       786
       +
           | `Assoc fields ->

     

       489
       787
        
             let role = match List.assoc_opt "role" fields with

     

       490
       788
        
               | Some json -> Role.t_of_yojson json

     

       491
       491
       -
               | None -> Util.json_error "Missing role field" json

     

       789
       789
       +
               | None -> raise (Json.Of_json ("Missing role field", `Assoc fields))

     

       492
       790
        
             in

     

       493
       791
        
             let content = match List.assoc_opt "content" fields with

     

       494
       792
        
               | Some json -> content_of_yojson json

     

       495
       495
       -
               | None -> Util.json_error "Missing content field" json

     

       793
       793
       +
               | None -> raise (Json.Of_json ("Missing content field", `Assoc fields))

     

       496
       794
        
             in

     

       497
       795
        
             { role; content }

     

       498
       498
       -
           | j -> Util.json_error "Expected object for PromptMessage" j

     

       796
       796
       +
           | j -> raise (Json.Of_json ("Expected object for PromptMessage", j))

     

       499
       797
        
       end

     

       500
       798
        
       

     

       501
       799
        
       module SamplingMessage = struct

     

       502
       800
        
         type t = {

     

       503
       801
        
           role: Role.t;

     

       504
       504
       -
           content: [ `Text of TextContent.t | `Image of ImageContent.t | `Audio of AudioContent.t ];

     

       802
       802
       +
           content: [ `Text of TextContent.t | `Image of ImageContent.t ];

     

       505
       803
        
         }

     

       506
       804
        
       

     

       507
       805
        
         let yojson_of_t { role; content } =

     

       508
       806
        
           let content_json = match content with

     

       509
       807
        
             | `Text t -> TextContent.yojson_of_t t

     

       510
       808
        
             | `Image i -> ImageContent.yojson_of_t i

     

       511
       511
       -
             | `Audio a -> AudioContent.yojson_of_t a

     

       512
       809
        
           in

     

       513
       810
        
           `Assoc [

     

       514
       811
        
             ("role", Role.yojson_of_t role);

     
···

       516
       813
        
           ]

     

       517
       814
        
       

     

       518
       815
        
         let t_of_yojson = function

     

       519
       519
       -
           | `Assoc fields as json ->

     

       816
       816
       +
           | `Assoc fields ->

     

       520
       817
        
             let role = match List.assoc_opt "role" fields with

     

       521
       818
        
               | Some json -> Role.t_of_yojson json

     

       522
       522
       -
               | None -> Util.json_error "Missing role field" json

     

       819
       819
       +
               | None -> raise (Json.Of_json ("Missing role field", `Assoc fields))

     

       523
       820
        
             in

     

       524
       524
       -
             let content_obj = match List.assoc_opt "content" fields with

     

       525
       525
       -
               | Some (`Assoc content_fields) -> content_fields

     

       526
       526
       -
               | _ -> Util.json_error "Missing or invalid content field" json

     

       527
       527
       -
             in

     

       528
       528
       -
             let content_type = match List.assoc_opt "type" content_obj with

     

       529
       529
       -
               | Some (`String ty) -> ty

     

       530
       530
       -
               | _ -> Util.json_error "Missing or invalid content type" (`Assoc content_obj)

     

       531
       531
       -
             in

     

       532
       532
       -
             let content = 

     

       533
       533
       -
               match content_type with

     

       534
       534
       -
               | "text" -> `Text (TextContent.t_of_yojson (`Assoc content_obj))

     

       535
       535
       -
               | "image" -> `Image (ImageContent.t_of_yojson (`Assoc content_obj))

     

       536
       536
       -
               | "audio" -> `Audio (AudioContent.t_of_yojson (`Assoc content_obj))

     

       537
       537
       -
               | _ -> Util.json_error "Invalid content type: %s" (`Assoc content_obj) content_type

     

       821
       821
       +
             let content = match List.assoc_opt "content" fields with

     

       822
       822
       +
               | Some (`Assoc content_fields) ->

     

       823
       823
       +
                 (match List.assoc_opt "type" content_fields with

     

       824
       824
       +
                  | Some (`String "text") -> `Text (TextContent.t_of_yojson (`Assoc content_fields))

     

       825
       825
       +
                  | Some (`String "image") -> `Image (ImageContent.t_of_yojson (`Assoc content_fields))

     

       826
       826
       +
                  | _ -> raise (Json.Of_json ("Invalid content type", `Assoc content_fields)))

     

       827
       827
       +
               | _ -> raise (Json.Of_json ("Missing or invalid content field", `Assoc fields))

     

       538
       828
        
             in

     

       539
       829
        
             { role; content }

     

       540
       540
       -
           | j -> Util.json_error "Expected object for SamplingMessage" j

     

       830
       830
       +
           | j -> raise (Json.Of_json ("Expected object for SamplingMessage", j))

     

       541
       831
        
       end

     

       542
       832
        
       

     

       543
       833
        
       (* Implementation info *)

     
···

       555
       845
        
           ]

     

       556
       846
        
       

     

       557
       847
        
         let t_of_yojson = function

     

       558
       558
       -
           | `Assoc fields as json ->

     

       559
       559
       -
             let name = Util.get_string_field fields "name" json in

     

       560
       560
       -
             let version = Util.get_string_field fields "version" json in

     

       848
       848
       +
           | `Assoc fields ->

     

       849
       849
       +
             let name = match List.assoc_opt "name" fields with

     

       850
       850
       +
               | Some (`String s) -> s

     

       851
       851
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'name' field", `Assoc fields))

     

       852
       852
       +
             in

     

       853
       853
       +
             let version = match List.assoc_opt "version" fields with

     

       854
       854
       +
               | Some (`String s) -> s

     

       855
       855
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'version' field", `Assoc fields))

     

       856
       856
       +
             in

     

       561
       857
        
             { name; version }

     

       562
       562
       -
           | j -> Util.json_error "Expected object for Implementation" j

     

       858
       858
       +
           | j -> raise (Json.Of_json ("Expected object for Implementation", j))

     

       563
       859
        
       end

     

       564
       860
        
       

     

       565
       861
        
       (* JSONRPC Message types *)

     

       862
       862
       +
       

     

       566
       863
        
       

     

       567
       864
        
       module JSONRPCMessage = struct

     

       568
       865
        
         type notification = {

     

       569
       569
       -
           meth: Method.t;

     

       866
       866
       +
           method_: string;

     

       570
       867
        
           params: Json.t option;

     

       571
       868
        
         }

     

       572
       869
        
       

     

       573
       870
        
         type request = {

     

       574
       871
        
           id: RequestId.t;

     

       575
       575
       -
           meth: Method.t;

     

       872
       872
       +
           method_: string;

     

       576
       873
        
           params: Json.t option;

     

       577
       874
        
           progress_token: ProgressToken.t option;

     

       578
       875
        
         }

     
···

       598
       895
        
         let yojson_of_notification (n: notification) =

     

       599
       896
        
           let assoc = [

     

       600
       897
        
             ("jsonrpc", `String "2.0");

     

       601
       601
       -
             ("method", `String (Method.to_string n.meth));

     

       898
       898
       +
             ("method", `String n.method_);

     

       602
       899
        
           ] in

     

       603
       900
        
           let assoc = match n.params with

     

       604
       901
        
             | Some params -> ("params", params) :: assoc

     
···

       610
       907
        
           let assoc = [

     

       611
       908
        
             ("jsonrpc", `String "2.0");

     

       612
       909
        
             ("id", Id.yojson_of_t r.id);

     

       613
       613
       -
             ("method", `String (Method.to_string r.meth));

     

       910
       910
       +
             ("method", `String r.method_);

     

       614
       911
        
           ] in

     

       615
       912
        
           let assoc = match r.params with

     

       616
       913
        
             | Some params ->

     
···

       660
       957
        
       

     

       661
       958
        
         let notification_of_yojson = function

     

       662
       959
        
           | `Assoc fields ->

     

       663
       663
       -
             let meth = match List.assoc_opt "method" fields with

     

       664
       664
       -
               | Some (`String s) -> 

     

       665
       665
       -
                   (try Method.of_string s

     

       666
       666
       -
                    with Failure msg -> Util.json_error "%s" (`String s) msg)

     

       667
       667
       -
               | _ -> Util.json_error "Missing or invalid 'method' field" (`Assoc fields)

     

       960
       960
       +
             let method_ = match List.assoc_opt "method" fields with

     

       961
       961
       +
               | Some (`String s) -> s

     

       962
       962
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'method' field", `Assoc fields))

     

       668
       963
        
             in

     

       669
       964
        
             let params = List.assoc_opt "params" fields in

     

       670
       670
       -
             { meth; params }

     

       671
       671
       -
           | j -> Util.json_error "Expected object for notification" j

     

       965
       965
       +
             { method_; params }

     

       966
       966
       +
           | j -> raise (Json.Of_json ("Expected object for notification", j))

     

       672
       967
        
       

     

       673
       968
        
         let request_of_yojson = function

     

       674
       969
        
           | `Assoc fields ->

     

       675
       970
        
             let id = match List.assoc_opt "id" fields with

     

       676
       971
        
               | Some id_json -> Id.t_of_yojson id_json

     

       677
       677
       -
               | _ -> Util.json_error "Missing or invalid 'id' field" (`Assoc fields)

     

       972
       972
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'id' field", `Assoc fields))

     

       678
       973
        
             in

     

       679
       679
       -
             let meth = match List.assoc_opt "method" fields with

     

       680
       680
       -
               | Some (`String s) -> 

     

       681
       681
       -
                   (try Method.of_string s

     

       682
       682
       -
                    with Failure msg -> Util.json_error "%s" (`String s) msg)

     

       683
       683
       -
               | _ -> Util.json_error "Missing or invalid 'method' field" (`Assoc fields)

     

       974
       974
       +
             let method_ = match List.assoc_opt "method" fields with

     

       975
       975
       +
               | Some (`String s) -> s

     

       976
       976
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'method' field", `Assoc fields))

     

       684
       977
        
             in

     

       685
       978
        
             let params = List.assoc_opt "params" fields in

     

       686
       979
        
             let progress_token = 

     
···

       694
       987
        
                  | _ -> None)

     

       695
       988
        
               | _ -> None

     

       696
       989
        
             in

     

       697
       697
       -
             { id; meth; params; progress_token }

     

       698
       698
       -
           | j -> Util.json_error "Expected object for request" j

     

       990
       990
       +
             { id; method_; params; progress_token }

     

       991
       991
       +
           | j -> raise (Json.Of_json ("Expected object for request", j))

     

       699
       992
        
       

     

       700
       993
        
         let response_of_yojson = function

     

       701
       994
        
           | `Assoc fields ->

     

       702
       995
        
             let id = match List.assoc_opt "id" fields with

     

       703
       996
        
               | Some id_json -> Id.t_of_yojson id_json

     

       704
       704
       -
               | _ -> Util.json_error "Missing or invalid 'id' field" (`Assoc fields)

     

       997
       997
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'id' field", `Assoc fields))

     

       705
       998
        
             in

     

       706
       999
        
             let result = match List.assoc_opt "result" fields with

     

       707
       1000
        
               | Some result -> result

     

       708
       708
       -
               | _ -> Util.json_error "Missing 'result' field" (`Assoc fields)

     

       1001
       1001
       +
               | _ -> raise (Json.Of_json ("Missing 'result' field", `Assoc fields))

     

       709
       1002
        
             in

     

       710
       1003
        
             { id; result }

     

       711
       711
       -
           | j -> Util.json_error "Expected object for response" j

     

       1004
       1004
       +
           | j -> raise (Json.Of_json ("Expected object for response", j))

     

       712
       1005
        
       

     

       713
       1006
        
         let error_of_yojson = function

     

       714
       714
       -
           | `Assoc fields as json ->

     

       1007
       1007
       +
           | `Assoc fields ->

     

       715
       1008
        
             let id = match List.assoc_opt "id" fields with

     

       716
       1009
        
               | Some id_json -> Id.t_of_yojson id_json

     

       717
       717
       -
               | _ -> Util.json_error "Missing or invalid 'id' field" json

     

       1010
       1010
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'id' field", `Assoc fields))

     

       718
       1011
        
             in

     

       719
       1012
        
             let error = match List.assoc_opt "error" fields with

     

       720
       1013
        
               | Some (`Assoc error_fields) -> error_fields

     

       721
       721
       -
               | _ -> Util.json_error "Missing or invalid 'error' field" json

     

       1014
       1014
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'error' field", `Assoc fields))

     

       722
       1015
        
             in

     

       723
       1016
        
             let code = match List.assoc_opt "code" error with

     

       724
       1017
        
               | Some (`Int code) -> code

     

       725
       725
       -
               | _ -> Util.json_error "Missing or invalid 'code' field in error" (`Assoc error)

     

       1018
       1018
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'code' field in error", `Assoc error))

     

       726
       1019
        
             in

     

       727
       1020
        
             let message = match List.assoc_opt "message" error with

     

       728
       1021
        
               | Some (`String msg) -> msg

     

       729
       729
       -
               | _ -> Util.json_error "Missing or invalid 'message' field in error" (`Assoc error)

     

       1022
       1022
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'message' field in error", `Assoc error))

     

       730
       1023
        
             in

     

       731
       1024
        
             let data = List.assoc_opt "data" error in

     

       732
       1025
        
             { id; code; message; data }

     

       733
       733
       -
           | j -> Util.json_error "Expected object for error" j

     

       1026
       1026
       +
           | j -> raise (Json.Of_json ("Expected object for error", j))

     

       734
       1027
        
       

     

       735
       1028
        
         let t_of_yojson json =

     

       736
       1029
        
           match json with

     

       737
       1030
        
           | `Assoc fields ->

     

       738
       1031
        
             let _jsonrpc = match List.assoc_opt "jsonrpc" fields with

     

       739
       1032
        
               | Some (`String "2.0") -> ()

     

       740
       740
       -
               | _ -> Util.json_error "Missing or invalid 'jsonrpc' field" json

     

       1033
       1033
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'jsonrpc' field", json))

     

       741
       1034
        
             in

     

       742
       1035
        
             if List.mem_assoc "method" fields then

     

       743
       1036
        
               if List.mem_assoc "id" fields then

     
···

       749
       1042
        
             else if List.mem_assoc "error" fields then

     

       750
       1043
        
               Error (error_of_yojson json)

     

       751
       1044
        
             else

     

       752
       752
       -
               Util.json_error "Invalid JSONRPC message format" json

     

       753
       753
       -
           | j -> Util.json_error "Expected object for JSONRPC message" j

     

       1045
       1045
       +
               raise (Json.Of_json ("Invalid JSONRPC message format", json))

     

       1046
       1046
       +
           | j -> raise (Json.Of_json ("Expected object for JSONRPC message", j))

     

       754
       1047
        
       

     

       755
       755
       -
         let create_notification ?(params=None) ~meth () =

     

       756
       756
       -
           Notification { meth; params }

     

       1048
       1048
       +
         let create_notification ?(params=None) ~method_ () =

     

       1049
       1049
       +
           Notification { method_; params }

     

       757
       1050
        
       

     

       758
       758
       -
         let create_request ?(params=None) ?(progress_token=None) ~id ~meth () =

     

       759
       759
       -
           Request { id; meth; params; progress_token }

     

       1051
       1051
       +
         let create_request ?(params=None) ?(progress_token=None) ~id ~method_ () =

     

       1052
       1052
       +
           Request { id; method_; params; progress_token }

     

       760
       1053
        
       

     

       761
       1054
        
         let create_response ~id ~result =

     

       762
       1055
        
           Response { id; result }

     
···

       783
       1076
        
             ]

     

       784
       1077
        
       

     

       785
       1078
        
           let t_of_yojson = function

     

       786
       786
       -
             | `Assoc fields as json ->

     

       1079
       1079
       +
             | `Assoc fields ->

     

       787
       1080
        
               let capabilities = match List.assoc_opt "capabilities" fields with

     

       788
       1081
        
                 | Some json -> json

     

       789
       789
       -
                 | None -> Util.json_error "Missing capabilities field" json

     

       1082
       1082
       +
                 | None -> raise (Json.Of_json ("Missing capabilities field", `Assoc fields))

     

       790
       1083
        
               in

     

       791
       1084
        
               let client_info = match List.assoc_opt "clientInfo" fields with

     

       792
       1085
        
                 | Some json -> Implementation.t_of_yojson json

     

       793
       793
       -
                 | None -> Util.json_error "Missing clientInfo field" json

     

       1086
       1086
       +
                 | None -> raise (Json.Of_json ("Missing clientInfo field", `Assoc fields))

     

       794
       1087
        
               in

     

       795
       795
       -
               let protocol_version = Util.get_string_field fields "protocolVersion" json in

     

       1088
       1088
       +
               let protocol_version = match List.assoc_opt "protocolVersion" fields with

     

       1089
       1089
       +
                 | Some (`String s) -> s

     

       1090
       1090
       +
                 | _ -> raise (Json.Of_json ("Missing or invalid protocolVersion field", `Assoc fields))

     

       1091
       1091
       +
               in

     

       796
       1092
        
               { capabilities; client_info; protocol_version }

     

       797
       797
       -
             | j -> Util.json_error "Expected object for InitializeRequest" j

     

       1093
       1093
       +
             | j -> raise (Json.Of_json ("Expected object for InitializeRequest", j))

     

       798
       1094
        
       

     

       799
       1095
        
           let create ~capabilities ~client_info ~protocol_version =

     

       800
       1096
        
             { capabilities; client_info; protocol_version }

     

       801
       1097
        
       

     

       802
       1098
        
           let to_jsonrpc ~id t =

     

       803
       1099
        
             let params = yojson_of_t t in

     

       804
       804
       -
             JSONRPCMessage.create_request ~id ~meth:Method.Initialize ~params:(Some params) ()

     

       1100
       1100
       +
             JSONRPCMessage.create_request ~id ~method_:"initialize" ~params:(Some params) ()

     

       805
       1101
        
         end

     

       806
       1102
        
       

     

       807
       1103
        
         module Result = struct

     
···

       830
       1126
        
             `Assoc assoc

     

       831
       1127
        
       

     

       832
       1128
        
           let t_of_yojson = function

     

       833
       833
       -
             | `Assoc fields as json ->

     

       1129
       1129
       +
             | `Assoc fields ->

     

       834
       1130
        
               let capabilities = match List.assoc_opt "capabilities" fields with

     

       835
       1131
        
                 | Some json -> json

     

       836
       836
       -
                 | None -> Util.json_error "Missing capabilities field" json

     

       1132
       1132
       +
                 | None -> raise (Json.Of_json ("Missing capabilities field", `Assoc fields))

     

       837
       1133
        
               in

     

       838
       1134
        
               let server_info = match List.assoc_opt "serverInfo" fields with

     

       839
       1135
        
                 | Some json -> Implementation.t_of_yojson json

     

       840
       840
       -
                 | None -> Util.json_error "Missing serverInfo field" json

     

       1136
       1136
       +
                 | None -> raise (Json.Of_json ("Missing serverInfo field", `Assoc fields))

     

       841
       1137
        
               in

     

       842
       842
       -
               let protocol_version = Util.get_string_field fields "protocolVersion" json in

     

       843
       843
       -
               let instructions = Util.get_optional_string_field fields "instructions" in

     

       1138
       1138
       +
               let protocol_version = match List.assoc_opt "protocolVersion" fields with

     

       1139
       1139
       +
                 | Some (`String s) -> s

     

       1140
       1140
       +
                 | _ -> raise (Json.Of_json ("Missing or invalid protocolVersion field", `Assoc fields))

     

       1141
       1141
       +
               in

     

       1142
       1142
       +
               let instructions = match List.assoc_opt "instructions" fields with

     

       1143
       1143
       +
                 | Some (`String s) -> Some s

     

       1144
       1144
       +
                 | _ -> None

     

       1145
       1145
       +
               in

     

       844
       1146
        
               let meta = List.assoc_opt "_meta" fields in

     

       845
       1147
        
               { capabilities; server_info; protocol_version; instructions; meta }

     

       846
       846
       -
             | j -> Util.json_error "Expected object for InitializeResult" j

     

       1148
       1148
       +
             | j -> raise (Json.Of_json ("Expected object for InitializeResult", j))

     

       847
       1149
        
       

     

       848
       1150
        
           let create ~capabilities ~server_info ~protocol_version ?instructions ?meta () =

     

       849
       1151
        
             { capabilities; server_info; protocol_version; instructions; meta }

     
···

       871
       1173
        
             | `Assoc fields ->

     

       872
       1174
        
               let meta = List.assoc_opt "_meta" fields in

     

       873
       1175
        
               { meta }

     

       874
       874
       -
             | j -> Util.json_error "Expected object for InitializedNotification" j

     

       1176
       1176
       +
             | j -> raise (Json.Of_json ("Expected object for InitializedNotification", j))

     

       875
       1177
        
       

     

       876
       1178
        
           let create ?meta () = { meta }

     

       877
       1179
        
       

     
···

       880
       1182
        
               | `Assoc [] -> None

     

       881
       1183
        
               | json -> Some json

     

       882
       1184
        
             in

     

       883
       883
       -
             JSONRPCMessage.create_notification ~meth:Method.Initialized ~params ()

     

       1185
       1185
       +
             JSONRPCMessage.create_notification ~method_:"notifications/initialized" ~params ()

     

       884
       1186
        
         end

     

       885
       1187
        
       end

     

       886
       886
       -
       

     

       887
       1188
        
       

     

       888
       1189
        
       (* Export the main interface for using the MCP protocol *)

     

       889
       1190
        
       

     

       890
       1191
        
       let parse_message json =

     

       891
       1192
        
         JSONRPCMessage.t_of_yojson json

     

       892
       1193
        
       

     

       893
       893
       -
       let create_notification ?(params=None) ~meth () =

     

       894
       894
       -
         JSONRPCMessage.create_notification ~params ~meth ()

     

       895
       895
       -
       

     

       896
       896
       -
       let create_request ?(params=None) ?(progress_token=None) ~id ~meth () =

     

       897
       897
       -
         JSONRPCMessage.create_request ~params ~progress_token ~id ~meth ()

     

       898
       898
       -
       

     

       1194
       1194
       +
       let create_notification = JSONRPCMessage.create_notification

     

       1195
       1195
       +
       let create_request = JSONRPCMessage.create_request

     

       899
       1196
        
       let create_response = JSONRPCMessage.create_response

     

       900
       1197
        
       let create_error = JSONRPCMessage.create_error

     

       901
       1198
        
       

     

       902
       902
       -
       (* Content type constructors *)

     

       903
       903
       -
       let make_text_content text =

     

       904
       904
       -
         Text (TextContent.{ text; annotations = None })

     

       905
       905
       -
       

     

       906
       906
       -
       let make_image_content data mime_type =

     

       907
       907
       -
         Image (ImageContent.{ data; mime_type; annotations = None })

     

       908
       908
       -
       

     

       909
       909
       -
       let make_audio_content data mime_type =

     

       910
       910
       -
         Audio (AudioContent.{ data; mime_type; annotations = None })

     

       911
       911
       -
       

     

       912
       912
       -
       let make_resource_text_content uri text mime_type =

     

       913
       913
       -
         Resource (EmbeddedResource.{

     

       914
       914
       -
           resource = `Text TextResourceContents.{ uri; text; mime_type };

     

       915
       915
       -
           annotations = None;

     

       916
       916
       -
         })

     

       917
       917
       -
       

     

       918
       918
       -
       let make_resource_blob_content uri blob mime_type =

     

       919
       919
       -
         Resource (EmbeddedResource.{

     

       920
       920
       -
           resource = `Blob BlobResourceContents.{ uri; blob; mime_type };

     

       921
       921
       -
           annotations = None;

     

       922
       922
       -
         })
     

       1199
       1199
       +
       (* Helper functions *)

     

       1200
       1200
       +
       let create_completion_request ~id ~argument ~ref =

     

       1201
       1201
       +
         let params = Completion.Request.to_params { argument; ref } in

     

       1202
       1202
       +
         create_request ~id ~method_:"completion/complete" ~params:(Some params) ()

     

       1203
       1203
       +
         

     

       1204
       1204
       +
       let create_completion_response ~id ~values ?(has_more=None) ?(total=None) ?(meta=None) () =

     

       1205
       1205
       +
         let completion = { Completion.Result.values; has_more; total } in

     

       1206
       1206
       +
         let result = Completion.Result.to_result { completion; meta } in

     

       1207
       1207
       +
         create_response ~id ~result

+219 -887

lib/mcp.mli

···

       1
       1
       -
       (** MCP - Model Context Protocol implementation 

     

       2
       2
       -
           

     

       3
       3
       -
           The Model Context Protocol (MCP) is a standardized protocol for AI agents to exchange context

     

       4
       4
       -
           with servers. This module provides the core OCaml implementation of MCP including

     

       5
       5
       -
           all message types, content representations, and serialization functionality.

     

       6
       6
       -
           

     

       7
       7
       -
           MCP Architecture:

     

       8
       8
       -
           - Uses JSON-RPC 2.0 as its underlying message format with UTF-8 encoding

     

       9
       9
       -
           - Follows a client-server model where clients (often LLM-integrated applications) communicate with MCP servers

     

       10
       10
       -
           - Supports multiple transport methods including stdio and streamable HTTP

     

       11
       11
       -
           - Implements a three-phase connection lifecycle: initialization, operation, and shutdown

     

       12
       12
       -
           - Provides capability negotiation during initialization to determine available features

     

       13
       13
       -
           - Offers four primary context exchange mechanisms:

     

       14
       14
       -
             1. Resources: Server-exposed data that provides context to language models

     

       15
       15
       -
             2. Tools: Server-exposed functionality that can be invoked by language models

     

       16
       16
       -
             3. Prompts: Server-defined templates for structuring interactions with models

     

       17
       17
       -
             4. Sampling: Client-exposed ability to generate completions from LLMs

     

       18
       18
       -
           - Supports multimodal content types: text, images, audio, and embedded resources

     

       19
       19
       -
           - Includes standardized error handling with defined error codes

     

       20
       20
       -
           

     

       21
       21
       -
           This implementation follows Protocol Revision 2025-03-26.

     

       22
       22
       -
       *)

     

       1
       1
       +
       (** MCP - Model Context Protocol implementation *)

     

       23
       2
        
       

     

       24
       3
        
       open Jsonrpc

     

       25
       4
        
       

     

       26
       26
       -
       (** Utility functions for JSON parsing *)

     

       27
       27
       -
       module Util : sig

     

       28
       28
       -
         (** Helper to raise a Json.Of_json exception with formatted message

     

       29
       29
       -
             @param fmt Format string for the error message

     

       30
       30
       -
             @param json JSON value to include in the exception

     

       31
       31
       -
             @return Never returns, always raises an exception

     

       32
       32
       -
             @raise Json.Of_json with the formatted message and JSON value

     

       33
       33
       -
         *)

     

       34
       34
       -
         val json_error : ('a, unit, string, 'b) format4 -> Json.t -> 'a

     

       35
       35
       -
         

     

       36
       36
       -
         (** Extract a string field from JSON object or raise an error 

     

       37
       37
       -
             @param fields Assoc list of fields from JSON object

     

       38
       38
       -
             @param name Field name to extract

     

       39
       39
       -
             @param json Original JSON for error context

     

       40
       40
       -
             @return The string value of the field

     

       41
       41
       -
             @raise Json.Of_json if the field is missing or not a string

     

       42
       42
       -
         *)

     

       43
       43
       -
         val get_string_field : (string * Json.t) list -> string -> Json.t -> string

     

       44
       44
       -
         

     

       45
       45
       -
         (** Extract an optional string field from JSON object

     

       46
       46
       -
             @param fields Assoc list of fields from JSON object

     

       47
       47
       -
             @param name Field name to extract

     

       48
       48
       -
             @return Some string if present and a string, None if missing

     

       49
       49
       -
             @raise Json.Of_json if the field exists but is not a string

     

       50
       50
       -
         *)

     

       51
       51
       -
         val get_optional_string_field : (string * Json.t) list -> string -> string option

     

       52
       52
       -
         

     

       53
       53
       -
         (** Extract an int field from JSON object or raise an error

     

       54
       54
       -
             @param fields Assoc list of fields from JSON object

     

       55
       55
       -
             @param name Field name to extract

     

       56
       56
       -
             @param json Original JSON for error context

     

       57
       57
       -
             @return The int value of the field

     

       58
       58
       -
             @raise Json.Of_json if the field is missing or not an int

     

       59
       59
       -
         *)

     

       60
       60
       -
         val get_int_field : (string * Json.t) list -> string -> Json.t -> int

     

       61
       61
       -
         

     

       62
       62
       -
         (** Extract a float field from JSON object or raise an error

     

       63
       63
       -
             @param fields Assoc list of fields from JSON object

     

       64
       64
       -
             @param name Field name to extract

     

       65
       65
       -
             @param json Original JSON for error context

     

       66
       66
       -
             @return The float value of the field

     

       67
       67
       -
             @raise Json.Of_json if the field is missing or not a float

     

       68
       68
       -
         *)

     

       69
       69
       -
         val get_float_field : (string * Json.t) list -> string -> Json.t -> float

     

       70
       70
       -
         

     

       71
       71
       -
         (** Extract a boolean field from JSON object or raise an error

     

       72
       72
       -
             @param fields Assoc list of fields from JSON object

     

       73
       73
       -
             @param name Field name to extract

     

       74
       74
       -
             @param json Original JSON for error context

     

       75
       75
       -
             @return The boolean value of the field

     

       76
       76
       -
             @raise Json.Of_json if the field is missing or not a boolean

     

       77
       77
       -
         *)

     

       78
       78
       -
         val get_bool_field : (string * Json.t) list -> string -> Json.t -> bool

     

       79
       79
       -
         

     

       80
       80
       -
         (** Extract an object field from JSON object or raise an error

     

       81
       81
       -
             @param fields Assoc list of fields from JSON object

     

       82
       82
       -
             @param name Field name to extract

     

       83
       83
       -
             @param json Original JSON for error context

     

       84
       84
       -
             @return The object as an assoc list

     

       85
       85
       -
             @raise Json.Of_json if the field is missing or not an object

     

       86
       86
       -
         *)

     

       87
       87
       -
         val get_object_field : (string * Json.t) list -> string -> Json.t -> (string * Json.t) list

     

       88
       88
       -
         

     

       89
       89
       -
         (** Extract a list field from JSON object or raise an error

     

       90
       90
       -
             @param fields Assoc list of fields from JSON object

     

       91
       91
       -
             @param name Field name to extract

     

       92
       92
       -
             @param json Original JSON for error context

     

       93
       93
       -
             @return The list items

     

       94
       94
       -
             @raise Json.Of_json if the field is missing or not a list

     

       95
       95
       -
         *)

     

       96
       96
       -
         val get_list_field : (string * Json.t) list -> string -> Json.t -> Json.t list

     

       97
       97
       -
         

     

       98
       98
       -
         (** Verify a specific string value in a field

     

       99
       99
       -
             @param fields Assoc list of fields from JSON object

     

       100
       100
       -
             @param name Field name to check

     

       101
       101
       -
             @param expected_value The expected string value

     

       102
       102
       -
             @param json Original JSON for error context

     

       103
       103
       -
             @raise Json.Of_json if the field is missing or not equal to expected_value

     

       104
       104
       -
         *)

     

       105
       105
       -
         val verify_string_field : (string * Json.t) list -> string -> string -> Json.t -> unit

     

       106
       106
       -
       end

     

       107
       107
       -
       

     

       108
       108
       -
       (** Error codes for JSON-RPC *)

     

       5
       5
       +
       (** Standard error codes *)

     

       109
       6
        
       module ErrorCode : sig

     

       110
       110
       -
         (** Standard JSON-RPC error codes with MCP-specific additions *)

     

       111
       111
       -
         type t = 

     

       112
       112
       -
           | ParseError       (** -32700 - Invalid JSON *)

     

       113
       113
       -
           | InvalidRequest   (** -32600 - Invalid JSON-RPC request *)

     

       114
       114
       -
           | MethodNotFound   (** -32601 - Method not available *)

     

       115
       115
       -
           | InvalidParams    (** -32602 - Invalid method parameters *)

     

       116
       116
       -
           | InternalError    (** -32603 - Internal JSON-RPC error *)

     

       117
       117
       -
           | ResourceNotFound (** -32002 - Custom MCP error: requested resource not found *)

     

       118
       118
       -
           | AuthRequired     (** -32001 - Custom MCP error: authentication required *)

     

       119
       119
       -
           | CustomError of int (** For any other error codes *)

     

       120
       120
       -
         

     

       121
       121
       -
         (** Convert the error code to its integer representation

     

       122
       122
       -
             @param code The error code to convert

     

       123
       123
       -
             @return The integer error code as defined in the JSON-RPC spec

     

       124
       124
       -
         *)

     

       125
       125
       -
         val to_int : t -> int

     

       126
       126
       -
         

     

       127
       127
       -
         (** Get error message for standard error codes

     

       128
       128
       -
             @param code The error code to get message for

     

       129
       129
       -
             @return A standard message for the error code

     

       130
       130
       -
         *)

     

       131
       131
       -
         val to_message : t -> string

     

       7
       7
       +
         val parse_error : int

     

       8
       8
       +
         val invalid_request : int

     

       9
       9
       +
         val method_not_found : int

     

       10
       10
       +
         val invalid_params : int

     

       11
       11
       +
         val internal_error : int

     

       12
       12
       +
         val resource_not_found : int

     

       13
       13
       +
         val server_error_start : int

     

       14
       14
       +
         val server_error_end : int

     

       132
       15
        
       end

     

       133
       16
        
       

     

       134
       134
       -
       (** MCP Protocol Methods - Algebraic data type representing all MCP methods *)

     

       135
       135
       -
       module Method : sig

     

       136
       136
       -
         (** Method type representing all MCP protocol methods *)

     

       137
       137
       -
         type t =

     

       138
       138
       -
           (* Initialization and lifecycle methods *)

     

       139
       139
       -
           | Initialize      (** Start the MCP lifecycle *)

     

       140
       140
       -
           | Initialized     (** Signal readiness after initialization *)

     

       141
       141
       -
           

     

       142
       142
       -
           (* Resource methods *)

     

       143
       143
       -
           | ResourcesList           (** Discover available resources *)

     

       144
       144
       -
           | ResourcesRead           (** Retrieve resource contents *)

     

       145
       145
       -
           | ResourceTemplatesList  (** List available resource templates *)

     

       146
       146
       -
           | ResourcesSubscribe      (** Subscribe to resource changes *)

     

       147
       147
       -
           | ResourcesListChanged    (** Resource list has changed *)

     

       148
       148
       -
           | ResourcesUpdated        (** Resource has been updated *)

     

       149
       149
       -
           

     

       150
       150
       -
           (* Tool methods *)

     

       151
       151
       -
           | ToolsList        (** Discover available tools *)

     

       152
       152
       -
           | ToolsCall        (** Invoke a tool *)

     

       153
       153
       -
           | ToolsListChanged (** Tool list has changed *)

     

       154
       154
       -
           

     

       155
       155
       -
           (* Prompt methods *)

     

       156
       156
       -
           | PromptsList        (** Discover available prompts *)

     

       157
       157
       -
           | PromptsGet         (** Retrieve a prompt template with arguments *)

     

       158
       158
       -
           | PromptsListChanged (** Prompt list has changed *)

     

       159
       159
       -
           

     

       160
       160
       -
           (* Progress notifications *)

     

       161
       161
       -
           | Progress         (** Progress update for long-running operations *)

     

       162
       162
       -
         

     

       163
       163
       -
         (** Convert method type to string representation

     

       164
       164
       -
             @param meth The method to convert

     

       165
       165
       -
             @return The string representation of the method (e.g., "initialize", "resources/list")

     

       166
       166
       -
         *)

     

       167
       167
       -
         val to_string : t -> string

     

       168
       168
       -
         

     

       169
       169
       -
         (** Convert string to method type

     

       170
       170
       -
             @param s The string representation of the method

     

       171
       171
       -
             @return The corresponding method type

     

       172
       172
       -
             @raise Failure if the string is not a valid MCP method

     

       173
       173
       -
         *)

     

       174
       174
       -
         val of_string : string -> t

     

       175
       175
       -
       end

     

       176
       176
       -
       

     

       177
       177
       -
       

     

       178
       17
        
       (** Common types *)

     

       179
       18
        
       

     

       180
       19
        
       (** Roles for conversation participants *)

     

       181
       20
        
       module Role : sig

     

       182
       182
       -
         (** Role represents conversation participants in MCP messages.

     

       183
       183
       -
             Roles can be either 'user' or 'assistant', determining the

     

       184
       184
       -
             source of each message in a conversation. *)

     

       185
       21
        
         type t = [ `User | `Assistant ]

     

       186
       186
       -
         include Json.Jsonable.S with type t := t

     

       22
       22
       +
       

     

       23
       23
       +
         val to_string : t -> string

     

       24
       24
       +
         val of_string : string -> t

     

       25
       25
       +
       

     

       26
       26
       +
         val yojson_of_t : t -> Json.t

     

       27
       27
       +
         val t_of_yojson : Json.t -> t

     

       187
       28
        
       end

     

       188
       29
        
       

     

       189
       30
        
       (** Progress tokens for long-running operations *)

     

       190
       31
        
       module ProgressToken : sig

     

       191
       191
       -
         (** Progress tokens identify long-running operations and enable

     

       192
       192
       -
             servers to provide progress updates to clients. This is used

     

       193
       193
       -
             to track operations that may take significant time to complete. *)

     

       194
       32
        
         type t = [ `String of string | `Int of int ]

     

       33
       33
       +
       

     

       195
       34
        
         include Json.Jsonable.S with type t := t

     

       196
       35
        
       end

     

       197
       36
        
       

     

       198
       37
        
       (** Request IDs *)

     

       199
       38
        
       module RequestId : sig

     

       200
       200
       -
         (** Request IDs uniquely identify JSON-RPC requests, allowing responses

     

       201
       201
       -
             to be correlated with their originating requests. They can be either

     

       202
       202
       -
             string or integer values. *)

     

       203
       39
        
         type t = [ `String of string | `Int of int ]

     

       40
       40
       +
       

     

       204
       41
        
         include Json.Jsonable.S with type t := t

     

       205
       42
        
       end

     

       206
       43
        
       

     

       207
       44
        
       (** Cursors for pagination *)

     

       208
       45
        
       module Cursor : sig

     

       209
       209
       -
         (** Cursors enable pagination in list operations for resources, tools, and prompts.

     

       210
       210
       -
             When a server has more items than can be returned in a single response,

     

       211
       211
       -
             it provides a cursor for the client to retrieve subsequent pages. *)

     

       212
       46
        
         type t = string

     

       213
       213
       -
         include Json.Jsonable.S with type t := t

     

       47
       47
       +
       

     

       48
       48
       +
         val yojson_of_t : t -> Json.t

     

       49
       49
       +
         val t_of_yojson : Json.t -> t

     

       214
       50
        
       end

     

       215
       51
        
       

     

       216
       52
        
       (** Annotations for objects *)

     

       217
       53
        
       module Annotated : sig

     

       218
       218
       -
         (** Annotations provide metadata for content objects, allowing

     

       219
       219
       -
             role-specific targeting and priority settings. *)

     

       220
       54
        
         type t = {

     

       221
       55
        
           annotations: annotation option;

     

       222
       56
        
         }

     

       223
       57
        
         and annotation = {

     

       224
       58
        
           audience: Role.t list option;

     

       225
       225
       -
           (** Optional list of roles that should receive this content *)

     

       226
       59
        
           priority: float option;

     

       227
       227
       -
           (** Optional priority value for this content *)

     

       228
       60
        
         }

     

       229
       229
       -
         include Json.Jsonable.S with type t := t

     

       61
       61
       +
       

     

       62
       62
       +
         val yojson_of_annotation : annotation -> Json.t

     

       63
       63
       +
         val annotation_of_yojson : Json.t -> annotation

     

       64
       64
       +
       

     

       65
       65
       +
         val yojson_of_t : t -> Json.t

     

       66
       66
       +
         val t_of_yojson : Json.t -> t

     

       230
       67
        
       end

     

       231
       68
        
       

     

       232
       232
       -
       (** Text content - Core textual message representation in MCP *)

     

       69
       69
       +
       (** Text content *)

     

       233
       70
        
       module TextContent : sig

     

       234
       234
       -
         (** TextContent represents plain text messages in MCP conversations.

     

       235
       235
       -
             This is the most common content type used for natural language interactions 

     

       236
       236
       -
             between users and assistants. Text content is used in prompts, tool results,

     

       237
       237
       -
             and model responses.

     

       238
       238
       -
             

     

       239
       239
       -
             In JSON-RPC, this is represented as:

     

       240
       240
       -
             {v

     

       241
       241
       -
             {

     

       242
       242
       -
               "type": "text",

     

       243
       243
       -
               "text": "The text content of the message"

     

       244
       244
       -
             }

     

       245
       245
       -
             v}

     

       246
       246
       -
             

     

       247
       247
       -
             For security, implementations must sanitize text content to prevent

     

       248
       248
       -
             injection attacks or unauthorized access to resources. *)

     

       249
       71
        
         type t = {

     

       250
       72
        
           text: string;

     

       251
       251
       -
           (** The actual text content as a UTF-8 encoded string *)

     

       252
       73
        
           annotations: Annotated.annotation option;

     

       253
       253
       -
           (** Optional annotations for audience targeting and priority.

     

       254
       254
       -
               Annotations can restrict content visibility to specific roles (user/assistant)

     

       255
       255
       -
               and indicate relative importance of different content elements. *)

     

       256
       74
        
         }

     

       257
       257
       -
         include Json.Jsonable.S with type t := t

     

       75
       75
       +
       

     

       76
       76
       +
         val yojson_of_t : t -> Json.t

     

       77
       77
       +
         val t_of_yojson : Json.t -> t

     

       258
       78
        
       end

     

       259
       79
        
       

     

       260
       260
       -
       (** Image content - Visual data representation in MCP *)

     

       80
       80
       +
       (** Image content *)

     

       261
       81
        
       module ImageContent : sig

     

       262
       262
       -
         (** ImageContent enables including visual information in MCP messages,

     

       263
       263
       -
             supporting multimodal interactions where visual context is important.

     

       264
       264
       -
             

     

       265
       265
       -
             Images can be used in several scenarios:

     

       266
       266
       -
             - As user inputs for visual understanding tasks

     

       267
       267
       -
             - As context for generating descriptions or analysis

     

       268
       268
       -
             - As outputs from tools that generate visualizations

     

       269
       269
       -
             - As part of prompt templates with visual components

     

       270
       270
       -
             

     

       271
       271
       -
             In JSON-RPC, this is represented as:

     

       272
       272
       -
             {v

     

       273
       273
       -
             {

     

       274
       274
       -
               "type": "image",

     

       275
       275
       -
               "data": "base64-encoded-image-data",

     

       276
       276
       -
               "mimeType": "image/png"

     

       277
       277
       -
             }

     

       278
       278
       -
             v}

     

       279
       279
       -
             

     

       280
       280
       -
             The data MUST be base64-encoded to ensure safe transmission in JSON.

     

       281
       281
       -
             Common mime types include image/png, image/jpeg, image/gif, and image/svg+xml. *)

     

       282
       82
        
         type t = {

     

       283
       83
        
           data: string;

     

       284
       284
       -
           (** Base64-encoded image data. All binary image data must be encoded using

     

       285
       285
       -
               standard base64 encoding (RFC 4648) to safely transmit within JSON. *)

     

       286
       84
        
           mime_type: string;

     

       287
       287
       -
           (** MIME type of the image (e.g., "image/png", "image/jpeg", "image/gif", "image/svg+xml").

     

       288
       288
       -
               This field is required and must accurately represent the image format to ensure

     

       289
       289
       -
               proper handling by clients. *)

     

       290
       85
        
           annotations: Annotated.annotation option;

     

       291
       291
       -
           (** Optional annotations for audience targeting and priority.

     

       292
       292
       -
               Annotations can restrict content visibility to specific roles (user/assistant)

     

       293
       293
       -
               and indicate relative importance of different content elements. *)

     

       294
       86
        
         }

     

       295
       295
       -
         include Json.Jsonable.S with type t := t

     

       87
       87
       +
       

     

       88
       88
       +
         val yojson_of_t : t -> Json.t

     

       89
       89
       +
         val t_of_yojson : Json.t -> t

     

       296
       90
        
       end

     

       297
       91
        
       

     

       298
       298
       -
       (** Audio content - Sound data representation in MCP *)

     

       92
       92
       +
       (** Audio content *)

     

       299
       93
        
       module AudioContent : sig

     

       300
       300
       -
         (** AudioContent enables including audio information in MCP messages,

     

       301
       301
       -
             supporting multimodal interactions where audio context is important.

     

       302
       302
       -
             

     

       303
       303
       -
             Audio can be used in several scenarios:

     

       304
       304
       -
             - As user inputs for speech recognition or audio analysis

     

       305
       305
       -
             - As context for transcription or sound classification tasks

     

       306
       306
       -
             - As outputs from tools that generate audio samples

     

       307
       307
       -
             - As part of prompt templates with audio components

     

       308
       308
       -
             

     

       309
       309
       -
             In JSON-RPC, this is represented as:

     

       310
       310
       -
             {v

     

       311
       311
       -
             {

     

       312
       312
       -
               "type": "audio",

     

       313
       313
       -
               "data": "base64-encoded-audio-data",

     

       314
       314
       -
               "mimeType": "audio/wav"

     

       315
       315
       -
             }

     

       316
       316
       -
             v}

     

       317
       317
       -
             

     

       318
       318
       -
             The data MUST be base64-encoded to ensure safe transmission in JSON.

     

       319
       319
       -
             Common mime types include audio/wav, audio/mp3, audio/ogg, and audio/mpeg. *)

     

       320
       94
        
         type t = {

     

       321
       95
        
           data: string;

     

       322
       322
       -
           (** Base64-encoded audio data. All binary audio data must be encoded using

     

       323
       323
       -
               standard base64 encoding (RFC 4648) to safely transmit within JSON. *)

     

       324
       96
        
           mime_type: string;

     

       325
       325
       -
           (** MIME type of the audio (e.g., "audio/wav", "audio/mp3", "audio/ogg", "audio/mpeg").

     

       326
       326
       -
               This field is required and must accurately represent the audio format to ensure

     

       327
       327
       -
               proper handling by clients. *)

     

       328
       97
        
           annotations: Annotated.annotation option;

     

       329
       329
       -
           (** Optional annotations for audience targeting and priority.

     

       330
       330
       -
               Annotations can restrict content visibility to specific roles (user/assistant)

     

       331
       331
       -
               and indicate relative importance of different content elements. *)

     

       332
       98
        
         }

     

       333
       333
       -
         include Json.Jsonable.S with type t := t

     

       99
       99
       +
       

     

       100
       100
       +
         val yojson_of_t : t -> Json.t

     

       101
       101
       +
         val t_of_yojson : Json.t -> t

     

       334
       102
        
       end

     

       335
       103
        
       

     

       336
       336
       -
       (** Base resource contents - Core resource metadata in MCP *)

     

       104
       104
       +
       (** Base resource contents *)

     

       337
       105
        
       module ResourceContents : sig

     

       338
       338
       -
         (** ResourceContents provides basic metadata for resources in MCP.

     

       339
       339
       -
             

     

       340
       340
       -
             Resources are server-exposed data that provides context to language models,

     

       341
       341
       -
             such as files, database schemas, or application-specific information.

     

       342
       342
       -
             Each resource is uniquely identified by a URI.

     

       343
       343
       -
             

     

       344
       344
       -
             The MCP resources architecture is designed to be application-driven, with

     

       345
       345
       -
             host applications determining how to incorporate context based on their needs.

     

       346
       346
       -
             

     

       347
       347
       -
             In the protocol, resources are discovered via the 'resources/list' endpoint

     

       348
       348
       -
             and retrieved via the 'resources/read' endpoint. Servers that support resources

     

       349
       349
       -
             must declare the 'resources' capability during initialization. *)

     

       350
       106
        
         type t = {

     

       351
       107
        
           uri: string;

     

       352
       352
       -
           (** URI that uniquely identifies the resource.

     

       353
       353
       -
               

     

       354
       354
       -
               Resources use standard URI schemes including:

     

       355
       355
       -
               - file:// - For filesystem-like resources

     

       356
       356
       -
               - https:// - For web-accessible resources

     

       357
       357
       -
               - git:// - For version control integration

     

       358
       358
       -
               

     

       359
       359
       -
               The URI serves as a stable identifier even if the underlying content changes. *)

     

       360
       108
        
           mime_type: string option;

     

       361
       361
       -
           (** Optional MIME type of the resource content to aid in client rendering.

     

       362
       362
       -
               Common MIME types include text/plain, application/json, image/png, etc.

     

       363
       363
       -
               For directories, the XDG MIME type inode/directory may be used. *)

     

       364
       109
        
         }

     

       365
       365
       -
         include Json.Jsonable.S with type t := t

     

       110
       110
       +
       

     

       111
       111
       +
         val yojson_of_t : t -> Json.t

     

       112
       112
       +
         val t_of_yojson : Json.t -> t

     

       366
       113
        
       end

     

       367
       114
        
       

     

       368
       368
       -
       (** Text resource contents - Textual resource data *)

     

       115
       115
       +
       (** Text resource contents *)

     

       369
       116
        
       module TextResourceContents : sig

     

       370
       370
       -
         (** TextResourceContents represents a text-based resource in MCP.

     

       371
       371
       -
             

     

       372
       372
       -
             Text resources are used for sharing code snippets, documentation, logs,

     

       373
       373
       -
             configuration files, and other textual information with language models.

     

       374
       374
       -
             

     

       375
       375
       -
             The server handles access control and security, ensuring that only

     

       376
       376
       -
             authorized resources are shared with clients.

     

       377
       377
       -
             

     

       378
       378
       -
             In JSON-RPC, this is represented as:

     

       379
       379
       -
             {v

     

       380
       380
       -
             {

     

       381
       381
       -
               "uri": "file:///example.txt",

     

       382
       382
       -
               "mimeType": "text/plain",

     

       383
       383
       -
               "text": "Resource content"

     

       384
       384
       -
             }

     

       385
       385
       -
             v}

     

       386
       386
       -
             *)

     

       387
       117
        
         type t = {

     

       388
       118
        
           uri: string;

     

       389
       389
       -
           (** URI that uniquely identifies the resource.

     

       390
       390
       -
               This URI can be referenced in subsequent requests to fetch updates. *)

     

       391
       119
        
           text: string;

     

       392
       392
       -
           (** The actual text content of the resource as a UTF-8 encoded string.

     

       393
       393
       -
               This may be sanitized by the server to remove sensitive information. *)

     

       394
       120
        
           mime_type: string option;

     

       395
       395
       -
           (** Optional MIME type of the text content to aid in client rendering.

     

       396
       396
       -
               Common text MIME types include: text/plain, text/markdown, text/x-python, 

     

       397
       397
       -
               application/json, text/html, text/csv, etc. *)

     

       398
       121
        
         }

     

       399
       399
       -
         include Json.Jsonable.S with type t := t

     

       122
       122
       +
       

     

       123
       123
       +
         val yojson_of_t : t -> Json.t

     

       124
       124
       +
         val t_of_yojson : Json.t -> t

     

       400
       125
        
       end

     

       401
       126
        
       

     

       402
       402
       -
       (** Binary resource contents - Binary resource data *)

     

       127
       127
       +
       (** Binary resource contents *)

     

       403
       128
        
       module BlobResourceContents : sig

     

       404
       404
       -
         (** BlobResourceContents represents a binary resource in MCP.

     

       405
       405
       -
             

     

       406
       406
       -
             Binary resources allow sharing non-textual data like images, audio files,

     

       407
       407
       -
             PDFs, and other binary formats with language models that support processing

     

       408
       408
       -
             such content.

     

       409
       409
       -
             

     

       410
       410
       -
             In JSON-RPC, this is represented as:

     

       411
       411
       -
             {v

     

       412
       412
       -
             {

     

       413
       413
       -
               "uri": "file:///example.png",

     

       414
       414
       -
               "mimeType": "image/png",

     

       415
       415
       -
               "blob": "base64-encoded-data"

     

       416
       416
       -
             }

     

       417
       417
       -
             v}

     

       418
       418
       -
             

     

       419
       419
       -
             Binary data MUST be properly base64-encoded to ensure safe transmission

     

       420
       420
       -
             in JSON payloads. *)

     

       421
       129
        
         type t = {

     

       422
       130
        
           uri: string;

     

       423
       423
       -
           (** URI that uniquely identifies the resource.

     

       424
       424
       -
               This URI can be referenced in subsequent requests to fetch updates. *)

     

       425
       131
        
           blob: string;

     

       426
       426
       -
           (** Base64-encoded binary data using standard base64 encoding (RFC 4648).

     

       427
       427
       -
               This encoding ensures that binary data can be safely transmitted in JSON. *)

     

       428
       132
        
           mime_type: string option;

     

       429
       429
       -
           (** Optional MIME type of the binary content to aid in client rendering.

     

       430
       430
       -
               Common binary MIME types include: image/png, image/jpeg, application/pdf, 

     

       431
       431
       -
               audio/wav, video/mp4, application/octet-stream, etc. *)

     

       432
       133
        
         }

     

       433
       433
       -
         include Json.Jsonable.S with type t := t

     

       134
       134
       +
       

     

       135
       135
       +
         val yojson_of_t : t -> Json.t

     

       136
       136
       +
         val t_of_yojson : Json.t -> t

     

       434
       137
        
       end

     

       435
       138
        
       

     

       436
       436
       -
       (** Embedded resource - Resource included directly in messages *)

     

       139
       139
       +
       (** Embedded resource *)

     

       437
       140
        
       module EmbeddedResource : sig

     

       438
       438
       -
         (** EmbeddedResource allows referencing server-side resources directly

     

       439
       439
       -
             in MCP messages, enabling seamless incorporation of managed content.

     

       440
       440
       -
             

     

       441
       441
       -
             Embedded resources can be included in:

     

       442
       442
       -
             - Tool results to provide rich context

     

       443
       443
       -
             - Prompt templates to include reference materials

     

       444
       444
       -
             - Messages to provide additional context to language models

     

       445
       445
       -
             

     

       446
       446
       -
             In contrast to direct content (TextContent, ImageContent, AudioContent),

     

       447
       447
       -
             embedded resources have the advantage of being persistently stored on the server

     

       448
       448
       -
             with a stable URI, allowing later retrieval and updates through the resources API.

     

       449
       449
       -
             

     

       450
       450
       -
             For example, a tool might return an embedded resource containing a chart or

     

       451
       451
       -
             a large dataset that the client can later reference or update. *)

     

       452
       141
        
         type t = {

     

       453
       142
        
           resource: [ `Text of TextResourceContents.t | `Blob of BlobResourceContents.t ];

     

       454
       454
       -
           (** The resource content, either as text or binary blob. *)

     

       455
       143
        
           annotations: Annotated.annotation option;

     

       456
       456
       -
           (** Optional annotations for audience targeting and priority.

     

       457
       457
       -
               Annotations can restrict resource visibility to specific roles (user/assistant)

     

       458
       458
       -
               and indicate relative importance of different content elements. *)

     

       459
       144
        
         }

     

       460
       460
       -
         include Json.Jsonable.S with type t := t

     

       145
       145
       +
       

     

       146
       146
       +
         val yojson_of_t : t -> Json.t

     

       147
       147
       +
         val t_of_yojson : Json.t -> t

     

       461
       148
        
       end

     

       462
       149
        
       

     

       463
       463
       -
       (** Content type used in messages - Unified multimodal content representation in MCP *)

     

       150
       150
       +
       (** Content type used in messages *)

     

       464
       151
        
       type content = 

     

       465
       465
       -
         | Text of TextContent.t    (** Text content for natural language messages. This is the most common content type for user-assistant interactions. *)

     

       466
       466
       -
         | Image of ImageContent.t  (** Image content for visual data. Used for sharing visual context in multimodal conversations. *)

     

       467
       467
       -
         | Audio of AudioContent.t  (** Audio content for audio data. Used for sharing audio context in multimodal conversations. *)

     

       468
       468
       -
         | Resource of EmbeddedResource.t  (** Resource content for referencing server-side resources. Used for incorporating managed server content with stable URIs. *)

     

       152
       152
       +
         | Text of TextContent.t

     

       153
       153
       +
         | Image of ImageContent.t

     

       154
       154
       +
         | Audio of AudioContent.t

     

       155
       155
       +
         | Resource of EmbeddedResource.t

     

       469
       156
        
       

     

       470
       470
       -
       (** Convert content to Yojson representation 

     

       471
       471
       -
           @param content The content to convert

     

       472
       472
       -
           @return JSON representation of the content

     

       473
       473
       -
       *)

     

       474
       157
        
       val yojson_of_content : content -> Json.t

     

       475
       475
       -
       

     

       476
       476
       -
       (** Convert Yojson representation to content 

     

       477
       477
       -
           @param json JSON representation of content

     

       478
       478
       -
           @return Parsed content object

     

       479
       479
       -
       *)

     

       480
       158
        
       val content_of_yojson : Json.t -> content

     

       481
       159
        
       

     

       482
       482
       -
       (** Message for prompts - Template messages in the MCP prompts feature *)

     

       160
       160
       +
       (** Message for prompts *)

     

       483
       161
        
       module PromptMessage : sig

     

       484
       484
       -
         (** PromptMessage represents a message in an MCP prompt template,

     

       485
       485
       -
             containing a role and content which can be customized with arguments.

     

       486
       486
       -
             

     

       487
       487
       -
             Prompt messages are part of prompt templates exposed by servers through

     

       488
       488
       -
             the prompts/get endpoint. They define structured conversation templates

     

       489
       489
       -
             that can be instantiated with user-provided arguments.

     

       490
       490
       -
             

     

       491
       491
       -
             The prompt feature is designed to be user-controlled, with prompts typically

     

       492
       492
       -
             exposed through UI elements like slash commands that users can explicitly select.

     

       493
       493
       -
             

     

       494
       494
       -
             In JSON-RPC, prompt messages are represented as:

     

       495
       495
       -
             {v

     

       496
       496
       -
             {

     

       497
       497
       -
               "role": "user",

     

       498
       498
       -
               "content": {

     

       499
       499
       -
                 "type": "text",

     

       500
       500
       -
                 "text": "Please review this code: ${code}"

     

       501
       501
       -
               }

     

       502
       502
       -
             }

     

       503
       503
       -
             v}

     

       504
       504
       -
             

     

       505
       505
       -
             Where $code would be replaced with a user-provided argument. *)

     

       506
       162
        
         type t = {

     

       507
       163
        
           role: Role.t;

     

       508
       508
       -
           (** The role of the message sender (user or assistant).

     

       509
       509
       -
               Prompt templates typically alternate between user and assistant messages

     

       510
       510
       -
               to create a conversation structure. *)

     

       511
       164
        
           content: content;

     

       512
       512
       -
           (** The message content, which can be text, image, audio, or resource.

     

       513
       513
       -
               This unified content type supports rich multimodal prompts. *)

     

       514
       165
        
         }

     

       515
       515
       -
         include Json.Jsonable.S with type t := t

     

       166
       166
       +
       

     

       167
       167
       +
         val yojson_of_t : t -> Json.t

     

       168
       168
       +
         val t_of_yojson : Json.t -> t

     

       516
       169
        
       end

     

       517
       170
        
       

     

       518
       518
       -
       (** Message for sampling - Messages used in LLM completion requests *)

     

       171
       171
       +
       (** Message for sampling *)

     

       519
       172
        
       module SamplingMessage : sig

     

       520
       520
       -
         (** SamplingMessage represents a message in an MCP sampling request,

     

       521
       521
       -
             used for AI model generation based on a prompt.

     

       522
       522
       -
             

     

       523
       523
       -
             The sampling feature allows clients to expose language model capabilities

     

       524
       524
       -
             to servers, enabling servers to request completions from the client's LLM.

     

       525
       525
       -
             This is effectively the reverse of the normal MCP flow, with the server

     

       526
       526
       -
             requesting generative capabilities from the client.

     

       527
       527
       -
             

     

       528
       528
       -
             Sampling messages differ from prompt messages in that they don't support

     

       529
       529
       -
             embedded resources, as they represent the actual context window being

     

       530
       530
       -
             sent to the LLM rather than template definitions.

     

       531
       531
       -
             

     

       532
       532
       -
             Clients that support sampling must declare the 'sampling' capability

     

       533
       533
       -
             during initialization. *)

     

       534
       173
        
         type t = {

     

       535
       174
        
           role: Role.t;

     

       536
       536
       -
           (** The role of the message sender (user or assistant).

     

       537
       537
       -
               Typically, a sampling request will contain multiple messages

     

       538
       538
       -
               representing a conversation history, with alternating roles. *)

     

       539
       539
       -
           content: [ `Text of TextContent.t | `Image of ImageContent.t | `Audio of AudioContent.t ];

     

       540
       540
       -
           (** The message content, restricted to text, image, or audio (no resources).

     

       541
       541
       -
               Resources are not included since sampling messages represent the

     

       542
       542
       -
               actual context window for the LLM, not template definitions. *)

     

       175
       175
       +
           content: [ `Text of TextContent.t | `Image of ImageContent.t ];

     

       543
       176
        
         }

     

       544
       544
       -
         include Json.Jsonable.S with type t := t

     

       177
       177
       +
       

     

       178
       178
       +
         val yojson_of_t : t -> Json.t

     

       179
       179
       +
         val t_of_yojson : Json.t -> t

     

       545
       180
        
       end

     

       546
       181
        
       

     

       547
       182
        
       (** Implementation information *)

     

       548
       183
        
       module Implementation : sig

     

       549
       549
       -
         (** Implementation provides metadata about client and server implementations,

     

       550
       550
       -
             used during the initialization phase to identify each party. *)

     

       551
       184
        
         type t = {

     

       552
       185
        
           name: string;

     

       553
       553
       -
           (** Name of the implementation *)

     

       554
       186
        
           version: string;

     

       555
       555
       -
           (** Version of the implementation *)

     

       556
       187
        
         }

     

       557
       557
       -
         include Json.Jsonable.S with type t := t

     

       188
       188
       +
       

     

       189
       189
       +
         val yojson_of_t : t -> Json.t

     

       190
       190
       +
         val t_of_yojson : Json.t -> t

     

       558
       191
        
       end

     

       559
       192
        
       

     

       560
       560
       -
       (** JSONRPC message types - Core message protocol for MCP

     

       561
       561
       -
       

     

       562
       562
       -
           MCP uses JSON-RPC 2.0 as its underlying messaging protocol.

     

       563
       563
       -
           All MCP messages are encoded as JSON-RPC 2.0 messages with UTF-8 encoding,

     

       564
       564
       -
           following the standard JSON-RPC message formats with some MCP-specific extensions.

     

       565
       565
       -
           

     

       566
       566
       -
           MCP defines four message types:

     

       567
       567
       -
           1. Notifications: One-way messages that don't expect a response

     

       568
       568
       -
           2. Requests: Messages that expect a corresponding response

     

       569
       569
       -
           3. Responses: Replies to requests with successful results

     

       570
       570
       -
           4. Errors: Replies to requests with error information

     

       571
       571
       -
           

     

       572
       572
       -
           These can be transported over multiple transport mechanisms:

     

       573
       573
       -
           - stdio: Communication over standard input/output

     

       574
       574
       -
           - Streamable HTTP: HTTP POST/GET with SSE for server streaming

     

       575
       575
       -
           - Custom transports: Implementation-specific transports

     

       576
       576
       -
           

     

       577
       577
       -
           Messages may be sent individually or as part of a JSON-RPC batch.

     

       578
       578
       -
       *)

     

       193
       193
       +
       (** JSONRPC message types *)

     

       579
       194
        
       module JSONRPCMessage : sig

     

       580
       580
       -
         (** Notification represents a JSON-RPC notification (one-way message without a response).

     

       581
       581
       -
             

     

       582
       582
       -
             Notifications are used for events that don't require a response, such as:

     

       583
       583
       -
             - The 'initialized' notification completing initialization

     

       584
       584
       -
             - Resource change notifications

     

       585
       585
       -
             - Progress updates for long-running operations

     

       586
       586
       -
             - List changed notifications for tools, resources, and prompts

     

       587
       587
       -
             

     

       588
       588
       -
             In JSON-RPC, notifications are identified by the absence of an 'id' field:

     

       589
       589
       -
             {v

     

       590
       590
       -
             {

     

       591
       591
       -
               "jsonrpc": "2.0",

     

       592
       592
       -
               "method": "notifications/resources/updated",

     

       593
       593
       -
               "params": {

     

       594
       594
       -
                 "uri": "file:///project/src/main.rs"

     

       595
       595
       -
               }

     

       596
       596
       -
             }

     

       597
       597
       -
             v}

     

       598
       598
       -
         *)

     

       599
       195
        
         type notification = {

     

       600
       600
       -
           meth: Method.t;

     

       601
       601
       -
           (** Method for the notification, using the Method.t type to ensure type safety.

     

       602
       602
       -
               Examples: Method.Initialized, Method.ResourcesUpdated *)

     

       196
       196
       +
           method_: string;

     

       603
       197
        
           params: Json.t option;

     

       604
       604
       -
           (** Optional parameters for the notification as arbitrary JSON.

     

       605
       605
       -
               The structure depends on the specific notification method. *)

     

       606
       198
        
         }

     

       607
       199
        
       

     

       608
       608
       -
         (** Request represents a JSON-RPC request that expects a response.

     

       609
       609
       -
             

     

       610
       610
       -
             Requests are used for operations that require a response, such as:

     

       611
       611
       -
             - Initialization

     

       612
       612
       -
             - Listing resources, tools, or prompts

     

       613
       613
       -
             - Reading resources

     

       614
       614
       -
             - Calling tools

     

       615
       615
       -
             - Getting prompts

     

       616
       616
       -
             

     

       617
       617
       -
             In JSON-RPC, requests include an 'id' field that correlates with the response:

     

       618
       618
       -
             {v

     

       619
       619
       -
             {

     

       620
       620
       -
               "jsonrpc": "2.0",

     

       621
       621
       -
               "id": 1,

     

       622
       622
       -
               "method": "resources/read",

     

       623
       623
       -
               "params": {

     

       624
       624
       -
                 "uri": "file:///project/src/main.rs"

     

       625
       625
       -
               }

     

       626
       626
       -
             }

     

       627
       627
       -
             v}

     

       628
       628
       -
         *)

     

       629
       200
        
         type request = {

     

       630
       201
        
           id: RequestId.t;

     

       631
       631
       -
           (** Unique identifier for the request, which will be echoed in the response.

     

       632
       632
       -
               This can be a string or integer and should be unique within the session. *)

     

       633
       633
       -
           meth: Method.t;

     

       634
       634
       -
           (** Method for the request, using the Method.t type to ensure type safety.

     

       635
       635
       -
               Examples: Method.Initialize, Method.ResourcesRead, Method.ToolsCall *)

     

       202
       202
       +
           method_: string;

     

       636
       203
        
           params: Json.t option;

     

       637
       637
       -
           (** Optional parameters for the request as arbitrary JSON.

     

       638
       638
       -
               The structure depends on the specific request method. *)

     

       639
       204
        
           progress_token: ProgressToken.t option;

     

       640
       640
       -
           (** Optional progress token for long-running operations.

     

       641
       641
       -
               If provided, the server can send progress notifications using this token

     

       642
       642
       -
               to inform the client about the operation's status. *)

     

       643
       205
        
         }

     

       644
       206
        
       

     

       645
       645
       -
         (** Response represents a successful JSON-RPC response to a request.

     

       646
       646
       -
             

     

       647
       647
       -
             Responses are sent in reply to requests and contain the successful result.

     

       648
       648
       -
             Each response must include the same ID as its corresponding request.

     

       649
       649
       -
             

     

       650
       650
       -
             In JSON-RPC, responses include the 'id' field matching the request:

     

       651
       651
       -
             {v

     

       652
       652
       -
             {

     

       653
       653
       -
               "jsonrpc": "2.0",

     

       654
       654
       -
               "id": 1,

     

       655
       655
       -
               "result": {

     

       656
       656
       -
                 "contents": [

     

       657
       657
       -
                   {

     

       658
       658
       -
                     "uri": "file:///project/src/main.rs",

     

       659
       659
       -
                     "mimeType": "text/x-rust",

     

       660
       660
       -
                     "text": "fn main() {\n    println!(\"Hello world!\");\n}"

     

       661
       661
       -
                   }

     

       662
       662
       -
                 ]

     

       663
       663
       -
               }

     

       664
       664
       -
             }

     

       665
       665
       -
             v}

     

       666
       666
       -
         *)

     

       667
       207
        
         type response = {

     

       668
       208
        
           id: RequestId.t;

     

       669
       669
       -
           (** ID matching the original request, allowing clients to correlate

     

       670
       670
       -
               responses with their originating requests, especially important

     

       671
       671
       -
               when multiple requests are in flight. *)

     

       672
       209
        
           result: Json.t;

     

       673
       673
       -
           (** Result of the successful request as arbitrary JSON.

     

       674
       674
       -
               The structure depends on the specific request method that was called. *)

     

       675
       210
        
         }

     

       676
       211
        
       

     

       677
       677
       -
         (** Error represents an error response to a JSON-RPC request.

     

       678
       678
       -
             

     

       679
       679
       -
             Errors are sent in reply to requests when processing fails.

     

       680
       680
       -
             Each error must include the same ID as its corresponding request.

     

       681
       681
       -
             

     

       682
       682
       -
             MCP defines several standard error codes:

     

       683
       683
       -
             - Standard JSON-RPC errors (-32700 to -32603)

     

       684
       684
       -
             - MCP-specific errors (-32002 for resource not found, etc.)

     

       685
       685
       -
             

     

       686
       686
       -
             In JSON-RPC, errors follow this structure:

     

       687
       687
       -
             {v

     

       688
       688
       -
             {

     

       689
       689
       -
               "jsonrpc": "2.0",

     

       690
       690
       -
               "id": 1,

     

       691
       691
       -
               "error": {

     

       692
       692
       -
                 "code": -32002,

     

       693
       693
       -
                 "message": "Resource not found",

     

       694
       694
       -
                 "data": {

     

       695
       695
       -
                   "uri": "file:///nonexistent.txt"

     

       696
       696
       -
                 }

     

       697
       697
       -
               }

     

       698
       698
       -
             }

     

       699
       699
       -
             v}

     

       700
       700
       -
         *)

     

       701
       212
        
         type error = {

     

       702
       213
        
           id: RequestId.t;

     

       703
       703
       -
           (** ID matching the original request, allowing clients to correlate

     

       704
       704
       -
               errors with their originating requests. *)

     

       705
       214
        
           code: int;

     

       706
       706
       -
           (** Error code indicating the type of error, following the JSON-RPC standard.

     

       707
       707
       -
               Common codes include:

     

       708
       708
       -
               - -32700: Parse error

     

       709
       709
       -
               - -32600: Invalid request

     

       710
       710
       -
               - -32601: Method not found

     

       711
       711
       -
               - -32602: Invalid params

     

       712
       712
       -
               - -32603: Internal error

     

       713
       713
       -
               - -32002: Resource not found (MCP-specific)

     

       714
       714
       -
               - -32001: Authentication required (MCP-specific) *)

     

       715
       215
        
           message: string;

     

       716
       716
       -
           (** Human-readable error message describing the issue.

     

       717
       717
       -
               This should be concise but informative enough for debugging. *)

     

       718
       216
        
           data: Json.t option;

     

       719
       719
       -
           (** Optional additional error data as arbitrary JSON.

     

       720
       720
       -
               This can provide more context about the error, such as which

     

       721
       721
       -
               resource wasn't found or which parameter was invalid. *)

     

       722
       217
        
         }

     

       723
       218
        
       

     

       724
       724
       -
         (** Union type for all JSON-RPC message kinds, providing a single type

     

       725
       725
       -
             that can represent any MCP message. *)

     

       726
       219
        
         type t =

     

       727
       220
        
           | Notification of notification

     

       728
       221
        
           | Request of request

     

       729
       222
        
           | Response of response

     

       730
       223
        
           | Error of error

     

       731
       224
        
       

     

       732
       732
       -
         (** Convert notification to Yojson representation 

     

       733
       733
       -
             @param notification The notification to convert

     

       734
       734
       -
             @return JSON representation of the notification

     

       735
       735
       -
         *)

     

       736
       225
        
         val yojson_of_notification : notification -> Json.t

     

       737
       737
       -
         

     

       738
       738
       -
         (** Convert request to Yojson representation 

     

       739
       739
       -
             @param request The request to convert

     

       740
       740
       -
             @return JSON representation of the request

     

       741
       741
       -
         *)

     

       742
       226
        
         val yojson_of_request : request -> Json.t

     

       743
       743
       -
         

     

       744
       744
       -
         (** Convert response to Yojson representation 

     

       745
       745
       -
             @param response The response to convert

     

       746
       746
       -
             @return JSON representation of the response

     

       747
       747
       -
         *)

     

       748
       227
        
         val yojson_of_response : response -> Json.t

     

       749
       749
       -
         

     

       750
       750
       -
         (** Convert error to Yojson representation 

     

       751
       751
       -
             @param error The error to convert

     

       752
       752
       -
             @return JSON representation of the error

     

       753
       753
       -
         *)

     

       754
       228
        
         val yojson_of_error : error -> Json.t

     

       755
       755
       -
         

     

       756
       756
       -
         (** Convert any message to Yojson representation 

     

       757
       757
       -
             @param message The message to convert

     

       758
       758
       -
             @return JSON representation of the message

     

       759
       759
       -
         *)

     

       760
       229
        
         val yojson_of_t : t -> Json.t

     

       761
       230
        
       

     

       762
       762
       -
         (** Convert Yojson representation to notification 

     

       763
       763
       -
             @param json JSON representation of a notification

     

       764
       764
       -
             @return Parsed notification object

     

       765
       765
       -
             @raise Parse error if the JSON is not a valid notification

     

       766
       766
       -
         *)

     

       767
       231
        
         val notification_of_yojson : Json.t -> notification

     

       768
       768
       -
         

     

       769
       769
       -
         (** Convert Yojson representation to request 

     

       770
       770
       -
             @param json JSON representation of a request

     

       771
       771
       -
             @return Parsed request object

     

       772
       772
       -
             @raise Parse error if the JSON is not a valid request

     

       773
       773
       -
         *)

     

       774
       232
        
         val request_of_yojson : Json.t -> request

     

       775
       775
       -
         

     

       776
       776
       -
         (** Convert Yojson representation to response 

     

       777
       777
       -
             @param json JSON representation of a response

     

       778
       778
       -
             @return Parsed response object

     

       779
       779
       -
             @raise Parse error if the JSON is not a valid response

     

       780
       780
       -
         *)

     

       781
       233
        
         val response_of_yojson : Json.t -> response

     

       782
       782
       -
         

     

       783
       783
       -
         (** Convert Yojson representation to error 

     

       784
       784
       -
             @param json JSON representation of an error

     

       785
       785
       -
             @return Parsed error object

     

       786
       786
       -
             @raise Parse error if the JSON is not a valid error

     

       787
       787
       -
         *)

     

       788
       234
        
         val error_of_yojson : Json.t -> error

     

       789
       789
       -
         

     

       790
       790
       -
         (** Convert Yojson representation to any message 

     

       791
       791
       -
             @param json JSON representation of any message type

     

       792
       792
       -
             @return Parsed message object

     

       793
       793
       -
             @raise Parse error if the JSON is not a valid message

     

       794
       794
       -
         *)

     

       795
       235
        
         val t_of_yojson : Json.t -> t

     

       796
       236
        
       

     

       797
       797
       -
         (** Create a new notification message

     

       798
       798
       -
             @param params Optional parameters for the notification

     

       799
       799
       -
             @param meth Method name for the notification

     

       800
       800
       -
             @return A new JSON-RPC notification message

     

       801
       801
       -
         *)

     

       802
       802
       -
         val create_notification : ?params:Json.t option -> meth:Method.t -> unit -> t

     

       803
       803
       -
         

     

       804
       804
       -
         (** Create a new request message

     

       805
       805
       -
             @param params Optional parameters for the request

     

       806
       806
       -
             @param progress_token Optional progress token for long-running operations

     

       807
       807
       -
             @param id Unique identifier for the request

     

       808
       808
       -
             @param meth Method name for the request

     

       809
       809
       -
             @return A new JSON-RPC request message

     

       810
       810
       -
         *)

     

       811
       811
       -
         val create_request : ?params:Json.t option -> ?progress_token:ProgressToken.t option -> id:RequestId.t -> meth:Method.t -> unit -> t

     

       812
       812
       -
         

     

       813
       813
       -
         (** Create a new response message

     

       814
       814
       -
             @param id ID matching the original request

     

       815
       815
       -
             @param result Result of the successful request

     

       816
       816
       -
             @return A new JSON-RPC response message

     

       817
       817
       -
         *)

     

       237
       237
       +
         val create_notification : ?params:Json.t option -> method_:string -> unit -> t

     

       238
       238
       +
         val create_request : ?params:Json.t option -> ?progress_token:ProgressToken.t option -> id:RequestId.t -> method_:string -> unit -> t

     

       818
       239
        
         val create_response : id:RequestId.t -> result:Json.t -> t

     

       819
       819
       -
         

     

       820
       820
       -
         (** Create a new error message

     

       821
       821
       -
             @param id ID matching the original request

     

       822
       822
       -
             @param code Error code indicating the type of error

     

       823
       823
       -
             @param message Human-readable error message

     

       824
       824
       -
             @param data Optional additional error data

     

       825
       825
       -
             @return A new JSON-RPC error message

     

       826
       826
       -
         *)

     

       827
       240
        
         val create_error : id:RequestId.t -> code:int -> message:string -> ?data:Json.t option -> unit -> t

     

       828
       241
        
       end

     

       829
       242
        
       

     

       830
       830
       -
       (** Initialize request/response - The first phase of the MCP lifecycle 

     

       831
       831
       -
           

     

       832
       832
       -
           The initialization phase is the mandatory first interaction between client and server.

     

       833
       833
       -
           During this phase, the protocol version is negotiated and capabilities are exchanged

     

       834
       834
       -
           to determine which optional features will be available during the session.

     

       835
       835
       -
           

     

       836
       836
       -
           This follows a strict sequence:

     

       837
       837
       -
           1. Client sends an InitializeRequest containing its capabilities and protocol version

     

       838
       838
       -
           2. Server responds with an InitializeResult containing its capabilities and protocol version

     

       839
       839
       -
           3. Client sends an InitializedNotification to signal it's ready for normal operations

     

       840
       840
       -
           

     

       841
       841
       -
           The Initialize module handles steps 1 and 2 of this process.

     

       842
       842
       -
       *)

     

       243
       243
       +
       (** Initialize request/response *)

     

       843
       244
        
       module Initialize : sig

     

       844
       245
        
         (** Initialize request *)

     

       845
       246
        
         module Request : sig

     

       846
       846
       -
           (** InitializeRequest starts the MCP lifecycle, negotiating capabilities

     

       847
       847
       -
               and protocol versions between client and server. This is always the first

     

       848
       848
       -
               message sent by the client and MUST NOT be part of a JSON-RPC batch.

     

       849
       849
       -
               

     

       850
       850
       -
               The client SHOULD send the latest protocol version it supports. If the server

     

       851
       851
       -
               does not support this version, it will respond with a version it does support,

     

       852
       852
       -
               and the client must either use that version or disconnect. *)

     

       853
       247
        
           type t = {

     

       854
       854
       -
             capabilities: Json.t; (** ClientCapabilities that define supported optional features.

     

       855
       855
       -
                 This includes which optional protocol features the client supports,

     

       856
       856
       -
                 such as 'roots' (filesystem access), 'sampling' (LLM generation),

     

       857
       857
       -
                 and any experimental features. *)

     

       248
       248
       +
             capabilities: Json.t; (** ClientCapabilities *)

     

       858
       249
        
             client_info: Implementation.t;

     

       859
       859
       -
             (** Client implementation details (name and version) used for identification

     

       860
       860
       -
                 and debugging. Helps servers understand which client they're working with. *)

     

       861
       250
        
             protocol_version: string;

     

       862
       862
       -
             (** MCP protocol version supported by the client, formatted as YYYY-MM-DD

     

       863
       863
       -
                 according to the MCP versioning scheme. Example: "2025-03-26" *)

     

       864
       251
        
           }

     

       865
       865
       -
           include Json.Jsonable.S with type t := t

     

       252
       252
       +
       

     

       253
       253
       +
           val yojson_of_t : t -> Json.t

     

       254
       254
       +
           val t_of_yojson : Json.t -> t

     

       866
       255
        
       

     

       867
       867
       -
           (** Create a new initialization request

     

       868
       868
       -
               @param capabilities Client capabilities that define supported optional features

     

       869
       869
       -
               @param client_info Client implementation details

     

       870
       870
       -
               @param protocol_version MCP protocol version supported by the client

     

       871
       871
       -
               @return A new initialization request

     

       872
       872
       -
           *)

     

       873
       256
        
           val create : capabilities:Json.t -> client_info:Implementation.t -> protocol_version:string -> t

     

       874
       874
       -
           

     

       875
       875
       -
           (** Convert to JSON-RPC message

     

       876
       876
       -
               @param id Unique request identifier

     

       877
       877
       -
               @param t Initialization request

     

       878
       878
       -
               @return JSON-RPC message containing the initialization request

     

       879
       879
       -
           *)

     

       880
       257
        
           val to_jsonrpc : id:RequestId.t -> t -> JSONRPCMessage.t

     

       881
       258
        
         end

     

       882
       259
        
       

     

       883
       260
        
         (** Initialize result *)

     

       884
       261
        
         module Result : sig

     

       885
       885
       -
           (** InitializeResult is the server's response to an initialization request,

     

       886
       886
       -
               completing capability negotiation and establishing the protocol version.

     

       887
       887
       -
               

     

       888
       888
       -
               After receiving this message, the client must send an InitializedNotification.

     

       889
       889
       -
               The server should not send any requests other than pings and logging before

     

       890
       890
       -
               receiving the initialized notification. *)

     

       891
       262
        
           type t = {

     

       892
       892
       -
             capabilities: Json.t; (** ServerCapabilities that define supported optional features.

     

       893
       893
       -
                 This declares which server features are available, including:

     

       894
       894
       -
                 - prompts: Server provides prompt templates

     

       895
       895
       -
                 - resources: Server provides readable resources

     

       896
       896
       -
                 - tools: Server exposes callable tools

     

       897
       897
       -
                 - logging: Server emits structured log messages

     

       898
       898
       -
                 

     

       899
       899
       -
                 Each capability may have sub-capabilities like:

     

       900
       900
       -
                 - listChanged: Server will notify when available items change

     

       901
       901
       -
                 - subscribe: Clients can subscribe to individual resources *)

     

       263
       263
       +
             capabilities: Json.t; (** ServerCapabilities *)

     

       902
       264
        
             server_info: Implementation.t;

     

       903
       903
       -
             (** Server implementation details (name and version) used for identification

     

       904
       904
       -
                 and debugging. Helps clients understand which server they're working with. *)

     

       905
       265
        
             protocol_version: string;

     

       906
       906
       -
             (** MCP protocol version supported by the server, formatted as YYYY-MM-DD.

     

       907
       907
       -
                 If the server supports the client's requested version, it responds with

     

       908
       908
       -
                 the same version. Otherwise, it responds with a version it does support. *)

     

       909
       266
        
             instructions: string option;

     

       910
       910
       -
             (** Optional instructions for using the server. These can provide human-readable

     

       911
       911
       -
                 guidance on how to interact with this specific server implementation. *)

     

       912
       267
        
             meta: Json.t option;

     

       913
       913
       -
             (** Optional additional metadata as arbitrary JSON. Can contain server-specific

     

       914
       914
       -
                 information not covered by the standard fields. *)

     

       915
       268
        
           }

     

       916
       916
       -
           include Json.Jsonable.S with type t := t

     

       269
       269
       +
       

     

       270
       270
       +
           val yojson_of_t : t -> Json.t

     

       271
       271
       +
           val t_of_yojson : Json.t -> t

     

       917
       272
        
       

     

       918
       918
       -
           (** Create a new initialization result

     

       919
       919
       -
               @param capabilities Server capabilities that define supported optional features

     

       920
       920
       -
               @param server_info Server implementation details

     

       921
       921
       -
               @param protocol_version MCP protocol version supported by the server

     

       922
       922
       -
               @param instructions Optional instructions for using the server

     

       923
       923
       -
               @param meta Optional additional metadata

     

       924
       924
       -
               @return A new initialization result

     

       925
       925
       -
           *)

     

       926
       273
        
           val create : capabilities:Json.t -> server_info:Implementation.t -> protocol_version:string -> ?instructions:string -> ?meta:Json.t -> unit -> t

     

       927
       927
       -
           

     

       928
       928
       -
           (** Convert to JSON-RPC message

     

       929
       929
       -
               @param id ID matching the original request

     

       930
       930
       -
               @param t Initialization result

     

       931
       931
       -
               @return JSON-RPC message containing the initialization result

     

       932
       932
       -
           *)

     

       933
       274
        
           val to_jsonrpc : id:RequestId.t -> t -> JSONRPCMessage.t

     

       934
       275
        
         end

     

       935
       276
        
       end

     

       936
       277
        
       

     

       937
       937
       -
       (** Initialized notification - Completes the initialization phase of the MCP lifecycle *)

     

       278
       278
       +
       (** Initialized notification *)

     

       938
       279
        
       module Initialized : sig

     

       939
       280
        
         module Notification : sig

     

       940
       940
       -
           (** InitializedNotification is sent by the client after receiving the initialization

     

       941
       941
       -
               response, indicating it's ready to begin normal operations. This completes the

     

       942
       942
       -
               three-step initialization process, after which both client and server can

     

       943
       943
       -
               freely exchange messages according to the negotiated capabilities.

     

       944
       944
       -
               

     

       945
       945
       -
               Only after this notification has been sent should the client begin normal operations

     

       946
       946
       -
               like listing resources, calling tools, or requesting prompts. *)

     

       947
       281
        
           type t = {

     

       948
       282
        
             meta: Json.t option;

     

       949
       949
       -
             (** Optional additional metadata as arbitrary JSON. Can contain client-specific

     

       950
       950
       -
                 information not covered by the standard fields. *)

     

       951
       283
        
           }

     

       952
       952
       -
           include Json.Jsonable.S with type t := t

     

       284
       284
       +
       

     

       285
       285
       +
           val yojson_of_t : t -> Json.t

     

       286
       286
       +
           val t_of_yojson : Json.t -> t

     

       953
       287
        
       

     

       954
       954
       -
           (** Create a new initialized notification

     

       955
       955
       -
               @param meta Optional additional metadata

     

       956
       956
       -
               @return A new initialized notification

     

       957
       957
       -
           *)

     

       958
       288
        
           val create : ?meta:Json.t -> unit -> t

     

       959
       959
       -
           

     

       960
       960
       -
           (** Convert to JSON-RPC message

     

       961
       961
       -
               @param t Initialized notification

     

       962
       962
       -
               @return JSON-RPC message containing the initialized notification

     

       963
       963
       -
           *)

     

       964
       289
        
           val to_jsonrpc : t -> JSONRPCMessage.t

     

       965
       290
        
         end

     

       966
       291
        
       end

     

       967
       292
        
       

     

       968
       968
       -
       (** Parse a JSON message into an MCP message 

     

       969
       969
       -
           

     

       970
       970
       -
           This function takes a raw JSON value and parses it into a structured MCP message.

     

       971
       971
       -
           It's the primary entry point for processing incoming JSON-RPC messages in the MCP protocol.

     

       972
       972
       -
           

     

       973
       973
       -
           The function determines the message type (notification, request, response, or error)

     

       974
       974
       -
           based on the presence and values of specific fields:

     

       975
       975
       -
           - A message with "method" but no "id" is a notification

     

       976
       976
       -
           - A message with "method" and "id" is a request

     

       977
       977
       -
           - A message with "id" and "result" is a response

     

       978
       978
       -
           - A message with "id" and "error" is an error

     

       979
       979
       -
           

     

       980
       980
       -
           @param json The JSON message to parse, typically received from the transport layer

     

       981
       981
       -
           @return The parsed MCP message as a structured JSONRPCMessage.t value

     

       982
       982
       -
           @raise Parse error if the JSON cannot be parsed as a valid MCP message

     

       983
       983
       -
       *)

     

       984
       984
       -
       val parse_message : Json.t -> JSONRPCMessage.t

     

       293
       293
       +
       (** Tool definition *)

     

       294
       294
       +
       module Tool : sig

     

       295
       295
       +
         type t = {

     

       296
       296
       +
           name: string;

     

       297
       297
       +
           description: string option;

     

       298
       298
       +
           input_schema: Json.t;

     

       299
       299
       +
         }

     

       985
       300
        
       

     

       986
       986
       -
       (** Create a new notification message

     

       987
       987
       -
           

     

       988
       988
       -
           Notifications are one-way messages that don't expect a response.

     

       989
       989
       -
           This is a convenience wrapper around JSONRPCMessage.create_notification.

     

       990
       990
       -
           

     

       991
       991
       -
           Common notifications in MCP include:

     

       992
       992
       -
           - "notifications/initialized" - Sent after initialization

     

       993
       993
       -
           - "notifications/progress" - Updates on long-running operations

     

       994
       994
       -
           - "notifications/resources/updated" - Resource content changed

     

       995
       995
       -
           - "notifications/prompts/list_changed" - Available prompts changed

     

       996
       996
       -
           - "notifications/tools/list_changed" - Available tools changed

     

       997
       997
       -
           

     

       998
       998
       -
           @param params Optional parameters for the notification as a JSON value

     

       999
       999
       -
           @param meth Method type for the notification

     

       1000
       1000
       -
           @return A new JSON-RPC notification message

     

       1001
       1001
       -
       *)

     

       1002
       1002
       -
       val create_notification : ?params:Json.t option -> meth:Method.t -> unit -> JSONRPCMessage.t

     

       301
       301
       +
         val yojson_of_t : t -> Json.t

     

       302
       302
       +
         val t_of_yojson : Json.t -> t

     

       303
       303
       +
       end

     

       1003
       304
        
       

     

       1004
       1004
       -
       (** Create a new request message

     

       1005
       1005
       -
           

     

       1006
       1006
       -
           Requests are messages that expect a corresponding response.

     

       1007
       1007
       -
           This is a convenience wrapper around JSONRPCMessage.create_request.

     

       1008
       1008
       -
           

     

       1009
       1009
       -
           Common requests in MCP include:

     

       1010
       1010
       -
           - "initialize" - Start the MCP lifecycle

     

       1011
       1011
       -
           - "resources/list" - Discover available resources

     

       1012
       1012
       -
           - "resources/read" - Retrieve resource contents

     

       1013
       1013
       -
           - "tools/list" - Discover available tools

     

       1014
       1014
       -
           - "tools/call" - Invoke a tool

     

       1015
       1015
       -
           - "prompts/list" - Discover available prompts

     

       1016
       1016
       -
           - "prompts/get" - Retrieve a prompt template

     

       1017
       1017
       -
           

     

       1018
       1018
       -
           @param params Optional parameters for the request as a JSON value

     

       1019
       1019
       -
           @param progress_token Optional progress token for long-running operations

     

       1020
       1020
       -
                  that can report progress updates

     

       1021
       1021
       -
           @param id Unique identifier for the request, used to correlate with the response

     

       1022
       1022
       -
           @param meth Method type for the request

     

       1023
       1023
       -
           @return A new JSON-RPC request message

     

       1024
       1024
       -
       *)

     

       1025
       1025
       -
       val create_request : ?params:Json.t option -> ?progress_token:ProgressToken.t option -> id:RequestId.t -> meth:Method.t -> unit -> JSONRPCMessage.t

     

       305
       305
       +
       (** Tool result *)

     

       306
       306
       +
       module CallToolResult : sig

     

       307
       307
       +
         type t = {

     

       308
       308
       +
           content: content list;

     

       309
       309
       +
           is_error: bool;

     

       310
       310
       +
           meta: Json.t option;

     

       311
       311
       +
         }

     

       312
       312
       +
         

     

       313
       313
       +
         val yojson_of_t : t -> Json.t

     

       314
       314
       +
         val t_of_yojson : Json.t -> t

     

       315
       315
       +
       end

     

       1026
       316
        
       

     

       1027
       1027
       -
       (** Create a new response message

     

       1028
       1028
       -
           

     

       1029
       1029
       -
           Responses are sent in reply to requests and contain successful results.

     

       1030
       1030
       -
           This is a convenience wrapper around JSONRPCMessage.create_response.

     

       1031
       1031
       -
           

     

       1032
       1032
       -
           Each response must include the same ID as its corresponding request

     

       1033
       1033
       -
           to allow the client to correlate them, especially when multiple

     

       1034
       1034
       -
           requests are in flight simultaneously.

     

       1035
       1035
       -
           

     

       1036
       1036
       -
           @param id ID matching the original request

     

       1037
       1037
       -
           @param result Result of the successful request as a JSON value

     

       1038
       1038
       -
           @return A new JSON-RPC response message

     

       1039
       1039
       -
       *)

     

       1040
       1040
       -
       val create_response : id:RequestId.t -> result:Json.t -> JSONRPCMessage.t

     

       317
       317
       +
       (** Resource definition *)

     

       318
       318
       +
       module Resource : sig

     

       319
       319
       +
         type t = {

     

       320
       320
       +
           name: string;

     

       321
       321
       +
           uri: string;

     

       322
       322
       +
           description: string option;

     

       323
       323
       +
           mime_type: string option;

     

       324
       324
       +
           size: int option;

     

       325
       325
       +
           annotations: Annotated.annotation option;

     

       326
       326
       +
         }

     

       1041
       327
        
       

     

       1042
       1042
       -
       (** Create a new error message

     

       1043
       1043
       -
           

     

       1044
       1044
       -
           Errors are sent in reply to requests when processing fails.

     

       1045
       1045
       -
           This is a convenience wrapper around JSONRPCMessage.create_error.

     

       1046
       1046
       -
           

     

       1047
       1047
       -
           MCP uses standard JSON-RPC error codes as well as some protocol-specific codes:

     

       1048
       1048
       -
           - -32700: Parse error (invalid JSON)

     

       1049
       1049
       -
           - -32600: Invalid request (malformed JSON-RPC)

     

       1050
       1050
       -
           - -32601: Method not found

     

       1051
       1051
       -
           - -32602: Invalid parameters

     

       1052
       1052
       -
           - -32603: Internal error

     

       1053
       1053
       -
           - -32002: Resource not found (MCP-specific)

     

       1054
       1054
       -
           - -32001: Authentication required (MCP-specific)

     

       1055
       1055
       -
           

     

       1056
       1056
       -
           @param id ID matching the original request

     

       1057
       1057
       -
           @param code Error code indicating the type of error

     

       1058
       1058
       -
           @param message Human-readable error message describing the issue

     

       1059
       1059
       -
           @param data Optional additional error data providing more context

     

       1060
       1060
       -
           @return A new JSON-RPC error message

     

       1061
       1061
       -
       *)

     

       1062
       1062
       -
       val create_error : id:RequestId.t -> code:int -> message:string -> ?data:Json.t option -> unit -> JSONRPCMessage.t

     

       328
       328
       +
         val yojson_of_t : t -> Json.t

     

       329
       329
       +
         val t_of_yojson : Json.t -> t

     

       330
       330
       +
       end

     

       331
       331
       +
       

     

       332
       332
       +
       (** Resource Template definition *)

     

       333
       333
       +
       module ResourceTemplate : sig

     

       334
       334
       +
         type t = {

     

       335
       335
       +
           name: string;

     

       336
       336
       +
           uri_template: string;

     

       337
       337
       +
           description: string option;

     

       338
       338
       +
           mime_type: string option;

     

       339
       339
       +
           annotations: Annotated.annotation option;

     

       340
       340
       +
         }

     

       1063
       341
        
       

     

       1064
       1064
       -
       (** Create a new text content object

     

       1065
       1065
       -
           @param text The text content

     

       1066
       1066
       -
           @return A content value with the text

     

       1067
       1067
       -
       *)

     

       1068
       1068
       -
       val make_text_content : string -> content

     

       342
       342
       +
         val yojson_of_t : t -> Json.t

     

       343
       343
       +
         val t_of_yojson : Json.t -> t

     

       344
       344
       +
       end

     

       1069
       345
        
       

     

       1070
       1070
       -
       (** Create a new image content object

     

       1071
       1071
       -
           @param data Base64-encoded image data

     

       1072
       1072
       -
           @param mime_type MIME type of the image (e.g., "image/png", "image/jpeg")  

     

       1073
       1073
       -
           @return A content value with the image

     

       1074
       1074
       -
       *)

     

       1075
       1075
       -
       val make_image_content : string -> string -> content

     

       346
       346
       +
       (** Resource Reference *)

     

       347
       347
       +
       module ResourceReference : sig

     

       348
       348
       +
         type t = {

     

       349
       349
       +
           uri: string;

     

       350
       350
       +
         }

     

       1076
       351
        
       

     

       1077
       1077
       -
       (** Create a new audio content object

     

       1078
       1078
       -
           @param data Base64-encoded audio data

     

       1079
       1079
       -
           @param mime_type MIME type of the audio (e.g., "audio/wav", "audio/mp3")

     

       1080
       1080
       -
           @return A content value with the audio

     

       1081
       1081
       -
       *)

     

       1082
       1082
       -
       val make_audio_content : string -> string -> content

     

       352
       352
       +
         val yojson_of_t : t -> Json.t

     

       353
       353
       +
         val t_of_yojson : Json.t -> t

     

       354
       354
       +
       end

     

       1083
       355
        
       

     

       1084
       1084
       -
       (** Create a new text resource content object

     

       1085
       1085
       -
           @param uri URI that uniquely identifies the resource

     

       1086
       1086
       -
           @param text The text content of the resource

     

       1087
       1087
       -
           @param mime_type Optional MIME type of the text content

     

       1088
       1088
       -
           @return A content value with the text resource

     

       1089
       1089
       -
       *)

     

       1090
       1090
       -
       val make_resource_text_content : string -> string -> string option -> content

     

       356
       356
       +
       (** Prompt Reference *)

     

       357
       357
       +
       module PromptReference : sig

     

       358
       358
       +
         type t = {

     

       359
       359
       +
           name: string;

     

       360
       360
       +
         }

     

       1091
       361
        
       

     

       1092
       1092
       -
       (** Create a new binary resource content object

     

       1093
       1093
       -
           @param uri URI that uniquely identifies the resource

     

       1094
       1094
       -
           @param blob Base64-encoded binary data

     

       1095
       1095
       -
           @param mime_type Optional MIME type of the binary content

     

       1096
       1096
       -
           @return A content value with the binary resource

     

       1097
       1097
       -
       *)

     

       1098
       1098
       -
       val make_resource_blob_content : string -> string -> string option -> content

     

       362
       362
       +
         val yojson_of_t : t -> Json.t

     

       363
       363
       +
         val t_of_yojson : Json.t -> t

     

       364
       364
       +
       end

     

       365
       365
       +
       

     

       366
       366
       +
       (** Completion support *)

     

       367
       367
       +
       module Completion : sig

     

       368
       368
       +
         module Argument : sig

     

       369
       369
       +
           type t = {

     

       370
       370
       +
             name: string;

     

       371
       371
       +
             value: string;

     

       372
       372
       +
           }

     

       373
       373
       +
       

     

       374
       374
       +
           val yojson_of_t : t -> Json.t

     

       375
       375
       +
           val t_of_yojson : Json.t -> t

     

       376
       376
       +
         end

     

       377
       377
       +
       

     

       378
       378
       +
         module Request : sig

     

       379
       379
       +
           type reference = [ `Prompt of PromptReference.t | `Resource of ResourceReference.t ]

     

       380
       380
       +
       

     

       381
       381
       +
           type t = {

     

       382
       382
       +
             argument: Argument.t;

     

       383
       383
       +
             ref: reference;

     

       384
       384
       +
           }

     

       385
       385
       +
       

     

       386
       386
       +
           val yojson_of_t : t -> Json.t

     

       387
       387
       +
           val t_of_yojson : Json.t -> t

     

       388
       388
       +
       

     

       389
       389
       +
           val yojson_of_reference : reference -> Json.t

     

       390
       390
       +
           val reference_of_yojson : Json.t -> reference

     

       391
       391
       +
       

     

       392
       392
       +
           val create : argument:Argument.t -> ref:reference -> t

     

       393
       393
       +
           val to_params : t -> Json.t

     

       394
       394
       +
         end

     

       395
       395
       +
       

     

       396
       396
       +
         module Result : sig

     

       397
       397
       +
           type completion = {

     

       398
       398
       +
             values: string list;

     

       399
       399
       +
             has_more: bool option;

     

       400
       400
       +
             total: int option;

     

       401
       401
       +
           }

     

       402
       402
       +
       

     

       403
       403
       +
           type t = {

     

       404
       404
       +
             completion: completion;

     

       405
       405
       +
             meta: Json.t option;

     

       406
       406
       +
           }

     

       407
       407
       +
       

     

       408
       408
       +
           val yojson_of_completion : completion -> Json.t

     

       409
       409
       +
           val completion_of_yojson : Json.t -> completion

     

       410
       410
       +
       

     

       411
       411
       +
           val yojson_of_t : t -> Json.t

     

       412
       412
       +
           val t_of_yojson : Json.t -> t

     

       413
       413
       +
       

     

       414
       414
       +
           val create : completion:completion -> ?meta:Json.t -> unit -> t

     

       415
       415
       +
           val to_result : t -> Json.t

     

       416
       416
       +
         end

     

       417
       417
       +
       end

     

       418
       418
       +
       

     

       419
       419
       +
       (** Parse a JSON message into an MCP message *)

     

       420
       420
       +
       val parse_message : Json.t -> JSONRPCMessage.t

     

       421
       421
       +
       

     

       422
       422
       +
       (** Create JSONRPC message helpers *)

     

       423
       423
       +
       val create_notification : ?params:Json.t option -> method_:string -> unit -> JSONRPCMessage.t

     

       424
       424
       +
       val create_request : ?params:Json.t option -> ?progress_token:ProgressToken.t option -> id:RequestId.t -> method_:string -> unit -> JSONRPCMessage.t

     

       425
       425
       +
       val create_response : id:RequestId.t -> result:Json.t -> JSONRPCMessage.t

     

       426
       426
       +
       val create_error : id:RequestId.t -> code:int -> message:string -> ?data:Json.t option -> unit -> JSONRPCMessage.t

     

       427
       427
       +
       

     

       428
       428
       +
       (** Helper functions for common requests/responses *)

     

       429
       429
       +
       val create_completion_request : id:RequestId.t -> argument:Completion.Argument.t -> ref:Completion.Request.reference -> JSONRPCMessage.t

     

       430
       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

-834

lib/mcp_rpc.ml

···

       1
       1
       -
       (* Mcp_message - High-level RPC message definitions for Model Context Protocol *)

     

       2
       2
       -
       

     

       3
       3
       -
       open Mcp

     

       4
       4
       -
       open Jsonrpc

     

       5
       5
       -
       

     

       6
       6
       -
       (* Resources/List *)

     

       7
       7
       -
       module ResourcesList = struct

     

       8
       8
       -
         module Request = struct

     

       9
       9
       -
           type t = {

     

       10
       10
       -
             cursor: Cursor.t option;

     

       11
       11
       -
           }

     

       12
       12
       -
           

     

       13
       13
       -
           let yojson_of_t { cursor } =

     

       14
       14
       -
             let assoc = [] in

     

       15
       15
       -
             let assoc = match cursor with

     

       16
       16
       -
               | Some c -> ("cursor", Cursor.yojson_of_t c) :: assoc

     

       17
       17
       -
               | None -> assoc

     

       18
       18
       -
             in

     

       19
       19
       -
             `Assoc assoc

     

       20
       20
       -
           

     

       21
       21
       -
           let t_of_yojson = function

     

       22
       22
       -
             | `Assoc fields ->

     

       23
       23
       -
               let cursor = List.assoc_opt "cursor" fields |> Option.map Cursor.t_of_yojson in

     

       24
       24
       -
               { cursor }

     

       25
       25
       -
             | j -> Util.json_error "Expected object for ResourcesList.Request.t" j

     

       26
       26
       -
             

     

       27
       27
       -
         end

     

       28
       28
       -
         

     

       29
       29
       -
         module Resource = struct

     

       30
       30
       -
           type t = {

     

       31
       31
       -
             uri: string;

     

       32
       32
       -
             name: string;

     

       33
       33
       -
             description: string option;

     

       34
       34
       -
             mime_type: string option;

     

       35
       35
       -
             size: int option;

     

       36
       36
       -
           }

     

       37
       37
       -
           

     

       38
       38
       -
           let yojson_of_t { uri; name; description; mime_type; size } =

     

       39
       39
       -
             let assoc = [

     

       40
       40
       -
               ("uri", `String uri);

     

       41
       41
       -
               ("name", `String name);

     

       42
       42
       -
             ] in

     

       43
       43
       -
             let assoc = match description with

     

       44
       44
       -
               | Some desc -> ("description", `String desc) :: assoc

     

       45
       45
       -
               | None -> assoc

     

       46
       46
       -
             in

     

       47
       47
       -
             let assoc = match mime_type with

     

       48
       48
       -
               | Some mime -> ("mimeType", `String mime) :: assoc

     

       49
       49
       -
               | None -> assoc

     

       50
       50
       -
             in

     

       51
       51
       -
             let assoc = match size with

     

       52
       52
       -
               | Some s -> ("size", `Int s) :: assoc

     

       53
       53
       -
               | None -> assoc

     

       54
       54
       -
             in

     

       55
       55
       -
             `Assoc assoc

     

       56
       56
       -
           

     

       57
       57
       -
           let t_of_yojson = function

     

       58
       58
       -
             | `Assoc fields as json ->

     

       59
       59
       -
               let uri = match List.assoc_opt "uri" fields with

     

       60
       60
       -
                 | Some (`String s) -> s

     

       61
       61
       -
                 | _ -> Util.json_error "Missing or invalid 'uri' field" json

     

       62
       62
       -
               in

     

       63
       63
       -
               let name = match List.assoc_opt "name" fields with

     

       64
       64
       -
                 | Some (`String s) -> s

     

       65
       65
       -
                 | _ -> Util.json_error "Missing or invalid 'name' field" json

     

       66
       66
       -
               in

     

       67
       67
       -
               let description = List.assoc_opt "description" fields |> Option.map (function

     

       68
       68
       -
                 | `String s -> s

     

       69
       69
       -
                 | j -> Util.json_error "Expected string for description" j

     

       70
       70
       -
               ) in

     

       71
       71
       -
               let mime_type = List.assoc_opt "mimeType" fields |> Option.map (function

     

       72
       72
       -
                 | `String s -> s

     

       73
       73
       -
                 | j -> Util.json_error "Expected string for mimeType" j

     

       74
       74
       -
               ) in

     

       75
       75
       -
               let size = List.assoc_opt "size" fields |> Option.map (function

     

       76
       76
       -
                 | `Int i -> i

     

       77
       77
       -
                 | j -> Util.json_error "Expected int for size" j

     

       78
       78
       -
               ) in

     

       79
       79
       -
               { uri; name; description; mime_type; size }

     

       80
       80
       -
             | j -> Util.json_error "Expected object for ResourcesList.Resource.t" j

     

       81
       81
       -
         end

     

       82
       82
       -
         

     

       83
       83
       -
         module Response = struct

     

       84
       84
       -
           type t = {

     

       85
       85
       -
             resources: Resource.t list;

     

       86
       86
       -
             next_cursor: Cursor.t option;

     

       87
       87
       -
           }

     

       88
       88
       -
           

     

       89
       89
       -
           let yojson_of_t { resources; next_cursor } =

     

       90
       90
       -
             let assoc = [

     

       91
       91
       -
               ("resources", `List (List.map Resource.yojson_of_t resources));

     

       92
       92
       -
             ] in

     

       93
       93
       -
             let assoc = match next_cursor with

     

       94
       94
       -
               | Some c -> ("nextCursor", Cursor.yojson_of_t c) :: assoc

     

       95
       95
       -
               | None -> assoc

     

       96
       96
       -
             in

     

       97
       97
       -
             `Assoc assoc

     

       98
       98
       -
           

     

       99
       99
       -
           let t_of_yojson = function

     

       100
       100
       -
             | `Assoc fields as json ->

     

       101
       101
       -
               let resources = match List.assoc_opt "resources" fields with

     

       102
       102
       -
                 | Some (`List items) -> List.map Resource.t_of_yojson items

     

       103
       103
       -
                 | _ -> Util.json_error "Missing or invalid 'resources' field" json

     

       104
       104
       -
               in

     

       105
       105
       -
               let next_cursor = List.assoc_opt "nextCursor" fields |> Option.map Cursor.t_of_yojson in

     

       106
       106
       -
               { resources; next_cursor }

     

       107
       107
       -
             | j -> Util.json_error "Expected object for ResourcesList.Response.t" j

     

       108
       108
       -
             

     

       109
       109
       -
         end

     

       110
       110
       -
         

     

       111
       111
       -
         (* Request/response creation helpers *)

     

       112
       112
       -
         let create_request ?cursor ?id () =

     

       113
       113
       -
           let id = match id with

     

       114
       114
       -
             | Some i -> i

     

       115
       115
       -
             | None -> `Int (Random.int 10000)

     

       116
       116
       -
           in

     

       117
       117
       -
           let params = Request.yojson_of_t { cursor } in

     

       118
       118
       -
           JSONRPCMessage.create_request ~id ~meth:Method.ResourcesList ~params:(Some params) ()

     

       119
       119
       -
         

     

       120
       120
       -
         let create_response ~id ~resources ?next_cursor () =

     

       121
       121
       -
           let result = Response.yojson_of_t { resources; next_cursor } in

     

       122
       122
       -
           JSONRPCMessage.create_response ~id ~result

     

       123
       123
       -
       end

     

       124
       124
       -
       

     

       125
       125
       -
       (* Resources/Templates/List *)

     

       126
       126
       -
       module ListResourceTemplatesRequest = struct

     

       127
       127
       -
         type t = {

     

       128
       128
       -
           cursor: Cursor.t option;

     

       129
       129
       -
         }

     

       130
       130
       -
         

     

       131
       131
       -
         let yojson_of_t { cursor } =

     

       132
       132
       -
           let assoc = [] in

     

       133
       133
       -
           let assoc = match cursor with

     

       134
       134
       -
             | Some c -> ("cursor", Cursor.yojson_of_t c) :: assoc

     

       135
       135
       -
             | None -> assoc

     

       136
       136
       -
           in

     

       137
       137
       -
           `Assoc assoc

     

       138
       138
       -
         

     

       139
       139
       -
         let t_of_yojson = function

     

       140
       140
       -
           | `Assoc fields ->

     

       141
       141
       -
             let cursor = List.assoc_opt "cursor" fields |> Option.map Cursor.t_of_yojson in

     

       142
       142
       -
             { cursor }

     

       143
       143
       -
           | j -> Util.json_error "Expected object for ListResourceTemplatesRequest.t" j

     

       144
       144
       -
           

     

       145
       145
       -
       end

     

       146
       146
       -
       

     

       147
       147
       -
       (* Resources/Templates/List Response *)

     

       148
       148
       -
       module ListResourceTemplatesResult = struct

     

       149
       149
       -
         module ResourceTemplate = struct

     

       150
       150
       -
           type t = {

     

       151
       151
       -
             uri_template: string;

     

       152
       152
       -
             name: string;

     

       153
       153
       -
             description: string option;

     

       154
       154
       -
             mime_type: string option;

     

       155
       155
       -
           }

     

       156
       156
       -
           

     

       157
       157
       -
           let yojson_of_t { uri_template; name; description; mime_type } =

     

       158
       158
       -
             let assoc = [

     

       159
       159
       -
               ("uriTemplate", `String uri_template);

     

       160
       160
       -
               ("name", `String name);

     

       161
       161
       -
             ] in

     

       162
       162
       -
             let assoc = match description with

     

       163
       163
       -
               | Some desc -> ("description", `String desc) :: assoc

     

       164
       164
       -
               | None -> assoc

     

       165
       165
       -
             in

     

       166
       166
       -
             let assoc = match mime_type with

     

       167
       167
       -
               | Some mime -> ("mimeType", `String mime) :: assoc

     

       168
       168
       -
               | None -> assoc

     

       169
       169
       -
             in

     

       170
       170
       -
             `Assoc assoc

     

       171
       171
       -
           

     

       172
       172
       -
           let t_of_yojson = function

     

       173
       173
       -
             | `Assoc fields as json ->

     

       174
       174
       -
               let uri_template = match List.assoc_opt "uriTemplate" fields with

     

       175
       175
       -
                 | Some (`String s) -> s

     

       176
       176
       -
                 | _ -> Util.json_error "Missing or invalid 'uriTemplate' field" json

     

       177
       177
       -
               in

     

       178
       178
       -
               let name = match List.assoc_opt "name" fields with

     

       179
       179
       -
                 | Some (`String s) -> s

     

       180
       180
       -
                 | _ -> Util.json_error "Missing or invalid 'name' field" json

     

       181
       181
       -
               in

     

       182
       182
       -
               let description = List.assoc_opt "description" fields |> Option.map (function

     

       183
       183
       -
                 | `String s -> s

     

       184
       184
       -
                 | j -> Util.json_error "Expected string for description" j

     

       185
       185
       -
               ) in

     

       186
       186
       -
               let mime_type = List.assoc_opt "mimeType" fields |> Option.map (function

     

       187
       187
       -
                 | `String s -> s

     

       188
       188
       -
                 | j -> Util.json_error "Expected string for mimeType" j

     

       189
       189
       -
               ) in

     

       190
       190
       -
               { uri_template; name; description; mime_type }

     

       191
       191
       -
             | j -> Util.json_error "Expected object for ListResourceTemplatesResult.ResourceTemplate.t" j

     

       192
       192
       -
         end

     

       193
       193
       -
         

     

       194
       194
       -
         type t = {

     

       195
       195
       -
           resource_templates: ResourceTemplate.t list;

     

       196
       196
       -
           next_cursor: Cursor.t option;

     

       197
       197
       -
         }

     

       198
       198
       -
         

     

       199
       199
       -
         let yojson_of_t { resource_templates; next_cursor } =

     

       200
       200
       -
           let assoc = [

     

       201
       201
       -
             ("resourceTemplates", `List (List.map ResourceTemplate.yojson_of_t resource_templates));

     

       202
       202
       -
           ] in

     

       203
       203
       -
           let assoc = match next_cursor with

     

       204
       204
       -
             | Some c -> ("nextCursor", Cursor.yojson_of_t c) :: assoc

     

       205
       205
       -
             | None -> assoc

     

       206
       206
       -
           in

     

       207
       207
       -
           `Assoc assoc

     

       208
       208
       -
         

     

       209
       209
       -
         let t_of_yojson = function

     

       210
       210
       -
           | `Assoc fields as json ->

     

       211
       211
       -
             let resource_templates = match List.assoc_opt "resourceTemplates" fields with

     

       212
       212
       -
               | Some (`List items) -> List.map ResourceTemplate.t_of_yojson items

     

       213
       213
       -
               | _ -> Util.json_error "Missing or invalid 'resourceTemplates' field" json

     

       214
       214
       -
             in

     

       215
       215
       -
             let next_cursor = List.assoc_opt "nextCursor" fields |> Option.map Cursor.t_of_yojson in

     

       216
       216
       -
             { resource_templates; next_cursor }

     

       217
       217
       -
           | j -> Util.json_error "Expected object for ListResourceTemplatesResult.t" j

     

       218
       218
       -
           

     

       219
       219
       -
         (* Request/response creation helpers *)

     

       220
       220
       -
         let create_request ?cursor ?id () =

     

       221
       221
       -
           let id = match id with

     

       222
       222
       -
             | Some i -> i

     

       223
       223
       -
             | None -> `Int (Random.int 10000)

     

       224
       224
       -
           in

     

       225
       225
       -
           let params = ListResourceTemplatesRequest.yojson_of_t { cursor } in

     

       226
       226
       -
           JSONRPCMessage.create_request ~id ~meth:Method.ResourceTemplatesList ~params:(Some params) ()

     

       227
       227
       -
         

     

       228
       228
       -
         let create_response ~id ~resource_templates ?next_cursor () =

     

       229
       229
       -
           let result = yojson_of_t { resource_templates; next_cursor } in

     

       230
       230
       -
           JSONRPCMessage.create_response ~id ~result

     

       231
       231
       -
       end

     

       232
       232
       -
       

     

       233
       233
       -
       (* Resources/Read *)

     

       234
       234
       -
       module ResourcesRead = struct

     

       235
       235
       -
         module Request = struct

     

       236
       236
       -
           type t = {

     

       237
       237
       -
             uri: string;

     

       238
       238
       -
           }

     

       239
       239
       -
           

     

       240
       240
       -
           let yojson_of_t { uri } =

     

       241
       241
       -
             `Assoc [

     

       242
       242
       -
               ("uri", `String uri);

     

       243
       243
       -
             ]

     

       244
       244
       -
           

     

       245
       245
       -
           let t_of_yojson = function

     

       246
       246
       -
             | `Assoc fields as json ->

     

       247
       247
       -
               let uri = match List.assoc_opt "uri" fields with

     

       248
       248
       -
                 | Some (`String s) -> s

     

       249
       249
       -
                 | _ -> Util.json_error "Missing or invalid 'uri' field" json

     

       250
       250
       -
               in

     

       251
       251
       -
               { uri }

     

       252
       252
       -
             | j -> Util.json_error "Expected object for ResourcesRead.Request.t" j

     

       253
       253
       -
             

     

       254
       254
       -
         end

     

       255
       255
       -
         

     

       256
       256
       -
         module ResourceContent = struct

     

       257
       257
       -
           type t = 

     

       258
       258
       -
             | TextResource of TextResourceContents.t

     

       259
       259
       -
             | BlobResource of BlobResourceContents.t

     

       260
       260
       -
           

     

       261
       261
       -
           let yojson_of_t = function

     

       262
       262
       -
             | TextResource tr -> TextResourceContents.yojson_of_t tr

     

       263
       263
       -
             | BlobResource br -> BlobResourceContents.yojson_of_t br

     

       264
       264
       -
           

     

       265
       265
       -
           let t_of_yojson json =

     

       266
       266
       -
             match json with

     

       267
       267
       -
             | `Assoc fields ->

     

       268
       268
       -
               if List.mem_assoc "text" fields then

     

       269
       269
       -
                 TextResource (TextResourceContents.t_of_yojson json)

     

       270
       270
       -
               else if List.mem_assoc "blob" fields then

     

       271
       271
       -
                 BlobResource (BlobResourceContents.t_of_yojson json)

     

       272
       272
       -
               else

     

       273
       273
       -
                 Util.json_error "Invalid resource content" json

     

       274
       274
       -
             | j -> Util.json_error "Expected object for ResourcesRead.ResourceContent.t" j

     

       275
       275
       -
             

     

       276
       276
       -
         end

     

       277
       277
       -
         

     

       278
       278
       -
         module Response = struct

     

       279
       279
       -
           type t = {

     

       280
       280
       -
             contents: ResourceContent.t list;

     

       281
       281
       -
           }

     

       282
       282
       -
           

     

       283
       283
       -
           let yojson_of_t { contents } =

     

       284
       284
       -
             `Assoc [

     

       285
       285
       -
               ("contents", `List (List.map ResourceContent.yojson_of_t contents));

     

       286
       286
       -
             ]

     

       287
       287
       -
           

     

       288
       288
       -
           let t_of_yojson = function

     

       289
       289
       -
             | `Assoc fields as json ->

     

       290
       290
       -
               let contents = match List.assoc_opt "contents" fields with

     

       291
       291
       -
                 | Some (`List items) -> List.map ResourceContent.t_of_yojson items

     

       292
       292
       -
                 | _ -> Util.json_error "Missing or invalid 'contents' field" json

     

       293
       293
       -
               in

     

       294
       294
       -
               { contents }

     

       295
       295
       -
             | j -> Util.json_error "Expected object for ResourcesRead.Response.t" j

     

       296
       296
       -
             

     

       297
       297
       -
         end

     

       298
       298
       -
         

     

       299
       299
       -
         (* Request/response creation helpers *)

     

       300
       300
       -
         let create_request ~uri ?id () =

     

       301
       301
       -
           let id = match id with

     

       302
       302
       -
             | Some i -> i

     

       303
       303
       -
             | None -> `Int (Random.int 10000)

     

       304
       304
       -
           in

     

       305
       305
       -
           let params = Request.yojson_of_t { uri } in

     

       306
       306
       -
           JSONRPCMessage.create_request ~id ~meth:Method.ResourcesRead ~params:(Some params) ()

     

       307
       307
       -
         

     

       308
       308
       -
         let create_response ~id ~contents () =

     

       309
       309
       -
           let result = Response.yojson_of_t { contents } in

     

       310
       310
       -
           JSONRPCMessage.create_response ~id ~result

     

       311
       311
       -
       end

     

       312
       312
       -
       

     

       313
       313
       -
       (* Tools/List *)

     

       314
       314
       -
       module ToolsList = struct

     

       315
       315
       -
         module Request = struct

     

       316
       316
       -
           type t = {

     

       317
       317
       -
             cursor: Cursor.t option;

     

       318
       318
       -
           }

     

       319
       319
       -
           

     

       320
       320
       -
           let yojson_of_t { cursor } =

     

       321
       321
       -
             let assoc = [] in

     

       322
       322
       -
             let assoc = match cursor with

     

       323
       323
       -
               | Some c -> ("cursor", Cursor.yojson_of_t c) :: assoc

     

       324
       324
       -
               | None -> assoc

     

       325
       325
       -
             in

     

       326
       326
       -
             `Assoc assoc

     

       327
       327
       -
           

     

       328
       328
       -
           let t_of_yojson = function

     

       329
       329
       -
             | `Assoc fields ->

     

       330
       330
       -
               let cursor = List.assoc_opt "cursor" fields |> Option.map Cursor.t_of_yojson in

     

       331
       331
       -
               { cursor }

     

       332
       332
       -
             | j -> Util.json_error "Expected object for ToolsList.Request.t" j

     

       333
       333
       -
             

     

       334
       334
       -
         end

     

       335
       335
       -
         

     

       336
       336
       -
         module Tool = struct

     

       337
       337
       -
           type t = {

     

       338
       338
       -
             name: string;

     

       339
       339
       -
             description: string option;

     

       340
       340
       -
             input_schema: Json.t;

     

       341
       341
       -
             annotations: Json.t option;

     

       342
       342
       -
           }

     

       343
       343
       -
           

     

       344
       344
       -
           let yojson_of_t { name; description; input_schema; annotations } =

     

       345
       345
       -
             let assoc = [

     

       346
       346
       -
               ("name", `String name);

     

       347
       347
       -
               ("inputSchema", input_schema);

     

       348
       348
       -
             ] in

     

       349
       349
       -
             let assoc = match description with

     

       350
       350
       -
               | Some desc -> ("description", `String desc) :: assoc

     

       351
       351
       -
               | None -> assoc

     

       352
       352
       -
             in

     

       353
       353
       -
             let assoc = match annotations with

     

       354
       354
       -
               | Some anno -> ("annotations", anno) :: assoc

     

       355
       355
       -
               | None -> assoc

     

       356
       356
       -
             in

     

       357
       357
       -
             `Assoc assoc

     

       358
       358
       -
           

     

       359
       359
       -
           let t_of_yojson = function

     

       360
       360
       -
             | `Assoc fields as json ->

     

       361
       361
       -
               let name = match List.assoc_opt "name" fields with

     

       362
       362
       -
                 | Some (`String s) -> s

     

       363
       363
       -
                 | _ -> Util.json_error "Missing or invalid 'name' field" json

     

       364
       364
       -
               in

     

       365
       365
       -
               let description = List.assoc_opt "description" fields |> Option.map (function

     

       366
       366
       -
                 | `String s -> s

     

       367
       367
       -
                 | j -> Util.json_error "Expected string for description" j

     

       368
       368
       -
               ) in

     

       369
       369
       -
               let input_schema = match List.assoc_opt "inputSchema" fields with

     

       370
       370
       -
                 | Some schema -> schema

     

       371
       371
       -
                 | None -> Util.json_error "Missing 'inputSchema' field" json

     

       372
       372
       -
               in

     

       373
       373
       -
               let annotations = List.assoc_opt "annotations" fields in

     

       374
       374
       -
               { name; description; input_schema; annotations }

     

       375
       375
       -
             | j -> Util.json_error "Expected object for ToolsList.Tool.t" j

     

       376
       376
       -
             

     

       377
       377
       -
         end

     

       378
       378
       -
         

     

       379
       379
       -
         module Response = struct

     

       380
       380
       -
           type t = {

     

       381
       381
       -
             tools: Tool.t list;

     

       382
       382
       -
             next_cursor: Cursor.t option;

     

       383
       383
       -
           }

     

       384
       384
       -
           

     

       385
       385
       -
           let yojson_of_t { tools; next_cursor } =

     

       386
       386
       -
             let assoc = [

     

       387
       387
       -
               ("tools", `List (List.map Tool.yojson_of_t tools));

     

       388
       388
       -
             ] in

     

       389
       389
       -
             let assoc = match next_cursor with

     

       390
       390
       -
               | Some c -> ("nextCursor", Cursor.yojson_of_t c) :: assoc

     

       391
       391
       -
               | None -> assoc

     

       392
       392
       -
             in

     

       393
       393
       -
             `Assoc assoc

     

       394
       394
       -
           

     

       395
       395
       -
           let t_of_yojson = function

     

       396
       396
       -
             | `Assoc fields as json ->

     

       397
       397
       -
               let tools = match List.assoc_opt "tools" fields with

     

       398
       398
       -
                 | Some (`List items) -> List.map Tool.t_of_yojson items

     

       399
       399
       -
                 | _ -> Util.json_error "Missing or invalid 'tools' field" json

     

       400
       400
       -
               in

     

       401
       401
       -
               let next_cursor = List.assoc_opt "nextCursor" fields |> Option.map Cursor.t_of_yojson in

     

       402
       402
       -
               { tools; next_cursor }

     

       403
       403
       -
             | j -> Util.json_error "Expected object for ToolsList.Response.t" j

     

       404
       404
       -
             

     

       405
       405
       -
         end

     

       406
       406
       -
         

     

       407
       407
       -
         (* Request/response creation helpers *)

     

       408
       408
       -
         let create_request ?cursor ?id () =

     

       409
       409
       -
           let id = match id with

     

       410
       410
       -
             | Some i -> i

     

       411
       411
       -
             | None -> `Int (Random.int 10000)

     

       412
       412
       -
           in

     

       413
       413
       -
           let params = Request.yojson_of_t { cursor } in

     

       414
       414
       -
           JSONRPCMessage.create_request ~id ~meth:Method.ToolsList ~params:(Some params) ()

     

       415
       415
       -
         

     

       416
       416
       -
         let create_response ~id ~tools ?next_cursor () =

     

       417
       417
       -
           let result = Response.yojson_of_t { tools; next_cursor } in

     

       418
       418
       -
           JSONRPCMessage.create_response ~id ~result

     

       419
       419
       -
       end

     

       420
       420
       -
       

     

       421
       421
       -
       (* Tools/Call *)

     

       422
       422
       -
       module ToolsCall = struct

     

       423
       423
       -
         module Request = struct

     

       424
       424
       -
           type t = {

     

       425
       425
       -
             name: string;

     

       426
       426
       -
             arguments: Json.t;

     

       427
       427
       -
           }

     

       428
       428
       -
           

     

       429
       429
       -
           let yojson_of_t { name; arguments } =

     

       430
       430
       -
             `Assoc [

     

       431
       431
       -
               ("name", `String name);

     

       432
       432
       -
               ("arguments", arguments);

     

       433
       433
       -
             ]

     

       434
       434
       -
           

     

       435
       435
       -
           let t_of_yojson = function

     

       436
       436
       -
             | `Assoc fields as json ->

     

       437
       437
       -
               let name = match List.assoc_opt "name" fields with

     

       438
       438
       -
                 | Some (`String s) -> s

     

       439
       439
       -
                 | _ -> Util.json_error "Missing or invalid 'name' field" json

     

       440
       440
       -
               in

     

       441
       441
       -
               let arguments = match List.assoc_opt "arguments" fields with

     

       442
       442
       -
                 | Some json -> json

     

       443
       443
       -
                 | None -> Util.json_error "Missing 'arguments' field" json

     

       444
       444
       -
               in

     

       445
       445
       -
               { name; arguments }

     

       446
       446
       -
             | j -> Util.json_error "Expected object for ToolsCall.Request.t" j

     

       447
       447
       -
             

     

       448
       448
       -
         end

     

       449
       449
       -
         

     

       450
       450
       -
         module ToolContent = struct

     

       451
       451
       -
           type t = 

     

       452
       452
       -
             | Text of TextContent.t

     

       453
       453
       -
             | Image of ImageContent.t

     

       454
       454
       -
             | Audio of AudioContent.t

     

       455
       455
       -
             | Resource of EmbeddedResource.t

     

       456
       456
       -
           

     

       457
       457
       -
           let yojson_of_t = function

     

       458
       458
       -
             | Text t -> TextContent.yojson_of_t t

     

       459
       459
       -
             | Image i -> ImageContent.yojson_of_t i

     

       460
       460
       -
             | Audio a -> AudioContent.yojson_of_t a

     

       461
       461
       -
             | Resource r -> EmbeddedResource.yojson_of_t r

     

       462
       462
       -
           

     

       463
       463
       -
           let t_of_yojson json =

     

       464
       464
       -
             match json with

     

       465
       465
       -
             | `Assoc fields ->

     

       466
       466
       -
               (match List.assoc_opt "type" fields with

     

       467
       467
       -
                | Some (`String "text") -> Text (TextContent.t_of_yojson json)

     

       468
       468
       -
                | Some (`String "image") -> Image (ImageContent.t_of_yojson json)

     

       469
       469
       -
                | Some (`String "audio") -> Audio (AudioContent.t_of_yojson json)

     

       470
       470
       -
                | Some (`String "resource") -> Resource (EmbeddedResource.t_of_yojson json)

     

       471
       471
       -
                | _ -> Util.json_error "Invalid or missing content type" json)

     

       472
       472
       -
             | j -> Util.json_error "Expected object for ToolsCall.ToolContent.t" j

     

       473
       473
       -
             

     

       474
       474
       -
         end

     

       475
       475
       -
         

     

       476
       476
       -
         module Response = struct

     

       477
       477
       -
           type t = {

     

       478
       478
       -
             content: ToolContent.t list;

     

       479
       479
       -
             is_error: bool;

     

       480
       480
       -
           }

     

       481
       481
       -
           

     

       482
       482
       -
           let yojson_of_t { content; is_error } =

     

       483
       483
       -
             `Assoc [

     

       484
       484
       -
               ("content", `List (List.map ToolContent.yojson_of_t content));

     

       485
       485
       -
               ("isError", `Bool is_error);

     

       486
       486
       -
             ]

     

       487
       487
       -
           

     

       488
       488
       -
           let t_of_yojson = function

     

       489
       489
       -
             | `Assoc fields as json ->

     

       490
       490
       -
               let content = match List.assoc_opt "content" fields with

     

       491
       491
       -
                 | Some (`List items) -> List.map ToolContent.t_of_yojson items

     

       492
       492
       -
                 | _ -> Util.json_error "Missing or invalid 'content' field" json

     

       493
       493
       -
               in

     

       494
       494
       -
               let is_error = match List.assoc_opt "isError" fields with

     

       495
       495
       -
                 | Some (`Bool b) -> b

     

       496
       496
       -
                 | _ -> false

     

       497
       497
       -
               in

     

       498
       498
       -
               { content; is_error }

     

       499
       499
       -
             | j -> Util.json_error "Expected object for ToolsCall.Response.t" j

     

       500
       500
       -
             

     

       501
       501
       -
         end

     

       502
       502
       -
         

     

       503
       503
       -
         (* Request/response creation helpers *)

     

       504
       504
       -
         let create_request ~name ~arguments ?id () =

     

       505
       505
       -
           let id = match id with

     

       506
       506
       -
             | Some i -> i

     

       507
       507
       -
             | None -> `Int (Random.int 10000)

     

       508
       508
       -
           in

     

       509
       509
       -
           let params = Request.yojson_of_t { name; arguments } in

     

       510
       510
       -
           JSONRPCMessage.create_request ~id ~meth:Method.ToolsCall ~params:(Some params) ()

     

       511
       511
       -
         

     

       512
       512
       -
         let create_response ~id ~content ~is_error () =

     

       513
       513
       -
           let result = Response.yojson_of_t { content; is_error } in

     

       514
       514
       -
           JSONRPCMessage.create_response ~id ~result

     

       515
       515
       -
       end

     

       516
       516
       -
       

     

       517
       517
       -
       (* Prompts/List *)

     

       518
       518
       -
       module PromptsList = struct

     

       519
       519
       -
         module PromptArgument = struct

     

       520
       520
       -
           type t = {

     

       521
       521
       -
             name: string;

     

       522
       522
       -
             description: string option;

     

       523
       523
       -
             required: bool;

     

       524
       524
       -
           }

     

       525
       525
       -
           

     

       526
       526
       -
           let yojson_of_t { name; description; required } =

     

       527
       527
       -
             let assoc = [

     

       528
       528
       -
               ("name", `String name);

     

       529
       529
       -
             ] in

     

       530
       530
       -
             let assoc = match description with

     

       531
       531
       -
               | Some desc -> ("description", `String desc) :: assoc

     

       532
       532
       -
               | None -> assoc

     

       533
       533
       -
             in

     

       534
       534
       -
             let assoc = if required then

     

       535
       535
       -
               ("required", `Bool true) :: assoc

     

       536
       536
       -
             else

     

       537
       537
       -
               assoc

     

       538
       538
       -
             in

     

       539
       539
       -
             `Assoc assoc

     

       540
       540
       -
           

     

       541
       541
       -
           let t_of_yojson = function

     

       542
       542
       -
             | `Assoc fields as json ->

     

       543
       543
       -
               let name = match List.assoc_opt "name" fields with

     

       544
       544
       -
                 | Some (`String s) -> s

     

       545
       545
       -
                 | _ -> Util.json_error "Missing or invalid 'name' field" json

     

       546
       546
       -
               in

     

       547
       547
       -
               let description = List.assoc_opt "description" fields |> Option.map (function

     

       548
       548
       -
                 | `String s -> s

     

       549
       549
       -
                 | j -> Util.json_error "Expected string for description" j

     

       550
       550
       -
               ) in

     

       551
       551
       -
               let required = match List.assoc_opt "required" fields with

     

       552
       552
       -
                 | Some (`Bool b) -> b

     

       553
       553
       -
                 | _ -> false

     

       554
       554
       -
               in

     

       555
       555
       -
               { name; description; required }

     

       556
       556
       -
             | j -> Util.json_error "Expected object for PromptsList.PromptArgument.t" j

     

       557
       557
       -
             

     

       558
       558
       -
         end

     

       559
       559
       -
         

     

       560
       560
       -
         module Prompt = struct

     

       561
       561
       -
           type t = {

     

       562
       562
       -
             name: string;

     

       563
       563
       -
             description: string option;

     

       564
       564
       -
             arguments: PromptArgument.t list;

     

       565
       565
       -
           }

     

       566
       566
       -
           

     

       567
       567
       -
           let yojson_of_t { name; description; arguments } =

     

       568
       568
       -
             let assoc = [

     

       569
       569
       -
               ("name", `String name);

     

       570
       570
       -
             ] in

     

       571
       571
       -
             let assoc = match description with

     

       572
       572
       -
               | Some desc -> ("description", `String desc) :: assoc

     

       573
       573
       -
               | None -> assoc

     

       574
       574
       -
             in

     

       575
       575
       -
             let assoc = if arguments <> [] then

     

       576
       576
       -
               ("arguments", `List (List.map PromptArgument.yojson_of_t arguments)) :: assoc

     

       577
       577
       -
             else

     

       578
       578
       -
               assoc

     

       579
       579
       -
             in

     

       580
       580
       -
             `Assoc assoc

     

       581
       581
       -
           

     

       582
       582
       -
           let t_of_yojson = function

     

       583
       583
       -
             | `Assoc fields as json ->

     

       584
       584
       -
               let name = match List.assoc_opt "name" fields with

     

       585
       585
       -
                 | Some (`String s) -> s

     

       586
       586
       -
                 | _ -> Util.json_error "Missing or invalid 'name' field" json

     

       587
       587
       -
               in

     

       588
       588
       -
               let description = List.assoc_opt "description" fields |> Option.map (function

     

       589
       589
       -
                 | `String s -> s

     

       590
       590
       -
                 | j -> Util.json_error "Expected string for description" j

     

       591
       591
       -
               ) in

     

       592
       592
       -
               let arguments = match List.assoc_opt "arguments" fields with

     

       593
       593
       -
                 | Some (`List items) -> List.map PromptArgument.t_of_yojson items

     

       594
       594
       -
                 | _ -> []

     

       595
       595
       -
               in

     

       596
       596
       -
               { name; description; arguments }

     

       597
       597
       -
             | j -> Util.json_error "Expected object for PromptsList.Prompt.t" j

     

       598
       598
       -
             

     

       599
       599
       -
         end

     

       600
       600
       -
         

     

       601
       601
       -
         module Request = struct

     

       602
       602
       -
           type t = {

     

       603
       603
       -
             cursor: Cursor.t option;

     

       604
       604
       -
           }

     

       605
       605
       -
           

     

       606
       606
       -
           let yojson_of_t { cursor } =

     

       607
       607
       -
             let assoc = [] in

     

       608
       608
       -
             let assoc = match cursor with

     

       609
       609
       -
               | Some c -> ("cursor", Cursor.yojson_of_t c) :: assoc

     

       610
       610
       -
               | None -> assoc

     

       611
       611
       -
             in

     

       612
       612
       -
             `Assoc assoc

     

       613
       613
       -
           

     

       614
       614
       -
           let t_of_yojson = function

     

       615
       615
       -
             | `Assoc fields ->

     

       616
       616
       -
               let cursor = List.assoc_opt "cursor" fields |> Option.map Cursor.t_of_yojson in

     

       617
       617
       -
               { cursor }

     

       618
       618
       -
             | j -> Util.json_error "Expected object for PromptsList.Request.t" j

     

       619
       619
       -
             

     

       620
       620
       -
         end

     

       621
       621
       -
         

     

       622
       622
       -
         module Response = struct

     

       623
       623
       -
           type t = {

     

       624
       624
       -
             prompts: Prompt.t list;

     

       625
       625
       -
             next_cursor: Cursor.t option;

     

       626
       626
       -
           }

     

       627
       627
       -
           

     

       628
       628
       -
           let yojson_of_t { prompts; next_cursor } =

     

       629
       629
       -
             let assoc = [

     

       630
       630
       -
               ("prompts", `List (List.map Prompt.yojson_of_t prompts));

     

       631
       631
       -
             ] in

     

       632
       632
       -
             let assoc = match next_cursor with

     

       633
       633
       -
               | Some c -> ("nextCursor", Cursor.yojson_of_t c) :: assoc

     

       634
       634
       -
               | None -> assoc

     

       635
       635
       -
             in

     

       636
       636
       -
             `Assoc assoc

     

       637
       637
       -
           

     

       638
       638
       -
           let t_of_yojson = function

     

       639
       639
       -
             | `Assoc fields as json ->

     

       640
       640
       -
               let prompts = match List.assoc_opt "prompts" fields with

     

       641
       641
       -
                 | Some (`List items) -> List.map Prompt.t_of_yojson items

     

       642
       642
       -
                 | _ -> Util.json_error "Missing or invalid 'prompts' field" json

     

       643
       643
       -
               in

     

       644
       644
       -
               let next_cursor = List.assoc_opt "nextCursor" fields |> Option.map Cursor.t_of_yojson in

     

       645
       645
       -
               { prompts; next_cursor }

     

       646
       646
       -
             | j -> Util.json_error "Expected object for PromptsList.Response.t" j

     

       647
       647
       -
             

     

       648
       648
       -
         end

     

       649
       649
       -
         

     

       650
       650
       -
         (* Request/response creation helpers *)

     

       651
       651
       -
         let create_request ?cursor ?id () =

     

       652
       652
       -
           let id = match id with

     

       653
       653
       -
             | Some i -> i

     

       654
       654
       -
             | None -> `Int (Random.int 10000)

     

       655
       655
       -
           in

     

       656
       656
       -
           let params = Request.yojson_of_t { cursor } in

     

       657
       657
       -
           JSONRPCMessage.create_request ~id ~meth:Method.PromptsList ~params:(Some params) ()

     

       658
       658
       -
         

     

       659
       659
       -
         let create_response ~id ~prompts ?next_cursor () =

     

       660
       660
       -
           let result = Response.yojson_of_t { prompts; next_cursor } in

     

       661
       661
       -
           JSONRPCMessage.create_response ~id ~result

     

       662
       662
       -
       end

     

       663
       663
       -
       

     

       664
       664
       -
       (* Prompts/Get *)

     

       665
       665
       -
       module PromptsGet = struct

     

       666
       666
       -
         module Request = struct

     

       667
       667
       -
           type t = {

     

       668
       668
       -
             name: string;

     

       669
       669
       -
             arguments: (string * string) list;

     

       670
       670
       -
           }

     

       671
       671
       -
           

     

       672
       672
       -
           let yojson_of_t { name; arguments } =

     

       673
       673
       -
             let args_json = `Assoc (List.map (fun (k, v) -> (k, `String v)) arguments) in

     

       674
       674
       -
             `Assoc [

     

       675
       675
       -
               ("name", `String name);

     

       676
       676
       -
               ("arguments", args_json);

     

       677
       677
       -
             ]

     

       678
       678
       -
           

     

       679
       679
       -
           let t_of_yojson = function

     

       680
       680
       -
             | `Assoc fields as json ->

     

       681
       681
       -
               let name = match List.assoc_opt "name" fields with

     

       682
       682
       -
                 | Some (`String s) -> s

     

       683
       683
       -
                 | _ -> Util.json_error "Missing or invalid 'name' field" json

     

       684
       684
       -
               in

     

       685
       685
       -
               let arguments = match List.assoc_opt "arguments" fields with

     

       686
       686
       -
                 | Some (`Assoc args) -> 

     

       687
       687
       -
                   List.map (fun (k, v) -> 

     

       688
       688
       -
                     match v with

     

       689
       689
       -
                     | `String s -> (k, s)

     

       690
       690
       -
                     | _ -> Util.json_error "Expected string value for argument" v

     

       691
       691
       -
                   ) args

     

       692
       692
       -
                 | _ -> []

     

       693
       693
       -
               in

     

       694
       694
       -
               { name; arguments }

     

       695
       695
       -
             | j -> Util.json_error "Expected object for PromptsGet.Request.t" j

     

       696
       696
       -
             

     

       697
       697
       -
         end

     

       698
       698
       -
         

     

       699
       699
       -
         module Response = struct

     

       700
       700
       -
           type t = {

     

       701
       701
       -
             description: string option;

     

       702
       702
       -
             messages: PromptMessage.t list;

     

       703
       703
       -
           }

     

       704
       704
       -
           

     

       705
       705
       -
           let yojson_of_t { description; messages } =

     

       706
       706
       -
             let assoc = [

     

       707
       707
       -
               ("messages", `List (List.map PromptMessage.yojson_of_t messages));

     

       708
       708
       -
             ] in

     

       709
       709
       -
             let assoc = match description with

     

       710
       710
       -
               | Some desc -> ("description", `String desc) :: assoc

     

       711
       711
       -
               | None -> assoc

     

       712
       712
       -
             in

     

       713
       713
       -
             `Assoc assoc

     

       714
       714
       -
           

     

       715
       715
       -
           let t_of_yojson = function

     

       716
       716
       -
             | `Assoc fields as json ->

     

       717
       717
       -
               let messages = match List.assoc_opt "messages" fields with

     

       718
       718
       -
                 | Some (`List items) -> List.map PromptMessage.t_of_yojson items

     

       719
       719
       -
                 | _ -> Util.json_error "Missing or invalid 'messages' field" json

     

       720
       720
       -
               in

     

       721
       721
       -
               let description = List.assoc_opt "description" fields |> Option.map (function

     

       722
       722
       -
                 | `String s -> s

     

       723
       723
       -
                 | j -> Util.json_error "Expected string for description" j

     

       724
       724
       -
               ) in

     

       725
       725
       -
               { description; messages }

     

       726
       726
       -
             | j -> Util.json_error "Expected object for PromptsGet.Response.t" j

     

       727
       727
       -
             

     

       728
       728
       -
         end

     

       729
       729
       -
         

     

       730
       730
       -
         (* Request/response creation helpers *)

     

       731
       731
       -
         let create_request ~name ~arguments ?id () =

     

       732
       732
       -
           let id = match id with

     

       733
       733
       -
             | Some i -> i

     

       734
       734
       -
             | None -> `Int (Random.int 10000)

     

       735
       735
       -
           in

     

       736
       736
       -
           let params = Request.yojson_of_t { name; arguments } in

     

       737
       737
       -
           JSONRPCMessage.create_request ~id ~meth:Method.PromptsGet ~params:(Some params) ()

     

       738
       738
       -
         

     

       739
       739
       -
         let create_response ~id ?description ~messages () =

     

       740
       740
       -
           let result = Response.yojson_of_t { description; messages } in

     

       741
       741
       -
           JSONRPCMessage.create_response ~id ~result

     

       742
       742
       -
       end

     

       743
       743
       -
       

     

       744
       744
       -
       (* List Changed Notifications *)

     

       745
       745
       -
       module ListChanged = struct

     

       746
       746
       -
         (* No parameters for these notifications *)

     

       747
       747
       -
         

     

       748
       748
       -
         let create_resources_notification () =

     

       749
       749
       -
           JSONRPCMessage.create_notification ~meth:Method.ResourcesListChanged ()

     

       750
       750
       -
         

     

       751
       751
       -
         let create_tools_notification () =

     

       752
       752
       -
           JSONRPCMessage.create_notification ~meth:Method.ToolsListChanged ()

     

       753
       753
       -
         

     

       754
       754
       -
         let create_prompts_notification () =

     

       755
       755
       -
           JSONRPCMessage.create_notification ~meth:Method.PromptsListChanged ()

     

       756
       756
       -
       end

     

       757
       757
       -
       

     

       758
       758
       -
       (* Resource Updated Notification *)

     

       759
       759
       -
       module ResourceUpdated = struct

     

       760
       760
       -
         module Notification = struct

     

       761
       761
       -
           type t = {

     

       762
       762
       -
             uri: string;

     

       763
       763
       -
           }

     

       764
       764
       -
           

     

       765
       765
       -
           let yojson_of_t { uri } =

     

       766
       766
       -
             `Assoc [

     

       767
       767
       -
               ("uri", `String uri);

     

       768
       768
       -
             ]

     

       769
       769
       -
           

     

       770
       770
       -
           let t_of_yojson = function

     

       771
       771
       -
             | `Assoc fields as json ->

     

       772
       772
       -
               let uri = match List.assoc_opt "uri" fields with

     

       773
       773
       -
                 | Some (`String s) -> s

     

       774
       774
       -
                 | _ -> Util.json_error "Missing or invalid 'uri' field" json

     

       775
       775
       -
               in

     

       776
       776
       -
               { uri }

     

       777
       777
       -
             | j -> Util.json_error "Expected object for ResourceUpdated.Notification.t" j

     

       778
       778
       -
             

     

       779
       779
       -
         end

     

       780
       780
       -
         

     

       781
       781
       -
         let create_notification ~uri () =

     

       782
       782
       -
           let params = Notification.yojson_of_t { uri } in

     

       783
       783
       -
           JSONRPCMessage.create_notification ~meth:Method.ResourcesUpdated ~params:(Some params) ()

     

       784
       784
       -
       end

     

       785
       785
       -
       

     

       786
       786
       -
       (* Progress Notification *)

     

       787
       787
       -
       module Progress = struct

     

       788
       788
       -
         module Notification = struct

     

       789
       789
       -
           type t = {

     

       790
       790
       -
             progress: float;

     

       791
       791
       -
             total: float;

     

       792
       792
       -
             progress_token: ProgressToken.t;

     

       793
       793
       -
           }

     

       794
       794
       -
           

     

       795
       795
       -
           let yojson_of_t { progress; total; progress_token } =

     

       796
       796
       -
             `Assoc [

     

       797
       797
       -
               ("progress", `Float progress);

     

       798
       798
       -
               ("total", `Float total);

     

       799
       799
       -
               ("progressToken", ProgressToken.yojson_of_t progress_token);

     

       800
       800
       -
             ]

     

       801
       801
       -
           

     

       802
       802
       -
           let t_of_yojson = function

     

       803
       803
       -
             | `Assoc fields as json ->

     

       804
       804
       -
               let progress = match List.assoc_opt "progress" fields with

     

       805
       805
       -
                 | Some (`Float f) -> f

     

       806
       806
       -
                 | _ -> Util.json_error "Missing or invalid 'progress' field" json

     

       807
       807
       -
               in

     

       808
       808
       -
               let total = match List.assoc_opt "total" fields with

     

       809
       809
       -
                 | Some (`Float f) -> f

     

       810
       810
       -
                 | _ -> Util.json_error "Missing or invalid 'total' field" json

     

       811
       811
       -
               in

     

       812
       812
       -
               let progress_token = match List.assoc_opt "progressToken" fields with

     

       813
       813
       -
                 | Some token -> ProgressToken.t_of_yojson token

     

       814
       814
       -
                 | _ -> Util.json_error "Missing or invalid 'progressToken' field" json

     

       815
       815
       -
               in

     

       816
       816
       -
               { progress; total; progress_token }

     

       817
       817
       -
             | j -> Util.json_error "Expected object for Progress.Notification.t" j

     

       818
       818
       -
             

     

       819
       819
       -
         end

     

       820
       820
       -
         

     

       821
       821
       -
         let create_notification ~progress ~total ~progress_token () =

     

       822
       822
       -
           let params = Notification.yojson_of_t { progress; total; progress_token } in

     

       823
       823
       -
           JSONRPCMessage.create_notification ~meth:Method.Progress ~params:(Some params) ()

     

       824
       824
       -
       end

     

       825
       825
       -
       

     

       826
       826
       -
       (* Type aliases for backward compatibility *)

     

       827
       827
       -
       type request = ResourcesList.Request.t

     

       828
       828
       -
       type response = ResourcesList.Response.t 

     

       829
       829
       -
       type resource = ResourcesList.Resource.t

     

       830
       830
       -
       type resource_content = ResourcesRead.ResourceContent.t

     

       831
       831
       -
       type tool = ToolsList.Tool.t

     

       832
       832
       -
       type tool_content = ToolsCall.ToolContent.t

     

       833
       833
       -
       type prompt = PromptsList.Prompt.t

     

       834
       834
       -
       type prompt_argument = PromptsList.PromptArgument.t

-298

lib/mcp_rpc.mli

···

       1
       1
       -
       (** Mcp_message - High-level RPC message definitions for Model Context Protocol *)

     

       2
       2
       -
       

     

       3
       3
       -
       open Mcp

     

       4
       4
       -
       open Jsonrpc

     

       5
       5
       -
       

     

       6
       6
       -
       (** Resources/List - Request to list available resources *)

     

       7
       7
       -
       module ResourcesList : sig

     

       8
       8
       -
         (** Request parameters *)

     

       9
       9
       -
         module Request : sig

     

       10
       10
       -
           type t = {

     

       11
       11
       -
             cursor: Cursor.t option; (** Optional pagination cursor *)

     

       12
       12
       -
           }

     

       13
       13
       -
           include Json.Jsonable.S with type t := t

     

       14
       14
       -
         end

     

       15
       15
       -
         

     

       16
       16
       -
         (** Resource definition *)

     

       17
       17
       -
         module Resource : sig

     

       18
       18
       -
           type t = {

     

       19
       19
       -
             uri: string; (** Unique identifier for the resource *)

     

       20
       20
       -
             name: string; (** Human-readable name *)

     

       21
       21
       -
             description: string option; (** Optional description *)

     

       22
       22
       -
             mime_type: string option; (** Optional MIME type *)

     

       23
       23
       -
             size: int option; (** Optional size in bytes *)

     

       24
       24
       -
           }

     

       25
       25
       -
           include Json.Jsonable.S with type t := t

     

       26
       26
       -
         end

     

       27
       27
       -
         

     

       28
       28
       -
         (** Response result *)

     

       29
       29
       -
         module Response : sig

     

       30
       30
       -
           type t = {

     

       31
       31
       -
             resources: Resource.t list; (** List of available resources *)

     

       32
       32
       -
             next_cursor: Cursor.t option; (** Optional cursor for the next page *)

     

       33
       33
       -
           }

     

       34
       34
       -
           include Json.Jsonable.S with type t := t

     

       35
       35
       -
         end

     

       36
       36
       -
         

     

       37
       37
       -
         (** Create a resources/list request *)

     

       38
       38
       -
         val create_request : ?cursor:Cursor.t -> ?id:RequestId.t -> unit -> JSONRPCMessage.t

     

       39
       39
       -
         

     

       40
       40
       -
         (** Create a resources/list response *)

     

       41
       41
       -
         val create_response : id:RequestId.t -> resources:Resource.t list -> ?next_cursor:Cursor.t -> unit -> JSONRPCMessage.t

     

       42
       42
       -
       end

     

       43
       43
       -
       

     

       44
       44
       -
       (** Resources/Templates/List - Request to list available resource templates *)

     

       45
       45
       -
       module ListResourceTemplatesRequest : sig

     

       46
       46
       -
         type t = {

     

       47
       47
       -
           cursor: Cursor.t option; (** Optional pagination cursor *)

     

       48
       48
       -
         }

     

       49
       49
       -
         include Json.Jsonable.S with type t := t

     

       50
       50
       -
       end

     

       51
       51
       -
       

     

       52
       52
       -
       (** Resources/Templates/List - Response with resource templates *)

     

       53
       53
       -
       module ListResourceTemplatesResult : sig

     

       54
       54
       -
         (** Resource Template definition *)

     

       55
       55
       -
         module ResourceTemplate : sig

     

       56
       56
       -
           type t = {

     

       57
       57
       -
             uri_template: string; (** URI template for the resource *)

     

       58
       58
       -
             name: string; (** Human-readable name *)

     

       59
       59
       -
             description: string option; (** Optional description *)

     

       60
       60
       -
             mime_type: string option; (** Optional MIME type *)

     

       61
       61
       -
           }

     

       62
       62
       -
           include Json.Jsonable.S with type t := t

     

       63
       63
       -
         end

     

       64
       64
       -
         

     

       65
       65
       -
         type t = {

     

       66
       66
       -
           resource_templates: ResourceTemplate.t list; (** List of available resource templates *)

     

       67
       67
       -
           next_cursor: Cursor.t option; (** Optional cursor for the next page *)

     

       68
       68
       -
         }

     

       69
       69
       -
         include Json.Jsonable.S with type t := t

     

       70
       70
       -
         

     

       71
       71
       -
         (** Create a resources/templates/list request *)

     

       72
       72
       -
         val create_request : ?cursor:Cursor.t -> ?id:RequestId.t -> unit -> JSONRPCMessage.t

     

       73
       73
       -
         

     

       74
       74
       -
         (** Create a resources/templates/list response *)

     

       75
       75
       -
         val create_response : id:RequestId.t -> resource_templates:ResourceTemplate.t list -> ?next_cursor:Cursor.t -> unit -> JSONRPCMessage.t

     

       76
       76
       -
       end

     

       77
       77
       -
       

     

       78
       78
       -
       (** Resources/Read - Request to read resource contents *)

     

       79
       79
       -
       module ResourcesRead : sig

     

       80
       80
       -
         (** Request parameters *)

     

       81
       81
       -
         module Request : sig

     

       82
       82
       -
           type t = {

     

       83
       83
       -
             uri: string; (** URI of the resource to read *)

     

       84
       84
       -
           }

     

       85
       85
       -
           include Json.Jsonable.S with type t := t

     

       86
       86
       -
         end

     

       87
       87
       -
         

     

       88
       88
       -
         (** Resource content *)

     

       89
       89
       -
         module ResourceContent : sig

     

       90
       90
       -
           type t = 

     

       91
       91
       -
             | TextResource of TextResourceContents.t (** Text content *)

     

       92
       92
       -
             | BlobResource of BlobResourceContents.t (** Binary content *)

     

       93
       93
       -
           include Json.Jsonable.S with type t := t

     

       94
       94
       -
         end

     

       95
       95
       -
         

     

       96
       96
       -
         (** Response result *)

     

       97
       97
       -
         module Response : sig

     

       98
       98
       -
           type t = {

     

       99
       99
       -
             contents: ResourceContent.t list; (** List of resource contents *)

     

       100
       100
       -
           }

     

       101
       101
       -
           include Json.Jsonable.S with type t := t

     

       102
       102
       -
         end

     

       103
       103
       -
         

     

       104
       104
       -
         (** Create a resources/read request *)

     

       105
       105
       -
         val create_request : uri:string -> ?id:RequestId.t -> unit -> JSONRPCMessage.t

     

       106
       106
       -
         

     

       107
       107
       -
         (** Create a resources/read response *)

     

       108
       108
       -
         val create_response : id:RequestId.t -> contents:ResourceContent.t list -> unit -> JSONRPCMessage.t

     

       109
       109
       -
       end

     

       110
       110
       -
       

     

       111
       111
       -
       (** Tools/List - Request to list available tools *)

     

       112
       112
       -
       module ToolsList : sig

     

       113
       113
       -
         (** Request parameters *)

     

       114
       114
       -
         module Request : sig

     

       115
       115
       -
           type t = {

     

       116
       116
       -
             cursor: Cursor.t option; (** Optional pagination cursor *)

     

       117
       117
       -
           }

     

       118
       118
       -
           include Json.Jsonable.S with type t := t

     

       119
       119
       -
         end

     

       120
       120
       -
         

     

       121
       121
       -
         (** Tool definition *)

     

       122
       122
       -
         module Tool : sig

     

       123
       123
       -
           type t = {

     

       124
       124
       -
             name: string; (** Unique identifier for the tool *)

     

       125
       125
       -
             description: string option; (** Human-readable description *)

     

       126
       126
       -
             input_schema: Json.t; (** JSON Schema defining expected parameters *)

     

       127
       127
       -
             annotations: Json.t option; (** Optional properties describing tool behavior *)

     

       128
       128
       -
           }

     

       129
       129
       -
           include Json.Jsonable.S with type t := t

     

       130
       130
       -
         end

     

       131
       131
       -
         

     

       132
       132
       -
         (** Response result *)

     

       133
       133
       -
         module Response : sig

     

       134
       134
       -
           type t = {

     

       135
       135
       -
             tools: Tool.t list; (** List of available tools *)

     

       136
       136
       -
             next_cursor: Cursor.t option; (** Optional cursor for the next page *)

     

       137
       137
       -
           }

     

       138
       138
       -
           include Json.Jsonable.S with type t := t

     

       139
       139
       -
         end

     

       140
       140
       -
         

     

       141
       141
       -
         (** Create a tools/list request *)

     

       142
       142
       -
         val create_request : ?cursor:Cursor.t -> ?id:RequestId.t -> unit -> JSONRPCMessage.t

     

       143
       143
       -
         

     

       144
       144
       -
         (** Create a tools/list response *)

     

       145
       145
       -
         val create_response : id:RequestId.t -> tools:Tool.t list -> ?next_cursor:Cursor.t -> unit -> JSONRPCMessage.t

     

       146
       146
       -
       end

     

       147
       147
       -
       

     

       148
       148
       -
       (** Tools/Call - Request to invoke a tool *)

     

       149
       149
       -
       module ToolsCall : sig

     

       150
       150
       -
         (** Request parameters *)

     

       151
       151
       -
         module Request : sig

     

       152
       152
       -
           type t = {

     

       153
       153
       -
             name: string; (** Name of the tool to call *)

     

       154
       154
       -
             arguments: Json.t; (** Arguments for the tool invocation *)

     

       155
       155
       -
           }

     

       156
       156
       -
           include Json.Jsonable.S with type t := t

     

       157
       157
       -
         end

     

       158
       158
       -
         

     

       159
       159
       -
         (** Tool content *)

     

       160
       160
       -
         module ToolContent : sig

     

       161
       161
       -
           type t = 

     

       162
       162
       -
             | Text of TextContent.t (** Text content *)

     

       163
       163
       -
             | Image of ImageContent.t (** Image content *)

     

       164
       164
       -
             | Audio of AudioContent.t (** Audio content *)

     

       165
       165
       -
             | Resource of EmbeddedResource.t (** Resource content *)

     

       166
       166
       -
           include Json.Jsonable.S with type t := t

     

       167
       167
       -
         end

     

       168
       168
       -
         

     

       169
       169
       -
         (** Response result *)

     

       170
       170
       -
         module Response : sig

     

       171
       171
       -
           type t = {

     

       172
       172
       -
             content: ToolContent.t list; (** List of content items returned by the tool *)

     

       173
       173
       -
             is_error: bool; (** Whether the result represents an error *)

     

       174
       174
       -
           }

     

       175
       175
       -
           include Json.Jsonable.S with type t := t

     

       176
       176
       -
         end

     

       177
       177
       -
         

     

       178
       178
       -
         (** Create a tools/call request *)

     

       179
       179
       -
         val create_request : name:string -> arguments:Json.t -> ?id:RequestId.t -> unit -> JSONRPCMessage.t

     

       180
       180
       -
         

     

       181
       181
       -
         (** Create a tools/call response *)

     

       182
       182
       -
         val create_response : id:RequestId.t -> content:ToolContent.t list -> is_error:bool -> unit -> JSONRPCMessage.t

     

       183
       183
       -
       end

     

       184
       184
       -
       

     

       185
       185
       -
       (** Prompts/List - Request to list available prompts *)

     

       186
       186
       -
       module PromptsList : sig

     

       187
       187
       -
         (** Prompt argument *)

     

       188
       188
       -
         module PromptArgument : sig

     

       189
       189
       -
           type t = {

     

       190
       190
       -
             name: string; (** Name of the argument *)

     

       191
       191
       -
             description: string option; (** Description of the argument *)

     

       192
       192
       -
             required: bool; (** Whether the argument is required *)

     

       193
       193
       -
           }

     

       194
       194
       -
           include Json.Jsonable.S with type t := t

     

       195
       195
       -
         end

     

       196
       196
       -
         

     

       197
       197
       -
         (** Prompt definition *)

     

       198
       198
       -
         module Prompt : sig

     

       199
       199
       -
           type t = {

     

       200
       200
       -
             name: string; (** Unique identifier for the prompt *)

     

       201
       201
       -
             description: string option; (** Human-readable description *)

     

       202
       202
       -
             arguments: PromptArgument.t list; (** Arguments for customization *)

     

       203
       203
       -
           }

     

       204
       204
       -
           include Json.Jsonable.S with type t := t

     

       205
       205
       -
         end

     

       206
       206
       -
         

     

       207
       207
       -
         (** Request parameters *)

     

       208
       208
       -
         module Request : sig

     

       209
       209
       -
           type t = {

     

       210
       210
       -
             cursor: Cursor.t option; (** Optional pagination cursor *)

     

       211
       211
       -
           }

     

       212
       212
       -
           include Json.Jsonable.S with type t := t

     

       213
       213
       -
         end

     

       214
       214
       -
         

     

       215
       215
       -
         (** Response result *)

     

       216
       216
       -
         module Response : sig

     

       217
       217
       -
           type t = {

     

       218
       218
       -
             prompts: Prompt.t list; (** List of available prompts *)

     

       219
       219
       -
             next_cursor: Cursor.t option; (** Optional cursor for the next page *)

     

       220
       220
       -
           }

     

       221
       221
       -
           include Json.Jsonable.S with type t := t

     

       222
       222
       -
         end

     

       223
       223
       -
         

     

       224
       224
       -
         (** Create a prompts/list request *)

     

       225
       225
       -
         val create_request : ?cursor:Cursor.t -> ?id:RequestId.t -> unit -> JSONRPCMessage.t

     

       226
       226
       -
         

     

       227
       227
       -
         (** Create a prompts/list response *)

     

       228
       228
       -
         val create_response : id:RequestId.t -> prompts:Prompt.t list -> ?next_cursor:Cursor.t -> unit -> JSONRPCMessage.t

     

       229
       229
       -
       end

     

       230
       230
       -
       

     

       231
       231
       -
       (** Prompts/Get - Request to get a prompt with arguments *)

     

       232
       232
       -
       module PromptsGet : sig

     

       233
       233
       -
         (** Request parameters *)

     

       234
       234
       -
         module Request : sig

     

       235
       235
       -
           type t = {

     

       236
       236
       -
             name: string; (** Name of the prompt to get *)

     

       237
       237
       -
             arguments: (string * string) list; (** Arguments for the prompt *)

     

       238
       238
       -
           }

     

       239
       239
       -
           include Json.Jsonable.S with type t := t

     

       240
       240
       -
         end

     

       241
       241
       -
         

     

       242
       242
       -
         (** Response result *)

     

       243
       243
       -
         module Response : sig

     

       244
       244
       -
           type t = {

     

       245
       245
       -
             description: string option; (** Description of the prompt *)

     

       246
       246
       -
             messages: PromptMessage.t list; (** List of messages in the prompt *)

     

       247
       247
       -
           }

     

       248
       248
       -
           include Json.Jsonable.S with type t := t

     

       249
       249
       -
         end

     

       250
       250
       -
         

     

       251
       251
       -
         (** Create a prompts/get request *)

     

       252
       252
       -
         val create_request : name:string -> arguments:(string * string) list -> ?id:RequestId.t -> unit -> JSONRPCMessage.t

     

       253
       253
       -
         

     

       254
       254
       -
         (** Create a prompts/get response *)

     

       255
       255
       -
         val create_response : id:RequestId.t -> ?description:string -> messages:PromptMessage.t list -> unit -> JSONRPCMessage.t

     

       256
       256
       -
       end

     

       257
       257
       -
       

     

       258
       258
       -
       (** List Changed Notifications *)

     

       259
       259
       -
       module ListChanged : sig

     

       260
       260
       -
         (** Create a resources/list_changed notification *)

     

       261
       261
       -
         val create_resources_notification : unit -> JSONRPCMessage.t

     

       262
       262
       -
         

     

       263
       263
       -
         (** Create a tools/list_changed notification *)

     

       264
       264
       -
         val create_tools_notification : unit -> JSONRPCMessage.t

     

       265
       265
       -
         

     

       266
       266
       -
         (** Create a prompts/list_changed notification *)

     

       267
       267
       -
         val create_prompts_notification : unit -> JSONRPCMessage.t

     

       268
       268
       -
       end

     

       269
       269
       -
       

     

       270
       270
       -
       (** Resource Updated Notification *)

     

       271
       271
       -
       module ResourceUpdated : sig

     

       272
       272
       -
         (** Notification parameters *)

     

       273
       273
       -
         module Notification : sig

     

       274
       274
       -
           type t = {

     

       275
       275
       -
             uri: string; (** URI of the updated resource *)

     

       276
       276
       -
           }

     

       277
       277
       -
           include Json.Jsonable.S with type t := t

     

       278
       278
       -
         end

     

       279
       279
       -
         

     

       280
       280
       -
         (** Create a resources/updated notification *)

     

       281
       281
       -
         val create_notification : uri:string -> unit -> JSONRPCMessage.t

     

       282
       282
       -
       end

     

       283
       283
       -
       

     

       284
       284
       -
       (** Progress Notification *)

     

       285
       285
       -
       module Progress : sig

     

       286
       286
       -
         (** Notification parameters *)

     

       287
       287
       -
         module Notification : sig

     

       288
       288
       -
           type t = {

     

       289
       289
       -
             progress: float; (** Current progress value *)

     

       290
       290
       -
             total: float; (** Total progress value *)

     

       291
       291
       -
             progress_token: ProgressToken.t; (** Token identifying the operation *)

     

       292
       292
       -
           }

     

       293
       293
       -
           include Json.Jsonable.S with type t := t

     

       294
       294
       -
         end

     

       295
       295
       -
         

     

       296
       296
       -
         (** Create a progress notification *)

     

       297
       297
       -
         val create_notification : progress:float -> total:float -> progress_token:ProgressToken.t -> unit -> JSONRPCMessage.t

     

       298
       298
       -
       end

+131 -275

lib/mcp_sdk.ml

···

       14
       14
        
           | Warning -> "WARNING"

     

       15
       15
        
           | Error -> "ERROR"

     

       16
       16
        
       

     

       17
       17
       -
         let logf level fmt =

     

       18
       18
       -
           Printf.fprintf stderr "[%s] " (string_of_level level);

     

       19
       19
       -
           Printf.kfprintf (fun oc -> Printf.fprintf oc "\n"; flush oc) stderr fmt

     

       17
       17
       +
         let log level msg =

     

       18
       18
       +
           Printf.eprintf "[%s] %s\n" (string_of_level level) msg;

     

       19
       19
       +
           flush stderr

     

       20
       20
        
       

     

       21
       21
       -
         let debugf fmt = logf Debug fmt

     

       22
       22
       -
         let infof fmt = logf Info fmt

     

       23
       23
       -
         let warningf fmt = logf Warning fmt

     

       24
       24
       -
         let errorf fmt = logf Error fmt

     

       25
       25
       -
         

     

       26
       26
       -
         (* Backward compatibility functions that take a simple string *)

     

       27
       27
       -
         let log level msg = logf level "%s" msg

     

       28
       28
       -
         let debug msg = debugf "%s" msg

     

       29
       29
       -
         let info msg = infof "%s" msg

     

       30
       30
       -
         let warning msg = warningf "%s" msg

     

       31
       31
       -
         let error msg = errorf "%s" msg

     

       21
       21
       +
         let debug = log Debug

     

       22
       22
       +
         let info = log Info

     

       23
       23
       +
         let warning = log Warning

     

       24
       24
       +
         let error = log Error

     

       32
       25
        
       end

     

       33
       26
        
       

     

       34
       27
        
       (* Context for tools and resources *)

     
···

       36
       29
        
         type t = {

     

       37
       30
        
           request_id: RequestId.t option;

     

       38
       31
        
           lifespan_context: (string * Json.t) list;

     

       39
       39
       -
           progress_token: ProgressToken.t option;

     

       32
       32
       +
           mutable progress_token: ProgressToken.t option;

     

       40
       33
        
         }

     

       41
       34
        
       

     

       42
       42
       -
         let create ?request_id ?progress_token ?(lifespan_context=[]) () =

     

       43
       43
       -
           { request_id; lifespan_context; progress_token }

     

       35
       35
       +
         let create ?request_id ?(lifespan_context=[]) () =

     

       36
       36
       +
           { request_id; lifespan_context; progress_token = None }

     

       44
       37
        
       

     

       45
       38
        
         let get_context_value ctx key =

     

       46
       39
        
           List.assoc_opt key ctx.lifespan_context

     
···

       53
       46
        
               ("total", `Float total);

     

       54
       47
        
               ("progressToken", ProgressToken.yojson_of_t token)

     

       55
       48
        
             ] in

     

       56
       56
       -
             Some (create_notification ~meth:Method.Progress ~params:(Some params) ())

     

       49
       49
       +
             Some (create_notification ~method_:"notifications/progress" ~params:(Some params) ())

     

       57
       50
        
           | _ -> None

     

       58
       51
        
       end

     

       59
       52
        
       

     
···

       81
       74
        
             | None -> assoc

     

       82
       75
        
           in

     

       83
       76
        
           `Assoc assoc

     

       84
       84
       -
           

     

       85
       85
       -
         (* Convert to Mcp_rpc.ToolsList.Tool.t *)

     

       86
       86
       -
         let to_rpc_tool_list_tool (tool:t) =

     

       87
       87
       -
           Mcp_rpc.ToolsList.Tool.{

     

       88
       88
       -
             name = tool.name;

     

       89
       89
       -
             description = tool.description;

     

       90
       90
       -
             input_schema = tool.input_schema;

     

       91
       91
       -
             annotations = None; (* Could be extended to support annotations *)

     

       92
       92
       -
           }

     

       93
       93
       -
       

     

       94
       94
       -
         (* Convert a list of Tool.t to the format needed for tools/list response *)

     

       95
       95
       -
         let to_rpc_tools_list tools =

     

       96
       96
       -
           List.map to_rpc_tool_list_tool tools

     

       97
       97
       -
       

     

       98
       98
       -
         (* Convert Mcp_rpc.ToolsCall response content to Mcp.content list *)

     

       99
       99
       -
         let rpc_content_to_mcp_content content =

     

       100
       100
       -
           List.map (function

     

       101
       101
       -
             | Mcp_rpc.ToolsCall.ToolContent.Text t -> 

     

       102
       102
       -
                 Mcp.Text { TextContent.text = t.text; annotations = None }

     

       103
       103
       -
             | Mcp_rpc.ToolsCall.ToolContent.Image i -> 

     

       104
       104
       -
                 Mcp.Image { 

     

       105
       105
       -
                   ImageContent.mime_type = i.mime_type;

     

       106
       106
       -
                   data = i.data;

     

       107
       107
       -
                   annotations = None

     

       108
       108
       -
                 }

     

       109
       109
       -
             | Mcp_rpc.ToolsCall.ToolContent.Audio a -> 

     

       110
       110
       -
                 Mcp.Audio {

     

       111
       111
       -
                   AudioContent.mime_type = a.mime_type;

     

       112
       112
       -
                   data = a.data;

     

       113
       113
       -
                   annotations = None

     

       114
       114
       -
                 }

     

       115
       115
       -
             | Mcp_rpc.ToolsCall.ToolContent.Resource r -> 

     

       116
       116
       -
                 (* Create a simple text resource from the embedded resource *)

     

       117
       117
       -
                 let uri = match r with 

     

       118
       118
       -
                   | { EmbeddedResource.resource = `Text tr; _ } -> tr.uri

     

       119
       119
       -
                   | { EmbeddedResource.resource = `Blob br; _ } -> br.uri

     

       120
       120
       -
                 in

     

       121
       121
       -
                 let text_content = match r with

     

       122
       122
       -
                   | { EmbeddedResource.resource = `Text tr; _ } -> tr.text

     

       123
       123
       -
                   | { EmbeddedResource.resource = `Blob br; _ } -> "Binary content"

     

       124
       124
       -
                 in

     

       125
       125
       -
                 let mime_type = match r with

     

       126
       126
       -
                   | { EmbeddedResource.resource = `Text tr; _ } -> tr.mime_type

     

       127
       127
       -
                   | { EmbeddedResource.resource = `Blob br; _ } -> br.mime_type

     

       128
       128
       -
                 in

     

       129
       129
       -
                 let text_resource = {

     

       130
       130
       -
                   TextResourceContents.uri;

     

       131
       131
       -
                   text = text_content;

     

       132
       132
       -
                   mime_type

     

       133
       133
       -
                 } in

     

       134
       134
       -
                 Mcp.Resource {

     

       135
       135
       -
                   EmbeddedResource.resource = `Text text_resource;

     

       136
       136
       -
                   annotations = None

     

       137
       137
       -
                 }

     

       138
       138
       -
           ) content

     

       139
       139
       -
       

     

       140
       140
       -
         (* Convert Mcp.content list to Mcp_rpc.ToolsCall.ToolContent.t list *)

     

       141
       141
       -
         let mcp_content_to_rpc_content content =

     

       142
       142
       -
           List.map (function

     

       143
       143
       -
             | Mcp.Text t -> 

     

       144
       144
       -
                 Mcp_rpc.ToolsCall.ToolContent.Text t

     

       145
       145
       -
             | Mcp.Image img -> 

     

       146
       146
       -
                 Mcp_rpc.ToolsCall.ToolContent.Image img

     

       147
       147
       -
             | Mcp.Audio aud -> 

     

       148
       148
       -
                 Mcp_rpc.ToolsCall.ToolContent.Audio aud

     

       149
       149
       -
             | Mcp.Resource res -> 

     

       150
       150
       -
                 let resource_data = match res.resource with

     

       151
       151
       -
                   | `Text txt -> `Text txt

     

       152
       152
       -
                   | `Blob blob -> `Blob blob

     

       153
       153
       -
                 in

     

       154
       154
       -
                 let resource = {

     

       155
       155
       -
                   EmbeddedResource.resource = resource_data;

     

       156
       156
       -
                   annotations = res.annotations

     

       157
       157
       -
                 } in

     

       158
       158
       -
                 Mcp_rpc.ToolsCall.ToolContent.Resource resource

     

       159
       159
       -
           ) content

     

       160
       160
       -
           

     

       161
       161
       -
         (* Create a tool result with content *)

     

       162
       162
       -
         let create_tool_result content ~is_error =

     

       163
       163
       -
           `Assoc [

     

       164
       164
       -
             ("content", `List (List.map Mcp.yojson_of_content content));

     

       165
       165
       -
             ("isError", `Bool is_error);

     

       166
       166
       -
           ]

     

       167
       167
       -
       

     

       168
       168
       -
         (* Create a tool error result with structured content *)

     

       169
       169
       -
         let create_error_result error =

     

       170
       170
       -
           Log.errorf "Error result: %s" error;

     

       171
       171
       -
           create_tool_result [Mcp.make_text_content error] ~is_error:true

     

       172
       172
       -
         

     

       173
       173
       -
         (* Handle tool execution errors *)

     

       174
       174
       -
         let handle_execution_error err =

     

       175
       175
       -
           create_error_result (Printf.sprintf "Error executing tool: %s" err)

     

       176
       176
       -
         

     

       177
       177
       -
         (* Handle unknown tool error *)

     

       178
       178
       -
         let handle_unknown_tool_error name =

     

       179
       179
       -
           create_error_result (Printf.sprintf "Unknown tool: %s" name)

     

       180
       180
       -
         

     

       181
       181
       -
         (* Handle general tool execution exception *)

     

       182
       182
       -
         let handle_execution_exception exn =

     

       183
       183
       -
           create_error_result (Printf.sprintf "Internal error: %s" (Printexc.to_string exn))

     

       184
       77
        
       end

     

       185
       78
        
       

     

       186
       79
        
       (* Resources for the MCP server *)

     
···

       188
       81
        
         type handler = Context.t -> string list -> (string, string) result

     

       189
       82
        
       

     

       190
       83
        
         type t = {

     

       191
       191
       -
           uri: string;  (* For resources, this is the exact URI (no variables) *)

     

       192
       192
       -
           name: string;

     

       84
       84
       +
           uri_template: string;

     

       193
       85
        
           description: string option;

     

       194
       86
        
           mime_type: string option;

     

       195
       87
        
           handler: handler;

     

       196
       88
        
         }

     

       197
       89
        
       

     

       198
       198
       -
         let create ~uri ~name ?description ?mime_type ~handler () =

     

       199
       199
       -
           (* Validate that the URI doesn't contain template variables *)

     

       200
       200
       -
           if String.contains uri '{' || String.contains uri '}' then

     

       201
       201
       -
             Log.warningf "Resource '%s' contains template variables. Consider using add_resource_template instead." uri;

     

       202
       202
       -
           { uri; name; description; mime_type; handler }

     

       90
       90
       +
         let create ~uri_template ?description ?mime_type ~handler () = 

     

       91
       91
       +
           { uri_template; description; mime_type; handler }

     

       203
       92
        
       

     

       204
       93
        
         let to_json resource =

     

       205
       94
        
           let assoc = [

     

       206
       206
       -
             ("uri", `String resource.uri);

     

       207
       207
       -
             ("name", `String resource.name);

     

       95
       95
       +
             ("uriTemplate", `String resource.uri_template);

     

       208
       96
        
           ] in

     

       209
       97
        
           let assoc = match resource.description with

     

       210
       98
        
             | Some desc -> ("description", `String desc) :: assoc

     
···

       215
       103
        
             | None -> assoc

     

       216
       104
        
           in

     

       217
       105
        
           `Assoc assoc

     

       218
       218
       -
           

     

       219
       219
       -
         (* Convert to Mcp_rpc.ResourcesList.Resource.t *)

     

       220
       220
       -
         let to_rpc_resource_list_resource (resource:t) =

     

       221
       221
       -
           Mcp_rpc.ResourcesList.Resource.{

     

       222
       222
       -
             uri = resource.uri;

     

       223
       223
       -
             name = resource.name;

     

       224
       224
       -
             description = resource.description;

     

       225
       225
       -
             mime_type = resource.mime_type;

     

       226
       226
       -
             size = None; (* Size can be added when we have actual resource content *)

     

       227
       227
       -
           }

     

       228
       228
       -
           

     

       229
       229
       -
         (* Convert a list of Resource.t to the format needed for resources/list response *)

     

       230
       230
       -
         let to_rpc_resources_list resources =

     

       231
       231
       -
           List.map to_rpc_resource_list_resource resources

     

       232
       106
        
       end

     

       233
       107
        
       

     

       234
       108
        
       (* Prompts for the MCP server *)

     
···

       259
       133
        
         let create_argument ~name ?description ?(required=false) () =

     

       260
       134
        
           { name; description; required }

     

       261
       135
        
       

     

       136
       136
       +
         let yojson_of_message { role; content } =

     

       137
       137
       +
           `Assoc [

     

       138
       138
       +
             ("role", Role.yojson_of_t role);

     

       139
       139
       +
             ("content", yojson_of_content content);

     

       140
       140
       +
           ]

     

       141
       141
       +
       

     

       142
       142
       +
         (* This function must match the structure expected by the PromptMessage module in mcp.ml *)

     

       143
       143
       +
         let message_of_yojson json =

     

       144
       144
       +
           match json with

     

       145
       145
       +
           | `Assoc fields -> begin

     

       146
       146
       +
               let role = match List.assoc_opt "role" fields with

     

       147
       147
       +
                 | Some json -> begin

     

       148
       148
       +
                     Role.t_of_yojson json

     

       149
       149
       +
                   end

     

       150
       150
       +
                 | None -> begin

     

       151
       151
       +
                     raise (Json.Of_json ("Missing role field", `Assoc fields))

     

       152
       152
       +
                   end

     

       153
       153
       +
               in

     

       154
       154
       +
               let content = match List.assoc_opt "content" fields with

     

       155
       155
       +
                 | Some json -> begin

     

       156
       156
       +
                     content_of_yojson json

     

       157
       157
       +
                   end

     

       158
       158
       +
                 | None -> begin

     

       159
       159
       +
                     raise (Json.Of_json ("Missing content field", `Assoc fields))

     

       160
       160
       +
                   end

     

       161
       161
       +
               in

     

       162
       162
       +
               { role; content }

     

       163
       163
       +
             end

     

       164
       164
       +
           | j -> begin

     

       165
       165
       +
               raise (Json.Of_json ("Expected object for PromptMessage", j))

     

       166
       166
       +
             end

     

       167
       167
       +
       

     

       262
       168
        
         let to_json prompt =

     

       263
       169
        
           let assoc = [

     

       264
       170
        
             ("name", `String prompt.name);

     
···

       289
       195
        
             assoc

     

       290
       196
        
           in

     

       291
       197
        
           `Assoc assoc

     

       292
       292
       -
           

     

       293
       293
       -
         (* Convert argument to Mcp_rpc.PromptsList.PromptArgument.t *)

     

       294
       294
       -
         let argument_to_rpc_prompt_argument (arg:argument) =

     

       295
       295
       -
           Mcp_rpc.PromptsList.PromptArgument.{

     

       296
       296
       -
             name = arg.name;

     

       297
       297
       -
             description = arg.description;

     

       298
       298
       -
             required = arg.required;

     

       299
       299
       -
           }

     

       300
       300
       -
           

     

       301
       301
       -
         (* Convert to Mcp_rpc.PromptsList.Prompt.t *)

     

       302
       302
       -
         let to_rpc_prompt_list_prompt (prompt:t) =

     

       303
       303
       -
           Mcp_rpc.PromptsList.Prompt.{

     

       304
       304
       -
             name = prompt.name;

     

       305
       305
       -
             description = prompt.description;

     

       306
       306
       -
             arguments = List.map argument_to_rpc_prompt_argument prompt.arguments;

     

       307
       307
       -
           }

     

       308
       308
       -
         

     

       309
       309
       -
         (* Convert a list of Prompt.t to the format needed for prompts/list response *)

     

       310
       310
       -
         let to_rpc_prompts_list prompts =

     

       311
       311
       -
           List.map to_rpc_prompt_list_prompt prompts

     

       312
       312
       -
           

     

       313
       313
       -
         (* Convert message to Mcp_rpc.PromptMessage.t *)

     

       314
       314
       -
         let message_to_rpc_prompt_message msg =

     

       315
       315
       -
           {

     

       316
       316
       -
             PromptMessage.role = msg.role;

     

       317
       317
       -
             PromptMessage.content = msg.content;

     

       318
       318
       -
           }

     

       319
       319
       -
           

     

       320
       320
       -
         (* Convert a list of messages to the format needed for prompts/get response *)

     

       321
       321
       -
         let messages_to_rpc_prompt_messages messages =

     

       322
       322
       -
           List.map message_to_rpc_prompt_message messages

     

       323
       198
        
       end

     

       324
       199
        
       

     

       200
       200
       +
       (* Helper functions for creating common objects *)

     

       201
       201
       +
       let make_text_content text =

     

       202
       202
       +
         Text (TextContent.{ text; annotations = None })

     

       203
       203
       +
       

     

       204
       204
       +
       let make_text_content_with_annotations text annotations =

     

       205
       205
       +
         Text (TextContent.{ text; annotations = Some annotations })

     

       206
       206
       +
       

     

       207
       207
       +
       let make_image_content data mime_type =

     

       208
       208
       +
         Image (ImageContent.{ data; mime_type; annotations = None })

     

       209
       209
       +
       

     

       210
       210
       +
       let make_image_content_with_annotations data mime_type annotations =

     

       211
       211
       +
         Image (ImageContent.{ data; mime_type; annotations = Some annotations })

     

       212
       212
       +
       

     

       213
       213
       +
       let make_audio_content data mime_type =

     

       214
       214
       +
         Audio (AudioContent.{ data; mime_type; annotations = None })

     

       215
       215
       +
       

     

       216
       216
       +
       let make_audio_content_with_annotations data mime_type annotations =

     

       217
       217
       +
         Audio (AudioContent.{ data; mime_type; annotations = Some annotations })

     

       218
       218
       +
       

     

       219
       219
       +
       let make_text_resource_content uri text ?mime_type () =

     

       220
       220
       +
         Resource (EmbeddedResource.{

     

       221
       221
       +
           resource = `Text TextResourceContents.{ uri; text; mime_type };

     

       222
       222
       +
           annotations = None

     

       223
       223
       +
         })

     

       224
       224
       +
       

     

       225
       225
       +
       let make_blob_resource_content uri blob ?mime_type () =

     

       226
       226
       +
         Resource (EmbeddedResource.{

     

       227
       227
       +
           resource = `Blob BlobResourceContents.{ uri; blob; mime_type };

     

       228
       228
       +
           annotations = None

     

       229
       229
       +
         })

     

       230
       230
       +
       

     

       325
       231
        
       let make_tool_schema properties required =

     

       326
       232
        
         let props = List.map (fun (name, schema_type, description) ->

     

       327
       233
        
           (name, `Assoc [

     
···

       336
       242
        
           ("required", required_json)

     

       337
       243
        
         ]

     

       338
       244
        
       

     

       339
       339
       -
       (* Resource Templates for the MCP server *)

     

       340
       340
       -
       module ResourceTemplate = struct

     

       341
       341
       -
         type handler = Context.t -> string list -> (string, string) result

     

       342
       342
       -
       

     

       343
       343
       -
         type t = {

     

       344
       344
       -
           uri_template: string;

     

       345
       345
       -
           name: string;

     

       346
       346
       -
           description: string option;

     

       347
       347
       -
           mime_type: string option;

     

       348
       348
       -
           handler: handler;

     

       349
       349
       -
         }

     

       350
       350
       -
       

     

       351
       351
       -
         let create ~uri_template ~name ?description ?mime_type ~handler () = 

     

       352
       352
       -
           { uri_template; name; description; mime_type; handler }

     

       353
       353
       -
       

     

       354
       354
       -
         let to_json resource_template =

     

       355
       355
       -
           let assoc = [

     

       356
       356
       -
             ("uriTemplate", `String resource_template.uri_template);

     

       357
       357
       -
             ("name", `String resource_template.name);

     

       358
       358
       -
           ] in

     

       359
       359
       -
           let assoc = match resource_template.description with

     

       360
       360
       -
             | Some desc -> ("description", `String desc) :: assoc

     

       361
       361
       -
             | None -> assoc

     

       362
       362
       -
           in

     

       363
       363
       -
           let assoc = match resource_template.mime_type with

     

       364
       364
       -
             | Some mime -> ("mimeType", `String mime) :: assoc

     

       365
       365
       -
             | None -> assoc

     

       366
       366
       -
           in

     

       367
       367
       -
           `Assoc assoc

     

       368
       368
       -
           

     

       369
       369
       -
         (* Convert to Mcp_rpc.ResourceTemplatesList.ResourceTemplate.t *)

     

       370
       370
       -
         let to_rpc_resource_template (template:t) =

     

       371
       371
       -
           Mcp_rpc.ListResourceTemplatesResult.ResourceTemplate.{

     

       372
       372
       -
             uri_template = template.uri_template;

     

       373
       373
       -
             name = template.name;

     

       374
       374
       -
             description = template.description;

     

       375
       375
       -
             mime_type = template.mime_type;

     

       376
       376
       -
           }

     

       377
       377
       -
           

     

       378
       378
       -
         (* Convert a list of ResourceTemplate.t to the format needed for resources/templates/list response *)

     

       379
       379
       -
         let to_rpc_resource_templates_list templates =

     

       380
       380
       -
           List.map to_rpc_resource_template templates

     

       381
       381
       -
       end

     

       382
       382
       -
       

     

       383
       245
        
       (* Main server type *)

     

       384
       246
        
       type server = {

     

       385
       247
        
         name: string;

     

       386
       248
        
         version: string;

     

       387
       249
        
         protocol_version: string;

     

       388
       388
       -
         lifespan_context: (string * Json.t) list;

     

       389
       250
        
         mutable capabilities: Json.t;

     

       390
       251
        
         mutable tools: Tool.t list;

     

       391
       252
        
         mutable resources: Resource.t list;

     

       392
       392
       -
         mutable resource_templates: ResourceTemplate.t list;

     

       393
       253
        
         mutable prompts: Prompt.t list;

     

       394
       394
       -
       } 

     

       395
       395
       -
       

     

       396
       396
       -
       let name { name; _ } = name

     

       397
       397
       -
       let version { version; _ } = version

     

       398
       398
       -
       let capabilities { capabilities; _ } = capabilities

     

       399
       399
       -
       let lifespan_context { lifespan_context; _ } = lifespan_context

     

       400
       400
       -
       let protocol_version { protocol_version; _ } = protocol_version

     

       401
       401
       -
       let tools { tools; _ } = tools

     

       402
       402
       -
       let resources { resources; _ } = resources

     

       403
       403
       -
       let resource_templates { resource_templates; _ } = resource_templates

     

       404
       404
       -
       let prompts { prompts; _ } = prompts

     

       254
       254
       +
         mutable lifespan_context: (string * Json.t) list;

     

       255
       255
       +
         mutable startup_hook: (unit -> unit) option;

     

       256
       256
       +
         mutable shutdown_hook: (unit -> unit) option;

     

       257
       257
       +
       }

     

       405
       258
        
       

     

       406
       259
        
       (* Create a new server *)

     

       407
       260
        
       let create_server ~name ?(version="0.1.0") ?(protocol_version="2024-11-05") () =

     
···

       412
       265
        
           capabilities = `Assoc [];

     

       413
       266
        
           tools = [];

     

       414
       267
        
           resources = [];

     

       415
       415
       -
           resource_templates = [];

     

       416
       268
        
           prompts = [];

     

       417
       269
        
           lifespan_context = [];

     

       270
       270
       +
           startup_hook = None;

     

       271
       271
       +
           shutdown_hook = None;

     

       418
       272
        
         }

     

       419
       273
        
       

     

       420
       274
        
       (* Default capabilities for the server *)

     

       421
       421
       -
       let default_capabilities ?(with_tools=true) ?(with_resources=false) ?(with_resource_templates=false) ?(with_prompts=false) () =

     

       275
       275
       +
       let default_capabilities ?(with_tools=true) ?(with_resources=false) ?(with_prompts=false) () =

     

       422
       276
        
         let caps = [] in

     

       423
       277
        
         let caps = 

     

       424
       278
        
           if with_tools then

     
···

       442
       296
        
           else

     

       443
       297
        
             caps

     

       444
       298
        
         in

     

       445
       445
       -
         let caps =

     

       446
       446
       -
           if with_resource_templates then

     

       447
       447
       -
             ("resourceTemplates", `Assoc [

     

       448
       448
       -
               ("listChanged", `Bool true)

     

       449
       449
       -
             ]) :: caps

     

       450
       450
       -
           else if not with_resource_templates then

     

       451
       451
       -
             ("resourceTemplates", `Assoc [

     

       452
       452
       -
               ("listChanged", `Bool false)

     

       453
       453
       -
             ]) :: caps

     

       454
       454
       -
           else

     

       455
       455
       -
             caps

     

       456
       456
       -
         in

     

       457
       299
        
         let caps = 

     

       458
       300
        
           if with_prompts then

     

       459
       301
        
             ("prompts", `Assoc [

     
···

       497
       339
        
         resource

     

       498
       340
        
       

     

       499
       341
        
       (* Create and register a resource in one step *)

     

       500
       500
       -
       let add_resource server ~uri ~name ?description ?mime_type handler =

     

       342
       342
       +
       let add_resource server ~uri_template ?description ?mime_type handler =

     

       501
       343
        
         let handler' _ctx params =

     

       502
       344
        
           try

     

       503
       345
        
             Ok (handler params)

     
···

       505
       347
        
             Error (Printexc.to_string exn)

     

       506
       348
        
         in

     

       507
       349
        
         let resource = Resource.create

     

       508
       508
       -
           ~uri

     

       509
       509
       -
           ~name

     

       350
       350
       +
           ~uri_template

     

       510
       351
        
           ?description

     

       511
       352
        
           ?mime_type

     

       512
       353
        
           ~handler:handler'

     

       513
       354
        
           ()

     

       514
       355
        
         in

     

       515
       356
        
         register_resource server resource

     

       516
       516
       -
       

     

       517
       517
       -
       (* Register a resource template *)

     

       518
       518
       -
       let register_resource_template server template =

     

       519
       519
       -
         server.resource_templates <- template :: server.resource_templates;

     

       520
       520
       -
         template

     

       521
       521
       -
       

     

       522
       522
       -
       (* Create and register a resource template in one step *)

     

       523
       523
       -
       let add_resource_template server ~uri_template ~name ?description ?mime_type handler =

     

       524
       524
       -
         let handler' _ctx params =

     

       525
       525
       -
           try

     

       526
       526
       -
             Ok (handler params)

     

       527
       527
       -
           with exn ->

     

       528
       528
       -
             Error (Printexc.to_string exn)

     

       529
       529
       -
         in

     

       530
       530
       -
         let template = ResourceTemplate.create

     

       531
       531
       -
           ~uri_template

     

       532
       532
       -
           ~name

     

       533
       533
       -
           ?description

     

       534
       534
       -
           ?mime_type

     

       535
       535
       -
           ~handler:handler'

     

       536
       536
       -
           ()

     

       537
       537
       -
         in

     

       538
       538
       -
         register_resource_template server template

     

       539
       357
        
       

     

       540
       358
        
       (* Register a prompt *)

     

       541
       359
        
       let register_prompt server prompt =

     
···

       567
       385
        
         server.capabilities <- capabilities

     

       568
       386
        
       

     

       569
       387
        
       (* Configure server with default capabilities based on registered components *)

     

       570
       570
       -
       let configure_server server ?with_tools ?with_resources ?with_resource_templates ?with_prompts () =

     

       388
       388
       +
       let configure_server server ?with_tools ?with_resources ?with_prompts () =

     

       571
       389
        
         let with_tools = match with_tools with

     

       572
       390
        
           | Some b -> b

     

       573
       391
        
           | None -> server.tools <> []

     
···

       576
       394
        
           | Some b -> b

     

       577
       395
        
           | None -> server.resources <> []

     

       578
       396
        
         in

     

       579
       579
       -
         let with_resource_templates = match with_resource_templates with

     

       580
       580
       -
           | Some b -> b

     

       581
       581
       -
           | None -> server.resource_templates <> []

     

       582
       582
       -
         in

     

       583
       397
        
         let with_prompts = match with_prompts with

     

       584
       398
        
           | Some b -> b

     

       585
       399
        
           | None -> server.prompts <> []

     

       586
       400
        
         in

     

       587
       587
       -
         let capabilities = default_capabilities ~with_tools ~with_resources ~with_resource_templates ~with_prompts () in

     

       401
       401
       +
         let capabilities = default_capabilities ~with_tools ~with_resources ~with_prompts () in

     

       588
       402
        
         set_capabilities server capabilities;

     

       589
       403
        
         server

     

       404
       404
       +
       

     

       405
       405
       +
       (* Set startup and shutdown hooks *)

     

       406
       406
       +
       let set_startup_hook server hook =

     

       407
       407
       +
         server.startup_hook <- Some hook

     

       408
       408
       +
       

     

       409
       409
       +
       let set_shutdown_hook server hook =

     

       410
       410
       +
         server.shutdown_hook <- Some hook

     

       411
       411
       +
       

     

       412
       412
       +
       (* Transport type for server *)

     

       413
       413
       +
       type transport_type = 

     

       414
       414
       +
         | Stdio  (* Read/write to stdin/stdout *)

     

       415
       415
       +
         | Http   (* HTTP server - to be implemented *)

     

       416
       416
       +
       

     

       417
       417
       +
       (* Run server with stdio transport *)

     

       418
       418
       +
       let run_server server =

     

       419
       419
       +
         (* Setup *)

     

       420
       420
       +
         Printexc.record_backtrace true;

     

       421
       421
       +
         

     

       422
       422
       +
         Log.info (Printf.sprintf "%s server starting" server.name);

     

       423
       423
       +
         Log.debug (Printf.sprintf "Protocol version: %s" server.protocol_version);

     

       424
       424
       +
         Log.debug (Printf.sprintf "Server info: %s v%s" server.name server.version);

     

       425
       425
       +
         

     

       426
       426
       +
         (* Initialize capabilities if not already set *)

     

       427
       427
       +
         if server.capabilities = `Assoc [] then

     

       428
       428
       +
           ignore (configure_server server ());

     

       429
       429
       +
         

     

       430
       430
       +
         (* Run startup hook if provided *)

     

       431
       431
       +
         (match server.startup_hook with

     

       432
       432
       +
          | Some hook -> hook ()

     

       433
       433
       +
          | None -> ());

     

       434
       434
       +
         

     

       435
       435
       +
         (* This function will be replaced by a full implementation in the mcp_server module *)

     

       436
       436
       +
         Log.info "Server initialized and ready."

     

       437
       437
       +
       

     

       438
       438
       +
       (* Placeholder for running server with different transports *)

     

       439
       439
       +
       let run_server_with_transport server transport =

     

       440
       440
       +
         match transport with

     

       441
       441
       +
         | Http ->

     

       442
       442
       +
             Log.info "HTTP server not implemented in this version, using stdio instead";

     

       443
       443
       +
             run_server server

     

       444
       444
       +
         | Stdio ->

     

       445
       445
       +
             run_server server

+62 -98

lib/mcp_sdk.mli

···

       12
       12
        
       

     

       13
       13
        
         val string_of_level : level -> string

     

       14
       14
        
       

     

       15
       15
       -
         (** Format-string based logging functions *)

     

       16
       16
       -
         val logf : level -> ('a, out_channel, unit) format -> 'a

     

       17
       17
       -
         val debugf : ('a, out_channel, unit) format -> 'a

     

       18
       18
       -
         val infof : ('a, out_channel, unit) format -> 'a

     

       19
       19
       -
         val warningf : ('a, out_channel, unit) format -> 'a

     

       20
       20
       -
         val errorf : ('a, out_channel, unit) format -> 'a

     

       21
       21
       -
       

     

       22
       22
       -
         (** Simple string logging functions (for backward compatibility) *)

     

       23
       15
        
         val log : level -> string -> unit

     

       24
       16
        
         val debug : string -> unit

     

       25
       17
        
         val info : string -> unit

     
···

       29
       21
        
       

     

       30
       22
        
       (** Context for tools and resources *)

     

       31
       23
        
       module Context : sig

     

       32
       32
       -
         type t

     

       24
       24
       +
         type t = {

     

       25
       25
       +
           request_id: RequestId.t option;

     

       26
       26
       +
           lifespan_context: (string * Json.t) list;

     

       27
       27
       +
           mutable progress_token: ProgressToken.t option;

     

       28
       28
       +
         }

     

       33
       29
        
       

     

       34
       34
       -
         val create : ?request_id:RequestId.t -> ?progress_token:ProgressToken.t -> ?lifespan_context:(string * Json.t) list -> unit -> t

     

       30
       30
       +
         val create : ?request_id:RequestId.t -> ?lifespan_context:(string * Json.t) list -> unit -> t

     

       35
       31
        
         val get_context_value : t -> string -> Json.t option

     

       36
       32
        
         val report_progress : t -> float -> float -> JSONRPCMessage.t option

     

       37
       33
        
       end

     
···

       49
       45
        
       

     

       50
       46
        
         val create : name:string -> ?description:string -> input_schema:Json.t -> handler:handler -> unit -> t

     

       51
       47
        
         val to_json : t -> Json.t

     

       52
       52
       -
         

     

       53
       53
       -
         (** Convert to Mcp_rpc.ToolsList.Tool.t *)

     

       54
       54
       -
         val to_rpc_tool_list_tool : t -> Mcp_rpc.ToolsList.Tool.t

     

       55
       55
       -
         

     

       56
       56
       -
         (** Convert a list of Tool.t to the format needed for tools/list response *)

     

       57
       57
       -
         val to_rpc_tools_list : t list -> Mcp_rpc.ToolsList.Tool.t list

     

       58
       58
       -
         

     

       59
       59
       -
         (** Convert Mcp_rpc.ToolsCall response content to Mcp.content list *)

     

       60
       60
       -
         val rpc_content_to_mcp_content : Mcp_rpc.ToolsCall.ToolContent.t list -> Mcp.content list

     

       61
       61
       -
         

     

       62
       62
       -
         (** Convert Mcp.content list to Mcp_rpc.ToolsCall.ToolContent.t list *)

     

       63
       63
       -
         val mcp_content_to_rpc_content : Mcp.content list -> Mcp_rpc.ToolsCall.ToolContent.t list

     

       64
       64
       -
         

     

       65
       65
       -
         (** Create a tool result with content *)

     

       66
       66
       -
         val create_tool_result : Mcp.content list -> is_error:bool -> Json.t

     

       67
       67
       -
         

     

       68
       68
       -
         (** Create a tool error result with structured content *)

     

       69
       69
       -
         val create_error_result : string -> Json.t

     

       70
       70
       -
         

     

       71
       71
       -
         (** Handle tool execution errors *)

     

       72
       72
       -
         val handle_execution_error : string -> Json.t

     

       73
       73
       -
         

     

       74
       74
       -
         (** Handle unknown tool error *)

     

       75
       75
       -
         val handle_unknown_tool_error : string -> Json.t

     

       76
       76
       -
         

     

       77
       77
       -
         (** Handle general tool execution exception *)

     

       78
       78
       -
         val handle_execution_exception : exn -> Json.t

     

       79
       48
        
       end

     

       80
       49
        
       

     

       81
       50
        
       (** Resources for the MCP server *)

     
···

       83
       52
        
         type handler = Context.t -> string list -> (string, string) result

     

       84
       53
        
       

     

       85
       54
        
         type t = {

     

       86
       86
       -
           uri: string;

     

       87
       87
       -
           name: string;

     

       88
       88
       -
           description: string option;

     

       89
       89
       -
           mime_type: string option;

     

       90
       90
       -
           handler: handler;

     

       91
       91
       -
         }

     

       92
       92
       -
       

     

       93
       93
       -
         val create : uri:string -> name:string -> ?description:string -> ?mime_type:string -> handler:handler -> unit -> t

     

       94
       94
       -
         val to_json : t -> Json.t

     

       95
       95
       -
         

     

       96
       96
       -
         (** Convert to Mcp_rpc.ResourcesList.Resource.t *)

     

       97
       97
       -
         val to_rpc_resource_list_resource : t -> Mcp_rpc.ResourcesList.Resource.t

     

       98
       98
       -
         

     

       99
       99
       -
         (** Convert a list of Resource.t to the format needed for resources/list response *)

     

       100
       100
       -
         val to_rpc_resources_list : t list -> Mcp_rpc.ResourcesList.Resource.t list

     

       101
       101
       -
       end

     

       102
       102
       -
       

     

       103
       103
       -
       (** Resource Templates for the MCP server *)

     

       104
       104
       -
       module ResourceTemplate : sig

     

       105
       105
       -
         type handler = Context.t -> string list -> (string, string) result

     

       106
       106
       -
       

     

       107
       107
       -
         type t = {

     

       108
       55
        
           uri_template: string;

     

       109
       109
       -
           name: string;

     

       110
       56
        
           description: string option;

     

       111
       57
        
           mime_type: string option;

     

       112
       58
        
           handler: handler;

     

       113
       59
        
         }

     

       114
       60
        
       

     

       115
       115
       -
         val create : uri_template:string -> name:string -> ?description:string -> ?mime_type:string -> handler:handler -> unit -> t

     

       61
       61
       +
         val create : uri_template:string -> ?description:string -> ?mime_type:string -> handler:handler -> unit -> t

     

       116
       62
        
         val to_json : t -> Json.t

     

       117
       117
       -
         

     

       118
       118
       -
         (** Convert to Mcp_rpc.ResourceTemplatesList.ResourceTemplate.t *)

     

       119
       119
       -
         val to_rpc_resource_template : t -> Mcp_rpc.ListResourceTemplatesResult.ResourceTemplate.t

     

       120
       120
       -
         

     

       121
       121
       -
         (** Convert a list of ResourceTemplate.t to the format needed for resources/templates/list response *)

     

       122
       122
       -
         val to_rpc_resource_templates_list : t list -> Mcp_rpc.ListResourceTemplatesResult.ResourceTemplate.t list

     

       123
       63
        
       end

     

       124
       64
        
       

     

       125
       65
        
       (** Prompts for the MCP server *)

     
···

       146
       86
        
       

     

       147
       87
        
         val create : name:string -> ?description:string -> ?arguments:argument list -> handler:handler -> unit -> t

     

       148
       88
        
         val create_argument : name:string -> ?description:string -> ?required:bool -> unit -> argument

     

       89
       89
       +
         val yojson_of_message : message -> Json.t

     

       90
       90
       +
         val message_of_yojson : Json.t -> message

     

       149
       91
        
         val to_json : t -> Json.t

     

       150
       150
       -
         

     

       151
       151
       -
         (** Convert argument to Mcp_rpc.PromptsList.PromptArgument.t *)

     

       152
       152
       -
         val argument_to_rpc_prompt_argument : argument -> Mcp_rpc.PromptsList.PromptArgument.t

     

       153
       153
       -
         

     

       154
       154
       -
         (** Convert to Mcp_rpc.PromptsList.Prompt.t *)

     

       155
       155
       -
         val to_rpc_prompt_list_prompt : t -> Mcp_rpc.PromptsList.Prompt.t

     

       156
       156
       -
         

     

       157
       157
       -
         (** Convert a list of Prompt.t to the format needed for prompts/list response *)

     

       158
       158
       -
         val to_rpc_prompts_list : t list -> Mcp_rpc.PromptsList.Prompt.t list

     

       159
       159
       -
         

     

       160
       160
       -
         (** Convert message to Mcp_rpc.PromptMessage.t *)

     

       161
       161
       -
         val message_to_rpc_prompt_message : message -> PromptMessage.t

     

       162
       162
       -
         

     

       163
       163
       -
         (** Convert a list of messages to the format needed for prompts/get response *)

     

       164
       164
       -
         val messages_to_rpc_prompt_messages : message list -> PromptMessage.t list

     

       165
       92
        
       end

     

       166
       93
        
       

     

       167
       94
        
       (** Main server type *)

     

       168
       168
       -
       type server

     

       169
       169
       -
       

     

       170
       170
       -
       val name : server -> string

     

       171
       171
       -
       val version : server -> string

     

       172
       172
       -
       val protocol_version : server -> string

     

       173
       173
       -
       val capabilities : server -> Json.t

     

       174
       174
       -
       val tools : server -> Tool.t list

     

       175
       175
       -
       val resources : server -> Resource.t list

     

       176
       176
       -
       val resource_templates : server -> ResourceTemplate.t list

     

       177
       177
       -
       val prompts : server -> Prompt.t list

     

       95
       95
       +
       type server = {

     

       96
       96
       +
         name: string;

     

       97
       97
       +
         version: string;

     

       98
       98
       +
         protocol_version: string;

     

       99
       99
       +
         mutable capabilities: Json.t;

     

       100
       100
       +
         mutable tools: Tool.t list;

     

       101
       101
       +
         mutable resources: Resource.t list;

     

       102
       102
       +
         mutable prompts: Prompt.t list;

     

       103
       103
       +
         mutable lifespan_context: (string * Json.t) list;

     

       104
       104
       +
         mutable startup_hook: (unit -> unit) option;

     

       105
       105
       +
         mutable shutdown_hook: (unit -> unit) option;

     

       106
       106
       +
       }

     

       178
       107
        
       

     

       179
       108
        
       (** Create a new server *)

     

       180
       109
        
       val create_server : name:string -> ?version:string -> ?protocol_version:string -> unit -> server

     

       181
       110
        
       

     

       182
       111
        
       (** Default capabilities for the server *)

     

       183
       183
       -
       val default_capabilities : ?with_tools:bool -> ?with_resources:bool -> ?with_resource_templates:bool -> ?with_prompts:bool -> unit -> Json.t

     

       112
       112
       +
       val default_capabilities : ?with_tools:bool -> ?with_resources:bool -> ?with_prompts:bool -> unit -> Json.t

     

       113
       113
       +
       

     

       114
       114
       +
       (** Register a tool with the server *)

     

       115
       115
       +
       val register_tool : server -> Tool.t -> Tool.t

     

       184
       116
        
       

     

       185
       117
        
       (** Create and register a tool in one step *)

     

       186
       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

     

       187
       119
        
       

     

       120
       120
       +
       (** Register a resource with the server *)

     

       121
       121
       +
       val register_resource : server -> Resource.t -> Resource.t

     

       122
       122
       +
       

     

       188
       123
        
       (** Create and register a resource in one step *)

     

       189
       189
       -
       val add_resource : server -> uri:string -> name:string -> ?description:string -> ?mime_type:string -> (string list -> string) -> Resource.t

     

       124
       124
       +
       val add_resource : server -> uri_template:string -> ?description:string -> ?mime_type:string -> (string list -> string) -> Resource.t

     

       190
       125
        
       

     

       191
       191
       -
       (** Create and register a resource template in one step *)

     

       192
       192
       -
       val add_resource_template : server -> uri_template:string -> name:string -> ?description:string -> ?mime_type:string -> (string list -> string) -> ResourceTemplate.t

     

       126
       126
       +
       (** Register a prompt with the server *)

     

       127
       127
       +
       val register_prompt : server -> Prompt.t -> Prompt.t

     

       193
       128
        
       

     

       194
       129
        
       (** Create and register a prompt in one step *)

     

       195
       130
        
       val add_prompt : server -> name:string -> ?description:string -> ?arguments:(string * string option * bool) list -> ((string * string) list -> Prompt.message list) -> Prompt.t

     

       131
       131
       +
       

     

       132
       132
       +
       (** Set server capabilities *)

     

       133
       133
       +
       val set_capabilities : server -> Json.t -> unit

     

       196
       134
        
       

     

       197
       135
        
       (** Configure server with default capabilities based on registered components *)

     

       198
       198
       -
       val configure_server : server -> ?with_tools:bool -> ?with_resources:bool -> ?with_resource_templates:bool -> ?with_prompts:bool -> unit -> server

     

       136
       136
       +
       val configure_server : server -> ?with_tools:bool -> ?with_resources:bool -> ?with_prompts:bool -> unit -> server

     

       199
       137
        
       

     

       200
       200
       -
       val make_tool_schema : (string * string * string) list -> string list -> Json.t

     

       138
       138
       +
       (** Set startup hook *)

     

       139
       139
       +
       val set_startup_hook : server -> (unit -> unit) -> unit

     

       140
       140
       +
       

     

       141
       141
       +
       (** Set shutdown hook *)

     

       142
       142
       +
       val set_shutdown_hook : server -> (unit -> unit) -> unit

     

       143
       143
       +
       

     

       144
       144
       +
       (** Run the server using stdio transport (legacy method) *)

     

       145
       145
       +
       val run_server : server -> unit

     

       146
       146
       +
       

     

       147
       147
       +
       (** Transport type for the server *)

     

       148
       148
       +
       type transport_type = 

     

       149
       149
       +
         | Stdio  (** Read/write to stdin/stdout *)

     

       150
       150
       +
         | Http   (** HTTP server - to be implemented *)

     

       151
       151
       +
       

     

       152
       152
       +
       (** Create and start a server with the specified transport *)

     

       153
       153
       +
       val run_server_with_transport : server -> transport_type -> unit

     

       154
       154
       +
       

     

       155
       155
       +
       (** Helper functions for creating common objects *)

     

       156
       156
       +
       val make_text_content : string -> content

     

       157
       157
       +
       val make_text_content_with_annotations : string -> Annotated.annotation -> content

     

       158
       158
       +
       val make_image_content : string -> string -> content

     

       159
       159
       +
       val make_image_content_with_annotations : string -> string -> Annotated.annotation -> content

     

       160
       160
       +
       val make_audio_content : string -> string -> content

     

       161
       161
       +
       val make_audio_content_with_annotations : string -> string -> Annotated.annotation -> content

     

       162
       162
       +
       val make_text_resource_content : string -> string -> ?mime_type:string -> unit -> content

     

       163
       163
       +
       val make_blob_resource_content : string -> string -> ?mime_type:string -> unit -> content

     

       164
       164
       +
       val make_tool_schema : (string * string * string) list -> string list -> Json.t

+507 -463

lib/mcp_server.ml

···

       1
       1
        
       open Mcp

     

       2
       2
       -
       open Jsonrpc

     

       3
       2
        
       open Mcp_sdk

     

       4
       3
        
       

     

       5
       5
       -
       (* Create a proper JSONRPC error with code and data *)

     

       6
       6
       -
       let create_jsonrpc_error id code message ?data () =

     

       7
       7
       -
         let error_code = ErrorCode.to_int code in

     

       8
       8
       -
         let error_data = match data with

     

       9
       9
       -
           | Some d -> d

     

       10
       10
       -
           | None -> `Null

     

       11
       11
       -
         in

     

       12
       12
       -
         create_error ~id ~code:error_code ~message ~data:(Some error_data) ()

     

       13
       13
       -
       

     

       14
       14
       -
       (* Process initialize request *)

     

       15
       15
       -
       let handle_initialize server req =

     

       16
       16
       -
         Log.debug "Processing initialize request";

     

       17
       17
       -
         let result = match req.JSONRPCMessage.params with

     

       18
       18
       -
           | Some params -> 

     

       19
       19
       -
               let req_data = Initialize.Request.t_of_yojson params in

     

       20
       20
       -
               Log.debugf "Client info: %s v%s" 

     

       21
       21
       -
                 req_data.client_info.name req_data.client_info.version;

     

       22
       22
       -
               Log.debugf "Client protocol version: %s" req_data.protocol_version;

     

       23
       23
       -
               

     

       24
       24
       -
               (* Create initialize response *)

     

       25
       25
       -
               let result = Initialize.Result.create

     

       26
       26
       -
                 ~capabilities:(capabilities server)

     

       27
       27
       -
                 ~server_info:Implementation.{ 

     

       28
       28
       -
                   name = name server; 

     

       29
       29
       -
                   version = version server 

     

       30
       30
       -
                 }

     

       31
       31
       -
                 ~protocol_version:(protocol_version server)

     

       32
       32
       -
                 ~instructions:(Printf.sprintf "This server provides tools for %s." (name server))

     

       33
       33
       -
                 ()

     

       34
       34
       -
               in

     

       35
       35
       -
               Initialize.Result.yojson_of_t result

     

       36
       36
       -
           | None -> 

     

       37
       37
       -
               Log.error "Missing params for initialize request";

     

       38
       38
       -
               `Assoc [("error", `String "Missing params for initialize request")]

     

       39
       39
       -
         in

     

       40
       40
       -
         Some (create_response ~id:req.id ~result)

     

       41
       41
       -
       

     

       42
       42
       -
       (* Process tools/list request *)

     

       43
       43
       -
       let handle_tools_list server (req:JSONRPCMessage.request) =

     

       44
       44
       -
         Log.debug "Processing tools/list request";

     

       45
       45
       -
         let tools_list = Tool.to_rpc_tools_list (tools server) in

     

       46
       46
       -
         let response = Mcp_rpc.ToolsList.create_response ~id:req.id ~tools:tools_list () in

     

       47
       47
       -
         Some response

     

       48
       48
       -
       

     

       49
       49
       -
       (* Process prompts/list request *)

     

       50
       50
       -
       let handle_prompts_list server (req:JSONRPCMessage.request) =

     

       51
       51
       -
         Log.debug "Processing prompts/list request";

     

       52
       52
       -
         let prompts_list = Prompt.to_rpc_prompts_list (prompts server) in

     

       53
       53
       -
         let response = Mcp_rpc.PromptsList.create_response ~id:req.id ~prompts:prompts_list () in

     

       54
       54
       -
         Some response

     

       55
       55
       -
       

     

       56
       56
       -
       (* Process resources/list request *)

     

       57
       57
       -
       let handle_resources_list server (req:JSONRPCMessage.request) =

     

       58
       58
       -
         Log.debug "Processing resources/list request";

     

       59
       59
       -
         let resources_list = Resource.to_rpc_resources_list (resources server) in

     

       60
       60
       -
         let response = Mcp_rpc.ResourcesList.create_response ~id:req.id ~resources:resources_list () in

     

       61
       61
       -
         Some response

     

       62
       62
       -
       

     

       63
       63
       -
       (* Process resources/templates/list request *)

     

       64
       64
       -
       let handle_resource_templates_list server (req:JSONRPCMessage.request) =

     

       65
       65
       -
         Log.debug "Processing resources/templates/list request";

     

       66
       66
       -
         let templates_list = ResourceTemplate.to_rpc_resource_templates_list (resource_templates server) in

     

       67
       67
       -
         let response = Mcp_rpc.ListResourceTemplatesResult.create_response ~id:req.id ~resource_templates:templates_list () in

     

       68
       68
       -
         Some response

     

       4
       4
       +
       (* MCP Server module for handling JSON-RPC communication *)

     

       69
       5
        
       

     

       70
       70
       -
       (* Utility module for resource template matching *)

     

       71
       71
       -
       module Resource_matcher = struct

     

       72
       72
       -
         (* Define variants for resource handling result *)

     

       73
       73
       -
         type resource_match =

     

       74
       74
       -
           | DirectResource of Resource.t * string list

     

       75
       75
       -
           | TemplateResource of ResourceTemplate.t * string list

     

       76
       76
       -
           | NoMatch

     

       6
       6
       +
       (** Server types *)

     

       7
       7
       +
       type transport_type = 

     

       8
       8
       +
         | Stdio  (* Read/write to stdin/stdout *)

     

       9
       9
       +
         | Http   (* HTTP server - to be implemented *)

     

       77
       10
        
       

     

       78
       78
       -
         (* Extract parameters from a template URI *)

     

       79
       79
       -
         let extract_template_vars template_uri uri =

     

       80
       80
       -
           (* Simple template variable extraction - could be enhanced with regex *)

     

       81
       81
       -
           let template_parts = String.split_on_char '/' template_uri in

     

       82
       82
       -
           let uri_parts = String.split_on_char '/' uri in

     

       83
       83
       -
           

     

       84
       84
       -
           if List.length template_parts <> List.length uri_parts then

     

       85
       85
       -
             None

     

       86
       86
       -
           else

     

       87
       87
       -
             (* Match parts and extract variables *)

     

       88
       88
       -
             let rec match_parts tparts uparts acc =

     

       89
       89
       -
               match tparts, uparts with

     

       90
       90
       -
               | [], [] -> Some (List.rev acc)

     

       91
       91
       -
               | th::tt, uh::ut ->

     

       92
       92
       -
                   (* Check if this part is a template variable *)

     

       93
       93
       -
                   if String.length th > 2 && 

     

       94
       94
       -
                      String.get th 0 = '{' && 

     

       95
       95
       -
                      String.get th (String.length th - 1) = '}' then

     

       96
       96
       -
                     (* Extract variable value and continue *)

     

       97
       97
       -
                     match_parts tt ut (uh::acc)

     

       98
       98
       -
                   else if th = uh then

     

       99
       99
       -
                     (* Fixed part matches, continue *)

     

       100
       100
       -
                     match_parts tt ut acc

     

       101
       101
       -
                   else

     

       102
       102
       -
                     (* Fixed part doesn't match, fail *)

     

       103
       103
       -
                     None

     

       104
       104
       -
               | _, _ -> None

     

       105
       105
       -
             in

     

       106
       106
       -
             match_parts template_parts uri_parts []

     

       11
       11
       +
       type t = {

     

       12
       12
       +
         server: Mcp_sdk.server;

     

       13
       13
       +
         transport: transport_type;

     

       14
       14
       +
         mutable running: bool;

     

       15
       15
       +
       }

     

       107
       16
        
       

     

       108
       108
       -
         (* Find a matching resource or template for a URI *)

     

       109
       109
       -
         let find_match server uri =

     

       110
       110
       -
           (* Try direct resource match first *)

     

       111
       111
       -
           match List.find_opt (fun resource -> resource.Resource.uri = uri) (resources server) with

     

       112
       112
       -
           | Some resource -> DirectResource (resource, [])

     

       113
       113
       -
           | None ->

     

       114
       114
       -
               (* Try template match next *)

     

       115
       115
       -
               let templates = resource_templates server in

     

       116
       116
       -
               

     

       117
       117
       -
               (* Try each template to see if it matches *)

     

       118
       118
       -
               let rec try_templates templates =

     

       119
       119
       -
                 match templates with

     

       120
       120
       -
                 | [] -> NoMatch

     

       121
       121
       -
                 | template::rest ->

     

       122
       122
       -
                     match extract_template_vars template.ResourceTemplate.uri_template uri with

     

       123
       123
       -
                     | Some params -> TemplateResource (template, params)

     

       124
       124
       -
                     | None -> try_templates rest

     

       125
       125
       -
               in

     

       126
       126
       -
               try_templates templates

     

       127
       127
       -
       end

     

       128
       128
       -
       

     

       129
       129
       -
       (* Process resources/read request *)

     

       130
       130
       -
       let handle_resources_read server (req:JSONRPCMessage.request) =

     

       131
       131
       -
         Log.debug "Processing resources/read request";

     

       132
       132
       -
         match req.JSONRPCMessage.params with

     

       133
       133
       -
         | None ->

     

       134
       134
       -
             Log.error "Missing params for resources/read request";

     

       135
       135
       -
             Some (create_jsonrpc_error req.id ErrorCode.InvalidParams "Missing params for resources/read request" ())

     

       136
       136
       -
         | Some params -> 

     

       137
       137
       -
             let req_data = Mcp_rpc.ResourcesRead.Request.t_of_yojson params in

     

       138
       138
       -
             let uri = req_data.uri in

     

       139
       139
       -
             Log.debugf "Resource URI: %s" uri;

     

       140
       140
       -
             

     

       141
       141
       -
             (* Find matching resource or template *)

     

       142
       142
       -
             match Resource_matcher.find_match server uri with

     

       143
       143
       -
             | Resource_matcher.DirectResource (resource, params) ->

     

       144
       144
       -
                 (* Create context for this request *)

     

       145
       145
       -
                 let ctx = Context.create 

     

       146
       146
       -
                   ?request_id:(Some req.id)

     

       147
       147
       -
                   ?progress_token:req.progress_token

     

       148
       148
       -
                   ~lifespan_context:[("resources/read", `Assoc [("uri", `String uri)])] 

     

       149
       149
       -
                   () 

     

       150
       150
       -
                 in

     

       151
       151
       -
                 

     

       152
       152
       -
                 Log.debugf "Handling direct resource: %s" resource.name;

     

       153
       153
       -
                 

     

       154
       154
       -
                 (* Call the resource handler *)

     

       155
       155
       -
                 (match resource.handler ctx params with

     

       156
       156
       -
                  | Ok content ->

     

       157
       157
       -
                      (* Create text resource content *)

     

       158
       158
       -
                      let mime_type = match resource.mime_type with

     

       159
       159
       -
                        | Some mime -> mime

     

       160
       160
       -
                        | None -> "text/plain"

     

       161
       161
       -
                      in

     

       162
       162
       -
                      let text_resource = {

     

       163
       163
       -
                        TextResourceContents.uri;

     

       164
       164
       -
                        text = content;

     

       165
       165
       -
                        mime_type = Some mime_type

     

       166
       166
       -
                      } in

     

       167
       167
       -
                      let resource_content = Mcp_rpc.ResourcesRead.ResourceContent.TextResource text_resource in

     

       168
       168
       -
                      let response = Mcp_rpc.ResourcesRead.create_response ~id:req.id ~contents:[resource_content] () in

     

       169
       169
       -
                      Some response

     

       170
       170
       -
                  | Error err ->

     

       171
       171
       -
                      Log.errorf "Error reading resource: %s" err;

     

       172
       172
       -
                      Some (create_jsonrpc_error req.id ErrorCode.InternalError ("Error reading resource: " ^ err) ()))

     

       173
       173
       -
                      

     

       174
       174
       -
             | Resource_matcher.TemplateResource (template, params) ->

     

       175
       175
       -
                 (* Create context for this request *)

     

       176
       176
       -
                 let ctx = Context.create 

     

       177
       177
       -
                   ?request_id:(Some req.id)

     

       178
       178
       -
                   ?progress_token:req.progress_token

     

       179
       179
       -
                   ~lifespan_context:[("resources/read", `Assoc [("uri", `String uri)])] 

     

       180
       180
       -
                   () 

     

       181
       181
       -
                 in

     

       182
       182
       -
                 

     

       183
       183
       -
                 Log.debugf "Handling resource template: %s with params: [%s]" 

     

       184
       184
       -
                   template.name 

     

       185
       185
       -
                   (String.concat ", " params);

     

       186
       186
       -
                 

     

       187
       187
       -
                 (* Call the template handler *)

     

       188
       188
       -
                 (match template.handler ctx params with

     

       189
       189
       -
                  | Ok content ->

     

       190
       190
       -
                      (* Create text resource content *)

     

       191
       191
       -
                      let mime_type = match template.mime_type with

     

       192
       192
       -
                        | Some mime -> mime

     

       193
       193
       -
                        | None -> "text/plain"

     

       194
       194
       -
                      in

     

       195
       195
       -
                      let text_resource = {

     

       196
       196
       -
                        TextResourceContents.uri;

     

       197
       197
       -
                        text = content;

     

       198
       198
       -
                        mime_type = Some mime_type

     

       199
       199
       -
                      } in

     

       200
       200
       -
                      let resource_content = Mcp_rpc.ResourcesRead.ResourceContent.TextResource text_resource in

     

       201
       201
       -
                      let response = Mcp_rpc.ResourcesRead.create_response ~id:req.id ~contents:[resource_content] () in

     

       202
       202
       -
                      Some response

     

       203
       203
       -
                  | Error err ->

     

       204
       204
       -
                      Log.errorf "Error reading resource template: %s" err;

     

       205
       205
       -
                      Some (create_jsonrpc_error req.id ErrorCode.InternalError ("Error reading resource template: " ^ err) ()))

     

       206
       206
       -
             

     

       207
       207
       -
             | Resource_matcher.NoMatch ->

     

       208
       208
       -
                 Log.errorf "Resource not found: %s" uri;

     

       209
       209
       -
                 Some (create_jsonrpc_error req.id ErrorCode.InvalidParams ("Resource not found: " ^ uri) ())

     

       210
       210
       -
       

     

       211
       211
       -
       (* Extract the tool name from params *)

     

       212
       212
       -
       let extract_tool_name params =

     

       213
       213
       -
         match List.assoc_opt "name" params with

     

       214
       214
       -
           | Some (`String name) -> 

     

       215
       215
       -
               Log.debugf "Tool name: %s" name;

     

       216
       216
       -
               Some name

     

       217
       217
       -
           | _ -> 

     

       218
       218
       -
               Log.error "Missing or invalid 'name' parameter in tool call";

     

       219
       219
       -
               None

     

       220
       220
       -
       

     

       221
       221
       -
       (* Extract the tool arguments from params *)

     

       222
       222
       -
       let extract_tool_arguments params =

     

       223
       223
       -
         match List.assoc_opt "arguments" params with

     

       224
       224
       -
           | Some (args) -> 

     

       225
       225
       -
               Log.debugf "Tool arguments: %s" (Yojson.Safe.to_string args);

     

       226
       226
       -
               args

     

       227
       227
       -
           | _ -> 

     

       228
       228
       -
               Log.debug "No arguments provided for tool call, using empty object";

     

       229
       229
       -
               `Assoc [] (* Empty arguments is valid *)

     

       230
       230
       -
       

     

       231
       231
       -
       (* Execute a tool *)

     

       232
       232
       -
       let execute_tool server ctx name args =

     

       233
       233
       -
         try

     

       234
       234
       -
           let tool = List.find (fun t -> t.Tool.name = name) (tools server) in

     

       235
       235
       -
           Log.debugf "Found tool: %s" name;

     

       236
       236
       -
           

     

       237
       237
       -
           (* Call the tool handler *)

     

       238
       238
       -
           match tool.handler ctx args with

     

       239
       239
       -
           | Ok result -> 

     

       240
       240
       -
               Log.debug "Tool execution succeeded";

     

       241
       241
       -
               result

     

       242
       242
       -
           | Error err -> Tool.handle_execution_error err

     

       243
       243
       -
         with

     

       244
       244
       -
         | Not_found -> Tool.handle_unknown_tool_error name

     

       245
       245
       -
         | exn -> Tool.handle_execution_exception exn

     

       246
       246
       -
       

     

       247
       247
       -
       (* Convert JSON tool result to RPC content format *)

     

       248
       248
       -
       let json_to_rpc_content json =

     

       249
       249
       -
         match json with

     

       250
       250
       -
         | `Assoc fields ->

     

       251
       251
       -
           (match List.assoc_opt "content" fields, List.assoc_opt "isError" fields with

     

       252
       252
       -
            | Some (`List content_items), Some (`Bool is_error) ->

     

       253
       253
       -
                let mcp_content = List.map Mcp.content_of_yojson content_items in

     

       254
       254
       -
                let rpc_content = Tool.mcp_content_to_rpc_content mcp_content in

     

       255
       255
       -
                (rpc_content, is_error)

     

       256
       256
       -
            | _ -> 

     

       257
       257
       -
                (* Fallback for compatibility with older formats *)

     

       258
       258
       -
                let text = Yojson.Safe.to_string json in

     

       259
       259
       -
                let text_content = { TextContent.text = text; annotations = None } in

     

       260
       260
       -
                ([Mcp_rpc.ToolsCall.ToolContent.Text text_content], false))

     

       261
       261
       -
         | _ ->

     

       262
       262
       -
           (* Simple fallback for non-object results *)

     

       263
       263
       -
           let text = Yojson.Safe.to_string json in

     

       264
       264
       -
           let text_content = { TextContent.text = text; annotations = None } in

     

       265
       265
       -
           ([Mcp_rpc.ToolsCall.ToolContent.Text text_content], false)

     

       266
       266
       -
       

     

       267
       267
       -
       (* Process tools/call request *)

     

       268
       268
       -
       let handle_tools_call server req =

     

       269
       269
       -
         Log.debug "Processing tools/call request";

     

       270
       270
       -
         match req.JSONRPCMessage.params with

     

       271
       271
       -
         | Some (`Assoc params) ->

     

       272
       272
       -
           (match extract_tool_name params with

     

       273
       273
       -
           | Some name ->

     

       274
       274
       -
               let args = extract_tool_arguments params in

     

       275
       275
       -
               

     

       276
       276
       -
               (* Create context for this request *)

     

       277
       277
       -
               let ctx = Context.create 

     

       278
       278
       -
                 ?request_id:(Some req.id)

     

       279
       279
       -
                 ?progress_token:req.progress_token

     

       280
       280
       -
                 ~lifespan_context:[("tools/call", `Assoc params)] 

     

       281
       281
       -
                 () 

     

       282
       282
       -
               in

     

       283
       283
       -
                       

     

       284
       284
       -
               (* Execute the tool *)

     

       285
       285
       -
               let result_json = execute_tool server ctx name args in

     

       286
       286
       -
               

     

       287
       287
       -
               (* Convert JSON result to RPC format *)

     

       288
       288
       -
               let content, is_error = json_to_rpc_content result_json in

     

       289
       289
       -
               

     

       290
       290
       -
               (* Create the RPC response *)

     

       291
       291
       -
               let response = Mcp_rpc.ToolsCall.create_response 

     

       292
       292
       -
                 ~id:req.id 

     

       293
       293
       -
                 ~content 

     

       294
       294
       -
                 ~is_error 

     

       295
       295
       -
                 () 

     

       296
       296
       -
               in

     

       297
       297
       -
               

     

       298
       298
       -
               Some response

     

       299
       299
       -
           | None ->

     

       300
       300
       -
               Some (create_jsonrpc_error req.id InvalidParams "Missing tool name parameter" ()))

     

       301
       301
       -
         | _ ->

     

       302
       302
       -
           Log.error "Invalid params format for tools/call";

     

       303
       303
       -
           Some (create_jsonrpc_error req.id InvalidParams "Invalid params format for tools/call" ())

     

       304
       304
       -
       

     

       305
       305
       -
       (* Process ping request *)

     

       306
       306
       -
       let handle_ping (req:JSONRPCMessage.request) =

     

       307
       307
       -
         Log.debug "Processing ping request";

     

       308
       308
       -
         Some (create_response ~id:req.JSONRPCMessage.id ~result:(`Assoc []))

     

       309
       309
       -
       

     

       310
       310
       -
       (* Handle notifications/initialized *)

     

       311
       311
       -
       let handle_initialized (notif:JSONRPCMessage.notification) =

     

       312
       312
       -
         Log.debug "Client initialization complete - Server is now ready to receive requests";

     

       313
       313
       -
         Log.debugf "Notification params: %s" 

     

       314
       314
       -
           (match notif.JSONRPCMessage.params with

     

       315
       315
       -
             | Some p -> Yojson.Safe.to_string p

     

       316
       316
       -
             | None -> "null");

     

       317
       317
       -
         None

     

       318
       318
       -
       

     

       319
       319
       -
       (* Process a single message using the MCP SDK *)

     

       17
       17
       +
       (** Process a single message *)

     

       320
       18
        
       let process_message server message =

     

       321
       19
        
         try

     

       322
       322
       -
           Log.debugf "Processing message: %s" (Yojson.Safe.to_string message);

     

       20
       20
       +
           Log.debug "Parsing message as JSONRPC message...";

     

       323
       21
        
           match JSONRPCMessage.t_of_yojson message with

     

       324
       324
       -
           | JSONRPCMessage.Request req ->

     

       325
       325
       -
             Log.debugf "Received request with method: %s" (Method.to_string req.meth);

     

       326
       326
       -
             (match req.meth with

     

       327
       327
       -
              | Method.Initialize -> handle_initialize server req

     

       328
       328
       -
              | Method.ToolsList -> handle_tools_list server req

     

       329
       329
       -
              | Method.ToolsCall -> handle_tools_call server req

     

       330
       330
       -
              | Method.PromptsList -> handle_prompts_list server req

     

       331
       331
       -
              | Method.ResourcesList -> handle_resources_list server req

     

       332
       332
       -
              | Method.ResourcesRead -> handle_resources_read server req

     

       333
       333
       -
              | Method.ResourceTemplatesList -> handle_resource_templates_list server req

     

       334
       334
       -
              | _ -> 

     

       335
       335
       -
                 Log.errorf "Unknown method received: %s" (Method.to_string req.meth);

     

       336
       336
       -
                 Some (create_jsonrpc_error req.id ErrorCode.MethodNotFound ("Method not found: " ^ (Method.to_string req.meth)) ()))

     

       337
       337
       -
           | JSONRPCMessage.Notification notif ->

     

       338
       338
       -
             Log.debugf "Received notification with method: %s" (Method.to_string notif.meth);

     

       339
       339
       -
             (match notif.meth with

     

       340
       340
       -
              | Method.Initialized -> handle_initialized notif

     

       341
       341
       -
              | _ ->

     

       342
       342
       -
                 Log.debugf "Ignoring notification: %s" (Method.to_string notif.meth);

     

       343
       343
       -
                 None)

     

       344
       344
       -
           | JSONRPCMessage.Response _ ->

     

       345
       345
       -
             Log.error "Unexpected response message received";

     

       22
       22
       +
           | JSONRPCMessage.Request req -> begin

     

       23
       23
       +
               Log.debug (Printf.sprintf "Received request with method: %s" req.method_);

     

       24
       24
       +
               match req.method_ with

     

       25
       25
       +
               | "initialize" -> begin

     

       26
       26
       +
                   Log.debug "Processing initialize request";

     

       27
       27
       +
                   let result = match req.params with

     

       28
       28
       +
                   | Some params -> begin

     

       29
       29
       +
                       Log.debug "Parsing initialize request params...";

     

       30
       30
       +
                       let req_params = Initialize.Request.t_of_yojson params in

     

       31
       31
       +
                       Log.debug (Printf.sprintf "Client info: %s v%s" 

     

       32
       32
       +
                                    req_params.client_info.name 

     

       33
       33
       +
                                    req_params.client_info.version);

     

       34
       34
       +
                       Log.debug (Printf.sprintf "Client protocol version: %s" req_params.protocol_version);

     

       35
       35
       +
                       

     

       36
       36
       +
                       (* Check protocol version compatibility *)

     

       37
       37
       +
                       if req_params.protocol_version <> server.protocol_version then begin

     

       38
       38
       +
                         Log.debug (Printf.sprintf "Protocol version mismatch: client=%s server=%s" 

     

       39
       39
       +
                                     req_params.protocol_version server.protocol_version);

     

       40
       40
       +
                       end;

     

       41
       41
       +
                       

     

       42
       42
       +
                       Initialize.Result.create

     

       43
       43
       +
                         ~capabilities:server.capabilities

     

       44
       44
       +
                         ~server_info:Implementation.{ name = server.name; version = server.version }

     

       45
       45
       +
                         ~protocol_version:server.protocol_version

     

       46
       46
       +
                         ?instructions:(Some "MCP Server") (* TODO: Allow customization *)

     

       47
       47
       +
                         ()

     

       48
       48
       +
                     end

     

       49
       49
       +
                   | None -> begin

     

       50
       50
       +
                       Log.error "Missing params for initialize request";

     

       51
       51
       +
                       Initialize.Result.create

     

       52
       52
       +
                         ~capabilities:server.capabilities

     

       53
       53
       +
                         ~server_info:Implementation.{ name = server.name; version = server.version }

     

       54
       54
       +
                         ~protocol_version:server.protocol_version

     

       55
       55
       +
                         ()

     

       56
       56
       +
                     end

     

       57
       57
       +
                   in

     

       58
       58
       +
                   Some (create_response ~id:req.id ~result:(Initialize.Result.yojson_of_t result))

     

       59
       59
       +
                 end

     

       60
       60
       +
                

     

       61
       61
       +
               | "tools/list" -> begin

     

       62
       62
       +
                   Log.debug "Processing tools/list request";

     

       63
       63
       +
                   let tools_json = List.map Mcp_sdk.Tool.to_json server.tools in

     

       64
       64
       +
                   let result = `Assoc [("tools", `List tools_json)] in

     

       65
       65
       +
                   Some (create_response ~id:req.id ~result)

     

       66
       66
       +
                 end

     

       67
       67
       +
                

     

       68
       68
       +
               | "tools/call" -> begin

     

       69
       69
       +
                   Log.debug "Processing tools/call request";

     

       70
       70
       +
                   match req.params with

     

       71
       71
       +
                   | Some (`Assoc params) -> begin

     

       72
       72
       +
                       let name = match List.assoc_opt "name" params with

     

       73
       73
       +
                       | Some (`String name) -> begin

     

       74
       74
       +
                           Log.debug (Printf.sprintf "Tool name: %s" name);

     

       75
       75
       +
                           name

     

       76
       76
       +
                         end

     

       77
       77
       +
                       | _ -> begin

     

       78
       78
       +
                           Log.error "Missing or invalid 'name' parameter in tool call";

     

       79
       79
       +
                           failwith "Missing or invalid 'name' parameter"

     

       80
       80
       +
                         end

     

       81
       81
       +
                       in

     

       82
       82
       +
                       let args = match List.assoc_opt "arguments" params with

     

       83
       83
       +
                       | Some args -> begin

     

       84
       84
       +
                           Log.debug (Printf.sprintf "Tool arguments: %s" (Yojson.Safe.to_string args));

     

       85
       85
       +
                           args

     

       86
       86
       +
                         end

     

       87
       87
       +
                       | _ -> begin

     

       88
       88
       +
                           Log.debug "No arguments provided for tool call, using empty object";

     

       89
       89
       +
                           `Assoc [] (* Empty arguments is valid *)

     

       90
       90
       +
                         end

     

       91
       91
       +
                       in

     

       92
       92
       +
                       let progress_token = req.progress_token in

     

       93
       93
       +
                       

     

       94
       94
       +
                       (* Find the tool *)

     

       95
       95
       +
                       let tool_opt = List.find_opt (fun t -> t.Mcp_sdk.Tool.name = name) server.tools in

     

       96
       96
       +
                       match tool_opt with

     

       97
       97
       +
                       | Some tool -> begin

     

       98
       98
       +
                           Log.debug (Printf.sprintf "Found tool: %s" name);

     

       99
       99
       +
                           let ctx = Mcp_sdk.Context.create 

     

       100
       100
       +
                               ?request_id:(Some req.id) 

     

       101
       101
       +
                               ~lifespan_context:server.lifespan_context 

     

       102
       102
       +
                               () 

     

       103
       103
       +
                           in

     

       104
       104
       +
                           ctx.progress_token <- progress_token;

     

       105
       105
       +
                           

     

       106
       106
       +
                           (* Call the handler *)

     

       107
       107
       +
                           let result = match tool.handler ctx args with

     

       108
       108
       +
                           | Ok json -> begin

     

       109
       109
       +
                               `Assoc [

     

       110
       110
       +
                                 ("content", `List [Mcp.yojson_of_content (Text (TextContent.{ 

     

       111
       111
       +
                                   text = Yojson.Safe.to_string json;

     

       112
       112
       +
                                   annotations = None 

     

       113
       113
       +
                                 }))]);

     

       114
       114
       +
                                 ("isError", `Bool false)

     

       115
       115
       +
                               ]

     

       116
       116
       +
                             end

     

       117
       117
       +
                           | Error err -> begin

     

       118
       118
       +
                               `Assoc [

     

       119
       119
       +
                                 ("content", `List [Mcp.yojson_of_content (Text (TextContent.{ 

     

       120
       120
       +
                                   text = err;

     

       121
       121
       +
                                   annotations = None 

     

       122
       122
       +
                                 }))]);

     

       123
       123
       +
                                 ("isError", `Bool true)

     

       124
       124
       +
                               ]

     

       125
       125
       +
                             end

     

       126
       126
       +
                           in

     

       127
       127
       +
                           Some (create_response ~id:req.id ~result)

     

       128
       128
       +
                         end

     

       129
       129
       +
                       | None -> begin

     

       130
       130
       +
                           Log.error (Printf.sprintf "Tool not found: %s" name);

     

       131
       131
       +
                           let error_content = TextContent.{

     

       132
       132
       +
                             text = Printf.sprintf "Unknown tool: %s" name;

     

       133
       133
       +
                             annotations = None

     

       134
       134
       +
                           } in

     

       135
       135
       +
                           let result = `Assoc [

     

       136
       136
       +
                             ("content", `List [Mcp.yojson_of_content (Text error_content)]);

     

       137
       137
       +
                             ("isError", `Bool true)

     

       138
       138
       +
                           ] in

     

       139
       139
       +
                           Some (create_response ~id:req.id ~result)

     

       140
       140
       +
                         end

     

       141
       141
       +
                     end

     

       142
       142
       +
                   | _ -> begin

     

       143
       143
       +
                       Log.error "Invalid params format for tools/call";

     

       144
       144
       +
                       Some (create_error ~id:req.id ~code:ErrorCode.invalid_params ~message:"Invalid params for tools/call" ())

     

       145
       145
       +
                     end

     

       146
       146
       +
                 end

     

       147
       147
       +
                   

     

       148
       148
       +
               | "resources/list" -> begin

     

       149
       149
       +
                   Log.debug "Processing resources/list request";

     

       150
       150
       +
                   if server.resources <> [] then begin

     

       151
       151
       +
                     let resources_json = List.map Mcp_sdk.Resource.to_json server.resources in

     

       152
       152
       +
                     let result = `Assoc [("resources", `List resources_json)] in

     

       153
       153
       +
                     Some (create_response ~id:req.id ~result)

     

       154
       154
       +
                   end else begin

     

       155
       155
       +
                     Some (create_error ~id:req.id ~code:ErrorCode.method_not_found ~message:"Resources not supported" ())

     

       156
       156
       +
                   end

     

       157
       157
       +
                 end

     

       158
       158
       +
                  

     

       159
       159
       +
               | "prompts/list" -> begin

     

       160
       160
       +
                   Log.debug "Processing prompts/list request";

     

       161
       161
       +
                   if server.prompts <> [] then begin

     

       162
       162
       +
                     let prompts_json = List.map Mcp_sdk.Prompt.to_json server.prompts in

     

       163
       163
       +
                     let result = `Assoc [("prompts", `List prompts_json)] in

     

       164
       164
       +
                     Some (create_response ~id:req.id ~result)

     

       165
       165
       +
                   end else begin

     

       166
       166
       +
                     Some (create_error ~id:req.id ~code:ErrorCode.method_not_found ~message:"Prompts not supported" ())

     

       167
       167
       +
                   end

     

       168
       168
       +
                 end

     

       169
       169
       +
                  

     

       170
       170
       +
               | "prompts/get" -> begin

     

       171
       171
       +
                   Log.debug "Processing prompts/get request";

     

       172
       172
       +
                   if server.prompts <> [] then begin

     

       173
       173
       +
                     match req.params with

     

       174
       174
       +
                     | Some (`Assoc params) -> begin

     

       175
       175
       +
                         (* Extract prompt name *)

     

       176
       176
       +
                         let name = match List.assoc_opt "name" params with

     

       177
       177
       +
                         | Some (`String name) -> begin 

     

       178
       178
       +
                             Log.debug (Printf.sprintf "Prompt name: %s" name);

     

       179
       179
       +
                             name

     

       180
       180
       +
                           end

     

       181
       181
       +
                         | _ -> begin

     

       182
       182
       +
                             Log.error "Missing or invalid 'name' parameter in prompt request";

     

       183
       183
       +
                             failwith "Missing or invalid 'name' parameter"

     

       184
       184
       +
                           end

     

       185
       185
       +
                         in

     

       186
       186
       +
                         

     

       187
       187
       +
                         (* Extract arguments if any *)

     

       188
       188
       +
                         let arguments = match List.assoc_opt "arguments" params with

     

       189
       189
       +
                         | Some (`Assoc args) -> begin

     

       190
       190
       +
                             Log.debug (Printf.sprintf "Prompt arguments: %s" (Yojson.Safe.to_string (`Assoc args)));

     

       191
       191
       +
                             List.map (fun (k, v) -> 

     

       192
       192
       +
                               match v with 

     

       193
       193
       +
                               | `String s -> begin (k, s) end

     

       194
       194
       +
                               | _ -> begin (k, Yojson.Safe.to_string v) end

     

       195
       195
       +
                             ) args

     

       196
       196
       +
                           end

     

       197
       197
       +
                         | _ -> begin

     

       198
       198
       +
                             []

     

       199
       199
       +
                           end

     

       200
       200
       +
                         in

     

       201
       201
       +
                         

     

       202
       202
       +
                         (* Find the prompt *)

     

       203
       203
       +
                         let prompt_opt = List.find_opt (fun p -> p.Mcp_sdk.Prompt.name = name) server.prompts in

     

       204
       204
       +
                         match prompt_opt with

     

       205
       205
       +
                         | Some prompt -> begin

     

       206
       206
       +
                             Log.debug (Printf.sprintf "Found prompt: %s" name);

     

       207
       207
       +
                             let ctx = Mcp_sdk.Context.create 

     

       208
       208
       +
                                 ?request_id:(Some req.id) 

     

       209
       209
       +
                                 ~lifespan_context:server.lifespan_context 

     

       210
       210
       +
                                 () 

     

       211
       211
       +
                             in

     

       212
       212
       +
                             

     

       213
       213
       +
                             (* Call the prompt handler *)

     

       214
       214
       +
                             match prompt.handler ctx arguments with

     

       215
       215
       +
                             | Ok messages -> begin

     

       216
       216
       +
                                 Log.debug (Printf.sprintf "Prompt handler returned %d messages" (List.length messages));

     

       217
       217
       +
                                 

     

       218
       218
       +
                                 (* Important: We need to directly use yojson_of_message which preserves MIME types *)

     

       219
       219
       +
                                 let messages_json = List.map Prompt.yojson_of_message messages in

     

       220
       220
       +
                                 

     

       221
       221
       +
                                 (* Debug output *)

     

       222
       222
       +
                                 Log.debug (Printf.sprintf "Messages JSON: %s" (Yojson.Safe.to_string (`List messages_json)));

     

       223
       223
       +
                                 

     

       224
       224
       +
                                 (* Verify one message if available to check structure *)

     

       225
       225
       +
                                 if List.length messages > 0 then begin

     

       226
       226
       +
                                   let first_msg = List.hd messages in

     

       227
       227
       +
                                   let content_debug = match first_msg.content with

     

       228
       228
       +
                                   | Text t -> begin

     

       229
       229
       +
                                       Printf.sprintf "Text content: %s" t.text

     

       230
       230
       +
                                     end

     

       231
       231
       +
                                   | Image i -> begin

     

       232
       232
       +
                                       Printf.sprintf "Image content (mime: %s)" i.mime_type

     

       233
       233
       +
                                     end

     

       234
       234
       +
                                   | Audio a -> begin

     

       235
       235
       +
                                       Printf.sprintf "Audio content (mime: %s)" a.mime_type

     

       236
       236
       +
                                     end

     

       237
       237
       +
                                   | Resource r -> begin

     

       238
       238
       +
                                       "Resource content"

     

       239
       239
       +
                                     end

     

       240
       240
       +
                                   in

     

       241
       241
       +
                                   Log.debug (Printf.sprintf "First message content type: %s" content_debug);

     

       242
       242
       +
                                 end;

     

       243
       243
       +
                                 

     

       244
       244
       +
                                 let result = `Assoc [

     

       245
       245
       +
                                   ("messages", `List messages_json);

     

       246
       246
       +
                                   ("description", match prompt.description with 

     

       247
       247
       +
                                     | Some d -> begin `String d end 

     

       248
       248
       +
                                     | None -> begin `Null end)

     

       249
       249
       +
                                 ] in

     

       250
       250
       +
                                 Some (create_response ~id:req.id ~result)

     

       251
       251
       +
                               end

     

       252
       252
       +
                             | Error err -> begin

     

       253
       253
       +
                                 Log.error (Printf.sprintf "Error processing prompt: %s" err);

     

       254
       254
       +
                                 Some (create_error ~id:req.id ~code:ErrorCode.internal_error ~message:err ())

     

       255
       255
       +
                               end

     

       256
       256
       +
                           end

     

       257
       257
       +
                         | None -> begin

     

       258
       258
       +
                             Log.error (Printf.sprintf "Prompt not found: %s" name);

     

       259
       259
       +
                             Some (create_error ~id:req.id ~code:ErrorCode.invalid_params ~message:(Printf.sprintf "Prompt not found: %s" name) ())

     

       260
       260
       +
                           end

     

       261
       261
       +
                       end

     

       262
       262
       +
                     | _ -> begin

     

       263
       263
       +
                         Log.error "Invalid params format for prompts/get";

     

       264
       264
       +
                         Some (create_error ~id:req.id ~code:ErrorCode.invalid_params ~message:"Invalid params format" ())

     

       265
       265
       +
                       end

     

       266
       266
       +
                   end else begin

     

       267
       267
       +
                     Some (create_error ~id:req.id ~code:ErrorCode.method_not_found ~message:"Prompts not supported" ())

     

       268
       268
       +
                   end

     

       269
       269
       +
                 end

     

       270
       270
       +
                  

     

       271
       271
       +
               | "ping" -> begin

     

       272
       272
       +
                   Log.debug "Processing ping request";

     

       273
       273
       +
                   Some (create_response ~id:req.id ~result:(`Assoc []))

     

       274
       274
       +
                 end

     

       275
       275
       +
                

     

       276
       276
       +
               | _ -> begin

     

       277
       277
       +
                   Log.error (Printf.sprintf "Unknown method received: %s" req.method_);

     

       278
       278
       +
                   Some (create_error ~id:req.id ~code:ErrorCode.method_not_found ~message:("Method not found: " ^ req.method_) ())

     

       279
       279
       +
                 end

     

       280
       280
       +
             end

     

       281
       281
       +
                

     

       282
       282
       +
           | JSONRPCMessage.Notification notif -> begin

     

       283
       283
       +
               Log.debug (Printf.sprintf "Received notification with method: %s" notif.method_);

     

       284
       284
       +
               match notif.method_ with

     

       285
       285
       +
               | "notifications/initialized" -> begin

     

       286
       286
       +
                   Log.debug "Client initialization complete - Server is now ready to receive requests";

     

       287
       287
       +
                   None

     

       288
       288
       +
                 end

     

       289
       289
       +
               | _ -> begin

     

       290
       290
       +
                   Log.debug (Printf.sprintf "Ignoring notification: %s" notif.method_);

     

       291
       291
       +
                   None

     

       292
       292
       +
                 end

     

       293
       293
       +
             end

     

       294
       294
       +
                

     

       295
       295
       +
           | JSONRPCMessage.Response _ -> begin

     

       296
       296
       +
               Log.error "Unexpected response message received";

     

       297
       297
       +
               None

     

       298
       298
       +
             end

     

       299
       299
       +
             

     

       300
       300
       +
           | JSONRPCMessage.Error _ -> begin

     

       301
       301
       +
               Log.error "Unexpected error message received";

     

       302
       302
       +
               None

     

       303
       303
       +
             end

     

       304
       304
       +
         with

     

       305
       305
       +
         | Failure msg -> begin

     

       306
       306
       +
             Log.error (Printf.sprintf "JSON error in message processing: %s" msg);

     

       346
       307
        
             None

     

       347
       347
       -
           | JSONRPCMessage.Error _ ->

     

       348
       348
       -
             Log.error "Unexpected error message received";

     

       308
       308
       +
           end

     

       309
       309
       +
         | exc -> begin

     

       310
       310
       +
             Log.error (Printf.sprintf "Exception during message processing: %s" (Printexc.to_string exc));

     

       311
       311
       +
             Log.error (Printf.sprintf "Backtrace: %s" (Printexc.get_backtrace()));

     

       349
       312
        
             None

     

       350
       350
       -
         with

     

       351
       351
       -
         | Json.Of_json (msg, _) ->

     

       352
       352
       -
           Log.errorf "JSON error: %s" msg;

     

       353
       353
       -
           (* Can't respond with error because we don't have a request ID *)

     

       354
       354
       -
           None

     

       355
       355
       -
         | Yojson.Json_error msg -> 

     

       356
       356
       -
           Log.errorf "JSON parse error: %s" msg;

     

       357
       357
       -
           (* Can't respond with error because we don't have a request ID *)

     

       358
       358
       -
           None

     

       359
       359
       -
         | exc ->

     

       360
       360
       -
           Log.errorf "Exception during message processing: %s" (Printexc.to_string exc);

     

       361
       361
       -
           Log.errorf "Backtrace: %s" (Printexc.get_backtrace());

     

       362
       362
       -
           Log.errorf "Message was: %s" (Yojson.Safe.to_string message);

     

       363
       363
       -
           None

     

       313
       313
       +
           end

     

       364
       314
        
       

     

       365
       365
       -
       (* Extract a request ID from a potentially malformed message *)

     

       366
       366
       -
       let extract_request_id json =

     

       315
       315
       +
       (** Read a single message from stdin *)

     

       316
       316
       +
       let read_stdio_message () =

     

       367
       317
        
         try

     

       368
       368
       -
           match json with

     

       369
       369
       -
           | `Assoc fields ->

     

       370
       370
       -
             (match List.assoc_opt "id" fields with

     

       371
       371
       -
              | Some (`Int id) -> Some (`Int id)

     

       372
       372
       -
              | Some (`String id) -> Some (`String id)

     

       373
       373
       -
              | _ -> None)

     

       374
       374
       -
           | _ -> None

     

       375
       375
       -
         with _ -> None

     

       318
       318
       +
           Log.debug "Reading line from stdin...";

     

       319
       319
       +
           let line = read_line () in

     

       320
       320
       +
           if line = "" then begin

     

       321
       321
       +
             Log.debug "Empty line received, ignoring";

     

       322
       322
       +
             None

     

       323
       323
       +
           end else begin

     

       324
       324
       +
             Log.debug (Printf.sprintf "Raw input: %s" (String.sub line 0 (min 100 (String.length line))));

     

       325
       325
       +
             try

     

       326
       326
       +
               let json = Yojson.Safe.from_string line in

     

       327
       327
       +
               Log.debug "Successfully parsed JSON";

     

       328
       328
       +
               Some json

     

       329
       329
       +
             with

     

       330
       330
       +
             | Yojson.Json_error msg -> begin

     

       331
       331
       +
                 Log.error (Printf.sprintf "Error parsing JSON: %s" msg);

     

       332
       332
       +
                 Log.error (Printf.sprintf "Input was: %s" (String.sub line 0 (min 100 (String.length line))));

     

       333
       333
       +
                 None

     

       334
       334
       +
               end

     

       335
       335
       +
           end

     

       336
       336
       +
         with

     

       337
       337
       +
         | End_of_file -> begin

     

       338
       338
       +
             Log.debug "End of file received on stdin";

     

       339
       339
       +
             None

     

       340
       340
       +
           end

     

       341
       341
       +
         | Sys_error msg -> begin

     

       342
       342
       +
             Log.error (Printf.sprintf "System error while reading: %s" msg);

     

       343
       343
       +
             None

     

       344
       344
       +
           end

     

       345
       345
       +
         | exc -> begin

     

       346
       346
       +
             Log.error (Printf.sprintf "Exception while reading: %s" (Printexc.to_string exc));

     

       347
       347
       +
             None

     

       348
       348
       +
           end

     

       376
       349
        
       

     

       377
       377
       -
       (* Handle processing for an input line *)

     

       378
       378
       -
       let process_input_line server line =

     

       379
       379
       -
         if line = "" then (

     

       380
       380
       -
           Log.debug "Empty line received, ignoring";

     

       381
       381
       -
           None

     

       382
       382
       -
         ) else (

     

       383
       383
       -
           Log.debugf "Raw input: %s" line;

     

       384
       384
       -
           try

     

       385
       385
       -
             let json = Yojson.Safe.from_string line in

     

       386
       386
       -
             Log.debug "Successfully parsed JSON";

     

       387
       387
       -
             

     

       388
       388
       -
             (* Process the message *)

     

       389
       389
       -
             process_message server json

     

       390
       390
       -
           with

     

       391
       391
       -
           | Yojson.Json_error msg -> begin

     

       392
       392
       -
               Log.errorf "Error parsing JSON: %s" msg;

     

       393
       393
       -
               Log.errorf "Input was: %s" line;

     

       394
       394
       -
               None

     

       350
       350
       +
       (** Run stdio server with enhanced error handling *)

     

       351
       351
       +
       let rec run_stdio_server mcp_server =

     

       352
       352
       +
         try begin

     

       353
       353
       +
           if not mcp_server.running then begin

     

       354
       354
       +
             Log.debug "Server stopped";

     

       355
       355
       +
             ()

     

       356
       356
       +
           end else begin

     

       357
       357
       +
             match read_stdio_message () with

     

       358
       358
       +
             | Some json -> begin

     

       359
       359
       +
                 Log.debug "Processing message...";

     

       360
       360
       +
                 try begin

     

       361
       361
       +
                   match process_message mcp_server.server json with

     

       362
       362
       +
                   | Some response -> begin

     

       363
       363
       +
                       let response_json = JSONRPCMessage.yojson_of_t response in

     

       364
       364
       +
                       let response_str = Yojson.Safe.to_string response_json in

     

       365
       365
       +
                       Log.debug (Printf.sprintf "Sending response: %s" 

     

       366
       366
       +
                                   (String.sub response_str 0 (min 100 (String.length response_str))));

     

       367
       367
       +
                       Printf.printf "%s\n" response_str;

     

       368
       368
       +
                       flush stdout;

     

       369
       369
       +
                       (* Give client time to process *)

     

       370
       370
       +
                       Unix.sleepf 0.01;

     

       371
       371
       +
                     end

     

       372
       372
       +
                   | None -> begin

     

       373
       373
       +
                       Log.debug "No response needed"

     

       374
       374
       +
                     end

     

       375
       375
       +
                   end with

     

       376
       376
       +
                   | exc -> begin

     

       377
       377
       +
                       Log.error (Printf.sprintf "ERROR in message processing: %s" (Printexc.to_string exc));

     

       378
       378
       +
                       Log.error (Printf.sprintf "Backtrace: %s" (Printexc.get_backtrace()));

     

       379
       379
       +
                       (* Try to extract ID and send an error response *)

     

       380
       380
       +
                       try begin

     

       381
       381
       +
                         let id_opt = match Yojson.Safe.Util.member "id" json with

     

       382
       382
       +
                           | `Int i -> Some (`Int i)

     

       383
       383
       +
                           | `String s -> Some (`String s)

     

       384
       384
       +
                           | _ -> None

     

       385
       385
       +
                         in

     

       386
       386
       +
                         match id_opt with

     

       387
       387
       +
                         | Some id -> begin

     

       388
       388
       +
                             let error_resp = create_error ~id ~code:ErrorCode.internal_error ~message:(Printexc.to_string exc) () in

     

       389
       389
       +
                             let error_json = JSONRPCMessage.yojson_of_t error_resp in

     

       390
       390
       +
                             let error_str = Yojson.Safe.to_string error_json in

     

       391
       391
       +
                             Printf.printf "%s\n" error_str;

     

       392
       392
       +
                             flush stdout;

     

       393
       393
       +
                           end

     

       394
       394
       +
                         | None -> begin

     

       395
       395
       +
                             Log.error "Could not extract request ID to send error response"

     

       396
       396
       +
                           end

     

       397
       397
       +
                         end with

     

       398
       398
       +
                         | e -> begin

     

       399
       399
       +
                             Log.error (Printf.sprintf "Failed to send error response: %s" (Printexc.to_string e))

     

       400
       400
       +
                           end

     

       401
       401
       +
                     end;

     

       402
       402
       +
                 run_stdio_server mcp_server

     

       403
       403
       +
               end

     

       404
       404
       +
             | None -> begin

     

       405
       405
       +
                 if mcp_server.running then begin

     

       406
       406
       +
                   (* No message received, but server is still running *)

     

       407
       407
       +
                   Unix.sleepf 0.1;  (* Small sleep to prevent CPU spinning *)

     

       408
       408
       +
                   run_stdio_server mcp_server

     

       409
       409
       +
                 end else begin

     

       410
       410
       +
                   Log.debug "Server stopped during message processing"

     

       411
       411
       +
                 end

     

       412
       412
       +
               end

     

       413
       413
       +
           end

     

       414
       414
       +
         end with

     

       415
       415
       +
         | exc -> begin

     

       416
       416
       +
             Log.error (Printf.sprintf "FATAL ERROR in server main loop: %s" (Printexc.to_string exc));

     

       417
       417
       +
             Log.error (Printf.sprintf "Backtrace: %s" (Printexc.get_backtrace()));

     

       418
       418
       +
             (* Try to continue anyway *)

     

       419
       419
       +
             if mcp_server.running then begin

     

       420
       420
       +
               Unix.sleepf 0.1;

     

       421
       421
       +
               run_stdio_server mcp_server

     

       422
       422
       +
             end

     

       395
       423
        
           end

     

       396
       396
       -
         )

     

       424
       424
       +
       

     

       425
       425
       +
       (** Create an MCP server *)

     

       426
       426
       +
       let create ~server ~transport () =

     

       427
       427
       +
         { server; transport; running = false }

     

       397
       428
        
       

     

       398
       398
       -
       (* Send a response to the client *)

     

       399
       399
       -
       let send_response stdout response =

     

       400
       400
       -
         let response_json = JSONRPCMessage.yojson_of_t response in

     

       401
       401
       -
         let response_str = Yojson.Safe.to_string response_json in

     

       402
       402
       -
         Log.debugf "Sending response: %s" response_str;

     

       429
       429
       +
       (** HTTP server placeholder (to be fully implemented) *)

     

       430
       430
       +
       let run_http_server mcp_server port =

     

       431
       431
       +
         Log.info (Printf.sprintf "%s HTTP server starting on port %d" mcp_server.server.name port);

     

       432
       432
       +
         Log.info "HTTP transport is a placeholder and not fully implemented yet";

     

       403
       433
        
         

     

       404
       404
       -
         (* Write the response followed by a newline *)

     

       405
       405
       -
         Eio.Flow.copy_string response_str stdout;

     

       406
       406
       -
         Eio.Flow.copy_string "\n" stdout

     

       407
       407
       -
       

     

       408
       408
       -
       (* Run the MCP server with the given server configuration *)

     

       409
       409
       -
       let callback mcp_server _conn (request : Http.Request.t) body =

     

       410
       410
       -
         match request.meth with

     

       411
       411
       -
         | `POST -> (

     

       412
       412
       -
             Log.debug "Received POST request";

     

       413
       413
       -
             let request_body_str =

     

       414
       414
       -
               Eio.Buf_read.(parse_exn take_all) body ~max_size:max_int

     

       415
       415
       -
             in

     

       416
       416
       -
             match process_input_line mcp_server request_body_str with

     

       417
       417
       -
             | Some mcp_response ->

     

       418
       418
       -
                 let response_json = JSONRPCMessage.yojson_of_t mcp_response in

     

       434
       434
       +
         (* This would be where we'd set up cohttp server *)

     

       435
       435
       +
         (*

     

       436
       436
       +
         let callback _conn req body =

     

       437
       437
       +
           let uri = req |> Cohttp.Request.uri in

     

       438
       438
       +
           let meth = req |> Cohttp.Request.meth |> Cohttp.Code.string_of_method in

     

       439
       439
       +
           

     

       440
       440
       +
           (* Handle only POST /jsonrpc endpoint *)

     

       441
       441
       +
           match (meth, Uri.path uri) with

     

       442
       442
       +
           | "POST", "/jsonrpc" ->

     

       443
       443
       +
             (* Read the body *)

     

       444
       444
       +
             Cohttp_lwt.Body.to_string body >>= fun body_str ->

     

       445
       445
       +
             

     

       446
       446
       +
             (* Parse JSON *)

     

       447
       447
       +
             let json = try Some (Yojson.Safe.from_string body_str) with _ -> None in

     

       448
       448
       +
             match json with

     

       449
       449
       +
             | Some json_msg ->

     

       450
       450
       +
               (* Process the message *)

     

       451
       451
       +
               let response_opt = process_message mcp_server.server json_msg in

     

       452
       452
       +
               (match response_opt with

     

       453
       453
       +
               | Some response ->

     

       454
       454
       +
                 let response_json = JSONRPCMessage.yojson_of_t response in

     

       419
       455
        
                 let response_str = Yojson.Safe.to_string response_json in

     

       420
       420
       -
                 Log.debugf "Sending MCP response: %s" response_str;

     

       421
       421
       -
                 let headers =

     

       422
       422
       -
                   Http.Header.of_list [ ("Content-Type", "application/json") ]

     

       423
       423
       -
                 in

     

       424
       424
       -
                 Cohttp_eio.Server.respond ~status:`OK ~headers

     

       425
       425
       -
                   ~body:(Cohttp_eio.Body.of_string response_str)

     

       456
       456
       +
                 Cohttp_lwt_unix.Server.respond_string

     

       457
       457
       +
                   ~status:`OK

     

       458
       458
       +
                   ~body:response_str

     

       459
       459
       +
                   ~headers:(Cohttp.Header.init_with "Content-Type" "application/json")

     

       426
       460
        
                   ()

     

       461
       461
       +
               | None ->

     

       462
       462
       +
                 Cohttp_lwt_unix.Server.respond_string

     

       463
       463
       +
                   ~status:`OK

     

       464
       464
       +
                   ~body:"{}"

     

       465
       465
       +
                   ~headers:(Cohttp.Header.init_with "Content-Type" "application/json")

     

       466
       466
       +
                   ())

     

       427
       467
        
             | None ->

     

       428
       428
       -
                 Log.debug "No MCP response needed";

     

       429
       429
       -
                 Cohttp_eio.Server.respond ~status:`No_content ~body:(Cohttp_eio.Body.of_string "") ())

     

       430
       430
       -
         | _ ->

     

       431
       431
       -
             Log.infof "Unsupported method: %s" (Http.Method.to_string request.meth);

     

       432
       432
       -
             Cohttp_eio.Server.respond ~status:`Method_not_allowed

     

       433
       433
       -
               ~body:(Cohttp_eio.Body.of_string "Only POST is supported")

     

       468
       468
       +
               Cohttp_lwt_unix.Server.respond_string

     

       469
       469
       +
                 ~status:`Bad_request

     

       470
       470
       +
                 ~body:"{\"error\":\"Invalid JSON\"}"

     

       471
       471
       +
                 ~headers:(Cohttp.Header.init_with "Content-Type" "application/json")

     

       472
       472
       +
                 ()

     

       473
       473
       +
           | _ ->

     

       474
       474
       +
             (* Return 404 for any other routes *)

     

       475
       475
       +
             Cohttp_lwt_unix.Server.respond_string

     

       476
       476
       +
               ~status:`Not_found

     

       477
       477
       +
               ~body:"Not found"

     

       434
       478
        
               ()

     

       435
       435
       -
       

     

       436
       436
       -
       let log_warning ex = Logs.warn (fun f -> f "%a" Eio.Exn.pp ex)

     

       437
       437
       -
       

     

       438
       438
       -
       (** run the server using http transport *)

     

       439
       439
       -
       let run_server ?(port = 8080) ?(on_error = log_warning) env server =

     

       440
       440
       -
         let net = Eio.Stdenv.net env in

     

       441
       441
       -
         let addr = `Tcp (Eio.Net.Ipaddr.V4.loopback, port) in

     

       442
       442
       -
       

     

       443
       443
       -
         Log.debugf "Starting MCP server: %s v%s" (name server) (version server);

     

       444
       444
       -
         Log.debugf "Protocol version: %s" (protocol_version server);

     

       445
       445
       -
       

     

       446
       446
       -
         Eio.Switch.run @@ fun sw ->

     

       447
       447
       -
         let server_spec = Cohttp_eio.Server.make ~callback:(callback server) () in

     

       448
       448
       -
       

     

       449
       449
       -
         let server_socket =

     

       450
       450
       -
           Eio.Net.listen net ~sw ~backlog:128 ~reuse_addr:true addr

     

       479
       479
       +
         in

     

       480
       480
       +
         

     

       481
       481
       +
         (* Create and start the server *)

     

       482
       482
       +
         let server = Cohttp_lwt_unix.Server.create

     

       483
       483
       +
           ~mode:(`TCP (`Port port))

     

       484
       484
       +
           (Cohttp_lwt_unix.Server.make ~callback ())

     

       451
       485
        
         in

     

       452
       452
       -
         Log.infof "MCP HTTP Server listening on http://localhost:%d" port;

     

       486
       486
       +
         

     

       487
       487
       +
         (* Run the server *)

     

       488
       488
       +
         Lwt_main.run server

     

       489
       489
       +
         *)

     

       490
       490
       +
         

     

       491
       491
       +
         (* For now, just wait until the server is stopped *)

     

       492
       492
       +
         while mcp_server.running do

     

       493
       493
       +
           Unix.sleep 1

     

       494
       494
       +
         done

     

       453
       495
        
       

     

       454
       454
       -
         Cohttp_eio.Server.run server_socket server_spec ~on_error

     

       455
       455
       -
       

     

       456
       456
       -
       (** run the server using the stdio transport *)

     

       457
       457
       -
       let run_sdtio_server env server =

     

       458
       458
       -
         let stdin = Eio.Stdenv.stdin env in

     

       459
       459
       -
         let stdout = Eio.Stdenv.stdout env in

     

       460
       460
       -
       

     

       461
       461
       -
         Log.debugf "Starting MCP server: %s v%s" (name server) (version server);

     

       462
       462
       -
         Log.debugf "Protocol version: %s" (protocol_version server);

     

       463
       463
       -
       

     

       464
       464
       -
         (* Enable exception backtraces *)

     

       465
       465
       -
         Printexc.record_backtrace true;

     

       496
       496
       +
       (** Start the server based on transport type *)

     

       497
       497
       +
       let start server =

     

       498
       498
       +
         server.running <- true;

     

       499
       499
       +
         

     

       500
       500
       +
         (* Run startup hook if provided *)

     

       501
       501
       +
         (match server.server.startup_hook with

     

       502
       502
       +
         | Some hook -> begin hook () end

     

       503
       503
       +
         | None -> begin () end);

     

       466
       504
        
         

     

       467
       467
       -
         let buf = Eio.Buf_read.of_flow stdin ~initial_size:100 ~max_size:1_000_000 in

     

       505
       505
       +
         (* Install signal handler *)

     

       506
       506
       +
         Sys.(set_signal sigint (Signal_handle (fun _ -> 

     

       507
       507
       +
           Log.debug "Received interrupt signal, stopping server...";

     

       508
       508
       +
           server.running <- false

     

       509
       509
       +
         )));

     

       468
       510
        
         

     

       469
       469
       -
         (* Main processing loop *)

     

       470
       470
       -
         try

     

       471
       471
       -
           while true do

     

       472
       472
       -
             Log.debug "Waiting for message...";

     

       473
       473
       -
             let line = Eio.Buf_read.line buf in

     

       511
       511
       +
         match server.transport with

     

       512
       512
       +
         | Stdio -> begin

     

       513
       513
       +
             (* Setup stdout and stderr *)

     

       514
       514
       +
             set_binary_mode_out stdout false;

     

       515
       515
       +
             Log.info (Printf.sprintf "%s server started with stdio transport" server.server.name);

     

       474
       516
        
             

     

       475
       475
       -
             (* Process the input and send response if needed *)

     

       476
       476
       -
             match process_input_line server line with

     

       477
       477
       -
             | Some response -> send_response stdout response

     

       478
       478
       -
             | None -> Log.debug "No response needed for this message"

     

       479
       479
       -
           done

     

       480
       480
       -
         with

     

       481
       481
       -
         | End_of_file -> 

     

       482
       482
       -
             Log.debug "End of file received on stdin";

     

       483
       483
       -
             ()

     

       484
       484
       -
         | Eio.Exn.Io _ as exn ->

     

       485
       485
       -
             Log.errorf "I/O error while reading: %s" (Printexc.to_string exn);

     

       486
       486
       -
             ()

     

       487
       487
       -
         | exn ->

     

       488
       488
       -
             Log.errorf "Exception while reading: %s" (Printexc.to_string exn);

     

       489
       489
       -
             ()

     

       517
       517
       +
             (* Run the server loop *)

     

       518
       518
       +
             run_stdio_server server

     

       519
       519
       +
           end

     

       520
       520
       +
         | Http -> begin

     

       521
       521
       +
             (* HTTP server placeholder *)

     

       522
       522
       +
             run_http_server server 8080

     

       523
       523
       +
           end

     

       524
       524
       +
       

     

       525
       525
       +
       (** Stop the server *)

     

       526
       526
       +
       let stop server =

     

       527
       527
       +
         Log.info "Stopping server...";

     

       528
       528
       +
         server.running <- false;

     

       529
       529
       +
         

     

       530
       530
       +
         (* Run shutdown hook if provided *)

     

       531
       531
       +
         match server.server.shutdown_hook with

     

       532
       532
       +
         | Some hook -> begin hook () end

     

       533
       533
       +
         | None -> begin () end

+54

lib/mcp_server.mli

···

       1
       1
       +
       (** MCP Server module - full implementation *)

     

       2
       2
       +
       

     

       3
       3
       +
       (** Transport type for server *)

     

       4
       4
       +
       type transport_type = 

     

       5
       5
       +
         | Stdio  (** Read/write to stdin/stdout *)

     

       6
       6
       +
         | Http   (** HTTP server - to be implemented *)

     

       7
       7
       +
       

     

       8
       8
       +
       (** Server type *)

     

       9
       9
       +
       type t = {

     

       10
       10
       +
         server: Mcp_sdk.server;

     

       11
       11
       +
         transport: transport_type;

     

       12
       12
       +
         mutable running: bool;

     

       13
       13
       +
       }

     

       14
       14
       +
       

     

       15
       15
       +
       (** Create an MCP server 

     

       16
       16
       +
           @param server The Mcp_sdk server to use

     

       17
       17
       +
           @param transport The transport type to use

     

       18
       18
       +
       *)

     

       19
       19
       +
       val create : server:Mcp_sdk.server -> transport:transport_type -> unit -> t

     

       20
       20
       +
       

     

       21
       21
       +
       (** Start the server

     

       22
       22
       +
           This function will block until the server is stopped.

     

       23
       23
       +
           @param server The server to start

     

       24
       24
       +
       *)

     

       25
       25
       +
       val start : t -> unit

     

       26
       26
       +
       

     

       27
       27
       +
       (** Stop the server

     

       28
       28
       +
           This will set the running flag to false and invoke the shutdown hook.

     

       29
       29
       +
           @param server The server to stop

     

       30
       30
       +
       *)

     

       31
       31
       +
       val stop : t -> unit

     

       32
       32
       +
       

     

       33
       33
       +
       (** Process a single message 

     

       34
       34
       +
           @param server The Mcp_sdk server to use

     

       35
       35
       +
           @param message The JSON message to process

     

       36
       36
       +
           @return An optional response message

     

       37
       37
       +
       *)

     

       38
       38
       +
       val process_message : Mcp_sdk.server -> Yojson.Safe.t -> Mcp.JSONRPCMessage.t option

     

       39
       39
       +
       

     

       40
       40
       +
       (** Run stdio server implementation 

     

       41
       41
       +
           @param mcp_server The mcp_server to run

     

       42
       42
       +
       *)

     

       43
       43
       +
       val run_stdio_server : t -> unit

     

       44
       44
       +
       

     

       45
       45
       +
       (** Read a message from stdio

     

       46
       46
       +
           @return An optional JSON message

     

       47
       47
       +
       *)

     

       48
       48
       +
       val read_stdio_message : unit -> Yojson.Safe.t option

     

       49
       49
       +
       

     

       50
       50
       +
       (** Run HTTP server implementation (placeholder)

     

       51
       51
       +
           @param mcp_server The mcp_server to run

     

       52
       52
       +
           @param port The port to listen on

     

       53
       53
       +
       *)

     

       54
       54
       +
       val run_http_server : t -> int -> unit

-32

mcp.opam

···

       1
       1
       -
       # This file is generated by dune, edit dune-project instead

     

       2
       2
       -
       opam-version: "2.0"

     

       3
       3
       -
       synopsis: "Model Context Protocol for LLMs"

     

       4
       4
       -
       description: "This is all still a work in progress"

     

       5
       5
       -
       maintainer: ["anil@recoil.org"]

     

       6
       6
       -
       authors: ["Anil Madhavapeddy"]

     

       7
       7
       -
       license: "ISC"

     

       8
       8
       -
       depends: [

     

       9
       9
       -
         "dune" {>= "3.17"}

     

       10
       10
       -
         "ocaml" {>= "5.2.0"}

     

       11
       11
       -
         "jsonrpc"

     

       12
       12
       -
         "yojson" {< "3.0.0"}

     

       13
       13
       -
         "http"

     

       14
       14
       -
         "cohttp-eio"

     

       15
       15
       -
         "eio_main"

     

       16
       16
       -
         "eio"

     

       17
       17
       -
         "odoc" {with-doc}

     

       18
       18
       -
       ]

     

       19
       19
       -
       build: [

     

       20
       20
       -
         ["dune" "subst"] {dev}

     

       21
       21
       -
         [

     

       22
       22
       -
           "dune"

     

       23
       23
       -
           "build"

     

       24
       24
       -
           "-p"

     

       25
       25
       -
           name

     

       26
       26
       -
           "-j"

     

       27
       27
       -
           jobs

     

       28
       28
       -
           "@install"

     

       29
       29
       -
           "@runtest" {with-test}

     

       30
       30
       -
           "@doc" {with-doc}

     

       31
       31
       -
         ]

     

       32
       32
       -
       ]

+178

spec/00-arch.md

···

       1
       1
       +
       ---

     

       2
       2
       +
       title: Architecture

     

       3
       3
       +
       cascade:

     

       4
       4
       +
         type: docs

     

       5
       5
       +
       weight: 10

     

       6
       6
       +
       ---

     

       7
       7
       +
       

     

       8
       8
       +
       The Model Context Protocol (MCP) follows a client-host-server architecture where each

     

       9
       9
       +
       host can run multiple client instances. This architecture enables users to integrate AI

     

       10
       10
       +
       capabilities across applications while maintaining clear security boundaries and

     

       11
       11
       +
       isolating concerns. Built on JSON-RPC, MCP provides a stateful session protocol focused

     

       12
       12
       +
       on context exchange and sampling coordination between clients and servers.

     

       13
       13
       +
       

     

       14
       14
       +
       ## Core Components

     

       15
       15
       +
       

     

       16
       16
       +
       ```mermaid

     

       17
       17
       +
       graph LR

     

       18
       18
       +
           subgraph "Application Host Process"

     

       19
       19
       +
               H[Host]

     

       20
       20
       +
               C1[Client 1]

     

       21
       21
       +
               C2[Client 2]

     

       22
       22
       +
               C3[Client 3]

     

       23
       23
       +
               H --> C1

     

       24
       24
       +
               H --> C2

     

       25
       25
       +
               H --> C3

     

       26
       26
       +
           end

     

       27
       27
       +
       

     

       28
       28
       +
           subgraph "Local machine"

     

       29
       29
       +
               S1[Server 1<br>Files & Git]

     

       30
       30
       +
               S2[Server 2<br>Database]

     

       31
       31
       +
               R1[("Local<br>Resource A")]

     

       32
       32
       +
               R2[("Local<br>Resource B")]

     

       33
       33
       +
       

     

       34
       34
       +
               C1 --> S1

     

       35
       35
       +
               C2 --> S2

     

       36
       36
       +
               S1 <--> R1

     

       37
       37
       +
               S2 <--> R2

     

       38
       38
       +
           end

     

       39
       39
       +
       

     

       40
       40
       +
           subgraph "Internet"

     

       41
       41
       +
               S3[Server 3<br>External APIs]

     

       42
       42
       +
               R3[("Remote<br>Resource C")]

     

       43
       43
       +
       

     

       44
       44
       +
               C3 --> S3

     

       45
       45
       +
               S3 <--> R3

     

       46
       46
       +
           end

     

       47
       47
       +
       ```

     

       48
       48
       +
       

     

       49
       49
       +
       ### Host

     

       50
       50
       +
       

     

       51
       51
       +
       The host process acts as the container and coordinator:

     

       52
       52
       +
       

     

       53
       53
       +
       - Creates and manages multiple client instances

     

       54
       54
       +
       - Controls client connection permissions and lifecycle

     

       55
       55
       +
       - Enforces security policies and consent requirements

     

       56
       56
       +
       - Handles user authorization decisions

     

       57
       57
       +
       - Coordinates AI/LLM integration and sampling

     

       58
       58
       +
       - Manages context aggregation across clients

     

       59
       59
       +
       

     

       60
       60
       +
       ### Clients

     

       61
       61
       +
       

     

       62
       62
       +
       Each client is created by the host and maintains an isolated server connection:

     

       63
       63
       +
       

     

       64
       64
       +
       - Establishes one stateful session per server

     

       65
       65
       +
       - Handles protocol negotiation and capability exchange

     

       66
       66
       +
       - Routes protocol messages bidirectionally

     

       67
       67
       +
       - Manages subscriptions and notifications

     

       68
       68
       +
       - Maintains security boundaries between servers

     

       69
       69
       +
       

     

       70
       70
       +
       A host application creates and manages multiple clients, with each client having a 1:1

     

       71
       71
       +
       relationship with a particular server.

     

       72
       72
       +
       

     

       73
       73
       +
       ### Servers

     

       74
       74
       +
       

     

       75
       75
       +
       Servers provide specialized context and capabilities:

     

       76
       76
       +
       

     

       77
       77
       +
       - Expose resources, tools and prompts via MCP primitives

     

       78
       78
       +
       - Operate independently with focused responsibilities

     

       79
       79
       +
       - Request sampling through client interfaces

     

       80
       80
       +
       - Must respect security constraints

     

       81
       81
       +
       - Can be local processes or remote services

     

       82
       82
       +
       

     

       83
       83
       +
       ## Design Principles

     

       84
       84
       +
       

     

       85
       85
       +
       MCP is built on several key design principles that inform its architecture and

     

       86
       86
       +
       implementation:

     

       87
       87
       +
       

     

       88
       88
       +
       1. **Servers should be extremely easy to build**

     

       89
       89
       +
       

     

       90
       90
       +
          - Host applications handle complex orchestration responsibilities

     

       91
       91
       +
          - Servers focus on specific, well-defined capabilities

     

       92
       92
       +
          - Simple interfaces minimize implementation overhead

     

       93
       93
       +
          - Clear separation enables maintainable code

     

       94
       94
       +
       

     

       95
       95
       +
       2. **Servers should be highly composable**

     

       96
       96
       +
       

     

       97
       97
       +
          - Each server provides focused functionality in isolation

     

       98
       98
       +
          - Multiple servers can be combined seamlessly

     

       99
       99
       +
          - Shared protocol enables interoperability

     

       100
       100
       +
          - Modular design supports extensibility

     

       101
       101
       +
       

     

       102
       102
       +
       3. **Servers should not be able to read the whole conversation, nor "see into" other

     

       103
       103
       +
          servers**

     

       104
       104
       +
       

     

       105
       105
       +
          - Servers receive only necessary contextual information

     

       106
       106
       +
          - Full conversation history stays with the host

     

       107
       107
       +
          - Each server connection maintains isolation

     

       108
       108
       +
          - Cross-server interactions are controlled by the host

     

       109
       109
       +
          - Host process enforces security boundaries

     

       110
       110
       +
       

     

       111
       111
       +
       4. **Features can be added to servers and clients progressively**

     

       112
       112
       +
          - Core protocol provides minimal required functionality

     

       113
       113
       +
          - Additional capabilities can be negotiated as needed

     

       114
       114
       +
          - Servers and clients evolve independently

     

       115
       115
       +
          - Protocol designed for future extensibility

     

       116
       116
       +
          - Backwards compatibility is maintained

     

       117
       117
       +
       

     

       118
       118
       +
       ## Capability Negotiation

     

       119
       119
       +
       

     

       120
       120
       +
       The Model Context Protocol uses a capability-based negotiation system where clients and

     

       121
       121
       +
       servers explicitly declare their supported features during initialization. Capabilities

     

       122
       122
       +
       determine which protocol features and primitives are available during a session.

     

       123
       123
       +
       

     

       124
       124
       +
       - Servers declare capabilities like resource subscriptions, tool support, and prompt

     

       125
       125
       +
         templates

     

       126
       126
       +
       - Clients declare capabilities like sampling support and notification handling

     

       127
       127
       +
       - Both parties must respect declared capabilities throughout the session

     

       128
       128
       +
       - Additional capabilities can be negotiated through extensions to the protocol

     

       129
       129
       +
       

     

       130
       130
       +
       ```mermaid

     

       131
       131
       +
       sequenceDiagram

     

       132
       132
       +
           participant Host

     

       133
       133
       +
           participant Client

     

       134
       134
       +
           participant Server

     

       135
       135
       +
       

     

       136
       136
       +
           Host->>+Client: Initialize client

     

       137
       137
       +
           Client->>+Server: Initialize session with capabilities

     

       138
       138
       +
           Server-->>Client: Respond with supported capabilities

     

       139
       139
       +
       

     

       140
       140
       +
           Note over Host,Server: Active Session with Negotiated Features

     

       141
       141
       +
       

     

       142
       142
       +
           loop Client Requests

     

       143
       143
       +
               Host->>Client: User- or model-initiated action

     

       144
       144
       +
               Client->>Server: Request (tools/resources)

     

       145
       145
       +
               Server-->>Client: Response

     

       146
       146
       +
               Client-->>Host: Update UI or respond to model

     

       147
       147
       +
           end

     

       148
       148
       +
       

     

       149
       149
       +
           loop Server Requests

     

       150
       150
       +
               Server->>Client: Request (sampling)

     

       151
       151
       +
               Client->>Host: Forward to AI

     

       152
       152
       +
               Host-->>Client: AI response

     

       153
       153
       +
               Client-->>Server: Response

     

       154
       154
       +
           end

     

       155
       155
       +
       

     

       156
       156
       +
           loop Notifications

     

       157
       157
       +
               Server--)Client: Resource updates

     

       158
       158
       +
               Client--)Server: Status changes

     

       159
       159
       +
           end

     

       160
       160
       +
       

     

       161
       161
       +
           Host->>Client: Terminate

     

       162
       162
       +
           Client->>-Server: End session

     

       163
       163
       +
           deactivate Server

     

       164
       164
       +
       ```

     

       165
       165
       +
       

     

       166
       166
       +
       Each capability unlocks specific protocol features for use during the session. For

     

       167
       167
       +
       example:

     

       168
       168
       +
       

     

       169
       169
       +
       - Implemented [server features]({{< ref "../server" >}}) must be advertised in the

     

       170
       170
       +
         server's capabilities

     

       171
       171
       +
       - Emitting resource subscription notifications requires the server to declare

     

       172
       172
       +
         subscription support

     

       173
       173
       +
       - Tool invocation requires the server to declare tool capabilities

     

       174
       174
       +
       - [Sampling]({{< ref "../client" >}}) requires the client to declare support in its

     

       175
       175
       +
         capabilities

     

       176
       176
       +
       

     

       177
       177
       +
       This capability negotiation ensures clients and servers have a clear understanding of

     

       178
       178
       +
       supported functionality while maintaining protocol extensibility.

spec/README.md

···

       1
       1
       +
       These specifications are snapshots from

     

       2
       2
       +
       https://github.com/modelcontextprotocol/specification/tree/main/docs/specification/2025-03-26

     

       3
       3
       +
       

     

       4
       4
       +
       to help with the agentic prompting.

+386

spec/authorization.md

···

       1
       1
       +
       ---

     

       2
       2
       +
       title: Authorization

     

       3
       3
       +
       type: docs

     

       4
       4
       +
       weight: 15

     

       5
       5
       +
       ---

     

       6
       6
       +
       

     

       7
       7
       +
       {{< callout type="info" >}} **Protocol Revision**: 2025-03-26 {{< /callout >}}

     

       8
       8
       +
       

     

       9
       9
       +
       ## 1. Introduction

     

       10
       10
       +
       

     

       11
       11
       +
       ### 1.1 Purpose and Scope

     

       12
       12
       +
       

     

       13
       13
       +
       The Model Context Protocol provides authorization capabilities at the transport level,

     

       14
       14
       +
       enabling MCP clients to make requests to restricted MCP servers on behalf of resource

     

       15
       15
       +
       owners. This specification defines the authorization flow for HTTP-based transports.

     

       16
       16
       +
       

     

       17
       17
       +
       ### 1.2 Protocol Requirements

     

       18
       18
       +
       

     

       19
       19
       +
       Authorization is **OPTIONAL** for MCP implementations. When supported:

     

       20
       20
       +
       

     

       21
       21
       +
       - Implementations using an HTTP-based transport **SHOULD** conform to this specification.

     

       22
       22
       +
       - Implementations using an STDIO transport **SHOULD NOT** follow this specification, and

     

       23
       23
       +
         instead retrieve credentials from the environment.

     

       24
       24
       +
       - Implementations using alternative transports **MUST** follow established security best

     

       25
       25
       +
         practices for their protocol.

     

       26
       26
       +
       

     

       27
       27
       +
       ### 1.3 Standards Compliance

     

       28
       28
       +
       

     

       29
       29
       +
       This authorization mechanism is based on established specifications listed below, but

     

       30
       30
       +
       implements a selected subset of their features to ensure security and interoperability

     

       31
       31
       +
       while maintaining simplicity:

     

       32
       32
       +
       

     

       33
       33
       +
       - [OAuth 2.1 IETF DRAFT](https://datatracker.ietf.org/doc/html/draft-ietf-oauth-v2-1-12)

     

       34
       34
       +
       - OAuth 2.0 Authorization Server Metadata

     

       35
       35
       +
         ([RFC8414](https://datatracker.ietf.org/doc/html/rfc8414))

     

       36
       36
       +
       - OAuth 2.0 Dynamic Client Registration Protocol

     

       37
       37
       +
         ([RFC7591](https://datatracker.ietf.org/doc/html/rfc7591))

     

       38
       38
       +
       

     

       39
       39
       +
       ## 2. Authorization Flow

     

       40
       40
       +
       

     

       41
       41
       +
       ### 2.1 Overview

     

       42
       42
       +
       

     

       43
       43
       +
       1. MCP auth implementations **MUST** implement OAuth 2.1 with appropriate security

     

       44
       44
       +
          measures for both confidential and public clients.

     

       45
       45
       +
       

     

       46
       46
       +
       2. MCP auth implementations **SHOULD** support the OAuth 2.0 Dynamic Client Registration

     

       47
       47
       +
          Protocol ([RFC7591](https://datatracker.ietf.org/doc/html/rfc7591)).

     

       48
       48
       +
       

     

       49
       49
       +
       3. MCP servers **SHOULD** and MCP clients **MUST** implement OAuth 2.0 Authorization

     

       50
       50
       +
          Server Metadata ([RFC8414](https://datatracker.ietf.org/doc/html/rfc8414)). Servers

     

       51
       51
       +
          that do not support Authorization Server Metadata **MUST** follow the default URI

     

       52
       52
       +
          schema.

     

       53
       53
       +
       

     

       54
       54
       +
       ### 2.2 Basic OAuth 2.1 Authorization

     

       55
       55
       +
       

     

       56
       56
       +
       When authorization is required and not yet proven by the client, servers **MUST** respond

     

       57
       57
       +
       with _HTTP 401 Unauthorized_.

     

       58
       58
       +
       

     

       59
       59
       +
       Clients initiate the

     

       60
       60
       +
       [OAuth 2.1 IETF DRAFT](https://datatracker.ietf.org/doc/html/draft-ietf-oauth-v2-1-12)

     

       61
       61
       +
       authorization flow after receiving the _HTTP 401 Unauthorized_.

     

       62
       62
       +
       

     

       63
       63
       +
       The following demonstrates the basic OAuth 2.1 for public clients using PKCE.

     

       64
       64
       +
       

     

       65
       65
       +
       ```mermaid

     

       66
       66
       +
       sequenceDiagram

     

       67
       67
       +
           participant B as User-Agent (Browser)

     

       68
       68
       +
           participant C as Client

     

       69
       69
       +
           participant M as MCP Server

     

       70
       70
       +
       

     

       71
       71
       +
           C->>M: MCP Request

     

       72
       72
       +
           M->>C: HTTP 401 Unauthorized

     

       73
       73
       +
           Note over C: Generate code_verifier and code_challenge

     

       74
       74
       +
           C->>B: Open browser with authorization URL + code_challenge

     

       75
       75
       +
           B->>M: GET /authorize

     

       76
       76
       +
           Note over M: User logs in and authorizes

     

       77
       77
       +
           M->>B: Redirect to callback URL with auth code

     

       78
       78
       +
           B->>C: Callback with authorization code

     

       79
       79
       +
           C->>M: Token Request with code + code_verifier

     

       80
       80
       +
           M->>C: Access Token (+ Refresh Token)

     

       81
       81
       +
           C->>M: MCP Request with Access Token

     

       82
       82
       +
           Note over C,M: Begin standard MCP message exchange

     

       83
       83
       +
       ```

     

       84
       84
       +
       

     

       85
       85
       +
       ### 2.3 Server Metadata Discovery

     

       86
       86
       +
       

     

       87
       87
       +
       For server capability discovery:

     

       88
       88
       +
       

     

       89
       89
       +
       - MCP clients _MUST_ follow the OAuth 2.0 Authorization Server Metadata protocol defined

     

       90
       90
       +
         in [RFC8414](https://datatracker.ietf.org/doc/html/rfc8414).

     

       91
       91
       +
       - MCP server _SHOULD_ follow the OAuth 2.0 Authorization Server Metadata protocol.

     

       92
       92
       +
       - MCP servers that do not support the OAuth 2.0 Authorization Server Metadata protocol,

     

       93
       93
       +
         _MUST_ support fallback URLs.

     

       94
       94
       +
       

     

       95
       95
       +
       The discovery flow is illustrated below:

     

       96
       96
       +
       

     

       97
       97
       +
       ```mermaid

     

       98
       98
       +
       sequenceDiagram

     

       99
       99
       +
           participant C as Client

     

       100
       100
       +
           participant S as Server

     

       101
       101
       +
       

     

       102
       102
       +
           C->>S: GET /.well-known/oauth-authorization-server

     

       103
       103
       +
           alt Discovery Success

     

       104
       104
       +
               S->>C: 200 OK + Metadata Document

     

       105
       105
       +
               Note over C: Use endpoints from metadata

     

       106
       106
       +
           else Discovery Failed

     

       107
       107
       +
               S->>C: 404 Not Found

     

       108
       108
       +
               Note over C: Fall back to default endpoints

     

       109
       109
       +
           end

     

       110
       110
       +
           Note over C: Continue with authorization flow

     

       111
       111
       +
       ```

     

       112
       112
       +
       

     

       113
       113
       +
       #### 2.3.1 Server Metadata Discovery Headers

     

       114
       114
       +
       

     

       115
       115
       +
       MCP clients _SHOULD_ include the header `MCP-Protocol-Version: <protocol-version>` during

     

       116
       116
       +
       Server Metadata Discovery to allow the MCP server to respond based on the MCP protocol

     

       117
       117
       +
       version.

     

       118
       118
       +
       

     

       119
       119
       +
       For example: `MCP-Protocol-Version: 2024-11-05`

     

       120
       120
       +
       

     

       121
       121
       +
       #### 2.3.2 Authorization Base URL

     

       122
       122
       +
       

     

       123
       123
       +
       The authorization base URL **MUST** be determined from the MCP server URL by discarding

     

       124
       124
       +
       any existing `path` component. For example:

     

       125
       125
       +
       

     

       126
       126
       +
       If the MCP server URL is `https://api.example.com/v1/mcp`, then:

     

       127
       127
       +
       

     

       128
       128
       +
       - The authorization base URL is `https://api.example.com`

     

       129
       129
       +
       - The metadata endpoint **MUST** be at

     

       130
       130
       +
         `https://api.example.com/.well-known/oauth-authorization-server`

     

       131
       131
       +
       

     

       132
       132
       +
       This ensures authorization endpoints are consistently located at the root level of the

     

       133
       133
       +
       domain hosting the MCP server, regardless of any path components in the MCP server URL.

     

       134
       134
       +
       

     

       135
       135
       +
       #### 2.3.3 Fallbacks for Servers without Metadata Discovery

     

       136
       136
       +
       

     

       137
       137
       +
       For servers that do not implement OAuth 2.0 Authorization Server Metadata, clients

     

       138
       138
       +
       **MUST** use the following default endpoint paths relative to the authorization base URL

     

       139
       139
       +
       (as defined in [Section 2.3.2](#232-authorization-base-url)):

     

       140
       140
       +
       

     

       141
       141
       +
       | Endpoint               | Default Path | Description                          |

     

       142
       142
       +
       | ---------------------- | ------------ | ------------------------------------ |

     

       143
       143
       +
       | Authorization Endpoint | /authorize   | Used for authorization requests      |

     

       144
       144
       +
       | Token Endpoint         | /token       | Used for token exchange & refresh    |

     

       145
       145
       +
       | Registration Endpoint  | /register    | Used for dynamic client registration |

     

       146
       146
       +
       

     

       147
       147
       +
       For example, with an MCP server hosted at `https://api.example.com/v1/mcp`, the default

     

       148
       148
       +
       endpoints would be:

     

       149
       149
       +
       

     

       150
       150
       +
       - `https://api.example.com/authorize`

     

       151
       151
       +
       - `https://api.example.com/token`

     

       152
       152
       +
       - `https://api.example.com/register`

     

       153
       153
       +
       

     

       154
       154
       +
       Clients **MUST** first attempt to discover endpoints via the metadata document before

     

       155
       155
       +
       falling back to default paths. When using default paths, all other protocol requirements

     

       156
       156
       +
       remain unchanged.

     

       157
       157
       +
       

     

       158
       158
       +
       ### 2.3 Dynamic Client Registration

     

       159
       159
       +
       

     

       160
       160
       +
       MCP clients and servers **SHOULD** support the

     

       161
       161
       +
       [OAuth 2.0 Dynamic Client Registration Protocol](https://datatracker.ietf.org/doc/html/rfc7591)

     

       162
       162
       +
       to allow MCP clients to obtain OAuth client IDs without user interaction. This provides a

     

       163
       163
       +
       standardized way for clients to automatically register with new servers, which is crucial

     

       164
       164
       +
       for MCP because:

     

       165
       165
       +
       

     

       166
       166
       +
       - Clients cannot know all possible servers in advance

     

       167
       167
       +
       - Manual registration would create friction for users

     

       168
       168
       +
       - It enables seamless connection to new servers

     

       169
       169
       +
       - Servers can implement their own registration policies

     

       170
       170
       +
       

     

       171
       171
       +
       Any MCP servers that _do not_ support Dynamic Client Registration need to provide

     

       172
       172
       +
       alternative ways to obtain a client ID (and, if applicable, client secret). For one of

     

       173
       173
       +
       these servers, MCP clients will have to either:

     

       174
       174
       +
       

     

       175
       175
       +
       1. Hardcode a client ID (and, if applicable, client secret) specifically for that MCP

     

       176
       176
       +
          server, or

     

       177
       177
       +
       2. Present a UI to users that allows them to enter these details, after registering an

     

       178
       178
       +
          OAuth client themselves (e.g., through a configuration interface hosted by the

     

       179
       179
       +
          server).

     

       180
       180
       +
       

     

       181
       181
       +
       ### 2.4 Authorization Flow Steps

     

       182
       182
       +
       

     

       183
       183
       +
       The complete Authorization flow proceeds as follows:

     

       184
       184
       +
       

     

       185
       185
       +
       ```mermaid

     

       186
       186
       +
       sequenceDiagram

     

       187
       187
       +
           participant B as User-Agent (Browser)

     

       188
       188
       +
           participant C as Client

     

       189
       189
       +
           participant M as MCP Server

     

       190
       190
       +
       

     

       191
       191
       +
           C->>M: GET /.well-known/oauth-authorization-server

     

       192
       192
       +
           alt Server Supports Discovery

     

       193
       193
       +
               M->>C: Authorization Server Metadata

     

       194
       194
       +
           else No Discovery

     

       195
       195
       +
               M->>C: 404 (Use default endpoints)

     

       196
       196
       +
           end

     

       197
       197
       +
       

     

       198
       198
       +
           alt Dynamic Client Registration

     

       199
       199
       +
               C->>M: POST /register

     

       200
       200
       +
               M->>C: Client Credentials

     

       201
       201
       +
           end

     

       202
       202
       +
       

     

       203
       203
       +
           Note over C: Generate PKCE Parameters

     

       204
       204
       +
           C->>B: Open browser with authorization URL + code_challenge

     

       205
       205
       +
           B->>M: Authorization Request

     

       206
       206
       +
           Note over M: User /authorizes

     

       207
       207
       +
           M->>B: Redirect to callback with authorization code

     

       208
       208
       +
           B->>C: Authorization code callback

     

       209
       209
       +
           C->>M: Token Request + code_verifier

     

       210
       210
       +
           M->>C: Access Token (+ Refresh Token)

     

       211
       211
       +
           C->>M: API Requests with Access Token

     

       212
       212
       +
       ```

     

       213
       213
       +
       

     

       214
       214
       +
       #### 2.4.1 Decision Flow Overview

     

       215
       215
       +
       

     

       216
       216
       +
       ```mermaid

     

       217
       217
       +
       flowchart TD

     

       218
       218
       +
           A[Start Auth Flow] --> B{Check Metadata Discovery}

     

       219
       219
       +
           B -->|Available| C[Use Metadata Endpoints]

     

       220
       220
       +
           B -->|Not Available| D[Use Default Endpoints]

     

       221
       221
       +
       

     

       222
       222
       +
           C --> G{Check Registration Endpoint}

     

       223
       223
       +
           D --> G

     

       224
       224
       +
       

     

       225
       225
       +
           G -->|Available| H[Perform Dynamic Registration]

     

       226
       226
       +
           G -->|Not Available| I[Alternative Registration Required]

     

       227
       227
       +
       

     

       228
       228
       +
           H --> J[Start OAuth Flow]

     

       229
       229
       +
           I --> J

     

       230
       230
       +
       

     

       231
       231
       +
           J --> K[Generate PKCE Parameters]

     

       232
       232
       +
           K --> L[Request Authorization]

     

       233
       233
       +
           L --> M[User Authorization]

     

       234
       234
       +
           M --> N[Exchange Code for Tokens]

     

       235
       235
       +
           N --> O[Use Access Token]

     

       236
       236
       +
       ```

     

       237
       237
       +
       

     

       238
       238
       +
       ### 2.5 Access Token Usage

     

       239
       239
       +
       

     

       240
       240
       +
       #### 2.5.1 Token Requirements

     

       241
       241
       +
       

     

       242
       242
       +
       Access token handling **MUST** conform to

     

       243
       243
       +
       [OAuth 2.1 Section 5](https://datatracker.ietf.org/doc/html/draft-ietf-oauth-v2-1-12#section-5)

     

       244
       244
       +
       requirements for resource requests. Specifically:

     

       245
       245
       +
       

     

       246
       246
       +
       1. MCP client **MUST** use the Authorization request header field

     

       247
       247
       +
          [Section 5.1.1](https://datatracker.ietf.org/doc/html/draft-ietf-oauth-v2-1-12#section-5.1.1):

     

       248
       248
       +
       

     

       249
       249
       +
       ```

     

       250
       250
       +
       Authorization: Bearer <access-token>

     

       251
       251
       +
       ```

     

       252
       252
       +
       

     

       253
       253
       +
       Note that authorization **MUST** be included in every HTTP request from client to server,

     

       254
       254
       +
       even if they are part of the same logical session.

     

       255
       255
       +
       

     

       256
       256
       +
       2. Access tokens **MUST NOT** be included in the URI query string

     

       257
       257
       +
       

     

       258
       258
       +
       Example request:

     

       259
       259
       +
       

     

       260
       260
       +
       ```http

     

       261
       261
       +
       GET /v1/contexts HTTP/1.1

     

       262
       262
       +
       Host: mcp.example.com

     

       263
       263
       +
       Authorization: Bearer eyJhbGciOiJIUzI1NiIs...

     

       264
       264
       +
       ```

     

       265
       265
       +
       

     

       266
       266
       +
       #### 2.5.2 Token Handling

     

       267
       267
       +
       

     

       268
       268
       +
       Resource servers **MUST** validate access tokens as described in

     

       269
       269
       +
       [Section 5.2](https://datatracker.ietf.org/doc/html/draft-ietf-oauth-v2-1-12#section-5.2).

     

       270
       270
       +
       If validation fails, servers **MUST** respond according to

     

       271
       271
       +
       [Section 5.3](https://datatracker.ietf.org/doc/html/draft-ietf-oauth-v2-1-12#section-5.3)

     

       272
       272
       +
       error handling requirements. Invalid or expired tokens **MUST** receive a HTTP 401

     

       273
       273
       +
       response.

     

       274
       274
       +
       

     

       275
       275
       +
       ### 2.6 Security Considerations

     

       276
       276
       +
       

     

       277
       277
       +
       The following security requirements **MUST** be implemented:

     

       278
       278
       +
       

     

       279
       279
       +
       1. Clients **MUST** securely store tokens following OAuth 2.0 best practices

     

       280
       280
       +
       2. Servers **SHOULD** enforce token expiration and rotation

     

       281
       281
       +
       3. All authorization endpoints **MUST** be served over HTTPS

     

       282
       282
       +
       4. Servers **MUST** validate redirect URIs to prevent open redirect vulnerabilities

     

       283
       283
       +
       5. Redirect URIs **MUST** be either localhost URLs or HTTPS URLs

     

       284
       284
       +
       

     

       285
       285
       +
       ### 2.7 Error Handling

     

       286
       286
       +
       

     

       287
       287
       +
       Servers **MUST** return appropriate HTTP status codes for authorization errors:

     

       288
       288
       +
       

     

       289
       289
       +
       | Status Code | Description  | Usage                                      |

     

       290
       290
       +
       | ----------- | ------------ | ------------------------------------------ |

     

       291
       291
       +
       | 401         | Unauthorized | Authorization required or token invalid    |

     

       292
       292
       +
       | 403         | Forbidden    | Invalid scopes or insufficient permissions |

     

       293
       293
       +
       | 400         | Bad Request  | Malformed authorization request            |

     

       294
       294
       +
       

     

       295
       295
       +
       ### 2.8 Implementation Requirements

     

       296
       296
       +
       

     

       297
       297
       +
       1. Implementations **MUST** follow OAuth 2.1 security best practices

     

       298
       298
       +
       2. PKCE is **REQUIRED** for all clients

     

       299
       299
       +
       3. Token rotation **SHOULD** be implemented for enhanced security

     

       300
       300
       +
       4. Token lifetimes **SHOULD** be limited based on security requirements

     

       301
       301
       +
       

     

       302
       302
       +
       ### 2.9 Third-Party Authorization Flow

     

       303
       303
       +
       

     

       304
       304
       +
       #### 2.9.1 Overview

     

       305
       305
       +
       

     

       306
       306
       +
       MCP servers **MAY** support delegated authorization through third-party authorization

     

       307
       307
       +
       servers. In this flow, the MCP server acts as both an OAuth client (to the third-party

     

       308
       308
       +
       auth server) and an OAuth authorization server (to the MCP client).

     

       309
       309
       +
       

     

       310
       310
       +
       #### 2.9.2 Flow Description

     

       311
       311
       +
       

     

       312
       312
       +
       The third-party authorization flow comprises these steps:

     

       313
       313
       +
       

     

       314
       314
       +
       1. MCP client initiates standard OAuth flow with MCP server

     

       315
       315
       +
       2. MCP server redirects user to third-party authorization server

     

       316
       316
       +
       3. User authorizes with third-party server

     

       317
       317
       +
       4. Third-party server redirects back to MCP server with authorization code

     

       318
       318
       +
       5. MCP server exchanges code for third-party access token

     

       319
       319
       +
       6. MCP server generates its own access token bound to the third-party session

     

       320
       320
       +
       7. MCP server completes original OAuth flow with MCP client

     

       321
       321
       +
       

     

       322
       322
       +
       ```mermaid

     

       323
       323
       +
       sequenceDiagram

     

       324
       324
       +
           participant B as User-Agent (Browser)

     

       325
       325
       +
           participant C as MCP Client

     

       326
       326
       +
           participant M as MCP Server

     

       327
       327
       +
           participant T as Third-Party Auth Server

     

       328
       328
       +
       

     

       329
       329
       +
           C->>M: Initial OAuth Request

     

       330
       330
       +
           M->>B: Redirect to Third-Party /authorize

     

       331
       331
       +
           B->>T: Authorization Request

     

       332
       332
       +
           Note over T: User authorizes

     

       333
       333
       +
           T->>B: Redirect to MCP Server callback

     

       334
       334
       +
           B->>M: Authorization code

     

       335
       335
       +
           M->>T: Exchange code for token

     

       336
       336
       +
           T->>M: Third-party access token

     

       337
       337
       +
           Note over M: Generate bound MCP token

     

       338
       338
       +
           M->>B: Redirect to MCP Client callback

     

       339
       339
       +
           B->>C: MCP authorization code

     

       340
       340
       +
           C->>M: Exchange code for token

     

       341
       341
       +
           M->>C: MCP access token

     

       342
       342
       +
       ```

     

       343
       343
       +
       

     

       344
       344
       +
       #### 2.9.3 Session Binding Requirements

     

       345
       345
       +
       

     

       346
       346
       +
       MCP servers implementing third-party authorization **MUST**:

     

       347
       347
       +
       

     

       348
       348
       +
       1. Maintain secure mapping between third-party tokens and issued MCP tokens

     

       349
       349
       +
       2. Validate third-party token status before honoring MCP tokens

     

       350
       350
       +
       3. Implement appropriate token lifecycle management

     

       351
       351
       +
       4. Handle third-party token expiration and renewal

     

       352
       352
       +
       

     

       353
       353
       +
       #### 2.9.4 Security Considerations

     

       354
       354
       +
       

     

       355
       355
       +
       When implementing third-party authorization, servers **MUST**:

     

       356
       356
       +
       

     

       357
       357
       +
       1. Validate all redirect URIs

     

       358
       358
       +
       2. Securely store third-party credentials

     

       359
       359
       +
       3. Implement appropriate session timeout handling

     

       360
       360
       +
       4. Consider security implications of token chaining

     

       361
       361
       +
       5. Implement proper error handling for third-party auth failures

     

       362
       362
       +
       

     

       363
       363
       +
       ## 3. Best Practices

     

       364
       364
       +
       

     

       365
       365
       +
       #### 3.1 Local clients as Public OAuth 2.1 Clients

     

       366
       366
       +
       

     

       367
       367
       +
       We strongly recommend that local clients implement OAuth 2.1 as a public client:

     

       368
       368
       +
       

     

       369
       369
       +
       1. Utilizing code challenges (PKCE) for authorization requests to prevent interception

     

       370
       370
       +
          attacks

     

       371
       371
       +
       2. Implementing secure token storage appropriate for the local system

     

       372
       372
       +
       3. Following token refresh best practices to maintain sessions

     

       373
       373
       +
       4. Properly handling token expiration and renewal

     

       374
       374
       +
       

     

       375
       375
       +
       #### 3.2 Authorization Metadata Discovery

     

       376
       376
       +
       

     

       377
       377
       +
       We strongly recommend that all clients implement metadata discovery. This reduces the

     

       378
       378
       +
       need for users to provide endpoints manually or clients to fallback to the defined

     

       379
       379
       +
       defaults.

     

       380
       380
       +
       

     

       381
       381
       +
       #### 3.3 Dynamic Client Registration

     

       382
       382
       +
       

     

       383
       383
       +
       Since clients do not know the set of MCP servers in advance, we strongly recommend the

     

       384
       384
       +
       implementation of dynamic client registration. This allows applications to automatically

     

       385
       385
       +
       register with the MCP server, and removes the need for users to obtain client ids

     

       386
       386
       +
       manually.

+239

spec/lifecycle.md

···

       1
       1
       +
       ---

     

       2
       2
       +
       title: Lifecycle

     

       3
       3
       +
       type: docs

     

       4
       4
       +
       weight: 30

     

       5
       5
       +
       ---

     

       6
       6
       +
       

     

       7
       7
       +
       {{< callout type="info" >}} **Protocol Revision**: 2025-03-26 {{< /callout >}}

     

       8
       8
       +
       

     

       9
       9
       +
       The Model Context Protocol (MCP) defines a rigorous lifecycle for client-server

     

       10
       10
       +
       connections that ensures proper capability negotiation and state management.

     

       11
       11
       +
       

     

       12
       12
       +
       1. **Initialization**: Capability negotiation and protocol version agreement

     

       13
       13
       +
       2. **Operation**: Normal protocol communication

     

       14
       14
       +
       3. **Shutdown**: Graceful termination of the connection

     

       15
       15
       +
       

     

       16
       16
       +
       ```mermaid

     

       17
       17
       +
       sequenceDiagram

     

       18
       18
       +
           participant Client

     

       19
       19
       +
           participant Server

     

       20
       20
       +
       

     

       21
       21
       +
           Note over Client,Server: Initialization Phase

     

       22
       22
       +
           activate Client

     

       23
       23
       +
           Client->>+Server: initialize request

     

       24
       24
       +
           Server-->>Client: initialize response

     

       25
       25
       +
           Client--)Server: initialized notification

     

       26
       26
       +
       

     

       27
       27
       +
           Note over Client,Server: Operation Phase

     

       28
       28
       +
           rect rgb(200, 220, 250)

     

       29
       29
       +
               note over Client,Server: Normal protocol operations

     

       30
       30
       +
           end

     

       31
       31
       +
       

     

       32
       32
       +
           Note over Client,Server: Shutdown

     

       33
       33
       +
           Client--)-Server: Disconnect

     

       34
       34
       +
           deactivate Server

     

       35
       35
       +
           Note over Client,Server: Connection closed

     

       36
       36
       +
       ```

     

       37
       37
       +
       

     

       38
       38
       +
       ## Lifecycle Phases

     

       39
       39
       +
       

     

       40
       40
       +
       ### Initialization

     

       41
       41
       +
       

     

       42
       42
       +
       The initialization phase **MUST** be the first interaction between client and server.

     

       43
       43
       +
       During this phase, the client and server:

     

       44
       44
       +
       

     

       45
       45
       +
       - Establish protocol version compatibility

     

       46
       46
       +
       - Exchange and negotiate capabilities

     

       47
       47
       +
       - Share implementation details

     

       48
       48
       +
       

     

       49
       49
       +
       The client **MUST** initiate this phase by sending an `initialize` request containing:

     

       50
       50
       +
       

     

       51
       51
       +
       - Protocol version supported

     

       52
       52
       +
       - Client capabilities

     

       53
       53
       +
       - Client implementation information

     

       54
       54
       +
       

     

       55
       55
       +
       ```json

     

       56
       56
       +
       {

     

       57
       57
       +
         "jsonrpc": "2.0",

     

       58
       58
       +
         "id": 1,

     

       59
       59
       +
         "method": "initialize",

     

       60
       60
       +
         "params": {

     

       61
       61
       +
           "protocolVersion": "2024-11-05",

     

       62
       62
       +
           "capabilities": {

     

       63
       63
       +
             "roots": {

     

       64
       64
       +
               "listChanged": true

     

       65
       65
       +
             },

     

       66
       66
       +
             "sampling": {}

     

       67
       67
       +
           },

     

       68
       68
       +
           "clientInfo": {

     

       69
       69
       +
             "name": "ExampleClient",

     

       70
       70
       +
             "version": "1.0.0"

     

       71
       71
       +
           }

     

       72
       72
       +
         }

     

       73
       73
       +
       }

     

       74
       74
       +
       ```

     

       75
       75
       +
       

     

       76
       76
       +
       The initialize request **MUST NOT** be part of a JSON-RPC

     

       77
       77
       +
       [batch](https://www.jsonrpc.org/specification#batch), as other requests and notifications

     

       78
       78
       +
       are not possible until initialization has completed. This also permits backwards

     

       79
       79
       +
       compatibility with prior protocol versions that do not explicitly support JSON-RPC

     

       80
       80
       +
       batches.

     

       81
       81
       +
       

     

       82
       82
       +
       The server **MUST** respond with its own capabilities and information:

     

       83
       83
       +
       

     

       84
       84
       +
       ```json

     

       85
       85
       +
       {

     

       86
       86
       +
         "jsonrpc": "2.0",

     

       87
       87
       +
         "id": 1,

     

       88
       88
       +
         "result": {

     

       89
       89
       +
           "protocolVersion": "2024-11-05",

     

       90
       90
       +
           "capabilities": {

     

       91
       91
       +
             "logging": {},

     

       92
       92
       +
             "prompts": {

     

       93
       93
       +
               "listChanged": true

     

       94
       94
       +
             },

     

       95
       95
       +
             "resources": {

     

       96
       96
       +
               "subscribe": true,

     

       97
       97
       +
               "listChanged": true

     

       98
       98
       +
             },

     

       99
       99
       +
             "tools": {

     

       100
       100
       +
               "listChanged": true

     

       101
       101
       +
             }

     

       102
       102
       +
           },

     

       103
       103
       +
           "serverInfo": {

     

       104
       104
       +
             "name": "ExampleServer",

     

       105
       105
       +
             "version": "1.0.0"

     

       106
       106
       +
           }

     

       107
       107
       +
         }

     

       108
       108
       +
       }

     

       109
       109
       +
       ```

     

       110
       110
       +
       

     

       111
       111
       +
       After successful initialization, the client **MUST** send an `initialized` notification

     

       112
       112
       +
       to indicate it is ready to begin normal operations:

     

       113
       113
       +
       

     

       114
       114
       +
       ```json

     

       115
       115
       +
       {

     

       116
       116
       +
         "jsonrpc": "2.0",

     

       117
       117
       +
         "method": "notifications/initialized"

     

       118
       118
       +
       }

     

       119
       119
       +
       ```

     

       120
       120
       +
       

     

       121
       121
       +
       - The client **SHOULD NOT** send requests other than

     

       122
       122
       +
         [pings]({{< ref "utilities/ping" >}}) before the server has responded to the

     

       123
       123
       +
         `initialize` request.

     

       124
       124
       +
       - The server **SHOULD NOT** send requests other than

     

       125
       125
       +
         [pings]({{< ref "utilities/ping" >}}) and

     

       126
       126
       +
         [logging]({{< ref "../server/utilities/logging" >}}) before receiving the `initialized`

     

       127
       127
       +
         notification.

     

       128
       128
       +
       

     

       129
       129
       +
       #### Version Negotiation

     

       130
       130
       +
       

     

       131
       131
       +
       In the `initialize` request, the client **MUST** send a protocol version it supports.

     

       132
       132
       +
       This **SHOULD** be the _latest_ version supported by the client.

     

       133
       133
       +
       

     

       134
       134
       +
       If the server supports the requested protocol version, it **MUST** respond with the same

     

       135
       135
       +
       version. Otherwise, the server **MUST** respond with another protocol version it

     

       136
       136
       +
       supports. This **SHOULD** be the _latest_ version supported by the server.

     

       137
       137
       +
       

     

       138
       138
       +
       If the client does not support the version in the server's response, it **SHOULD**

     

       139
       139
       +
       disconnect.

     

       140
       140
       +
       

     

       141
       141
       +
       #### Capability Negotiation

     

       142
       142
       +
       

     

       143
       143
       +
       Client and server capabilities establish which optional protocol features will be

     

       144
       144
       +
       available during the session.

     

       145
       145
       +
       

     

       146
       146
       +
       Key capabilities include:

     

       147
       147
       +
       

     

       148
       148
       +
       | Category | Capability     | Description                                                                |

     

       149
       149
       +
       | -------- | -------------- | -------------------------------------------------------------------------- |

     

       150
       150
       +
       | Client   | `roots`        | Ability to provide filesystem [roots]({{< ref "../client/roots" >}})       |

     

       151
       151
       +
       | Client   | `sampling`     | Support for LLM [sampling]({{< ref "../client/sampling" >}}) requests      |

     

       152
       152
       +
       | Client   | `experimental` | Describes support for non-standard experimental features                   |

     

       153
       153
       +
       | Server   | `prompts`      | Offers [prompt templates]({{< ref "../server/prompts" >}})                 |

     

       154
       154
       +
       | Server   | `resources`    | Provides readable [resources]({{< ref "../server/resources" >}})           |

     

       155
       155
       +
       | Server   | `tools`        | Exposes callable [tools]({{< ref "../server/tools" >}})                    |

     

       156
       156
       +
       | Server   | `logging`      | Emits structured [log messages]({{< ref "../server/utilities/logging" >}}) |

     

       157
       157
       +
       | Server   | `experimental` | Describes support for non-standard experimental features                   |

     

       158
       158
       +
       

     

       159
       159
       +
       Capability objects can describe sub-capabilities like:

     

       160
       160
       +
       

     

       161
       161
       +
       - `listChanged`: Support for list change notifications (for prompts, resources, and

     

       162
       162
       +
         tools)

     

       163
       163
       +
       - `subscribe`: Support for subscribing to individual items' changes (resources only)

     

       164
       164
       +
       

     

       165
       165
       +
       ### Operation

     

       166
       166
       +
       

     

       167
       167
       +
       During the operation phase, the client and server exchange messages according to the

     

       168
       168
       +
       negotiated capabilities.

     

       169
       169
       +
       

     

       170
       170
       +
       Both parties **SHOULD**:

     

       171
       171
       +
       

     

       172
       172
       +
       - Respect the negotiated protocol version

     

       173
       173
       +
       - Only use capabilities that were successfully negotiated

     

       174
       174
       +
       

     

       175
       175
       +
       ### Shutdown

     

       176
       176
       +
       

     

       177
       177
       +
       During the shutdown phase, one side (usually the client) cleanly terminates the protocol

     

       178
       178
       +
       connection. No specific shutdown messages are defined—instead, the underlying transport

     

       179
       179
       +
       mechanism should be used to signal connection termination:

     

       180
       180
       +
       

     

       181
       181
       +
       #### stdio

     

       182
       182
       +
       

     

       183
       183
       +
       For the stdio [transport]({{< ref "transports" >}}), the client **SHOULD** initiate

     

       184
       184
       +
       shutdown by:

     

       185
       185
       +
       

     

       186
       186
       +
       1. First, closing the input stream to the child process (the server)

     

       187
       187
       +
       2. Waiting for the server to exit, or sending `SIGTERM` if the server does not exit

     

       188
       188
       +
          within a reasonable time

     

       189
       189
       +
       3. Sending `SIGKILL` if the server does not exit within a reasonable time after `SIGTERM`

     

       190
       190
       +
       

     

       191
       191
       +
       The server **MAY** initiate shutdown by closing its output stream to the client and

     

       192
       192
       +
       exiting.

     

       193
       193
       +
       

     

       194
       194
       +
       #### HTTP

     

       195
       195
       +
       

     

       196
       196
       +
       For HTTP [transports]({{< ref "transports" >}}), shutdown is indicated by closing the

     

       197
       197
       +
       associated HTTP connection(s).

     

       198
       198
       +
       

     

       199
       199
       +
       ## Timeouts

     

       200
       200
       +
       

     

       201
       201
       +
       Implementations **SHOULD** establish timeouts for all sent requests, to prevent hung

     

       202
       202
       +
       connections and resource exhaustion. When the request has not received a success or error

     

       203
       203
       +
       response within the timeout period, the sender **SHOULD** issue a [cancellation

     

       204
       204
       +
       notification]({{< ref "utilities/cancellation" >}}) for that request and stop waiting for

     

       205
       205
       +
       a response.

     

       206
       206
       +
       

     

       207
       207
       +
       SDKs and other middleware **SHOULD** allow these timeouts to be configured on a

     

       208
       208
       +
       per-request basis.

     

       209
       209
       +
       

     

       210
       210
       +
       Implementations **MAY** choose to reset the timeout clock when receiving a [progress

     

       211
       211
       +
       notification]({{< ref "utilities/progress" >}}) corresponding to the request, as this

     

       212
       212
       +
       implies that work is actually happening. However, implementations **SHOULD** always

     

       213
       213
       +
       enforce a maximum timeout, regardless of progress notifications, to limit the impact of a

     

       214
       214
       +
       misbehaving client or server.

     

       215
       215
       +
       

     

       216
       216
       +
       ## Error Handling

     

       217
       217
       +
       

     

       218
       218
       +
       Implementations **SHOULD** be prepared to handle these error cases:

     

       219
       219
       +
       

     

       220
       220
       +
       - Protocol version mismatch

     

       221
       221
       +
       - Failure to negotiate required capabilities

     

       222
       222
       +
       - Request [timeouts](#timeouts)

     

       223
       223
       +
       

     

       224
       224
       +
       Example initialization error:

     

       225
       225
       +
       

     

       226
       226
       +
       ```json

     

       227
       227
       +
       {

     

       228
       228
       +
         "jsonrpc": "2.0",

     

       229
       229
       +
         "id": 1,

     

       230
       230
       +
         "error": {

     

       231
       231
       +
           "code": -32602,

     

       232
       232
       +
           "message": "Unsupported protocol version",

     

       233
       233
       +
           "data": {

     

       234
       234
       +
             "supported": ["2024-11-05"],

     

       235
       235
       +
             "requested": "1.0.0"

     

       236
       236
       +
           }

     

       237
       237
       +
         }

     

       238
       238
       +
       }

     

       239
       239
       +
       ```

+265

spec/prompts.md

···

       1
       1
       +
       ---

     

       2
       2
       +
       title: Prompts

     

       3
       3
       +
       weight: 10

     

       4
       4
       +
       ---

     

       5
       5
       +
       

     

       6
       6
       +
       {{< callout type="info" >}} **Protocol Revision**: 2025-03-26 {{< /callout >}}

     

       7
       7
       +
       

     

       8
       8
       +
       The Model Context Protocol (MCP) provides a standardized way for servers to expose prompt

     

       9
       9
       +
       templates to clients. Prompts allow servers to provide structured messages and

     

       10
       10
       +
       instructions for interacting with language models. Clients can discover available

     

       11
       11
       +
       prompts, retrieve their contents, and provide arguments to customize them.

     

       12
       12
       +
       

     

       13
       13
       +
       ## User Interaction Model

     

       14
       14
       +
       

     

       15
       15
       +
       Prompts are designed to be **user-controlled**, meaning they are exposed from servers to

     

       16
       16
       +
       clients with the intention of the user being able to explicitly select them for use.

     

       17
       17
       +
       

     

       18
       18
       +
       Typically, prompts would be triggered through user-initiated commands in the user

     

       19
       19
       +
       interface, which allows users to naturally discover and invoke available prompts.

     

       20
       20
       +
       

     

       21
       21
       +
       For example, as slash commands:

     

       22
       22
       +
       

     

       23
       23
       +
       ![Example of prompt exposed as slash command](slash-command.png)

     

       24
       24
       +
       

     

       25
       25
       +
       However, implementors are free to expose prompts through any interface pattern that suits

     

       26
       26
       +
       their needs&mdash;the protocol itself does not mandate any specific user interaction

     

       27
       27
       +
       model.

     

       28
       28
       +
       

     

       29
       29
       +
       ## Capabilities

     

       30
       30
       +
       

     

       31
       31
       +
       Servers that support prompts **MUST** declare the `prompts` capability during

     

       32
       32
       +
       [initialization]({{< ref "../basic/lifecycle#initialization" >}}):

     

       33
       33
       +
       

     

       34
       34
       +
       /draft`json { "capabilities": { "prompts": { "listChanged": true } } }

     

       35
       35
       +
       

     

       36
       36
       +
       ````

     

       37
       37
       +
       

     

       38
       38
       +
       `listChanged` indicates whether the server will emit notifications when the list of

     

       39
       39
       +
       available prompts changes.

     

       40
       40
       +
       

     

       41
       41
       +
       ## Protocol Messages

     

       42
       42
       +
       

     

       43
       43
       +
       ### Listing Prompts

     

       44
       44
       +
       

     

       45
       45
       +
       To retrieve available prompts, clients send a `prompts/list` request. This operation

     

       46
       46
       +
       supports [pagination]({{< ref "utilities/pagination" >}}).

     

       47
       47
       +
       

     

       48
       48
       +
       **Request:**

     

       49
       49
       +
       

     

       50
       50
       +
       ```json

     

       51
       51
       +
       {

     

       52
       52
       +
         "jsonrpc": "2.0",

     

       53
       53
       +
         "id": 1,

     

       54
       54
       +
         "method": "prompts/list",

     

       55
       55
       +
         "params": {

     

       56
       56
       +
           "cursor": "optional-cursor-value"

     

       57
       57
       +
         }

     

       58
       58
       +
       }

     

       59
       59
       +
       ````

     

       60
       60
       +
       

     

       61
       61
       +
       **Response:**

     

       62
       62
       +
       

     

       63
       63
       +
       ```json

     

       64
       64
       +
       {

     

       65
       65
       +
         "jsonrpc": "2.0",

     

       66
       66
       +
         "id": 1,

     

       67
       67
       +
         "result": {

     

       68
       68
       +
           "prompts": [

     

       69
       69
       +
             {

     

       70
       70
       +
               "name": "code_review",

     

       71
       71
       +
               "description": "Asks the LLM to analyze code quality and suggest improvements",

     

       72
       72
       +
               "arguments": [

     

       73
       73
       +
                 {

     

       74
       74
       +
                   "name": "code",

     

       75
       75
       +
                   "description": "The code to review",

     

       76
       76
       +
                   "required": true

     

       77
       77
       +
                 }

     

       78
       78
       +
               ]

     

       79
       79
       +
             }

     

       80
       80
       +
           ],

     

       81
       81
       +
           "nextCursor": "next-page-cursor"

     

       82
       82
       +
         }

     

       83
       83
       +
       }

     

       84
       84
       +
       ```

     

       85
       85
       +
       

     

       86
       86
       +
       ### Getting a Prompt

     

       87
       87
       +
       

     

       88
       88
       +
       To retrieve a specific prompt, clients send a `prompts/get` request. Arguments may be

     

       89
       89
       +
       auto-completed through [the completion API]({{< ref "utilities/completion" >}}).

     

       90
       90
       +
       

     

       91
       91
       +
       **Request:**

     

       92
       92
       +
       

     

       93
       93
       +
       ```json

     

       94
       94
       +
       {

     

       95
       95
       +
         "jsonrpc": "2.0",

     

       96
       96
       +
         "id": 2,

     

       97
       97
       +
         "method": "prompts/get",

     

       98
       98
       +
         "params": {

     

       99
       99
       +
           "name": "code_review",

     

       100
       100
       +
           "arguments": {

     

       101
       101
       +
             "code": "def hello():\n    print('world')"

     

       102
       102
       +
           }

     

       103
       103
       +
         }

     

       104
       104
       +
       }

     

       105
       105
       +
       ```

     

       106
       106
       +
       

     

       107
       107
       +
       **Response:**

     

       108
       108
       +
       

     

       109
       109
       +
       ```json

     

       110
       110
       +
       {

     

       111
       111
       +
         "jsonrpc": "2.0",

     

       112
       112
       +
         "id": 2,

     

       113
       113
       +
         "result": {

     

       114
       114
       +
           "description": "Code review prompt",

     

       115
       115
       +
           "messages": [

     

       116
       116
       +
             {

     

       117
       117
       +
               "role": "user",

     

       118
       118
       +
               "content": {

     

       119
       119
       +
                 "type": "text",

     

       120
       120
       +
                 "text": "Please review this Python code:\ndef hello():\n    print('world')"

     

       121
       121
       +
               }

     

       122
       122
       +
             }

     

       123
       123
       +
           ]

     

       124
       124
       +
         }

     

       125
       125
       +
       }

     

       126
       126
       +
       ```

     

       127
       127
       +
       

     

       128
       128
       +
       ### List Changed Notification

     

       129
       129
       +
       

     

       130
       130
       +
       When the list of available prompts changes, servers that declared the `listChanged`

     

       131
       131
       +
       capability **SHOULD** send a notification:

     

       132
       132
       +
       

     

       133
       133
       +
       ```json

     

       134
       134
       +
       {

     

       135
       135
       +
         "jsonrpc": "2.0",

     

       136
       136
       +
         "method": "notifications/prompts/list_changed"

     

       137
       137
       +
       }

     

       138
       138
       +
       ```

     

       139
       139
       +
       

     

       140
       140
       +
       ## Message Flow

     

       141
       141
       +
       

     

       142
       142
       +
       ```mermaid

     

       143
       143
       +
       sequenceDiagram

     

       144
       144
       +
           participant Client

     

       145
       145
       +
           participant Server

     

       146
       146
       +
       

     

       147
       147
       +
           Note over Client,Server: Discovery

     

       148
       148
       +
           Client->>Server: prompts/list

     

       149
       149
       +
           Server-->>Client: List of prompts

     

       150
       150
       +
       

     

       151
       151
       +
           Note over Client,Server: Usage

     

       152
       152
       +
           Client->>Server: prompts/get

     

       153
       153
       +
           Server-->>Client: Prompt content

     

       154
       154
       +
       

     

       155
       155
       +
           opt listChanged

     

       156
       156
       +
             Note over Client,Server: Changes

     

       157
       157
       +
             Server--)Client: prompts/list_changed

     

       158
       158
       +
             Client->>Server: prompts/list

     

       159
       159
       +
             Server-->>Client: Updated prompts

     

       160
       160
       +
           end

     

       161
       161
       +
       ```

     

       162
       162
       +
       

     

       163
       163
       +
       ## Data Types

     

       164
       164
       +
       

     

       165
       165
       +
       ### Prompt

     

       166
       166
       +
       

     

       167
       167
       +
       A prompt definition includes:

     

       168
       168
       +
       

     

       169
       169
       +
       - `name`: Unique identifier for the prompt

     

       170
       170
       +
       - `description`: Optional human-readable description

     

       171
       171
       +
       - `arguments`: Optional list of arguments for customization

     

       172
       172
       +
       

     

       173
       173
       +
       ### PromptMessage

     

       174
       174
       +
       

     

       175
       175
       +
       Messages in a prompt can contain:

     

       176
       176
       +
       

     

       177
       177
       +
       - `role`: Either "user" or "assistant" to indicate the speaker

     

       178
       178
       +
       - `content`: One of the following content types:

     

       179
       179
       +
       

     

       180
       180
       +
       #### Text Content

     

       181
       181
       +
       

     

       182
       182
       +
       Text content represents plain text messages:

     

       183
       183
       +
       

     

       184
       184
       +
       ```json

     

       185
       185
       +
       {

     

       186
       186
       +
         "type": "text",

     

       187
       187
       +
         "text": "The text content of the message"

     

       188
       188
       +
       }

     

       189
       189
       +
       ```

     

       190
       190
       +
       

     

       191
       191
       +
       This is the most common content type used for natural language interactions.

     

       192
       192
       +
       

     

       193
       193
       +
       #### Image Content

     

       194
       194
       +
       

     

       195
       195
       +
       Image content allows including visual information in messages:

     

       196
       196
       +
       

     

       197
       197
       +
       ```json

     

       198
       198
       +
       {

     

       199
       199
       +
         "type": "image",

     

       200
       200
       +
         "data": "base64-encoded-image-data",

     

       201
       201
       +
         "mimeType": "image/png"

     

       202
       202
       +
       }

     

       203
       203
       +
       ```

     

       204
       204
       +
       

     

       205
       205
       +
       The image data **MUST** be base64-encoded and include a valid MIME type. This enables

     

       206
       206
       +
       multi-modal interactions where visual context is important.

     

       207
       207
       +
       

     

       208
       208
       +
       #### Audio Content

     

       209
       209
       +
       

     

       210
       210
       +
       Audio content allows including audio information in messages:

     

       211
       211
       +
       

     

       212
       212
       +
       ```json

     

       213
       213
       +
       {

     

       214
       214
       +
         "type": "audio",

     

       215
       215
       +
         "data": "base64-encoded-audio-data",

     

       216
       216
       +
         "mimeType": "audio/wav"

     

       217
       217
       +
       }

     

       218
       218
       +
       ```

     

       219
       219
       +
       

     

       220
       220
       +
       The audio data MUST be base64-encoded and include a valid MIME type. This enables

     

       221
       221
       +
       multi-modal interactions where audio context is important.

     

       222
       222
       +
       

     

       223
       223
       +
       #### Embedded Resources

     

       224
       224
       +
       

     

       225
       225
       +
       Embedded resources allow referencing server-side resources directly in messages:

     

       226
       226
       +
       

     

       227
       227
       +
       ```json

     

       228
       228
       +
       {

     

       229
       229
       +
         "type": "resource",

     

       230
       230
       +
         "resource": {

     

       231
       231
       +
           "uri": "resource://example",

     

       232
       232
       +
           "mimeType": "text/plain",

     

       233
       233
       +
           "text": "Resource content"

     

       234
       234
       +
         }

     

       235
       235
       +
       }

     

       236
       236
       +
       ```

     

       237
       237
       +
       

     

       238
       238
       +
       Resources can contain either text or binary (blob) data and **MUST** include:

     

       239
       239
       +
       

     

       240
       240
       +
       - A valid resource URI

     

       241
       241
       +
       - The appropriate MIME type

     

       242
       242
       +
       - Either text content or base64-encoded blob data

     

       243
       243
       +
       

     

       244
       244
       +
       Embedded resources enable prompts to seamlessly incorporate server-managed content like

     

       245
       245
       +
       documentation, code samples, or other reference materials directly into the conversation

     

       246
       246
       +
       flow.

     

       247
       247
       +
       

     

       248
       248
       +
       ## Error Handling

     

       249
       249
       +
       

     

       250
       250
       +
       Servers **SHOULD** return standard JSON-RPC errors for common failure cases:

     

       251
       251
       +
       

     

       252
       252
       +
       - Invalid prompt name: `-32602` (Invalid params)

     

       253
       253
       +
       - Missing required arguments: `-32602` (Invalid params)

     

       254
       254
       +
       - Internal errors: `-32603` (Internal error)

     

       255
       255
       +
       

     

       256
       256
       +
       ## Implementation Considerations

     

       257
       257
       +
       

     

       258
       258
       +
       1. Servers **SHOULD** validate prompt arguments before processing

     

       259
       259
       +
       2. Clients **SHOULD** handle pagination for large prompt lists

     

       260
       260
       +
       3. Both parties **SHOULD** respect capability negotiation

     

       261
       261
       +
       

     

       262
       262
       +
       ## Security

     

       263
       263
       +
       

     

       264
       264
       +
       Implementations **MUST** carefully validate all prompt inputs and outputs to prevent

     

       265
       265
       +
       injection attacks or unauthorized access to resources.

+357

spec/resources.md

···

       1
       1
       +
       ---

     

       2
       2
       +
       title: Resources

     

       3
       3
       +
       type: docs

     

       4
       4
       +
       weight: 20

     

       5
       5
       +
       ---

     

       6
       6
       +
       

     

       7
       7
       +
       {{< callout type="info" >}} **Protocol Revision**: 2025-03-26 {{< /callout >}}

     

       8
       8
       +
       

     

       9
       9
       +
       The Model Context Protocol (MCP) provides a standardized way for servers to expose

     

       10
       10
       +
       resources to clients. Resources allow servers to share data that provides context to

     

       11
       11
       +
       language models, such as files, database schemas, or application-specific information.

     

       12
       12
       +
       Each resource is uniquely identified by a

     

       13
       13
       +
       [URI](https://datatracker.ietf.org/doc/html/rfc3986).

     

       14
       14
       +
       

     

       15
       15
       +
       ## User Interaction Model

     

       16
       16
       +
       

     

       17
       17
       +
       Resources in MCP are designed to be **application-driven**, with host applications

     

       18
       18
       +
       determining how to incorporate context based on their needs.

     

       19
       19
       +
       

     

       20
       20
       +
       For example, applications could:

     

       21
       21
       +
       

     

       22
       22
       +
       - Expose resources through UI elements for explicit selection, in a tree or list view

     

       23
       23
       +
       - Allow the user to search through and filter available resources

     

       24
       24
       +
       - Implement automatic context inclusion, based on heuristics or the AI model's selection

     

       25
       25
       +
       

     

       26
       26
       +
       ![Example of resource context picker](resource-picker.png)

     

       27
       27
       +
       

     

       28
       28
       +
       However, implementations are free to expose resources through any interface pattern that

     

       29
       29
       +
       suits their needs&mdash;the protocol itself does not mandate any specific user

     

       30
       30
       +
       interaction model.

     

       31
       31
       +
       

     

       32
       32
       +
       ## Capabilities

     

       33
       33
       +
       

     

       34
       34
       +
       Servers that support resources **MUST** declare the `resources` capability:

     

       35
       35
       +
       

     

       36
       36
       +
       ```json

     

       37
       37
       +
       {

     

       38
       38
       +
         "capabilities": {

     

       39
       39
       +
           "resources": {

     

       40
       40
       +
             "subscribe": true,

     

       41
       41
       +
             "listChanged": true

     

       42
       42
       +
           }

     

       43
       43
       +
         }

     

       44
       44
       +
       }

     

       45
       45
       +
       ```

     

       46
       46
       +
       

     

       47
       47
       +
       The capability supports two optional features:

     

       48
       48
       +
       

     

       49
       49
       +
       - `subscribe`: whether the client can subscribe to be notified of changes to individual

     

       50
       50
       +
         resources.

     

       51
       51
       +
       - `listChanged`: whether the server will emit notifications when the list of available

     

       52
       52
       +
         resources changes.

     

       53
       53
       +
       

     

       54
       54
       +
       Both `subscribe` and `listChanged` are optional&mdash;servers can support neither,

     

       55
       55
       +
       either, or both:

     

       56
       56
       +
       

     

       57
       57
       +
       ```json

     

       58
       58
       +
       {

     

       59
       59
       +
         "capabilities": {

     

       60
       60
       +
           "resources": {} // Neither feature supported

     

       61
       61
       +
         }

     

       62
       62
       +
       }

     

       63
       63
       +
       ```

     

       64
       64
       +
       

     

       65
       65
       +
       ```json

     

       66
       66
       +
       {

     

       67
       67
       +
         "capabilities": {

     

       68
       68
       +
           "resources": {

     

       69
       69
       +
             "subscribe": true // Only subscriptions supported

     

       70
       70
       +
           }

     

       71
       71
       +
         }

     

       72
       72
       +
       }

     

       73
       73
       +
       ```

     

       74
       74
       +
       

     

       75
       75
       +
       ```json

     

       76
       76
       +
       {

     

       77
       77
       +
         "capabilities": {

     

       78
       78
       +
           "resources": {

     

       79
       79
       +
             "listChanged": true // Only list change notifications supported

     

       80
       80
       +
           }

     

       81
       81
       +
         }

     

       82
       82
       +
       }

     

       83
       83
       +
       ```

     

       84
       84
       +
       

     

       85
       85
       +
       ## Protocol Messages

     

       86
       86
       +
       

     

       87
       87
       +
       ### Listing Resources

     

       88
       88
       +
       

     

       89
       89
       +
       To discover available resources, clients send a `resources/list` request. This operation

     

       90
       90
       +
       supports [pagination]({{< ref "utilities/pagination" >}}).

     

       91
       91
       +
       

     

       92
       92
       +
       **Request:**

     

       93
       93
       +
       

     

       94
       94
       +
       ```json

     

       95
       95
       +
       {

     

       96
       96
       +
         "jsonrpc": "2.0",

     

       97
       97
       +
         "id": 1,

     

       98
       98
       +
         "method": "resources/list",

     

       99
       99
       +
         "params": {

     

       100
       100
       +
           "cursor": "optional-cursor-value"

     

       101
       101
       +
         }

     

       102
       102
       +
       }

     

       103
       103
       +
       ```

     

       104
       104
       +
       

     

       105
       105
       +
       **Response:**

     

       106
       106
       +
       

     

       107
       107
       +
       ```json

     

       108
       108
       +
       {

     

       109
       109
       +
         "jsonrpc": "2.0",

     

       110
       110
       +
         "id": 1,

     

       111
       111
       +
         "result": {

     

       112
       112
       +
           "resources": [

     

       113
       113
       +
             {

     

       114
       114
       +
               "uri": "file:///project/src/main.rs",

     

       115
       115
       +
               "name": "main.rs",

     

       116
       116
       +
               "description": "Primary application entry point",

     

       117
       117
       +
               "mimeType": "text/x-rust"

     

       118
       118
       +
             }

     

       119
       119
       +
           ],

     

       120
       120
       +
           "nextCursor": "next-page-cursor"

     

       121
       121
       +
         }

     

       122
       122
       +
       }

     

       123
       123
       +
       ```

     

       124
       124
       +
       

     

       125
       125
       +
       ### Reading Resources

     

       126
       126
       +
       

     

       127
       127
       +
       To retrieve resource contents, clients send a `resources/read` request:

     

       128
       128
       +
       

     

       129
       129
       +
       **Request:**

     

       130
       130
       +
       

     

       131
       131
       +
       ```json

     

       132
       132
       +
       {

     

       133
       133
       +
         "jsonrpc": "2.0",

     

       134
       134
       +
         "id": 2,

     

       135
       135
       +
         "method": "resources/read",

     

       136
       136
       +
         "params": {

     

       137
       137
       +
           "uri": "file:///project/src/main.rs"

     

       138
       138
       +
         }

     

       139
       139
       +
       }

     

       140
       140
       +
       ```

     

       141
       141
       +
       

     

       142
       142
       +
       **Response:**

     

       143
       143
       +
       

     

       144
       144
       +
       ```json

     

       145
       145
       +
       {

     

       146
       146
       +
         "jsonrpc": "2.0",

     

       147
       147
       +
         "id": 2,

     

       148
       148
       +
         "result": {

     

       149
       149
       +
           "contents": [

     

       150
       150
       +
             {

     

       151
       151
       +
               "uri": "file:///project/src/main.rs",

     

       152
       152
       +
               "mimeType": "text/x-rust",

     

       153
       153
       +
               "text": "fn main() {\n    println!(\"Hello world!\");\n}"

     

       154
       154
       +
             }

     

       155
       155
       +
           ]

     

       156
       156
       +
         }

     

       157
       157
       +
       }

     

       158
       158
       +
       ```

     

       159
       159
       +
       

     

       160
       160
       +
       ### Resource Templates

     

       161
       161
       +
       

     

       162
       162
       +
       Resource templates allow servers to expose parameterized resources using

     

       163
       163
       +
       [URI templates](https://datatracker.ietf.org/doc/html/rfc6570). Arguments may be

     

       164
       164
       +
       auto-completed through [the completion API]({{< ref "utilities/completion" >}}).

     

       165
       165
       +
       

     

       166
       166
       +
       **Request:**

     

       167
       167
       +
       

     

       168
       168
       +
       ```json

     

       169
       169
       +
       {

     

       170
       170
       +
         "jsonrpc": "2.0",

     

       171
       171
       +
         "id": 3,

     

       172
       172
       +
         "method": "resources/templates/list"

     

       173
       173
       +
       }

     

       174
       174
       +
       ```

     

       175
       175
       +
       

     

       176
       176
       +
       **Response:**

     

       177
       177
       +
       

     

       178
       178
       +
       ```json

     

       179
       179
       +
       {

     

       180
       180
       +
         "jsonrpc": "2.0",

     

       181
       181
       +
         "id": 3,

     

       182
       182
       +
         "result": {

     

       183
       183
       +
           "resourceTemplates": [

     

       184
       184
       +
             {

     

       185
       185
       +
               "uriTemplate": "file:///{path}",

     

       186
       186
       +
               "name": "Project Files",

     

       187
       187
       +
               "description": "Access files in the project directory",

     

       188
       188
       +
               "mimeType": "application/octet-stream"

     

       189
       189
       +
             }

     

       190
       190
       +
           ]

     

       191
       191
       +
         }

     

       192
       192
       +
       }

     

       193
       193
       +
       ```

     

       194
       194
       +
       

     

       195
       195
       +
       ### List Changed Notification

     

       196
       196
       +
       

     

       197
       197
       +
       When the list of available resources changes, servers that declared the `listChanged`

     

       198
       198
       +
       capability **SHOULD** send a notification:

     

       199
       199
       +
       

     

       200
       200
       +
       ```json

     

       201
       201
       +
       {

     

       202
       202
       +
         "jsonrpc": "2.0",

     

       203
       203
       +
         "method": "notifications/resources/list_changed"

     

       204
       204
       +
       }

     

       205
       205
       +
       ```

     

       206
       206
       +
       

     

       207
       207
       +
       ### Subscriptions

     

       208
       208
       +
       

     

       209
       209
       +
       The protocol supports optional subscriptions to resource changes. Clients can subscribe

     

       210
       210
       +
       to specific resources and receive notifications when they change:

     

       211
       211
       +
       

     

       212
       212
       +
       **Subscribe Request:**

     

       213
       213
       +
       

     

       214
       214
       +
       ```json

     

       215
       215
       +
       {

     

       216
       216
       +
         "jsonrpc": "2.0",

     

       217
       217
       +
         "id": 4,

     

       218
       218
       +
         "method": "resources/subscribe",

     

       219
       219
       +
         "params": {

     

       220
       220
       +
           "uri": "file:///project/src/main.rs"

     

       221
       221
       +
         }

     

       222
       222
       +
       }

     

       223
       223
       +
       ```

     

       224
       224
       +
       

     

       225
       225
       +
       **Update Notification:**

     

       226
       226
       +
       

     

       227
       227
       +
       ```json

     

       228
       228
       +
       {

     

       229
       229
       +
         "jsonrpc": "2.0",

     

       230
       230
       +
         "method": "notifications/resources/updated",

     

       231
       231
       +
         "params": {

     

       232
       232
       +
           "uri": "file:///project/src/main.rs"

     

       233
       233
       +
         }

     

       234
       234
       +
       }

     

       235
       235
       +
       ```

     

       236
       236
       +
       

     

       237
       237
       +
       ## Message Flow

     

       238
       238
       +
       

     

       239
       239
       +
       ```mermaid

     

       240
       240
       +
       sequenceDiagram

     

       241
       241
       +
           participant Client

     

       242
       242
       +
           participant Server

     

       243
       243
       +
       

     

       244
       244
       +
           Note over Client,Server: Resource Discovery

     

       245
       245
       +
           Client->>Server: resources/list

     

       246
       246
       +
           Server-->>Client: List of resources

     

       247
       247
       +
       

     

       248
       248
       +
           Note over Client,Server: Resource Access

     

       249
       249
       +
           Client->>Server: resources/read

     

       250
       250
       +
           Server-->>Client: Resource contents

     

       251
       251
       +
       

     

       252
       252
       +
           Note over Client,Server: Subscriptions

     

       253
       253
       +
           Client->>Server: resources/subscribe

     

       254
       254
       +
           Server-->>Client: Subscription confirmed

     

       255
       255
       +
       

     

       256
       256
       +
           Note over Client,Server: Updates

     

       257
       257
       +
           Server--)Client: notifications/resources/updated

     

       258
       258
       +
           Client->>Server: resources/read

     

       259
       259
       +
           Server-->>Client: Updated contents

     

       260
       260
       +
       ```

     

       261
       261
       +
       

     

       262
       262
       +
       ## Data Types

     

       263
       263
       +
       

     

       264
       264
       +
       ### Resource

     

       265
       265
       +
       

     

       266
       266
       +
       A resource definition includes:

     

       267
       267
       +
       

     

       268
       268
       +
       - `uri`: Unique identifier for the resource

     

       269
       269
       +
       - `name`: Human-readable name

     

       270
       270
       +
       - `description`: Optional description

     

       271
       271
       +
       - `mimeType`: Optional MIME type

     

       272
       272
       +
       - `size`: Optional size in bytes

     

       273
       273
       +
       

     

       274
       274
       +
       ### Resource Contents

     

       275
       275
       +
       

     

       276
       276
       +
       Resources can contain either text or binary data:

     

       277
       277
       +
       

     

       278
       278
       +
       #### Text Content

     

       279
       279
       +
       

     

       280
       280
       +
       ```json

     

       281
       281
       +
       {

     

       282
       282
       +
         "uri": "file:///example.txt",

     

       283
       283
       +
         "mimeType": "text/plain",

     

       284
       284
       +
         "text": "Resource content"

     

       285
       285
       +
       }

     

       286
       286
       +
       ```

     

       287
       287
       +
       

     

       288
       288
       +
       #### Binary Content

     

       289
       289
       +
       

     

       290
       290
       +
       ```json

     

       291
       291
       +
       {

     

       292
       292
       +
         "uri": "file:///example.png",

     

       293
       293
       +
         "mimeType": "image/png",

     

       294
       294
       +
         "blob": "base64-encoded-data"

     

       295
       295
       +
       }

     

       296
       296
       +
       ```

     

       297
       297
       +
       

     

       298
       298
       +
       ## Common URI Schemes

     

       299
       299
       +
       

     

       300
       300
       +
       The protocol defines several standard URI schemes. This list not

     

       301
       301
       +
       exhaustive&mdash;implementations are always free to use additional, custom URI schemes.

     

       302
       302
       +
       

     

       303
       303
       +
       ### https://

     

       304
       304
       +
       

     

       305
       305
       +
       Used to represent a resource available on the web.

     

       306
       306
       +
       

     

       307
       307
       +
       Servers **SHOULD** use this scheme only when the client is able to fetch and load the

     

       308
       308
       +
       resource directly from the web on its own—that is, it doesn’t need to read the resource

     

       309
       309
       +
       via the MCP server.

     

       310
       310
       +
       

     

       311
       311
       +
       For other use cases, servers **SHOULD** prefer to use another URI scheme, or define a

     

       312
       312
       +
       custom one, even if the server will itself be downloading resource contents over the

     

       313
       313
       +
       internet.

     

       314
       314
       +
       

     

       315
       315
       +
       ### file://

     

       316
       316
       +
       

     

       317
       317
       +
       Used to identify resources that behave like a filesystem. However, the resources do not

     

       318
       318
       +
       need to map to an actual physical filesystem.

     

       319
       319
       +
       

     

       320
       320
       +
       MCP servers **MAY** identify file:// resources with an

     

       321
       321
       +
       [XDG MIME type](https://specifications.freedesktop.org/shared-mime-info-spec/0.14/ar01s02.html#id-1.3.14),

     

       322
       322
       +
       like `inode/directory`, to represent non-regular files (such as directories) that don’t

     

       323
       323
       +
       otherwise have a standard MIME type.

     

       324
       324
       +
       

     

       325
       325
       +
       ### git://

     

       326
       326
       +
       

     

       327
       327
       +
       Git version control integration.

     

       328
       328
       +
       

     

       329
       329
       +
       ## Error Handling

     

       330
       330
       +
       

     

       331
       331
       +
       Servers **SHOULD** return standard JSON-RPC errors for common failure cases:

     

       332
       332
       +
       

     

       333
       333
       +
       - Resource not found: `-32002`

     

       334
       334
       +
       - Internal errors: `-32603`

     

       335
       335
       +
       

     

       336
       336
       +
       Example error:

     

       337
       337
       +
       

     

       338
       338
       +
       ```json

     

       339
       339
       +
       {

     

       340
       340
       +
         "jsonrpc": "2.0",

     

       341
       341
       +
         "id": 5,

     

       342
       342
       +
         "error": {

     

       343
       343
       +
           "code": -32002,

     

       344
       344
       +
           "message": "Resource not found",

     

       345
       345
       +
           "data": {

     

       346
       346
       +
             "uri": "file:///nonexistent.txt"

     

       347
       347
       +
           }

     

       348
       348
       +
         }

     

       349
       349
       +
       }

     

       350
       350
       +
       ```

     

       351
       351
       +
       

     

       352
       352
       +
       ## Security Considerations

     

       353
       353
       +
       

     

       354
       354
       +
       1. Servers **MUST** validate all resource URIs

     

       355
       355
       +
       2. Access controls **SHOULD** be implemented for sensitive resources

     

       356
       356
       +
       3. Binary data **MUST** be properly encoded

     

       357
       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
       1
       +
       ---

     

       2
       2
       +
       title: Tools

     

       3
       3
       +
       type: docs

     

       4
       4
       +
       weight: 40

     

       5
       5
       +
       ---

     

       6
       6
       +
       

     

       7
       7
       +
       {{< callout type="info" >}} **Protocol Revision**: 2025-03-26 {{< /callout >}}

     

       8
       8
       +
       

     

       9
       9
       +
       The Model Context Protocol (MCP) allows servers to expose tools that can be invoked by

     

       10
       10
       +
       language models. Tools enable models to interact with external systems, such as querying

     

       11
       11
       +
       databases, calling APIs, or performing computations. Each tool is uniquely identified by

     

       12
       12
       +
       a name and includes metadata describing its schema.

     

       13
       13
       +
       

     

       14
       14
       +
       ## User Interaction Model

     

       15
       15
       +
       

     

       16
       16
       +
       Tools in MCP are designed to be **model-controlled**, meaning that the language model can

     

       17
       17
       +
       discover and invoke tools automatically based on its contextual understanding and the

     

       18
       18
       +
       user's prompts.

     

       19
       19
       +
       

     

       20
       20
       +
       However, implementations are free to expose tools through any interface pattern that

     

       21
       21
       +
       suits their needs&mdash;the protocol itself does not mandate any specific user

     

       22
       22
       +
       interaction model.

     

       23
       23
       +
       

     

       24
       24
       +
       {{< callout type="warning" >}} For trust & safety and security, there **SHOULD** always

     

       25
       25
       +
       be a human in the loop with the ability to deny tool invocations.

     

       26
       26
       +
       

     

       27
       27
       +
       Applications **SHOULD**:

     

       28
       28
       +
       

     

       29
       29
       +
       - Provide UI that makes clear which tools are being exposed to the AI model

     

       30
       30
       +
       - Insert clear visual indicators when tools are invoked

     

       31
       31
       +
       - Present confirmation prompts to the user for operations, to ensure a human is in the

     

       32
       32
       +
         loop {{< /callout >}}

     

       33
       33
       +
       

     

       34
       34
       +
       ## Capabilities

     

       35
       35
       +
       

     

       36
       36
       +
       Servers that support tools **MUST** declare the `tools` capability:

     

       37
       37
       +
       

     

       38
       38
       +
       ```json

     

       39
       39
       +
       {

     

       40
       40
       +
         "capabilities": {

     

       41
       41
       +
           "tools": {

     

       42
       42
       +
             "listChanged": true

     

       43
       43
       +
           }

     

       44
       44
       +
         }

     

       45
       45
       +
       }

     

       46
       46
       +
       ```

     

       47
       47
       +
       

     

       48
       48
       +
       `listChanged` indicates whether the server will emit notifications when the list of

     

       49
       49
       +
       available tools changes.

     

       50
       50
       +
       

     

       51
       51
       +
       ## Protocol Messages

     

       52
       52
       +
       

     

       53
       53
       +
       ### Listing Tools

     

       54
       54
       +
       

     

       55
       55
       +
       To discover available tools, clients send a `tools/list` request. This operation supports

     

       56
       56
       +
       [pagination]({{< ref "utilities/pagination" >}}).

     

       57
       57
       +
       

     

       58
       58
       +
       **Request:**

     

       59
       59
       +
       

     

       60
       60
       +
       ```json

     

       61
       61
       +
       {

     

       62
       62
       +
         "jsonrpc": "2.0",

     

       63
       63
       +
         "id": 1,

     

       64
       64
       +
         "method": "tools/list",

     

       65
       65
       +
         "params": {

     

       66
       66
       +
           "cursor": "optional-cursor-value"

     

       67
       67
       +
         }

     

       68
       68
       +
       }

     

       69
       69
       +
       ```

     

       70
       70
       +
       

     

       71
       71
       +
       **Response:**

     

       72
       72
       +
       

     

       73
       73
       +
       ```json

     

       74
       74
       +
       {

     

       75
       75
       +
         "jsonrpc": "2.0",

     

       76
       76
       +
         "id": 1,

     

       77
       77
       +
         "result": {

     

       78
       78
       +
           "tools": [

     

       79
       79
       +
             {

     

       80
       80
       +
               "name": "get_weather",

     

       81
       81
       +
               "description": "Get current weather information for a location",

     

       82
       82
       +
               "inputSchema": {

     

       83
       83
       +
                 "type": "object",

     

       84
       84
       +
                 "properties": {

     

       85
       85
       +
                   "location": {

     

       86
       86
       +
                     "type": "string",

     

       87
       87
       +
                     "description": "City name or zip code"

     

       88
       88
       +
                   }

     

       89
       89
       +
                 },

     

       90
       90
       +
                 "required": ["location"]

     

       91
       91
       +
               }

     

       92
       92
       +
             }

     

       93
       93
       +
           ],

     

       94
       94
       +
           "nextCursor": "next-page-cursor"

     

       95
       95
       +
         }

     

       96
       96
       +
       }

     

       97
       97
       +
       ```

     

       98
       98
       +
       

     

       99
       99
       +
       ### Calling Tools

     

       100
       100
       +
       

     

       101
       101
       +
       To invoke a tool, clients send a `tools/call` request:

     

       102
       102
       +
       

     

       103
       103
       +
       **Request:**

     

       104
       104
       +
       

     

       105
       105
       +
       ```json

     

       106
       106
       +
       {

     

       107
       107
       +
         "jsonrpc": "2.0",

     

       108
       108
       +
         "id": 2,

     

       109
       109
       +
         "method": "tools/call",

     

       110
       110
       +
         "params": {

     

       111
       111
       +
           "name": "get_weather",

     

       112
       112
       +
           "arguments": {

     

       113
       113
       +
             "location": "New York"

     

       114
       114
       +
           }

     

       115
       115
       +
         }

     

       116
       116
       +
       }

     

       117
       117
       +
       ```

     

       118
       118
       +
       

     

       119
       119
       +
       **Response:**

     

       120
       120
       +
       

     

       121
       121
       +
       ```json

     

       122
       122
       +
       {

     

       123
       123
       +
         "jsonrpc": "2.0",

     

       124
       124
       +
         "id": 2,

     

       125
       125
       +
         "result": {

     

       126
       126
       +
           "content": [

     

       127
       127
       +
             {

     

       128
       128
       +
               "type": "text",

     

       129
       129
       +
               "text": "Current weather in New York:\nTemperature: 72°F\nConditions: Partly cloudy"

     

       130
       130
       +
             }

     

       131
       131
       +
           ],

     

       132
       132
       +
           "isError": false

     

       133
       133
       +
         }

     

       134
       134
       +
       }

     

       135
       135
       +
       ```

     

       136
       136
       +
       

     

       137
       137
       +
       ### List Changed Notification

     

       138
       138
       +
       

     

       139
       139
       +
       When the list of available tools changes, servers that declared the `listChanged`

     

       140
       140
       +
       capability **SHOULD** send a notification:

     

       141
       141
       +
       

     

       142
       142
       +
       ```json

     

       143
       143
       +
       {

     

       144
       144
       +
         "jsonrpc": "2.0",

     

       145
       145
       +
         "method": "notifications/tools/list_changed"

     

       146
       146
       +
       }

     

       147
       147
       +
       ```

     

       148
       148
       +
       

     

       149
       149
       +
       ## Message Flow

     

       150
       150
       +
       

     

       151
       151
       +
       ```mermaid

     

       152
       152
       +
       sequenceDiagram

     

       153
       153
       +
           participant LLM

     

       154
       154
       +
           participant Client

     

       155
       155
       +
           participant Server

     

       156
       156
       +
       

     

       157
       157
       +
           Note over Client,Server: Discovery

     

       158
       158
       +
           Client->>Server: tools/list

     

       159
       159
       +
           Server-->>Client: List of tools

     

       160
       160
       +
       

     

       161
       161
       +
           Note over Client,LLM: Tool Selection

     

       162
       162
       +
           LLM->>Client: Select tool to use

     

       163
       163
       +
       

     

       164
       164
       +
           Note over Client,Server: Invocation

     

       165
       165
       +
           Client->>Server: tools/call

     

       166
       166
       +
           Server-->>Client: Tool result

     

       167
       167
       +
           Client->>LLM: Process result

     

       168
       168
       +
       

     

       169
       169
       +
           Note over Client,Server: Updates

     

       170
       170
       +
           Server--)Client: tools/list_changed

     

       171
       171
       +
           Client->>Server: tools/list

     

       172
       172
       +
           Server-->>Client: Updated tools

     

       173
       173
       +
       ```

     

       174
       174
       +
       

     

       175
       175
       +
       ## Data Types

     

       176
       176
       +
       

     

       177
       177
       +
       ### Tool

     

       178
       178
       +
       

     

       179
       179
       +
       A tool definition includes:

     

       180
       180
       +
       

     

       181
       181
       +
       - `name`: Unique identifier for the tool

     

       182
       182
       +
       - `description`: Human-readable description of functionality

     

       183
       183
       +
       - `inputSchema`: JSON Schema defining expected parameters

     

       184
       184
       +
       - `annotations`: optional properties describing tool behavior

     

       185
       185
       +
       

     

       186
       186
       +
       {{< callout type="warning" >}} For trust & safety and security, clients **MUST** consider

     

       187
       187
       +
       tool annotations to be untrusted unless they come from trusted servers. {{< /callout >}}

     

       188
       188
       +
       

     

       189
       189
       +
       ### Tool Result

     

       190
       190
       +
       

     

       191
       191
       +
       Tool results can contain multiple content items of different types:

     

       192
       192
       +
       

     

       193
       193
       +
       #### Text Content

     

       194
       194
       +
       

     

       195
       195
       +
       ```json

     

       196
       196
       +
       {

     

       197
       197
       +
         "type": "text",

     

       198
       198
       +
         "text": "Tool result text"

     

       199
       199
       +
       }

     

       200
       200
       +
       ```

     

       201
       201
       +
       

     

       202
       202
       +
       #### Image Content

     

       203
       203
       +
       

     

       204
       204
       +
       ```json

     

       205
       205
       +
       {

     

       206
       206
       +
         "type": "image",

     

       207
       207
       +
         "data": "base64-encoded-data",

     

       208
       208
       +
         "mimeType": "image/png"

     

       209
       209
       +
       }

     

       210
       210
       +
       ```

     

       211
       211
       +
       

     

       212
       212
       +
       #### Audio Content

     

       213
       213
       +
       

     

       214
       214
       +
       ```json

     

       215
       215
       +
       {

     

       216
       216
       +
         "type": "audio",

     

       217
       217
       +
         "data": "base64-encoded-audio-data",

     

       218
       218
       +
         "mimeType": "audio/wav"

     

       219
       219
       +
       }

     

       220
       220
       +
       ```

     

       221
       221
       +
       

     

       222
       222
       +
       #### Embedded Resources

     

       223
       223
       +
       

     

       224
       224
       +
       [Resources]({{< ref "resources" >}}) **MAY** be embedded, to provide additional context

     

       225
       225
       +
       or data, behind a URI that can be subscribed to or fetched again by the client later:

     

       226
       226
       +
       

     

       227
       227
       +
       ```json

     

       228
       228
       +
       {

     

       229
       229
       +
         "type": "resource",

     

       230
       230
       +
         "resource": {

     

       231
       231
       +
           "uri": "resource://example",

     

       232
       232
       +
           "mimeType": "text/plain",

     

       233
       233
       +
           "text": "Resource content"

     

       234
       234
       +
         }

     

       235
       235
       +
       }

     

       236
       236
       +
       ```

     

       237
       237
       +
       

     

       238
       238
       +
       ## Error Handling

     

       239
       239
       +
       

     

       240
       240
       +
       Tools use two error reporting mechanisms:

     

       241
       241
       +
       

     

       242
       242
       +
       1. **Protocol Errors**: Standard JSON-RPC errors for issues like:

     

       243
       243
       +
       

     

       244
       244
       +
          - Unknown tools

     

       245
       245
       +
          - Invalid arguments

     

       246
       246
       +
          - Server errors

     

       247
       247
       +
       

     

       248
       248
       +
       2. **Tool Execution Errors**: Reported in tool results with `isError: true`:

     

       249
       249
       +
          - API failures

     

       250
       250
       +
          - Invalid input data

     

       251
       251
       +
          - Business logic errors

     

       252
       252
       +
       

     

       253
       253
       +
       Example protocol error:

     

       254
       254
       +
       

     

       255
       255
       +
       ```json

     

       256
       256
       +
       {

     

       257
       257
       +
         "jsonrpc": "2.0",

     

       258
       258
       +
         "id": 3,

     

       259
       259
       +
         "error": {

     

       260
       260
       +
           "code": -32602,

     

       261
       261
       +
           "message": "Unknown tool: invalid_tool_name"

     

       262
       262
       +
         }

     

       263
       263
       +
       }

     

       264
       264
       +
       ```

     

       265
       265
       +
       

     

       266
       266
       +
       Example tool execution error:

     

       267
       267
       +
       

     

       268
       268
       +
       ```json

     

       269
       269
       +
       {

     

       270
       270
       +
         "jsonrpc": "2.0",

     

       271
       271
       +
         "id": 4,

     

       272
       272
       +
         "result": {

     

       273
       273
       +
           "content": [

     

       274
       274
       +
             {

     

       275
       275
       +
               "type": "text",

     

       276
       276
       +
               "text": "Failed to fetch weather data: API rate limit exceeded"

     

       277
       277
       +
             }

     

       278
       278
       +
           ],

     

       279
       279
       +
           "isError": true

     

       280
       280
       +
         }

     

       281
       281
       +
       }

     

       282
       282
       +
       ```

     

       283
       283
       +
       

     

       284
       284
       +
       ## Security Considerations

     

       285
       285
       +
       

     

       286
       286
       +
       1. Servers **MUST**:

     

       287
       287
       +
       

     

       288
       288
       +
          - Validate all tool inputs

     

       289
       289
       +
          - Implement proper access controls

     

       290
       290
       +
          - Rate limit tool invocations

     

       291
       291
       +
          - Sanitize tool outputs

     

       292
       292
       +
       

     

       293
       293
       +
       2. Clients **SHOULD**:

     

       294
       294
       +
          - Prompt for user confirmation on sensitive operations

     

       295
       295
       +
          - Show tool inputs to the user before calling the server, to avoid malicious or

     

       296
       296
       +
            accidental data exfiltration

     

       297
       297
       +
          - Validate tool results before passing to LLM

     

       298
       298
       +
          - Implement timeouts for tool calls

     

       299
       299
       +
          - Log tool usage for audit purposes

+278

spec/transports.md

···

       1
       1
       +
       ---

     

       2
       2
       +
       title: Transports

     

       3
       3
       +
       type: docs

     

       4
       4
       +
       weight: 10

     

       5
       5
       +
       ---

     

       6
       6
       +
       

     

       7
       7
       +
       {{< callout type="info" >}} **Protocol Revision**: 2025-03-26 {{< /callout >}}

     

       8
       8
       +
       

     

       9
       9
       +
       MCP uses JSON-RPC to encode messages. JSON-RPC messages **MUST** be UTF-8 encoded.

     

       10
       10
       +
       

     

       11
       11
       +
       The protocol currently defines two standard transport mechanisms for client-server

     

       12
       12
       +
       communication:

     

       13
       13
       +
       

     

       14
       14
       +
       1. [stdio](#stdio), communication over standard in and standard out

     

       15
       15
       +
       2. [Streamable HTTP](#streamable-http)

     

       16
       16
       +
       

     

       17
       17
       +
       Clients **SHOULD** support stdio whenever possible.

     

       18
       18
       +
       

     

       19
       19
       +
       It is also possible for clients and servers to implement

     

       20
       20
       +
       [custom transports](#custom-transports) in a pluggable fashion.

     

       21
       21
       +
       

     

       22
       22
       +
       ## stdio

     

       23
       23
       +
       

     

       24
       24
       +
       In the **stdio** transport:

     

       25
       25
       +
       

     

       26
       26
       +
       - The client launches the MCP server as a subprocess.

     

       27
       27
       +
       - The server reads JSON-RPC messages from its standard input (`stdin`) and sends messages

     

       28
       28
       +
         to its standard output (`stdout`).

     

       29
       29
       +
       - Messages may be JSON-RPC requests, notifications, responses—or a JSON-RPC

     

       30
       30
       +
         [batch](https://www.jsonrpc.org/specification#batch) containing one or more requests

     

       31
       31
       +
         and/or notifications.

     

       32
       32
       +
       - Messages are delimited by newlines, and **MUST NOT** contain embedded newlines.

     

       33
       33
       +
       - The server **MAY** write UTF-8 strings to its standard error (`stderr`) for logging

     

       34
       34
       +
         purposes. Clients **MAY** capture, forward, or ignore this logging.

     

       35
       35
       +
       - The server **MUST NOT** write anything to its `stdout` that is not a valid MCP message.

     

       36
       36
       +
       - The client **MUST NOT** write anything to the server's `stdin` that is not a valid MCP

     

       37
       37
       +
         message.

     

       38
       38
       +
       

     

       39
       39
       +
       ```mermaid

     

       40
       40
       +
       sequenceDiagram

     

       41
       41
       +
           participant Client

     

       42
       42
       +
           participant Server Process

     

       43
       43
       +
       

     

       44
       44
       +
           Client->>+Server Process: Launch subprocess

     

       45
       45
       +
           loop Message Exchange

     

       46
       46
       +
               Client->>Server Process: Write to stdin

     

       47
       47
       +
               Server Process->>Client: Write to stdout

     

       48
       48
       +
               Server Process--)Client: Optional logs on stderr

     

       49
       49
       +
           end

     

       50
       50
       +
           Client->>Server Process: Close stdin, terminate subprocess

     

       51
       51
       +
           deactivate Server Process

     

       52
       52
       +
       ```

     

       53
       53
       +
       

     

       54
       54
       +
       ## Streamable HTTP

     

       55
       55
       +
       

     

       56
       56
       +
       {{< callout type="info" >}} This replaces the [HTTP+SSE

     

       57
       57
       +
       transport]({{< ref "/specification/2024-11-05/basic/transports#http-with-sse" >}}) from

     

       58
       58
       +
       protocol version 2024-11-05. See the [backwards compatibility](#backwards-compatibility)

     

       59
       59
       +
       guide below. {{< /callout >}}

     

       60
       60
       +
       

     

       61
       61
       +
       In the **Streamable HTTP** transport, the server operates as an independent process that

     

       62
       62
       +
       can handle multiple client connections. This transport uses HTTP POST and GET requests.

     

       63
       63
       +
       Server can optionally make use of

     

       64
       64
       +
       [Server-Sent Events](https://en.wikipedia.org/wiki/Server-sent_events) (SSE) to stream

     

       65
       65
       +
       multiple server messages. This permits basic MCP servers, as well as more feature-rich

     

       66
       66
       +
       servers supporting streaming and server-to-client notifications and requests.

     

       67
       67
       +
       

     

       68
       68
       +
       The server **MUST** provide a single HTTP endpoint path (hereafter referred to as the

     

       69
       69
       +
       **MCP endpoint**) that supports both POST and GET methods. For example, this could be a

     

       70
       70
       +
       URL like `https://example.com/mcp`.

     

       71
       71
       +
       

     

       72
       72
       +
       ### Sending Messages to the Server

     

       73
       73
       +
       

     

       74
       74
       +
       Every JSON-RPC message sent from the client **MUST** be a new HTTP POST request to the

     

       75
       75
       +
       MCP endpoint.

     

       76
       76
       +
       

     

       77
       77
       +
       1. The client **MUST** use HTTP POST to send JSON-RPC messages to the MCP endpoint.

     

       78
       78
       +
       2. The client **MUST** include an `Accept` header, listing both `application/json` and

     

       79
       79
       +
          `text/event-stream` as supported content types.

     

       80
       80
       +
       3. The body of the POST request **MUST** be one of the following:

     

       81
       81
       +
          - A single JSON-RPC _request_, _notification_, or _response_

     

       82
       82
       +
          - An array [batching](https://www.jsonrpc.org/specification#batch) one or more

     

       83
       83
       +
            _requests and/or notifications_

     

       84
       84
       +
          - An array [batching](https://www.jsonrpc.org/specification#batch) one or more

     

       85
       85
       +
            _responses_

     

       86
       86
       +
       4. If the input consists solely of (any number of) JSON-RPC _responses_ or

     

       87
       87
       +
          _notifications_:

     

       88
       88
       +
          - If the server accepts the input, the server **MUST** return HTTP status code 202

     

       89
       89
       +
            Accepted with no body.

     

       90
       90
       +
          - If the server cannot accept the input, it **MUST** return an HTTP error status code

     

       91
       91
       +
            (e.g., 400 Bad Request). The HTTP response body **MAY** comprise a JSON-RPC _error

     

       92
       92
       +
            response_ that has no `id`.

     

       93
       93
       +
       5. If the input contains any number of JSON-RPC _requests_, the server **MUST** either

     

       94
       94
       +
          return `Content-Type: text/event-stream`, to initiate an SSE stream, or

     

       95
       95
       +
          `Content-Type: application/json`, to return one JSON object. The client **MUST**

     

       96
       96
       +
          support both these cases.

     

       97
       97
       +
       6. If the server initiates an SSE stream:

     

       98
       98
       +
          - The SSE stream **SHOULD** eventually include one JSON-RPC _response_ per each

     

       99
       99
       +
            JSON-RPC _request_ sent in the POST body. These _responses_ **MAY** be

     

       100
       100
       +
            [batched](https://www.jsonrpc.org/specification#batch).

     

       101
       101
       +
          - The server **MAY** send JSON-RPC _requests_ and _notifications_ before sending a

     

       102
       102
       +
            JSON-RPC _response_. These messages **SHOULD** relate to the originating client

     

       103
       103
       +
            _request_. These _requests_ and _notifications_ **MAY** be

     

       104
       104
       +
            [batched](https://www.jsonrpc.org/specification#batch).

     

       105
       105
       +
          - The server **SHOULD NOT** close the SSE stream before sending a JSON-RPC _response_

     

       106
       106
       +
            per each received JSON-RPC _request_, unless the [session](#session-management)

     

       107
       107
       +
            expires.

     

       108
       108
       +
          - After all JSON-RPC _responses_ have been sent, the server **SHOULD** close the SSE

     

       109
       109
       +
            stream.

     

       110
       110
       +
          - Disconnection **MAY** occur at any time (e.g., due to network conditions).

     

       111
       111
       +
            Therefore:

     

       112
       112
       +
            - Disconnection **SHOULD NOT** be interpreted as the client cancelling its request.

     

       113
       113
       +
            - To cancel, the client **SHOULD** explicitly send an MCP `CancelledNotification`.

     

       114
       114
       +
            - To avoid message loss due to disconnection, the server **MAY** make the stream

     

       115
       115
       +
              [resumable](#resumability-and-redelivery).

     

       116
       116
       +
       

     

       117
       117
       +
       ### Listening for Messages from the Server

     

       118
       118
       +
       

     

       119
       119
       +
       1. The client **MAY** issue an HTTP GET to the MCP endpoint. This can be used to open an

     

       120
       120
       +
          SSE stream, allowing the server to communicate to the client, without the client first

     

       121
       121
       +
          sending data via HTTP POST.

     

       122
       122
       +
       2. The client **MUST** include an `Accept` header, listing `text/event-stream` as a

     

       123
       123
       +
          supported content type.

     

       124
       124
       +
       3. The server **MUST** either return `Content-Type: text/event-stream` in response to

     

       125
       125
       +
          this HTTP GET, or else return HTTP 405 Method Not Allowed, indicating that the server

     

       126
       126
       +
          does not offer an SSE stream at this endpoint.

     

       127
       127
       +
       4. If the server initiates an SSE stream:

     

       128
       128
       +
          - The server **MAY** send JSON-RPC _requests_ and _notifications_ on the stream. These

     

       129
       129
       +
            _requests_ and _notifications_ **MAY** be

     

       130
       130
       +
            [batched](https://www.jsonrpc.org/specification#batch).

     

       131
       131
       +
          - These messages **SHOULD** be unrelated to any concurrently-running JSON-RPC

     

       132
       132
       +
            _request_ from the client.

     

       133
       133
       +
          - The server **MUST NOT** send a JSON-RPC _response_ on the stream **unless**

     

       134
       134
       +
            [resuming](#resumability-and-redelivery) a stream associated with a previous client

     

       135
       135
       +
            request.

     

       136
       136
       +
          - The server **MAY** close the SSE stream at any time.

     

       137
       137
       +
          - The client **MAY** close the SSE stream at any time.

     

       138
       138
       +
       

     

       139
       139
       +
       ### Multiple Connections

     

       140
       140
       +
       

     

       141
       141
       +
       1. The client **MAY** remain connected to multiple SSE streams simultaneously.

     

       142
       142
       +
       2. The server **MUST** send each of its JSON-RPC messages on only one of the connected

     

       143
       143
       +
          streams; that is, it **MUST NOT** broadcast the same message across multiple streams.

     

       144
       144
       +
          - The risk of message loss **MAY** be mitigated by making the stream

     

       145
       145
       +
            [resumable](#resumability-and-redelivery).

     

       146
       146
       +
       

     

       147
       147
       +
       ### Resumability and Redelivery

     

       148
       148
       +
       

     

       149
       149
       +
       To support resuming broken connections, and redelivering messages that might otherwise be

     

       150
       150
       +
       lost:

     

       151
       151
       +
       

     

       152
       152
       +
       1. Servers **MAY** attach an `id` field to their SSE events, as described in the

     

       153
       153
       +
          [SSE standard](https://html.spec.whatwg.org/multipage/server-sent-events.html#event-stream-interpretation).

     

       154
       154
       +
          - If present, the ID **MUST** be globally unique across all streams within that

     

       155
       155
       +
            [session](#session-management)—or all streams with that specific client, if session

     

       156
       156
       +
            management is not in use.

     

       157
       157
       +
       2. If the client wishes to resume after a broken connection, it **SHOULD** issue an HTTP

     

       158
       158
       +
          GET to the MCP endpoint, and include the

     

       159
       159
       +
          [`Last-Event-ID`](https://html.spec.whatwg.org/multipage/server-sent-events.html#the-last-event-id-header)

     

       160
       160
       +
          header to indicate the last event ID it received.

     

       161
       161
       +
          - The server **MAY** use this header to replay messages that would have been sent

     

       162
       162
       +
            after the last event ID, _on the stream that was disconnected_, and to resume the

     

       163
       163
       +
            stream from that point.

     

       164
       164
       +
          - The server **MUST NOT** replay messages that would have been delivered on a

     

       165
       165
       +
            different stream.

     

       166
       166
       +
       

     

       167
       167
       +
       In other words, these event IDs should be assigned by servers on a _per-stream_ basis, to

     

       168
       168
       +
       act as a cursor within that particular stream.

     

       169
       169
       +
       

     

       170
       170
       +
       ### Session Management

     

       171
       171
       +
       

     

       172
       172
       +
       An MCP "session" consists of logically related interactions between a client and a

     

       173
       173
       +
       server, beginning with the [initialization phase]({{< ref "lifecycle" >}}). To support

     

       174
       174
       +
       servers which want to establish stateful sessions:

     

       175
       175
       +
       

     

       176
       176
       +
       1. A server using the Streamable HTTP transport **MAY** assign a session ID at

     

       177
       177
       +
          initialization time, by including it in an `Mcp-Session-Id` header on the HTTP

     

       178
       178
       +
          response containing the `InitializeResult`.

     

       179
       179
       +
          - The session ID **SHOULD** be globally unique and cryptographically secure (e.g., a

     

       180
       180
       +
            securely generated UUID, a JWT, or a cryptographic hash).

     

       181
       181
       +
          - The session ID **MUST** only contain visible ASCII characters (ranging from 0x21 to

     

       182
       182
       +
            0x7E).

     

       183
       183
       +
       2. If an `Mcp-Session-Id` is returned by the server during initialization, clients using

     

       184
       184
       +
          the Streamable HTTP transport **MUST** include it in the `Mcp-Session-Id` header on

     

       185
       185
       +
          all of their subsequent HTTP requests.

     

       186
       186
       +
          - Servers that require a session ID **SHOULD** respond to requests without an

     

       187
       187
       +
            `Mcp-Session-Id` header (other than initialization) with HTTP 400 Bad Request.

     

       188
       188
       +
       3. The server **MAY** terminate the session at any time, after which it **MUST** respond

     

       189
       189
       +
          to requests containing that session ID with HTTP 404 Not Found.

     

       190
       190
       +
       4. When a client receives HTTP 404 in response to a request containing an

     

       191
       191
       +
          `Mcp-Session-Id`, it **MUST** start a new session by sending a new `InitializeRequest`

     

       192
       192
       +
          without a session ID attached.

     

       193
       193
       +
       5. Clients that no longer need a particular session (e.g., because the user is leaving

     

       194
       194
       +
          the client application) **SHOULD** send an HTTP DELETE to the MCP endpoint with the

     

       195
       195
       +
          `Mcp-Session-Id` header, to explicitly terminate the session.

     

       196
       196
       +
          - The server **MAY** respond to this request with HTTP 405 Method Not Allowed,

     

       197
       197
       +
            indicating that the server does not allow clients to terminate sessions.

     

       198
       198
       +
       

     

       199
       199
       +
       ### Sequence Diagram

     

       200
       200
       +
       

     

       201
       201
       +
       ```mermaid

     

       202
       202
       +
       sequenceDiagram

     

       203
       203
       +
           participant Client

     

       204
       204
       +
           participant Server

     

       205
       205
       +
       

     

       206
       206
       +
           note over Client, Server: initialization

     

       207
       207
       +
       

     

       208
       208
       +
           Client->>+Server: POST InitializeRequest

     

       209
       209
       +
           Server->>-Client: InitializeResponse<br>Mcp-Session-Id: 1868a90c...

     

       210
       210
       +
       

     

       211
       211
       +
           Client->>+Server: POST InitializedNotification<br>Mcp-Session-Id: 1868a90c...

     

       212
       212
       +
           Server->>-Client: 202 Accepted

     

       213
       213
       +
       

     

       214
       214
       +
           note over Client, Server: client requests

     

       215
       215
       +
           Client->>+Server: POST ... request ...<br>Mcp-Session-Id: 1868a90c...

     

       216
       216
       +
       

     

       217
       217
       +
           alt single HTTP response

     

       218
       218
       +
             Server->>Client: ... response ...

     

       219
       219
       +
           else server opens SSE stream

     

       220
       220
       +
             loop while connection remains open

     

       221
       221
       +
                 Server-)Client: ... SSE messages from server ...

     

       222
       222
       +
             end

     

       223
       223
       +
             Server-)Client: SSE event: ... response ...

     

       224
       224
       +
           end

     

       225
       225
       +
           deactivate Server

     

       226
       226
       +
       

     

       227
       227
       +
           note over Client, Server: client notifications/responses

     

       228
       228
       +
           Client->>+Server: POST ... notification/response ...<br>Mcp-Session-Id: 1868a90c...

     

       229
       229
       +
           Server->>-Client: 202 Accepted

     

       230
       230
       +
       

     

       231
       231
       +
           note over Client, Server: server requests

     

       232
       232
       +
           Client->>+Server: GET<br>Mcp-Session-Id: 1868a90c...

     

       233
       233
       +
           loop while connection remains open

     

       234
       234
       +
               Server-)Client: ... SSE messages from server ...

     

       235
       235
       +
           end

     

       236
       236
       +
           deactivate Server

     

       237
       237
       +
       

     

       238
       238
       +
       ```

     

       239
       239
       +
       

     

       240
       240
       +
       ### Backwards Compatibility

     

       241
       241
       +
       

     

       242
       242
       +
       Clients and servers can maintain backwards compatibility with the deprecated [HTTP+SSE

     

       243
       243
       +
       transport]({{< ref "/specification/2024-11-05/basic/transports#http-with-sse" >}}) (from

     

       244
       244
       +
       protocol version 2024-11-05) as follows:

     

       245
       245
       +
       

     

       246
       246
       +
       **Servers** wanting to support older clients should:

     

       247
       247
       +
       

     

       248
       248
       +
       - Continue to host both the SSE and POST endpoints of the old transport, alongside the

     

       249
       249
       +
         new "MCP endpoint" defined for the Streamable HTTP transport.

     

       250
       250
       +
         - It is also possible to combine the old POST endpoint and the new MCP endpoint, but

     

       251
       251
       +
           this may introduce unneeded complexity.

     

       252
       252
       +
       

     

       253
       253
       +
       **Clients** wanting to support older servers should:

     

       254
       254
       +
       

     

       255
       255
       +
       1. Accept an MCP server URL from the user, which may point to either a server using the

     

       256
       256
       +
          old transport or the new transport.

     

       257
       257
       +
       2. Attempt to POST an `InitializeRequest` to the server URL, with an `Accept` header as

     

       258
       258
       +
          defined above:

     

       259
       259
       +
          - If it succeeds, the client can assume this is a server supporting the new Streamable

     

       260
       260
       +
            HTTP transport.

     

       261
       261
       +
          - If it fails with an HTTP 4xx status code (e.g., 405 Method Not Allowed or 404 Not

     

       262
       262
       +
            Found):

     

       263
       263
       +
            - Issue a GET request to the server URL, expecting that this will open an SSE stream

     

       264
       264
       +
              and return an `endpoint` event as the first event.

     

       265
       265
       +
            - When the `endpoint` event arrives, the client can assume this is a server running

     

       266
       266
       +
              the old HTTP+SSE transport, and should use that transport for all subsequent

     

       267
       267
       +
              communication.

     

       268
       268
       +
       

     

       269
       269
       +
       ## Custom Transports

     

       270
       270
       +
       

     

       271
       271
       +
       Clients and servers **MAY** implement additional custom transport mechanisms to suit

     

       272
       272
       +
       their specific needs. The protocol is transport-agnostic and can be implemented over any

     

       273
       273
       +
       communication channel that supports bidirectional message exchange.

     

       274
       274
       +
       

     

       275
       275
       +
       Implementers who choose to support custom transports **MUST** ensure they preserve the

     

       276
       276
       +
       JSON-RPC message format and lifecycle requirements defined by MCP. Custom transports

     

       277
       277
       +
       **SHOULD** document their specific connection establishment and message exchange patterns

     

       278
       278
       +
       to aid interoperability.

Compare changes