Model Context Protocol in OCaml
anil.recoil.org
1open Mcp_sdk
2
3(* Helper for extracting string value from JSON *)
4let get_string_param json name =
5 match json with
6 | `Assoc fields -> (
7 match List.assoc_opt name fields with
8 | Some (`String value) -> value
9 | _ ->
10 raise
11 (Failure (Printf.sprintf "Missing or invalid parameter: %s" name)))
12 | _ -> raise (Failure "Expected JSON object")
13
14(* Helper for extracting integer value from JSON *)
15let get_int_param json name =
16 match json with
17 | `Assoc fields -> (
18 match List.assoc_opt name fields with
19 | Some (`Int value) -> value
20 | Some (`String value) -> int_of_string value
21 | _ ->
22 raise
23 (Failure (Printf.sprintf "Missing or invalid parameter: %s" name)))
24 | _ -> raise (Failure "Expected JSON object")
25
26(* Base64 encoding - simplified version *)
27module Base64 = struct
28 let encode_char idx =
29 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/".[idx]
30
31 let encode s =
32 let len = String.length s in
33 let result = Bytes.create ((len + 2) / 3 * 4) in
34
35 let rec loop i j =
36 if i >= len then j
37 else
38 let n =
39 let n = Char.code s.[i] lsl 16 in
40 let n =
41 if i + 1 < len then n lor (Char.code s.[i + 1] lsl 8) else n
42 in
43 if i + 2 < len then n lor Char.code s.[i + 2] else n
44 in
45 Bytes.set result j (encode_char ((n lsr 18) land 63));
46 Bytes.set result (j + 1) (encode_char ((n lsr 12) land 63));
47 Bytes.set result (j + 2)
48 (if i + 1 < len then encode_char ((n lsr 6) land 63) else '=');
49 Bytes.set result (j + 3)
50 (if i + 2 < len then encode_char (n land 63) else '=');
51 loop (i + 3) (j + 4)
52 in
53 Bytes.sub_string result 0 (loop 0 0)
54end
55
56(* Generate a simple GIF format image *)
57let generate_random_image width height =
58 (* Ensure dimensions are reasonable *)
59 let width = min 256 (max 16 width) in
60 let height = min 256 (max 16 height) in
61
62 (* Create a buffer for GIF data *)
63 let buf = Buffer.create 1024 in
64
65 (* GIF Header - "GIF89a" *)
66 Buffer.add_string buf "GIF89a";
67
68 (* Logical Screen Descriptor *)
69 (* Width - 2 bytes little endian *)
70 Buffer.add_char buf (Char.chr (width land 0xff));
71 Buffer.add_char buf (Char.chr ((width lsr 8) land 0xff));
72
73 (* Height - 2 bytes little endian *)
74 Buffer.add_char buf (Char.chr (height land 0xff));
75 Buffer.add_char buf (Char.chr ((height lsr 8) land 0xff));
76
77 (* Packed fields - 1 byte:
78 Global Color Table Flag - 1 bit (1)
79 Color Resolution - 3 bits (7 = 8 bits per color)
80 Sort Flag - 1 bit (0)
81 Size of Global Color Table - 3 bits (2 = 8 colors) *)
82 Buffer.add_char buf (Char.chr 0xF2);
83
84 (* Background color index - 1 byte *)
85 Buffer.add_char buf (Char.chr 0);
86
87 (* Pixel aspect ratio - 1 byte *)
88 Buffer.add_char buf (Char.chr 0);
89
90 (* Global Color Table - 8 colors x 3 bytes (R,G,B) *)
91 (* Simple 8-color palette *)
92 Buffer.add_string buf "\xFF\xFF\xFF";
93 (* White (0) *)
94 Buffer.add_string buf "\xFF\x00\x00";
95 (* Red (1) *)
96 Buffer.add_string buf "\x00\xFF\x00";
97 (* Green (2) *)
98 Buffer.add_string buf "\x00\x00\xFF";
99 (* Blue (3) *)
100 Buffer.add_string buf "\xFF\xFF\x00";
101 (* Yellow (4) *)
102 Buffer.add_string buf "\xFF\x00\xFF";
103 (* Magenta (5) *)
104 Buffer.add_string buf "\x00\xFF\xFF";
105 (* Cyan (6) *)
106 Buffer.add_string buf "\x00\x00\x00";
107
108 (* Black (7) *)
109
110 (* Graphics Control Extension (optional) *)
111 Buffer.add_char buf (Char.chr 0x21);
112 (* Extension Introducer *)
113 Buffer.add_char buf (Char.chr 0xF9);
114 (* Graphic Control Label *)
115 Buffer.add_char buf (Char.chr 0x04);
116 (* Block Size *)
117 Buffer.add_char buf (Char.chr 0x01);
118 (* Packed field: 1 bit for transparency *)
119 Buffer.add_char buf (Char.chr 0x00);
120 (* Delay time (1/100s) - 2 bytes *)
121 Buffer.add_char buf (Char.chr 0x00);
122 Buffer.add_char buf (Char.chr 0x00);
123 (* Transparent color index *)
124 Buffer.add_char buf (Char.chr 0x00);
125
126 (* Block terminator *)
127
128 (* Image Descriptor *)
129 Buffer.add_char buf (Char.chr 0x2C);
130 (* Image Separator *)
131 Buffer.add_char buf (Char.chr 0x00);
132 (* Left position - 2 bytes *)
133 Buffer.add_char buf (Char.chr 0x00);
134 Buffer.add_char buf (Char.chr 0x00);
135 (* Top position - 2 bytes *)
136 Buffer.add_char buf (Char.chr 0x00);
137
138 (* Image width - 2 bytes little endian *)
139 Buffer.add_char buf (Char.chr (width land 0xff));
140 Buffer.add_char buf (Char.chr ((width lsr 8) land 0xff));
141
142 (* Image height - 2 bytes little endian *)
143 Buffer.add_char buf (Char.chr (height land 0xff));
144 Buffer.add_char buf (Char.chr ((height lsr 8) land 0xff));
145
146 (* Packed fields - 1 byte - no local color table *)
147 Buffer.add_char buf (Char.chr 0x00);
148
149 (* LZW Minimum Code Size - 1 byte *)
150 Buffer.add_char buf (Char.chr 0x03);
151
152 (* Minimum code size 3 for 8 colors *)
153
154 (* Generate a simple image - a checkerboard pattern *)
155 let step = width / 8 in
156 let image_data = Buffer.create (width * height / 4) in
157
158 (* Very simple LZW compression - just store raw clear codes and color indexes *)
159 (* Start with Clear code *)
160 Buffer.add_char image_data (Char.chr 0x08);
161
162 (* Clear code 8 *)
163
164 (* For very simple encoding, we'll just use a sequence of color indexes *)
165 for y = 0 to height - 1 do
166 for x = 0 to width - 1 do
167 (* Checkerboard pattern with different colors *)
168 let color =
169 if ((x / step) + (y / step)) mod 2 = 0 then 3 (* Blue *)
170 else 1 (* Red *)
171 in
172 Buffer.add_char image_data (Char.chr color)
173 done
174 done;
175
176 (* End with End of Information code *)
177 Buffer.add_char image_data (Char.chr 0x09);
178
179 (* Add image data blocks - GIF uses 255-byte max chunks *)
180 let data = Buffer.contents image_data in
181 let data_len = String.length data in
182 let pos = ref 0 in
183
184 while !pos < data_len do
185 let chunk_size = min 255 (data_len - !pos) in
186 Buffer.add_char buf (Char.chr chunk_size);
187 for i = 0 to chunk_size - 1 do
188 Buffer.add_char buf (String.get data (!pos + i))
189 done;
190 pos := !pos + chunk_size
191 done;
192
193 (* Zero-length block to end the image data *)
194 Buffer.add_char buf (Char.chr 0x00);
195
196 (* GIF Trailer *)
197 Buffer.add_char buf (Char.chr 0x3B);
198
199 (* Base64 encode the GIF data *)
200 Base64.encode (Buffer.contents buf)
201
202(* Helper to write 32-bit little endian integer *)
203let write_int32_le buf n =
204 Buffer.add_char buf (Char.chr (n land 0xff));
205 Buffer.add_char buf (Char.chr ((n lsr 8) land 0xff));
206 Buffer.add_char buf (Char.chr ((n lsr 16) land 0xff));
207 Buffer.add_char buf (Char.chr ((n lsr 24) land 0xff))
208
209(* Helper to write 16-bit little endian integer *)
210let write_int16_le buf n =
211 Buffer.add_char buf (Char.chr (n land 0xff));
212 Buffer.add_char buf (Char.chr ((n lsr 8) land 0xff))
213
214(* Generate a simple WAV file with sine wave *)
215let generate_sine_wave_audio frequency duration =
216 (* WAV header *)
217 let sample_rate = 8000 in
218 let num_samples = sample_rate * duration in
219 let header_buf = Buffer.create 44 in
220
221 (* Fill WAV header properly *)
222 Buffer.add_string header_buf "RIFF";
223 write_int32_le header_buf (36 + (num_samples * 2));
224 (* File size minus 8 *)
225 Buffer.add_string header_buf "WAVE";
226
227 (* Format chunk *)
228 Buffer.add_string header_buf "fmt ";
229 write_int32_le header_buf 16;
230 (* Format chunk size *)
231 write_int16_le header_buf 1;
232 (* PCM format *)
233 write_int16_le header_buf 1;
234 (* Mono *)
235 write_int32_le header_buf sample_rate;
236 (* Sample rate *)
237 write_int32_le header_buf (sample_rate * 2);
238 (* Byte rate *)
239 write_int16_le header_buf 2;
240 (* Block align *)
241 write_int16_le header_buf 16;
242
243 (* Bits per sample *)
244
245 (* Data chunk *)
246 Buffer.add_string header_buf "data";
247 write_int32_le header_buf (num_samples * 2);
248
249 (* Data size *)
250
251 (* Generate sine wave samples *)
252 let samples_buf = Buffer.create (num_samples * 2) in
253 let amplitude = 16384.0 in
254 (* 16-bit with headroom *)
255
256 for i = 0 to num_samples - 1 do
257 let t = float_of_int i /. float_of_int sample_rate in
258 let value = amplitude *. sin (2.0 *. Float.pi *. frequency *. t) in
259 let sample = int_of_float value in
260
261 (* Convert to 16-bit little-endian *)
262 let sample = if sample < 0 then sample + 65536 else sample in
263 write_int16_le samples_buf sample
264 done;
265
266 (* Combine header and samples, then encode as Base64 *)
267 let wav_data = Buffer.contents header_buf ^ Buffer.contents samples_buf in
268 Base64.encode wav_data
269
270(* Create a server *)
271let server =
272 create_server ~name:"OCaml MCP Multimodal Example" ~version:"0.1.0"
273 ~protocol_version:"2024-11-05" ()
274 |> fun server ->
275 (* Set default capabilities *)
276 configure_server server ~with_tools:true ~with_resources:true
277 ~with_prompts:true ()
278
279(* Define and register a multimodal tool that returns text, images, and audio *)
280let _ =
281 add_tool server ~name:"multimodal_demo"
282 ~description:"Demonstrates multimodal content with text, image, and audio"
283 ~schema_properties:
284 [
285 ("width", "integer", "Width of the generated image (pixels)");
286 ("height", "integer", "Height of the generated image (pixels)");
287 ("frequency", "integer", "Frequency of the generated audio tone (Hz)");
288 ("duration", "integer", "Duration of the generated audio (seconds)");
289 ("message", "string", "Text message to include");
290 ]
291 ~schema_required:[ "message" ]
292 (fun args ->
293 try
294 (* Extract parameters with defaults if not provided *)
295 let message = get_string_param args "message" in
296 let width = try get_int_param args "width" with _ -> 128 in
297 let height = try get_int_param args "height" with _ -> 128 in
298 let frequency = try get_int_param args "frequency" with _ -> 440 in
299 let duration = try get_int_param args "duration" with _ -> 1 in
300
301 (* Generate image and audio data *)
302 let image_data = generate_random_image width height in
303 let audio_data =
304 generate_sine_wave_audio (float_of_int frequency) duration
305 in
306
307 (* Create a multimodal tool result *)
308 Tool.create_tool_result
309 [
310 Mcp.make_text_content message;
311 Mcp.make_image_content image_data "image/gif";
312 Mcp.make_audio_content audio_data "audio/wav";
313 ]
314 ~is_error:false
315 with Failure msg ->
316 Logs.err (fun m -> m "Error in multimodal tool: %s" msg);
317 Tool.create_tool_result
318 [ Mcp.make_text_content (Printf.sprintf "Error: %s" msg) ]
319 ~is_error:true)
320
321(* Define and register a tool for generating only images *)
322let _ =
323 add_tool server ~name:"generate_image"
324 ~description:"Generates a random image with specified dimensions"
325 ~schema_properties:
326 [
327 ("width", "integer", "Width of the generated image (pixels)");
328 ("height", "integer", "Height of the generated image (pixels)");
329 ]
330 ~schema_required:[ "width"; "height" ]
331 (fun args ->
332 try
333 let width = get_int_param args "width" in
334 let height = get_int_param args "height" in
335
336 if width < 1 || width > 1024 || height < 1 || height > 1024 then
337 Tool.create_tool_result
338 [
339 Mcp.make_text_content
340 "Error: Dimensions must be between 1 and 1024 pixels";
341 ]
342 ~is_error:true
343 else
344 let image_data = generate_random_image width height in
345 Tool.create_tool_result
346 [ Mcp.make_image_content image_data "image/gif" ]
347 ~is_error:false
348 with Failure msg ->
349 Logs.err (fun m -> m "Error in generate_image tool: %s" msg);
350 Tool.create_tool_result
351 [ Mcp.make_text_content (Printf.sprintf "Error: %s" msg) ]
352 ~is_error:true)
353
354(* Define and register a tool for generating only audio *)
355let _ =
356 add_tool server ~name:"generate_audio"
357 ~description:"Generates an audio tone with specified frequency and duration"
358 ~schema_properties:
359 [
360 ("frequency", "integer", "Frequency of the tone in Hz (20-20000)");
361 ("duration", "integer", "Duration of the tone in seconds (1-10)");
362 ]
363 ~schema_required:[ "frequency"; "duration" ]
364 (fun args ->
365 try
366 let frequency = get_int_param args "frequency" in
367 let duration = get_int_param args "duration" in
368
369 if frequency < 20 || frequency > 20000 then
370 Tool.create_tool_result
371 [
372 Mcp.make_text_content
373 "Error: Frequency must be between 20Hz and 20,000Hz";
374 ]
375 ~is_error:true
376 else if duration < 1 || duration > 10 then
377 Tool.create_tool_result
378 [
379 Mcp.make_text_content
380 "Error: Duration must be between 1 and 10 seconds";
381 ]
382 ~is_error:true
383 else
384 let audio_data =
385 generate_sine_wave_audio (float_of_int frequency) duration
386 in
387 Tool.create_tool_result
388 [ Mcp.make_audio_content audio_data "audio/wav" ]
389 ~is_error:false
390 with Failure msg ->
391 Logs.err (fun m -> m "Error in generate_audio tool: %s" msg);
392 Tool.create_tool_result
393 [ Mcp.make_text_content (Printf.sprintf "Error: %s" msg) ]
394 ~is_error:true)
395
396(* Define and register a resource template example with multimodal content *)
397let _ =
398 add_resource_template server ~uri_template:"multimodal://{name}"
399 ~name:"Multimodal Greeting"
400 ~description:"Get a multimodal greeting with text, image and audio"
401 ~mime_type:"application/json" (fun params ->
402 match params with
403 | [ name ] ->
404 let greeting =
405 Printf.sprintf "Hello, %s! Welcome to the multimodal MCP example."
406 name
407 in
408 let image_data = generate_random_image 128 128 in
409 let audio_data = generate_sine_wave_audio 440.0 1 in
410
411 Printf.sprintf
412 {|
413 {
414 "greeting": "%s",
415 "image": {
416 "data": "%s",
417 "mimeType": "image/gif"
418 },
419 "audio": {
420 "data": "%s",
421 "mimeType": "audio/wav"
422 }
423 }
424 |}
425 greeting image_data audio_data
426 | _ -> Printf.sprintf {|{"error": "Invalid parameters"}|})
427
428(* Run the server with the default scheduler *)
429let () =
430 Logs.set_reporter (Logs.format_reporter ());
431 Random.self_init ();
432 (* Initialize random generator *)
433 Eio_main.run @@ fun env -> Mcp_server.run_stdio_server env server