Model Context Protocol in OCaml
anil.recoil.org
1open Mcp
2open Mcp_sdk
3open Mcp_server
4
5(* WAV file format helper module *)
6module Wav = struct
7 (* Simple WAV file generation for a sine wave *)
8 let generate_sine_wave ~frequency ~duration ~sample_rate ~amplitude =
9 (* WAV parameters *)
10 let num_channels = 1 in (* Mono *)
11 let bits_per_sample = 16 in
12 let byte_rate = sample_rate * num_channels * bits_per_sample / 8 in
13 let block_align = num_channels * bits_per_sample / 8 in
14 let num_samples = int_of_float (float_of_int sample_rate *. duration) in
15 let data_size = num_samples * block_align in
16
17 (* Create buffer for the WAV data *)
18 let buffer = Buffer.create (44 + data_size) in
19
20 (* Write WAV header *)
21 (* "RIFF" chunk *)
22 Buffer.add_string buffer "RIFF";
23 let file_size = 36 + data_size in
24 Buffer.add_char buffer (char_of_int (file_size land 0xff));
25 Buffer.add_char buffer (char_of_int ((file_size lsr 8) land 0xff));
26 Buffer.add_char buffer (char_of_int ((file_size lsr 16) land 0xff));
27 Buffer.add_char buffer (char_of_int ((file_size lsr 24) land 0xff));
28 Buffer.add_string buffer "WAVE";
29
30 (* "fmt " sub-chunk *)
31 Buffer.add_string buffer "fmt ";
32 Buffer.add_char buffer (char_of_int 16); (* Sub-chunk size (16 for PCM) *)
33 Buffer.add_char buffer (char_of_int 0);
34 Buffer.add_char buffer (char_of_int 0);
35 Buffer.add_char buffer (char_of_int 0);
36 Buffer.add_char buffer (char_of_int 1); (* Audio format (1 for PCM) *)
37 Buffer.add_char buffer (char_of_int 0);
38 Buffer.add_char buffer (char_of_int num_channels); (* Number of channels *)
39 Buffer.add_char buffer (char_of_int 0);
40
41 (* Sample rate *)
42 Buffer.add_char buffer (char_of_int (sample_rate land 0xff));
43 Buffer.add_char buffer (char_of_int ((sample_rate lsr 8) land 0xff));
44 Buffer.add_char buffer (char_of_int ((sample_rate lsr 16) land 0xff));
45 Buffer.add_char buffer (char_of_int ((sample_rate lsr 24) land 0xff));
46
47 (* Byte rate *)
48 Buffer.add_char buffer (char_of_int (byte_rate land 0xff));
49 Buffer.add_char buffer (char_of_int ((byte_rate lsr 8) land 0xff));
50 Buffer.add_char buffer (char_of_int ((byte_rate lsr 16) land 0xff));
51 Buffer.add_char buffer (char_of_int ((byte_rate lsr 24) land 0xff));
52
53 (* Block align *)
54 Buffer.add_char buffer (char_of_int block_align);
55 Buffer.add_char buffer (char_of_int 0);
56
57 (* Bits per sample *)
58 Buffer.add_char buffer (char_of_int bits_per_sample);
59 Buffer.add_char buffer (char_of_int 0);
60
61 (* "data" sub-chunk *)
62 Buffer.add_string buffer "data";
63 Buffer.add_char buffer (char_of_int (data_size land 0xff));
64 Buffer.add_char buffer (char_of_int ((data_size lsr 8) land 0xff));
65 Buffer.add_char buffer (char_of_int ((data_size lsr 16) land 0xff));
66 Buffer.add_char buffer (char_of_int ((data_size lsr 24) land 0xff));
67
68 (* Generate sine wave data *)
69 let max_amplitude = float_of_int (1 lsl (bits_per_sample - 1)) -. 1.0 in
70 for i = 0 to num_samples - 1 do
71 let t = float_of_int i /. float_of_int sample_rate in
72 let value = int_of_float (amplitude *. max_amplitude *. sin (2.0 *. Float.pi *. frequency *. t)) in
73 (* Write 16-bit sample (little-endian) *)
74 Buffer.add_char buffer (char_of_int (value land 0xff));
75 Buffer.add_char buffer (char_of_int ((value lsr 8) land 0xff));
76 done;
77
78 Buffer.contents buffer
79
80 (* Encode binary data as base64 *)
81 let base64_encode data =
82 let buffer = Buffer.create (4 * (String.length data + 2) / 3) in
83 let alphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" in
84
85 let encode_block i bytes =
86 let b1 = Char.code (String.get bytes (i * 3)) in
87 let b2 = if i * 3 + 1 < String.length bytes then Char.code (String.get bytes (i * 3 + 1)) else 0 in
88 let b3 = if i * 3 + 2 < String.length bytes then Char.code (String.get bytes (i * 3 + 2)) else 0 in
89
90 let n = (b1 lsl 16) lor (b2 lsl 8) lor b3 in
91 Buffer.add_char buffer (String.get alphabet ((n lsr 18) land 63));
92 Buffer.add_char buffer (String.get alphabet ((n lsr 12) land 63));
93
94 if i * 3 + 1 < String.length bytes then
95 Buffer.add_char buffer (String.get alphabet ((n lsr 6) land 63))
96 else
97 Buffer.add_char buffer '=';
98
99 if i * 3 + 2 < String.length bytes then
100 Buffer.add_char buffer (String.get alphabet (n land 63))
101 else
102 Buffer.add_char buffer '=';
103 in
104
105 for i = 0 to (String.length data + 2) / 3 - 1 do
106 encode_block i data
107 done;
108
109 Buffer.contents buffer
110end
111
112(* Helper for extracting string value from JSON *)
113let get_string_param json name =
114 match json with
115 | `Assoc fields ->
116 (match List.assoc_opt name fields with
117 | Some (`String value) -> value
118 | _ -> raise (Failure (Printf.sprintf "Missing or invalid parameter: %s" name)))
119 | _ -> raise (Failure "Expected JSON object")
120
121(* Create a server *)
122let server = create_server
123 ~name:"OCaml MCP Audio Example"
124 ~version:"0.1.0"
125 ~protocol_version:"2024-11-05"
126 ()
127
128(* Define startup and shutdown hooks *)
129let startup () =
130 (* Use stderr for direct printing to avoid interfering with JSON-RPC protocol *)
131 Printf.fprintf stderr "AudioExampleServer is starting up!\n";
132 flush stderr;
133 Log.info "AudioExampleServer is starting up!"
134
135let shutdown () =
136 Printf.fprintf stderr "AudioExampleServer is shutting down. Goodbye!\n";
137 flush stderr;
138 Log.info "AudioExampleServer is shutting down. Goodbye!"
139
140(* Register the hooks *)
141let () =
142 set_startup_hook server startup;
143 set_shutdown_hook server shutdown
144
145(* Helper to create audio content *)
146let make_audio_content data mime_type =
147 let audio_content = AudioContent.{
148 data;
149 mime_type;
150 annotations = None;
151 } in
152 Audio audio_content
153
154(* Define and register an audio tool *)
155let _ = add_tool server
156 ~name:"generate_audio_description"
157 ~description:"Generates a description with an audio sample"
158 ~schema_properties:[
159 ("text", "string", "The text to describe with audio");
160 ("frequency", "number", "The frequency in Hz for the tone (optional)");
161 ("duration", "number", "The duration in seconds for the tone (optional)");
162 ("amplitude", "number", "The amplitude (0.0-1.0) for the tone (optional)");
163 ]
164 ~schema_required:["text"]
165 (fun args ->
166 try
167 let text = get_string_param args "text" in
168
169 (* Parse parameters with defaults *)
170 let frequency =
171 try
172 match List.assoc_opt "frequency" (match args with `Assoc l -> l | _ -> []) with
173 | Some (`Int f) -> float_of_int f
174 | Some (`Float f) -> f
175 | _ -> 440.0 (* Default to A440 *)
176 with _ -> 440.0
177 in
178
179 let duration =
180 try
181 match List.assoc_opt "duration" (match args with `Assoc l -> l | _ -> []) with
182 | Some (`Int d) -> float_of_int d
183 | Some (`Float d) -> d
184 | _ -> 2.0 (* Default to 2 seconds *)
185 with _ -> 2.0
186 in
187
188 let amplitude =
189 try
190 match List.assoc_opt "amplitude" (match args with `Assoc l -> l | _ -> []) with
191 | Some (`Int a) -> float_of_int a
192 | Some (`Float a) -> a
193 | _ -> 0.8 (* Default to 80% amplitude *)
194 with _ -> 0.8
195 in
196
197 (* Generate WAV file for the tone *)
198 let sample_rate = 44100 in (* CD quality *)
199 let wav_data = Wav.generate_sine_wave
200 ~frequency
201 ~duration
202 ~sample_rate
203 ~amplitude
204 in
205
206 (* Encode WAV data as base64 *)
207 let base64_audio = Wav.base64_encode wav_data in
208
209 Log.info (Printf.sprintf "Generated %d Hz tone for %.1f seconds (%.1f KB)"
210 (int_of_float frequency) duration
211 (float_of_int (String.length wav_data) /. 1024.0));
212
213 (* Create a response with both text and audio content *)
214 CallToolResult.yojson_of_t CallToolResult.{
215 content = [
216 Text TextContent.{
217 text = Printf.sprintf "Description: %s (with %.1f Hz tone for %.1f seconds)"
218 text frequency duration;
219 annotations = None
220 };
221 Audio AudioContent.{
222 data = base64_audio;
223 mime_type = "audio/wav";
224 annotations = None
225 }
226 ];
227 is_error = false;
228 meta = None
229 }
230 with
231 | Failure msg ->
232 Log.error (Printf.sprintf "Error in audio tool: %s" msg);
233 CallToolResult.yojson_of_t CallToolResult.{
234 content = [
235 Text TextContent.{
236 text = Printf.sprintf "Error: %s" msg;
237 annotations = None
238 }
239 ];
240 is_error = true;
241 meta = None
242 }
243 )
244
245(* Define and register a prompt example with audio *)
246let _ = add_prompt server
247 ~name:"audio-description-prompt"
248 ~description:"A prompt with audio and text content"
249 ~arguments:[
250 ("description", Some "Text description to accompany the audio", true);
251 ("frequency", Some "Frequency in Hz for the audio tone", false);
252 ("duration", Some "Duration in seconds for the audio tone", false);
253 ]
254 (fun args ->
255 let description =
256 try List.assoc "description" args
257 with Not_found -> "No description provided"
258 in
259
260 (* Parse frequency with default *)
261 let frequency =
262 try float_of_string (List.assoc "frequency" args)
263 with _ -> 440.0 (* Default to A440 *)
264 in
265
266 (* Parse duration with default *)
267 let duration =
268 try float_of_string (List.assoc "duration" args)
269 with _ -> 3.0 (* Default to 3 seconds *)
270 in
271
272 (* Generate WAV data *)
273 let sample_rate = 44100 in
274 let wav_data = Wav.generate_sine_wave
275 ~frequency
276 ~duration
277 ~sample_rate
278 ~amplitude:0.8
279 in
280
281 (* Encode WAV data as base64 *)
282 let base64_audio = Wav.base64_encode wav_data in
283
284 Log.info (Printf.sprintf "Generated %.1f Hz tone for prompt (%.1f seconds, %.1f KB)"
285 frequency duration
286 (float_of_int (String.length wav_data) /. 1024.0));
287
288 [
289 Prompt.{
290 role = `User;
291 content = make_text_content "Here's a sound sample with description:"
292 };
293 Prompt.{
294 role = `User;
295 content = make_audio_content base64_audio "audio/wav"
296 };
297 Prompt.{
298 role = `User;
299 content = make_text_content (Printf.sprintf "%s (%.1f Hz tone for %.1f seconds)"
300 description frequency duration)
301 };
302 Prompt.{
303 role = `Assistant;
304 content = make_text_content "I've received your audio file and description."
305 }
306 ]
307 )
308
309(* Main function *)
310let () =
311 (* Parse command line arguments *)
312 let transport_type = ref Mcp_server.Stdio in
313 let args = [
314 ("--http", Arg.Unit (fun () -> transport_type := Mcp_server.Http),
315 "Start server with HTTP transport (default is stdio)");
316 ] in
317 let usage_msg = "Usage: audio_example [--http]" in
318 Arg.parse args (fun _ -> ()) usage_msg;
319
320 (* Use stderr for direct printing to avoid interfering with JSON-RPC protocol *)
321 Printf.fprintf stderr "Starting AudioExampleServer...\n";
322 flush stderr;
323 Log.info "Starting AudioExampleServer...";
324
325 (* Configure the server with appropriate capabilities *)
326 ignore (configure_server server ());
327
328 (* Create and start MCP server with the selected transport *)
329 let mcp_server = Mcp_server.create ~server ~transport:!transport_type () in
330 Mcp_server.start mcp_server