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 | _ -> raise (Failure (Printf.sprintf "Missing or invalid parameter: %s" name)))
10 | _ -> raise (Failure "Expected JSON object")
11
12(* Helper for extracting integer value from JSON *)
13let get_int_param json name =
14 match json with
15 | `Assoc fields ->
16 (match List.assoc_opt name fields with
17 | Some (`Int value) -> value
18 | Some (`String value) -> int_of_string value
19 | _ -> raise (Failure (Printf.sprintf "Missing or invalid parameter: %s" name)))
20 | _ -> raise (Failure "Expected JSON object")
21
22(* Base64 encoding - simplified version *)
23module Base64 = struct
24 let encode_char idx =
25 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/".[idx]
26
27 let encode s =
28 let len = String.length s in
29 let result = Bytes.create (((len + 2) / 3) * 4) in
30
31 let rec loop i j =
32 if i >= len then j
33 else
34 let n =
35 let n = Char.code s.[i] lsl 16 in
36 let n = if i + 1 < len then n lor (Char.code s.[i+1] lsl 8) else n in
37 if i + 2 < len then n lor Char.code s.[i+2] else n
38 in
39 Bytes.set result j (encode_char ((n lsr 18) land 63));
40 Bytes.set result (j+1) (encode_char ((n lsr 12) land 63));
41 Bytes.set result (j+2)
42 (if i + 1 < len then encode_char ((n lsr 6) land 63) else '=');
43 Bytes.set result (j+3)
44 (if i + 2 < len then encode_char (n land 63) else '=');
45 loop (i + 3) (j + 4)
46 in
47 Bytes.sub_string result 0 (loop 0 0)
48end
49
50(* Generate a random image as SVG format *)
51let generate_random_image width height =
52 (* Helper to get random color with param control *)
53 let random_color ?(min=0) ?(max=255) () =
54 let r = min + Random.int (max - min + 1) in
55 let g = min + Random.int (max - min + 1) in
56 let b = min + Random.int (max - min + 1) in
57 Printf.sprintf "#%02x%02x%02x" r g b
58 in
59
60 (* Create SVG header *)
61 let svg_buffer = Buffer.create 10240 in
62 Buffer.add_string svg_buffer (Printf.sprintf
63 "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"no\"?>\n\
64 <svg width=\"%d\" height=\"%d\" xmlns=\"http://www.w3.org/2000/svg\">\n\
65 <rect width=\"%d\" height=\"%d\" fill=\"%s\"/>\n"
66 width height width height (random_color ~min:200 ~max:240 ())
67 );
68
69 (* Generate different SVG shapes based on image size and randomness *)
70 let shape_count = (width * height) / 5000 + 5 in
71
72 (* Add random circles *)
73 for _ = 1 to shape_count / 2 do
74 let cx = Random.int width in
75 let cy = Random.int height in
76 let r = 5 + Random.int (min width height / 8) in
77 let color = random_color ~min:50 ~max:200 () in
78 let opacity = 0.3 +. (Random.float 0.7) in
79 Buffer.add_string svg_buffer (Printf.sprintf
80 "<circle cx=\"%d\" cy=\"%d\" r=\"%d\" fill=\"%s\" fill-opacity=\"%.2f\" />\n"
81 cx cy r color opacity
82 );
83 done;
84
85 (* Add random rectangles *)
86 for _ = 1 to shape_count / 3 do
87 let x = Random.int width in
88 let y = Random.int height in
89 let w = 10 + Random.int (width / 5) in
90 let h = 10 + Random.int (height / 5) in
91 let color = random_color ~min:50 ~max:200 () in
92 let opacity = 0.2 +. (Random.float 0.6) in
93 let rx = 2 + Random.int 20 in (* Rounded corners *)
94 Buffer.add_string svg_buffer (Printf.sprintf
95 "<rect x=\"%d\" y=\"%d\" width=\"%d\" height=\"%d\" rx=\"%d\" fill=\"%s\" fill-opacity=\"%.2f\" />\n"
96 x y w h rx color opacity
97 );
98 done;
99
100 (* Add random lines *)
101 for _ = 1 to shape_count do
102 let x1 = Random.int width in
103 let y1 = Random.int height in
104 let x2 = Random.int width in
105 let y2 = Random.int height in
106 let stroke = random_color () in
107 let sw = 1 + Random.int 5 in
108 Buffer.add_string svg_buffer (Printf.sprintf
109 "<line x1=\"%d\" y1=\"%d\" x2=\"%d\" y2=\"%d\" stroke=\"%s\" stroke-width=\"%d\" />\n"
110 x1 y1 x2 y2 stroke sw
111 );
112 done;
113
114 (* Add some random polygons *)
115 for _ = 1 to shape_count / 4 do
116 let points = 3 + Random.int 5 in (* 3 to 7 points *)
117 let cx = Random.int width in
118 let cy = Random.int height in
119 let radius = 10 + Random.int (min width height / 6) in
120 let points_str = Buffer.create 100 in
121
122 for i = 0 to points - 1 do
123 let angle = 2.0 *. Float.pi *. (float_of_int i) /. (float_of_int points) in
124 let px = cx + int_of_float (float_of_int radius *. cos angle) in
125 let py = cy + int_of_float (float_of_int radius *. sin angle) in
126 Buffer.add_string points_str (Printf.sprintf "%d,%d " px py);
127 done;
128
129 let fill = random_color ~min:100 ~max:220 () in
130 let opacity = 0.2 +. Random.float 0.5 in
131
132 Buffer.add_string svg_buffer (Printf.sprintf
133 "<polygon points=\"%s\" fill=\"%s\" fill-opacity=\"%.2f\" />\n"
134 (Buffer.contents points_str) fill opacity
135 );
136 done;
137
138 (* Close SVG tag *)
139 Buffer.add_string svg_buffer "</svg>";
140
141 (* Return the SVG directly, no need for Base64 since it's already text *)
142 Buffer.contents svg_buffer
143
144(* Helper to write 32-bit little endian integer *)
145let write_int32_le buf n =
146 Buffer.add_char buf (Char.chr (n land 0xff));
147 Buffer.add_char buf (Char.chr ((n lsr 8) land 0xff));
148 Buffer.add_char buf (Char.chr ((n lsr 16) land 0xff));
149 Buffer.add_char buf (Char.chr ((n lsr 24) land 0xff))
150
151(* Helper to write 16-bit little endian integer *)
152let write_int16_le buf n =
153 Buffer.add_char buf (Char.chr (n land 0xff));
154 Buffer.add_char buf (Char.chr ((n lsr 8) land 0xff))
155
156(* Generate a simple WAV file with sine wave *)
157let generate_sine_wave_audio frequency duration =
158 (* WAV header *)
159 let sample_rate = 8000 in
160 let num_samples = sample_rate * duration in
161 let header_buf = Buffer.create 44 in
162
163 (* Fill WAV header properly *)
164 Buffer.add_string header_buf "RIFF";
165 write_int32_le header_buf (36 + num_samples * 2); (* File size minus 8 *)
166 Buffer.add_string header_buf "WAVE";
167
168 (* Format chunk *)
169 Buffer.add_string header_buf "fmt ";
170 write_int32_le header_buf 16; (* Format chunk size *)
171 write_int16_le header_buf 1; (* PCM format *)
172 write_int16_le header_buf 1; (* Mono *)
173 write_int32_le header_buf sample_rate; (* Sample rate *)
174 write_int32_le header_buf (sample_rate * 2); (* Byte rate *)
175 write_int16_le header_buf 2; (* Block align *)
176 write_int16_le header_buf 16; (* Bits per sample *)
177
178 (* Data chunk *)
179 Buffer.add_string header_buf "data";
180 write_int32_le header_buf (num_samples * 2); (* Data size *)
181
182 (* Generate sine wave samples *)
183 let samples_buf = Buffer.create (num_samples * 2) in
184 let amplitude = 16384.0 in (* 16-bit with headroom *)
185
186 for i = 0 to num_samples - 1 do
187 let t = float_of_int i /. float_of_int sample_rate in
188 let value = amplitude *. sin (2.0 *. Float.pi *. frequency *. t) in
189 let sample = int_of_float value in
190
191 (* Convert to 16-bit little-endian *)
192 let sample = if sample < 0 then sample + 65536 else sample in
193 write_int16_le samples_buf sample;
194 done;
195
196 (* Combine header and samples, then encode as Base64 *)
197 let wav_data = Buffer.contents header_buf ^ Buffer.contents samples_buf in
198 Base64.encode wav_data
199
200(* Create a server *)
201let server = create_server
202 ~name:"OCaml MCP Multimodal Example"
203 ~version:"0.1.0"
204 ~protocol_version:"2025-03-26" () |>
205 fun server ->
206 (* Set default capabilities *)
207 configure_server server ~with_tools:true ~with_resources:true ~with_prompts:true ()
208
209(* Define and register a multimodal tool that returns text, images, and audio *)
210let _ = add_tool server
211 ~name:"multimodal_demo"
212 ~description:"Demonstrates multimodal content with text, image, and audio"
213 ~schema_properties:[
214 ("width", "integer", "Width of the generated image (pixels)");
215 ("height", "integer", "Height of the generated image (pixels)");
216 ("frequency", "integer", "Frequency of the generated audio tone (Hz)");
217 ("duration", "integer", "Duration of the generated audio (seconds)");
218 ("message", "string", "Text message to include")
219 ]
220 ~schema_required:["message"]
221 (fun args ->
222 try
223 (* Extract parameters with defaults if not provided *)
224 let message = get_string_param args "message" in
225 let width = try get_int_param args "width" with _ -> 128 in
226 let height = try get_int_param args "height" with _ -> 128 in
227 let frequency = try get_int_param args "frequency" with _ -> 440 in
228 let duration = try get_int_param args "duration" with _ -> 1 in
229
230 (* Generate image and audio data *)
231 let image_data = generate_random_image width height in
232 let audio_data = generate_sine_wave_audio (float_of_int frequency) duration in
233
234 (* Create a multimodal tool result *)
235 create_rich_tool_result
236 ~text:(Some message)
237 ~image:(Some (image_data, "image/svg+xml"))
238 ~audio:(Some (audio_data, "audio/wav"))
239 ~is_error:false
240 ()
241 with
242 | Failure msg ->
243 Log.error (Printf.sprintf "Error in multimodal tool: %s" msg);
244 create_tool_result [TextContent (Printf.sprintf "Error: %s" msg)] ~is_error:true
245 )
246
247(* Define and register a tool for generating only images *)
248let _ = add_tool server
249 ~name:"generate_image"
250 ~description:"Generates a random image with specified dimensions"
251 ~schema_properties:[
252 ("width", "integer", "Width of the generated image (pixels)");
253 ("height", "integer", "Height of the generated image (pixels)")
254 ]
255 ~schema_required:["width"; "height"]
256 (fun args ->
257 try
258 let width = get_int_param args "width" in
259 let height = get_int_param args "height" in
260
261 if width < 1 || width > 1024 || height < 1 || height > 1024 then
262 create_tool_result
263 [TextContent "Error: Dimensions must be between 1 and 1024 pixels"]
264 ~is_error:true
265 else
266 let image_data = generate_random_image width height in
267 create_tool_result
268 [ImageContent { data = image_data; mime_type = "image/svg+xml" }]
269 ~is_error:false
270 with
271 | Failure msg ->
272 Log.error (Printf.sprintf "Error in generate_image tool: %s" msg);
273 create_tool_result [TextContent (Printf.sprintf "Error: %s" msg)] ~is_error:true
274 )
275
276(* Define and register a tool for generating only audio *)
277let _ = add_tool server
278 ~name:"generate_audio"
279 ~description:"Generates an audio tone with specified frequency and duration"
280 ~schema_properties:[
281 ("frequency", "integer", "Frequency of the tone in Hz (20-20000)");
282 ("duration", "integer", "Duration of the tone in seconds (1-10)")
283 ]
284 ~schema_required:["frequency"; "duration"]
285 (fun args ->
286 try
287 let frequency = get_int_param args "frequency" in
288 let duration = get_int_param args "duration" in
289
290 if frequency < 20 || frequency > 20000 then
291 create_tool_result
292 [TextContent "Error: Frequency must be between 20Hz and 20,000Hz"]
293 ~is_error:true
294 else if duration < 1 || duration > 10 then
295 create_tool_result
296 [TextContent "Error: Duration must be between 1 and 10 seconds"]
297 ~is_error:true
298 else
299 let audio_data = generate_sine_wave_audio (float_of_int frequency) duration in
300 create_tool_result
301 [AudioContent { data = audio_data; mime_type = "audio/wav" }]
302 ~is_error:false
303 with
304 | Failure msg ->
305 Log.error (Printf.sprintf "Error in generate_audio tool: %s" msg);
306 create_tool_result [TextContent (Printf.sprintf "Error: %s" msg)] ~is_error:true
307 )
308
309(* Define and register a resource example with multimodal content *)
310let _ = add_resource server
311 ~uri_template:"multimodal://{name}"
312 ~description:"Get a multimodal greeting with text, image and audio"
313 ~mime_type:"application/json"
314 (fun params ->
315 match params with
316 | [name] ->
317 let greeting = Printf.sprintf "Hello, %s! Welcome to the multimodal MCP example." name in
318 let image_data = generate_random_image 128 128 in
319 let audio_data = generate_sine_wave_audio 440.0 1 in
320
321 Printf.sprintf {|
322 {
323 "greeting": "%s",
324 "image": {
325 "data": "%s",
326 "mimeType": "image/svg+xml"
327 },
328 "audio": {
329 "data": "%s",
330 "mimeType": "audio/wav"
331 }
332 }
333 |} greeting image_data audio_data
334 | _ -> Printf.sprintf {|{"error": "Invalid parameters"}|}
335 )
336
337(* Run the server with the default scheduler *)
338let () =
339 Random.self_init(); (* Initialize random generator *)
340 Eio_main.run @@ fun env ->
341 Mcp_server.run_server env server