Model Context Protocol in OCaml
anil.recoil.org
1open Mcp
2open Mcp_sdk
3open Mcp_server
4
5(* Multimodal example MCP server *)
6
7(* Base64 encoding helper *)
8module Base64 = struct
9 let encode_char n =
10 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/".[n]
11
12 let encode_block i bytes =
13 let buffer = Buffer.create 4 in
14 let b1 = Char.code (String.get bytes (i * 3)) in
15 let b2 = if i * 3 + 1 < String.length bytes then Char.code (String.get bytes (i * 3 + 1)) else 0 in
16 let b3 = if i * 3 + 2 < String.length bytes then Char.code (String.get bytes (i * 3 + 2)) else 0 in
17
18 let n = (b1 lsl 16) lor (b2 lsl 8) lor b3 in
19 Buffer.add_char buffer (encode_char ((n lsr 18) land 63));
20 Buffer.add_char buffer (encode_char ((n lsr 12) land 63));
21
22 if i * 3 + 1 < String.length bytes then
23 Buffer.add_char buffer (encode_char ((n lsr 6) land 63))
24 else
25 Buffer.add_char buffer '=';
26
27 if i * 3 + 2 < String.length bytes then
28 Buffer.add_char buffer (encode_char (n land 63))
29 else
30 Buffer.add_char buffer '=';
31
32 Buffer.contents buffer
33
34 let encode data =
35 let buffer = Buffer.create (4 * (String.length data + 2) / 3) in
36 for i = 0 to (String.length data - 1) / 3 do
37 Buffer.add_string buffer (encode_block i data)
38 done;
39 Buffer.contents buffer
40end
41
42(* Audio generator *)
43module AudioGenerator = struct
44 (* Generate a simple sine wave *)
45 let generate_sine_wave ~frequency ~duration ~sample_rate ~amplitude =
46 (* WAV parameters *)
47 let num_channels = 1 in (* Mono *)
48 let bits_per_sample = 16 in
49 let byte_rate = sample_rate * num_channels * bits_per_sample / 8 in
50 let block_align = num_channels * bits_per_sample / 8 in
51 let num_samples = int_of_float (float_of_int sample_rate *. duration) in
52 let data_size = num_samples * block_align in
53
54 (* Create buffer for the WAV data *)
55 let buffer = Buffer.create (44 + data_size) in
56
57 (* Write WAV header *)
58 (* "RIFF" chunk *)
59 Buffer.add_string buffer "RIFF";
60 let file_size = 36 + data_size in
61 Buffer.add_char buffer (Char.chr (file_size land 0xff));
62 Buffer.add_char buffer (Char.chr ((file_size lsr 8) land 0xff));
63 Buffer.add_char buffer (Char.chr ((file_size lsr 16) land 0xff));
64 Buffer.add_char buffer (Char.chr ((file_size lsr 24) land 0xff));
65 Buffer.add_string buffer "WAVE";
66
67 (* "fmt " sub-chunk *)
68 Buffer.add_string buffer "fmt ";
69 Buffer.add_char buffer (Char.chr 16); (* Sub-chunk size (16 for PCM) *)
70 Buffer.add_char buffer (Char.chr 0);
71 Buffer.add_char buffer (Char.chr 0);
72 Buffer.add_char buffer (Char.chr 0);
73 Buffer.add_char buffer (Char.chr 1); (* Audio format (1 for PCM) *)
74 Buffer.add_char buffer (Char.chr 0);
75 Buffer.add_char buffer (Char.chr num_channels); (* Number of channels *)
76 Buffer.add_char buffer (Char.chr 0);
77
78 (* Sample rate *)
79 Buffer.add_char buffer (Char.chr (sample_rate land 0xff));
80 Buffer.add_char buffer (Char.chr ((sample_rate lsr 8) land 0xff));
81 Buffer.add_char buffer (Char.chr ((sample_rate lsr 16) land 0xff));
82 Buffer.add_char buffer (Char.chr ((sample_rate lsr 24) land 0xff));
83
84 (* Byte rate *)
85 Buffer.add_char buffer (Char.chr (byte_rate land 0xff));
86 Buffer.add_char buffer (Char.chr ((byte_rate lsr 8) land 0xff));
87 Buffer.add_char buffer (Char.chr ((byte_rate lsr 16) land 0xff));
88 Buffer.add_char buffer (Char.chr ((byte_rate lsr 24) land 0xff));
89
90 (* Block align *)
91 Buffer.add_char buffer (Char.chr block_align);
92 Buffer.add_char buffer (Char.chr 0);
93
94 (* Bits per sample *)
95 Buffer.add_char buffer (Char.chr bits_per_sample);
96 Buffer.add_char buffer (Char.chr 0);
97
98 (* "data" sub-chunk *)
99 Buffer.add_string buffer "data";
100 Buffer.add_char buffer (Char.chr (data_size land 0xff));
101 Buffer.add_char buffer (Char.chr ((data_size lsr 8) land 0xff));
102 Buffer.add_char buffer (Char.chr ((data_size lsr 16) land 0xff));
103 Buffer.add_char buffer (Char.chr ((data_size lsr 24) land 0xff));
104
105 (* Generate sine wave data *)
106 let max_amplitude = float_of_int (1 lsl (bits_per_sample - 1)) -. 1.0 in
107 for i = 0 to num_samples - 1 do
108 let t = float_of_int i /. float_of_int sample_rate in
109 let value = int_of_float (amplitude *. max_amplitude *. sin (2.0 *. Float.pi *. frequency *. t)) in
110 (* Write 16-bit sample (little-endian) *)
111 Buffer.add_char buffer (Char.chr (value land 0xff));
112 Buffer.add_char buffer (Char.chr ((value lsr 8) land 0xff));
113 done;
114
115 Buffer.contents buffer
116end
117
118(* Image generator *)
119module ImageGenerator = struct
120 (* Simple PNG generation *)
121 let generate_simple_image width height color_str =
122 (* Parse color - expected format: #RRGGBB or #RRGGBBAA *)
123 let r, g, b, a =
124 try
125 if String.length color_str >= 7 && color_str.[0] = '#' then
126 let r = int_of_string ("0x" ^ String.sub color_str 1 2) in
127 let g = int_of_string ("0x" ^ String.sub color_str 3 2) in
128 let b = int_of_string ("0x" ^ String.sub color_str 5 2) in
129 let a = if String.length color_str >= 9 then
130 int_of_string ("0x" ^ String.sub color_str 7 2)
131 else 255 in
132 (r, g, b, a)
133 else
134 (255, 0, 0, 255) (* Default to red if invalid *)
135 with _ ->
136 (255, 0, 0, 255) (* Default to red on parsing error *)
137 in
138
139 (* Create a very simple 1x1 PNG with the specified color *)
140 (* PNG signature *)
141 let signature = [137; 80; 78; 71; 13; 10; 26; 10] in
142
143 (* Create buffer for the PNG data *)
144 let buffer = Buffer.create 100 in
145
146 (* PNG signature *)
147 List.iter (fun b -> Buffer.add_char buffer (Char.chr b)) signature;
148
149 (* IHDR chunk *)
150 Buffer.add_char buffer (Char.chr 0); (* length - 13 bytes *)
151 Buffer.add_char buffer (Char.chr 0);
152 Buffer.add_char buffer (Char.chr 0);
153 Buffer.add_char buffer (Char.chr 13);
154
155 Buffer.add_string buffer "IHDR";
156
157 (* Width *)
158 Buffer.add_char buffer (Char.chr ((width lsr 24) land 0xff));
159 Buffer.add_char buffer (Char.chr ((width lsr 16) land 0xff));
160 Buffer.add_char buffer (Char.chr ((width lsr 8) land 0xff));
161 Buffer.add_char buffer (Char.chr (width land 0xff));
162
163 (* Height *)
164 Buffer.add_char buffer (Char.chr ((height lsr 24) land 0xff));
165 Buffer.add_char buffer (Char.chr ((height lsr 16) land 0xff));
166 Buffer.add_char buffer (Char.chr ((height lsr 8) land 0xff));
167 Buffer.add_char buffer (Char.chr (height land 0xff));
168
169 Buffer.add_char buffer (Char.chr 8); (* Bit depth - 8 bits per channel *)
170 Buffer.add_char buffer (Char.chr 6); (* Color type - RGBA *)
171 Buffer.add_char buffer (Char.chr 0); (* Compression method - deflate *)
172 Buffer.add_char buffer (Char.chr 0); (* Filter method - adaptive filtering *)
173 Buffer.add_char buffer (Char.chr 0); (* Interlace method - no interlace *)
174
175 (* IHDR CRC - precomputed for simplicity *)
176 Buffer.add_char buffer (Char.chr 0);
177 Buffer.add_char buffer (Char.chr 0);
178 Buffer.add_char buffer (Char.chr 0);
179 Buffer.add_char buffer (Char.chr 0);
180
181 (* IDAT chunk - simplified for example *)
182 let pixels_per_row = width * 4 in
183 let data_size = (1 + pixels_per_row) * height in
184
185 Buffer.add_char buffer (Char.chr ((data_size lsr 24) land 0xff));
186 Buffer.add_char buffer (Char.chr ((data_size lsr 16) land 0xff));
187 Buffer.add_char buffer (Char.chr ((data_size lsr 8) land 0xff));
188 Buffer.add_char buffer (Char.chr (data_size land 0xff));
189
190 Buffer.add_string buffer "IDAT";
191
192 (* Simple zlib header *)
193 Buffer.add_char buffer (Char.chr 0x78);
194 Buffer.add_char buffer (Char.chr 0x01);
195
196 (* Raw image data *)
197 for _ = 0 to height - 1 do
198 Buffer.add_char buffer (Char.chr 0); (* Filter type 0 - None *)
199 for _ = 0 to width - 1 do
200 Buffer.add_char buffer (Char.chr r);
201 Buffer.add_char buffer (Char.chr g);
202 Buffer.add_char buffer (Char.chr b);
203 Buffer.add_char buffer (Char.chr a);
204 done
205 done;
206
207 (* Dummy Adler32 checksum *)
208 Buffer.add_char buffer (Char.chr 0);
209 Buffer.add_char buffer (Char.chr 0);
210 Buffer.add_char buffer (Char.chr 0);
211 Buffer.add_char buffer (Char.chr 0);
212
213 (* IDAT CRC - precomputed for simplicity *)
214 Buffer.add_char buffer (Char.chr 0);
215 Buffer.add_char buffer (Char.chr 0);
216 Buffer.add_char buffer (Char.chr 0);
217 Buffer.add_char buffer (Char.chr 0);
218
219 (* IEND chunk *)
220 Buffer.add_char buffer (Char.chr 0);
221 Buffer.add_char buffer (Char.chr 0);
222 Buffer.add_char buffer (Char.chr 0);
223 Buffer.add_char buffer (Char.chr 0);
224
225 Buffer.add_string buffer "IEND";
226
227 (* IEND CRC - precomputed value *)
228 Buffer.add_char buffer (Char.chr 0xAE);
229 Buffer.add_char buffer (Char.chr 0x42);
230 Buffer.add_char buffer (Char.chr 0x60);
231 Buffer.add_char buffer (Char.chr 0x82);
232
233 Buffer.contents buffer
234end
235
236(* Helper for extracting values from JSON *)
237let get_param_int json name default =
238 match json with
239 | `Assoc fields -> begin
240 match List.assoc_opt name fields with
241 | Some (`Int i) -> begin
242 i
243 end
244 | Some (`Float f) -> begin
245 int_of_float f
246 end
247 | _ -> begin
248 default
249 end
250 end
251 | _ -> begin
252 default
253 end
254
255let get_param_float json name default =
256 match json with
257 | `Assoc fields -> begin
258 match List.assoc_opt name fields with
259 | Some (`Int i) -> begin
260 float_of_int i
261 end
262 | Some (`Float f) -> begin
263 f
264 end
265 | _ -> begin
266 default
267 end
268 end
269 | _ -> begin
270 default
271 end
272
273let get_param_string json name default =
274 match json with
275 | `Assoc fields -> begin
276 match List.assoc_opt name fields with
277 | Some (`String s) -> begin
278 s
279 end
280 | _ -> begin
281 default
282 end
283 end
284 | _ -> begin
285 default
286 end
287
288(* Create a server *)
289let server = create_server
290 ~name:"OCaml MCP Multimodal Example"
291 ~version:"0.1.0"
292 ~protocol_version:"2024-11-05"
293 ()
294
295(* Define startup and shutdown hooks *)
296let startup () =
297 Printf.fprintf stderr "MultimodalServer is starting up!\n";
298 flush stderr;
299 Log.info "MultimodalServer is starting up!"
300
301let shutdown () =
302 Printf.fprintf stderr "MultimodalServer is shutting down. Goodbye!\n";
303 flush stderr;
304 Log.info "MultimodalServer is shutting down. Goodbye!"
305
306(* Register the hooks *)
307let () =
308 set_startup_hook server startup;
309 set_shutdown_hook server shutdown
310
311(* Define and register a multimodal tool *)
312let _ = add_tool server
313 ~name:"generate_multimodal_response"
314 ~description:"Generates a response with text, image and audio content"
315 ~schema_properties:[
316 ("message", "string", "The text message to include");
317 ("color", "string", "Color for the image (hex format #RRGGBB)");
318 ("frequency", "integer", "Frequency for the audio tone in Hz");
319 ]
320 ~schema_required:["message"]
321 (fun args ->
322 try
323 let message = get_param_string args "message" "Hello, multimodal world!" in
324 let color = get_param_string args "color" "#FF0000" in
325 let frequency = get_param_int args "frequency" 440 in
326
327 (* Generate image *)
328 let image_data = ImageGenerator.generate_simple_image 100 100 color in
329 let image_base64 = Base64.encode image_data in
330
331 (* Generate audio *)
332 let audio_data = AudioGenerator.generate_sine_wave
333 ~frequency:(float_of_int frequency)
334 ~duration:1.0
335 ~sample_rate:8000
336 ~amplitude:0.8 in
337 let audio_base64 = Base64.encode audio_data in
338
339 (* Create a response with text, image and audio content *)
340 CallToolResult.yojson_of_t CallToolResult.{
341 content = [
342 Text TextContent.{
343 text = message;
344 annotations = None
345 };
346 Image ImageContent.{
347 data = image_base64;
348 mime_type = "image/png";
349 annotations = None
350 };
351 Audio AudioContent.{
352 data = audio_base64;
353 mime_type = "audio/wav";
354 annotations = None
355 }
356 ];
357 is_error = false;
358 meta = None
359 }
360 with
361 | Failure msg ->
362 Log.error (Printf.sprintf "Error in multimodal tool: %s" msg);
363 CallToolResult.yojson_of_t CallToolResult.{
364 content = [
365 Text TextContent.{
366 text = Printf.sprintf "Error: %s" msg;
367 annotations = None
368 }
369 ];
370 is_error = true;
371 meta = None
372 }
373 )
374
375(* Define and register a multimodal prompt *)
376let _ = add_prompt server
377 ~name:"multimodal-prompt"
378 ~description:"A prompt that includes text, image, and audio"
379 ~arguments:[
380 ("message", Some "Text message to include", true);
381 ("color", Some "Color for the image (hex format #RRGGBB)", false);
382 ("frequency", Some "Frequency for the audio tone in Hz", false);
383 ]
384 (fun args ->
385 (* Parse parameters with defaults *)
386 let message =
387 try List.assoc "message" args
388 with Not_found -> "Hello, multimodal world!"
389 in
390
391 let color =
392 try List.assoc "color" args
393 with Not_found -> "#0000FF"
394 in
395
396 let frequency =
397 try int_of_string (List.assoc "frequency" args)
398 with _ -> 440
399 in
400
401 (* Generate image *)
402 let image_data = ImageGenerator.generate_simple_image 100 100 color in
403 let image_base64 = Base64.encode image_data in
404
405 (* Generate audio *)
406 let audio_data = AudioGenerator.generate_sine_wave
407 ~frequency:(float_of_int frequency)
408 ~duration:1.0
409 ~sample_rate:8000
410 ~amplitude:0.8 in
411 let audio_base64 = Base64.encode audio_data in
412
413 (* Create a multimodal prompt *)
414 [
415 Prompt.{
416 role = `User;
417 content = make_text_content "Here's a multimodal message with text, image, and audio:"
418 };
419 Prompt.{
420 role = `User;
421 content = make_text_content message
422 };
423 Prompt.{
424 role = `User;
425 content = make_image_content image_base64 "image/png"
426 };
427 Prompt.{
428 role = `User;
429 content = make_audio_content audio_base64 "audio/wav"
430 };
431 Prompt.{
432 role = `Assistant;
433 content = make_text_content "I've received your multimodal message with text, image, and audio."
434 }
435 ]
436 )
437
438(* Also register a resource prompt example *)
439let _ = add_prompt server
440 ~name:"resource-prompt"
441 ~description:"A prompt that includes embedded resources"
442 ~arguments:[
443 ("resource_id", Some "ID of the resource to include", true);
444 ]
445 (fun args ->
446 (* Sample resource texts *)
447 let resources = [
448 ("doc1", "This is the content of document 1.");
449 ("doc2", "Document 2 contains important information about OCaml.");
450 ("doc3", "Document 3 explains the MCP protocol in detail.");
451 ] in
452
453 (* Get the requested resource *)
454 let resource_id =
455 try List.assoc "resource_id" args
456 with Not_found -> "doc1"
457 in
458
459 (* Find the resource content *)
460 let resource_content =
461 try List.assoc resource_id resources
462 with Not_found -> Printf.sprintf "Resource '%s' not found" resource_id
463 in
464
465 (* Create a prompt with embedded resource *)
466 [
467 Prompt.{
468 role = `User;
469 content = make_text_content (Printf.sprintf "Here's the content of resource %s:" resource_id)
470 };
471 Prompt.{
472 role = `User;
473 content = make_text_resource_content (Printf.sprintf "resource://%s" resource_id) resource_content ~mime_type:"text/plain" ()
474 };
475 Prompt.{
476 role = `User;
477 content = make_text_content "Please analyze this content."
478 };
479 Prompt.{
480 role = `Assistant;
481 content = make_text_content "I'll analyze the resource content for you."
482 }
483 ]
484 )
485
486(* Main function *)
487let () =
488 (* Parse command line arguments *)
489 let transport_type = ref Stdio in
490 let args = [
491 ("--http", Arg.Unit (fun () -> transport_type := Http),
492 "Start server with HTTP transport (default is stdio)");
493 ] in
494 let usage_msg = "Usage: multimodal_example [--http]" in
495 Arg.parse args (fun _ -> ()) usage_msg;
496
497 (* Configure the server with appropriate capabilities *)
498 let server = configure_server server ~with_tools:true ~with_resources:false ~with_prompts:true () in
499
500 (* Create and start MCP server with the selected transport *)
501 let mcp_server = create ~server ~transport:!transport_type () in
502 start mcp_server;