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

-1

.gitignore

···

       1
       1
        
       jsonrpc.mli

     

       2
       2
        
       _build

     

       3
       3
        
       CLAUDE.md

     

       4
       4
       -
       *.install

.ocamlformat

This is a binary file and will not be displayed.

+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

+113 -68

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 =

     

       6
       7
        
         match json with

     

       7
       7
       -
         | `Assoc fields -> (

     

       8
       8
       -
             match List.assoc_opt name fields with

     

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

     

       10
       10
       -
             | _ ->

     

       11
       11
       -
                 raise

     

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

     

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

     

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

     

       14
       13
        
       

     

       15
       14
        
       (* Create a server *)

     

       16
       16
       -
       let server =

     

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

     

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

     

       19
       19
       -
         |> fun server ->

     

       20
       20
       -
         (* Set default capabilities *)

     

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

     

       22
       22
       -
           ~with_prompts:true ()

     

       15
       15
       +
       let server = create_server 

     

       16
       16
       +
         ~name:"OCaml MCP Capitalizer" 

     

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

     

       23
       37
        
       

     

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

     

       25
       25
       -
       let _ =

     

       26
       26
       -
         add_tool server ~name:"capitalize"

     

       27
       27
       -
           ~description:"Capitalizes the provided text"

     

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

     

       29
       29
       -
           ~schema_required:[ "text" ]

     

       30
       30
       -
           (fun args ->

     

       31
       31
       -
             try

     

       32
       32
       -
               let text = get_string_param args "text" in

     

       33
       33
       -
               let capitalized_text = String.uppercase_ascii text in

     

       34
       34
       -
               TextContent.yojson_of_t

     

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

     

       36
       36
       -
             with Failure msg ->

     

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

     

       38
       38
       -
               TextContent.yojson_of_t

     

       39
       39
       -
                 TextContent.

     

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

     

       39
       39
       +
       let _ = add_tool server

     

       40
       40
       +
         ~name:"capitalize"

     

       41
       41
       +
         ~description:"Capitalizes the provided text"

     

       42
       42
       +
         ~schema_properties:[

     

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

     

       44
       44
       +
         ]

     

       45
       45
       +
         ~schema_required:["text"]

     

       46
       46
       +
         (fun args ->

     

       47
       47
       +
           try

     

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

     

       49
       49
       +
             let capitalized_text = String.uppercase_ascii text in

     

       50
       50
       +
             TextContent.yojson_of_t TextContent.{

     

       51
       51
       +
               text = capitalized_text;

     

       52
       52
       +
               annotations = None

     

       53
       53
       +
             }

     

       54
       54
       +
           with

     

       55
       55
       +
           | Failure msg ->

     

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

     

       57
       57
       +
             TextContent.yojson_of_t TextContent.{

     

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

     

       59
       59
       +
               annotations = None

     

       60
       60
       +
             }

     

       61
       61
       +
         )

     

       41
       62
        
       

     

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

     

       43
       43
       -
       let _ =

     

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

     

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

     

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

     

       47
       47
       -
             match params with

     

       48
       48
       -
             | [ name ] ->

     

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

     

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

     

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

     

       64
       64
       +
       let _ = add_resource server

     

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

     

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

     

       67
       67
       +
         ~mime_type:"text/plain"

     

       68
       68
       +
         (fun params ->

     

       69
       69
       +
           match params with

     

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

     

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

     

       72
       72
       +
         )

     

       51
       73
        
       

     

       52
       74
        
       (* Define and register a prompt example *)

     

       53
       53
       -
       let _ =

     

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

     

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

     

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

     

       57
       57
       -
           (fun args ->

     

       58
       58
       -
             let text =

     

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

     

       60
       60
       -
             in

     

       61
       61
       -
             [

     

       62
       62
       -
               Prompt.

     

       63
       63
       -
                 {

     

       64
       64
       -
                   role = `User;

     

       65
       65
       -
                   content =

     

       66
       66
       -
                     Mcp.make_text_content

     

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

     

       68
       68
       -
                 };

     

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

     

       70
       70
       -
               Prompt.

     

       71
       71
       -
                 {

     

       72
       72
       -
                   role = `Assistant;

     

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

     

       74
       74
       -
                 };

     

       75
       75
       -
               Prompt.

     

       76
       76
       -
                 {

     

       77
       77
       -
                   role = `Assistant;

     

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

     

       79
       79
       -
                 };

     

       80
       80
       -
             ])

     

       75
       75
       +
       let _ = add_prompt server

     

       76
       76
       +
         ~name:"capitalize-prompt"

     

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

     

       78
       78
       +
         ~arguments:[

     

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

     

       80
       80
       +
         ]

     

       81
       81
       +
         (fun args ->

     

       82
       82
       +
           let text = 

     

       83
       83
       +
             try

     

       84
       84
       +
               List.assoc "text" args

     

       85
       85
       +
             with

     

       86
       86
       +
             | Not_found -> "No text provided"

     

       87
       87
       +
           in

     

       88
       88
       +
           [

     

       89
       89
       +
             Prompt.{ 

     

       90
       90
       +
               role = `User; 

     

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

     

       92
       92
       +
             };

     

       93
       93
       +
             Prompt.{ 

     

       94
       94
       +
               role = `User; 

     

       95
       95
       +
               content = make_text_content text

     

       96
       96
       +
             };

     

       97
       97
       +
             Prompt.{ 

     

       98
       98
       +
               role = `Assistant; 

     

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

     

       100
       100
       +
             };

     

       101
       101
       +
             Prompt.{ 

     

       102
       102
       +
               role = `Assistant; 

     

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

     

       104
       104
       +
             }

     

       105
       105
       +
           ]

     

       106
       106
       +
         )

     

       81
       107
        
       

     

       108
       108
       +
       (* Main function *)

     

       82
       109
        
       let () =

     

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

     

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

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 logs mcp mcp_server yojson eio_main eio))

     

       9
       9
       +
        (libraries mcp mcp_sdk mcp_server yojson unix)

     

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

     

       5
       11
        
       

     

       6
       12
        
       (executable

     

       7
       7
       -
        (name multimodal_sdk)

     

       8
       8
       -
        (modules multimodal_sdk)

     

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

     

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

     

       10
       17
        
       

     

       11
       18
        
       (executable

     

       12
       12
       -
        (name ocaml_eval_sdk)

     

       13
       13
       -
        (modes byte)

     

       14
       14
       -
        (modules ocaml_eval_sdk)

     

       15
       15
       -
        (flags

     

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

     

       17
       17
       -
        (libraries

     

       18
       18
       -
         logs

     

       19
       19
       -
         mcp

     

       20
       20
       -
         mcp_sdk

     

       21
       21
       -
         mcp_server

     

       22
       22
       -
         yojson

     

       23
       23
       -
         eio_main

     

       24
       24
       -
         eio

     

       25
       25
       -
         compiler-libs.toplevel))

     

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

     

       23
       23
       +
       

     

       24
       24
       +
       (executable

     

       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
       +
       

     

       30
       30
       +
       

     

       31
       31
       +
       (executable

     

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

     

       26
       36
        
       

     

       27
       37
        
       (executable

     

       28
       28
       -
        (name markdown_book_sdk)

     

       29
       29
       -
        (modules markdown_book_sdk)

     

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

-721

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 = { id : string; title : string; contents : string }

     

       6
       6
       -
       

     

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

     

       8
       8
       -
         let chapters =

     

       9
       9
       -
           [

     

       10
       10
       -
             {

     

       11
       11
       -
               id = "chapter1";

     

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

     

       13
       13
       -
               contents =

     

       14
       14
       -
                 {|

     

       15
       15
       -
       # Introduction to OCaml

     

       16
       16
       -
       

     

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

     

       18
       18
       -
       

     

       19
       19
       -
       ## Key Features

     

       20
       20
       -
       

     

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

     

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

     

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

     

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

     

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

     

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

     

       27
       27
       -
       

     

       28
       28
       -
       ## History

     

       29
       29
       -
       

     

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

     

       31
       31
       -
       

     

       32
       32
       -
       ## Why OCaml?

     

       33
       33
       -
       

     

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

     

       35
       35
       -
       

     

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

     

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

     

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

     

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

     

       40
       40
       -
       

     

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

     

       42
       42
       -
       |};

     

       43
       43
       -
             };

     

       44
       44
       -
             {

     

       45
       45
       -
               id = "chapter2";

     

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

     

       47
       47
       -
               contents =

     

       48
       48
       -
                 {|

     

       49
       49
       -
       # Basic Syntax and Types

     

       50
       50
       -
       

     

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

     

       52
       52
       -
       

     

       53
       53
       -
       ## Variables and Basic Types

     

       54
       54
       -
       

     

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

     

       56
       56
       -
       

     

       57
       57
       -
       ```ocaml

     

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

     

       59
       59
       -
       let x = 42

     

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

     

       61
       61
       -
       

     

       62
       62
       -
       (* OCaml has type inference *)

     

       63
       63
       -
       (* These are equivalent: *)

     

       64
       64
       -
       let x = 42

     

       65
       65
       -
       let x : int = 42

     

       66
       66
       -
       ```

     

       67
       67
       -
       

     

       68
       68
       -
       ## Basic Types

     

       69
       69
       -
       

     

       70
       70
       -
       - `int`: Integer numbers

     

       71
       71
       -
       - `float`: Floating-point numbers

     

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

     

       73
       73
       -
       - `char`: Single characters

     

       74
       74
       -
       - `string`: Text strings

     

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

     

       76
       76
       -
       

     

       77
       77
       -
       ## Functions

     

       78
       78
       -
       

     

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

     

       80
       80
       -
       

     

       81
       81
       -
       ```ocaml

     

       82
       82
       -
       (* A simple function *)

     

       83
       83
       -
       let add x y = x + y

     

       84
       84
       -
       

     

       85
       85
       -
       (* With type annotations *)

     

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

     

       87
       87
       -
       

     

       88
       88
       -
       (* Anonymous (lambda) function *)

     

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

     

       90
       90
       -
       

     

       91
       91
       -
       (* Partial application *)

     

       92
       92
       -
       let add5 = add 5

     

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

     

       94
       94
       -
       ```

     

       95
       95
       -
       

     

       96
       96
       -
       ## Control Flow

     

       97
       97
       -
       

     

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

     

       99
       99
       -
       

     

       100
       100
       -
       ```ocaml

     

       101
       101
       -
       (* If expression *)

     

       102
       102
       -
       let abs x =

     

       103
       103
       -
         if x < 0 then -x else x

     

       104
       104
       -
       

     

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

     

       106
       106
       -
       let describe_sign x =

     

       107
       107
       -
         match x with

     

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

     

       109
       109
       -
         | 0 -> "zero"

     

       110
       110
       -
         | _ -> "positive"

     

       111
       111
       -
       ```

     

       112
       112
       -
       

     

       113
       113
       -
       ## Recursion

     

       114
       114
       -
       

     

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

     

       116
       116
       -
       

     

       117
       117
       -
       ```ocaml

     

       118
       118
       -
       (* Recursive function *)

     

       119
       119
       -
       let rec factorial n =

     

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

     

       121
       121
       -
       

     

       122
       122
       -
       (* Mutually recursive functions *)

     

       123
       123
       -
       let rec is_even n =

     

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

     

       125
       125
       -
       and is_odd n =

     

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

     

       127
       127
       -
       ```

     

       128
       128
       -
       

     

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

     

       130
       130
       -
       |};

     

       131
       131
       -
             };

     

       132
       132
       -
             {

     

       133
       133
       -
               id = "chapter3";

     

       134
       134
       -
               title = "# Data Structures";

     

       135
       135
       -
               contents =

     

       136
       136
       -
                 {|

     

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

     

       274
       274
       -
       # Modules and Functors

     

       275
       275
       -
       

     

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

     

       277
       277
       -
       

     

       278
       278
       -
       ## Basic Modules

     

       279
       279
       -
       

     

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

     

       281
       281
       -
       

     

       282
       282
       -
       ```ocaml

     

       283
       283
       -
       (* Defining a module *)

     

       284
       284
       -
       module Math = struct

     

       285
       285
       -
         let pi = 3.14159

     

       286
       286
       -
         let square x = x *. x

     

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

     

       288
       288
       -
       end

     

       289
       289
       -
       

     

       290
       290
       -
       (* Using a module *)

     

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

     

       292
       292
       -
       ```

     

       293
       293
       -
       

     

       294
       294
       -
       ## Module Signatures

     

       295
       295
       -
       

     

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

     

       297
       297
       -
       

     

       298
       298
       -
       ```ocaml

     

       299
       299
       -
       (* Defining a signature *)

     

       300
       300
       -
       module type MATH = sig

     

       301
       301
       -
         val pi : float

     

       302
       302
       -
         val square : float -> float

     

       303
       303
       -
         val cube : float -> float

     

       304
       304
       -
       end

     

       305
       305
       -
       

     

       306
       306
       -
       (* Implementing a signature *)

     

       307
       307
       -
       module Math : MATH = struct

     

       308
       308
       -
         let pi = 3.14159

     

       309
       309
       -
         let square x = x *. x

     

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

     

       311
       311
       -
       

     

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

     

       313
       313
       -
         let private_helper x = x +. 1.0

     

       314
       314
       -
       end

     

       315
       315
       -
       ```

     

       316
       316
       -
       

     

       317
       317
       -
       ## Functors

     

       318
       318
       -
       

     

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

     

       320
       320
       -
       

     

       321
       321
       -
       ```ocaml

     

       322
       322
       -
       (* Module signature for collections *)

     

       323
       323
       -
       module type COLLECTION = sig

     

       324
       324
       -
         type 'a t

     

       325
       325
       -
         val empty : 'a t

     

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

     

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

     

       328
       328
       -
       end

     

       329
       329
       -
       

     

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

     

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

     

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

     

       333
       333
       -
       

     

       334
       334
       -
         let empty = []

     

       335
       335
       -
       

     

       336
       336
       -
         let rec add x lst =

     

       337
       337
       -
           match lst with

     

       338
       338
       -
           | [] -> [x]

     

       339
       339
       -
           | y :: ys ->

     

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

     

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

     

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

     

       343
       343
       -
               else y :: add x ys

     

       344
       344
       -
       

     

       345
       345
       -
         let rec mem x lst =

     

       346
       346
       -
           match lst with

     

       347
       347
       -
           | [] -> false

     

       348
       348
       -
           | y :: ys ->

     

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

     

       350
       350
       -
               if c = 0 then true

     

       351
       351
       -
               else if c < 0 then false

     

       352
       352
       -
               else mem x ys

     

       353
       353
       -
       end

     

       354
       354
       -
       

     

       355
       355
       -
       (* Creating an integer set *)

     

       356
       356
       -
       module IntElement = struct

     

       357
       357
       -
         type t = int

     

       358
       358
       -
         let compare = Int.compare

     

       359
       359
       -
       end

     

       360
       360
       -
       

     

       361
       361
       -
       module IntSet = MakeSet(IntElement)

     

       362
       362
       -
       

     

       363
       363
       -
       (* Using the set *)

     

       364
       364
       -
       let my_set = IntSet.empty

     

       365
       365
       -
                    |> IntSet.add 3

     

       366
       366
       -
                    |> IntSet.add 1

     

       367
       367
       -
                    |> IntSet.add 4

     

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

     

       369
       369
       -
       

     

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

     

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

     

       372
       372
       -
       ```

     

       373
       373
       -
       

     

       374
       374
       -
       ## First-Class Modules

     

       375
       375
       -
       

     

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

     

       377
       377
       -
       

     

       378
       378
       -
       ```ocaml

     

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

     

       380
       380
       -
       module type NUMBER = sig

     

       381
       381
       -
         type t

     

       382
       382
       -
         val zero : t

     

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

     

       384
       384
       -
         val to_string : t -> string

     

       385
       385
       -
       end

     

       386
       386
       -
       

     

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

     

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

     

       389
       389
       -
         type t = int

     

       390
       390
       -
         let zero = 0

     

       391
       391
       -
         let add = (+)

     

       392
       392
       -
         let to_string = string_of_int

     

       393
       393
       -
       end

     

       394
       394
       -
       

     

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

     

       396
       396
       -
         type t = float

     

       397
       397
       -
         let zero = 0.0

     

       398
       398
       -
         let add = (+.)

     

       399
       399
       -
         let to_string = string_of_float

     

       400
       400
       -
       end

     

       401
       401
       -
       

     

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

     

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

     

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

     

       405
       405
       -
         N.to_string sum

     

       406
       406
       -
       

     

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

     

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

     

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

     

       410
       410
       -
       ```

     

       411
       411
       -
       

     

       412
       412
       -
       ## Open and Include

     

       413
       413
       -
       

     

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

     

       415
       415
       -
       

     

       416
       416
       -
       ```ocaml

     

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

     

       418
       418
       -
       let area =

     

       419
       419
       -
         let open Math in

     

       420
       420
       -
         pi *. square 2.0

     

       421
       421
       -
       

     

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

     

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

     

       424
       424
       -
       

     

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

     

       426
       426
       -
       module ExtendedMath = struct

     

       427
       427
       -
         include Math

     

       428
       428
       -
         let tau = 2.0 *. pi

     

       429
       429
       -
         let circumference r = tau *. r

     

       430
       430
       -
       end

     

       431
       431
       -
       ```

     

       432
       432
       -
       

     

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

     

       434
       434
       -
       |};

     

       435
       435
       -
             };

     

       436
       436
       -
             {

     

       437
       437
       -
               id = "chapter5";

     

       438
       438
       -
               title = "# Advanced Features";

     

       439
       439
       -
               contents =

     

       440
       440
       -
                 {|

     

       441
       441
       -
       # Advanced Features

     

       442
       442
       -
       

     

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

     

       444
       444
       -
       

     

       445
       445
       -
       ## Polymorphic Variants

     

       446
       446
       -
       

     

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

     

       448
       448
       -
       

     

       449
       449
       -
       ```ocaml

     

       450
       450
       -
       (* Using polymorphic variants directly *)

     

       451
       451
       -
       let weekend = `Saturday | `Sunday

     

       452
       452
       -
       let is_weekend day =

     

       453
       453
       -
         match day with

     

       454
       454
       -
         | `Saturday | `Sunday -> true

     

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

     

       456
       456
       -
       

     

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

     

       458
       458
       -
       let shape_area = function

     

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

     

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

     

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

     

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

     

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

     

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

     

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

     

       466
       466
       -
       ```

     

       467
       467
       -
       

     

       468
       468
       -
       ## Objects and Classes

     

       469
       469
       -
       

     

       470
       470
       -
       OCaml supports object-oriented programming:

     

       471
       471
       -
       

     

       472
       472
       -
       ```ocaml

     

       473
       473
       -
       (* Simple class definition *)

     

       474
       474
       -
       class point x_init y_init =

     

       475
       475
       -
         object (self)

     

       476
       476
       -
           val mutable x = x_init

     

       477
       477
       -
           val mutable y = y_init

     

       478
       478
       -
       

     

       479
       479
       -
           method get_x = x

     

       480
       480
       -
           method get_y = y

     

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

     

       482
       482
       -
           method distance_from_origin =

     

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

     

       484
       484
       -
       

     

       485
       485
       -
           (* Private method *)

     

       486
       486
       -
           method private to_string =

     

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

     

       488
       488
       -
       

     

       489
       489
       -
           (* Calling another method *)

     

       490
       490
       -
           method print = print_endline self#to_string

     

       491
       491
       -
         end

     

       492
       492
       -
       

     

       493
       493
       -
       (* Using a class *)

     

       494
       494
       -
       let p = new point 3 4

     

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

     

       496
       496
       -
       let d = p#distance_from_origin

     

       497
       497
       -
       ```

     

       498
       498
       -
       

     

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

     

       500
       500
       -
       

     

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

     

       502
       502
       -
       

     

       503
       503
       -
       ```ocaml

     

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

     

       505
       505
       -
       type _ expr =

     

       506
       506
       -
         | Int : int -> int expr

     

       507
       507
       -
         | Bool : bool -> bool expr

     

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

     

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

     

       510
       510
       -
       

     

       511
       511
       -
       (* Type-safe evaluation *)

     

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

     

       513
       513
       -
         | Int n -> n

     

       514
       514
       -
         | Bool b -> b

     

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

     

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

     

       517
       517
       -
       

     

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

     

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

     

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

     

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

     

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

     

       523
       523
       -
       ```

     

       524
       524
       -
       

     

       525
       525
       -
       ## Type Extensions

     

       526
       526
       -
       

     

       527
       527
       -
       OCaml allows extending existing types:

     

       528
       528
       -
       

     

       529
       529
       -
       ```ocaml

     

       530
       530
       -
       (* Original type *)

     

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

     

       532
       532
       -
       

     

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

     

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

     

       535
       535
       -
       

     

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

     

       537
       537
       -
       let area = function

     

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

     

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

     

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

     

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

     

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

     

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

     

       544
       544
       -
       ```

     

       545
       545
       -
       

     

       546
       546
       -
       ## Effects and Effect Handlers

     

       547
       547
       -
       

     

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

     

       549
       549
       -
       

     

       550
       550
       -
       ```ocaml

     

       551
       551
       -
       (* Defining an effect *)

     

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

     

       553
       553
       -
       

     

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

     

       555
       555
       -
       let prompt_user () =

     

       556
       556
       -
         Effect.Deep.try_with

     

       557
       557
       -
           (fun () ->

     

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

     

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

     

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

     

       561
       561
       -
               match effect with

     

       562
       562
       -
               | Ask prompt -> fun k ->

     

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

     

       564
       564
       -
                   let response = read_line () in

     

       565
       565
       -
                   k response

     

       566
       566
       -
               | _ -> None }

     

       567
       567
       -
       ```

     

       568
       568
       -
       

     

       569
       569
       -
       ## Higher-Ranked Polymorphism

     

       570
       570
       -
       

     

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

     

       572
       572
       -
       

     

       573
       573
       -
       ```ocaml

     

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

     

       575
       575
       -
       let apply_to_all_types f =

     

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

     

       577
       577
       -
         [

     

       578
       578
       -
           magic_f 42;

     

       579
       579
       -
           magic_f "hello";

     

       580
       580
       -
           magic_f 3.14;

     

       581
       581
       -
           magic_f true;

     

       582
       582
       -
         ]

     

       583
       583
       -
       

     

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

     

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

     

       586
       586
       -
       ```

     

       587
       587
       -
       

     

       588
       588
       -
       ## Metaprogramming with PPX

     

       589
       589
       -
       

     

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

     

       591
       591
       -
       

     

       592
       592
       -
       ```ocaml

     

       593
       593
       -
       (* With ppx_deriving *)

     

       594
       594
       -
       type person = {

     

       595
       595
       -
         name: string;

     

       596
       596
       -
         age: int;

     

       597
       597
       -
         email: string option;

     

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

     

       599
       599
       -
       

     

       600
       600
       -
       (* With ppx_sexp_conv *)

     

       601
       601
       -
       type config = {

     

       602
       602
       -
         server: string;

     

       603
       603
       -
         port: int;

     

       604
       604
       -
         timeout: float;

     

       605
       605
       -
       } [@@deriving sexp]

     

       606
       606
       -
       

     

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

     

       608
       608
       -
       let computation =

     

       609
       609
       -
         [%m.let

     

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

     

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

     

       612
       612
       -
           return (x + y)

     

       613
       613
       -
         ]

     

       614
       614
       -
       ```

     

       615
       615
       -
       

     

       616
       616
       -
       ## Modules for Advanced Typing

     

       617
       617
       -
       

     

       618
       618
       -
       Using modules to encode complex type relationships:

     

       619
       619
       -
       

     

       620
       620
       -
       ```ocaml

     

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

     

       622
       622
       -
       module SafeString : sig

     

       623
       623
       -
         type 'a t

     

       624
       624
       -
       

     

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

     

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

     

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

     

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

     

       629
       629
       -
       

     

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

     

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

     

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

     

       633
       633
       -
       

     

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

     

       635
       635
       -
         val length : _ t -> int

     

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

     

       637
       637
       -
       end = struct

     

       638
       638
       -
         type 'a t = string

     

       639
       639
       -
       

     

       640
       640
       -
         let of_raw s = s

     

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

     

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

     

       643
       643
       -
       

     

       644
       644
       -
         let to_html s = s

     

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

     

       646
       646
       -
       

     

       647
       647
       -
         let length = String.length

     

       648
       648
       -
         let concat s1 s2 = s1 ^ s2

     

       649
       649
       -
       end

     

       650
       650
       -
       ```

     

       651
       651
       -
       

     

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

     

       653
       653
       -
       |};

     

       654
       654
       -
             };

     

       655
       655
       -
           ]

     

       656
       656
       -
       

     

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

     

       658
       658
       -
         let get_by_id id =

     

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

     

       660
       660
       -
       

     

       661
       661
       -
         (* Get chapter titles *)

     

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

     

       663
       663
       -
       end

     

       664
       664
       -
       

     

       665
       665
       -
       (* Create a server *)

     

       666
       666
       -
       let server =

     

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

     

       668
       668
       -
         |> fun server ->

     

       669
       669
       -
         (* Set default capabilities *)

     

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

     

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

     

       672
       672
       -
       

     

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

     

       674
       674
       -
       let _ =

     

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

     

       676
       676
       -
           ~name:"Chapter Resource"

     

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

     

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

     

       679
       679
       -
             match params with

     

       680
       680
       -
             | [ id ] -> (

     

       681
       681
       -
                 match BookChapter.get_by_id id with

     

       682
       682
       -
                 | Some chapter -> chapter.contents

     

       683
       683
       -
                 | None ->

     

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

     

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

     

       686
       686
       -
       

     

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

     

       688
       688
       -
       let _ =

     

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

     

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

     

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

     

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

     

       693
       693
       -
             let toc =

     

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

     

       695
       695
       -
               ^ (List.mapi

     

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

     

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

     

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

     

       699
       699
       -
                        (* Remove "# " prefix *)

     

       700
       700
       -
                        id)

     

       701
       701
       -
                    titles

     

       702
       702
       -
                 |> String.concat "")

     

       703
       703
       -
             in

     

       704
       704
       -
             toc)

     

       705
       705
       -
       

     

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

     

       707
       707
       -
       let _ =

     

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

     

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

     

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

     

       711
       711
       -
             let chapter_contents =

     

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

     

       713
       713
       -
             in

     

       714
       714
       -
             let content =

     

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

     

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

     

       717
       717
       -
             in

     

       718
       718
       -
             content)

     

       719
       719
       -
       

     

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

     

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

-433

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

     

       10
       10
       -
                 raise

     

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

     

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

     

       13
       13
       -
       

     

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

     

       15
       15
       -
       let get_int_param json name =

     

       16
       16
       -
         match json with

     

       17
       17
       -
         | `Assoc fields -> (

     

       18
       18
       -
             match List.assoc_opt name fields with

     

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

     

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

     

       21
       21
       -
             | _ ->

     

       22
       22
       -
                 raise

     

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

     

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

     

       25
       25
       -
       

     

       26
       26
       -
       (* Base64 encoding - simplified version *)

     

       27
       27
       -
       module Base64 = struct

     

       28
       28
       -
         let encode_char idx =

     

       29
       29
       -
           "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/".[idx]

     

       30
       30
       -
       

     

       31
       31
       -
         let encode s =

     

       32
       32
       -
           let len = String.length s in

     

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

     

       34
       34
       -
       

     

       35
       35
       -
           let rec loop i j =

     

       36
       36
       -
             if i >= len then j

     

       37
       37
       -
             else

     

       38
       38
       -
               let n =

     

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

     

       40
       40
       -
                 let n =

     

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

     

       42
       42
       -
                 in

     

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

     

       44
       44
       -
               in

     

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

     

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

     

       47
       47
       -
               Bytes.set result (j + 2)

     

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

     

       49
       49
       -
               Bytes.set result (j + 3)

     

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

     

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

     

       52
       52
       -
           in

     

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

     

       54
       54
       -
       end

     

       55
       55
       -
       

     

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

     

       57
       57
       -
       let generate_random_image width height =

     

       58
       58
       -
         (* Ensure dimensions are reasonable *)

     

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

     

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

     

       61
       61
       -
       

     

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

     

       63
       63
       -
         let buf = Buffer.create 1024 in

     

       64
       64
       -
       

     

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

     

       66
       66
       -
         Buffer.add_string buf "GIF89a";

     

       67
       67
       -
       

     

       68
       68
       -
         (* Logical Screen Descriptor *)

     

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

     

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

     

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

     

       72
       72
       -
       

     

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

     

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

     

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

     

       76
       76
       -
       

     

       77
       77
       -
         (* Packed fields - 1 byte:

     

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

     

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

     

       80
       80
       -
            Sort Flag - 1 bit (0)

     

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

     

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

     

       83
       83
       -
       

     

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

     

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

     

       86
       86
       -
       

     

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

     

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

     

       89
       89
       -
       

     

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

     

       91
       91
       -
         (* Simple 8-color palette *)

     

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

     

       93
       93
       -
         (* White (0) *)

     

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

     

       95
       95
       -
         (* Red (1) *)

     

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

     

       97
       97
       -
         (* Green (2) *)

     

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

     

       99
       99
       -
         (* Blue (3) *)

     

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

     

       101
       101
       -
         (* Yellow (4) *)

     

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

     

       103
       103
       -
         (* Magenta (5) *)

     

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

     

       105
       105
       -
         (* Cyan (6) *)

     

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

     

       107
       107
       -
       

     

       108
       108
       -
         (* Black (7) *)

     

       109
       109
       -
       

     

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

     

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

     

       112
       112
       -
         (* Extension Introducer *)

     

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

     

       114
       114
       -
         (* Graphic Control Label *)

     

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

     

       116
       116
       -
         (* Block Size *)

     

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

     

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

     

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

     

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

     

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

     

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

     

       123
       123
       -
         (* Transparent color index *)

     

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

     

       125
       125
       -
       

     

       126
       126
       -
         (* Block terminator *)

     

       127
       127
       -
       

     

       128
       128
       -
         (* Image Descriptor *)

     

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

     

       130
       130
       -
         (* Image Separator *)

     

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

     

       132
       132
       -
         (* Left position - 2 bytes *)

     

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

     

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

     

       135
       135
       -
         (* Top position - 2 bytes *)

     

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

     

       137
       137
       -
       

     

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

     

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

     

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

     

       141
       141
       -
       

     

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

     

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

     

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

     

       145
       145
       -
       

     

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

     

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

     

       148
       148
       -
       

     

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

     

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

     

       151
       151
       -
       

     

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

     

       153
       153
       -
       

     

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

     

       155
       155
       -
         let step = width / 8 in

     

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

     

       157
       157
       -
       

     

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

     

       159
       159
       -
         (* Start with Clear code *)

     

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

     

       161
       161
       -
       

     

       162
       162
       -
         (* Clear code 8 *)

     

       163
       163
       -
       

     

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

     

       165
       165
       -
         for y = 0 to height - 1 do

     

       166
       166
       -
           for x = 0 to width - 1 do

     

       167
       167
       -
             (* Checkerboard pattern with different colors *)

     

       168
       168
       -
             let color =

     

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

     

       170
       170
       -
               else 1 (* Red *)

     

       171
       171
       -
             in

     

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

     

       173
       173
       -
           done

     

       174
       174
       -
         done;

     

       175
       175
       -
       

     

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

     

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

     

       178
       178
       -
       

     

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

     

       180
       180
       -
         let data = Buffer.contents image_data in

     

       181
       181
       -
         let data_len = String.length data in

     

       182
       182
       -
         let pos = ref 0 in

     

       183
       183
       -
       

     

       184
       184
       -
         while !pos < data_len do

     

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

     

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

     

       187
       187
       -
           for i = 0 to chunk_size - 1 do

     

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

     

       189
       189
       -
           done;

     

       190
       190
       -
           pos := !pos + chunk_size

     

       191
       191
       -
         done;

     

       192
       192
       -
       

     

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

     

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

     

       195
       195
       -
       

     

       196
       196
       -
         (* GIF Trailer *)

     

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

     

       198
       198
       -
       

     

       199
       199
       -
         (* Base64 encode the GIF data *)

     

       200
       200
       -
         Base64.encode (Buffer.contents buf)

     

       201
       201
       -
       

     

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

     

       203
       203
       -
       let write_int32_le buf n =

     

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

     

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

     

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

     

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

     

       208
       208
       -
       

     

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

     

       210
       210
       -
       let write_int16_le buf n =

     

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

     

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

     

       213
       213
       -
       

     

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

     

       215
       215
       -
       let generate_sine_wave_audio frequency duration =

     

       216
       216
       -
         (* WAV header *)

     

       217
       217
       -
         let sample_rate = 8000 in

     

       218
       218
       -
         let num_samples = sample_rate * duration in

     

       219
       219
       -
         let header_buf = Buffer.create 44 in

     

       220
       220
       -
       

     

       221
       221
       -
         (* Fill WAV header properly *)

     

       222
       222
       -
         Buffer.add_string header_buf "RIFF";

     

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

     

       224
       224
       -
         (* File size minus 8 *)

     

       225
       225
       -
         Buffer.add_string header_buf "WAVE";

     

       226
       226
       -
       

     

       227
       227
       -
         (* Format chunk *)

     

       228
       228
       -
         Buffer.add_string header_buf "fmt ";

     

       229
       229
       -
         write_int32_le header_buf 16;

     

       230
       230
       -
         (* Format chunk size *)

     

       231
       231
       -
         write_int16_le header_buf 1;

     

       232
       232
       -
         (* PCM format *)

     

       233
       233
       -
         write_int16_le header_buf 1;

     

       234
       234
       -
         (* Mono *)

     

       235
       235
       -
         write_int32_le header_buf sample_rate;

     

       236
       236
       -
         (* Sample rate *)

     

       237
       237
       -
         write_int32_le header_buf (sample_rate * 2);

     

       238
       238
       -
         (* Byte rate *)

     

       239
       239
       -
         write_int16_le header_buf 2;

     

       240
       240
       -
         (* Block align *)

     

       241
       241
       -
         write_int16_le header_buf 16;

     

       242
       242
       -
       

     

       243
       243
       -
         (* Bits per sample *)

     

       244
       244
       -
       

     

       245
       245
       -
         (* Data chunk *)

     

       246
       246
       -
         Buffer.add_string header_buf "data";

     

       247
       247
       -
         write_int32_le header_buf (num_samples * 2);

     

       248
       248
       -
       

     

       249
       249
       -
         (* Data size *)

     

       250
       250
       -
       

     

       251
       251
       -
         (* Generate sine wave samples *)

     

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

     

       253
       253
       -
         let amplitude = 16384.0 in

     

       254
       254
       -
         (* 16-bit with headroom *)

     

       255
       255
       -
       

     

       256
       256
       -
         for i = 0 to num_samples - 1 do

     

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

     

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

     

       259
       259
       -
           let sample = int_of_float value in

     

       260
       260
       -
       

     

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

     

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

     

       263
       263
       -
           write_int16_le samples_buf sample

     

       264
       264
       -
         done;

     

       265
       265
       -
       

     

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

     

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

     

       268
       268
       -
         Base64.encode wav_data

     

       269
       269
       -
       

     

       270
       270
       -
       (* Create a server *)

     

       271
       271
       -
       let server =

     

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

     

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

     

       274
       274
       -
         |> fun server ->

     

       275
       275
       -
         (* Set default capabilities *)

     

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

     

       277
       277
       -
           ~with_prompts:true ()

     

       278
       278
       -
       

     

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

     

       280
       280
       -
       let _ =

     

       281
       281
       -
         add_tool server ~name:"multimodal_demo"

     

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

     

       283
       283
       -
           ~schema_properties:

     

       284
       284
       -
             [

     

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

     

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

     

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

     

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

     

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

     

       290
       290
       -
             ]

     

       291
       291
       -
           ~schema_required:[ "message" ]

     

       292
       292
       -
           (fun args ->

     

       293
       293
       -
             try

     

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

     

       295
       295
       -
               let message = get_string_param args "message" in

     

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

     

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

     

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

     

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

     

       300
       300
       -
       

     

       301
       301
       -
               (* Generate image and audio data *)

     

       302
       302
       -
               let image_data = generate_random_image width height in

     

       303
       303
       -
               let audio_data =

     

       304
       304
       -
                 generate_sine_wave_audio (float_of_int frequency) duration

     

       305
       305
       -
               in

     

       306
       306
       -
       

     

       307
       307
       -
               (* Create a multimodal tool result *)

     

       308
       308
       -
               Tool.create_tool_result

     

       309
       309
       -
                 [

     

       310
       310
       -
                   Mcp.make_text_content message;

     

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

     

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

     

       313
       313
       -
                 ]

     

       314
       314
       -
                 ~is_error:false

     

       315
       315
       -
             with Failure msg ->

     

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

     

       317
       317
       -
               Tool.create_tool_result

     

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

     

       319
       319
       -
                 ~is_error:true)

     

       320
       320
       -
       

     

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

     

       322
       322
       -
       let _ =

     

       323
       323
       -
         add_tool server ~name:"generate_image"

     

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

     

       325
       325
       -
           ~schema_properties:

     

       326
       326
       -
             [

     

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

     

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

     

       329
       329
       -
             ]

     

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

     

       331
       331
       -
           (fun args ->

     

       332
       332
       -
             try

     

       333
       333
       -
               let width = get_int_param args "width" in

     

       334
       334
       -
               let height = get_int_param args "height" in

     

       335
       335
       -
       

     

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

     

       337
       337
       -
                 Tool.create_tool_result

     

       338
       338
       -
                   [

     

       339
       339
       -
                     Mcp.make_text_content

     

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

     

       341
       341
       -
                   ]

     

       342
       342
       -
                   ~is_error:true

     

       343
       343
       -
               else

     

       344
       344
       -
                 let image_data = generate_random_image width height in

     

       345
       345
       -
                 Tool.create_tool_result

     

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

     

       347
       347
       -
                   ~is_error:false

     

       348
       348
       -
             with Failure msg ->

     

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

     

       350
       350
       -
               Tool.create_tool_result

     

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

     

       352
       352
       -
                 ~is_error:true)

     

       353
       353
       -
       

     

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

     

       355
       355
       -
       let _ =

     

       356
       356
       -
         add_tool server ~name:"generate_audio"

     

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

     

       358
       358
       -
           ~schema_properties:

     

       359
       359
       -
             [

     

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

     

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

     

       362
       362
       -
             ]

     

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

     

       364
       364
       -
           (fun args ->

     

       365
       365
       -
             try

     

       366
       366
       -
               let frequency = get_int_param args "frequency" in

     

       367
       367
       -
               let duration = get_int_param args "duration" in

     

       368
       368
       -
       

     

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

     

       370
       370
       -
                 Tool.create_tool_result

     

       371
       371
       -
                   [

     

       372
       372
       -
                     Mcp.make_text_content

     

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

     

       374
       374
       -
                   ]

     

       375
       375
       -
                   ~is_error:true

     

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

     

       377
       377
       -
                 Tool.create_tool_result

     

       378
       378
       -
                   [

     

       379
       379
       -
                     Mcp.make_text_content

     

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

     

       381
       381
       -
                   ]

     

       382
       382
       -
                   ~is_error:true

     

       383
       383
       -
               else

     

       384
       384
       -
                 let audio_data =

     

       385
       385
       -
                   generate_sine_wave_audio (float_of_int frequency) duration

     

       386
       386
       -
                 in

     

       387
       387
       -
                 Tool.create_tool_result

     

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

     

       389
       389
       -
                   ~is_error:false

     

       390
       390
       -
             with Failure msg ->

     

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

     

       392
       392
       -
               Tool.create_tool_result

     

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

     

       394
       394
       -
                 ~is_error:true)

     

       395
       395
       -
       

     

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

     

       397
       397
       -
       let _ =

     

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

     

       399
       399
       -
           ~name:"Multimodal Greeting"

     

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

     

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

     

       402
       402
       -
             match params with

     

       403
       403
       -
             | [ name ] ->

     

       404
       404
       -
                 let greeting =

     

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

     

       406
       406
       -
                     name

     

       407
       407
       -
                 in

     

       408
       408
       -
                 let image_data = generate_random_image 128 128 in

     

       409
       409
       -
                 let audio_data = generate_sine_wave_audio 440.0 1 in

     

       410
       410
       -
       

     

       411
       411
       -
                 Printf.sprintf

     

       412
       412
       -
                   {|

     

       413
       413
       -
               {

     

       414
       414
       -
                 "greeting": "%s",

     

       415
       415
       -
                 "image": {

     

       416
       416
       -
                   "data": "%s",

     

       417
       417
       -
                   "mimeType": "image/gif"

     

       418
       418
       -
                 },

     

       419
       419
       -
                 "audio": {

     

       420
       420
       -
                   "data": "%s",

     

       421
       421
       -
                   "mimeType": "audio/wav"

     

       422
       422
       -
                 }

     

       423
       423
       -
               }

     

       424
       424
       -
             |}

     

       425
       425
       -
                   greeting image_data audio_data

     

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

     

       427
       427
       -
       

     

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

     

       429
       429
       -
       let () =

     

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

     

       431
       431
       -
         Random.self_init ();

     

       432
       432
       -
         (* Initialize random generator *)

     

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

-161

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 =

     

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

     

       51
       51
       -
           else

     

       52
       52
       -
             `Assoc

     

       53
       53
       -
               [

     

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

     

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

     

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

     

       57
       57
       -
               ]

     

       58
       58
       -
         with e ->

     

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

     

       60
       60
       -
           let error_msg =

     

       61
       61
       -
             match e with

     

       62
       62
       -
             | Syntaxerr.Error err ->

     

       63
       63
       -
                 let msg =

     

       64
       64
       -
                   match err with

     

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

     

       66
       66
       -
                   | Syntaxerr.Expecting _ ->

     

       67
       67
       -
                       "Syntax error: Expecting a different token"

     

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

     

       69
       69
       -
                   | Syntaxerr.Applicative_path _ ->

     

       70
       70
       -
                       "Syntax error: Invalid applicative path"

     

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

     

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

     

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

     

       74
       74
       -
                 in

     

       75
       75
       -
                 msg

     

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

     

       77
       77
       -
                 let msg =

     

       78
       78
       -
                   match err with

     

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

     

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

     

       81
       81
       -
                   | Lexer.Unterminated_comment _ ->

     

       82
       82
       -
                       "Lexer error: Unterminated comment"

     

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

     

       84
       84
       -
                   | Lexer.Unterminated_string_in_comment _ ->

     

       85
       85
       -
                       "Lexer error: Unterminated string in comment"

     

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

     

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

     

       88
       88
       -
                 in

     

       89
       89
       -
                 msg

     

       90
       90
       -
             | _ -> Printexc.to_string e

     

       91
       91
       -
           in

     

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

     

       93
       93
       -
       

     

       94
       94
       -
       (* Create evaluation server *)

     

       95
       95
       -
       let server =

     

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

     

       107
       107
       -
           let _ = initialize_toploop () in

     

       108
       108
       -
           toplevel_initialized := true

     

       109
       109
       -
       

     

       110
       110
       -
       (* Register eval tool *)

     

       111
       111
       -
       let _ =

     

       112
       112
       -
         add_tool server ~name:"ocaml_eval"

     

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

     

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

     

       115
       115
       -
           ~schema_required:[ "code" ]

     

       116
       116
       -
           (fun args ->

     

       117
       117
       -
             ensure_toploop_initialized ();

     

       118
       118
       -
       

     

       119
       119
       -
             try

     

       120
       120
       -
               (* Extract code parameter *)

     

       121
       121
       -
               let code = get_string_param args "code" in

     

       122
       122
       -
       

     

       123
       123
       -
               (* Execute the code *)

     

       124
       124
       -
               let result = evaluate_phrase code in

     

       125
       125
       -
       

     

       126
       126
       -
               (* Return formatted result *)

     

       127
       127
       -
               let success =

     

       128
       128
       -
                 match result with

     

       129
       129
       -
                 | `Assoc fields -> (

     

       130
       130
       -
                     match List.assoc_opt "success" fields with

     

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

     

       132
       132
       -
                     | _ -> false)

     

       133
       133
       -
                 | _ -> false

     

       134
       134
       -
               in

     

       135
       135
       -
       

     

       136
       136
       -
               let output =

     

       137
       137
       -
                 match result with

     

       138
       138
       -
                 | `Assoc fields -> (

     

       139
       139
       -
                     match List.assoc_opt "output" fields with

     

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

     

       141
       141
       -
                     | _ -> (

     

       142
       142
       -
                         match List.assoc_opt "error" fields with

     

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

     

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

     

       145
       145
       -
                 | _ -> "Unknown result"

     

       146
       146
       -
               in

     

       147
       147
       -
       

     

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

     

       149
       149
       -
               Tool.create_tool_result

     

       150
       150
       -
                 [ Mcp.make_text_content output ]

     

       151
       151
       -
                 ~is_error:(not success)

     

       152
       152
       -
             with Failure msg ->

     

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

     

       154
       154
       -
               Tool.create_tool_result

     

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

     

       156
       156
       -
                 ~is_error:true)

     

       157
       157
       -
       

     

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

     

       159
       159
       -
       let () =

     

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

     

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

-20

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

     

       18
       18
       -
         cohttp-eio

     

       19
       19
       -
         eio_main

     

       20
       20
       -
         eio

     

       21
       21
       -
         logs))

+11 -22

lib/dune

···

       1
       1
        
       (library

     

       2
       2
       -
        (name mcp)

     

       3
       3
       -
        (public_name mcp)

     

       4
       4
       -
        (libraries jsonrpc unix yojson)

     

       5
       5
       -
        (modules mcp))

     

       2
       2
       +
         (name mcp)

     

       3
       3
       +
         (libraries jsonrpc unix yojson)

     

       4
       4
       +
         (modules mcp))

     

       6
       5
        
       

     

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

     

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

     

       7
       7
       +
         (name mcp_sdk)

     

       8
       8
       +
         (libraries mcp jsonrpc unix yojson)

     

       9
       9
       +
         (modules mcp_sdk)

     

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

     

       14
       11
        
       

     

       15
       12
        
       (library

     

       16
       16
       -
        (name mcp_sdk)

     

       17
       17
       -
        (public_name mcp.sdk)

     

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

     

       19
       19
       -
        (modules mcp_sdk)

     

       20
       20
       -
        (flags

     

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

     

       22
       22
       -
       

     

       23
       23
       -
       (library

     

       24
       24
       -
        (name mcp_server)

     

       25
       25
       -
        (public_name mcp.server)

     

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

     

       27
       27
       -
        (modules mcp_server))

     

       13
       13
       +
         (name mcp_server)

     

       14
       14
       +
         (libraries mcp mcp_sdk jsonrpc unix yojson)

     

       15
       15
       +
         (modules mcp_server)

     

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

+899 -655

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

     

       18
       18
       -
           |> Option.map (function

     

       19
       19
       -
                | `String s -> s

     

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

     

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

     

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

     

       58
       58
       -
                 expected_value

     

       59
       59
       -
       end

     

       60
       60
       -
       

     

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

     

       3
       3
       +
       (* Standard error codes *)

     

       62
       4
        
       module ErrorCode = struct

     

       63
       63
       -
         type t =

     

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

     

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

     

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

     

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

     

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

     

       69
       69
       -
           | ResourceNotFound

     

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

     

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

     

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

     

       73
       73
       -
       

     

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

     

       75
       75
       -
         let to_int = function

     

       76
       76
       -
           | ParseError -> -32700

     

       77
       77
       -
           | InvalidRequest -> -32600

     

       78
       78
       -
           | MethodNotFound -> -32601

     

       79
       79
       -
           | InvalidParams -> -32602

     

       80
       80
       -
           | InternalError -> -32603

     

       81
       81
       -
           | ResourceNotFound -> -32002

     

       82
       82
       -
           | AuthRequired -> -32001

     

       83
       83
       -
           | CustomError code -> code

     

       84
       84
       -
       

     

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

     

       86
       86
       -
         let to_message = function

     

       87
       87
       -
           | ParseError -> "Parse error"

     

       88
       88
       -
           | InvalidRequest -> "Invalid Request"

     

       89
       89
       -
           | MethodNotFound -> "Method not found"

     

       90
       90
       -
           | InvalidParams -> "Invalid params"

     

       91
       91
       -
           | InternalError -> "Internal error"

     

       92
       92
       -
           | ResourceNotFound -> "Resource not found"

     

       93
       93
       -
           | AuthRequired -> "Authentication required"

     

       94
       94
       -
           | CustomError _ -> "Error"

     

       95
       95
       -
       end

     

       96
       96
       -
       

     

       97
       97
       -
       (* Protocol method types *)

     

       98
       98
       -
       module Method = struct

     

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

     

       100
       100
       -
         type t =

     

       101
       101
       -
           (* Initialization and lifecycle methods *)

     

       102
       102
       -
           | Initialize

     

       103
       103
       -
           | Initialized

     

       104
       104
       -
           (* Resource methods *)

     

       105
       105
       -
           | ResourcesList

     

       106
       106
       -
           | ResourcesRead

     

       107
       107
       -
           | ResourceTemplatesList

     

       108
       108
       -
           | ResourcesSubscribe

     

       109
       109
       -
           | ResourcesListChanged

     

       110
       110
       -
           | ResourcesUpdated

     

       111
       111
       -
           (* Tool methods *)

     

       112
       112
       -
           | ToolsList

     

       113
       113
       -
           | ToolsCall

     

       114
       114
       -
           | ToolsListChanged

     

       115
       115
       -
           (* Prompt methods *)

     

       116
       116
       -
           | PromptsList

     

       117
       117
       -
           | PromptsGet

     

       118
       118
       -
           | PromptsListChanged

     

       119
       119
       -
           (* Progress notifications *)

     

       120
       120
       -
           | Progress

     

       121
       121
       -
       

     

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

     

       123
       123
       -
         let to_string = function

     

       124
       124
       -
           | Initialize -> "initialize"

     

       125
       125
       -
           | Initialized -> "notifications/initialized"

     

       126
       126
       -
           | ResourcesList -> "resources/list"

     

       127
       127
       -
           | ResourcesRead -> "resources/read"

     

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

     

       129
       129
       -
           | ResourcesSubscribe -> "resources/subscribe"

     

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

     

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

     

       132
       132
       -
           | ToolsList -> "tools/list"

     

       133
       133
       -
           | ToolsCall -> "tools/call"

     

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

     

       135
       135
       -
           | PromptsList -> "prompts/list"

     

       136
       136
       -
           | PromptsGet -> "prompts/get"

     

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

     

       138
       138
       -
           | Progress -> "notifications/progress"

     

       139
       139
       -
       

     

       140
       140
       -
         (* Convert string to method type *)

     

       141
       141
       -
         let of_string = function

     

       142
       142
       -
           | "initialize" -> Initialize

     

       143
       143
       -
           | "notifications/initialized" -> Initialized

     

       144
       144
       -
           | "resources/list" -> ResourcesList

     

       145
       145
       -
           | "resources/read" -> ResourcesRead

     

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

     

       147
       147
       -
           | "resources/subscribe" -> ResourcesSubscribe

     

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

     

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

     

       150
       150
       -
           | "tools/list" -> ToolsList

     

       151
       151
       -
           | "tools/call" -> ToolsCall

     

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

     

       153
       153
       -
           | "prompts/list" -> PromptsList

     

       154
       154
       -
           | "prompts/get" -> PromptsGet

     

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

     

       156
       156
       -
           | "notifications/progress" -> Progress

     

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

     

       158
       13
        
       end

     

       159
       14
        
       

     

       160
       15
        
       (* Common types *)

     
···

       162
       17
        
       module Role = struct

     

       163
       18
        
         type t = [ `User | `Assistant ]

     

       164
       19
        
       

     

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

     

       20
       20
       +
         let to_string = function

     

       21
       21
       +
           | `User -> "user"

     

       22
       22
       +
           | `Assistant -> "assistant"

     

       166
       23
        
       

     

       167
       24
        
         let of_string = function

     

       168
       25
        
           | "user" -> `User

     

       169
       26
        
           | "assistant" -> `Assistant

     

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

     

       27
       27
       +
           | s -> raise (Json.Of_json ("Unknown role: " ^ s, `String s))

     

       171
       28
        
       

     

       172
       29
        
         let yojson_of_t t = `String (to_string t)

     

       173
       173
       -
       

     

       174
       30
        
         let t_of_yojson = function

     

       175
       31
        
           | `String s -> of_string s

     

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

     

       32
       32
       +
           | j -> raise (Json.Of_json ("Expected string for Role", j))

     

       177
       33
        
       end

     

       178
       34
        
       

     

       179
       35
        
       module ProgressToken = struct

     
···

       188
       44
        
         type t = string

     

       189
       45
        
       

     

       190
       46
        
         let yojson_of_t t = `String t

     

       191
       191
       -
       

     

       192
       47
        
         let t_of_yojson = function

     

       193
       48
        
           | `String s -> s

     

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

     

       49
       49
       +
           | j -> raise (Json.Of_json ("Expected string for Cursor", j))

     

       195
       50
        
       end

     

       196
       51
        
       

     

       197
       52
        
       (* Annotations *)

     

       198
       53
        
       

     

       199
       54
        
       module Annotated = struct

     

       200
       200
       -
         type t = { annotations : annotation option }

     

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

     

       55
       55
       +
         type t = {

     

       56
       56
       +
           annotations: annotation option;

     

       57
       57
       +
         }

     

       58
       58
       +
         and annotation = {

     

       59
       59
       +
           audience: Role.t list option;

     

       60
       60
       +
           priority: float option;

     

       61
       61
       +
         }

     

       202
       62
        
       

     

       203
       63
        
         let yojson_of_annotation { audience; priority } =

     

       204
       64
        
           let assoc = [] in

     

       205
       205
       -
           let assoc =

     

       206
       206
       -
             match audience with

     

       207
       207
       -
             | Some audience ->

     

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

     

       65
       65
       +
           let assoc = match audience with

     

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

     

       209
       67
        
             | None -> assoc

     

       210
       68
        
           in

     

       211
       211
       -
           let assoc =

     

       212
       212
       -
             match priority with

     

       69
       69
       +
           let assoc = match priority with

     

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

     

       214
       71
        
             | None -> assoc

     

       215
       72
        
           in

     
···

       217
       74
        
       

     

       218
       75
        
         let annotation_of_yojson = function

     

       219
       76
        
           | `Assoc fields ->

     

       220
       220
       -
               let audience =

     

       221
       221
       -
                 List.assoc_opt "audience" fields

     

       222
       222
       -
                 |> Option.map (function

     

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

     

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

     

       225
       225
       -
               in

     

       226
       226
       -
               let priority =

     

       227
       227
       -
                 List.assoc_opt "priority" fields

     

       228
       228
       -
                 |> Option.map (function

     

       229
       229
       -
                      | `Float f -> f

     

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

     

       231
       231
       -
               in

     

       232
       232
       -
               { audience; priority }

     

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

     

       77
       77
       +
             let audience = List.assoc_opt "audience" fields |> Option.map (function

     

       78
       78
       +
               | `List items -> List.map Role.t_of_yojson items

     

       79
       79
       +
               | j -> raise (Json.Of_json ("Expected list for audience", j))

     

       80
       80
       +
             ) in

     

       81
       81
       +
             let priority = List.assoc_opt "priority" fields |> Option.map (function

     

       82
       82
       +
               | `Float f -> f

     

       83
       83
       +
               | j -> raise (Json.Of_json ("Expected float for priority", j))

     

       84
       84
       +
             ) in

     

       85
       85
       +
             { audience; priority }

     

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

     

       234
       87
        
       

     

       235
       88
        
         let yojson_of_t { annotations } =

     

       236
       89
        
           match annotations with

     

       237
       237
       -
           | Some annotations ->

     

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

     

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

     

       239
       91
        
           | None -> `Assoc []

     

       240
       92
        
       

     

       241
       93
        
         let t_of_yojson = function

     

       242
       94
        
           | `Assoc fields ->

     

       243
       243
       -
               let annotations =

     

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

     

       245
       245
       -
               in

     

       246
       246
       -
               { annotations }

     

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

     

       95
       95
       +
             let annotations = List.assoc_opt "annotations" fields |> Option.map annotation_of_yojson in

     

       96
       96
       +
             { annotations }

     

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

     

       248
       98
        
       end

     

       249
       99
        
       

     

       250
       100
        
       (* Content types *)

     

       251
       101
        
       

     

       252
       102
        
       module TextContent = struct

     

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

     

       103
       103
       +
         type t = {

     

       104
       104
       +
           text: string;

     

       105
       105
       +
           annotations: Annotated.annotation option;

     

       106
       106
       +
         }

     

       254
       107
        
       

     

       255
       108
        
         let yojson_of_t { text; annotations } =

     

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

     

       257
       257
       -
           let assoc =

     

       258
       258
       -
             match annotations with

     

       259
       259
       -
             | Some annotations ->

     

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

     

       109
       109
       +
           let assoc = [

     

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

     

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

     

       112
       112
       +
           ] in

     

       113
       113
       +
           let assoc = match annotations with

     

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

     

       261
       115
        
             | None -> assoc

     

       262
       116
        
           in

     

       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;

     

       269
       269
       -
               let annotations =

     

       270
       270
       -
                 List.assoc_opt "annotations" fields

     

       271
       271
       -
                 |> Option.map Annotated.annotation_of_yojson

     

       272
       272
       -
               in

     

       273
       273
       -
               { text; annotations }

     

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

     

       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

     

       129
       129
       +
             let annotations = List.assoc_opt "annotations" fields |> Option.map Annotated.annotation_of_yojson in

     

       130
       130
       +
             { text; annotations }

     

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

     

       275
       132
        
       end

     

       276
       133
        
       

     

       277
       134
        
       module ImageContent = struct

     

       278
       135
        
         type t = {

     

       279
       279
       -
           data : string;

     

       280
       280
       -
           mime_type : string;

     

       281
       281
       -
           annotations : Annotated.annotation option;

     

       136
       136
       +
           data: string;

     

       137
       137
       +
           mime_type: string;

     

       138
       138
       +
           annotations: Annotated.annotation option;

     

       282
       139
        
         }

     

       283
       140
        
       

     

       284
       141
        
         let yojson_of_t { data; mime_type; annotations } =

     

       285
       285
       -
           let assoc =

     

       286
       286
       -
             [

     

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

     

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

     

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

     

       290
       290
       -
             ]

     

       291
       291
       -
           in

     

       292
       292
       -
           let assoc =

     

       293
       293
       -
             match annotations with

     

       294
       294
       -
             | Some annotations ->

     

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

     

       142
       142
       +
           let assoc = [

     

       143
       143
       +
             ("data", `String data);

     

       144
       144
       +
             ("mimeType", `String mime_type);

     

       145
       145
       +
             ("type", `String "image");

     

       146
       146
       +
           ] in

     

       147
       147
       +
           let assoc = match annotations with

     

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

     

       296
       149
        
             | None -> assoc

     

       297
       150
        
           in

     

       298
       151
        
           `Assoc assoc

     

       299
       152
        
       

     

       300
       153
        
         let t_of_yojson = function

     

       301
       301
       -
           | `Assoc fields as json ->

     

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

     

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

     

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

     

       305
       305
       -
               let annotations =

     

       306
       306
       -
                 List.assoc_opt "annotations" fields

     

       307
       307
       -
                 |> Option.map Annotated.annotation_of_yojson

     

       308
       308
       -
               in

     

       309
       309
       -
               { data; mime_type; annotations }

     

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

     

       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

     

       167
       167
       +
             let annotations = List.assoc_opt "annotations" fields |> Option.map Annotated.annotation_of_yojson in

     

       168
       168
       +
             { data; mime_type; annotations }

     

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

     

       311
       170
        
       end

     

       312
       171
        
       

     

       313
       172
        
       module AudioContent = struct

     

       314
       173
        
         type t = {

     

       315
       315
       -
           data : string;

     

       316
       316
       -
           mime_type : string;

     

       317
       317
       -
           annotations : Annotated.annotation option;

     

       174
       174
       +
           data: string;

     

       175
       175
       +
           mime_type: string;

     

       176
       176
       +
           annotations: Annotated.annotation option;

     

       318
       177
        
         }

     

       319
       178
        
       

     

       320
       179
        
         let yojson_of_t { data; mime_type; annotations } =

     

       321
       321
       -
           let assoc =

     

       322
       322
       -
             [

     

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

     

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

     

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

     

       326
       326
       -
             ]

     

       327
       327
       -
           in

     

       328
       328
       -
           let assoc =

     

       329
       329
       -
             match annotations with

     

       330
       330
       -
             | Some annotations ->

     

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

     

       180
       180
       +
           let assoc = [

     

       181
       181
       +
             ("data", `String data);

     

       182
       182
       +
             ("mimeType", `String mime_type);

     

       183
       183
       +
             ("type", `String "audio");

     

       184
       184
       +
           ] in

     

       185
       185
       +
           let assoc = match annotations with

     

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

     

       332
       187
        
             | None -> assoc

     

       333
       188
        
           in

     

       334
       189
        
           `Assoc assoc

     

       335
       190
        
       

     

       336
       191
        
         let t_of_yojson = function

     

       337
       337
       -
           | `Assoc fields as json ->

     

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

     

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

     

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

     

       341
       341
       -
               let annotations =

     

       342
       342
       -
                 List.assoc_opt "annotations" fields

     

       343
       343
       -
                 |> Option.map Annotated.annotation_of_yojson

     

       344
       344
       -
               in

     

       345
       345
       -
               { data; mime_type; annotations }

     

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

     

       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

     

       205
       205
       +
             let annotations = List.assoc_opt "annotations" fields |> Option.map Annotated.annotation_of_yojson in

     

       206
       206
       +
             { data; mime_type; annotations }

     

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

     

       347
       208
        
       end

     

       348
       209
        
       

     

       349
       210
        
       module ResourceContents = struct

     

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

     

       211
       211
       +
         type t = {

     

       212
       212
       +
           uri: string;

     

       213
       213
       +
           mime_type: string option;

     

       214
       214
       +
         }

     

       351
       215
        
       

     

       352
       216
        
         let yojson_of_t { uri; mime_type } =

     

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

     

       354
       354
       -
           let assoc =

     

       355
       355
       -
             match mime_type with

     

       217
       217
       +
           let assoc = [

     

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

     

       219
       219
       +
           ] in

     

       220
       220
       +
           let assoc = match mime_type with

     

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

     

       357
       222
        
             | None -> assoc

     

       358
       223
        
           in

     

       359
       224
        
           `Assoc assoc

     

       360
       225
        
       

     

       361
       226
        
         let t_of_yojson = function

     

       362
       362
       -
           | `Assoc fields as json ->

     

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

     

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

     

       365
       365
       -
               { uri; mime_type }

     

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

     

       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

     

       236
       236
       +
             { uri; mime_type }

     

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

     

       367
       238
        
       end

     

       368
       239
        
       

     

       369
       240
        
       module TextResourceContents = struct

     

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

     

       241
       241
       +
         type t = {

     

       242
       242
       +
           uri: string;

     

       243
       243
       +
           text: string;

     

       244
       244
       +
           mime_type: string option;

     

       245
       245
       +
         }

     

       371
       246
        
       

     

       372
       247
        
         let yojson_of_t { uri; text; mime_type } =

     

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

     

       374
       374
       -
           let assoc =

     

       375
       375
       -
             match mime_type with

     

       248
       248
       +
           let assoc = [

     

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

     

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

     

       251
       251
       +
           ] in

     

       252
       252
       +
           let assoc = match mime_type with

     

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

     

       377
       254
        
             | None -> assoc

     

       378
       255
        
           in

     

       379
       256
        
           `Assoc assoc

     

       380
       257
        
       

     

       381
       258
        
         let t_of_yojson = function

     

       382
       382
       -
           | `Assoc fields as json ->

     

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

     

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

     

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

     

       386
       386
       -
               { uri; text; mime_type }

     

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

     

       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

     

       272
       272
       +
             { uri; text; mime_type }

     

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

     

       388
       274
        
       end

     

       389
       275
        
       

     

       390
       276
        
       module BlobResourceContents = struct

     

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

     

       277
       277
       +
         type t = {

     

       278
       278
       +
           uri: string;

     

       279
       279
       +
           blob: string;

     

       280
       280
       +
           mime_type: string option;

     

       281
       281
       +
         }

     

       392
       282
        
       

     

       393
       283
        
         let yojson_of_t { uri; blob; mime_type } =

     

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

     

       395
       395
       -
           let assoc =

     

       396
       396
       -
             match mime_type with

     

       284
       284
       +
           let assoc = [

     

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

     

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

     

       287
       287
       +
           ] in

     

       288
       288
       +
           let assoc = match mime_type with

     

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

     

       398
       290
        
             | None -> assoc

     

       399
       291
        
           in

     

       400
       292
        
           `Assoc assoc

     

       401
       293
        
       

     

       402
       294
        
         let t_of_yojson = function

     

       403
       403
       -
           | `Assoc fields as json ->

     

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

     

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

     

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

     

       407
       407
       -
               { uri; blob; mime_type }

     

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

     

       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

     

       308
       308
       +
             { uri; blob; mime_type }

     

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

     

       409
       310
        
       end

     

       410
       311
        
       

     

       411
       312
        
       module EmbeddedResource = struct

     

       412
       313
        
         type t = {

     

       413
       413
       -
           resource :

     

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

     

       415
       415
       -
           annotations : Annotated.annotation option;

     

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

     

       315
       315
       +
           annotations: Annotated.annotation option;

     

       416
       316
        
         }

     

       417
       317
        
       

     

       418
       318
        
         let yojson_of_t { resource; annotations } =

     

       419
       419
       -
           let resource_json =

     

       420
       420
       -
             match resource with

     

       319
       319
       +
           let resource_json = match resource with

     

       421
       320
        
             | `Text txt -> TextResourceContents.yojson_of_t txt

     

       422
       321
        
             | `Blob blob -> BlobResourceContents.yojson_of_t blob

     

       423
       322
        
           in

     

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

     

       425
       425
       -
           let assoc =

     

       426
       426
       -
             match annotations with

     

       427
       427
       -
             | Some annotations ->

     

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

     

       323
       323
       +
           let assoc = [

     

       324
       324
       +
             ("resource", resource_json);

     

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

     

       326
       326
       +
           ] in

     

       327
       327
       +
           let assoc = match annotations with

     

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

     

       429
       329
        
             | None -> assoc

     

       430
       330
        
           in

     

       431
       331
        
           `Assoc assoc

     

       432
       332
        
       

     

       433
       333
        
         let t_of_yojson = function

     

       434
       434
       -
           | `Assoc fields as json ->

     

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

     

       436
       436
       -
               let resource_fields =

     

       437
       437
       -
                 match List.assoc_opt "resource" fields with

     

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

     

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

     

       440
       440
       -
               in

     

       441
       441
       -
               let resource =

     

       442
       442
       -
                 if List.mem_assoc "text" resource_fields then

     

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

     

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

     

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

     

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

     

       338
       338
       +
             in

     

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

     

       446
       345
        
                 else

     

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

     

       448
       448
       -
               in

     

       449
       449
       -
               let annotations =

     

       450
       450
       -
                 List.assoc_opt "annotations" fields

     

       451
       451
       -
                 |> Option.map Annotated.annotation_of_yojson

     

       452
       452
       -
               in

     

       453
       453
       -
               { resource; annotations }

     

       454
       454
       -
           | j -> Util.json_error "Expected object for EmbeddedResource" j

     

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

     

       348
       348
       +
             in

     

       349
       349
       +
             let annotations = List.assoc_opt "annotations" fields |> Option.map Annotated.annotation_of_yojson in

     

       350
       350
       +
             { resource; annotations }

     

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

     

       455
       389
        
       end

     

       456
       390
        
       

     

       457
       457
       -
       type content =

     

       391
       391
       +
       type content = 

     

       458
       392
        
         | Text of TextContent.t

     

       459
       393
        
         | Image of ImageContent.t

     

       460
       394
        
         | Audio of AudioContent.t

     
···

       467
       401
        
         | Resource r -> EmbeddedResource.yojson_of_t r

     

       468
       402
        
       

     

       469
       403
        
       let content_of_yojson = function

     

       470
       470
       -
         | `Assoc fields as json -> (

     

       471
       471
       -
             match List.assoc_opt "type" fields with

     

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

     

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

     

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

     

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

     

       476
       476
       -
                 Resource (EmbeddedResource.t_of_yojson json)

     

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

     

       478
       478
       -
         | j -> Util.json_error "Expected object for content" j

     

       404
       404
       +
         | `Assoc fields ->

     

       405
       405
       +
           (match List.assoc_opt "type" fields with

     

       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

     

       479
       770
        
       

     

       480
       771
        
       (* Message types *)

     

       481
       772
        
       

     

       482
       773
        
       module PromptMessage = struct

     

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

     

       774
       774
       +
         type t = {

     

       775
       775
       +
           role: Role.t;

     

       776
       776
       +
           content: content;

     

       777
       777
       +
         }

     

       484
       778
        
       

     

       485
       779
        
         let yojson_of_t { role; content } =

     

       486
       486
       -
           `Assoc

     

       487
       487
       -
             [

     

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

     

       489
       489
       -
             ]

     

       780
       780
       +
           `Assoc [

     

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

     

       782
       782
       +
             ("content", yojson_of_content content);

     

       783
       783
       +
           ]

     

       490
       784
        
       

     

       491
       785
        
         let t_of_yojson = function

     

       492
       492
       -
           | `Assoc fields as json ->

     

       493
       493
       -
               let role =

     

       494
       494
       -
                 match List.assoc_opt "role" fields with

     

       495
       495
       -
                 | Some json -> Role.t_of_yojson json

     

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

     

       497
       497
       -
               in

     

       498
       498
       -
               let content =

     

       499
       499
       -
                 match List.assoc_opt "content" fields with

     

       500
       500
       -
                 | Some json -> content_of_yojson json

     

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

     

       502
       502
       -
               in

     

       503
       503
       -
               { role; content }

     

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

     

       786
       786
       +
           | `Assoc fields ->

     

       787
       787
       +
             let role = match List.assoc_opt "role" fields with

     

       788
       788
       +
               | Some json -> Role.t_of_yojson json

     

       789
       789
       +
               | None -> raise (Json.Of_json ("Missing role field", `Assoc fields))

     

       790
       790
       +
             in

     

       791
       791
       +
             let content = match List.assoc_opt "content" fields with

     

       792
       792
       +
               | Some json -> content_of_yojson json

     

       793
       793
       +
               | None -> raise (Json.Of_json ("Missing content field", `Assoc fields))

     

       794
       794
       +
             in

     

       795
       795
       +
             { role; content }

     

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

     

       505
       797
        
       end

     

       506
       798
        
       

     

       507
       799
        
       module SamplingMessage = struct

     

       508
       800
        
         type t = {

     

       509
       509
       -
           role : Role.t;

     

       510
       510
       -
           content :

     

       511
       511
       -
             [ `Text of TextContent.t

     

       512
       512
       -
             | `Image of ImageContent.t

     

       513
       513
       -
             | `Audio of AudioContent.t ];

     

       801
       801
       +
           role: Role.t;

     

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

     

       514
       803
        
         }

     

       515
       804
        
       

     

       516
       805
        
         let yojson_of_t { role; content } =

     

       517
       517
       -
           let content_json =

     

       518
       518
       -
             match content with

     

       806
       806
       +
           let content_json = match content with

     

       519
       807
        
             | `Text t -> TextContent.yojson_of_t t

     

       520
       808
        
             | `Image i -> ImageContent.yojson_of_t i

     

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

     

       522
       809
        
           in

     

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

     

       810
       810
       +
           `Assoc [

     

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

     

       812
       812
       +
             ("content", content_json);

     

       813
       813
       +
           ]

     

       524
       814
        
       

     

       525
       815
        
         let t_of_yojson = function

     

       526
       526
       -
           | `Assoc fields as json ->

     

       527
       527
       -
               let role =

     

       528
       528
       -
                 match List.assoc_opt "role" fields with

     

       529
       529
       -
                 | Some json -> Role.t_of_yojson json

     

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

     

       531
       531
       -
               in

     

       532
       532
       -
               let content_obj =

     

       533
       533
       -
                 match List.assoc_opt "content" fields with

     

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

     

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

     

       536
       536
       -
               in

     

       537
       537
       -
               let content_type =

     

       538
       538
       -
                 match List.assoc_opt "type" content_obj with

     

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

     

       540
       540
       -
                 | _ ->

     

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

     

       542
       542
       -
                       (`Assoc content_obj)

     

       543
       543
       -
               in

     

       544
       544
       -
               let content =

     

       545
       545
       -
                 match content_type with

     

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

     

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

     

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

     

       549
       549
       -
                 | _ ->

     

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

     

       551
       551
       -
                       content_type

     

       552
       552
       -
               in

     

       553
       553
       -
               { role; content }

     

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

     

       816
       816
       +
           | `Assoc fields ->

     

       817
       817
       +
             let role = match List.assoc_opt "role" fields with

     

       818
       818
       +
               | Some json -> Role.t_of_yojson json

     

       819
       819
       +
               | None -> raise (Json.Of_json ("Missing role field", `Assoc fields))

     

       820
       820
       +
             in

     

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

     

       828
       828
       +
             in

     

       829
       829
       +
             { role; content }

     

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

     

       555
       831
        
       end

     

       556
       832
        
       

     

       557
       833
        
       (* Implementation info *)

     

       558
       834
        
       

     

       559
       835
        
       module Implementation = struct

     

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

     

       836
       836
       +
         type t = {

     

       837
       837
       +
           name: string;

     

       838
       838
       +
           version: string;

     

       839
       839
       +
         }

     

       561
       840
        
       

     

       562
       841
        
         let yojson_of_t { name; version } =

     

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

     

       842
       842
       +
           `Assoc [

     

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

     

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

     

       845
       845
       +
           ]

     

       564
       846
        
       

     

       565
       847
        
         let t_of_yojson = function

     

       566
       566
       -
           | `Assoc fields as json ->

     

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

     

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

     

       569
       569
       -
               { name; version }

     

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

     

       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

     

       857
       857
       +
             { name; version }

     

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

     

       571
       859
        
       end

     

       572
       860
        
       

     

       573
       861
        
       (* JSONRPC Message types *)

     

       862
       862
       +
       

     

       574
       863
        
       

     

       575
       864
        
       module JSONRPCMessage = struct

     

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

     

       865
       865
       +
         type notification = {

     

       866
       866
       +
           method_: string;

     

       867
       867
       +
           params: Json.t option;

     

       868
       868
       +
         }

     

       577
       869
        
       

     

       578
       870
        
         type request = {

     

       579
       579
       -
           id : RequestId.t;

     

       580
       580
       -
           meth : Method.t;

     

       581
       581
       -
           params : Json.t option;

     

       582
       582
       -
           progress_token : ProgressToken.t option;

     

       871
       871
       +
           id: RequestId.t;

     

       872
       872
       +
           method_: string;

     

       873
       873
       +
           params: Json.t option;

     

       874
       874
       +
           progress_token: ProgressToken.t option;

     

       583
       875
        
         }

     

       584
       876
        
       

     

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

     

       877
       877
       +
         type response = {

     

       878
       878
       +
           id: RequestId.t;

     

       879
       879
       +
           result: Json.t;

     

       880
       880
       +
         }

     

       586
       881
        
       

     

       587
       882
        
         type error = {

     

       588
       588
       -
           id : RequestId.t;

     

       589
       589
       -
           code : int;

     

       590
       590
       -
           message : string;

     

       591
       591
       -
           data : Json.t option;

     

       883
       883
       +
           id: RequestId.t;

     

       884
       884
       +
           code: int;

     

       885
       885
       +
           message: string;

     

       886
       886
       +
           data: Json.t option;

     

       592
       887
        
         }

     

       593
       888
        
       

     

       594
       889
        
         type t =

     
···

       597
       892
        
           | Response of response

     

       598
       893
        
           | Error of error

     

       599
       894
        
       

     

       600
       600
       -
         let yojson_of_notification (n : notification) =

     

       601
       601
       -
           let assoc =

     

       602
       602
       -
             [

     

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

     

       604
       604
       -
             ]

     

       605
       605
       -
           in

     

       606
       606
       -
           let assoc =

     

       607
       607
       -
             match n.params with

     

       895
       895
       +
         let yojson_of_notification (n: notification) =

     

       896
       896
       +
           let assoc = [

     

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

     

       898
       898
       +
             ("method", `String n.method_);

     

       899
       899
       +
           ] in

     

       900
       900
       +
           let assoc = match n.params with

     

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

     

       609
       902
        
             | None -> assoc

     

       610
       903
        
           in

     

       611
       904
        
           `Assoc assoc

     

       612
       905
        
       

     

       613
       613
       -
         let yojson_of_request (r : request) =

     

       614
       614
       -
           let assoc =

     

       615
       615
       -
             [

     

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

     

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

     

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

     

       619
       619
       -
             ]

     

       620
       620
       -
           in

     

       621
       621
       -
           let assoc =

     

       622
       622
       -
             match r.params with

     

       906
       906
       +
         let yojson_of_request (r: request) =

     

       907
       907
       +
           let assoc = [

     

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

     

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

     

       910
       910
       +
             ("method", `String r.method_);

     

       911
       911
       +
           ] in

     

       912
       912
       +
           let assoc = match r.params with

     

       623
       913
        
             | Some params ->

     

       624
       624
       -
                 let params_json =

     

       625
       625
       -
                   match params with

     

       626
       626
       -
                   | `Assoc fields ->

     

       627
       627
       -
                       let fields =

     

       628
       628
       -
                         match r.progress_token with

     

       629
       629
       -
                         | Some token ->

     

       630
       630
       -
                             let meta =

     

       631
       631
       -
                               `Assoc

     

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

     

       633
       633
       -
                             in

     

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

     

       635
       635
       -
                         | None -> fields

     

       636
       636
       -
                       in

     

       637
       637
       -
                       `Assoc fields

     

       638
       638
       -
                   | _ -> params

     

       639
       639
       -
                 in

     

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

     

       914
       914
       +
               let params_json = match params with

     

       915
       915
       +
                 | `Assoc fields ->

     

       916
       916
       +
                   let fields = match r.progress_token with

     

       917
       917
       +
                     | Some token ->

     

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

     

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

     

       920
       920
       +
                     | None -> fields

     

       921
       921
       +
                   in

     

       922
       922
       +
                   `Assoc fields

     

       923
       923
       +
                 | _ -> params

     

       924
       924
       +
               in

     

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

     

       641
       926
        
             | None -> assoc

     

       642
       927
        
           in

     

       643
       928
        
           `Assoc assoc

     

       644
       929
        
       

     

       645
       645
       -
         let yojson_of_response (r : response) =

     

       646
       646
       -
           `Assoc

     

       647
       647
       -
             [

     

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

     

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

     

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

     

       651
       651
       -
             ]

     

       930
       930
       +
         let yojson_of_response (r: response) =

     

       931
       931
       +
           `Assoc [

     

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

     

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

     

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

     

       935
       935
       +
           ]

     

       652
       936
        
       

     

       653
       653
       -
         let yojson_of_error (e : error) =

     

       654
       654
       -
           let error_assoc =

     

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

     

       656
       656
       -
           in

     

       657
       657
       -
           let error_assoc =

     

       658
       658
       -
             match e.data with

     

       937
       937
       +
         let yojson_of_error (e: error) =

     

       938
       938
       +
           let error_assoc = [

     

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

     

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

     

       941
       941
       +
           ] in

     

       942
       942
       +
           let error_assoc = match e.data with

     

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

     

       660
       944
        
             | None -> error_assoc

     

       661
       945
        
           in

     

       662
       662
       -
           `Assoc

     

       663
       663
       -
             [

     

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

     

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

     

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

     

       667
       667
       -
             ]

     

       946
       946
       +
           `Assoc [

     

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

     

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

     

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

     

       950
       950
       +
           ]

     

       668
       951
        
       

     

       669
       952
        
         let yojson_of_t = function

     

       670
       953
        
           | Notification n -> yojson_of_notification n

     
···

       674
       957
        
       

     

       675
       958
        
         let notification_of_yojson = function

     

       676
       959
        
           | `Assoc fields ->

     

       677
       677
       -
               let meth =

     

       678
       678
       -
                 match List.assoc_opt "method" fields with

     

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

     

       680
       680
       -
                     try Method.of_string s

     

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

     

       682
       682
       -
                 | _ ->

     

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

     

       684
       684
       -
                       (`Assoc fields)

     

       685
       685
       -
               in

     

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

     

       687
       687
       -
               { meth; params }

     

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

     

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

     

       963
       963
       +
             in

     

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

     

       965
       965
       +
             { method_; params }

     

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

     

       689
       967
        
       

     

       690
       968
        
         let request_of_yojson = function

     

       691
       969
        
           | `Assoc fields ->

     

       692
       692
       -
               let id =

     

       693
       693
       -
                 match List.assoc_opt "id" fields with

     

       694
       694
       -
                 | Some id_json -> Id.t_of_yojson id_json

     

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

     

       696
       696
       -
               in

     

       697
       697
       -
               let meth =

     

       698
       698
       -
                 match List.assoc_opt "method" fields with

     

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

     

       700
       700
       -
                     try Method.of_string s

     

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

     

       702
       702
       -
                 | _ ->

     

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

     

       704
       704
       -
                       (`Assoc fields)

     

       705
       705
       -
               in

     

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

     

       707
       707
       -
               let progress_token =

     

       708
       708
       -
                 match params with

     

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

     

       710
       710
       -
                     match List.assoc_opt "_meta" param_fields with

     

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

     

       712
       712
       -
                         match List.assoc_opt "progressToken" meta_fields with

     

       713
       713
       -
                         | Some token_json ->

     

       714
       714
       -
                             Some (ProgressToken.t_of_yojson token_json)

     

       715
       715
       -
                         | None -> None)

     

       716
       716
       -
                     | _ -> None)

     

       717
       717
       -
                 | _ -> None

     

       718
       718
       -
               in

     

       719
       719
       -
               { id; meth; params; progress_token }

     

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

     

       970
       970
       +
             let id = match List.assoc_opt "id" fields with

     

       971
       971
       +
               | Some id_json -> Id.t_of_yojson id_json

     

       972
       972
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'id' field", `Assoc fields))

     

       973
       973
       +
             in

     

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

     

       977
       977
       +
             in

     

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

     

       979
       979
       +
             let progress_token = 

     

       980
       980
       +
               match params with

     

       981
       981
       +
               | Some (`Assoc param_fields) -> 

     

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

     

       983
       983
       +
                  | Some (`Assoc meta_fields) -> 

     

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

     

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

     

       986
       986
       +
                     | None -> None)

     

       987
       987
       +
                  | _ -> None)

     

       988
       988
       +
               | _ -> None

     

       989
       989
       +
             in

     

       990
       990
       +
             { id; method_; params; progress_token }

     

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

     

       721
       992
        
       

     

       722
       993
        
         let response_of_yojson = function

     

       723
       994
        
           | `Assoc fields ->

     

       724
       724
       -
               let id =

     

       725
       725
       -
                 match List.assoc_opt "id" fields with

     

       726
       726
       -
                 | Some id_json -> Id.t_of_yojson id_json

     

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

     

       728
       728
       -
               in

     

       729
       729
       -
               let result =

     

       730
       730
       -
                 match List.assoc_opt "result" fields with

     

       731
       731
       -
                 | Some result -> result

     

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

     

       733
       733
       -
               in

     

       734
       734
       -
               { id; result }

     

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

     

       995
       995
       +
             let id = match List.assoc_opt "id" fields with

     

       996
       996
       +
               | Some id_json -> Id.t_of_yojson id_json

     

       997
       997
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'id' field", `Assoc fields))

     

       998
       998
       +
             in

     

       999
       999
       +
             let result = match List.assoc_opt "result" fields with

     

       1000
       1000
       +
               | Some result -> result

     

       1001
       1001
       +
               | _ -> raise (Json.Of_json ("Missing 'result' field", `Assoc fields))

     

       1002
       1002
       +
             in

     

       1003
       1003
       +
             { id; result }

     

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

     

       736
       1005
        
       

     

       737
       1006
        
         let error_of_yojson = function

     

       738
       738
       -
           | `Assoc fields as json ->

     

       739
       739
       -
               let id =

     

       740
       740
       -
                 match List.assoc_opt "id" fields with

     

       741
       741
       -
                 | Some id_json -> Id.t_of_yojson id_json

     

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

     

       743
       743
       -
               in

     

       744
       744
       -
               let error =

     

       745
       745
       -
                 match List.assoc_opt "error" fields with

     

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

     

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

     

       748
       748
       -
               in

     

       749
       749
       -
               let code =

     

       750
       750
       -
                 match List.assoc_opt "code" error with

     

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

     

       752
       752
       -
                 | _ ->

     

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

     

       754
       754
       -
                       (`Assoc error)

     

       755
       755
       -
               in

     

       756
       756
       -
               let message =

     

       757
       757
       -
                 match List.assoc_opt "message" error with

     

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

     

       759
       759
       -
                 | _ ->

     

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

     

       761
       761
       -
                       (`Assoc error)

     

       762
       762
       -
               in

     

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

     

       764
       764
       -
               { id; code; message; data }

     

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

     

       1007
       1007
       +
           | `Assoc fields ->

     

       1008
       1008
       +
             let id = match List.assoc_opt "id" fields with

     

       1009
       1009
       +
               | Some id_json -> Id.t_of_yojson id_json

     

       1010
       1010
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'id' field", `Assoc fields))

     

       1011
       1011
       +
             in

     

       1012
       1012
       +
             let error = match List.assoc_opt "error" fields with

     

       1013
       1013
       +
               | Some (`Assoc error_fields) -> error_fields

     

       1014
       1014
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'error' field", `Assoc fields))

     

       1015
       1015
       +
             in

     

       1016
       1016
       +
             let code = match List.assoc_opt "code" error with

     

       1017
       1017
       +
               | Some (`Int code) -> code

     

       1018
       1018
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'code' field in error", `Assoc error))

     

       1019
       1019
       +
             in

     

       1020
       1020
       +
             let message = match List.assoc_opt "message" error with

     

       1021
       1021
       +
               | Some (`String msg) -> msg

     

       1022
       1022
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'message' field in error", `Assoc error))

     

       1023
       1023
       +
             in

     

       1024
       1024
       +
             let data = List.assoc_opt "data" error in

     

       1025
       1025
       +
             { id; code; message; data }

     

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

     

       766
       1027
        
       

     

       767
       1028
        
         let t_of_yojson json =

     

       768
       1029
        
           match json with

     

       769
       1030
        
           | `Assoc fields ->

     

       770
       770
       -
               let _jsonrpc =

     

       771
       771
       -
                 match List.assoc_opt "jsonrpc" fields with

     

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

     

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

     

       774
       774
       -
               in

     

       775
       775
       -
               if List.mem_assoc "method" fields then

     

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

     

       777
       777
       -
                 else Notification (notification_of_yojson json)

     

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

     

       779
       779
       -
                 Response (response_of_yojson json)

     

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

     

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

     

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

     

       1031
       1031
       +
             let _jsonrpc = match List.assoc_opt "jsonrpc" fields with

     

       1032
       1032
       +
               | Some (`String "2.0") -> ()

     

       1033
       1033
       +
               | _ -> raise (Json.Of_json ("Missing or invalid 'jsonrpc' field", json))

     

       1034
       1034
       +
             in

     

       1035
       1035
       +
             if List.mem_assoc "method" fields then

     

       1036
       1036
       +
               if List.mem_assoc "id" fields then

     

       1037
       1037
       +
                 Request (request_of_yojson json)

     

       1038
       1038
       +
               else

     

       1039
       1039
       +
                 Notification (notification_of_yojson json)

     

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

     

       1041
       1041
       +
               Response (response_of_yojson json)

     

       1042
       1042
       +
             else if List.mem_assoc "error" fields then

     

       1043
       1043
       +
               Error (error_of_yojson json)

     

       1044
       1044
       +
             else

     

       1045
       1045
       +
               raise (Json.Of_json ("Invalid JSONRPC message format", json))

     

       1046
       1046
       +
           | j -> raise (Json.Of_json ("Expected object for JSONRPC message", j))

     

       783
       1047
        
       

     

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

     

       785
       785
       -
           Notification { meth; params }

     

       1048
       1048
       +
         let create_notification ?(params=None) ~method_ () =

     

       1049
       1049
       +
           Notification { method_; params }

     

       786
       1050
        
       

     

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

     

       788
       788
       -
           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 }

     

       789
       1053
        
       

     

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

     

       1054
       1054
       +
         let create_response ~id ~result =

     

       1055
       1055
       +
           Response { id; result }

     

       791
       1056
        
       

     

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

     

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

     

       793
       1058
        
           Error { id; code; message; data }

     

       794
       1059
        
       end

     

       795
       1060
        
       

     
···

       798
       1063
        
       module Initialize = struct

     

       799
       1064
        
         module Request = struct

     

       800
       1065
        
           type t = {

     

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

     

       802
       802
       -
             client_info : Implementation.t;

     

       803
       803
       -
             protocol_version : string;

     

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

     

       1067
       1067
       +
             client_info: Implementation.t;

     

       1068
       1068
       +
             protocol_version: string;

     

       804
       1069
        
           }

     

       805
       1070
        
       

     

       806
       1071
        
           let yojson_of_t { capabilities; client_info; protocol_version } =

     

       807
       807
       -
             `Assoc

     

       808
       808
       -
               [

     

       809
       809
       -
                 ("capabilities", capabilities);

     

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

     

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

     

       812
       812
       -
               ]

     

       1072
       1072
       +
             `Assoc [

     

       1073
       1073
       +
               ("capabilities", capabilities);

     

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

     

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

     

       1076
       1076
       +
             ]

     

       813
       1077
        
       

     

       814
       1078
        
           let t_of_yojson = function

     

       815
       815
       -
             | `Assoc fields as json ->

     

       816
       816
       -
                 let capabilities =

     

       817
       817
       -
                   match List.assoc_opt "capabilities" fields with

     

       818
       818
       -
                   | Some json -> json

     

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

     

       820
       820
       -
                 in

     

       821
       821
       -
                 let client_info =

     

       822
       822
       -
                   match List.assoc_opt "clientInfo" fields with

     

       823
       823
       -
                   | Some json -> Implementation.t_of_yojson json

     

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

     

       825
       825
       -
                 in

     

       826
       826
       -
                 let protocol_version =

     

       827
       827
       -
                   Util.get_string_field fields "protocolVersion" json

     

       828
       828
       -
                 in

     

       829
       829
       -
                 { capabilities; client_info; protocol_version }

     

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

     

       1079
       1079
       +
             | `Assoc fields ->

     

       1080
       1080
       +
               let capabilities = match List.assoc_opt "capabilities" fields with

     

       1081
       1081
       +
                 | Some json -> json

     

       1082
       1082
       +
                 | None -> raise (Json.Of_json ("Missing capabilities field", `Assoc fields))

     

       1083
       1083
       +
               in

     

       1084
       1084
       +
               let client_info = match List.assoc_opt "clientInfo" fields with

     

       1085
       1085
       +
                 | Some json -> Implementation.t_of_yojson json

     

       1086
       1086
       +
                 | None -> raise (Json.Of_json ("Missing clientInfo field", `Assoc fields))

     

       1087
       1087
       +
               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

     

       1092
       1092
       +
               { capabilities; client_info; protocol_version }

     

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

     

       831
       1094
        
       

     

       832
       1095
        
           let create ~capabilities ~client_info ~protocol_version =

     

       833
       1096
        
             { capabilities; client_info; protocol_version }

     

       834
       1097
        
       

     

       835
       1098
        
           let to_jsonrpc ~id t =

     

       836
       1099
        
             let params = yojson_of_t t in

     

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

     

       838
       838
       -
               ~params:(Some params) ()

     

       1100
       1100
       +
             JSONRPCMessage.create_request ~id ~method_:"initialize" ~params:(Some params) ()

     

       839
       1101
        
         end

     

       840
       1102
        
       

     

       841
       1103
        
         module Result = struct

     

       842
       1104
        
           type t = {

     

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

     

       844
       844
       -
             server_info : Implementation.t;

     

       845
       845
       -
             protocol_version : string;

     

       846
       846
       -
             instructions : string option;

     

       847
       847
       -
             meta : Json.t option;

     

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

     

       1106
       1106
       +
             server_info: Implementation.t;

     

       1107
       1107
       +
             protocol_version: string;

     

       1108
       1108
       +
             instructions: string option;

     

       1109
       1109
       +
             meta: Json.t option;

     

       848
       1110
        
           }

     

       849
       1111
        
       

     

       850
       850
       -
           let yojson_of_t

     

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

     

       852
       852
       -
             let assoc =

     

       853
       853
       -
               [

     

       854
       854
       -
                 ("capabilities", capabilities);

     

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

     

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

     

       857
       857
       -
               ]

     

       858
       858
       -
             in

     

       859
       859
       -
             let assoc =

     

       860
       860
       -
               match instructions with

     

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

     

       1113
       1113
       +
             let assoc = [

     

       1114
       1114
       +
               ("capabilities", capabilities);

     

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

     

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

     

       1117
       1117
       +
             ] in

     

       1118
       1118
       +
             let assoc = match instructions with

     

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

     

       862
       1120
        
               | None -> assoc

     

       863
       1121
        
             in

     

       864
       864
       -
             let assoc =

     

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

     

       1122
       1122
       +
             let assoc = match meta with

     

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

     

       1124
       1124
       +
               | None -> assoc

     

       866
       1125
        
             in

     

       867
       1126
        
             `Assoc assoc

     

       868
       1127
        
       

     

       869
       1128
        
           let t_of_yojson = function

     

       870
       870
       -
             | `Assoc fields as json ->

     

       871
       871
       -
                 let capabilities =

     

       872
       872
       -
                   match List.assoc_opt "capabilities" fields with

     

       873
       873
       -
                   | Some json -> json

     

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

     

       875
       875
       -
                 in

     

       876
       876
       -
                 let server_info =

     

       877
       877
       -
                   match List.assoc_opt "serverInfo" fields with

     

       878
       878
       -
                   | Some json -> Implementation.t_of_yojson json

     

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

     

       880
       880
       -
                 in

     

       881
       881
       -
                 let protocol_version =

     

       882
       882
       -
                   Util.get_string_field fields "protocolVersion" json

     

       883
       883
       -
                 in

     

       884
       884
       -
                 let instructions =

     

       885
       885
       -
                   Util.get_optional_string_field fields "instructions"

     

       886
       886
       -
                 in

     

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

     

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

     

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

     

       1129
       1129
       +
             | `Assoc fields ->

     

       1130
       1130
       +
               let capabilities = match List.assoc_opt "capabilities" fields with

     

       1131
       1131
       +
                 | Some json -> json

     

       1132
       1132
       +
                 | None -> raise (Json.Of_json ("Missing capabilities field", `Assoc fields))

     

       1133
       1133
       +
               in

     

       1134
       1134
       +
               let server_info = match List.assoc_opt "serverInfo" fields with

     

       1135
       1135
       +
                 | Some json -> Implementation.t_of_yojson json

     

       1136
       1136
       +
                 | None -> raise (Json.Of_json ("Missing serverInfo field", `Assoc fields))

     

       1137
       1137
       +
               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

     

       1146
       1146
       +
               let meta = List.assoc_opt "_meta" fields in

     

       1147
       1147
       +
               { capabilities; server_info; protocol_version; instructions; meta }

     

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

     

       890
       1149
        
       

     

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

     

       892
       892
       -
               () =

     

       1150
       1150
       +
           let create ~capabilities ~server_info ~protocol_version ?instructions ?meta () =

     

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

     

       894
       1152
        
       

     

       895
       1153
        
           let to_jsonrpc ~id t =

     
···

       899
       1157
        
       

     

       900
       1158
        
       module Initialized = struct

     

       901
       1159
        
         module Notification = struct

     

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

     

       1160
       1160
       +
           type t = {

     

       1161
       1161
       +
             meta: Json.t option;

     

       1162
       1162
       +
           }

     

       903
       1163
        
       

     

       904
       1164
        
           let yojson_of_t { meta } =

     

       905
       1165
        
             let assoc = [] in

     

       906
       906
       -
             let assoc =

     

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

     

       1166
       1166
       +
             let assoc = match meta with

     

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

     

       1168
       1168
       +
               | None -> assoc

     

       908
       1169
        
             in

     

       909
       1170
        
             `Assoc assoc

     

       910
       1171
        
       

     

       911
       1172
        
           let t_of_yojson = function

     

       912
       1173
        
             | `Assoc fields ->

     

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

     

       914
       914
       -
                 { meta }

     

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

     

       1174
       1174
       +
               let meta = List.assoc_opt "_meta" fields in

     

       1175
       1175
       +
               { meta }

     

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

     

       916
       1177
        
       

     

       917
       1178
        
           let create ?meta () = { meta }

     

       918
       1179
        
       

     

       919
       1180
        
           let to_jsonrpc t =

     

       920
       920
       -
             let params =

     

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

     

       1181
       1181
       +
             let params = match yojson_of_t t with

     

       1182
       1182
       +
               | `Assoc [] -> None

     

       1183
       1183
       +
               | json -> Some json

     

       922
       1184
        
             in

     

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

     

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

     

       924
       1186
        
         end

     

       925
       1187
        
       end

     

       926
       1188
        
       

     

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

     

       928
       1190
        
       

     

       929
       929
       -
       let parse_message json = JSONRPCMessage.t_of_yojson json

     

       930
       930
       -
       

     

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

     

       932
       932
       -
         JSONRPCMessage.create_notification ~params ~meth ()

     

       933
       933
       -
       

     

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

     

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

     

       1191
       1191
       +
       let parse_message json =

     

       1192
       1192
       +
         JSONRPCMessage.t_of_yojson json

     

       936
       1193
        
       

     

       1194
       1194
       +
       let create_notification = JSONRPCMessage.create_notification

     

       1195
       1195
       +
       let create_request = JSONRPCMessage.create_request

     

       937
       1196
        
       let create_response = JSONRPCMessage.create_response

     

       938
       1197
        
       let create_error = JSONRPCMessage.create_error

     

       939
       1198
        
       

     

       940
       940
       -
       (* Content type constructors *)

     

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

     

       942
       942
       -
       

     

       943
       943
       -
       let make_image_content data mime_type =

     

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

     

       945
       945
       -
       

     

       946
       946
       -
       let make_audio_content data mime_type =

     

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

     

       948
       948
       -
       

     

       949
       949
       -
       let make_resource_text_content uri text mime_type =

     

       950
       950
       -
         Resource

     

       951
       951
       -
           EmbeddedResource.

     

       952
       952
       -
             {

     

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

     

       954
       954
       -
               annotations = None;

     

       955
       955
       -
             }

     

       956
       956
       -
       

     

       957
       957
       -
       let make_resource_blob_content uri blob mime_type =

     

       958
       958
       -
         Resource

     

       959
       959
       -
           EmbeddedResource.

     

       960
       960
       -
             {

     

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

     

       962
       962
       -
               annotations = None;

     

       963
       963
       -
             }

     

       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

+231 -957

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

     

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

     

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

     

       6
       6
       -
           and serialization functionality.

     

       7
       7
       -
       

     

       8
       8
       -
           MCP Architecture:

     

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

     

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

     

       11
       11
       -
             applications) communicate with MCP servers

     

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

     

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

     

       14
       14
       -
             and shutdown

     

       15
       15
       -
           - Provides capability negotiation during initialization to determine

     

       16
       16
       -
             available features

     

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

     

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

     

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

     

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

     

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

     

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

     

       23
       23
       -
             resources

     

       24
       24
       -
           - Includes standardized error handling with defined error codes

     

       25
       25
       -
       

     

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

     

       1
       1
       +
       (** MCP - Model Context Protocol implementation *)

     

       27
       2
        
       

     

       28
       3
        
       open Jsonrpc

     

       29
       4
        
       

     

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

     

       31
       31
       -
       module Util : sig

     

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

     

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

     

       34
       34
       -
             @param fmt Format string for the error message

     

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

     

       36
       36
       -
             @return Never returns, always raises an exception

     

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

     

       38
       38
       -
       

     

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

     

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

     

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

     

       42
       42
       -
             @param name Field name to extract

     

       43
       43
       -
             @param json Original JSON for error context

     

       44
       44
       -
             @return The string value of the field

     

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

     

       46
       46
       -
       

     

       47
       47
       -
         val get_optional_string_field :

     

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

     

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

     

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

     

       51
       51
       -
             @param name Field name to extract

     

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

     

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

     

       54
       54
       -
       

     

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

     

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

     

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

     

       58
       58
       -
             @param name Field name to extract

     

       59
       59
       -
             @param json Original JSON for error context

     

       60
       60
       -
             @return The int value of the field

     

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

     

       62
       62
       -
       

     

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

     

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

     

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

     

       66
       66
       -
             @param name Field name to extract

     

       67
       67
       -
             @param json Original JSON for error context

     

       68
       68
       -
             @return The float value of the field

     

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

     

       70
       70
       -
       

     

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

     

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

     

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

     

       74
       74
       -
             @param name Field name to extract

     

       75
       75
       -
             @param json Original JSON for error context

     

       76
       76
       -
             @return The boolean value of the field

     

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

     

       78
       78
       -
       

     

       79
       79
       -
         val get_object_field :

     

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

     

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

     

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

     

       83
       83
       -
             @param name Field name to extract

     

       84
       84
       -
             @param json Original JSON for error context

     

       85
       85
       -
             @return The object as an assoc list

     

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

     

       87
       87
       -
       

     

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

     

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

     

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

     

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

     

       106
       106
       -
       

     

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

     

       5
       5
       +
       (** Standard error codes *)

     

       108
       6
        
       module ErrorCode : sig

     

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

     

       110
       110
       -
         type t =

     

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

     

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

     

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

     

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

     

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

     

       116
       116
       -
           | ResourceNotFound

     

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

     

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

     

       123
       123
       -
             @param code The error code to convert

     

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

     

       125
       125
       -
       

     

       126
       126
       -
         val to_message : t -> string

     

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

     

       131
       131
       -
       

     

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

     

       133
       133
       -
       module Method : sig

     

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

     

       135
       135
       -
         type t =

     

       136
       136
       -
           (* Initialization and lifecycle methods *)

     

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

     

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

     

       139
       139
       -
           (* Resource methods *)

     

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

     

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

     

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

     

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

     

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

     

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

     

       146
       146
       -
           (* Tool methods *)

     

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

     

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

     

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

     

       150
       150
       -
           (* Prompt methods *)

     

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

     

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

     

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

     

       154
       154
       -
           (* Progress notifications *)

     

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

     

       156
       156
       -
       

     

       157
       157
       -
         val to_string : t -> string

     

       158
       158
       -
         (** Convert method type to string representation

     

       159
       159
       -
             @param meth The method to convert

     

       160
       160
       -
             @return

     

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

     

       162
       162
       -
               "resources/list") *)

     

       163
       163
       -
       

     

       164
       164
       -
         val of_string : string -> t

     

       165
       165
       -
         (** Convert string to method type

     

       166
       166
       -
             @param s The string representation of the method

     

       167
       167
       -
             @return The corresponding method type

     

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

     

       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

     

       169
       15
        
       end

     

       170
       16
        
       

     

       171
       17
        
       (** Common types *)

     
···

       173
       19
        
       (** Roles for conversation participants *)

     

       174
       20
        
       module Role : sig

     

       175
       21
        
         type t = [ `User | `Assistant ]

     

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

     

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

     

       178
       178
       -
             conversation. *)

     

       179
       22
        
       

     

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

     

       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

     

       181
       28
        
       end

     

       182
       29
        
       

     

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

     

       184
       31
        
       module ProgressToken : sig

     

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

     

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

     

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

     

       188
       188
       -
             may take significant time to complete. *)

     

       189
       33
        
       

     

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

     

       191
       35
        
       end

     
···

       193
       37
        
       (** Request IDs *)

     

       194
       38
        
       module RequestId : sig

     

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

     

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

     

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

     

       198
       198
       -
             integer values. *)

     

       199
       40
        
       

     

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

     

       201
       42
        
       end

     
···

       203
       44
        
       (** Cursors for pagination *)

     

       204
       45
        
       module Cursor : sig

     

       205
       46
        
         type t = string

     

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

     

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

     

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

     

       209
       209
       -
             pages. *)

     

       210
       47
        
       

     

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

     

       48
       48
       +
         val yojson_of_t : t -> Json.t

     

       49
       49
       +
         val t_of_yojson : Json.t -> t

     

       212
       50
        
       end

     

       213
       51
        
       

     

       214
       52
        
       (** Annotations for objects *)

     

       215
       53
        
       module Annotated : sig

     

       216
       216
       -
         type t = { annotations : annotation option }

     

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

     

       218
       218
       -
             targeting and priority settings. *)

     

       219
       219
       -
       

     

       54
       54
       +
         type t = {

     

       55
       55
       +
           annotations: annotation option;

     

       56
       56
       +
         }

     

       220
       57
        
         and annotation = {

     

       221
       221
       -
           audience : Role.t list option;

     

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

     

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

     

       58
       58
       +
           audience: Role.t list option;

     

       59
       59
       +
           priority: float option;

     

       224
       60
        
         }

     

       225
       61
        
       

     

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

     

       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

     

       227
       67
        
       end

     

       228
       68
        
       

     

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

     

       69
       69
       +
       (** Text content *)

     

       230
       70
        
       module TextContent : sig

     

       231
       71
        
         type t = {

     

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

     

       233
       233
       -
           annotations : Annotated.annotation option;

     

       234
       234
       -
               (** Optional annotations for audience targeting and priority.

     

       235
       235
       -
                   Annotations can restrict content visibility to specific roles

     

       236
       236
       -
                   (user/assistant) and indicate relative importance of different

     

       237
       237
       -
                   content elements. *)

     

       72
       72
       +
           text: string;

     

       73
       73
       +
           annotations: Annotated.annotation option;

     

       238
       74
        
         }

     

       239
       239
       -
         (** TextContent represents plain text messages in MCP conversations. This is

     

       240
       240
       -
             the most common content type used for natural language interactions

     

       241
       241
       -
             between users and assistants. Text content is used in prompts, tool

     

       242
       242
       -
             results, and model responses.

     

       243
       75
        
       

     

       244
       244
       -
             In JSON-RPC, this is represented as:

     

       245
       245
       -
             {v

     

       246
       246
       -
             {

     

       247
       247
       -
               "type": "text",

     

       248
       248
       -
               "text": "The text content of the message"

     

       249
       249
       -
             }

     

       250
       250
       -
             v}

     

       251
       251
       -
       

     

       252
       252
       -
             For security, implementations must sanitize text content to prevent

     

       253
       253
       -
             injection attacks or unauthorized access to resources. *)

     

       254
       254
       -
       

     

       255
       255
       -
         include Json.Jsonable.S with type t := t

     

       76
       76
       +
         val yojson_of_t : t -> Json.t

     

       77
       77
       +
         val t_of_yojson : Json.t -> t

     

       256
       78
        
       end

     

       257
       79
        
       

     

       258
       258
       -
       (** Image content - Visual data representation in MCP *)

     

       80
       80
       +
       (** Image content *)

     

       259
       81
        
       module ImageContent : sig

     

       260
       82
        
         type t = {

     

       261
       261
       -
           data : string;

     

       262
       262
       -
               (** Base64-encoded image data. All binary image data must be encoded

     

       263
       263
       -
                   using standard base64 encoding (RFC 4648) to safely transmit within

     

       264
       264
       -
                   JSON. *)

     

       265
       265
       -
           mime_type : string;

     

       266
       266
       -
               (** MIME type of the image (e.g., "image/png", "image/jpeg",

     

       267
       267
       -
                   "image/gif", "image/svg+xml"). This field is required and must

     

       268
       268
       -
                   accurately represent the image format to ensure proper handling by

     

       269
       269
       -
                   clients. *)

     

       270
       270
       -
           annotations : Annotated.annotation option;

     

       271
       271
       -
               (** Optional annotations for audience targeting and priority.

     

       272
       272
       -
                   Annotations can restrict content visibility to specific roles

     

       273
       273
       -
                   (user/assistant) and indicate relative importance of different

     

       274
       274
       -
                   content elements. *)

     

       83
       83
       +
           data: string;

     

       84
       84
       +
           mime_type: string;

     

       85
       85
       +
           annotations: Annotated.annotation option;

     

       275
       86
        
         }

     

       276
       276
       -
         (** ImageContent enables including visual information in MCP messages,

     

       277
       277
       -
             supporting multimodal interactions where visual context is important.

     

       278
       87
        
       

     

       279
       279
       -
             Images can be used in several scenarios:

     

       280
       280
       -
             - As user inputs for visual understanding tasks

     

       281
       281
       -
             - As context for generating descriptions or analysis

     

       282
       282
       -
             - As outputs from tools that generate visualizations

     

       283
       283
       -
             - As part of prompt templates with visual components

     

       284
       284
       -
       

     

       285
       285
       -
             In JSON-RPC, this is represented as:

     

       286
       286
       -
             {v

     

       287
       287
       -
             {

     

       288
       288
       -
               "type": "image",

     

       289
       289
       -
               "data": "base64-encoded-image-data",

     

       290
       290
       -
               "mimeType": "image/png"

     

       291
       291
       -
             }

     

       292
       292
       -
             v}

     

       293
       293
       -
       

     

       294
       294
       -
             The data MUST be base64-encoded to ensure safe transmission in JSON.

     

       295
       295
       -
             Common mime types include image/png, image/jpeg, image/gif, and

     

       296
       296
       -
             image/svg+xml. *)

     

       297
       297
       -
       

     

       298
       298
       -
         include Json.Jsonable.S with type t := t

     

       88
       88
       +
         val yojson_of_t : t -> Json.t

     

       89
       89
       +
         val t_of_yojson : Json.t -> t

     

       299
       90
        
       end

     

       300
       91
        
       

     

       301
       301
       -
       (** Audio content - Sound data representation in MCP *)

     

       92
       92
       +
       (** Audio content *)

     

       302
       93
        
       module AudioContent : sig

     

       303
       94
        
         type t = {

     

       304
       304
       -
           data : string;

     

       305
       305
       -
               (** Base64-encoded audio data. All binary audio data must be encoded

     

       306
       306
       -
                   using standard base64 encoding (RFC 4648) to safely transmit within

     

       307
       307
       -
                   JSON. *)

     

       308
       308
       -
           mime_type : string;

     

       309
       309
       -
               (** MIME type of the audio (e.g., "audio/wav", "audio/mp3", "audio/ogg",

     

       310
       310
       -
                   "audio/mpeg"). This field is required and must accurately represent

     

       311
       311
       -
                   the audio format to ensure proper handling by clients. *)

     

       312
       312
       -
           annotations : Annotated.annotation option;

     

       313
       313
       -
               (** Optional annotations for audience targeting and priority.

     

       314
       314
       -
                   Annotations can restrict content visibility to specific roles

     

       315
       315
       -
                   (user/assistant) and indicate relative importance of different

     

       316
       316
       -
                   content elements. *)

     

       95
       95
       +
           data: string;

     

       96
       96
       +
           mime_type: string;

     

       97
       97
       +
           annotations: Annotated.annotation option;

     

       317
       98
        
         }

     

       318
       318
       -
         (** AudioContent enables including audio information in MCP messages,

     

       319
       319
       -
             supporting multimodal interactions where audio context is important.

     

       320
       99
        
       

     

       321
       321
       -
             Audio can be used in several scenarios:

     

       322
       322
       -
             - As user inputs for speech recognition or audio analysis

     

       323
       323
       -
             - As context for transcription or sound classification tasks

     

       324
       324
       -
             - As outputs from tools that generate audio samples

     

       325
       325
       -
             - As part of prompt templates with audio components

     

       326
       326
       -
       

     

       327
       327
       -
             In JSON-RPC, this is represented as:

     

       328
       328
       -
             {v

     

       329
       329
       -
             {

     

       330
       330
       -
               "type": "audio",

     

       331
       331
       -
               "data": "base64-encoded-audio-data",

     

       332
       332
       -
               "mimeType": "audio/wav"

     

       333
       333
       -
             }

     

       334
       334
       -
             v}

     

       335
       335
       -
       

     

       336
       336
       -
             The data MUST be base64-encoded to ensure safe transmission in JSON.

     

       337
       337
       -
             Common mime types include audio/wav, audio/mp3, audio/ogg, and audio/mpeg.

     

       338
       338
       -
         *)

     

       339
       339
       -
       

     

       340
       340
       -
         include Json.Jsonable.S with type t := t

     

       100
       100
       +
         val yojson_of_t : t -> Json.t

     

       101
       101
       +
         val t_of_yojson : Json.t -> t

     

       341
       102
        
       end

     

       342
       103
        
       

     

       343
       343
       -
       (** Base resource contents - Core resource metadata in MCP *)

     

       104
       104
       +
       (** Base resource contents *)

     

       344
       105
        
       module ResourceContents : sig

     

       345
       106
        
         type t = {

     

       346
       346
       -
           uri : string;

     

       347
       347
       -
               (** URI that uniquely identifies the resource.

     

       348
       348
       -
       

     

       349
       349
       -
                   Resources use standard URI schemes including:

     

       350
       350
       -
                   - file:// - For filesystem-like resources

     

       351
       351
       -
                   - https:// - For web-accessible resources

     

       352
       352
       -
                   - git:// - For version control integration

     

       353
       353
       -
       

     

       354
       354
       -
                   The URI serves as a stable identifier even if the underlying content

     

       355
       355
       -
                   changes. *)

     

       356
       356
       -
           mime_type : string option;

     

       357
       357
       -
               (** Optional MIME type of the resource content to aid in client

     

       358
       358
       -
                   rendering. Common MIME types include text/plain, application/json,

     

       359
       359
       -
                   image/png, etc. For directories, the XDG MIME type inode/directory

     

       360
       360
       -
                   may be used. *)

     

       107
       107
       +
           uri: string;

     

       108
       108
       +
           mime_type: string option;

     

       361
       109
        
         }

     

       362
       362
       -
         (** ResourceContents provides basic metadata for resources in MCP.

     

       363
       110
        
       

     

       364
       364
       -
             Resources are server-exposed data that provides context to language

     

       365
       365
       -
             models, such as files, database schemas, or application-specific

     

       366
       366
       -
             information. Each resource is uniquely identified by a URI.

     

       367
       367
       -
       

     

       368
       368
       -
             The MCP resources architecture is designed to be application-driven, with

     

       369
       369
       -
             host applications determining how to incorporate context based on their

     

       370
       370
       -
             needs.

     

       371
       371
       -
       

     

       372
       372
       -
             In the protocol, resources are discovered via the 'resources/list'

     

       373
       373
       -
             endpoint and retrieved via the 'resources/read' endpoint. Servers that

     

       374
       374
       -
             support resources must declare the 'resources' capability during

     

       375
       375
       -
             initialization. *)

     

       376
       376
       -
       

     

       377
       377
       -
         include Json.Jsonable.S with type t := t

     

       111
       111
       +
         val yojson_of_t : t -> Json.t

     

       112
       112
       +
         val t_of_yojson : Json.t -> t

     

       378
       113
        
       end

     

       379
       114
        
       

     

       380
       380
       -
       (** Text resource contents - Textual resource data *)

     

       115
       115
       +
       (** Text resource contents *)

     

       381
       116
        
       module TextResourceContents : sig

     

       382
       117
        
         type t = {

     

       383
       383
       -
           uri : string;

     

       384
       384
       -
               (** URI that uniquely identifies the resource. This URI can be

     

       385
       385
       -
                   referenced in subsequent requests to fetch updates. *)

     

       386
       386
       -
           text : string;

     

       387
       387
       -
               (** The actual text content of the resource as a UTF-8 encoded string.

     

       388
       388
       -
                   This may be sanitized by the server to remove sensitive information.

     

       389
       389
       -
               *)

     

       390
       390
       -
           mime_type : string option;

     

       391
       391
       -
               (** Optional MIME type of the text content to aid in client rendering.

     

       392
       392
       -
                   Common text MIME types include: text/plain, text/markdown,

     

       393
       393
       -
                   text/x-python, application/json, text/html, text/csv, etc. *)

     

       118
       118
       +
           uri: string;

     

       119
       119
       +
           text: string;

     

       120
       120
       +
           mime_type: string option;

     

       394
       121
        
         }

     

       395
       395
       -
         (** TextResourceContents represents a text-based resource in MCP.

     

       396
       122
        
       

     

       397
       397
       -
             Text resources are used for sharing code snippets, documentation, logs,

     

       398
       398
       -
             configuration files, and other textual information with language models.

     

       399
       399
       -
       

     

       400
       400
       -
             The server handles access control and security, ensuring that only

     

       401
       401
       -
             authorized resources are shared with clients.

     

       402
       402
       -
       

     

       403
       403
       -
             In JSON-RPC, this is represented as:

     

       404
       404
       -
             {v

     

       405
       405
       -
             {

     

       406
       406
       -
               "uri": "file:///example.txt",

     

       407
       407
       -
               "mimeType": "text/plain",

     

       408
       408
       -
               "text": "Resource content"

     

       409
       409
       -
             }

     

       410
       410
       -
             v} *)

     

       411
       411
       -
       

     

       412
       412
       -
         include Json.Jsonable.S with type t := t

     

       123
       123
       +
         val yojson_of_t : t -> Json.t

     

       124
       124
       +
         val t_of_yojson : Json.t -> t

     

       413
       125
        
       end

     

       414
       126
        
       

     

       415
       415
       -
       (** Binary resource contents - Binary resource data *)

     

       127
       127
       +
       (** Binary resource contents *)

     

       416
       128
        
       module BlobResourceContents : sig

     

       417
       129
        
         type t = {

     

       418
       418
       -
           uri : string;

     

       419
       419
       -
               (** URI that uniquely identifies the resource. This URI can be

     

       420
       420
       -
                   referenced in subsequent requests to fetch updates. *)

     

       421
       421
       -
           blob : string;

     

       422
       422
       -
               (** Base64-encoded binary data using standard base64 encoding (RFC

     

       423
       423
       -
                   4648). This encoding ensures that binary data can be safely

     

       424
       424
       -
                   transmitted in JSON. *)

     

       425
       425
       -
           mime_type : string option;

     

       426
       426
       -
               (** Optional MIME type of the binary content to aid in client rendering.

     

       427
       427
       -
                   Common binary MIME types include: image/png, image/jpeg,

     

       428
       428
       -
                   application/pdf, audio/wav, video/mp4, application/octet-stream,

     

       429
       429
       -
                   etc. *)

     

       130
       130
       +
           uri: string;

     

       131
       131
       +
           blob: string;

     

       132
       132
       +
           mime_type: string option;

     

       430
       133
        
         }

     

       431
       431
       -
         (** BlobResourceContents represents a binary resource in MCP.

     

       432
       134
        
       

     

       433
       433
       -
             Binary resources allow sharing non-textual data like images, audio files,

     

       434
       434
       -
             PDFs, and other binary formats with language models that support

     

       435
       435
       -
             processing such content.

     

       436
       436
       -
       

     

       437
       437
       -
             In JSON-RPC, this is represented as:

     

       438
       438
       -
             {v

     

       439
       439
       -
             {

     

       440
       440
       -
               "uri": "file:///example.png",

     

       441
       441
       -
               "mimeType": "image/png",

     

       442
       442
       -
               "blob": "base64-encoded-data"

     

       443
       443
       -
             }

     

       444
       444
       -
             v}

     

       445
       445
       -
       

     

       446
       446
       -
             Binary data MUST be properly base64-encoded to ensure safe transmission in

     

       447
       447
       -
             JSON payloads. *)

     

       448
       448
       -
       

     

       449
       449
       -
         include Json.Jsonable.S with type t := t

     

       135
       135
       +
         val yojson_of_t : t -> Json.t

     

       136
       136
       +
         val t_of_yojson : Json.t -> t

     

       450
       137
        
       end

     

       451
       138
        
       

     

       452
       452
       -
       (** Embedded resource - Resource included directly in messages *)

     

       139
       139
       +
       (** Embedded resource *)

     

       453
       140
        
       module EmbeddedResource : sig

     

       454
       141
        
         type t = {

     

       455
       455
       -
           resource :

     

       456
       456
       -
             [ `Text of TextResourceContents.t | `Blob of BlobResourceContents.t ];

     

       457
       457
       -
               (** The resource content, either as text or binary blob. *)

     

       458
       458
       -
           annotations : Annotated.annotation option;

     

       459
       459
       -
               (** Optional annotations for audience targeting and priority.

     

       460
       460
       -
                   Annotations can restrict resource visibility to specific roles

     

       461
       461
       -
                   (user/assistant) and indicate relative importance of different

     

       462
       462
       -
                   content elements. *)

     

       142
       142
       +
           resource: [ `Text of TextResourceContents.t | `Blob of BlobResourceContents.t ];

     

       143
       143
       +
           annotations: Annotated.annotation option;

     

       463
       144
        
         }

     

       464
       464
       -
         (** EmbeddedResource allows referencing server-side resources directly in MCP

     

       465
       465
       -
             messages, enabling seamless incorporation of managed content.

     

       466
       145
        
       

     

       467
       467
       -
             Embedded resources can be included in:

     

       468
       468
       -
             - Tool results to provide rich context

     

       469
       469
       -
             - Prompt templates to include reference materials

     

       470
       470
       -
             - Messages to provide additional context to language models

     

       471
       471
       -
       

     

       472
       472
       -
             In contrast to direct content (TextContent, ImageContent, AudioContent),

     

       473
       473
       -
             embedded resources have the advantage of being persistently stored on the

     

       474
       474
       -
             server with a stable URI, allowing later retrieval and updates through the

     

       475
       475
       -
             resources API.

     

       476
       476
       -
       

     

       477
       477
       -
             For example, a tool might return an embedded resource containing a chart

     

       478
       478
       -
             or a large dataset that the client can later reference or update. *)

     

       479
       479
       -
       

     

       480
       480
       -
         include Json.Jsonable.S with type t := t

     

       146
       146
       +
         val yojson_of_t : t -> Json.t

     

       147
       147
       +
         val t_of_yojson : Json.t -> t

     

       481
       148
        
       end

     

       482
       149
        
       

     

       483
       483
       -
       (** Content type used in messages - Unified multimodal content representation in

     

       484
       484
       -
           MCP *)

     

       485
       485
       -
       type content =

     

       150
       150
       +
       (** Content type used in messages *)

     

       151
       151
       +
       type content = 

     

       486
       152
        
         | Text of TextContent.t

     

       487
       487
       -
             (** Text content for natural language messages. This is the most common

     

       488
       488
       -
                 content type for user-assistant interactions. *)

     

       489
       153
        
         | Image of ImageContent.t

     

       490
       490
       -
             (** Image content for visual data. Used for sharing visual context in

     

       491
       491
       -
                 multimodal conversations. *)

     

       492
       154
        
         | Audio of AudioContent.t

     

       493
       493
       -
             (** Audio content for audio data. Used for sharing audio context in

     

       494
       494
       -
                 multimodal conversations. *)

     

       495
       155
        
         | Resource of EmbeddedResource.t

     

       496
       496
       -
             (** Resource content for referencing server-side resources. Used for

     

       497
       497
       -
                 incorporating managed server content with stable URIs. *)

     

       498
       156
        
       

     

       499
       157
        
       val yojson_of_content : content -> Json.t

     

       500
       500
       -
       (** Convert content to Yojson representation

     

       501
       501
       -
           @param content The content to convert

     

       502
       502
       -
           @return JSON representation of the content *)

     

       503
       503
       -
       

     

       504
       158
        
       val content_of_yojson : Json.t -> content

     

       505
       505
       -
       (** Convert Yojson representation to content

     

       506
       506
       -
           @param json JSON representation of content

     

       507
       507
       -
           @return Parsed content object *)

     

       508
       159
        
       

     

       509
       509
       -
       (** Message for prompts - Template messages in the MCP prompts feature *)

     

       160
       160
       +
       (** Message for prompts *)

     

       510
       161
        
       module PromptMessage : sig

     

       511
       162
        
         type t = {

     

       512
       512
       -
           role : Role.t;

     

       513
       513
       -
               (** The role of the message sender (user or assistant). Prompt templates

     

       514
       514
       -
                   typically alternate between user and assistant messages to create a

     

       515
       515
       -
                   conversation structure. *)

     

       516
       516
       -
           content : content;

     

       517
       517
       -
               (** The message content, which can be text, image, audio, or resource.

     

       518
       518
       -
                   This unified content type supports rich multimodal prompts. *)

     

       163
       163
       +
           role: Role.t;

     

       164
       164
       +
           content: content;

     

       519
       165
        
         }

     

       520
       520
       -
         (** PromptMessage represents a message in an MCP prompt template, containing a

     

       521
       521
       -
             role and content which can be customized with arguments.

     

       522
       522
       -
       

     

       523
       523
       -
             Prompt messages are part of prompt templates exposed by servers through

     

       524
       524
       -
             the prompts/get endpoint. They define structured conversation templates

     

       525
       525
       -
             that can be instantiated with user-provided arguments.

     

       526
       166
        
       

     

       527
       527
       -
             The prompt feature is designed to be user-controlled, with prompts

     

       528
       528
       -
             typically exposed through UI elements like slash commands that users can

     

       529
       529
       -
             explicitly select.

     

       530
       530
       -
       

     

       531
       531
       -
             In JSON-RPC, prompt messages are represented as:

     

       532
       532
       -
             {v

     

       533
       533
       -
             {

     

       534
       534
       -
               "role": "user",

     

       535
       535
       -
               "content": {

     

       536
       536
       -
                 "type": "text",

     

       537
       537
       -
                 "text": "Please review this code: ${code}"

     

       538
       538
       -
               }

     

       539
       539
       -
             }

     

       540
       540
       -
             v}

     

       541
       541
       -
       

     

       542
       542
       -
             Where $code would be replaced with a user-provided argument. *)

     

       543
       543
       -
       

     

       544
       544
       -
         include Json.Jsonable.S with type t := t

     

       167
       167
       +
         val yojson_of_t : t -> Json.t

     

       168
       168
       +
         val t_of_yojson : Json.t -> t

     

       545
       169
        
       end

     

       546
       170
        
       

     

       547
       547
       -
       (** Message for sampling - Messages used in LLM completion requests *)

     

       171
       171
       +
       (** Message for sampling *)

     

       548
       172
        
       module SamplingMessage : sig

     

       549
       173
        
         type t = {

     

       550
       550
       -
           role : Role.t;

     

       551
       551
       -
               (** The role of the message sender (user or assistant). Typically, a

     

       552
       552
       -
                   sampling request will contain multiple messages representing a

     

       553
       553
       -
                   conversation history, with alternating roles. *)

     

       554
       554
       -
           content :

     

       555
       555
       -
             [ `Text of TextContent.t

     

       556
       556
       -
             | `Image of ImageContent.t

     

       557
       557
       -
             | `Audio of AudioContent.t ];

     

       558
       558
       -
               (** The message content, restricted to text, image, or audio (no

     

       559
       559
       -
                   resources). Resources are not included since sampling messages

     

       560
       560
       -
                   represent the actual context window for the LLM, not template

     

       561
       561
       -
                   definitions. *)

     

       174
       174
       +
           role: Role.t;

     

       175
       175
       +
           content: [ `Text of TextContent.t | `Image of ImageContent.t ];

     

       562
       176
        
         }

     

       563
       563
       -
         (** SamplingMessage represents a message in an MCP sampling request, used for

     

       564
       564
       -
             AI model generation based on a prompt.

     

       565
       177
        
       

     

       566
       566
       -
             The sampling feature allows clients to expose language model capabilities

     

       567
       567
       -
             to servers, enabling servers to request completions from the client's LLM.

     

       568
       568
       -
             This is effectively the reverse of the normal MCP flow, with the server

     

       569
       569
       -
             requesting generative capabilities from the client.

     

       570
       570
       -
       

     

       571
       571
       -
             Sampling messages differ from prompt messages in that they don't support

     

       572
       572
       -
             embedded resources, as they represent the actual context window being sent

     

       573
       573
       -
             to the LLM rather than template definitions.

     

       574
       574
       -
       

     

       575
       575
       -
             Clients that support sampling must declare the 'sampling' capability

     

       576
       576
       -
             during initialization. *)

     

       577
       577
       -
       

     

       578
       578
       -
         include Json.Jsonable.S with type t := t

     

       178
       178
       +
         val yojson_of_t : t -> Json.t

     

       179
       179
       +
         val t_of_yojson : Json.t -> t

     

       579
       180
        
       end

     

       580
       181
        
       

     

       581
       182
        
       (** Implementation information *)

     

       582
       183
        
       module Implementation : sig

     

       583
       184
        
         type t = {

     

       584
       584
       -
           name : string;  (** Name of the implementation *)

     

       585
       585
       -
           version : string;  (** Version of the implementation *)

     

       185
       185
       +
           name: string;

     

       186
       186
       +
           version: string;

     

       586
       187
        
         }

     

       587
       587
       -
         (** Implementation provides metadata about client and server implementations,

     

       588
       588
       -
             used during the initialization phase to identify each party. *)

     

       589
       188
        
       

     

       590
       590
       -
         include Json.Jsonable.S with type t := t

     

       189
       189
       +
         val yojson_of_t : t -> Json.t

     

       190
       190
       +
         val t_of_yojson : Json.t -> t

     

       591
       191
        
       end

     

       592
       192
        
       

     

       593
       593
       -
       (** JSONRPC message types - Core message protocol for MCP

     

       594
       594
       -
       

     

       595
       595
       -
           MCP uses JSON-RPC 2.0 as its underlying messaging protocol. All MCP messages

     

       596
       596
       -
           are encoded as JSON-RPC 2.0 messages with UTF-8 encoding, following the

     

       597
       597
       -
           standard JSON-RPC message formats with some MCP-specific extensions.

     

       598
       598
       -
       

     

       599
       599
       -
           MCP defines four message types: 1. Notifications: One-way messages that

     

       600
       600
       -
           don't expect a response 2. Requests: Messages that expect a corresponding

     

       601
       601
       -
           response 3. Responses: Replies to requests with successful results 4.

     

       602
       602
       -
           Errors: Replies to requests with error information

     

       603
       603
       -
       

     

       604
       604
       -
           These can be transported over multiple transport mechanisms:

     

       605
       605
       -
           - stdio: Communication over standard input/output

     

       606
       606
       -
           - Streamable HTTP: HTTP POST/GET with SSE for server streaming

     

       607
       607
       -
           - Custom transports: Implementation-specific transports

     

       608
       608
       -
       

     

       609
       609
       -
           Messages may be sent individually or as part of a JSON-RPC batch. *)

     

       193
       193
       +
       (** JSONRPC message types *)

     

       610
       194
        
       module JSONRPCMessage : sig

     

       611
       195
        
         type notification = {

     

       612
       612
       -
           meth : Method.t;

     

       613
       613
       -
               (** Method for the notification, using the Method.t type to ensure type

     

       614
       614
       -
                   safety. Examples: Method.Initialized, Method.ResourcesUpdated *)

     

       615
       615
       -
           params : Json.t option;

     

       616
       616
       -
               (** Optional parameters for the notification as arbitrary JSON. The

     

       617
       617
       -
                   structure depends on the specific notification method. *)

     

       196
       196
       +
           method_: string;

     

       197
       197
       +
           params: Json.t option;

     

       618
       198
        
         }

     

       619
       619
       -
         (** Notification represents a JSON-RPC notification (one-way message without a

     

       620
       620
       -
             response).

     

       621
       621
       -
       

     

       622
       622
       -
             Notifications are used for events that don't require a response, such as:

     

       623
       623
       -
             - The 'initialized' notification completing initialization

     

       624
       624
       -
             - Resource change notifications

     

       625
       625
       -
             - Progress updates for long-running operations

     

       626
       626
       -
             - List changed notifications for tools, resources, and prompts

     

       627
       627
       -
       

     

       628
       628
       -
             In JSON-RPC, notifications are identified by the absence of an 'id' field:

     

       629
       629
       -
             {v

     

       630
       630
       -
             {

     

       631
       631
       -
               "jsonrpc": "2.0",

     

       632
       632
       -
               "method": "notifications/resources/updated",

     

       633
       633
       -
               "params": {

     

       634
       634
       -
                 "uri": "file:///project/src/main.rs"

     

       635
       635
       -
               }

     

       636
       636
       -
             }

     

       637
       637
       -
             v} *)

     

       638
       199
        
       

     

       639
       200
        
         type request = {

     

       640
       640
       -
           id : RequestId.t;

     

       641
       641
       -
               (** Unique identifier for the request, which will be echoed in the

     

       642
       642
       -
                   response. This can be a string or integer and should be unique

     

       643
       643
       -
                   within the session. *)

     

       644
       644
       -
           meth : Method.t;

     

       645
       645
       -
               (** Method for the request, using the Method.t type to ensure type

     

       646
       646
       -
                   safety. Examples: Method.Initialize, Method.ResourcesRead,

     

       647
       647
       -
                   Method.ToolsCall *)

     

       648
       648
       -
           params : Json.t option;

     

       649
       649
       -
               (** Optional parameters for the request as arbitrary JSON. The structure

     

       650
       650
       -
                   depends on the specific request method. *)

     

       651
       651
       -
           progress_token : ProgressToken.t option;

     

       652
       652
       -
               (** Optional progress token for long-running operations. If provided,

     

       653
       653
       -
                   the server can send progress notifications using this token to

     

       654
       654
       -
                   inform the client about the operation's status. *)

     

       201
       201
       +
           id: RequestId.t;

     

       202
       202
       +
           method_: string;

     

       203
       203
       +
           params: Json.t option;

     

       204
       204
       +
           progress_token: ProgressToken.t option;

     

       655
       205
        
         }

     

       656
       656
       -
         (** Request represents a JSON-RPC request that expects a response.

     

       657
       657
       -
       

     

       658
       658
       -
             Requests are used for operations that require a response, such as:

     

       659
       659
       -
             - Initialization

     

       660
       660
       -
             - Listing resources, tools, or prompts

     

       661
       661
       -
             - Reading resources

     

       662
       662
       -
             - Calling tools

     

       663
       663
       -
             - Getting prompts

     

       664
       664
       -
       

     

       665
       665
       -
             In JSON-RPC, requests include an 'id' field that correlates with the

     

       666
       666
       -
             response:

     

       667
       667
       -
             {v

     

       668
       668
       -
             {

     

       669
       669
       -
               "jsonrpc": "2.0",

     

       670
       670
       -
               "id": 1,

     

       671
       671
       -
               "method": "resources/read",

     

       672
       672
       -
               "params": {

     

       673
       673
       -
                 "uri": "file:///project/src/main.rs"

     

       674
       674
       -
               }

     

       675
       675
       -
             }

     

       676
       676
       -
             v} *)

     

       677
       206
        
       

     

       678
       207
        
         type response = {

     

       679
       679
       -
           id : RequestId.t;

     

       680
       680
       -
               (** ID matching the original request, allowing clients to correlate

     

       681
       681
       -
                   responses with their originating requests, especially important when

     

       682
       682
       -
                   multiple requests are in flight. *)

     

       683
       683
       -
           result : Json.t;

     

       684
       684
       -
               (** Result of the successful request as arbitrary JSON. The structure

     

       685
       685
       -
                   depends on the specific request method that was called. *)

     

       208
       208
       +
           id: RequestId.t;

     

       209
       209
       +
           result: Json.t;

     

       686
       210
        
         }

     

       687
       687
       -
         (** Response represents a successful JSON-RPC response to a request.

     

       688
       688
       -
       

     

       689
       689
       -
             Responses are sent in reply to requests and contain the successful result.

     

       690
       690
       -
             Each response must include the same ID as its corresponding request.

     

       691
       691
       -
       

     

       692
       692
       -
             In JSON-RPC, responses include the 'id' field matching the request:

     

       693
       693
       -
             {v

     

       694
       694
       -
             {

     

       695
       695
       -
               "jsonrpc": "2.0",

     

       696
       696
       -
               "id": 1,

     

       697
       697
       -
               "result": {

     

       698
       698
       -
                 "contents": [

     

       699
       699
       -
                   {

     

       700
       700
       -
                     "uri": "file:///project/src/main.rs",

     

       701
       701
       -
                     "mimeType": "text/x-rust",

     

       702
       702
       -
                     "text": "fn main() {\n    println!(\"Hello world!\");\n}"

     

       703
       703
       -
                   }

     

       704
       704
       -
                 ]

     

       705
       705
       -
               }

     

       706
       706
       -
             }

     

       707
       707
       -
             v} *)

     

       708
       211
        
       

     

       709
       212
        
         type error = {

     

       710
       710
       -
           id : RequestId.t;

     

       711
       711
       -
               (** ID matching the original request, allowing clients to correlate

     

       712
       712
       -
                   errors with their originating requests. *)

     

       713
       713
       -
           code : int;

     

       714
       714
       -
               (** Error code indicating the type of error, following the JSON-RPC

     

       715
       715
       -
                   standard. Common codes include:

     

       716
       716
       -
                   - -32700: Parse error

     

       717
       717
       -
                   - -32600: Invalid request

     

       718
       718
       -
                   - -32601: Method not found

     

       719
       719
       -
                   - -32602: Invalid params

     

       720
       720
       -
                   - -32603: Internal error

     

       721
       721
       -
                   - -32002: Resource not found (MCP-specific)

     

       722
       722
       -
                   - -32001: Authentication required (MCP-specific) *)

     

       723
       723
       -
           message : string;

     

       724
       724
       -
               (** Human-readable error message describing the issue. This should be

     

       725
       725
       -
                   concise but informative enough for debugging. *)

     

       726
       726
       -
           data : Json.t option;

     

       727
       727
       -
               (** Optional additional error data as arbitrary JSON. This can provide

     

       728
       728
       -
                   more context about the error, such as which resource wasn't found or

     

       729
       729
       -
                   which parameter was invalid. *)

     

       213
       213
       +
           id: RequestId.t;

     

       214
       214
       +
           code: int;

     

       215
       215
       +
           message: string;

     

       216
       216
       +
           data: Json.t option;

     

       730
       217
        
         }

     

       731
       731
       -
         (** Error represents an error response to a JSON-RPC request.

     

       732
       218
        
       

     

       733
       733
       -
             Errors are sent in reply to requests when processing fails. Each error

     

       734
       734
       -
             must include the same ID as its corresponding request.

     

       735
       735
       -
       

     

       736
       736
       -
             MCP defines several standard error codes:

     

       737
       737
       -
             - Standard JSON-RPC errors (-32700 to -32603)

     

       738
       738
       -
             - MCP-specific errors (-32002 for resource not found, etc.)

     

       739
       739
       -
       

     

       740
       740
       -
             In JSON-RPC, errors follow this structure:

     

       741
       741
       -
             {v

     

       742
       742
       -
             {

     

       743
       743
       -
               "jsonrpc": "2.0",

     

       744
       744
       -
               "id": 1,

     

       745
       745
       -
               "error": {

     

       746
       746
       -
                 "code": -32002,

     

       747
       747
       -
                 "message": "Resource not found",

     

       748
       748
       -
                 "data": {

     

       749
       749
       -
                   "uri": "file:///nonexistent.txt"

     

       750
       750
       -
                 }

     

       751
       751
       -
               }

     

       752
       752
       -
             }

     

       753
       753
       -
             v} *)

     

       754
       754
       -
       

     

       755
       755
       -
         (** Union type for all JSON-RPC message kinds, providing a single type that

     

       756
       756
       -
             can represent any MCP message. *)

     

       757
       219
        
         type t =

     

       758
       220
        
           | Notification of notification

     

       759
       221
        
           | Request of request

     
···

       761
       223
        
           | Error of error

     

       762
       224
        
       

     

       763
       225
        
         val yojson_of_notification : notification -> Json.t

     

       764
       764
       -
         (** Convert notification to Yojson representation

     

       765
       765
       -
             @param notification The notification to convert

     

       766
       766
       -
             @return JSON representation of the notification *)

     

       767
       767
       -
       

     

       768
       226
        
         val yojson_of_request : request -> Json.t

     

       769
       769
       -
         (** Convert request to Yojson representation

     

       770
       770
       -
             @param request The request to convert

     

       771
       771
       -
             @return JSON representation of the request *)

     

       772
       772
       -
       

     

       773
       227
        
         val yojson_of_response : response -> Json.t

     

       774
       774
       -
         (** Convert response to Yojson representation

     

       775
       775
       -
             @param response The response to convert

     

       776
       776
       -
             @return JSON representation of the response *)

     

       777
       777
       -
       

     

       778
       228
        
         val yojson_of_error : error -> Json.t

     

       779
       779
       -
         (** Convert error to Yojson representation

     

       780
       780
       -
             @param error The error to convert

     

       781
       781
       -
             @return JSON representation of the error *)

     

       782
       782
       -
       

     

       783
       229
        
         val yojson_of_t : t -> Json.t

     

       784
       784
       -
         (** Convert any message to Yojson representation

     

       785
       785
       -
             @param message The message to convert

     

       786
       786
       -
             @return JSON representation of the message *)

     

       787
       230
        
       

     

       788
       231
        
         val notification_of_yojson : Json.t -> notification

     

       789
       789
       -
         (** Convert Yojson representation to notification

     

       790
       790
       -
             @param json JSON representation of a notification

     

       791
       791
       -
             @return Parsed notification object

     

       792
       792
       -
             @raise Parse error if the JSON is not a valid notification *)

     

       793
       793
       -
       

     

       794
       232
        
         val request_of_yojson : Json.t -> request

     

       795
       795
       -
         (** Convert Yojson representation to request

     

       796
       796
       -
             @param json JSON representation of a request

     

       797
       797
       -
             @return Parsed request object

     

       798
       798
       -
             @raise Parse error if the JSON is not a valid request *)

     

       799
       799
       -
       

     

       800
       233
        
         val response_of_yojson : Json.t -> response

     

       801
       801
       -
         (** Convert Yojson representation to response

     

       802
       802
       -
             @param json JSON representation of a response

     

       803
       803
       -
             @return Parsed response object

     

       804
       804
       -
             @raise Parse error if the JSON is not a valid response *)

     

       805
       805
       -
       

     

       806
       234
        
         val error_of_yojson : Json.t -> error

     

       807
       807
       -
         (** Convert Yojson representation to error

     

       808
       808
       -
             @param json JSON representation of an error

     

       809
       809
       -
             @return Parsed error object

     

       810
       810
       -
             @raise Parse error if the JSON is not a valid error *)

     

       811
       811
       -
       

     

       812
       235
        
         val t_of_yojson : Json.t -> t

     

       813
       813
       -
         (** Convert Yojson representation to any message

     

       814
       814
       -
             @param json JSON representation of any message type

     

       815
       815
       -
             @return Parsed message object

     

       816
       816
       -
             @raise Parse error if the JSON is not a valid message *)

     

       817
       236
        
       

     

       818
       818
       -
         val create_notification : ?params:Json.t option -> meth:Method.t -> unit -> t

     

       819
       819
       -
         (** Create a new notification message

     

       820
       820
       -
             @param params Optional parameters for the notification

     

       821
       821
       -
             @param meth Method name for the notification

     

       822
       822
       -
             @return A new JSON-RPC notification message *)

     

       823
       823
       -
       

     

       824
       824
       -
         val create_request :

     

       825
       825
       -
           ?params:Json.t option ->

     

       826
       826
       -
           ?progress_token:ProgressToken.t option ->

     

       827
       827
       -
           id:RequestId.t ->

     

       828
       828
       -
           meth:Method.t ->

     

       829
       829
       -
           unit ->

     

       830
       830
       -
           t

     

       831
       831
       -
         (** Create a new request message

     

       832
       832
       -
             @param params Optional parameters for the request

     

       833
       833
       -
             @param progress_token Optional progress token for long-running operations

     

       834
       834
       -
             @param id Unique identifier for the request

     

       835
       835
       -
             @param meth Method name for the request

     

       836
       836
       -
             @return A new JSON-RPC request message *)

     

       837
       837
       -
       

     

       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

     

       838
       239
        
         val create_response : id:RequestId.t -> result:Json.t -> t

     

       839
       839
       -
         (** Create a new response message

     

       840
       840
       -
             @param id ID matching the original request

     

       841
       841
       -
             @param result Result of the successful request

     

       842
       842
       -
             @return A new JSON-RPC response message *)

     

       843
       843
       -
       

     

       844
       844
       -
         val create_error :

     

       845
       845
       -
           id:RequestId.t ->

     

       846
       846
       -
           code:int ->

     

       847
       847
       -
           message:string ->

     

       848
       848
       -
           ?data:Json.t option ->

     

       849
       849
       -
           unit ->

     

       850
       850
       -
           t

     

       851
       851
       -
         (** Create a new error message

     

       852
       852
       -
             @param id ID matching the original request

     

       853
       853
       -
             @param code Error code indicating the type of error

     

       854
       854
       -
             @param message Human-readable error message

     

       855
       855
       -
             @param data Optional additional error data

     

       856
       856
       -
             @return A new JSON-RPC error message *)

     

       240
       240
       +
         val create_error : id:RequestId.t -> code:int -> message:string -> ?data:Json.t option -> unit -> t

     

       857
       241
        
       end

     

       858
       242
        
       

     

       859
       859
       -
       (** Initialize request/response - The first phase of the MCP lifecycle

     

       860
       860
       -
       

     

       861
       861
       -
           The initialization phase is the mandatory first interaction between client

     

       862
       862
       -
           and server. During this phase, the protocol version is negotiated and

     

       863
       863
       -
           capabilities are exchanged to determine which optional features will be

     

       864
       864
       -
           available during the session.

     

       865
       865
       -
       

     

       866
       866
       -
           This follows a strict sequence: 1. Client sends an InitializeRequest

     

       867
       867
       -
           containing its capabilities and protocol version 2. Server responds with an

     

       868
       868
       -
           InitializeResult containing its capabilities and protocol version 3. Client

     

       869
       869
       -
           sends an InitializedNotification to signal it's ready for normal operations

     

       870
       870
       -
       

     

       871
       871
       -
           The Initialize module handles steps 1 and 2 of this process. *)

     

       243
       243
       +
       (** Initialize request/response *)

     

       872
       244
        
       module Initialize : sig

     

       873
       245
        
         (** Initialize request *)

     

       874
       246
        
         module Request : sig

     

       875
       247
        
           type t = {

     

       876
       876
       -
             capabilities : Json.t;

     

       877
       877
       -
                 (** ClientCapabilities that define supported optional features. This

     

       878
       878
       -
                     includes which optional protocol features the client supports,

     

       879
       879
       -
                     such as 'roots' (filesystem access), 'sampling' (LLM generation),

     

       880
       880
       -
                     and any experimental features. *)

     

       881
       881
       -
             client_info : Implementation.t;

     

       882
       882
       -
                 (** Client implementation details (name and version) used for

     

       883
       883
       -
                     identification and debugging. Helps servers understand which

     

       884
       884
       -
                     client they're working with. *)

     

       885
       885
       -
             protocol_version : string;

     

       886
       886
       -
                 (** MCP protocol version supported by the client, formatted as

     

       887
       887
       -
                     YYYY-MM-DD according to the MCP versioning scheme. Example:

     

       888
       888
       -
                     "2025-03-26" *)

     

       248
       248
       +
             capabilities: Json.t; (** ClientCapabilities *)

     

       249
       249
       +
             client_info: Implementation.t;

     

       250
       250
       +
             protocol_version: string;

     

       889
       251
        
           }

     

       890
       890
       -
           (** InitializeRequest starts the MCP lifecycle, negotiating capabilities and

     

       891
       891
       -
               protocol versions between client and server. This is always the first

     

       892
       892
       -
               message sent by the client and MUST NOT be part of a JSON-RPC batch.

     

       893
       252
        
       

     

       894
       894
       -
               The client SHOULD send the latest protocol version it supports. If the

     

       895
       895
       -
               server does not support this version, it will respond with a version it

     

       896
       896
       -
               does support, and the client must either use that version or disconnect.

     

       897
       897
       -
           *)

     

       898
       898
       -
       

     

       899
       899
       -
           include Json.Jsonable.S with type t := t

     

       900
       900
       -
       

     

       901
       901
       -
           val create :

     

       902
       902
       -
             capabilities:Json.t ->

     

       903
       903
       -
             client_info:Implementation.t ->

     

       904
       904
       -
             protocol_version:string ->

     

       905
       905
       -
             t

     

       906
       906
       -
           (** Create a new initialization request

     

       907
       907
       -
               @param capabilities

     

       908
       908
       -
                 Client capabilities that define supported optional features

     

       909
       909
       -
               @param client_info Client implementation details

     

       910
       910
       -
               @param protocol_version MCP protocol version supported by the client

     

       911
       911
       -
               @return A new initialization request *)

     

       253
       253
       +
           val yojson_of_t : t -> Json.t

     

       254
       254
       +
           val t_of_yojson : Json.t -> t

     

       912
       255
        
       

     

       256
       256
       +
           val create : capabilities:Json.t -> client_info:Implementation.t -> protocol_version:string -> t

     

       913
       257
        
           val to_jsonrpc : id:RequestId.t -> t -> JSONRPCMessage.t

     

       914
       914
       -
           (** Convert to JSON-RPC message

     

       915
       915
       -
               @param id Unique request identifier

     

       916
       916
       -
               @param t Initialization request

     

       917
       917
       -
               @return JSON-RPC message containing the initialization request *)

     

       918
       258
        
         end

     

       919
       259
        
       

     

       920
       260
        
         (** Initialize result *)

     

       921
       261
        
         module Result : sig

     

       922
       262
        
           type t = {

     

       923
       923
       -
             capabilities : Json.t;

     

       924
       924
       -
                 (** ServerCapabilities that define supported optional features. This

     

       925
       925
       -
                     declares which server features are available, including:

     

       926
       926
       -
                     - prompts: Server provides prompt templates

     

       927
       927
       -
                     - resources: Server provides readable resources

     

       928
       928
       -
                     - tools: Server exposes callable tools

     

       929
       929
       -
                     - logging: Server emits structured log messages

     

       930
       930
       -
       

     

       931
       931
       -
                     Each capability may have sub-capabilities like:

     

       932
       932
       -
                     - listChanged: Server will notify when available items change

     

       933
       933
       -
                     - subscribe: Clients can subscribe to individual resources *)

     

       934
       934
       -
             server_info : Implementation.t;

     

       935
       935
       -
                 (** Server implementation details (name and version) used for

     

       936
       936
       -
                     identification and debugging. Helps clients understand which

     

       937
       937
       -
                     server they're working with. *)

     

       938
       938
       -
             protocol_version : string;

     

       939
       939
       -
                 (** MCP protocol version supported by the server, formatted as

     

       940
       940
       -
                     YYYY-MM-DD. If the server supports the client's requested version,

     

       941
       941
       -
                     it responds with the same version. Otherwise, it responds with a

     

       942
       942
       -
                     version it does support. *)

     

       943
       943
       -
             instructions : string option;

     

       944
       944
       -
                 (** Optional instructions for using the server. These can provide

     

       945
       945
       -
                     human-readable guidance on how to interact with this specific

     

       946
       946
       -
                     server implementation. *)

     

       947
       947
       -
             meta : Json.t option;

     

       948
       948
       -
                 (** Optional additional metadata as arbitrary JSON. Can contain

     

       949
       949
       -
                     server-specific information not covered by the standard fields. *)

     

       263
       263
       +
             capabilities: Json.t; (** ServerCapabilities *)

     

       264
       264
       +
             server_info: Implementation.t;

     

       265
       265
       +
             protocol_version: string;

     

       266
       266
       +
             instructions: string option;

     

       267
       267
       +
             meta: Json.t option;

     

       950
       268
        
           }

     

       951
       951
       -
           (** InitializeResult is the server's response to an initialization request,

     

       952
       952
       -
               completing capability negotiation and establishing the protocol version.

     

       953
       953
       -
       

     

       954
       954
       -
               After receiving this message, the client must send an

     

       955
       955
       -
               InitializedNotification. The server should not send any requests other

     

       956
       956
       -
               than pings and logging before receiving the initialized notification. *)

     

       957
       957
       -
       

     

       958
       958
       -
           include Json.Jsonable.S with type t := t

     

       959
       269
        
       

     

       960
       960
       -
           val create :

     

       961
       961
       -
             capabilities:Json.t ->

     

       962
       962
       -
             server_info:Implementation.t ->

     

       963
       963
       -
             protocol_version:string ->

     

       964
       964
       -
             ?instructions:string ->

     

       965
       965
       -
             ?meta:Json.t ->

     

       966
       966
       -
             unit ->

     

       967
       967
       -
             t

     

       968
       968
       -
           (** Create a new initialization result

     

       969
       969
       -
               @param capabilities

     

       970
       970
       -
                 Server capabilities that define supported optional features

     

       971
       971
       -
               @param server_info Server implementation details

     

       972
       972
       -
               @param protocol_version MCP protocol version supported by the server

     

       973
       973
       -
               @param instructions Optional instructions for using the server

     

       974
       974
       -
               @param meta Optional additional metadata

     

       975
       975
       -
               @return A new initialization result *)

     

       270
       270
       +
           val yojson_of_t : t -> Json.t

     

       271
       271
       +
           val t_of_yojson : Json.t -> t

     

       976
       272
        
       

     

       273
       273
       +
           val create : capabilities:Json.t -> server_info:Implementation.t -> protocol_version:string -> ?instructions:string -> ?meta:Json.t -> unit -> t

     

       977
       274
        
           val to_jsonrpc : id:RequestId.t -> t -> JSONRPCMessage.t

     

       978
       978
       -
           (** Convert to JSON-RPC message

     

       979
       979
       -
               @param id ID matching the original request

     

       980
       980
       -
               @param t Initialization result

     

       981
       981
       -
               @return JSON-RPC message containing the initialization result *)

     

       982
       275
        
         end

     

       983
       276
        
       end

     

       984
       277
        
       

     

       985
       985
       -
       (** Initialized notification - Completes the initialization phase of the MCP

     

       986
       986
       -
           lifecycle *)

     

       278
       278
       +
       (** Initialized notification *)

     

       987
       279
        
       module Initialized : sig

     

       988
       280
        
         module Notification : sig

     

       989
       281
        
           type t = {

     

       990
       990
       -
             meta : Json.t option;

     

       991
       991
       -
                 (** Optional additional metadata as arbitrary JSON. Can contain

     

       992
       992
       -
                     client-specific information not covered by the standard fields. *)

     

       282
       282
       +
             meta: Json.t option;

     

       993
       283
        
           }

     

       994
       994
       -
           (** InitializedNotification is sent by the client after receiving the

     

       995
       995
       -
               initialization response, indicating it's ready to begin normal

     

       996
       996
       -
               operations. This completes the three-step initialization process, after

     

       997
       997
       -
               which both client and server can freely exchange messages according to

     

       998
       998
       -
               the negotiated capabilities.

     

       999
       284
        
       

     

       1000
       1000
       -
               Only after this notification has been sent should the client begin

     

       1001
       1001
       -
               normal operations like listing resources, calling tools, or requesting

     

       1002
       1002
       -
               prompts. *)

     

       1003
       1003
       -
       

     

       1004
       1004
       -
           include Json.Jsonable.S with type t := t

     

       285
       285
       +
           val yojson_of_t : t -> Json.t

     

       286
       286
       +
           val t_of_yojson : Json.t -> t

     

       1005
       287
        
       

     

       1006
       288
        
           val create : ?meta:Json.t -> unit -> t

     

       1007
       1007
       -
           (** Create a new initialized notification

     

       1008
       1008
       -
               @param meta Optional additional metadata

     

       1009
       1009
       -
               @return A new initialized notification *)

     

       1010
       1010
       -
       

     

       1011
       289
        
           val to_jsonrpc : t -> JSONRPCMessage.t

     

       1012
       1012
       -
           (** Convert to JSON-RPC message

     

       1013
       1013
       -
               @param t Initialized notification

     

       1014
       1014
       -
               @return JSON-RPC message containing the initialized notification *)

     

       1015
       290
        
         end

     

       1016
       291
        
       end

     

       1017
       292
        
       

     

       1018
       1018
       -
       val parse_message : Json.t -> JSONRPCMessage.t

     

       1019
       1019
       -
       (** Parse a JSON message into an MCP message

     

       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
       +
         }

     

       1020
       300
        
       

     

       1021
       1021
       -
           This function takes a raw JSON value and parses it into a structured MCP

     

       1022
       1022
       -
           message. It's the primary entry point for processing incoming JSON-RPC

     

       1023
       1023
       -
           messages in the MCP protocol.

     

       301
       301
       +
         val yojson_of_t : t -> Json.t

     

       302
       302
       +
         val t_of_yojson : Json.t -> t

     

       303
       303
       +
       end

     

       1024
       304
        
       

     

       1025
       1025
       -
           The function determines the message type (notification, request, response,

     

       1026
       1026
       -
           or error) based on the presence and values of specific fields:

     

       1027
       1027
       -
           - A message with "method" but no "id" is a notification

     

       1028
       1028
       -
           - A message with "method" and "id" is a request

     

       1029
       1029
       -
           - A message with "id" and "result" is a response

     

       1030
       1030
       -
           - A message with "id" and "error" is an error

     

       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

     

       1031
       316
        
       

     

       1032
       1032
       -
           @param json

     

       1033
       1033
       -
             The JSON message to parse, typically received from the transport layer

     

       1034
       1034
       -
           @return The parsed MCP message as a structured JSONRPCMessage.t value

     

       1035
       1035
       -
           @raise Parse error if the JSON cannot be parsed as a valid MCP message *)

     

       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
       +
         }

     

       1036
       327
        
       

     

       1037
       1037
       -
       val create_notification :

     

       1038
       1038
       -
         ?params:Json.t option -> meth:Method.t -> unit -> JSONRPCMessage.t

     

       1039
       1039
       -
       (** Create a new notification message

     

       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
       +
         }

     

       1040
       341
        
       

     

       1041
       1041
       -
           Notifications are one-way messages that don't expect a response. This is a

     

       1042
       1042
       -
           convenience wrapper around JSONRPCMessage.create_notification.

     

       342
       342
       +
         val yojson_of_t : t -> Json.t

     

       343
       343
       +
         val t_of_yojson : Json.t -> t

     

       344
       344
       +
       end

     

       1043
       345
        
       

     

       1044
       1044
       -
           Common notifications in MCP include:

     

       1045
       1045
       -
           - "notifications/initialized" - Sent after initialization

     

       1046
       1046
       -
           - "notifications/progress" - Updates on long-running operations

     

       1047
       1047
       -
           - "notifications/resources/updated" - Resource content changed

     

       1048
       1048
       -
           - "notifications/prompts/list_changed" - Available prompts changed

     

       1049
       1049
       -
           - "notifications/tools/list_changed" - Available tools changed

     

       346
       346
       +
       (** Resource Reference *)

     

       347
       347
       +
       module ResourceReference : sig

     

       348
       348
       +
         type t = {

     

       349
       349
       +
           uri: string;

     

       350
       350
       +
         }

     

       1050
       351
        
       

     

       1051
       1051
       -
           @param params Optional parameters for the notification as a JSON value

     

       1052
       1052
       -
           @param meth Method type for the notification

     

       1053
       1053
       -
           @return A new JSON-RPC notification message *)

     

       352
       352
       +
         val yojson_of_t : t -> Json.t

     

       353
       353
       +
         val t_of_yojson : Json.t -> t

     

       354
       354
       +
       end

     

       1054
       355
        
       

     

       1055
       1055
       -
       val create_request :

     

       1056
       1056
       -
         ?params:Json.t option ->

     

       1057
       1057
       -
         ?progress_token:ProgressToken.t option ->

     

       1058
       1058
       -
         id:RequestId.t ->

     

       1059
       1059
       -
         meth:Method.t ->

     

       1060
       1060
       -
         unit ->

     

       1061
       1061
       -
         JSONRPCMessage.t

     

       1062
       1062
       -
       (** Create a new request message

     

       356
       356
       +
       (** Prompt Reference *)

     

       357
       357
       +
       module PromptReference : sig

     

       358
       358
       +
         type t = {

     

       359
       359
       +
           name: string;

     

       360
       360
       +
         }

     

       1063
       361
        
       

     

       1064
       1064
       -
           Requests are messages that expect a corresponding response. This is a

     

       1065
       1065
       -
           convenience wrapper around JSONRPCMessage.create_request.

     

       362
       362
       +
         val yojson_of_t : t -> Json.t

     

       363
       363
       +
         val t_of_yojson : Json.t -> t

     

       364
       364
       +
       end

     

       1066
       365
        
       

     

       1067
       1067
       -
           Common requests in MCP include:

     

       1068
       1068
       -
           - "initialize" - Start the MCP lifecycle

     

       1069
       1069
       -
           - "resources/list" - Discover available resources

     

       1070
       1070
       -
           - "resources/read" - Retrieve resource contents

     

       1071
       1071
       -
           - "tools/list" - Discover available tools

     

       1072
       1072
       -
           - "tools/call" - Invoke a tool

     

       1073
       1073
       -
           - "prompts/list" - Discover available prompts

     

       1074
       1074
       -
           - "prompts/get" - Retrieve a prompt template

     

       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
       +
           }

     

       1075
       373
        
       

     

       1076
       1076
       -
           @param params Optional parameters for the request as a JSON value

     

       1077
       1077
       -
           @param progress_token

     

       1078
       1078
       -
             Optional progress token for long-running operations that can report

     

       1079
       1079
       -
             progress updates

     

       1080
       1080
       -
           @param id

     

       1081
       1081
       -
             Unique identifier for the request, used to correlate with the response

     

       1082
       1082
       -
           @param meth Method type for the request

     

       1083
       1083
       -
           @return A new JSON-RPC request message *)

     

       374
       374
       +
           val yojson_of_t : t -> Json.t

     

       375
       375
       +
           val t_of_yojson : Json.t -> t

     

       376
       376
       +
         end

     

       1084
       377
        
       

     

       1085
       1085
       -
       val create_response : id:RequestId.t -> result:Json.t -> JSONRPCMessage.t

     

       1086
       1086
       -
       (** Create a new response message

     

       378
       378
       +
         module Request : sig

     

       379
       379
       +
           type reference = [ `Prompt of PromptReference.t | `Resource of ResourceReference.t ]

     

       1087
       380
        
       

     

       1088
       1088
       -
           Responses are sent in reply to requests and contain successful results. This

     

       1089
       1089
       -
           is a convenience wrapper around JSONRPCMessage.create_response.

     

       381
       381
       +
           type t = {

     

       382
       382
       +
             argument: Argument.t;

     

       383
       383
       +
             ref: reference;

     

       384
       384
       +
           }

     

       1090
       385
        
       

     

       1091
       1091
       -
           Each response must include the same ID as its corresponding request to allow

     

       1092
       1092
       -
           the client to correlate them, especially when multiple requests are in

     

       1093
       1093
       -
           flight simultaneously.

     

       386
       386
       +
           val yojson_of_t : t -> Json.t

     

       387
       387
       +
           val t_of_yojson : Json.t -> t

     

       1094
       388
        
       

     

       1095
       1095
       -
           @param id ID matching the original request

     

       1096
       1096
       -
           @param result Result of the successful request as a JSON value

     

       1097
       1097
       -
           @return A new JSON-RPC response message *)

     

       389
       389
       +
           val yojson_of_reference : reference -> Json.t

     

       390
       390
       +
           val reference_of_yojson : Json.t -> reference

     

       1098
       391
        
       

     

       1099
       1099
       -
       val create_error :

     

       1100
       1100
       -
         id:RequestId.t ->

     

       1101
       1101
       -
         code:int ->

     

       1102
       1102
       -
         message:string ->

     

       1103
       1103
       -
         ?data:Json.t option ->

     

       1104
       1104
       -
         unit ->

     

       1105
       1105
       -
         JSONRPCMessage.t

     

       1106
       1106
       -
       (** Create a new error message

     

       392
       392
       +
           val create : argument:Argument.t -> ref:reference -> t

     

       393
       393
       +
           val to_params : t -> Json.t

     

       394
       394
       +
         end

     

       1107
       395
        
       

     

       1108
       1108
       -
           Errors are sent in reply to requests when processing fails. This is a

     

       1109
       1109
       -
           convenience wrapper around JSONRPCMessage.create_error.

     

       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
       +
           }

     

       1110
       402
        
       

     

       1111
       1111
       -
           MCP uses standard JSON-RPC error codes as well as some protocol-specific

     

       1112
       1112
       -
           codes:

     

       1113
       1113
       -
           - -32700: Parse error (invalid JSON)

     

       1114
       1114
       -
           - -32600: Invalid request (malformed JSON-RPC)

     

       1115
       1115
       -
           - -32601: Method not found

     

       1116
       1116
       -
           - -32602: Invalid parameters

     

       1117
       1117
       -
           - -32603: Internal error

     

       1118
       1118
       -
           - -32002: Resource not found (MCP-specific)

     

       1119
       1119
       -
           - -32001: Authentication required (MCP-specific)

     

       403
       403
       +
           type t = {

     

       404
       404
       +
             completion: completion;

     

       405
       405
       +
             meta: Json.t option;

     

       406
       406
       +
           }

     

       1120
       407
        
       

     

       1121
       1121
       -
           @param id ID matching the original request

     

       1122
       1122
       -
           @param code Error code indicating the type of error

     

       1123
       1123
       -
           @param message Human-readable error message describing the issue

     

       1124
       1124
       -
           @param data Optional additional error data providing more context

     

       1125
       1125
       -
           @return A new JSON-RPC error message *)

     

       408
       408
       +
           val yojson_of_completion : completion -> Json.t

     

       409
       409
       +
           val completion_of_yojson : Json.t -> completion

     

       1126
       410
        
       

     

       1127
       1127
       -
       val make_text_content : string -> content

     

       1128
       1128
       -
       (** Create a new text content object

     

       1129
       1129
       -
           @param text The text content

     

       1130
       1130
       -
           @return A content value with the text *)

     

       411
       411
       +
           val yojson_of_t : t -> Json.t

     

       412
       412
       +
           val t_of_yojson : Json.t -> t

     

       1131
       413
        
       

     

       1132
       1132
       -
       val make_image_content : string -> string -> content

     

       1133
       1133
       -
       (** Create a new image content object

     

       1134
       1134
       -
           @param data Base64-encoded image data

     

       1135
       1135
       -
           @param mime_type MIME type of the image (e.g., "image/png", "image/jpeg")

     

       1136
       1136
       -
           @return A content value with the image *)

     

       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

     

       1137
       418
        
       

     

       1138
       1138
       -
       val make_audio_content : string -> string -> content

     

       1139
       1139
       -
       (** Create a new audio content object

     

       1140
       1140
       -
           @param data Base64-encoded audio data

     

       1141
       1141
       -
           @param mime_type MIME type of the audio (e.g., "audio/wav", "audio/mp3")

     

       1142
       1142
       -
           @return A content value with the audio *)

     

       419
       419
       +
       (** Parse a JSON message into an MCP message *)

     

       420
       420
       +
       val parse_message : Json.t -> JSONRPCMessage.t

     

       1143
       421
        
       

     

       1144
       1144
       -
       val make_resource_text_content : string -> string -> string option -> content

     

       1145
       1145
       -
       (** Create a new text resource content object

     

       1146
       1146
       -
           @param uri URI that uniquely identifies the resource

     

       1147
       1147
       -
           @param text The text content of the resource

     

       1148
       1148
       -
           @param mime_type Optional MIME type of the text content

     

       1149
       1149
       -
           @return A content value with the text resource *)

     

       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

     

       1150
       427
        
       

     

       1151
       1151
       -
       val make_resource_blob_content : string -> string -> string option -> content

     

       1152
       1152
       -
       (** Create a new binary resource content object

     

       1153
       1153
       -
           @param uri URI that uniquely identifies the resource

     

       1154
       1154
       -
           @param blob Base64-encoded binary data

     

       1155
       1155
       -
           @param mime_type Optional MIME type of the binary content

     

       1156
       1156
       -
           @return A content value with the binary resource *)

     

       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

-833

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 = { cursor : Cursor.t option }

     

       10
       10
       -
       

     

       11
       11
       -
           let yojson_of_t { cursor } =

     

       12
       12
       -
             let assoc = [] in

     

       13
       13
       -
             let assoc =

     

       14
       14
       -
               match cursor with

     

       15
       15
       -
               | Some c -> ("cursor", Cursor.yojson_of_t c) :: assoc

     

       16
       16
       -
               | None -> assoc

     

       17
       17
       -
             in

     

       18
       18
       -
             `Assoc assoc

     

       19
       19
       -
       

     

       20
       20
       -
           let t_of_yojson = function

     

       21
       21
       -
             | `Assoc fields ->

     

       22
       22
       -
                 let cursor =

     

       23
       23
       -
                   List.assoc_opt "cursor" fields |> Option.map Cursor.t_of_yojson

     

       24
       24
       -
                 in

     

       25
       25
       -
                 { cursor }

     

       26
       26
       -
             | j -> Util.json_error "Expected object for ResourcesList.Request.t" j

     

       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 = [ ("uri", `String uri); ("name", `String name) ] in

     

       40
       40
       -
             let assoc =

     

       41
       41
       -
               match description with

     

       42
       42
       -
               | Some desc -> ("description", `String desc) :: assoc

     

       43
       43
       -
               | None -> assoc

     

       44
       44
       -
             in

     

       45
       45
       -
             let assoc =

     

       46
       46
       -
               match mime_type with

     

       47
       47
       -
               | Some mime -> ("mimeType", `String mime) :: assoc

     

       48
       48
       -
               | None -> assoc

     

       49
       49
       -
             in

     

       50
       50
       -
             let assoc =

     

       51
       51
       -
               match size with Some s -> ("size", `Int s) :: assoc | None -> assoc

     

       52
       52
       -
             in

     

       53
       53
       -
             `Assoc assoc

     

       54
       54
       -
       

     

       55
       55
       -
           let t_of_yojson = function

     

       56
       56
       -
             | `Assoc fields as json ->

     

       57
       57
       -
                 let uri =

     

       58
       58
       -
                   match List.assoc_opt "uri" fields with

     

       59
       59
       -
                   | Some (`String s) -> s

     

       60
       60
       -
                   | _ -> Util.json_error "Missing or invalid 'uri' field" json

     

       61
       61
       -
                 in

     

       62
       62
       -
                 let name =

     

       63
       63
       -
                   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 =

     

       68
       68
       -
                   List.assoc_opt "description" fields

     

       69
       69
       -
                   |> Option.map (function

     

       70
       70
       -
                        | `String s -> s

     

       71
       71
       -
                        | j -> Util.json_error "Expected string for description" j)

     

       72
       72
       -
                 in

     

       73
       73
       -
                 let mime_type =

     

       74
       74
       -
                   List.assoc_opt "mimeType" fields

     

       75
       75
       -
                   |> Option.map (function

     

       76
       76
       -
                        | `String s -> s

     

       77
       77
       -
                        | j -> Util.json_error "Expected string for mimeType" j)

     

       78
       78
       -
                 in

     

       79
       79
       -
                 let size =

     

       80
       80
       -
                   List.assoc_opt "size" fields

     

       81
       81
       -
                   |> Option.map (function

     

       82
       82
       -
                        | `Int i -> i

     

       83
       83
       -
                        | j -> Util.json_error "Expected int for size" j)

     

       84
       84
       -
                 in

     

       85
       85
       -
                 { uri; name; description; mime_type; size }

     

       86
       86
       -
             | j -> Util.json_error "Expected object for ResourcesList.Resource.t" j

     

       87
       87
       -
         end

     

       88
       88
       -
       

     

       89
       89
       -
         module Response = struct

     

       90
       90
       -
           type t = { resources : Resource.t list; next_cursor : Cursor.t option }

     

       91
       91
       -
       

     

       92
       92
       -
           let yojson_of_t { resources; next_cursor } =

     

       93
       93
       -
             let assoc =

     

       94
       94
       -
               [ ("resources", `List (List.map Resource.yojson_of_t resources)) ]

     

       95
       95
       -
             in

     

       96
       96
       -
             let assoc =

     

       97
       97
       -
               match next_cursor with

     

       98
       98
       -
               | Some c -> ("nextCursor", Cursor.yojson_of_t c) :: assoc

     

       99
       99
       -
               | None -> assoc

     

       100
       100
       -
             in

     

       101
       101
       -
             `Assoc assoc

     

       102
       102
       -
       

     

       103
       103
       -
           let t_of_yojson = function

     

       104
       104
       -
             | `Assoc fields as json ->

     

       105
       105
       -
                 let resources =

     

       106
       106
       -
                   match List.assoc_opt "resources" fields with

     

       107
       107
       -
                   | Some (`List items) -> List.map Resource.t_of_yojson items

     

       108
       108
       -
                   | _ -> Util.json_error "Missing or invalid 'resources' field" json

     

       109
       109
       -
                 in

     

       110
       110
       -
                 let next_cursor =

     

       111
       111
       -
                   List.assoc_opt "nextCursor" fields |> Option.map Cursor.t_of_yojson

     

       112
       112
       -
                 in

     

       113
       113
       -
                 { resources; next_cursor }

     

       114
       114
       -
             | j -> Util.json_error "Expected object for ResourcesList.Response.t" j

     

       115
       115
       -
         end

     

       116
       116
       -
       

     

       117
       117
       -
         (* Request/response creation helpers *)

     

       118
       118
       -
         let create_request ?cursor ?id () =

     

       119
       119
       -
           let id = match id with Some i -> i | None -> `Int (Random.int 10000) in

     

       120
       120
       -
           let params = Request.yojson_of_t { cursor } in

     

       121
       121
       -
           JSONRPCMessage.create_request ~id ~meth:Method.ResourcesList

     

       122
       122
       -
             ~params:(Some params) ()

     

       123
       123
       -
       

     

       124
       124
       -
         let create_response ~id ~resources ?next_cursor () =

     

       125
       125
       -
           let result = Response.yojson_of_t { resources; next_cursor } in

     

       126
       126
       -
           JSONRPCMessage.create_response ~id ~result

     

       127
       127
       -
       end

     

       128
       128
       -
       

     

       129
       129
       -
       (* Resources/Templates/List *)

     

       130
       130
       -
       module ListResourceTemplatesRequest = struct

     

       131
       131
       -
         type t = { cursor : Cursor.t option }

     

       132
       132
       -
       

     

       133
       133
       -
         let yojson_of_t { cursor } =

     

       134
       134
       -
           let assoc = [] in

     

       135
       135
       -
           let assoc =

     

       136
       136
       -
             match cursor with

     

       137
       137
       -
             | Some c -> ("cursor", Cursor.yojson_of_t c) :: assoc

     

       138
       138
       -
             | None -> assoc

     

       139
       139
       -
           in

     

       140
       140
       -
           `Assoc assoc

     

       141
       141
       -
       

     

       142
       142
       -
         let t_of_yojson = function

     

       143
       143
       -
           | `Assoc fields ->

     

       144
       144
       -
               let cursor =

     

       145
       145
       -
                 List.assoc_opt "cursor" fields |> Option.map Cursor.t_of_yojson

     

       146
       146
       -
               in

     

       147
       147
       -
               { cursor }

     

       148
       148
       -
           | j ->

     

       149
       149
       -
               Util.json_error "Expected object for ListResourceTemplatesRequest.t" j

     

       150
       150
       -
       end

     

       151
       151
       -
       

     

       152
       152
       -
       (* Resources/Templates/List Response *)

     

       153
       153
       -
       module ListResourceTemplatesResult = struct

     

       154
       154
       -
         module ResourceTemplate = struct

     

       155
       155
       -
           type t = {

     

       156
       156
       -
             uri_template : string;

     

       157
       157
       -
             name : string;

     

       158
       158
       -
             description : string option;

     

       159
       159
       -
             mime_type : string option;

     

       160
       160
       -
           }

     

       161
       161
       -
       

     

       162
       162
       -
           let yojson_of_t { uri_template; name; description; mime_type } =

     

       163
       163
       -
             let assoc =

     

       164
       164
       -
               [ ("uriTemplate", `String uri_template); ("name", `String name) ]

     

       165
       165
       -
             in

     

       166
       166
       -
             let assoc =

     

       167
       167
       -
               match description with

     

       168
       168
       -
               | Some desc -> ("description", `String desc) :: assoc

     

       169
       169
       -
               | None -> assoc

     

       170
       170
       -
             in

     

       171
       171
       -
             let assoc =

     

       172
       172
       -
               match mime_type with

     

       173
       173
       -
               | Some mime -> ("mimeType", `String mime) :: assoc

     

       174
       174
       -
               | None -> assoc

     

       175
       175
       -
             in

     

       176
       176
       -
             `Assoc assoc

     

       177
       177
       -
       

     

       178
       178
       -
           let t_of_yojson = function

     

       179
       179
       -
             | `Assoc fields as json ->

     

       180
       180
       -
                 let uri_template =

     

       181
       181
       -
                   match List.assoc_opt "uriTemplate" fields with

     

       182
       182
       -
                   | Some (`String s) -> s

     

       183
       183
       -
                   | _ -> Util.json_error "Missing or invalid 'uriTemplate' field" json

     

       184
       184
       -
                 in

     

       185
       185
       -
                 let name =

     

       186
       186
       -
                   match List.assoc_opt "name" fields with

     

       187
       187
       -
                   | Some (`String s) -> s

     

       188
       188
       -
                   | _ -> Util.json_error "Missing or invalid 'name' field" json

     

       189
       189
       -
                 in

     

       190
       190
       -
                 let description =

     

       191
       191
       -
                   List.assoc_opt "description" fields

     

       192
       192
       -
                   |> Option.map (function

     

       193
       193
       -
                        | `String s -> s

     

       194
       194
       -
                        | j -> Util.json_error "Expected string for description" j)

     

       195
       195
       -
                 in

     

       196
       196
       -
                 let mime_type =

     

       197
       197
       -
                   List.assoc_opt "mimeType" fields

     

       198
       198
       -
                   |> Option.map (function

     

       199
       199
       -
                        | `String s -> s

     

       200
       200
       -
                        | j -> Util.json_error "Expected string for mimeType" j)

     

       201
       201
       -
                 in

     

       202
       202
       -
                 { uri_template; name; description; mime_type }

     

       203
       203
       -
             | j ->

     

       204
       204
       -
                 Util.json_error

     

       205
       205
       -
                   "Expected object for ListResourceTemplatesResult.ResourceTemplate.t"

     

       206
       206
       -
                   j

     

       207
       207
       -
         end

     

       208
       208
       -
       

     

       209
       209
       -
         type t = {

     

       210
       210
       -
           resource_templates : ResourceTemplate.t list;

     

       211
       211
       -
           next_cursor : Cursor.t option;

     

       212
       212
       -
         }

     

       213
       213
       -
       

     

       214
       214
       -
         let yojson_of_t { resource_templates; next_cursor } =

     

       215
       215
       -
           let assoc =

     

       216
       216
       -
             [

     

       217
       217
       -
               ( "resourceTemplates",

     

       218
       218
       -
                 `List (List.map ResourceTemplate.yojson_of_t resource_templates) );

     

       219
       219
       -
             ]

     

       220
       220
       -
           in

     

       221
       221
       -
           let assoc =

     

       222
       222
       -
             match next_cursor with

     

       223
       223
       -
             | Some c -> ("nextCursor", Cursor.yojson_of_t c) :: assoc

     

       224
       224
       -
             | None -> assoc

     

       225
       225
       -
           in

     

       226
       226
       -
           `Assoc assoc

     

       227
       227
       -
       

     

       228
       228
       -
         let t_of_yojson = function

     

       229
       229
       -
           | `Assoc fields as json ->

     

       230
       230
       -
               let resource_templates =

     

       231
       231
       -
                 match List.assoc_opt "resourceTemplates" fields with

     

       232
       232
       -
                 | Some (`List items) -> List.map ResourceTemplate.t_of_yojson items

     

       233
       233
       -
                 | _ ->

     

       234
       234
       -
                     Util.json_error "Missing or invalid 'resourceTemplates' field"

     

       235
       235
       -
                       json

     

       236
       236
       -
               in

     

       237
       237
       -
               let next_cursor =

     

       238
       238
       -
                 List.assoc_opt "nextCursor" fields |> Option.map Cursor.t_of_yojson

     

       239
       239
       -
               in

     

       240
       240
       -
               { resource_templates; next_cursor }

     

       241
       241
       -
           | j -> Util.json_error "Expected object for ListResourceTemplatesResult.t" j

     

       242
       242
       -
       

     

       243
       243
       -
         (* Request/response creation helpers *)

     

       244
       244
       -
         let create_request ?cursor ?id () =

     

       245
       245
       -
           let id = match id with Some i -> i | None -> `Int (Random.int 10000) in

     

       246
       246
       -
           let params = ListResourceTemplatesRequest.yojson_of_t { cursor } in

     

       247
       247
       -
           JSONRPCMessage.create_request ~id ~meth:Method.ResourceTemplatesList

     

       248
       248
       -
             ~params:(Some params) ()

     

       249
       249
       -
       

     

       250
       250
       -
         let create_response ~id ~resource_templates ?next_cursor () =

     

       251
       251
       -
           let result = yojson_of_t { resource_templates; next_cursor } in

     

       252
       252
       -
           JSONRPCMessage.create_response ~id ~result

     

       253
       253
       -
       end

     

       254
       254
       -
       

     

       255
       255
       -
       (* Resources/Read *)

     

       256
       256
       -
       module ResourcesRead = struct

     

       257
       257
       -
         module Request = struct

     

       258
       258
       -
           type t = { uri : string }

     

       259
       259
       -
       

     

       260
       260
       -
           let yojson_of_t { uri } = `Assoc [ ("uri", `String uri) ]

     

       261
       261
       -
       

     

       262
       262
       -
           let t_of_yojson = function

     

       263
       263
       -
             | `Assoc fields as json ->

     

       264
       264
       -
                 let uri =

     

       265
       265
       -
                   match List.assoc_opt "uri" fields with

     

       266
       266
       -
                   | Some (`String s) -> s

     

       267
       267
       -
                   | _ -> Util.json_error "Missing or invalid 'uri' field" json

     

       268
       268
       -
                 in

     

       269
       269
       -
                 { uri }

     

       270
       270
       -
             | j -> Util.json_error "Expected object for ResourcesRead.Request.t" j

     

       271
       271
       -
         end

     

       272
       272
       -
       

     

       273
       273
       -
         module ResourceContent = struct

     

       274
       274
       -
           type t =

     

       275
       275
       -
             | TextResource of TextResourceContents.t

     

       276
       276
       -
             | BlobResource of BlobResourceContents.t

     

       277
       277
       -
       

     

       278
       278
       -
           let yojson_of_t = function

     

       279
       279
       -
             | TextResource tr -> TextResourceContents.yojson_of_t tr

     

       280
       280
       -
             | BlobResource br -> BlobResourceContents.yojson_of_t br

     

       281
       281
       -
       

     

       282
       282
       -
           let t_of_yojson json =

     

       283
       283
       -
             match json with

     

       284
       284
       -
             | `Assoc fields ->

     

       285
       285
       -
                 if List.mem_assoc "text" fields then

     

       286
       286
       -
                   TextResource (TextResourceContents.t_of_yojson json)

     

       287
       287
       -
                 else if List.mem_assoc "blob" fields then

     

       288
       288
       -
                   BlobResource (BlobResourceContents.t_of_yojson json)

     

       289
       289
       -
                 else Util.json_error "Invalid resource content" json

     

       290
       290
       -
             | j ->

     

       291
       291
       -
                 Util.json_error "Expected object for ResourcesRead.ResourceContent.t"

     

       292
       292
       -
                   j

     

       293
       293
       -
         end

     

       294
       294
       -
       

     

       295
       295
       -
         module Response = struct

     

       296
       296
       -
           type t = { contents : ResourceContent.t list }

     

       297
       297
       -
       

     

       298
       298
       -
           let yojson_of_t { contents } =

     

       299
       299
       -
             `Assoc

     

       300
       300
       -
               [ ("contents", `List (List.map ResourceContent.yojson_of_t contents)) ]

     

       301
       301
       -
       

     

       302
       302
       -
           let t_of_yojson = function

     

       303
       303
       -
             | `Assoc fields as json ->

     

       304
       304
       -
                 let contents =

     

       305
       305
       -
                   match List.assoc_opt "contents" fields with

     

       306
       306
       -
                   | Some (`List items) -> List.map ResourceContent.t_of_yojson items

     

       307
       307
       -
                   | _ -> Util.json_error "Missing or invalid 'contents' field" json

     

       308
       308
       -
                 in

     

       309
       309
       -
                 { contents }

     

       310
       310
       -
             | j -> Util.json_error "Expected object for ResourcesRead.Response.t" j

     

       311
       311
       -
         end

     

       312
       312
       -
       

     

       313
       313
       -
         (* Request/response creation helpers *)

     

       314
       314
       -
         let create_request ~uri ?id () =

     

       315
       315
       -
           let id = match id with Some i -> i | None -> `Int (Random.int 10000) in

     

       316
       316
       -
           let params = Request.yojson_of_t { uri } in

     

       317
       317
       -
           JSONRPCMessage.create_request ~id ~meth:Method.ResourcesRead

     

       318
       318
       -
             ~params:(Some params) ()

     

       319
       319
       -
       

     

       320
       320
       -
         let create_response ~id ~contents () =

     

       321
       321
       -
           let result = Response.yojson_of_t { contents } in

     

       322
       322
       -
           JSONRPCMessage.create_response ~id ~result

     

       323
       323
       -
       end

     

       324
       324
       -
       

     

       325
       325
       -
       (* Tools/List *)

     

       326
       326
       -
       module ToolsList = struct

     

       327
       327
       -
         module Request = struct

     

       328
       328
       -
           type t = { cursor : Cursor.t option }

     

       329
       329
       -
       

     

       330
       330
       -
           let yojson_of_t { cursor } =

     

       331
       331
       -
             let assoc = [] in

     

       332
       332
       -
             let assoc =

     

       333
       333
       -
               match cursor with

     

       334
       334
       -
               | Some c -> ("cursor", Cursor.yojson_of_t c) :: assoc

     

       335
       335
       -
               | None -> assoc

     

       336
       336
       -
             in

     

       337
       337
       -
             `Assoc assoc

     

       338
       338
       -
       

     

       339
       339
       -
           let t_of_yojson = function

     

       340
       340
       -
             | `Assoc fields ->

     

       341
       341
       -
                 let cursor =

     

       342
       342
       -
                   List.assoc_opt "cursor" fields |> Option.map Cursor.t_of_yojson

     

       343
       343
       -
                 in

     

       344
       344
       -
                 { cursor }

     

       345
       345
       -
             | j -> Util.json_error "Expected object for ToolsList.Request.t" j

     

       346
       346
       -
         end

     

       347
       347
       -
       

     

       348
       348
       -
         module Tool = struct

     

       349
       349
       -
           type t = {

     

       350
       350
       -
             name : string;

     

       351
       351
       -
             description : string option;

     

       352
       352
       -
             input_schema : Json.t;

     

       353
       353
       -
             annotations : Json.t option;

     

       354
       354
       -
           }

     

       355
       355
       -
       

     

       356
       356
       -
           let yojson_of_t { name; description; input_schema; annotations } =

     

       357
       357
       -
             let assoc = [ ("name", `String name); ("inputSchema", input_schema) ] in

     

       358
       358
       -
             let assoc =

     

       359
       359
       -
               match description with

     

       360
       360
       -
               | Some desc -> ("description", `String desc) :: assoc

     

       361
       361
       -
               | None -> assoc

     

       362
       362
       -
             in

     

       363
       363
       -
             let assoc =

     

       364
       364
       -
               match annotations with

     

       365
       365
       -
               | Some anno -> ("annotations", anno) :: assoc

     

       366
       366
       -
               | None -> assoc

     

       367
       367
       -
             in

     

       368
       368
       -
             `Assoc assoc

     

       369
       369
       -
       

     

       370
       370
       -
           let t_of_yojson = function

     

       371
       371
       -
             | `Assoc fields as json ->

     

       372
       372
       -
                 let name =

     

       373
       373
       -
                   match List.assoc_opt "name" fields with

     

       374
       374
       -
                   | Some (`String s) -> s

     

       375
       375
       -
                   | _ -> Util.json_error "Missing or invalid 'name' field" json

     

       376
       376
       -
                 in

     

       377
       377
       -
                 let description =

     

       378
       378
       -
                   List.assoc_opt "description" fields

     

       379
       379
       -
                   |> Option.map (function

     

       380
       380
       -
                        | `String s -> s

     

       381
       381
       -
                        | j -> Util.json_error "Expected string for description" j)

     

       382
       382
       -
                 in

     

       383
       383
       -
                 let input_schema =

     

       384
       384
       -
                   match List.assoc_opt "inputSchema" fields with

     

       385
       385
       -
                   | Some schema -> schema

     

       386
       386
       -
                   | None -> Util.json_error "Missing 'inputSchema' field" json

     

       387
       387
       -
                 in

     

       388
       388
       -
                 let annotations = List.assoc_opt "annotations" fields in

     

       389
       389
       -
                 { name; description; input_schema; annotations }

     

       390
       390
       -
             | j -> Util.json_error "Expected object for ToolsList.Tool.t" j

     

       391
       391
       -
         end

     

       392
       392
       -
       

     

       393
       393
       -
         module Response = struct

     

       394
       394
       -
           type t = { tools : Tool.t list; next_cursor : Cursor.t option }

     

       395
       395
       -
       

     

       396
       396
       -
           let yojson_of_t { tools; next_cursor } =

     

       397
       397
       -
             let assoc = [ ("tools", `List (List.map Tool.yojson_of_t tools)) ] in

     

       398
       398
       -
             let assoc =

     

       399
       399
       -
               match next_cursor with

     

       400
       400
       -
               | Some c -> ("nextCursor", Cursor.yojson_of_t c) :: assoc

     

       401
       401
       -
               | None -> assoc

     

       402
       402
       -
             in

     

       403
       403
       -
             `Assoc assoc

     

       404
       404
       -
       

     

       405
       405
       -
           let t_of_yojson = function

     

       406
       406
       -
             | `Assoc fields as json ->

     

       407
       407
       -
                 let tools =

     

       408
       408
       -
                   match List.assoc_opt "tools" fields with

     

       409
       409
       -
                   | Some (`List items) -> List.map Tool.t_of_yojson items

     

       410
       410
       -
                   | _ -> Util.json_error "Missing or invalid 'tools' field" json

     

       411
       411
       -
                 in

     

       412
       412
       -
                 let next_cursor =

     

       413
       413
       -
                   List.assoc_opt "nextCursor" fields |> Option.map Cursor.t_of_yojson

     

       414
       414
       -
                 in

     

       415
       415
       -
                 { tools; next_cursor }

     

       416
       416
       -
             | j -> Util.json_error "Expected object for ToolsList.Response.t" j

     

       417
       417
       -
         end

     

       418
       418
       -
       

     

       419
       419
       -
         (* Request/response creation helpers *)

     

       420
       420
       -
         let create_request ?cursor ?id () =

     

       421
       421
       -
           let id = match id with Some i -> i | None -> `Int (Random.int 10000) in

     

       422
       422
       -
           let params = Request.yojson_of_t { cursor } in

     

       423
       423
       -
           JSONRPCMessage.create_request ~id ~meth:Method.ToolsList

     

       424
       424
       -
             ~params:(Some params) ()

     

       425
       425
       -
       

     

       426
       426
       -
         let create_response ~id ~tools ?next_cursor () =

     

       427
       427
       -
           let result = Response.yojson_of_t { tools; next_cursor } in

     

       428
       428
       -
           JSONRPCMessage.create_response ~id ~result

     

       429
       429
       -
       end

     

       430
       430
       -
       

     

       431
       431
       -
       (* Tools/Call *)

     

       432
       432
       -
       module ToolsCall = struct

     

       433
       433
       -
         module Request = struct

     

       434
       434
       -
           type t = { name : string; arguments : Json.t }

     

       435
       435
       -
       

     

       436
       436
       -
           let yojson_of_t { name; arguments } =

     

       437
       437
       -
             `Assoc [ ("name", `String name); ("arguments", arguments) ]

     

       438
       438
       -
       

     

       439
       439
       -
           let t_of_yojson = function

     

       440
       440
       -
             | `Assoc fields as json ->

     

       441
       441
       -
                 let name =

     

       442
       442
       -
                   match List.assoc_opt "name" fields with

     

       443
       443
       -
                   | Some (`String s) -> s

     

       444
       444
       -
                   | _ -> Util.json_error "Missing or invalid 'name' field" json

     

       445
       445
       -
                 in

     

       446
       446
       -
                 let arguments =

     

       447
       447
       -
                   match List.assoc_opt "arguments" fields with

     

       448
       448
       -
                   | Some json -> json

     

       449
       449
       -
                   | None -> Util.json_error "Missing 'arguments' field" json

     

       450
       450
       -
                 in

     

       451
       451
       -
                 { name; arguments }

     

       452
       452
       -
             | j -> Util.json_error "Expected object for ToolsCall.Request.t" j

     

       453
       453
       -
         end

     

       454
       454
       -
       

     

       455
       455
       -
         module ToolContent = struct

     

       456
       456
       -
           type t =

     

       457
       457
       -
             | Text of TextContent.t

     

       458
       458
       -
             | Image of ImageContent.t

     

       459
       459
       -
             | Audio of AudioContent.t

     

       460
       460
       -
             | Resource of EmbeddedResource.t

     

       461
       461
       -
       

     

       462
       462
       -
           let yojson_of_t = function

     

       463
       463
       -
             | Text t -> TextContent.yojson_of_t t

     

       464
       464
       -
             | Image i -> ImageContent.yojson_of_t i

     

       465
       465
       -
             | Audio a -> AudioContent.yojson_of_t a

     

       466
       466
       -
             | Resource r -> EmbeddedResource.yojson_of_t r

     

       467
       467
       -
       

     

       468
       468
       -
           let t_of_yojson json =

     

       469
       469
       -
             match json with

     

       470
       470
       -
             | `Assoc fields -> (

     

       471
       471
       -
                 match List.assoc_opt "type" fields with

     

       472
       472
       -
                 | Some (`String "text") -> Text (TextContent.t_of_yojson json)

     

       473
       473
       -
                 | Some (`String "image") -> Image (ImageContent.t_of_yojson json)

     

       474
       474
       -
                 | Some (`String "audio") -> Audio (AudioContent.t_of_yojson json)

     

       475
       475
       -
                 | Some (`String "resource") ->

     

       476
       476
       -
                     Resource (EmbeddedResource.t_of_yojson json)

     

       477
       477
       -
                 | _ -> Util.json_error "Invalid or missing content type" json)

     

       478
       478
       -
             | j -> Util.json_error "Expected object for ToolsCall.ToolContent.t" j

     

       479
       479
       -
         end

     

       480
       480
       -
       

     

       481
       481
       -
         module Response = struct

     

       482
       482
       -
           type t = { content : ToolContent.t list; is_error : bool }

     

       483
       483
       -
       

     

       484
       484
       -
           let yojson_of_t { content; is_error } =

     

       485
       485
       -
             `Assoc

     

       486
       486
       -
               [

     

       487
       487
       -
                 ("content", `List (List.map ToolContent.yojson_of_t content));

     

       488
       488
       -
                 ("isError", `Bool is_error);

     

       489
       489
       -
               ]

     

       490
       490
       -
       

     

       491
       491
       -
           let t_of_yojson = function

     

       492
       492
       -
             | `Assoc fields as json ->

     

       493
       493
       -
                 let content =

     

       494
       494
       -
                   match List.assoc_opt "content" fields with

     

       495
       495
       -
                   | Some (`List items) -> List.map ToolContent.t_of_yojson items

     

       496
       496
       -
                   | _ -> Util.json_error "Missing or invalid 'content' field" json

     

       497
       497
       -
                 in

     

       498
       498
       -
                 let is_error =

     

       499
       499
       -
                   match List.assoc_opt "isError" fields with

     

       500
       500
       -
                   | Some (`Bool b) -> b

     

       501
       501
       -
                   | _ -> false

     

       502
       502
       -
                 in

     

       503
       503
       -
                 { content; is_error }

     

       504
       504
       -
             | j -> Util.json_error "Expected object for ToolsCall.Response.t" j

     

       505
       505
       -
         end

     

       506
       506
       -
       

     

       507
       507
       -
         (* Request/response creation helpers *)

     

       508
       508
       -
         let create_request ~name ~arguments ?id () =

     

       509
       509
       -
           let id = match id with Some i -> i | None -> `Int (Random.int 10000) in

     

       510
       510
       -
           let params = Request.yojson_of_t { name; arguments } in

     

       511
       511
       -
           JSONRPCMessage.create_request ~id ~meth:Method.ToolsCall

     

       512
       512
       -
             ~params:(Some params) ()

     

       513
       513
       -
       

     

       514
       514
       -
         let create_response ~id ~content ~is_error () =

     

       515
       515
       -
           let result = Response.yojson_of_t { content; is_error } in

     

       516
       516
       -
           JSONRPCMessage.create_response ~id ~result

     

       517
       517
       -
       end

     

       518
       518
       -
       

     

       519
       519
       -
       (* Prompts/List *)

     

       520
       520
       -
       module PromptsList = struct

     

       521
       521
       -
         module PromptArgument = struct

     

       522
       522
       -
           type t = { name : string; description : string option; required : bool }

     

       523
       523
       -
       

     

       524
       524
       -
           let yojson_of_t { name; description; required } =

     

       525
       525
       -
             let assoc = [ ("name", `String name) ] in

     

       526
       526
       -
             let assoc =

     

       527
       527
       -
               match description with

     

       528
       528
       -
               | Some desc -> ("description", `String desc) :: assoc

     

       529
       529
       -
               | None -> assoc

     

       530
       530
       -
             in

     

       531
       531
       -
             let assoc =

     

       532
       532
       -
               if required then ("required", `Bool true) :: assoc else assoc

     

       533
       533
       -
             in

     

       534
       534
       -
             `Assoc assoc

     

       535
       535
       -
       

     

       536
       536
       -
           let t_of_yojson = function

     

       537
       537
       -
             | `Assoc fields as json ->

     

       538
       538
       -
                 let name =

     

       539
       539
       -
                   match List.assoc_opt "name" fields with

     

       540
       540
       -
                   | Some (`String s) -> s

     

       541
       541
       -
                   | _ -> Util.json_error "Missing or invalid 'name' field" json

     

       542
       542
       -
                 in

     

       543
       543
       -
                 let description =

     

       544
       544
       -
                   List.assoc_opt "description" fields

     

       545
       545
       -
                   |> Option.map (function

     

       546
       546
       -
                        | `String s -> s

     

       547
       547
       -
                        | j -> Util.json_error "Expected string for description" j)

     

       548
       548
       -
                 in

     

       549
       549
       -
                 let required =

     

       550
       550
       -
                   match List.assoc_opt "required" fields with

     

       551
       551
       -
                   | Some (`Bool b) -> b

     

       552
       552
       -
                   | _ -> false

     

       553
       553
       -
                 in

     

       554
       554
       -
                 { name; description; required }

     

       555
       555
       -
             | j ->

     

       556
       556
       -
                 Util.json_error "Expected object for PromptsList.PromptArgument.t" j

     

       557
       557
       -
         end

     

       558
       558
       -
       

     

       559
       559
       -
         module Prompt = struct

     

       560
       560
       -
           type t = {

     

       561
       561
       -
             name : string;

     

       562
       562
       -
             description : string option;

     

       563
       563
       -
             arguments : PromptArgument.t list;

     

       564
       564
       -
           }

     

       565
       565
       -
       

     

       566
       566
       -
           let yojson_of_t { name; description; arguments } =

     

       567
       567
       -
             let assoc = [ ("name", `String name) ] in

     

       568
       568
       -
             let assoc =

     

       569
       569
       -
               match description with

     

       570
       570
       -
               | Some desc -> ("description", `String desc) :: assoc

     

       571
       571
       -
               | None -> assoc

     

       572
       572
       -
             in

     

       573
       573
       -
             let assoc =

     

       574
       574
       -
               if arguments <> [] then

     

       575
       575
       -
                 ("arguments", `List (List.map PromptArgument.yojson_of_t arguments))

     

       576
       576
       -
                 :: assoc

     

       577
       577
       -
               else assoc

     

       578
       578
       -
             in

     

       579
       579
       -
             `Assoc assoc

     

       580
       580
       -
       

     

       581
       581
       -
           let t_of_yojson = function

     

       582
       582
       -
             | `Assoc fields as json ->

     

       583
       583
       -
                 let name =

     

       584
       584
       -
                   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 =

     

       589
       589
       -
                   List.assoc_opt "description" fields

     

       590
       590
       -
                   |> Option.map (function

     

       591
       591
       -
                        | `String s -> s

     

       592
       592
       -
                        | j -> Util.json_error "Expected string for description" j)

     

       593
       593
       -
                 in

     

       594
       594
       -
                 let arguments =

     

       595
       595
       -
                   match List.assoc_opt "arguments" fields with

     

       596
       596
       -
                   | Some (`List items) -> List.map PromptArgument.t_of_yojson items

     

       597
       597
       -
                   | _ -> []

     

       598
       598
       -
                 in

     

       599
       599
       -
                 { name; description; arguments }

     

       600
       600
       -
             | j -> Util.json_error "Expected object for PromptsList.Prompt.t" j

     

       601
       601
       -
         end

     

       602
       602
       -
       

     

       603
       603
       -
         module Request = struct

     

       604
       604
       -
           type t = { cursor : Cursor.t option }

     

       605
       605
       -
       

     

       606
       606
       -
           let yojson_of_t { cursor } =

     

       607
       607
       -
             let assoc = [] in

     

       608
       608
       -
             let assoc =

     

       609
       609
       -
               match cursor with

     

       610
       610
       -
               | Some c -> ("cursor", Cursor.yojson_of_t c) :: assoc

     

       611
       611
       -
               | None -> assoc

     

       612
       612
       -
             in

     

       613
       613
       -
             `Assoc assoc

     

       614
       614
       -
       

     

       615
       615
       -
           let t_of_yojson = function

     

       616
       616
       -
             | `Assoc fields ->

     

       617
       617
       -
                 let cursor =

     

       618
       618
       -
                   List.assoc_opt "cursor" fields |> Option.map Cursor.t_of_yojson

     

       619
       619
       -
                 in

     

       620
       620
       -
                 { cursor }

     

       621
       621
       -
             | j -> Util.json_error "Expected object for PromptsList.Request.t" j

     

       622
       622
       -
         end

     

       623
       623
       -
       

     

       624
       624
       -
         module Response = struct

     

       625
       625
       -
           type t = { prompts : Prompt.t list; next_cursor : Cursor.t option }

     

       626
       626
       -
       

     

       627
       627
       -
           let yojson_of_t { prompts; next_cursor } =

     

       628
       628
       -
             let assoc =

     

       629
       629
       -
               [ ("prompts", `List (List.map Prompt.yojson_of_t prompts)) ]

     

       630
       630
       -
             in

     

       631
       631
       -
             let assoc =

     

       632
       632
       -
               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 =

     

       641
       641
       -
                   match List.assoc_opt "prompts" fields with

     

       642
       642
       -
                   | Some (`List items) -> List.map Prompt.t_of_yojson items

     

       643
       643
       -
                   | _ -> Util.json_error "Missing or invalid 'prompts' field" json

     

       644
       644
       -
                 in

     

       645
       645
       -
                 let next_cursor =

     

       646
       646
       -
                   List.assoc_opt "nextCursor" fields |> Option.map Cursor.t_of_yojson

     

       647
       647
       -
                 in

     

       648
       648
       -
                 { prompts; next_cursor }

     

       649
       649
       -
             | j -> Util.json_error "Expected object for PromptsList.Response.t" j

     

       650
       650
       -
         end

     

       651
       651
       -
       

     

       652
       652
       -
         (* Request/response creation helpers *)

     

       653
       653
       -
         let create_request ?cursor ?id () =

     

       654
       654
       -
           let id = match id with Some i -> i | None -> `Int (Random.int 10000) in

     

       655
       655
       -
           let params = Request.yojson_of_t { cursor } in

     

       656
       656
       -
           JSONRPCMessage.create_request ~id ~meth:Method.PromptsList

     

       657
       657
       -
             ~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 = { name : string; arguments : (string * string) list }

     

       668
       668
       -
       

     

       669
       669
       -
           let yojson_of_t { name; arguments } =

     

       670
       670
       -
             let args_json =

     

       671
       671
       -
               `Assoc (List.map (fun (k, v) -> (k, `String v)) arguments)

     

       672
       672
       -
             in

     

       673
       673
       -
             `Assoc [ ("name", `String name); ("arguments", args_json) ]

     

       674
       674
       -
       

     

       675
       675
       -
           let t_of_yojson = function

     

       676
       676
       -
             | `Assoc fields as json ->

     

       677
       677
       -
                 let name =

     

       678
       678
       -
                   match List.assoc_opt "name" fields with

     

       679
       679
       -
                   | Some (`String s) -> s

     

       680
       680
       -
                   | _ -> Util.json_error "Missing or invalid 'name' field" json

     

       681
       681
       -
                 in

     

       682
       682
       -
                 let arguments =

     

       683
       683
       -
                   match List.assoc_opt "arguments" fields with

     

       684
       684
       -
                   | Some (`Assoc args) ->

     

       685
       685
       -
                       List.map

     

       686
       686
       -
                         (fun (k, v) ->

     

       687
       687
       -
                           match v with

     

       688
       688
       -
                           | `String s -> (k, s)

     

       689
       689
       -
                           | _ ->

     

       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
       -
         end

     

       697
       697
       -
       

     

       698
       698
       -
         module Response = struct

     

       699
       699
       -
           type t = { description : string option; messages : PromptMessage.t list }

     

       700
       700
       -
       

     

       701
       701
       -
           let yojson_of_t { description; messages } =

     

       702
       702
       -
             let assoc =

     

       703
       703
       -
               [ ("messages", `List (List.map PromptMessage.yojson_of_t messages)) ]

     

       704
       704
       -
             in

     

       705
       705
       -
             let assoc =

     

       706
       706
       -
               match description with

     

       707
       707
       -
               | Some desc -> ("description", `String desc) :: assoc

     

       708
       708
       -
               | None -> assoc

     

       709
       709
       -
             in

     

       710
       710
       -
             `Assoc assoc

     

       711
       711
       -
       

     

       712
       712
       -
           let t_of_yojson = function

     

       713
       713
       -
             | `Assoc fields as json ->

     

       714
       714
       -
                 let messages =

     

       715
       715
       -
                   match List.assoc_opt "messages" fields with

     

       716
       716
       -
                   | Some (`List items) -> List.map PromptMessage.t_of_yojson items

     

       717
       717
       -
                   | _ -> Util.json_error "Missing or invalid 'messages' field" json

     

       718
       718
       -
                 in

     

       719
       719
       -
                 let description =

     

       720
       720
       -
                   List.assoc_opt "description" fields

     

       721
       721
       -
                   |> 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
       -
         end

     

       728
       728
       -
       

     

       729
       729
       -
         (* Request/response creation helpers *)

     

       730
       730
       -
         let create_request ~name ~arguments ?id () =

     

       731
       731
       -
           let id = match id with Some i -> i | None -> `Int (Random.int 10000) in

     

       732
       732
       -
           let params = Request.yojson_of_t { name; arguments } in

     

       733
       733
       -
           JSONRPCMessage.create_request ~id ~meth:Method.PromptsGet

     

       734
       734
       -
             ~params:(Some params) ()

     

       735
       735
       -
       

     

       736
       736
       -
         let create_response ~id ?description ~messages () =

     

       737
       737
       -
           let result = Response.yojson_of_t { description; messages } in

     

       738
       738
       -
           JSONRPCMessage.create_response ~id ~result

     

       739
       739
       -
       end

     

       740
       740
       -
       

     

       741
       741
       -
       (* List Changed Notifications *)

     

       742
       742
       -
       module ListChanged = struct

     

       743
       743
       -
         (* No parameters for these notifications *)

     

       744
       744
       -
       

     

       745
       745
       -
         let create_resources_notification () =

     

       746
       746
       -
           JSONRPCMessage.create_notification ~meth:Method.ResourcesListChanged ()

     

       747
       747
       -
       

     

       748
       748
       -
         let create_tools_notification () =

     

       749
       749
       -
           JSONRPCMessage.create_notification ~meth:Method.ToolsListChanged ()

     

       750
       750
       -
       

     

       751
       751
       -
         let create_prompts_notification () =

     

       752
       752
       -
           JSONRPCMessage.create_notification ~meth:Method.PromptsListChanged ()

     

       753
       753
       -
       end

     

       754
       754
       -
       

     

       755
       755
       -
       (* Resource Updated Notification *)

     

       756
       756
       -
       module ResourceUpdated = struct

     

       757
       757
       -
         module Notification = struct

     

       758
       758
       -
           type t = { uri : string }

     

       759
       759
       -
       

     

       760
       760
       -
           let yojson_of_t { uri } = `Assoc [ ("uri", `String uri) ]

     

       761
       761
       -
       

     

       762
       762
       -
           let t_of_yojson = function

     

       763
       763
       -
             | `Assoc fields as json ->

     

       764
       764
       -
                 let uri =

     

       765
       765
       -
                   match List.assoc_opt "uri" fields with

     

       766
       766
       -
                   | Some (`String s) -> s

     

       767
       767
       -
                   | _ -> Util.json_error "Missing or invalid 'uri' field" json

     

       768
       768
       -
                 in

     

       769
       769
       -
                 { uri }

     

       770
       770
       -
             | j ->

     

       771
       771
       -
                 Util.json_error "Expected object for ResourceUpdated.Notification.t" j

     

       772
       772
       -
         end

     

       773
       773
       -
       

     

       774
       774
       -
         let create_notification ~uri () =

     

       775
       775
       -
           let params = Notification.yojson_of_t { uri } in

     

       776
       776
       -
           JSONRPCMessage.create_notification ~meth:Method.ResourcesUpdated

     

       777
       777
       -
             ~params:(Some params) ()

     

       778
       778
       -
       end

     

       779
       779
       -
       

     

       780
       780
       -
       (* Progress Notification *)

     

       781
       781
       -
       module Progress = struct

     

       782
       782
       -
         module Notification = struct

     

       783
       783
       -
           type t = {

     

       784
       784
       -
             progress : float;

     

       785
       785
       -
             total : float;

     

       786
       786
       -
             progress_token : ProgressToken.t;

     

       787
       787
       -
           }

     

       788
       788
       -
       

     

       789
       789
       -
           let yojson_of_t { progress; total; progress_token } =

     

       790
       790
       -
             `Assoc

     

       791
       791
       -
               [

     

       792
       792
       -
                 ("progress", `Float progress);

     

       793
       793
       -
                 ("total", `Float total);

     

       794
       794
       -
                 ("progressToken", ProgressToken.yojson_of_t progress_token);

     

       795
       795
       -
               ]

     

       796
       796
       -
       

     

       797
       797
       -
           let t_of_yojson = function

     

       798
       798
       -
             | `Assoc fields as json ->

     

       799
       799
       -
                 let progress =

     

       800
       800
       -
                   match List.assoc_opt "progress" fields with

     

       801
       801
       -
                   | Some (`Float f) -> f

     

       802
       802
       -
                   | _ -> Util.json_error "Missing or invalid 'progress' field" json

     

       803
       803
       -
                 in

     

       804
       804
       -
                 let total =

     

       805
       805
       -
                   match List.assoc_opt "total" fields with

     

       806
       806
       -
                   | Some (`Float f) -> f

     

       807
       807
       -
                   | _ -> Util.json_error "Missing or invalid 'total' field" json

     

       808
       808
       -
                 in

     

       809
       809
       -
                 let progress_token =

     

       810
       810
       -
                   match List.assoc_opt "progressToken" fields with

     

       811
       811
       -
                   | Some token -> ProgressToken.t_of_yojson token

     

       812
       812
       -
                   | _ ->

     

       813
       813
       -
                       Util.json_error "Missing or invalid 'progressToken' field" json

     

       814
       814
       -
                 in

     

       815
       815
       -
                 { progress; total; progress_token }

     

       816
       816
       -
             | j -> Util.json_error "Expected object for Progress.Notification.t" j

     

       817
       817
       -
         end

     

       818
       818
       -
       

     

       819
       819
       -
         let create_notification ~progress ~total ~progress_token () =

     

       820
       820
       -
           let params = Notification.yojson_of_t { progress; total; progress_token } in

     

       821
       821
       -
           JSONRPCMessage.create_notification ~meth:Method.Progress

     

       822
       822
       -
             ~params:(Some params) ()

     

       823
       823
       -
       end

     

       824
       824
       -
       

     

       825
       825
       -
       (* Type aliases for backward compatibility *)

     

       826
       826
       -
       type request = ResourcesList.Request.t

     

       827
       827
       -
       type response = ResourcesList.Response.t

     

       828
       828
       -
       type resource = ResourcesList.Resource.t

     

       829
       829
       -
       type resource_content = ResourcesRead.ResourceContent.t

     

       830
       830
       -
       type tool = ToolsList.Tool.t

     

       831
       831
       -
       type tool_content = ToolsCall.ToolContent.t

     

       832
       832
       -
       type prompt = PromptsList.Prompt.t

     

       833
       833
       -
       type prompt_argument = PromptsList.PromptArgument.t

-366

lib/mcp_rpc.mli

···

       1
       1
       -
       (** Mcp_message - High-level RPC message definitions for Model Context Protocol

     

       2
       2
       -
       *)

     

       3
       3
       -
       

     

       4
       4
       -
       open Mcp

     

       5
       5
       -
       open Jsonrpc

     

       6
       6
       -
       

     

       7
       7
       -
       (** Resources/List - Request to list available resources *)

     

       8
       8
       -
       module ResourcesList : sig

     

       9
       9
       -
         (** Request parameters *)

     

       10
       10
       -
         module Request : sig

     

       11
       11
       -
           type t = { 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
       -
       

     

       26
       26
       -
           include Json.Jsonable.S with type t := t

     

       27
       27
       -
         end

     

       28
       28
       -
       

     

       29
       29
       -
         (** Response result *)

     

       30
       30
       -
         module Response : sig

     

       31
       31
       -
           type t = {

     

       32
       32
       -
             resources : Resource.t list;  (** List of available resources *)

     

       33
       33
       -
             next_cursor : Cursor.t option;  (** Optional cursor for the next page *)

     

       34
       34
       -
           }

     

       35
       35
       -
       

     

       36
       36
       -
           include Json.Jsonable.S with type t := t

     

       37
       37
       -
         end

     

       38
       38
       -
       

     

       39
       39
       -
         val create_request :

     

       40
       40
       -
           ?cursor:Cursor.t -> ?id:RequestId.t -> unit -> JSONRPCMessage.t

     

       41
       41
       -
         (** Create a resources/list request *)

     

       42
       42
       -
       

     

       43
       43
       -
         val create_response :

     

       44
       44
       -
           id:RequestId.t ->

     

       45
       45
       -
           resources:Resource.t list ->

     

       46
       46
       -
           ?next_cursor:Cursor.t ->

     

       47
       47
       -
           unit ->

     

       48
       48
       -
           JSONRPCMessage.t

     

       49
       49
       -
         (** Create a resources/list response *)

     

       50
       50
       -
       end

     

       51
       51
       -
       

     

       52
       52
       -
       (** Resources/Templates/List - Request to list available resource templates *)

     

       53
       53
       -
       module ListResourceTemplatesRequest : sig

     

       54
       54
       -
         type t = { cursor : Cursor.t option  (** Optional pagination cursor *) }

     

       55
       55
       -
       

     

       56
       56
       -
         include Json.Jsonable.S with type t := t

     

       57
       57
       -
       end

     

       58
       58
       -
       

     

       59
       59
       -
       (** Resources/Templates/List - Response with resource templates *)

     

       60
       60
       -
       module ListResourceTemplatesResult : sig

     

       61
       61
       -
         (** Resource Template definition *)

     

       62
       62
       -
         module ResourceTemplate : sig

     

       63
       63
       -
           type t = {

     

       64
       64
       -
             uri_template : string;  (** URI template for the resource *)

     

       65
       65
       -
             name : string;  (** Human-readable name *)

     

       66
       66
       -
             description : string option;  (** Optional description *)

     

       67
       67
       -
             mime_type : string option;  (** Optional MIME type *)

     

       68
       68
       -
           }

     

       69
       69
       -
       

     

       70
       70
       -
           include Json.Jsonable.S with type t := t

     

       71
       71
       -
         end

     

       72
       72
       -
       

     

       73
       73
       -
         type t = {

     

       74
       74
       -
           resource_templates : ResourceTemplate.t list;

     

       75
       75
       -
               (** List of available resource templates *)

     

       76
       76
       -
           next_cursor : Cursor.t option;  (** Optional cursor for the next page *)

     

       77
       77
       -
         }

     

       78
       78
       -
       

     

       79
       79
       -
         include Json.Jsonable.S with type t := t

     

       80
       80
       -
       

     

       81
       81
       -
         val create_request :

     

       82
       82
       -
           ?cursor:Cursor.t -> ?id:RequestId.t -> unit -> JSONRPCMessage.t

     

       83
       83
       -
         (** Create a resources/templates/list request *)

     

       84
       84
       -
       

     

       85
       85
       -
         val create_response :

     

       86
       86
       -
           id:RequestId.t ->

     

       87
       87
       -
           resource_templates:ResourceTemplate.t list ->

     

       88
       88
       -
           ?next_cursor:Cursor.t ->

     

       89
       89
       -
           unit ->

     

       90
       90
       -
           JSONRPCMessage.t

     

       91
       91
       -
         (** Create a resources/templates/list response *)

     

       92
       92
       -
       end

     

       93
       93
       -
       

     

       94
       94
       -
       (** Resources/Read - Request to read resource contents *)

     

       95
       95
       -
       module ResourcesRead : sig

     

       96
       96
       -
         (** Request parameters *)

     

       97
       97
       -
         module Request : sig

     

       98
       98
       -
           type t = { uri : string  (** URI of the resource to read *) }

     

       99
       99
       -
       

     

       100
       100
       -
           include Json.Jsonable.S with type t := t

     

       101
       101
       -
         end

     

       102
       102
       -
       

     

       103
       103
       -
         (** Resource content *)

     

       104
       104
       -
         module ResourceContent : sig

     

       105
       105
       -
           type t =

     

       106
       106
       -
             | TextResource of TextResourceContents.t  (** Text content *)

     

       107
       107
       -
             | BlobResource of BlobResourceContents.t  (** Binary content *)

     

       108
       108
       -
       

     

       109
       109
       -
           include Json.Jsonable.S with type t := t

     

       110
       110
       -
         end

     

       111
       111
       -
       

     

       112
       112
       -
         (** Response result *)

     

       113
       113
       -
         module Response : sig

     

       114
       114
       -
           type t = {

     

       115
       115
       -
             contents : ResourceContent.t list;  (** List of resource contents *)

     

       116
       116
       -
           }

     

       117
       117
       -
       

     

       118
       118
       -
           include Json.Jsonable.S with type t := t

     

       119
       119
       -
         end

     

       120
       120
       -
       

     

       121
       121
       -
         val create_request : uri:string -> ?id:RequestId.t -> unit -> JSONRPCMessage.t

     

       122
       122
       -
         (** Create a resources/read request *)

     

       123
       123
       -
       

     

       124
       124
       -
         val create_response :

     

       125
       125
       -
           id:RequestId.t ->

     

       126
       126
       -
           contents:ResourceContent.t list ->

     

       127
       127
       -
           unit ->

     

       128
       128
       -
           JSONRPCMessage.t

     

       129
       129
       -
         (** Create a resources/read response *)

     

       130
       130
       -
       end

     

       131
       131
       -
       

     

       132
       132
       -
       (** Tools/List - Request to list available tools *)

     

       133
       133
       -
       module ToolsList : sig

     

       134
       134
       -
         (** Request parameters *)

     

       135
       135
       -
         module Request : sig

     

       136
       136
       -
           type t = { cursor : Cursor.t option  (** Optional pagination cursor *) }

     

       137
       137
       -
       

     

       138
       138
       -
           include Json.Jsonable.S with type t := t

     

       139
       139
       -
         end

     

       140
       140
       -
       

     

       141
       141
       -
         (** Tool definition *)

     

       142
       142
       -
         module Tool : sig

     

       143
       143
       -
           type t = {

     

       144
       144
       -
             name : string;  (** Unique identifier for the tool *)

     

       145
       145
       -
             description : string option;  (** Human-readable description *)

     

       146
       146
       -
             input_schema : Json.t;  (** JSON Schema defining expected parameters *)

     

       147
       147
       -
             annotations : Json.t option;

     

       148
       148
       -
                 (** Optional properties describing tool behavior *)

     

       149
       149
       -
           }

     

       150
       150
       -
       

     

       151
       151
       -
           include Json.Jsonable.S with type t := t

     

       152
       152
       -
         end

     

       153
       153
       -
       

     

       154
       154
       -
         (** Response result *)

     

       155
       155
       -
         module Response : sig

     

       156
       156
       -
           type t = {

     

       157
       157
       -
             tools : Tool.t list;  (** List of available tools *)

     

       158
       158
       -
             next_cursor : Cursor.t option;  (** Optional cursor for the next page *)

     

       159
       159
       -
           }

     

       160
       160
       -
       

     

       161
       161
       -
           include Json.Jsonable.S with type t := t

     

       162
       162
       -
         end

     

       163
       163
       -
       

     

       164
       164
       -
         val create_request :

     

       165
       165
       -
           ?cursor:Cursor.t -> ?id:RequestId.t -> unit -> JSONRPCMessage.t

     

       166
       166
       -
         (** Create a tools/list request *)

     

       167
       167
       -
       

     

       168
       168
       -
         val create_response :

     

       169
       169
       -
           id:RequestId.t ->

     

       170
       170
       -
           tools:Tool.t list ->

     

       171
       171
       -
           ?next_cursor:Cursor.t ->

     

       172
       172
       -
           unit ->

     

       173
       173
       -
           JSONRPCMessage.t

     

       174
       174
       -
         (** Create a tools/list response *)

     

       175
       175
       -
       end

     

       176
       176
       -
       

     

       177
       177
       -
       (** Tools/Call - Request to invoke a tool *)

     

       178
       178
       -
       module ToolsCall : sig

     

       179
       179
       -
         (** Request parameters *)

     

       180
       180
       -
         module Request : sig

     

       181
       181
       -
           type t = {

     

       182
       182
       -
             name : string;  (** Name of the tool to call *)

     

       183
       183
       -
             arguments : Json.t;  (** Arguments for the tool invocation *)

     

       184
       184
       -
           }

     

       185
       185
       -
       

     

       186
       186
       -
           include Json.Jsonable.S with type t := t

     

       187
       187
       -
         end

     

       188
       188
       -
       

     

       189
       189
       -
         (** Tool content *)

     

       190
       190
       -
         module ToolContent : sig

     

       191
       191
       -
           type t =

     

       192
       192
       -
             | Text of TextContent.t  (** Text content *)

     

       193
       193
       -
             | Image of ImageContent.t  (** Image content *)

     

       194
       194
       -
             | Audio of AudioContent.t  (** Audio content *)

     

       195
       195
       -
             | Resource of EmbeddedResource.t  (** Resource content *)

     

       196
       196
       -
       

     

       197
       197
       -
           include Json.Jsonable.S with type t := t

     

       198
       198
       -
         end

     

       199
       199
       -
       

     

       200
       200
       -
         (** Response result *)

     

       201
       201
       -
         module Response : sig

     

       202
       202
       -
           type t = {

     

       203
       203
       -
             content : ToolContent.t list;

     

       204
       204
       -
                 (** List of content items returned by the tool *)

     

       205
       205
       -
             is_error : bool;  (** Whether the result represents an error *)

     

       206
       206
       -
           }

     

       207
       207
       -
       

     

       208
       208
       -
           include Json.Jsonable.S with type t := t

     

       209
       209
       -
         end

     

       210
       210
       -
       

     

       211
       211
       -
         val create_request :

     

       212
       212
       -
           name:string ->

     

       213
       213
       -
           arguments:Json.t ->

     

       214
       214
       -
           ?id:RequestId.t ->

     

       215
       215
       -
           unit ->

     

       216
       216
       -
           JSONRPCMessage.t

     

       217
       217
       -
         (** Create a tools/call request *)

     

       218
       218
       -
       

     

       219
       219
       -
         val create_response :

     

       220
       220
       -
           id:RequestId.t ->

     

       221
       221
       -
           content:ToolContent.t list ->

     

       222
       222
       -
           is_error:bool ->

     

       223
       223
       -
           unit ->

     

       224
       224
       -
           JSONRPCMessage.t

     

       225
       225
       -
         (** Create a tools/call response *)

     

       226
       226
       -
       end

     

       227
       227
       -
       

     

       228
       228
       -
       (** Prompts/List - Request to list available prompts *)

     

       229
       229
       -
       module PromptsList : sig

     

       230
       230
       -
         (** Prompt argument *)

     

       231
       231
       -
         module PromptArgument : sig

     

       232
       232
       -
           type t = {

     

       233
       233
       -
             name : string;  (** Name of the argument *)

     

       234
       234
       -
             description : string option;  (** Description of the argument *)

     

       235
       235
       -
             required : bool;  (** Whether the argument is required *)

     

       236
       236
       -
           }

     

       237
       237
       -
       

     

       238
       238
       -
           include Json.Jsonable.S with type t := t

     

       239
       239
       -
         end

     

       240
       240
       -
       

     

       241
       241
       -
         (** Prompt definition *)

     

       242
       242
       -
         module Prompt : sig

     

       243
       243
       -
           type t = {

     

       244
       244
       -
             name : string;  (** Unique identifier for the prompt *)

     

       245
       245
       -
             description : string option;  (** Human-readable description *)

     

       246
       246
       -
             arguments : PromptArgument.t list;  (** Arguments for customization *)

     

       247
       247
       -
           }

     

       248
       248
       -
       

     

       249
       249
       -
           include Json.Jsonable.S with type t := t

     

       250
       250
       -
         end

     

       251
       251
       -
       

     

       252
       252
       -
         (** Request parameters *)

     

       253
       253
       -
         module Request : sig

     

       254
       254
       -
           type t = { cursor : Cursor.t option  (** Optional pagination cursor *) }

     

       255
       255
       -
       

     

       256
       256
       -
           include Json.Jsonable.S with type t := t

     

       257
       257
       -
         end

     

       258
       258
       -
       

     

       259
       259
       -
         (** Response result *)

     

       260
       260
       -
         module Response : sig

     

       261
       261
       -
           type t = {

     

       262
       262
       -
             prompts : Prompt.t list;  (** List of available prompts *)

     

       263
       263
       -
             next_cursor : Cursor.t option;  (** Optional cursor for the next page *)

     

       264
       264
       -
           }

     

       265
       265
       -
       

     

       266
       266
       -
           include Json.Jsonable.S with type t := t

     

       267
       267
       -
         end

     

       268
       268
       -
       

     

       269
       269
       -
         val create_request :

     

       270
       270
       -
           ?cursor:Cursor.t -> ?id:RequestId.t -> unit -> JSONRPCMessage.t

     

       271
       271
       -
         (** Create a prompts/list request *)

     

       272
       272
       -
       

     

       273
       273
       -
         val create_response :

     

       274
       274
       -
           id:RequestId.t ->

     

       275
       275
       -
           prompts:Prompt.t list ->

     

       276
       276
       -
           ?next_cursor:Cursor.t ->

     

       277
       277
       -
           unit ->

     

       278
       278
       -
           JSONRPCMessage.t

     

       279
       279
       -
         (** Create a prompts/list response *)

     

       280
       280
       -
       end

     

       281
       281
       -
       

     

       282
       282
       -
       (** Prompts/Get - Request to get a prompt with arguments *)

     

       283
       283
       -
       module PromptsGet : sig

     

       284
       284
       -
         (** Request parameters *)

     

       285
       285
       -
         module Request : sig

     

       286
       286
       -
           type t = {

     

       287
       287
       -
             name : string;  (** Name of the prompt to get *)

     

       288
       288
       -
             arguments : (string * string) list;  (** Arguments for the prompt *)

     

       289
       289
       -
           }

     

       290
       290
       -
       

     

       291
       291
       -
           include Json.Jsonable.S with type t := t

     

       292
       292
       -
         end

     

       293
       293
       -
       

     

       294
       294
       -
         (** Response result *)

     

       295
       295
       -
         module Response : sig

     

       296
       296
       -
           type t = {

     

       297
       297
       -
             description : string option;  (** Description of the prompt *)

     

       298
       298
       -
             messages : PromptMessage.t list;  (** List of messages in the prompt *)

     

       299
       299
       -
           }

     

       300
       300
       -
       

     

       301
       301
       -
           include Json.Jsonable.S with type t := t

     

       302
       302
       -
         end

     

       303
       303
       -
       

     

       304
       304
       -
         val create_request :

     

       305
       305
       -
           name:string ->

     

       306
       306
       -
           arguments:(string * string) list ->

     

       307
       307
       -
           ?id:RequestId.t ->

     

       308
       308
       -
           unit ->

     

       309
       309
       -
           JSONRPCMessage.t

     

       310
       310
       -
         (** Create a prompts/get request *)

     

       311
       311
       -
       

     

       312
       312
       -
         val create_response :

     

       313
       313
       -
           id:RequestId.t ->

     

       314
       314
       -
           ?description:string ->

     

       315
       315
       -
           messages:PromptMessage.t list ->

     

       316
       316
       -
           unit ->

     

       317
       317
       -
           JSONRPCMessage.t

     

       318
       318
       -
         (** Create a prompts/get response *)

     

       319
       319
       -
       end

     

       320
       320
       -
       

     

       321
       321
       -
       (** List Changed Notifications *)

     

       322
       322
       -
       module ListChanged : sig

     

       323
       323
       -
         val create_resources_notification : unit -> JSONRPCMessage.t

     

       324
       324
       -
         (** Create a resources/list_changed notification *)

     

       325
       325
       -
       

     

       326
       326
       -
         val create_tools_notification : unit -> JSONRPCMessage.t

     

       327
       327
       -
         (** Create a tools/list_changed notification *)

     

       328
       328
       -
       

     

       329
       329
       -
         val create_prompts_notification : unit -> JSONRPCMessage.t

     

       330
       330
       -
         (** Create a prompts/list_changed notification *)

     

       331
       331
       -
       end

     

       332
       332
       -
       

     

       333
       333
       -
       (** Resource Updated Notification *)

     

       334
       334
       -
       module ResourceUpdated : sig

     

       335
       335
       -
         (** Notification parameters *)

     

       336
       336
       -
         module Notification : sig

     

       337
       337
       -
           type t = { uri : string  (** URI of the updated resource *) }

     

       338
       338
       -
       

     

       339
       339
       -
           include Json.Jsonable.S with type t := t

     

       340
       340
       -
         end

     

       341
       341
       -
       

     

       342
       342
       -
         val create_notification : uri:string -> unit -> JSONRPCMessage.t

     

       343
       343
       -
         (** Create a resources/updated notification *)

     

       344
       344
       -
       end

     

       345
       345
       -
       

     

       346
       346
       -
       (** Progress Notification *)

     

       347
       347
       -
       module Progress : sig

     

       348
       348
       -
         (** Notification parameters *)

     

       349
       349
       -
         module Notification : sig

     

       350
       350
       -
           type t = {

     

       351
       351
       -
             progress : float;  (** Current progress value *)

     

       352
       352
       -
             total : float;  (** Total progress value *)

     

       353
       353
       -
             progress_token : ProgressToken.t;  (** Token identifying the operation *)

     

       354
       354
       -
           }

     

       355
       355
       -
       

     

       356
       356
       -
           include Json.Jsonable.S with type t := t

     

       357
       357
       -
         end

     

       358
       358
       -
       

     

       359
       359
       -
         val create_notification :

     

       360
       360
       -
           progress:float ->

     

       361
       361
       -
           total:float ->

     

       362
       362
       -
           progress_token:ProgressToken.t ->

     

       363
       363
       -
           unit ->

     

       364
       364
       -
           JSONRPCMessage.t

     

       365
       365
       -
         (** Create a progress notification *)

     

       366
       366
       -
       end

+293 -399

lib/mcp_sdk.ml

···

       3
       3
        
       

     

       4
       4
        
       (* SDK version *)

     

       5
       5
        
       let version = "0.1.0"

     

       6
       6
       -
       let src = Logs.Src.create "mcp.sdk" ~doc:"mcp.sdk logging"

     

       7
       6
        
       

     

       8
       8
       -
       module Log = (val Logs.src_log src : Logs.LOG)

     

       7
       7
       +
       (* Logging utilities *)

     

       8
       8
       +
       module Log = struct

     

       9
       9
       +
         type level = Debug | Info | Warning | Error

     

       10
       10
       +
       

     

       11
       11
       +
         let string_of_level = function

     

       12
       12
       +
           | Debug -> "DEBUG"

     

       13
       13
       +
           | Info -> "INFO"

     

       14
       14
       +
           | Warning -> "WARNING"

     

       15
       15
       +
           | Error -> "ERROR"

     

       16
       16
       +
       

     

       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 debug = log Debug

     

       22
       22
       +
         let info = log Info

     

       23
       23
       +
         let warning = log Warning

     

       24
       24
       +
         let error = log Error

     

       25
       25
       +
       end

     

       9
       26
        
       

     

       10
       27
        
       (* Context for tools and resources *)

     

       11
       28
        
       module Context = struct

     

       12
       29
        
         type t = {

     

       13
       13
       -
           request_id : RequestId.t option;

     

       14
       14
       -
           lifespan_context : (string * Json.t) list;

     

       15
       15
       -
           progress_token : ProgressToken.t option;

     

       30
       30
       +
           request_id: RequestId.t option;

     

       31
       31
       +
           lifespan_context: (string * Json.t) list;

     

       32
       32
       +
           mutable progress_token: ProgressToken.t option;

     

       16
       33
        
         }

     

       17
       34
        
       

     

       18
       18
       -
         let create ?request_id ?progress_token ?(lifespan_context = []) () =

     

       19
       19
       -
           { request_id; lifespan_context; progress_token }

     

       20
       20
       -
       

     

       21
       21
       -
         let get_context_value ctx key = List.assoc_opt key ctx.lifespan_context

     

       35
       35
       +
         let create ?request_id ?(lifespan_context=[]) () =

     

       36
       36
       +
           { request_id; lifespan_context; progress_token = None }

     

       22
       37
        
       

     

       38
       38
       +
         let get_context_value ctx key =

     

       39
       39
       +
           List.assoc_opt key ctx.lifespan_context

     

       40
       40
       +
         

     

       23
       41
        
         let report_progress ctx value total =

     

       24
       24
       -
           match (ctx.progress_token, ctx.request_id) with

     

       42
       42
       +
           match ctx.progress_token, ctx.request_id with

     

       25
       43
        
           | Some token, Some _id ->

     

       26
       26
       -
               let params =

     

       27
       27
       -
                 `Assoc

     

       28
       28
       -
                   [

     

       29
       29
       -
                     ("progress", `Float value);

     

       30
       30
       -
                     ("total", `Float total);

     

       31
       31
       -
                     ("progressToken", ProgressToken.yojson_of_t token);

     

       32
       32
       -
                   ]

     

       33
       33
       -
               in

     

       34
       34
       -
               Some

     

       35
       35
       -
                 (create_notification ~meth:Method.Progress ~params:(Some params) ())

     

       44
       44
       +
             let params = `Assoc [

     

       45
       45
       +
               ("progress", `Float value);

     

       46
       46
       +
               ("total", `Float total);

     

       47
       47
       +
               ("progressToken", ProgressToken.yojson_of_t token)

     

       48
       48
       +
             ] in

     

       49
       49
       +
             Some (create_notification ~method_:"notifications/progress" ~params:(Some params) ())

     

       36
       50
        
           | _ -> None

     

       37
       51
        
       end

     

       38
       52
        
       

     
···

       41
       55
        
         type handler = Context.t -> Json.t -> (Json.t, string) result

     

       42
       56
        
       

     

       43
       57
        
         type t = {

     

       44
       44
       -
           name : string;

     

       45
       45
       -
           description : string option;

     

       46
       46
       -
           input_schema : Json.t; (* JSON Schema *)

     

       47
       47
       -
           handler : handler;

     

       58
       58
       +
           name: string;

     

       59
       59
       +
           description: string option;

     

       60
       60
       +
           input_schema: Json.t;  (* JSON Schema *)

     

       61
       61
       +
           handler: handler;

     

       48
       62
        
         }

     

       49
       63
        
       

     

       50
       50
       -
         let create ~name ?description ~input_schema ~handler () =

     

       64
       64
       +
         let create ~name ?description ~input_schema ~handler () = 

     

       51
       65
        
           { name; description; input_schema; handler }

     

       52
       66
        
       

     

       53
       67
        
         let to_json tool =

     

       54
       54
       -
           let assoc =

     

       55
       55
       -
             [ ("name", `String tool.name); ("inputSchema", tool.input_schema) ]

     

       56
       56
       -
           in

     

       57
       57
       -
           let assoc =

     

       58
       58
       -
             match tool.description with

     

       68
       68
       +
           let assoc = [

     

       69
       69
       +
             ("name", `String tool.name);

     

       70
       70
       +
             ("inputSchema", tool.input_schema);

     

       71
       71
       +
           ] in

     

       72
       72
       +
           let assoc = match tool.description with

     

       59
       73
        
             | Some desc -> ("description", `String desc) :: assoc

     

       60
       74
        
             | None -> assoc

     

       61
       75
        
           in

     

       62
       76
        
           `Assoc assoc

     

       63
       63
       -
       

     

       64
       64
       -
         (* Convert to Mcp_rpc.ToolsList.Tool.t *)

     

       65
       65
       -
         let to_rpc_tool_list_tool (tool : t) =

     

       66
       66
       -
           Mcp_rpc.ToolsList.Tool.

     

       67
       67
       -
             {

     

       68
       68
       -
               name = tool.name;

     

       69
       69
       -
               description = tool.description;

     

       70
       70
       -
               input_schema = tool.input_schema;

     

       71
       71
       -
               annotations = None;

     

       72
       72
       -
               (* Could be extended to support annotations *)

     

       73
       73
       -
             }

     

       74
       74
       -
       

     

       75
       75
       -
         (* Convert a list of Tool.t to the format needed for tools/list response *)

     

       76
       76
       -
         let to_rpc_tools_list tools = List.map to_rpc_tool_list_tool tools

     

       77
       77
       -
       

     

       78
       78
       -
         (* Convert Mcp_rpc.ToolsCall response content to Mcp.content list *)

     

       79
       79
       -
         let rpc_content_to_mcp_content content =

     

       80
       80
       -
           List.map

     

       81
       81
       -
             (function

     

       82
       82
       -
               | Mcp_rpc.ToolsCall.ToolContent.Text t ->

     

       83
       83
       -
                   Mcp.Text { TextContent.text = t.text; annotations = None }

     

       84
       84
       -
               | Mcp_rpc.ToolsCall.ToolContent.Image i ->

     

       85
       85
       -
                   Mcp.Image

     

       86
       86
       -
                     {

     

       87
       87
       -
                       ImageContent.mime_type = i.mime_type;

     

       88
       88
       -
                       data = i.data;

     

       89
       89
       -
                       annotations = None;

     

       90
       90
       -
                     }

     

       91
       91
       -
               | Mcp_rpc.ToolsCall.ToolContent.Audio a ->

     

       92
       92
       -
                   Mcp.Audio

     

       93
       93
       -
                     {

     

       94
       94
       -
                       AudioContent.mime_type = a.mime_type;

     

       95
       95
       -
                       data = a.data;

     

       96
       96
       -
                       annotations = None;

     

       97
       97
       -
                     }

     

       98
       98
       -
               | Mcp_rpc.ToolsCall.ToolContent.Resource r ->

     

       99
       99
       -
                   (* Create a simple text resource from the embedded resource *)

     

       100
       100
       -
                   let uri =

     

       101
       101
       -
                     match r with

     

       102
       102
       -
                     | { EmbeddedResource.resource = `Text tr; _ } -> tr.uri

     

       103
       103
       -
                     | { EmbeddedResource.resource = `Blob br; _ } -> br.uri

     

       104
       104
       -
                   in

     

       105
       105
       -
                   let text_content =

     

       106
       106
       -
                     match r with

     

       107
       107
       -
                     | { EmbeddedResource.resource = `Text tr; _ } -> tr.text

     

       108
       108
       -
                     | { EmbeddedResource.resource = `Blob br; _ } -> "Binary content"

     

       109
       109
       -
                   in

     

       110
       110
       -
                   let mime_type =

     

       111
       111
       -
                     match r with

     

       112
       112
       -
                     | { EmbeddedResource.resource = `Text tr; _ } -> tr.mime_type

     

       113
       113
       -
                     | { EmbeddedResource.resource = `Blob br; _ } -> br.mime_type

     

       114
       114
       -
                   in

     

       115
       115
       -
                   let text_resource =

     

       116
       116
       -
                     { TextResourceContents.uri; text = text_content; mime_type }

     

       117
       117
       -
                   in

     

       118
       118
       -
                   Mcp.Resource

     

       119
       119
       -
                     {

     

       120
       120
       -
                       EmbeddedResource.resource = `Text text_resource;

     

       121
       121
       -
                       annotations = None;

     

       122
       122
       -
                     })

     

       123
       123
       -
             content

     

       124
       124
       -
       

     

       125
       125
       -
         (* Convert Mcp.content list to Mcp_rpc.ToolsCall.ToolContent.t list *)

     

       126
       126
       -
         let mcp_content_to_rpc_content content =

     

       127
       127
       -
           List.map

     

       128
       128
       -
             (function

     

       129
       129
       -
               | Mcp.Text t -> Mcp_rpc.ToolsCall.ToolContent.Text t

     

       130
       130
       -
               | Mcp.Image img -> Mcp_rpc.ToolsCall.ToolContent.Image img

     

       131
       131
       -
               | Mcp.Audio aud -> Mcp_rpc.ToolsCall.ToolContent.Audio aud

     

       132
       132
       -
               | Mcp.Resource res ->

     

       133
       133
       -
                   let resource_data =

     

       134
       134
       -
                     match res.resource with

     

       135
       135
       -
                     | `Text txt -> `Text txt

     

       136
       136
       -
                     | `Blob blob -> `Blob blob

     

       137
       137
       -
                   in

     

       138
       138
       -
                   let resource =

     

       139
       139
       -
                     {

     

       140
       140
       -
                       EmbeddedResource.resource = resource_data;

     

       141
       141
       -
                       annotations = res.annotations;

     

       142
       142
       -
                     }

     

       143
       143
       -
                   in

     

       144
       144
       -
                   Mcp_rpc.ToolsCall.ToolContent.Resource resource)

     

       145
       145
       -
             content

     

       146
       146
       -
       

     

       147
       147
       -
         (* Create a tool result with content *)

     

       148
       148
       -
         let create_tool_result content ~is_error =

     

       149
       149
       -
           `Assoc

     

       150
       150
       -
             [

     

       151
       151
       -
               ("content", `List (List.map Mcp.yojson_of_content content));

     

       152
       152
       -
               ("isError", `Bool is_error);

     

       153
       153
       -
             ]

     

       154
       154
       -
       

     

       155
       155
       -
         (* Create a tool error result with structured content *)

     

       156
       156
       -
         let create_error_result error =

     

       157
       157
       -
           Logs.err (fun m -> m "Error result: %s" error);

     

       158
       158
       -
           create_tool_result [ Mcp.make_text_content error ] ~is_error:true

     

       159
       159
       -
       

     

       160
       160
       -
         (* Handle tool execution errors *)

     

       161
       161
       -
         let handle_execution_error err =

     

       162
       162
       -
           create_error_result (Printf.sprintf "Error executing tool: %s" err)

     

       163
       163
       -
       

     

       164
       164
       -
         (* Handle unknown tool error *)

     

       165
       165
       -
         let handle_unknown_tool_error name =

     

       166
       166
       -
           create_error_result (Printf.sprintf "Unknown tool: %s" name)

     

       167
       167
       -
       

     

       168
       168
       -
         (* Handle general tool execution exception *)

     

       169
       169
       -
         let handle_execution_exception exn =

     

       170
       170
       -
           create_error_result

     

       171
       171
       -
             (Printf.sprintf "Internal error: %s" (Printexc.to_string exn))

     

       172
       77
        
       end

     

       173
       78
        
       

     

       174
       79
        
       (* Resources for the MCP server *)

     
···

       176
       81
        
         type handler = Context.t -> string list -> (string, string) result

     

       177
       82
        
       

     

       178
       83
        
         type t = {

     

       179
       179
       -
           uri : string; (* For resources, this is the exact URI (no variables) *)

     

       180
       180
       -
           name : string;

     

       181
       181
       -
           description : string option;

     

       182
       182
       -
           mime_type : string option;

     

       183
       183
       -
           handler : handler;

     

       84
       84
       +
           uri_template: string;

     

       85
       85
       +
           description: string option;

     

       86
       86
       +
           mime_type: string option;

     

       87
       87
       +
           handler: handler;

     

       184
       88
        
         }

     

       185
       89
        
       

     

       186
       186
       -
         let create ~uri ~name ?description ?mime_type ~handler () =

     

       187
       187
       -
           (* Validate that the URI doesn't contain template variables *)

     

       188
       188
       -
           if String.contains uri '{' || String.contains uri '}' then

     

       189
       189
       -
             Logs.warn (fun m ->

     

       190
       190
       -
                 m

     

       191
       191
       -
                   "Resource '%s' contains template variables. Consider using \

     

       192
       192
       -
                    add_resource_template instead."

     

       193
       193
       -
                   uri);

     

       194
       194
       -
           { uri; name; description; mime_type; handler }

     

       90
       90
       +
         let create ~uri_template ?description ?mime_type ~handler () = 

     

       91
       91
       +
           { uri_template; description; mime_type; handler }

     

       195
       92
        
       

     

       196
       93
        
         let to_json resource =

     

       197
       197
       -
           let assoc =

     

       198
       198
       -
             [ ("uri", `String resource.uri); ("name", `String resource.name) ]

     

       199
       199
       -
           in

     

       200
       200
       -
           let assoc =

     

       201
       201
       -
             match resource.description with

     

       94
       94
       +
           let assoc = [

     

       95
       95
       +
             ("uriTemplate", `String resource.uri_template);

     

       96
       96
       +
           ] in

     

       97
       97
       +
           let assoc = match resource.description with

     

       202
       98
        
             | Some desc -> ("description", `String desc) :: assoc

     

       203
       99
        
             | None -> assoc

     

       204
       100
        
           in

     

       205
       205
       -
           let assoc =

     

       206
       206
       -
             match resource.mime_type with

     

       101
       101
       +
           let assoc = match resource.mime_type with

     

       207
       102
        
             | Some mime -> ("mimeType", `String mime) :: assoc

     

       208
       103
        
             | None -> assoc

     

       209
       104
        
           in

     

       210
       105
        
           `Assoc assoc

     

       211
       211
       -
       

     

       212
       212
       -
         (* Convert to Mcp_rpc.ResourcesList.Resource.t *)

     

       213
       213
       -
         let to_rpc_resource_list_resource (resource : t) =

     

       214
       214
       -
           Mcp_rpc.ResourcesList.Resource.

     

       215
       215
       -
             {

     

       216
       216
       -
               uri = resource.uri;

     

       217
       217
       -
               name = resource.name;

     

       218
       218
       -
               description = resource.description;

     

       219
       219
       -
               mime_type = resource.mime_type;

     

       220
       220
       -
               size = None;

     

       221
       221
       -
               (* Size can be added when we have actual resource content *)

     

       222
       222
       -
             }

     

       223
       223
       -
       

     

       224
       224
       -
         (* Convert a list of Resource.t to the format needed for resources/list response *)

     

       225
       225
       -
         let to_rpc_resources_list resources =

     

       226
       226
       -
           List.map to_rpc_resource_list_resource resources

     

       227
       106
        
       end

     

       228
       107
        
       

     

       229
       108
        
       (* Prompts for the MCP server *)

     

       230
       109
        
       module Prompt = struct

     

       231
       110
        
         type argument = {

     

       232
       232
       -
           name : string;

     

       233
       233
       -
           description : string option;

     

       234
       234
       -
           required : bool;

     

       111
       111
       +
           name: string;

     

       112
       112
       +
           description: string option;

     

       113
       113
       +
           required: bool;

     

       235
       114
        
         }

     

       236
       115
        
       

     

       237
       237
       -
         type message = { role : Role.t; content : content }

     

       116
       116
       +
         type message = {

     

       117
       117
       +
           role: Role.t;

     

       118
       118
       +
           content: content;

     

       119
       119
       +
         }

     

       238
       120
        
       

     

       239
       239
       -
         type handler =

     

       240
       240
       -
           Context.t -> (string * string) list -> (message list, string) result

     

       121
       121
       +
         type handler = Context.t -> (string * string) list -> (message list, string) result

     

       241
       122
        
       

     

       242
       123
        
         type t = {

     

       243
       243
       -
           name : string;

     

       244
       244
       -
           description : string option;

     

       245
       245
       -
           arguments : argument list;

     

       246
       246
       -
           handler : handler;

     

       124
       124
       +
           name: string;

     

       125
       125
       +
           description: string option;

     

       126
       126
       +
           arguments: argument list;

     

       127
       127
       +
           handler: handler;

     

       247
       128
        
         }

     

       248
       129
        
       

     

       249
       249
       -
         let create ~name ?description ?(arguments = []) ~handler () =

     

       130
       130
       +
         let create ~name ?description ?(arguments=[]) ~handler () = 

     

       250
       131
        
           { name; description; arguments; handler }

     

       251
       132
        
       

     

       252
       252
       -
         let create_argument ~name ?description ?(required = false) () =

     

       133
       133
       +
         let create_argument ~name ?description ?(required=false) () =

     

       253
       134
        
           { name; description; required }

     

       254
       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
       +
       

     

       255
       168
        
         let to_json prompt =

     

       256
       256
       -
           let assoc = [ ("name", `String prompt.name) ] in

     

       257
       257
       -
           let assoc =

     

       258
       258
       -
             match prompt.description with

     

       169
       169
       +
           let assoc = [

     

       170
       170
       +
             ("name", `String prompt.name);

     

       171
       171
       +
           ] in

     

       172
       172
       +
           let assoc = match prompt.description with

     

       259
       173
        
             | Some desc -> ("description", `String desc) :: assoc

     

       260
       174
        
             | None -> assoc

     

       261
       175
        
           in

     

       262
       262
       -
           let assoc =

     

       263
       263
       -
             if prompt.arguments <> [] then

     

       264
       264
       -
               let args =

     

       265
       265
       -
                 List.map

     

       266
       266
       -
                   (fun (arg : argument) ->

     

       267
       267
       -
                     let arg_assoc = [ ("name", `String arg.name) ] in

     

       268
       268
       -
                     let arg_assoc =

     

       269
       269
       -
                       match arg.description with

     

       270
       270
       -
                       | Some desc -> ("description", `String desc) :: arg_assoc

     

       271
       271
       -
                       | None -> arg_assoc

     

       272
       272
       -
                     in

     

       273
       273
       -
                     let arg_assoc =

     

       274
       274
       -
                       if arg.required then ("required", `Bool true) :: arg_assoc

     

       275
       275
       -
                       else arg_assoc

     

       276
       276
       -
                     in

     

       277
       277
       -
                     `Assoc arg_assoc)

     

       278
       278
       -
                   prompt.arguments

     

       176
       176
       +
           let assoc = if prompt.arguments <> [] then

     

       177
       177
       +
             let args = List.map (fun (arg: argument) ->

     

       178
       178
       +
               let arg_assoc = [

     

       179
       179
       +
                 ("name", `String arg.name);

     

       180
       180
       +
               ] in

     

       181
       181
       +
               let arg_assoc = match arg.description with

     

       182
       182
       +
                 | Some desc -> ("description", `String desc) :: arg_assoc

     

       183
       183
       +
                 | None -> arg_assoc

     

       184
       184
       +
               in

     

       185
       185
       +
               let arg_assoc = 

     

       186
       186
       +
                 if arg.required then

     

       187
       187
       +
                   ("required", `Bool true) :: arg_assoc

     

       188
       188
       +
                 else

     

       189
       189
       +
                   arg_assoc

     

       279
       190
        
               in

     

       280
       280
       -
               ("arguments", `List args) :: assoc

     

       281
       281
       -
             else assoc

     

       191
       191
       +
               `Assoc arg_assoc

     

       192
       192
       +
             ) prompt.arguments in

     

       193
       193
       +
             ("arguments", `List args) :: assoc

     

       194
       194
       +
           else

     

       195
       195
       +
             assoc

     

       282
       196
        
           in

     

       283
       197
        
           `Assoc assoc

     

       284
       284
       -
       

     

       285
       285
       -
         (* Convert argument to Mcp_rpc.PromptsList.PromptArgument.t *)

     

       286
       286
       -
         let argument_to_rpc_prompt_argument (arg : argument) =

     

       287
       287
       -
           Mcp_rpc.PromptsList.PromptArgument.

     

       288
       288
       -
             {

     

       289
       289
       -
               name = arg.name;

     

       290
       290
       -
               description = arg.description;

     

       291
       291
       -
               required = arg.required;

     

       292
       292
       -
             }

     

       293
       293
       -
       

     

       294
       294
       -
         (* Convert to Mcp_rpc.PromptsList.Prompt.t *)

     

       295
       295
       -
         let to_rpc_prompt_list_prompt (prompt : t) =

     

       296
       296
       -
           Mcp_rpc.PromptsList.Prompt.

     

       297
       297
       -
             {

     

       298
       298
       -
               name = prompt.name;

     

       299
       299
       -
               description = prompt.description;

     

       300
       300
       -
               arguments = List.map argument_to_rpc_prompt_argument prompt.arguments;

     

       301
       301
       -
             }

     

       198
       198
       +
       end

     

       302
       199
        
       

     

       303
       303
       -
         (* Convert a list of Prompt.t to the format needed for prompts/list response *)

     

       304
       304
       -
         let to_rpc_prompts_list prompts = List.map to_rpc_prompt_list_prompt prompts

     

       200
       200
       +
       (* Helper functions for creating common objects *)

     

       201
       201
       +
       let make_text_content text =

     

       202
       202
       +
         Text (TextContent.{ text; annotations = None })

     

       305
       203
        
       

     

       306
       306
       -
         (* Convert message to Mcp_rpc.PromptMessage.t *)

     

       307
       307
       -
         let message_to_rpc_prompt_message msg =

     

       308
       308
       -
           { PromptMessage.role = msg.role; PromptMessage.content = msg.content }

     

       204
       204
       +
       let make_text_content_with_annotations text annotations =

     

       205
       205
       +
         Text (TextContent.{ text; annotations = Some annotations })

     

       309
       206
        
       

     

       310
       310
       -
         (* Convert a list of messages to the format needed for prompts/get response *)

     

       311
       311
       -
         let messages_to_rpc_prompt_messages messages =

     

       312
       312
       -
           List.map message_to_rpc_prompt_message messages

     

       313
       313
       -
       end

     

       207
       207
       +
       let make_image_content data mime_type =

     

       208
       208
       +
         Image (ImageContent.{ data; mime_type; annotations = None })

     

       314
       209
        
       

     

       315
       315
       -
       let make_tool_schema properties required =

     

       316
       316
       -
         let props =

     

       317
       317
       -
           List.map

     

       318
       318
       -
             (fun (name, schema_type, description) ->

     

       319
       319
       -
               ( name,

     

       320
       320
       -
                 `Assoc

     

       321
       321
       -
                   [

     

       322
       322
       -
                     ("type", `String schema_type); ("description", `String description);

     

       323
       323
       -
                   ] ))

     

       324
       324
       -
             properties

     

       325
       325
       -
         in

     

       326
       326
       -
         let required_json = `List (List.map (fun name -> `String name) required) in

     

       327
       327
       -
         `Assoc

     

       328
       328
       -
           [

     

       329
       329
       -
             ("type", `String "object");

     

       330
       330
       -
             ("properties", `Assoc props);

     

       331
       331
       -
             ("required", required_json);

     

       332
       332
       -
           ]

     

       210
       210
       +
       let make_image_content_with_annotations data mime_type annotations =

     

       211
       211
       +
         Image (ImageContent.{ data; mime_type; annotations = Some annotations })

     

       333
       212
        
       

     

       334
       334
       -
       (* Resource Templates for the MCP server *)

     

       335
       335
       -
       module ResourceTemplate = struct

     

       336
       336
       -
         type handler = Context.t -> string list -> (string, string) result

     

       213
       213
       +
       let make_audio_content data mime_type =

     

       214
       214
       +
         Audio (AudioContent.{ data; mime_type; annotations = None })

     

       337
       215
        
       

     

       338
       338
       -
         type t = {

     

       339
       339
       -
           uri_template : string;

     

       340
       340
       -
           name : string;

     

       341
       341
       -
           description : string option;

     

       342
       342
       -
           mime_type : string option;

     

       343
       343
       -
           handler : handler;

     

       344
       344
       -
         }

     

       216
       216
       +
       let make_audio_content_with_annotations data mime_type annotations =

     

       217
       217
       +
         Audio (AudioContent.{ data; mime_type; annotations = Some annotations })

     

       345
       218
        
       

     

       346
       346
       -
         let create ~uri_template ~name ?description ?mime_type ~handler () =

     

       347
       347
       -
           { uri_template; name; description; mime_type; handler }

     

       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
       +
         })

     

       348
       224
        
       

     

       349
       349
       -
         let to_json resource_template =

     

       350
       350
       -
           let assoc =

     

       351
       351
       -
             [

     

       352
       352
       -
               ("uriTemplate", `String resource_template.uri_template);

     

       353
       353
       -
               ("name", `String resource_template.name);

     

       354
       354
       -
             ]

     

       355
       355
       -
           in

     

       356
       356
       -
           let assoc =

     

       357
       357
       -
             match resource_template.description with

     

       358
       358
       -
             | Some desc -> ("description", `String desc) :: assoc

     

       359
       359
       -
             | None -> assoc

     

       360
       360
       -
           in

     

       361
       361
       -
           let assoc =

     

       362
       362
       -
             match resource_template.mime_type with

     

       363
       363
       -
             | Some mime -> ("mimeType", `String mime) :: assoc

     

       364
       364
       -
             | None -> assoc

     

       365
       365
       -
           in

     

       366
       366
       -
           `Assoc assoc

     

       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
       +
         })

     

       367
       230
        
       

     

       368
       368
       -
         (* Convert to Mcp_rpc.ResourceTemplatesList.ResourceTemplate.t *)

     

       369
       369
       -
         let to_rpc_resource_template (template : t) =

     

       370
       370
       -
           Mcp_rpc.ListResourceTemplatesResult.ResourceTemplate.

     

       371
       371
       -
             {

     

       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

     

       231
       231
       +
       let make_tool_schema properties required =

     

       232
       232
       +
         let props = List.map (fun (name, schema_type, description) ->

     

       233
       233
       +
           (name, `Assoc [

     

       234
       234
       +
             ("type", `String schema_type);

     

       235
       235
       +
             ("description", `String description)

     

       236
       236
       +
           ])

     

       237
       237
       +
         ) properties in

     

       238
       238
       +
         let required_json = `List (List.map (fun name -> `String name) required) in

     

       239
       239
       +
         `Assoc [

     

       240
       240
       +
           ("type", `String "object");

     

       241
       241
       +
           ("properties", `Assoc props);

     

       242
       242
       +
           ("required", required_json)

     

       243
       243
       +
         ]

     

       382
       244
        
       

     

       383
       245
        
       (* Main server type *)

     

       384
       246
        
       type server = {

     

       385
       385
       -
         name : string;

     

       386
       386
       -
         version : string;

     

       387
       387
       -
         protocol_version : string;

     

       388
       388
       -
         lifespan_context : (string * Json.t) list;

     

       389
       389
       -
         mutable capabilities : Json.t;

     

       390
       390
       -
         mutable tools : Tool.t list;

     

       391
       391
       -
         mutable resources : Resource.t list;

     

       392
       392
       -
         mutable resource_templates : ResourceTemplate.t list;

     

       393
       393
       -
         mutable prompts : Prompt.t list;

     

       247
       247
       +
         name: string;

     

       248
       248
       +
         version: string;

     

       249
       249
       +
         protocol_version: string;

     

       250
       250
       +
         mutable capabilities: Json.t;

     

       251
       251
       +
         mutable tools: Tool.t list;

     

       252
       252
       +
         mutable resources: Resource.t list;

     

       253
       253
       +
         mutable prompts: Prompt.t list;

     

       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;

     

       394
       257
        
       }

     

       395
       258
        
       

     

       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

     

       405
       405
       -
       

     

       406
       259
        
       (* Create a new server *)

     

       407
       407
       -
       let create_server ~name ?(version = "0.1.0") ?(protocol_version = "2024-11-05")

     

       408
       408
       -
           () =

     

       409
       409
       -
         {

     

       260
       260
       +
       let create_server ~name ?(version="0.1.0") ?(protocol_version="2024-11-05") () =

     

       261
       261
       +
         { 

     

       410
       262
        
           name;

     

       411
       263
        
           version;

     

       412
       264
        
           protocol_version;

     

       413
       265
        
           capabilities = `Assoc [];

     

       414
       266
        
           tools = [];

     

       415
       267
        
           resources = [];

     

       416
       416
       -
           resource_templates = [];

     

       417
       268
        
           prompts = [];

     

       418
       269
        
           lifespan_context = [];

     

       270
       270
       +
           startup_hook = None;

     

       271
       271
       +
           shutdown_hook = None;

     

       419
       272
        
         }

     

       420
       273
        
       

     

       421
       274
        
       (* Default capabilities for the server *)

     

       422
       422
       -
       let default_capabilities ?(with_tools = true) ?(with_resources = false)

     

       423
       423
       -
           ?(with_resource_templates = false) ?(with_prompts = false) () =

     

       275
       275
       +
       let default_capabilities ?(with_tools=true) ?(with_resources=false) ?(with_prompts=false) () =

     

       424
       276
        
         let caps = [] in

     

       425
       425
       -
         let caps =

     

       426
       426
       -
           if with_tools then ("tools", `Assoc [ ("listChanged", `Bool true) ]) :: caps

     

       427
       427
       -
           else caps

     

       277
       277
       +
         let caps = 

     

       278
       278
       +
           if with_tools then

     

       279
       279
       +
             ("tools", `Assoc [

     

       280
       280
       +
               ("listChanged", `Bool true)

     

       281
       281
       +
             ]) :: caps

     

       282
       282
       +
           else

     

       283
       283
       +
             caps

     

       428
       284
        
         in

     

       429
       429
       -
         let caps =

     

       285
       285
       +
         let caps = 

     

       430
       286
        
           if with_resources then

     

       431
       431
       -
             ( "resources",

     

       432
       432
       -
               `Assoc [ ("listChanged", `Bool true); ("subscribe", `Bool false) ] )

     

       433
       433
       -
             :: caps

     

       287
       287
       +
             ("resources", `Assoc [

     

       288
       288
       +
               ("listChanged", `Bool true);

     

       289
       289
       +
               ("subscribe", `Bool false)

     

       290
       290
       +
             ]) :: caps

     

       434
       291
        
           else if not with_resources then

     

       435
       435
       -
             ( "resources",

     

       436
       436
       -
               `Assoc [ ("listChanged", `Bool false); ("subscribe", `Bool false) ] )

     

       437
       437
       -
             :: caps

     

       438
       438
       -
           else caps

     

       439
       439
       -
         in

     

       440
       440
       -
         let caps =

     

       441
       441
       -
           if with_resource_templates then

     

       442
       442
       -
             ("resourceTemplates", `Assoc [ ("listChanged", `Bool true) ]) :: caps

     

       443
       443
       -
           else if not with_resource_templates then

     

       444
       444
       -
             ("resourceTemplates", `Assoc [ ("listChanged", `Bool false) ]) :: caps

     

       445
       445
       -
           else caps

     

       292
       292
       +
             ("resources", `Assoc [

     

       293
       293
       +
               ("listChanged", `Bool false);

     

       294
       294
       +
               ("subscribe", `Bool false)

     

       295
       295
       +
             ]) :: caps

     

       296
       296
       +
           else

     

       297
       297
       +
             caps

     

       446
       298
        
         in

     

       447
       447
       -
         let caps =

     

       299
       299
       +
         let caps = 

     

       448
       300
        
           if with_prompts then

     

       449
       449
       -
             ("prompts", `Assoc [ ("listChanged", `Bool true) ]) :: caps

     

       301
       301
       +
             ("prompts", `Assoc [

     

       302
       302
       +
               ("listChanged", `Bool true)

     

       303
       303
       +
             ]) :: caps

     

       450
       304
        
           else if not with_prompts then

     

       451
       451
       -
             ("prompts", `Assoc [ ("listChanged", `Bool false) ]) :: caps

     

       452
       452
       -
           else caps

     

       305
       305
       +
             ("prompts", `Assoc [

     

       306
       306
       +
               ("listChanged", `Bool false)

     

       307
       307
       +
             ]) :: caps

     

       308
       308
       +
           else

     

       309
       309
       +
             caps

     

       453
       310
        
         in

     

       454
       311
        
         `Assoc caps

     

       455
       312
        
       

     
···

       459
       316
        
         tool

     

       460
       317
        
       

     

       461
       318
        
       (* Create and register a tool in one step *)

     

       462
       462
       -
       let add_tool server ~name ?description ?(schema_properties = [])

     

       463
       463
       -
           ?(schema_required = []) handler =

     

       319
       319
       +
       let add_tool server ~name ?description ?(schema_properties=[]) ?(schema_required=[]) handler =

     

       464
       320
        
         let input_schema = make_tool_schema schema_properties schema_required in

     

       465
       321
        
         let handler' ctx args =

     

       466
       466
       -
           try Ok (handler args) with exn -> Error (Printexc.to_string exn)

     

       322
       322
       +
           try

     

       323
       323
       +
             Ok (handler args)

     

       324
       324
       +
           with exn ->

     

       325
       325
       +
             Error (Printexc.to_string exn)

     

       467
       326
        
         in

     

       468
       468
       -
         let tool =

     

       469
       469
       -
           Tool.create ~name ?description ~input_schema ~handler:handler' ()

     

       327
       327
       +
         let tool = Tool.create

     

       328
       328
       +
           ~name

     

       329
       329
       +
           ?description

     

       330
       330
       +
           ~input_schema

     

       331
       331
       +
           ~handler:handler'

     

       332
       332
       +
           ()

     

       470
       333
        
         in

     

       471
       334
        
         register_tool server tool

     

       472
       335
        
       

     
···

       476
       339
        
         resource

     

       477
       340
        
       

     

       478
       341
        
       (* Create and register a resource in one step *)

     

       479
       479
       -
       let add_resource server ~uri ~name ?description ?mime_type handler =

     

       342
       342
       +
       let add_resource server ~uri_template ?description ?mime_type handler =

     

       480
       343
        
         let handler' _ctx params =

     

       481
       481
       -
           try Ok (handler params) with exn -> Error (Printexc.to_string exn)

     

       344
       344
       +
           try

     

       345
       345
       +
             Ok (handler params)

     

       346
       346
       +
           with exn ->

     

       347
       347
       +
             Error (Printexc.to_string exn)

     

       482
       348
        
         in

     

       483
       483
       -
         let resource =

     

       484
       484
       -
           Resource.create ~uri ~name ?description ?mime_type ~handler:handler' ()

     

       349
       349
       +
         let resource = Resource.create

     

       350
       350
       +
           ~uri_template

     

       351
       351
       +
           ?description

     

       352
       352
       +
           ?mime_type

     

       353
       353
       +
           ~handler:handler'

     

       354
       354
       +
           ()

     

       485
       355
        
         in

     

       486
       356
        
         register_resource server resource

     

       487
       357
        
       

     

       488
       488
       -
       (* Register a resource template *)

     

       489
       489
       -
       let register_resource_template server template =

     

       490
       490
       -
         server.resource_templates <- template :: server.resource_templates;

     

       491
       491
       -
         template

     

       492
       492
       -
       

     

       493
       493
       -
       (* Create and register a resource template in one step *)

     

       494
       494
       -
       let add_resource_template server ~uri_template ~name ?description ?mime_type

     

       495
       495
       -
           handler =

     

       496
       496
       -
         let handler' _ctx params =

     

       497
       497
       -
           try Ok (handler params) with exn -> Error (Printexc.to_string exn)

     

       498
       498
       -
         in

     

       499
       499
       -
         let template =

     

       500
       500
       -
           ResourceTemplate.create ~uri_template ~name ?description ?mime_type

     

       501
       501
       -
             ~handler:handler' ()

     

       502
       502
       -
         in

     

       503
       503
       -
         register_resource_template server template

     

       504
       504
       -
       

     

       505
       358
        
       (* Register a prompt *)

     

       506
       359
        
       let register_prompt server prompt =

     

       507
       360
        
         server.prompts <- prompt :: server.prompts;

     

       508
       361
        
         prompt

     

       509
       362
        
       

     

       510
       363
        
       (* Create and register a prompt in one step *)

     

       511
       511
       -
       let add_prompt server ~name ?description ?(arguments = []) handler =

     

       512
       512
       -
         let prompt_args =

     

       513
       513
       -
           List.map

     

       514
       514
       -
             (fun (name, desc, required) ->

     

       515
       515
       -
               Prompt.create_argument ~name ?description:desc ~required ())

     

       516
       516
       -
             arguments

     

       517
       517
       -
         in

     

       364
       364
       +
       let add_prompt server ~name ?description ?(arguments=[]) handler =

     

       365
       365
       +
         let prompt_args = List.map (fun (name, desc, required) ->

     

       366
       366
       +
           Prompt.create_argument ~name ?description:desc ~required ()

     

       367
       367
       +
         ) arguments in

     

       518
       368
        
         let handler' _ctx args =

     

       519
       519
       -
           try Ok (handler args) with exn -> Error (Printexc.to_string exn)

     

       369
       369
       +
           try

     

       370
       370
       +
             Ok (handler args)

     

       371
       371
       +
           with exn ->

     

       372
       372
       +
             Error (Printexc.to_string exn)

     

       520
       373
        
         in

     

       521
       521
       -
         let prompt =

     

       522
       522
       -
           Prompt.create ~name ?description ~arguments:prompt_args ~handler:handler' ()

     

       374
       374
       +
         let prompt = Prompt.create

     

       375
       375
       +
           ~name

     

       376
       376
       +
           ?description

     

       377
       377
       +
           ~arguments:prompt_args

     

       378
       378
       +
           ~handler:handler'

     

       379
       379
       +
           ()

     

       523
       380
        
         in

     

       524
       381
        
         register_prompt server prompt

     

       525
       382
        
       

     

       526
       383
        
       (* Set server capabilities *)

     

       527
       527
       -
       let set_capabilities server capabilities = server.capabilities <- capabilities

     

       384
       384
       +
       let set_capabilities server capabilities =

     

       385
       385
       +
         server.capabilities <- capabilities

     

       528
       386
        
       

     

       529
       387
        
       (* Configure server with default capabilities based on registered components *)

     

       530
       530
       -
       let configure_server server ?with_tools ?with_resources ?with_resource_templates

     

       531
       531
       -
           ?with_prompts () =

     

       532
       532
       -
         let with_tools =

     

       533
       533
       -
           match with_tools with Some b -> b | None -> server.tools <> []

     

       388
       388
       +
       let configure_server server ?with_tools ?with_resources ?with_prompts () =

     

       389
       389
       +
         let with_tools = match with_tools with

     

       390
       390
       +
           | Some b -> b

     

       391
       391
       +
           | None -> server.tools <> []

     

       534
       392
        
         in

     

       535
       535
       -
         let with_resources =

     

       536
       536
       -
           match with_resources with Some b -> b | None -> server.resources <> []

     

       393
       393
       +
         let with_resources = match with_resources with

     

       394
       394
       +
           | Some b -> b

     

       395
       395
       +
           | None -> server.resources <> []

     

       537
       396
        
         in

     

       538
       538
       -
         let with_resource_templates =

     

       539
       539
       -
           match with_resource_templates with

     

       397
       397
       +
         let with_prompts = match with_prompts with

     

       540
       398
        
           | Some b -> b

     

       541
       541
       -
           | None -> server.resource_templates <> []

     

       542
       542
       -
         in

     

       543
       543
       -
         let with_prompts =

     

       544
       544
       -
           match with_prompts with Some b -> b | None -> server.prompts <> []

     

       545
       545
       -
         in

     

       546
       546
       -
         let capabilities =

     

       547
       547
       -
           default_capabilities ~with_tools ~with_resources ~with_resource_templates

     

       548
       548
       -
             ~with_prompts ()

     

       399
       399
       +
           | None -> server.prompts <> []

     

       549
       400
        
         in

     

       401
       401
       +
         let capabilities = default_capabilities ~with_tools ~with_resources ~with_prompts () in

     

       550
       402
        
         set_capabilities server capabilities;

     

       551
       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

+102 -203

lib/mcp_sdk.mli

···

       3
       3
        
       open Mcp

     

       4
       4
        
       open Jsonrpc

     

       5
       5
        
       

     

       6
       6
       -
       val version : string

     

       7
       6
        
       (** SDK version *)

     

       7
       7
       +
       val version : string

     

       8
       8
       +
       

     

       9
       9
       +
       (** Logging utilities *)

     

       10
       10
       +
       module Log : sig

     

       11
       11
       +
         type level = Debug | Info | Warning | Error

     

       12
       12
       +
       

     

       13
       13
       +
         val string_of_level : level -> string

     

       14
       14
       +
       

     

       15
       15
       +
         val log : level -> string -> unit

     

       16
       16
       +
         val debug : string -> unit

     

       17
       17
       +
         val info : string -> unit

     

       18
       18
       +
         val warning : string -> unit

     

       19
       19
       +
         val error : string -> unit

     

       20
       20
       +
       end

     

       8
       21
        
       

     

       9
       22
        
       (** Context for tools and resources *)

     

       10
       23
        
       module Context : sig

     

       11
       11
       -
         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
       +
         }

     

       12
       29
        
       

     

       13
       13
       -
         val create :

     

       14
       14
       -
           ?request_id:RequestId.t ->

     

       15
       15
       -
           ?progress_token:ProgressToken.t ->

     

       16
       16
       -
           ?lifespan_context:(string * Json.t) list ->

     

       17
       17
       -
           unit ->

     

       18
       18
       -
           t

     

       19
       19
       -
       

     

       30
       30
       +
         val create : ?request_id:RequestId.t -> ?lifespan_context:(string * Json.t) list -> unit -> t

     

       20
       31
        
         val get_context_value : t -> string -> Json.t option

     

       21
       32
        
         val report_progress : t -> float -> float -> JSONRPCMessage.t option

     

       22
       33
        
       end

     
···

       26
       37
        
         type handler = Context.t -> Json.t -> (Json.t, string) result

     

       27
       38
        
       

     

       28
       39
        
         type t = {

     

       29
       29
       -
           name : string;

     

       30
       30
       -
           description : string option;

     

       31
       31
       -
           input_schema : Json.t;

     

       32
       32
       -
           handler : handler;

     

       40
       40
       +
           name: string;

     

       41
       41
       +
           description: string option;

     

       42
       42
       +
           input_schema: Json.t;

     

       43
       43
       +
           handler: handler;

     

       33
       44
        
         }

     

       34
       45
        
       

     

       35
       35
       -
         val create :

     

       36
       36
       -
           name:string ->

     

       37
       37
       -
           ?description:string ->

     

       38
       38
       -
           input_schema:Json.t ->

     

       39
       39
       -
           handler:handler ->

     

       40
       40
       -
           unit ->

     

       41
       41
       -
           t

     

       42
       42
       -
       

     

       46
       46
       +
         val create : name:string -> ?description:string -> input_schema:Json.t -> handler:handler -> unit -> t

     

       43
       47
        
         val to_json : t -> Json.t

     

       44
       44
       -
       

     

       45
       45
       -
         val to_rpc_tool_list_tool : t -> Mcp_rpc.ToolsList.Tool.t

     

       46
       46
       -
         (** Convert to Mcp_rpc.ToolsList.Tool.t *)

     

       47
       47
       -
       

     

       48
       48
       -
         val to_rpc_tools_list : t list -> Mcp_rpc.ToolsList.Tool.t list

     

       49
       49
       -
         (** Convert a list of Tool.t to the format needed for tools/list response *)

     

       50
       50
       -
       

     

       51
       51
       -
         val rpc_content_to_mcp_content :

     

       52
       52
       -
           Mcp_rpc.ToolsCall.ToolContent.t list -> Mcp.content list

     

       53
       53
       -
         (** Convert Mcp_rpc.ToolsCall response content to Mcp.content list *)

     

       54
       54
       -
       

     

       55
       55
       -
         val mcp_content_to_rpc_content :

     

       56
       56
       -
           Mcp.content list -> Mcp_rpc.ToolsCall.ToolContent.t list

     

       57
       57
       -
         (** Convert Mcp.content list to Mcp_rpc.ToolsCall.ToolContent.t list *)

     

       58
       58
       -
       

     

       59
       59
       -
         val create_tool_result : Mcp.content list -> is_error:bool -> Json.t

     

       60
       60
       -
         (** Create a tool result with content *)

     

       61
       61
       -
       

     

       62
       62
       -
         val create_error_result : string -> Json.t

     

       63
       63
       -
         (** Create a tool error result with structured content *)

     

       64
       64
       -
       

     

       65
       65
       -
         val handle_execution_error : string -> Json.t

     

       66
       66
       -
         (** Handle tool execution errors *)

     

       67
       67
       -
       

     

       68
       68
       -
         val handle_unknown_tool_error : string -> Json.t

     

       69
       69
       -
         (** Handle unknown tool error *)

     

       70
       70
       -
       

     

       71
       71
       -
         val handle_execution_exception : exn -> Json.t

     

       72
       72
       -
         (** Handle general tool execution exception *)

     

       73
       48
        
       end

     

       74
       49
        
       

     

       75
       50
        
       (** Resources for the MCP server *)

     
···

       77
       52
        
         type handler = Context.t -> string list -> (string, string) result

     

       78
       53
        
       

     

       79
       54
        
         type t = {

     

       80
       80
       -
           uri : string;

     

       81
       81
       -
           name : string;

     

       82
       82
       -
           description : string option;

     

       83
       83
       -
           mime_type : string option;

     

       84
       84
       -
           handler : handler;

     

       85
       85
       -
         }

     

       86
       86
       -
       

     

       87
       87
       -
         val create :

     

       88
       88
       -
           uri:string ->

     

       89
       89
       -
           name:string ->

     

       90
       90
       -
           ?description:string ->

     

       91
       91
       -
           ?mime_type:string ->

     

       92
       92
       -
           handler:handler ->

     

       93
       93
       -
           unit ->

     

       94
       94
       -
           t

     

       95
       95
       -
       

     

       96
       96
       -
         val to_json : t -> Json.t

     

       97
       97
       -
       

     

       98
       98
       -
         val to_rpc_resource_list_resource : t -> Mcp_rpc.ResourcesList.Resource.t

     

       99
       99
       -
         (** Convert to Mcp_rpc.ResourcesList.Resource.t *)

     

       100
       100
       -
       

     

       101
       101
       -
         val to_rpc_resources_list : t list -> Mcp_rpc.ResourcesList.Resource.t list

     

       102
       102
       -
         (** Convert a list of Resource.t to the format needed for resources/list

     

       103
       103
       -
             response *)

     

       104
       104
       -
       end

     

       105
       105
       -
       

     

       106
       106
       -
       (** Resource Templates for the MCP server *)

     

       107
       107
       -
       module ResourceTemplate : sig

     

       108
       108
       -
         type handler = Context.t -> string list -> (string, string) result

     

       109
       109
       -
       

     

       110
       110
       -
         type t = {

     

       111
       111
       -
           uri_template : string;

     

       112
       112
       -
           name : string;

     

       113
       113
       -
           description : string option;

     

       114
       114
       -
           mime_type : string option;

     

       115
       115
       -
           handler : handler;

     

       55
       55
       +
           uri_template: string;

     

       56
       56
       +
           description: string option;

     

       57
       57
       +
           mime_type: string option;

     

       58
       58
       +
           handler: handler;

     

       116
       59
        
         }

     

       117
       60
        
       

     

       118
       118
       -
         val create :

     

       119
       119
       -
           uri_template:string ->

     

       120
       120
       -
           name:string ->

     

       121
       121
       -
           ?description:string ->

     

       122
       122
       -
           ?mime_type:string ->

     

       123
       123
       -
           handler:handler ->

     

       124
       124
       -
           unit ->

     

       125
       125
       -
           t

     

       126
       126
       -
       

     

       61
       61
       +
         val create : uri_template:string -> ?description:string -> ?mime_type:string -> handler:handler -> unit -> t

     

       127
       62
        
         val to_json : t -> Json.t

     

       128
       128
       -
       

     

       129
       129
       -
         val to_rpc_resource_template :

     

       130
       130
       -
           t -> Mcp_rpc.ListResourceTemplatesResult.ResourceTemplate.t

     

       131
       131
       -
         (** Convert to Mcp_rpc.ResourceTemplatesList.ResourceTemplate.t *)

     

       132
       132
       -
       

     

       133
       133
       -
         val to_rpc_resource_templates_list :

     

       134
       134
       -
           t list -> Mcp_rpc.ListResourceTemplatesResult.ResourceTemplate.t list

     

       135
       135
       -
         (** Convert a list of ResourceTemplate.t to the format needed for

     

       136
       136
       -
             resources/templates/list response *)

     

       137
       63
        
       end

     

       138
       64
        
       

     

       139
       65
        
       (** Prompts for the MCP server *)

     

       140
       66
        
       module Prompt : sig

     

       141
       67
        
         type argument = {

     

       142
       142
       -
           name : string;

     

       143
       143
       -
           description : string option;

     

       144
       144
       -
           required : bool;

     

       68
       68
       +
           name: string;

     

       69
       69
       +
           description: string option;

     

       70
       70
       +
           required: bool;

     

       145
       71
        
         }

     

       146
       72
        
       

     

       147
       147
       -
         type message = { role : Role.t; content : content }

     

       73
       73
       +
         type message = {

     

       74
       74
       +
           role: Role.t;

     

       75
       75
       +
           content: content;

     

       76
       76
       +
         }

     

       148
       77
        
       

     

       149
       149
       -
         type handler =

     

       150
       150
       -
           Context.t -> (string * string) list -> (message list, string) result

     

       78
       78
       +
         type handler = Context.t -> (string * string) list -> (message list, string) result

     

       151
       79
        
       

     

       152
       80
        
         type t = {

     

       153
       153
       -
           name : string;

     

       154
       154
       -
           description : string option;

     

       155
       155
       -
           arguments : argument list;

     

       156
       156
       -
           handler : handler;

     

       81
       81
       +
           name: string;

     

       82
       82
       +
           description: string option;

     

       83
       83
       +
           arguments: argument list;

     

       84
       84
       +
           handler: handler;

     

       157
       85
        
         }

     

       158
       86
        
       

     

       159
       159
       -
         val create :

     

       160
       160
       -
           name:string ->

     

       161
       161
       -
           ?description:string ->

     

       162
       162
       -
           ?arguments:argument list ->

     

       163
       163
       -
           handler:handler ->

     

       164
       164
       -
           unit ->

     

       165
       165
       -
           t

     

       166
       166
       -
       

     

       167
       167
       -
         val create_argument :

     

       168
       168
       -
           name:string -> ?description:string -> ?required:bool -> unit -> argument

     

       169
       169
       -
       

     

       87
       87
       +
         val create : name:string -> ?description:string -> ?arguments:argument list -> handler:handler -> unit -> t

     

       88
       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

     

       170
       91
        
         val to_json : t -> Json.t

     

       171
       171
       -
       

     

       172
       172
       -
         val argument_to_rpc_prompt_argument :

     

       173
       173
       -
           argument -> Mcp_rpc.PromptsList.PromptArgument.t

     

       174
       174
       -
         (** Convert argument to Mcp_rpc.PromptsList.PromptArgument.t *)

     

       175
       175
       -
       

     

       176
       176
       -
         val to_rpc_prompt_list_prompt : t -> Mcp_rpc.PromptsList.Prompt.t

     

       177
       177
       -
         (** Convert to Mcp_rpc.PromptsList.Prompt.t *)

     

       178
       178
       -
       

     

       179
       179
       -
         val to_rpc_prompts_list : t list -> Mcp_rpc.PromptsList.Prompt.t list

     

       180
       180
       -
         (** Convert a list of Prompt.t to the format needed for prompts/list response

     

       181
       181
       -
         *)

     

       182
       182
       -
       

     

       183
       183
       -
         val message_to_rpc_prompt_message : message -> PromptMessage.t

     

       184
       184
       -
         (** Convert message to Mcp_rpc.PromptMessage.t *)

     

       185
       185
       -
       

     

       186
       186
       -
         val messages_to_rpc_prompt_messages : message list -> PromptMessage.t list

     

       187
       187
       -
         (** Convert a list of messages to the format needed for prompts/get response

     

       188
       188
       -
         *)

     

       189
       92
        
       end

     

       190
       93
        
       

     

       191
       191
       -
       type server

     

       192
       94
        
       (** Main server type *)

     

       193
       193
       -
       

     

       194
       194
       -
       val name : server -> string

     

       195
       195
       -
       val version : server -> string

     

       196
       196
       -
       val protocol_version : server -> string

     

       197
       197
       -
       val capabilities : server -> Json.t

     

       198
       198
       -
       val tools : server -> Tool.t list

     

       199
       199
       -
       val resources : server -> Resource.t list

     

       200
       200
       -
       val resource_templates : server -> ResourceTemplate.t list

     

       201
       201
       -
       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
       +
       }

     

       202
       107
        
       

     

       203
       203
       -
       val create_server :

     

       204
       204
       -
         name:string -> ?version:string -> ?protocol_version:string -> unit -> server

     

       205
       108
        
       (** Create a new server *)

     

       109
       109
       +
       val create_server : name:string -> ?version:string -> ?protocol_version:string -> unit -> server

     

       206
       110
        
       

     

       207
       207
       -
       val default_capabilities :

     

       208
       208
       -
         ?with_tools:bool ->

     

       209
       209
       -
         ?with_resources:bool ->

     

       210
       210
       -
         ?with_resource_templates:bool ->

     

       211
       211
       -
         ?with_prompts:bool ->

     

       212
       212
       -
         unit ->

     

       213
       213
       -
         Json.t

     

       214
       111
        
       (** Default capabilities for the server *)

     

       112
       112
       +
       val default_capabilities : ?with_tools:bool -> ?with_resources:bool -> ?with_prompts:bool -> unit -> Json.t

     

       215
       113
        
       

     

       216
       216
       -
       val add_tool :

     

       217
       217
       -
         server ->

     

       218
       218
       -
         name:string ->

     

       219
       219
       -
         ?description:string ->

     

       220
       220
       -
         ?schema_properties:(string * string * string) list ->

     

       221
       221
       -
         ?schema_required:string list ->

     

       222
       222
       -
         (Json.t -> Json.t) ->

     

       223
       223
       -
         Tool.t

     

       114
       114
       +
       (** Register a tool with the server *)

     

       115
       115
       +
       val register_tool : server -> Tool.t -> Tool.t

     

       116
       116
       +
       

     

       224
       117
        
       (** Create and register a tool in one step *)

     

       118
       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

     

       225
       119
        
       

     

       226
       226
       -
       val add_resource :

     

       227
       227
       -
         server ->

     

       228
       228
       -
         uri:string ->

     

       229
       229
       -
         name:string ->

     

       230
       230
       -
         ?description:string ->

     

       231
       231
       -
         ?mime_type:string ->

     

       232
       232
       -
         (string list -> string) ->

     

       233
       233
       -
         Resource.t

     

       120
       120
       +
       (** Register a resource with the server *)

     

       121
       121
       +
       val register_resource : server -> Resource.t -> Resource.t

     

       122
       122
       +
       

     

       234
       123
        
       (** Create and register a resource in one step *)

     

       124
       124
       +
       val add_resource : server -> uri_template:string -> ?description:string -> ?mime_type:string -> (string list -> string) -> Resource.t

     

       235
       125
        
       

     

       236
       236
       -
       val add_resource_template :

     

       237
       237
       -
         server ->

     

       238
       238
       -
         uri_template:string ->

     

       239
       239
       -
         name:string ->

     

       240
       240
       -
         ?description:string ->

     

       241
       241
       -
         ?mime_type:string ->

     

       242
       242
       -
         (string list -> string) ->

     

       243
       243
       -
         ResourceTemplate.t

     

       244
       244
       -
       (** Create and register a resource template in one step *)

     

       126
       126
       +
       (** Register a prompt with the server *)

     

       127
       127
       +
       val register_prompt : server -> Prompt.t -> Prompt.t

     

       245
       128
        
       

     

       246
       246
       -
       val add_prompt :

     

       247
       247
       -
         server ->

     

       248
       248
       -
         name:string ->

     

       249
       249
       -
         ?description:string ->

     

       250
       250
       -
         ?arguments:(string * string option * bool) list ->

     

       251
       251
       -
         ((string * string) list -> Prompt.message list) ->

     

       252
       252
       -
         Prompt.t

     

       253
       129
        
       (** Create and register a prompt in one step *)

     

       130
       130
       +
       val add_prompt : server -> name:string -> ?description:string -> ?arguments:(string * string option * bool) list -> ((string * string) list -> Prompt.message list) -> Prompt.t

     

       254
       131
        
       

     

       255
       255
       -
       val configure_server :

     

       256
       256
       -
         server ->

     

       257
       257
       -
         ?with_tools:bool ->

     

       258
       258
       -
         ?with_resources:bool ->

     

       259
       259
       -
         ?with_resource_templates:bool ->

     

       260
       260
       -
         ?with_prompts:bool ->

     

       261
       261
       -
         unit ->

     

       262
       262
       -
         server

     

       132
       132
       +
       (** Set server capabilities *)

     

       133
       133
       +
       val set_capabilities : server -> Json.t -> unit

     

       134
       134
       +
       

     

       263
       135
        
       (** Configure server with default capabilities based on registered components *)

     

       136
       136
       +
       val configure_server : server -> ?with_tools:bool -> ?with_resources:bool -> ?with_prompts:bool -> unit -> server

     

       264
       137
        
       

     

       265
       265
       -
       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 -539

lib/mcp_server.ml

···

       1
       1
        
       open Mcp

     

       2
       2
       -
       open Jsonrpc

     

       3
       2
        
       open Mcp_sdk

     

       4
       3
        
       

     

       5
       5
       -
       let src = Logs.Src.create "mcp.sdk" ~doc:"mcp.sdk logging"

     

       6
       6
       -
       

     

       7
       7
       -
       module Log = (val Logs.src_log src : Logs.LOG)

     

       8
       8
       -
       

     

       9
       9
       -
       (* Create a proper JSONRPC error with code and data *)

     

       10
       10
       -
       let create_jsonrpc_error id code message ?data () =

     

       11
       11
       -
         let error_code = ErrorCode.to_int code in

     

       12
       12
       -
         let error_data = match data with Some d -> d | None -> `Null in

     

       13
       13
       -
         create_error ~id ~code:error_code ~message ~data:(Some error_data) ()

     

       14
       14
       -
       

     

       15
       15
       -
       (* Process initialize request *)

     

       16
       16
       -
       let handle_initialize server req =

     

       17
       17
       -
         Log.debug (fun m -> m "Processing initialize request");

     

       18
       18
       -
         let result =

     

       19
       19
       -
           match req.JSONRPCMessage.params with

     

       20
       20
       -
           | Some params ->

     

       21
       21
       -
               let req_data = Initialize.Request.t_of_yojson params in

     

       22
       22
       -
               Logs.debug (fun m ->

     

       23
       23
       -
                   m "Client info: %s v%s" req_data.client_info.name

     

       24
       24
       -
                     req_data.client_info.version);

     

       25
       25
       -
               Log.debug (fun m ->

     

       26
       26
       -
                   m "Client protocol version: %s" req_data.protocol_version);

     

       27
       27
       -
       

     

       28
       28
       -
               (* Create initialize response *)

     

       29
       29
       -
               let result =

     

       30
       30
       -
                 Initialize.Result.create ~capabilities:(capabilities server)

     

       31
       31
       -
                   ~server_info:

     

       32
       32
       -
                     Implementation.{ name = name server; version = version server }

     

       33
       33
       -
                   ~protocol_version:(protocol_version server)

     

       34
       34
       -
                   ~instructions:

     

       35
       35
       -
                     (Printf.sprintf "This server provides tools for %s." (name server))

     

       36
       36
       -
                   ()

     

       37
       37
       -
               in

     

       38
       38
       -
               Initialize.Result.yojson_of_t result

     

       39
       39
       -
           | None ->

     

       40
       40
       -
               Log.err (fun m -> m "Missing params for initialize request");

     

       41
       41
       -
               `Assoc [ ("error", `String "Missing params for initialize request") ]

     

       42
       42
       -
         in

     

       43
       43
       -
         Some (create_response ~id:req.id ~result)

     

       44
       44
       -
       

     

       45
       45
       -
       (* Process tools/list request *)

     

       46
       46
       -
       let handle_tools_list server (req : JSONRPCMessage.request) =

     

       47
       47
       -
         Log.debug (fun m -> m "Processing tools/list request");

     

       48
       48
       -
         let tools_list = Tool.to_rpc_tools_list (tools server) in

     

       49
       49
       -
         let response =

     

       50
       50
       -
           Mcp_rpc.ToolsList.create_response ~id:req.id ~tools:tools_list ()

     

       51
       51
       -
         in

     

       52
       52
       -
         Some response

     

       53
       53
       -
       

     

       54
       54
       -
       (* Process prompts/list request *)

     

       55
       55
       -
       let handle_prompts_list server (req : JSONRPCMessage.request) =

     

       56
       56
       -
         Log.debug (fun m -> m "Processing prompts/list request");

     

       57
       57
       -
         let prompts_list = Prompt.to_rpc_prompts_list (prompts server) in

     

       58
       58
       -
         let response =

     

       59
       59
       -
           Mcp_rpc.PromptsList.create_response ~id:req.id ~prompts:prompts_list ()

     

       60
       60
       -
         in

     

       61
       61
       -
         Some response

     

       62
       62
       -
       

     

       63
       63
       -
       (* Process resources/list request *)

     

       64
       64
       -
       let handle_resources_list server (req : JSONRPCMessage.request) =

     

       65
       65
       -
         Log.debug (fun m -> m "Processing resources/list request");

     

       66
       66
       -
         let resources_list = Resource.to_rpc_resources_list (resources server) in

     

       67
       67
       -
         let response =

     

       68
       68
       -
           Mcp_rpc.ResourcesList.create_response ~id:req.id ~resources:resources_list

     

       69
       69
       -
             ()

     

       70
       70
       -
         in

     

       71
       71
       -
         Some response

     

       72
       72
       -
       

     

       73
       73
       -
       (* Process resources/templates/list request *)

     

       74
       74
       -
       let handle_resource_templates_list server (req : JSONRPCMessage.request) =

     

       75
       75
       -
         Log.debug (fun m -> m "Processing resources/templates/list request");

     

       76
       76
       -
         let templates_list =

     

       77
       77
       -
           ResourceTemplate.to_rpc_resource_templates_list (resource_templates server)

     

       78
       78
       -
         in

     

       79
       79
       -
         let response =

     

       80
       80
       -
           Mcp_rpc.ListResourceTemplatesResult.create_response ~id:req.id

     

       81
       81
       -
             ~resource_templates:templates_list ()

     

       82
       82
       -
         in

     

       83
       83
       -
         Some response

     

       84
       84
       -
       

     

       85
       85
       -
       (* Utility module for resource template matching *)

     

       86
       86
       -
       module Resource_matcher = struct

     

       87
       87
       -
         (* Define variants for resource handling result *)

     

       88
       88
       -
         type resource_match =

     

       89
       89
       -
           | DirectResource of Resource.t * string list

     

       90
       90
       -
           | TemplateResource of ResourceTemplate.t * string list

     

       91
       91
       -
           | NoMatch

     

       92
       92
       -
       

     

       93
       93
       -
         (* Extract parameters from a template URI *)

     

       94
       94
       -
         let extract_template_vars template_uri uri =

     

       95
       95
       -
           (* Simple template variable extraction - could be enhanced with regex *)

     

       96
       96
       -
           let template_parts = String.split_on_char '/' template_uri in

     

       97
       97
       -
           let uri_parts = String.split_on_char '/' uri in

     

       98
       98
       -
       

     

       99
       99
       -
           if List.length template_parts <> List.length uri_parts then None

     

       100
       100
       -
           else

     

       101
       101
       -
             (* Match parts and extract variables *)

     

       102
       102
       -
             let rec match_parts tparts uparts acc =

     

       103
       103
       -
               match (tparts, uparts) with

     

       104
       104
       -
               | [], [] -> Some (List.rev acc)

     

       105
       105
       -
               | th :: tt, uh :: ut ->

     

       106
       106
       -
                   (* Check if this part is a template variable *)

     

       107
       107
       -
                   if

     

       108
       108
       -
                     String.length th > 2

     

       109
       109
       -
                     && String.get th 0 = '{'

     

       110
       110
       -
                     && String.get th (String.length th - 1) = '}'

     

       111
       111
       -
                   then

     

       112
       112
       -
                     (* Extract variable value and continue *)

     

       113
       113
       -
                     match_parts tt ut (uh :: acc)

     

       114
       114
       -
                   else if th = uh then

     

       115
       115
       -
                     (* Fixed part matches, continue *)

     

       116
       116
       -
                     match_parts tt ut acc

     

       117
       117
       -
                   else

     

       118
       118
       -
                     (* Fixed part doesn't match, fail *)

     

       119
       119
       -
                     None

     

       120
       120
       -
               | _, _ -> None

     

       121
       121
       -
             in

     

       122
       122
       -
             match_parts template_parts uri_parts []

     

       123
       123
       -
       

     

       124
       124
       -
         (* Find a matching resource or template for a URI *)

     

       125
       125
       -
         let find_match server uri =

     

       126
       126
       -
           (* Try direct resource match first *)

     

       127
       127
       -
           match

     

       128
       128
       -
             List.find_opt

     

       129
       129
       -
               (fun resource -> resource.Resource.uri = uri)

     

       130
       130
       -
               (resources server)

     

       131
       131
       -
           with

     

       132
       132
       -
           | Some resource -> DirectResource (resource, [])

     

       133
       133
       -
           | None ->

     

       134
       134
       -
               (* Try template match next *)

     

       135
       135
       -
               let templates = resource_templates server in

     

       4
       4
       +
       (* MCP Server module for handling JSON-RPC communication *)

     

       136
       5
        
       

     

       137
       137
       -
               (* Try each template to see if it matches *)

     

       138
       138
       -
               let rec try_templates templates =

     

       139
       139
       -
                 match templates with

     

       140
       140
       -
                 | [] -> NoMatch

     

       141
       141
       -
                 | template :: rest -> (

     

       142
       142
       -
                     match

     

       143
       143
       -
                       extract_template_vars template.ResourceTemplate.uri_template uri

     

       144
       144
       -
                     with

     

       145
       145
       -
                     | Some params -> TemplateResource (template, params)

     

       146
       146
       -
                     | None -> try_templates rest)

     

       147
       147
       -
               in

     

       148
       148
       -
               try_templates templates

     

       149
       149
       -
       end

     

       150
       150
       -
       

     

       151
       151
       -
       (* Process resources/read request *)

     

       152
       152
       -
       let handle_resources_read server (req : JSONRPCMessage.request) =

     

       153
       153
       -
         Log.debug (fun m -> m "Processing resources/read request");

     

       154
       154
       -
         match req.JSONRPCMessage.params with

     

       155
       155
       -
         | None ->

     

       156
       156
       -
             Log.err (fun m -> m "Missing params for resources/read request");

     

       157
       157
       -
             Some

     

       158
       158
       -
               (create_jsonrpc_error req.id ErrorCode.InvalidParams

     

       159
       159
       -
                  "Missing params for resources/read request" ())

     

       160
       160
       -
         | Some params -> (

     

       161
       161
       -
             let req_data = Mcp_rpc.ResourcesRead.Request.t_of_yojson params in

     

       162
       162
       -
             let uri = req_data.uri in

     

       163
       163
       -
             Log.debug (fun m -> m "Resource URI: %s" uri);

     

       164
       164
       -
       

     

       165
       165
       -
             (* Find matching resource or template *)

     

       166
       166
       -
             match Resource_matcher.find_match server uri with

     

       167
       167
       -
             | Resource_matcher.DirectResource (resource, params) -> (

     

       168
       168
       -
                 (* Create context for this request *)

     

       169
       169
       -
                 let ctx =

     

       170
       170
       -
                   Context.create ?request_id:(Some req.id)

     

       171
       171
       -
                     ?progress_token:req.progress_token

     

       172
       172
       -
                     ~lifespan_context:

     

       173
       173
       -
                       [ ("resources/read", `Assoc [ ("uri", `String uri) ]) ]

     

       174
       174
       -
                     ()

     

       175
       175
       -
                 in

     

       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 *)

     

       176
       10
        
       

     

       177
       177
       -
                 Log.debug (fun m -> m "Handling direct resource: %s" resource.name);

     

       11
       11
       +
       type t = {

     

       12
       12
       +
         server: Mcp_sdk.server;

     

       13
       13
       +
         transport: transport_type;

     

       14
       14
       +
         mutable running: bool;

     

       15
       15
       +
       }

     

       178
       16
        
       

     

       179
       179
       -
                 (* Call the resource handler *)

     

       180
       180
       -
                 match resource.handler ctx params with

     

       181
       181
       -
                 | Ok content ->

     

       182
       182
       -
                     (* Create text resource content *)

     

       183
       183
       -
                     let mime_type =

     

       184
       184
       -
                       match resource.mime_type with

     

       185
       185
       -
                       | Some mime -> mime

     

       186
       186
       -
                       | None -> "text/plain"

     

       187
       187
       -
                     in

     

       188
       188
       -
                     let text_resource =

     

       189
       189
       -
                       {

     

       190
       190
       -
                         TextResourceContents.uri;

     

       191
       191
       -
                         text = content;

     

       192
       192
       -
                         mime_type = Some mime_type;

     

       193
       193
       -
                       }

     

       194
       194
       -
                     in

     

       195
       195
       -
                     let resource_content =

     

       196
       196
       -
                       Mcp_rpc.ResourcesRead.ResourceContent.TextResource text_resource

     

       197
       197
       -
                     in

     

       198
       198
       -
                     let response =

     

       199
       199
       -
                       Mcp_rpc.ResourcesRead.create_response ~id:req.id

     

       200
       200
       -
                         ~contents:[ resource_content ] ()

     

       201
       201
       -
                     in

     

       202
       202
       -
                     Some response

     

       203
       203
       -
                 | Error err ->

     

       204
       204
       -
                     Log.err (fun m -> m "Error reading resource: %s" err);

     

       205
       205
       -
                     Some

     

       206
       206
       -
                       (create_jsonrpc_error req.id ErrorCode.InternalError

     

       207
       207
       -
                          ("Error reading resource: " ^ err)

     

       208
       208
       -
                          ()))

     

       209
       209
       -
             | Resource_matcher.TemplateResource (template, params) -> (

     

       210
       210
       -
                 (* Create context for this request *)

     

       211
       211
       -
                 let ctx =

     

       212
       212
       -
                   Context.create ?request_id:(Some req.id)

     

       213
       213
       -
                     ?progress_token:req.progress_token

     

       214
       214
       -
                     ~lifespan_context:

     

       215
       215
       -
                       [ ("resources/read", `Assoc [ ("uri", `String uri) ]) ]

     

       216
       216
       -
                     ()

     

       217
       217
       -
                 in

     

       218
       218
       -
       

     

       219
       219
       -
                 Log.debug (fun m ->

     

       220
       220
       -
                     m "Handling resource template: %s with params: [%s]" template.name

     

       221
       221
       -
                       (String.concat ", " params));

     

       222
       222
       -
       

     

       223
       223
       -
                 (* Call the template handler *)

     

       224
       224
       -
                 match template.handler ctx params with

     

       225
       225
       -
                 | Ok content ->

     

       226
       226
       -
                     (* Create text resource content *)

     

       227
       227
       -
                     let mime_type =

     

       228
       228
       -
                       match template.mime_type with

     

       229
       229
       -
                       | Some mime -> mime

     

       230
       230
       -
                       | None -> "text/plain"

     

       231
       231
       -
                     in

     

       232
       232
       -
                     let text_resource =

     

       233
       233
       -
                       {

     

       234
       234
       -
                         TextResourceContents.uri;

     

       235
       235
       -
                         text = content;

     

       236
       236
       -
                         mime_type = Some mime_type;

     

       237
       237
       -
                       }

     

       238
       238
       -
                     in

     

       239
       239
       -
                     let resource_content =

     

       240
       240
       -
                       Mcp_rpc.ResourcesRead.ResourceContent.TextResource text_resource

     

       241
       241
       -
                     in

     

       242
       242
       -
                     let response =

     

       243
       243
       -
                       Mcp_rpc.ResourcesRead.create_response ~id:req.id

     

       244
       244
       -
                         ~contents:[ resource_content ] ()

     

       245
       245
       -
                     in

     

       246
       246
       -
                     Some response

     

       247
       247
       -
                 | Error err ->

     

       248
       248
       -
                     Log.err (fun m -> m "Error reading resource template: %s" err);

     

       249
       249
       -
                     Some

     

       250
       250
       -
                       (create_jsonrpc_error req.id ErrorCode.InternalError

     

       251
       251
       -
                          ("Error reading resource template: " ^ err)

     

       252
       252
       -
                          ()))

     

       253
       253
       -
             | Resource_matcher.NoMatch ->

     

       254
       254
       -
                 Log.err (fun m -> m "Resource not found: %s" uri);

     

       255
       255
       -
                 Some

     

       256
       256
       -
                   (create_jsonrpc_error req.id ErrorCode.InvalidParams

     

       257
       257
       -
                      ("Resource not found: " ^ uri)

     

       258
       258
       -
                      ()))

     

       259
       259
       -
       

     

       260
       260
       -
       (* Extract the tool name from params *)

     

       261
       261
       -
       let extract_tool_name params =

     

       262
       262
       -
         match List.assoc_opt "name" params with

     

       263
       263
       -
         | Some (`String name) ->

     

       264
       264
       -
             Log.debug (fun m -> m "Tool name: %s" name);

     

       265
       265
       -
             Some name

     

       266
       266
       -
         | _ ->

     

       267
       267
       -
             Log.err (fun m -> m "Missing or invalid 'name' parameter in tool call");

     

       268
       268
       -
             None

     

       269
       269
       -
       

     

       270
       270
       -
       (* Extract the tool arguments from params *)

     

       271
       271
       -
       let extract_tool_arguments params =

     

       272
       272
       -
         match List.assoc_opt "arguments" params with

     

       273
       273
       -
         | Some args ->

     

       274
       274
       -
             Log.debug (fun m -> m "Tool arguments: %s" (Yojson.Safe.to_string args));

     

       275
       275
       -
             args

     

       276
       276
       -
         | _ ->

     

       277
       277
       -
             Log.debug (fun m ->

     

       278
       278
       -
                 m "No arguments provided for tool call, using empty object");

     

       279
       279
       -
             `Assoc [] (* Empty arguments is valid *)

     

       280
       280
       -
       

     

       281
       281
       -
       (* Execute a tool *)

     

       282
       282
       -
       let execute_tool server ctx name args =

     

       283
       283
       -
         try

     

       284
       284
       -
           let tool = List.find (fun t -> t.Tool.name = name) (tools server) in

     

       285
       285
       -
           Log.debug (fun m -> m "Found tool: %s" name);

     

       286
       286
       -
       

     

       287
       287
       -
           (* Call the tool handler *)

     

       288
       288
       -
           match tool.handler ctx args with

     

       289
       289
       -
           | Ok result ->

     

       290
       290
       -
               Log.debug (fun m -> m "Tool execution succeeded");

     

       291
       291
       -
               result

     

       292
       292
       -
           | Error err -> Tool.handle_execution_error err

     

       293
       293
       -
         with

     

       294
       294
       -
         | Not_found -> Tool.handle_unknown_tool_error name

     

       295
       295
       -
         | exn -> Tool.handle_execution_exception exn

     

       296
       296
       -
       

     

       297
       297
       -
       (* Convert JSON tool result to RPC content format *)

     

       298
       298
       -
       let json_to_rpc_content json =

     

       299
       299
       -
         match json with

     

       300
       300
       -
         | `Assoc fields -> (

     

       301
       301
       -
             match

     

       302
       302
       -
               (List.assoc_opt "content" fields, List.assoc_opt "isError" fields)

     

       303
       303
       -
             with

     

       304
       304
       -
             | Some (`List content_items), Some (`Bool is_error) ->

     

       305
       305
       -
                 let mcp_content = List.map Mcp.content_of_yojson content_items in

     

       306
       306
       -
                 let rpc_content = Tool.mcp_content_to_rpc_content mcp_content in

     

       307
       307
       -
                 (rpc_content, is_error)

     

       308
       308
       -
             | _ ->

     

       309
       309
       -
                 (* Fallback for compatibility with older formats *)

     

       310
       310
       -
                 let text = Yojson.Safe.to_string json in

     

       311
       311
       -
                 let text_content = { TextContent.text; annotations = None } in

     

       312
       312
       -
                 ([ Mcp_rpc.ToolsCall.ToolContent.Text text_content ], false))

     

       313
       313
       -
         | _ ->

     

       314
       314
       -
             (* Simple fallback for non-object results *)

     

       315
       315
       -
             let text = Yojson.Safe.to_string json in

     

       316
       316
       -
             let text_content = { TextContent.text; annotations = None } in

     

       317
       317
       -
             ([ Mcp_rpc.ToolsCall.ToolContent.Text text_content ], false)

     

       318
       318
       -
       

     

       319
       319
       -
       (* Process tools/call request *)

     

       320
       320
       -
       let handle_tools_call server req =

     

       321
       321
       -
         Log.debug (fun m -> m "Processing tools/call request");

     

       322
       322
       -
         match req.JSONRPCMessage.params with

     

       323
       323
       -
         | Some (`Assoc params) -> (

     

       324
       324
       -
             match extract_tool_name params with

     

       325
       325
       -
             | Some name ->

     

       326
       326
       -
                 let args = extract_tool_arguments params in

     

       327
       327
       -
       

     

       328
       328
       -
                 (* Create context for this request *)

     

       329
       329
       -
                 let ctx =

     

       330
       330
       -
                   Context.create ?request_id:(Some req.id)

     

       331
       331
       -
                     ?progress_token:req.progress_token

     

       332
       332
       -
                     ~lifespan_context:[ ("tools/call", `Assoc params) ]

     

       333
       333
       -
                     ()

     

       334
       334
       -
                 in

     

       335
       335
       -
       

     

       336
       336
       -
                 (* Execute the tool *)

     

       337
       337
       -
                 let result_json = execute_tool server ctx name args in

     

       338
       338
       -
       

     

       339
       339
       -
                 (* Convert JSON result to RPC format *)

     

       340
       340
       -
                 let content, is_error = json_to_rpc_content result_json in

     

       341
       341
       -
       

     

       342
       342
       -
                 (* Create the RPC response *)

     

       343
       343
       -
                 let response =

     

       344
       344
       -
                   Mcp_rpc.ToolsCall.create_response ~id:req.id ~content ~is_error ()

     

       345
       345
       -
                 in

     

       346
       346
       -
       

     

       347
       347
       -
                 Some response

     

       348
       348
       -
             | None ->

     

       349
       349
       -
                 Some

     

       350
       350
       -
                   (create_jsonrpc_error req.id InvalidParams

     

       351
       351
       -
                      "Missing tool name parameter" ()))

     

       352
       352
       -
         | _ ->

     

       353
       353
       -
             Log.err (fun m -> m "Invalid params format for tools/call");

     

       354
       354
       -
             Some

     

       355
       355
       -
               (create_jsonrpc_error req.id InvalidParams

     

       356
       356
       -
                  "Invalid params format for tools/call" ())

     

       357
       357
       -
       

     

       358
       358
       -
       (* Process ping request *)

     

       359
       359
       -
       let handle_ping (req : JSONRPCMessage.request) =

     

       360
       360
       -
         Log.debug (fun m -> m "Processing ping request");

     

       361
       361
       -
         Some (create_response ~id:req.JSONRPCMessage.id ~result:(`Assoc []))

     

       362
       362
       -
       

     

       363
       363
       -
       (* Handle notifications/initialized *)

     

       364
       364
       -
       let handle_initialized (notif : JSONRPCMessage.notification) =

     

       365
       365
       -
         Log.debug (fun m ->

     

       366
       366
       -
             m

     

       367
       367
       -
               "Client initialization complete - Server is now ready to receive \

     

       368
       368
       -
                requests\n\

     

       369
       369
       -
               \ Notification params: %s"

     

       370
       370
       -
               (match notif.JSONRPCMessage.params with

     

       371
       371
       -
               | Some p -> Yojson.Safe.to_string p

     

       372
       372
       -
               | None -> "null"));

     

       373
       373
       -
         None

     

       374
       374
       -
       

     

       375
       375
       -
       (* Process a single message using the MCP SDK *)

     

       17
       17
       +
       (** Process a single message *)

     

       376
       18
        
       let process_message server message =

     

       377
       19
        
         try

     

       378
       378
       -
           Log.debug (fun m ->

     

       379
       379
       -
               m "Processing message: %s" (Yojson.Safe.to_string message));

     

       20
       20
       +
           Log.debug "Parsing message as JSONRPC message...";

     

       380
       21
        
           match JSONRPCMessage.t_of_yojson message with

     

       381
       381
       -
           | JSONRPCMessage.Request req -> (

     

       382
       382
       -
               Log.debug (fun m ->

     

       383
       383
       -
                   m "Received request with method: %s" (Method.to_string req.meth));

     

       384
       384
       -
               match req.meth with

     

       385
       385
       -
               | Method.Initialize -> handle_initialize server req

     

       386
       386
       -
               | Method.ToolsList -> handle_tools_list server req

     

       387
       387
       -
               | Method.ToolsCall -> handle_tools_call server req

     

       388
       388
       -
               | Method.PromptsList -> handle_prompts_list server req

     

       389
       389
       -
               | Method.ResourcesList -> handle_resources_list server req

     

       390
       390
       -
               | Method.ResourcesRead -> handle_resources_read server req

     

       391
       391
       -
               | Method.ResourceTemplatesList ->

     

       392
       392
       -
                   handle_resource_templates_list server req

     

       393
       393
       -
               | _ ->

     

       394
       394
       -
                   Log.err (fun m ->

     

       395
       395
       -
                       m "Unknown method received: %s" (Method.to_string req.meth));

     

       396
       396
       -
                   Some

     

       397
       397
       -
                     (create_jsonrpc_error req.id ErrorCode.MethodNotFound

     

       398
       398
       -
                        ("Method not found: " ^ Method.to_string req.meth)

     

       399
       399
       -
                        ()))

     

       400
       400
       -
           | JSONRPCMessage.Notification notif -> (

     

       401
       401
       -
               Log.debug (fun m ->

     

       402
       402
       -
                   m "Received notification with method: %s"

     

       403
       403
       -
                     (Method.to_string notif.meth));

     

       404
       404
       -
               match notif.meth with

     

       405
       405
       -
               | Method.Initialized -> handle_initialized notif

     

       406
       406
       -
               | _ ->

     

       407
       407
       -
                   Log.debug (fun m ->

     

       408
       408
       -
                       m "Ignoring notification: %s" (Method.to_string notif.meth));

     

       409
       409
       -
                   None)

     

       410
       410
       -
           | JSONRPCMessage.Response _ ->

     

       411
       411
       -
               Log.err (fun m -> m "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";

     

       412
       297
        
               None

     

       413
       413
       -
           | JSONRPCMessage.Error _ ->

     

       414
       414
       -
               Log.err (fun m -> m "Unexpected error message received");

     

       298
       298
       +
             end

     

       299
       299
       +
             

     

       300
       300
       +
           | JSONRPCMessage.Error _ -> begin

     

       301
       301
       +
               Log.error "Unexpected error message received";

     

       415
       302
        
               None

     

       303
       303
       +
             end

     

       416
       304
        
         with

     

       417
       417
       -
         | Json.Of_json (msg, _) ->

     

       418
       418
       -
             Log.err (fun m -> m "JSON error: %s" msg);

     

       419
       419
       -
             (* Can't respond with error because we don't have a request ID *)

     

       305
       305
       +
         | Failure msg -> begin

     

       306
       306
       +
             Log.error (Printf.sprintf "JSON error in message processing: %s" msg);

     

       420
       307
        
             None

     

       421
       421
       -
         | Yojson.Json_error msg ->

     

       422
       422
       -
             Log.err (fun m -> m "JSON parse error: %s" msg);

     

       423
       423
       -
             (* Can't respond with error because we don't have a request ID *)

     

       424
       424
       -
             None

     

       425
       425
       -
         | exc ->

     

       426
       426
       -
             Log.err (fun m ->

     

       427
       427
       -
                 m

     

       428
       428
       -
                   "Exception during message processing: %s\n\

     

       429
       429
       -
                    Backtrace: %s\n\

     

       430
       430
       -
                    Message was: %s"

     

       431
       431
       -
                   (Printexc.to_string exc)

     

       432
       432
       -
                   (Printexc.get_backtrace ())

     

       433
       433
       -
                   (Yojson.Safe.to_string message));

     

       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()));

     

       434
       312
        
             None

     

       313
       313
       +
           end

     

       435
       314
        
       

     

       436
       436
       -
       (* Extract a request ID from a potentially malformed message *)

     

       437
       437
       -
       let extract_request_id json =

     

       315
       315
       +
       (** Read a single message from stdin *)

     

       316
       316
       +
       let read_stdio_message () =

     

       438
       317
        
         try

     

       439
       439
       -
           match json with

     

       440
       440
       -
           | `Assoc fields -> (

     

       441
       441
       -
               match List.assoc_opt "id" fields with

     

       442
       442
       -
               | Some (`Int id) -> Some (`Int id)

     

       443
       443
       -
               | Some (`String id) -> Some (`String id)

     

       444
       444
       -
               | _ -> None)

     

       445
       445
       -
           | _ -> None

     

       446
       446
       -
         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

     

       447
       349
        
       

     

       448
       448
       -
       (* Handle processing for an input line *)

     

       449
       449
       -
       let process_input_line server line =

     

       450
       450
       -
         if line = "" then (

     

       451
       451
       -
           Log.debug (fun m -> m "Empty line received, ignoring");

     

       452
       452
       -
           None)

     

       453
       453
       -
         else (

     

       454
       454
       -
           Log.debug (fun m -> m "Raw input: %s" line);

     

       455
       455
       -
           try

     

       456
       456
       -
             let json = Yojson.Safe.from_string line in

     

       457
       457
       -
             Log.debug (fun m -> m "Successfully parsed JSON");

     

       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

     

       423
       423
       +
           end

     

       458
       424
        
       

     

       459
       459
       -
             (* Process the message *)

     

       460
       460
       -
             process_message server json

     

       461
       461
       -
           with Yojson.Json_error msg ->

     

       462
       462
       -
             Log.err (fun m -> m "Error parsing JSON: %s" msg);

     

       463
       463
       -
             Log.err (fun m -> m "Input was: %s" line);

     

       464
       464
       -
             None)

     

       425
       425
       +
       (** Create an MCP server *)

     

       426
       426
       +
       let create ~server ~transport () =

     

       427
       427
       +
         { server; transport; running = false }

     

       465
       428
        
       

     

       466
       466
       -
       (* Send a response to the client *)

     

       467
       467
       -
       let send_response stdout response =

     

       468
       468
       -
         let response_json = JSONRPCMessage.yojson_of_t response in

     

       469
       469
       -
         let response_str = Yojson.Safe.to_string response_json in

     

       470
       470
       -
         Log.debug (fun m -> m "Sending response: %s" response_str);

     

       471
       471
       -
       

     

       472
       472
       -
         (* Write the response followed by a newline *)

     

       473
       473
       -
         Eio.Flow.copy_string response_str stdout;

     

       474
       474
       -
         Eio.Flow.copy_string "\n" stdout

     

       475
       475
       -
       

     

       476
       476
       -
       (* Run the MCP server with the given server configuration *)

     

       477
       477
       -
       let callback mcp_server _conn (request : Http.Request.t) body =

     

       478
       478
       -
         match request.meth with

     

       479
       479
       -
         | `POST -> (

     

       480
       480
       -
             Log.debug (fun m -> m "Received POST request");

     

       481
       481
       -
             let request_body_str =

     

       482
       482
       -
               Eio.Buf_read.(parse_exn take_all) body ~max_size:max_int

     

       483
       483
       -
             in

     

       484
       484
       -
             match process_input_line mcp_server request_body_str with

     

       485
       485
       -
             | Some mcp_response ->

     

       486
       486
       -
                 let response_json = JSONRPCMessage.yojson_of_t mcp_response in

     

       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";

     

       433
       433
       +
         

     

       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

     

       487
       455
        
                 let response_str = Yojson.Safe.to_string response_json in

     

       488
       488
       -
                 Log.debug (fun m -> m "Sending MCP response: %s" response_str);

     

       489
       489
       -
                 let headers =

     

       490
       490
       -
                   Http.Header.of_list [ ("Content-Type", "application/json") ]

     

       491
       491
       -
                 in

     

       492
       492
       -
                 Cohttp_eio.Server.respond ~status:`OK ~headers

     

       493
       493
       -
                   ~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")

     

       494
       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
       +
                   ())

     

       495
       467
        
             | None ->

     

       496
       496
       -
                 Log.debug (fun m -> m "No MCP response needed");

     

       497
       497
       -
                 Cohttp_eio.Server.respond ~status:`No_content

     

       498
       498
       -
                   ~body:(Cohttp_eio.Body.of_string "")

     

       499
       499
       -
                   ())

     

       500
       500
       -
         | _ ->

     

       501
       501
       -
             Log.info (fun m ->

     

       502
       502
       -
                 m "Unsupported method: %s" (Http.Method.to_string request.meth));

     

       503
       503
       -
             Cohttp_eio.Server.respond ~status:`Method_not_allowed

     

       504
       504
       -
               ~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"

     

       505
       478
        
               ()

     

       506
       506
       -
       

     

       507
       507
       -
       let log_warning ex = Logs.warn (fun f -> f "%a" Eio.Exn.pp ex)

     

       508
       508
       -
       

     

       509
       509
       -
       (** run the server using http transport *)

     

       510
       510
       -
       let run_server ?(port = 8080) ?(on_error = log_warning) env server =

     

       511
       511
       -
         let net = Eio.Stdenv.net env in

     

       512
       512
       -
         let addr = `Tcp (Eio.Net.Ipaddr.V4.loopback, port) in

     

       513
       513
       -
       

     

       514
       514
       -
         Log.info (fun m ->

     

       515
       515
       -
             m "Starting http MCP server: %s v%s\nProtocol version: %s" (name server)

     

       516
       516
       -
               (version server) (protocol_version server));

     

       517
       517
       -
       

     

       518
       518
       -
         Eio.Switch.run @@ fun sw ->

     

       519
       519
       -
         let server_spec = Cohttp_eio.Server.make ~callback:(callback server) () in

     

       520
       520
       -
       

     

       521
       521
       -
         let server_socket =

     

       522
       522
       -
           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 ())

     

       523
       485
        
         in

     

       524
       524
       -
         Log.info (fun m -> m "MCP HTTP Server listening on http://localhost:%d" port);

     

       525
       525
       -
       

     

       526
       526
       -
         Cohttp_eio.Server.run server_socket server_spec ~on_error

     

       527
       527
       -
       

     

       528
       528
       -
       (** run the server using the stdio transport *)

     

       529
       529
       -
       let run_stdio_server env server =

     

       530
       530
       -
         let stdin = Eio.Stdenv.stdin env in

     

       531
       531
       -
         let stdout = Eio.Stdenv.stdout env in

     

       532
       532
       -
       

     

       533
       533
       -
         Log.info (fun m ->

     

       534
       534
       -
             m "Starting stdio MCP server: %s v%s\nProtocol version: %s" (name server)

     

       535
       535
       -
               (version server) (protocol_version server));

     

       536
       536
       -
       

     

       537
       537
       -
         (* Enable exception backtraces *)

     

       538
       538
       -
         Printexc.record_backtrace true;

     

       539
       539
       -
       

     

       540
       540
       -
         let buf = Eio.Buf_read.of_flow stdin ~initial_size:100 ~max_size:1_000_000 in

     

       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

     

       541
       495
        
       

     

       542
       542
       -
         (* Main processing loop *)

     

       543
       543
       -
         try

     

       544
       544
       -
           while true do

     

       545
       545
       -
             Log.info (fun m -> m "Waiting for message...");

     

       546
       546
       -
             let line = Eio.Buf_read.line buf in

     

       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);

     

       504
       504
       +
         

     

       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
       +
         )));

     

       510
       510
       +
         

     

       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);

     

       516
       516
       +
             

     

       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

     

       547
       524
        
       

     

       548
       548
       -
             (* Process the input and send response if needed *)

     

       549
       549
       -
             match process_input_line server line with

     

       550
       550
       -
             | Some response -> send_response stdout response

     

       551
       551
       -
             | None -> Log.info (fun m -> m "No response needed for this message")

     

       552
       552
       -
           done

     

       553
       553
       -
         with

     

       554
       554
       -
         | End_of_file ->

     

       555
       555
       -
             Log.debug (fun m -> m "End of file received on stdin");

     

       556
       556
       -
             ()

     

       557
       557
       -
         | Eio.Exn.Io _ as exn ->

     

       558
       558
       -
             (* Only a warning since on Windows, once the client closes the connection, we normally fail with `I/O error while reading: Eio.Io Net Connection_reset Unix_error (Broken pipe, "stub_cstruct_read", "")` *)

     

       559
       559
       -
             Log.warn (fun m ->

     

       560
       560
       -
                 m "I/O error while reading: %s" (Printexc.to_string exn));

     

       561
       561
       -
             ()

     

       562
       562
       -
         | exn ->

     

       563
       563
       -
             Log.err (fun m ->

     

       564
       564
       -
                 m "Exception while reading: %s" (Printexc.to_string exn));

     

       565
       565
       -
             ()

     

       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
       -
         "http"

     

       13
       13
       -
         "cohttp-eio"

     

       14
       14
       -
         "eio_main"

     

       15
       15
       -
         "eio"

     

       16
       16
       -
         "logs"

     

       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