Model Context Protocol in OCaml
anil.recoil.org
1open Mcp
2open Mcp_sdk
3
4(* Helper for extracting string value from JSON *)
5let get_string_param json name =
6 match json with
7 | `Assoc fields ->
8 (match List.assoc_opt name fields with
9 | Some (`String value) -> value
10 | _ -> raise (Failure (Printf.sprintf "Missing or invalid parameter: %s" name)))
11 | _ -> raise (Failure "Expected JSON object")
12
13(* Helper for extracting integer value from JSON *)
14let get_int_param json name =
15 match json with
16 | `Assoc fields ->
17 (match List.assoc_opt name fields with
18 | Some (`Int value) -> 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 PPM format (simple RGB format) *)
51let generate_random_image width height =
52 let header = Printf.sprintf "P6\n%d %d\n255\n" width height in
53 let data = Bytes.create (width * height * 3) in
54 let step = Random.int 20 + 10 in
55
56 for y = 0 to height - 1 do
57 for x = 0 to width - 1 do
58 let pattern_val = ((x / step) + (y / step)) mod 2 in
59 let offset = (y * width + x) * 3 in
60 if pattern_val = 0 then begin
61 (* Random bright color for checkerboard *)
62 let r = 150 + Random.int 100 in
63 let g = 150 + Random.int 100 in
64 let b = 150 + Random.int 100 in
65 Bytes.set data offset (Char.chr r);
66 Bytes.set data (offset + 1) (Char.chr g);
67 Bytes.set data (offset + 2) (Char.chr b);
68 end else begin
69 (* Dark color *)
70 let r = Random.int 100 in
71 let g = Random.int 100 in
72 let b = Random.int 100 in
73 Bytes.set data offset (Char.chr r);
74 Bytes.set data (offset + 1) (Char.chr g);
75 Bytes.set data (offset + 2) (Char.chr b);
76 end
77 done
78 done;
79
80 (* Encode PPM data as Base64 *)
81 Base64.encode (header ^ Bytes.to_string data)
82
83(* Generate a simple WAV file with sine wave *)
84let generate_sine_wave_audio frequency duration =
85 (* WAV header *)
86 let sample_rate = 8000 in
87 let num_samples = sample_rate * duration in
88 let header = "RIFF" ^
89 String.make 4 '\000' ^ (* Size placeholder *)
90 "WAVEfmt " ^
91 String.make 4 '\016' ^ (* Subchunk1 size *)
92 String.make 2 '\001' ^ (* Audio format = 1 (PCM) *)
93 String.make 2 '\001' ^ (* Num channels = 1 (mono) *)
94 String.make 4 (Char.chr sample_rate) ^ (* Sample rate as 4 bytes *)
95 String.make 4 (Char.chr (sample_rate * 2)) ^ (* Byte rate *)
96 String.make 2 '\002' ^ (* Block align *)
97 String.make 2 '\016' ^ (* Bits per sample = 16 *)
98 "data" ^
99 String.make 4 (Char.chr (num_samples * 2)) in (* Data size *)
100
101 (* Generate sine wave samples *)
102 let samples = Bytes.create (num_samples * 2) in
103 let amplitude = 16384.0 in (* 16-bit with headroom *)
104
105 for i = 0 to num_samples - 1 do
106 let t = float_of_int i /. float_of_int sample_rate in
107 let value = amplitude *. sin (2.0 *. Float.pi *. frequency *. t) in
108 let sample = int_of_float value in
109
110 (* Convert to 16-bit little-endian *)
111 let sample = if sample < 0 then sample + 65536 else sample in
112 Bytes.set samples (i * 2) (Char.chr (sample land 0xff));
113 Bytes.set samples (i * 2 + 1) (Char.chr ((sample lsr 8) land 0xff));
114 done;
115
116 (* Encode WAV data as Base64 *)
117 Base64.encode (header ^ Bytes.to_string samples)
118
119(* Create a server *)
120let server = create_server
121 ~name:"OCaml MCP Multimodal Example"
122 ~version:"0.1.0"
123 ~protocol_version:"2025-03-26" () |>
124 fun server ->
125 (* Set default capabilities *)
126 configure_server server ~with_tools:true ~with_resources:true ~with_prompts:true ()
127
128(* Define and register a multimodal tool that returns text, images, and audio *)
129let _ = add_tool server
130 ~name:"multimodal_demo"
131 ~description:"Demonstrates multimodal content with text, image, and audio"
132 ~schema_properties:[
133 ("width", "integer", "Width of the generated image (pixels)");
134 ("height", "integer", "Height of the generated image (pixels)");
135 ("frequency", "integer", "Frequency of the generated audio tone (Hz)");
136 ("duration", "integer", "Duration of the generated audio (seconds)");
137 ("message", "string", "Text message to include")
138 ]
139 ~schema_required:["message"]
140 (fun args ->
141 try
142 (* Extract parameters with defaults if not provided *)
143 let message = get_string_param args "message" in
144 let width = try get_int_param args "width" with _ -> 128 in
145 let height = try get_int_param args "height" with _ -> 128 in
146 let frequency = try get_int_param args "frequency" with _ -> 440 in
147 let duration = try get_int_param args "duration" with _ -> 1 in
148
149 (* Generate image and audio data *)
150 let image_data = generate_random_image width height in
151 let audio_data = generate_sine_wave_audio (float_of_int frequency) duration in
152
153 (* Create a multimodal tool result *)
154 create_rich_tool_result
155 ~text:(Some message)
156 ~image:(Some (image_data, "image/ppm"))
157 ~audio:(Some (audio_data, "audio/wav"))
158 ~is_error:false
159 ()
160 with
161 | Failure msg ->
162 Log.error (Printf.sprintf "Error in multimodal tool: %s" msg);
163 create_tool_result [TextContent (Printf.sprintf "Error: %s" msg)] ~is_error:true
164 )
165
166(* Define and register a tool for generating only images *)
167let _ = add_tool server
168 ~name:"generate_image"
169 ~description:"Generates a random image with specified dimensions"
170 ~schema_properties:[
171 ("width", "integer", "Width of the generated image (pixels)");
172 ("height", "integer", "Height of the generated image (pixels)")
173 ]
174 ~schema_required:["width"; "height"]
175 (fun args ->
176 try
177 let width = get_int_param args "width" in
178 let height = get_int_param args "height" in
179
180 if width < 1 || width > 1024 || height < 1 || height > 1024 then
181 create_tool_result
182 [TextContent "Error: Dimensions must be between 1 and 1024 pixels"]
183 ~is_error:true
184 else
185 let image_data = generate_random_image width height in
186 create_tool_result
187 [ImageContent { data = image_data; mime_type = "image/ppm" }]
188 ~is_error:false
189 with
190 | Failure msg ->
191 Log.error (Printf.sprintf "Error in generate_image tool: %s" msg);
192 create_tool_result [TextContent (Printf.sprintf "Error: %s" msg)] ~is_error:true
193 )
194
195(* Define and register a tool for generating only audio *)
196let _ = add_tool server
197 ~name:"generate_audio"
198 ~description:"Generates an audio tone with specified frequency and duration"
199 ~schema_properties:[
200 ("frequency", "integer", "Frequency of the tone in Hz (20-20000)");
201 ("duration", "integer", "Duration of the tone in seconds (1-10)")
202 ]
203 ~schema_required:["frequency"; "duration"]
204 (fun args ->
205 try
206 let frequency = get_int_param args "frequency" in
207 let duration = get_int_param args "duration" in
208
209 if frequency < 20 || frequency > 20000 then
210 create_tool_result
211 [TextContent "Error: Frequency must be between 20Hz and 20,000Hz"]
212 ~is_error:true
213 else if duration < 1 || duration > 10 then
214 create_tool_result
215 [TextContent "Error: Duration must be between 1 and 10 seconds"]
216 ~is_error:true
217 else
218 let audio_data = generate_sine_wave_audio (float_of_int frequency) duration in
219 create_tool_result
220 [AudioContent { data = audio_data; mime_type = "audio/wav" }]
221 ~is_error:false
222 with
223 | Failure msg ->
224 Log.error (Printf.sprintf "Error in generate_audio tool: %s" msg);
225 create_tool_result [TextContent (Printf.sprintf "Error: %s" msg)] ~is_error:true
226 )
227
228(* Define and register a resource example with multimodal content *)
229let _ = add_resource server
230 ~uri_template:"multimodal://{name}"
231 ~description:"Get a multimodal greeting with text, image and audio"
232 ~mime_type:"application/json"
233 (fun params ->
234 match params with
235 | [name] ->
236 let greeting = Printf.sprintf "Hello, %s! Welcome to the multimodal MCP example." name in
237 let image_data = generate_random_image 128 128 in
238 let audio_data = generate_sine_wave_audio 440.0 1 in
239
240 Printf.sprintf {|
241 {
242 "greeting": "%s",
243 "image": {
244 "data": "%s",
245 "mimeType": "image/ppm"
246 },
247 "audio": {
248 "data": "%s",
249 "mimeType": "audio/wav"
250 }
251 }
252 |} greeting image_data audio_data
253 | _ -> Printf.sprintf {|{"error": "Invalid parameters"}|}
254 )
255
256(* Run the server with the default scheduler *)
257let () =
258 Random.self_init(); (* Initialize random generator *)
259 Eio_main.run @@ fun env ->
260 Mcp_server.run_server env server