Model Context Protocol in OCaml
anil.recoil.org
1open Jsonrpc
2
3(* Standard error codes *)
4module ErrorCode = struct
5 let parse_error = -32700
6 let invalid_request = -32600
7 let method_not_found = -32601
8 let invalid_params = -32602
9 let internal_error = -32603
10 let resource_not_found = -32002
11 let server_error_start = -32000
12 let server_error_end = -32099
13end
14
15(* Common types *)
16
17module Role = struct
18 type t = [ `User | `Assistant ]
19
20 let to_string = function
21 | `User -> "user"
22 | `Assistant -> "assistant"
23
24 let of_string = function
25 | "user" -> `User
26 | "assistant" -> `Assistant
27 | s -> raise (Json.Of_json ("Unknown role: " ^ s, `String s))
28
29 let yojson_of_t t = `String (to_string t)
30 let t_of_yojson = function
31 | `String s -> of_string s
32 | j -> raise (Json.Of_json ("Expected string for Role", j))
33end
34
35module ProgressToken = struct
36 type t = [ `String of string | `Int of int ]
37
38 include (Id : Json.Jsonable.S with type t := t)
39end
40
41module RequestId = Id
42
43module Cursor = struct
44 type t = string
45
46 let yojson_of_t t = `String t
47 let t_of_yojson = function
48 | `String s -> s
49 | j -> raise (Json.Of_json ("Expected string for Cursor", j))
50end
51
52(* Annotations *)
53
54module Annotated = struct
55 type t = {
56 annotations: annotation option;
57 }
58 and annotation = {
59 audience: Role.t list option;
60 priority: float option;
61 }
62
63 let yojson_of_annotation { audience; priority } =
64 let assoc = [] in
65 let assoc = match audience with
66 | Some audience -> ("audience", `List (List.map Role.yojson_of_t audience)) :: assoc
67 | None -> assoc
68 in
69 let assoc = match priority with
70 | Some priority -> ("priority", `Float priority) :: assoc
71 | None -> assoc
72 in
73 `Assoc assoc
74
75 let annotation_of_yojson = function
76 | `Assoc fields ->
77 let audience = List.assoc_opt "audience" fields |> Option.map (function
78 | `List items -> List.map Role.t_of_yojson items
79 | j -> raise (Json.Of_json ("Expected list for audience", j))
80 ) in
81 let priority = List.assoc_opt "priority" fields |> Option.map (function
82 | `Float f -> f
83 | j -> raise (Json.Of_json ("Expected float for priority", j))
84 ) in
85 { audience; priority }
86 | j -> raise (Json.Of_json ("Expected object for annotation", j))
87
88 let yojson_of_t { annotations } =
89 match annotations with
90 | Some annotations -> `Assoc [ "annotations", yojson_of_annotation annotations ]
91 | None -> `Assoc []
92
93 let t_of_yojson = function
94 | `Assoc fields ->
95 let annotations = List.assoc_opt "annotations" fields |> Option.map annotation_of_yojson in
96 { annotations }
97 | j -> raise (Json.Of_json ("Expected object for Annotated", j))
98end
99
100(* Content types *)
101
102module TextContent = struct
103 type t = {
104 text: string;
105 annotations: Annotated.annotation option;
106 }
107
108 let yojson_of_t { text; annotations } =
109 let assoc = [
110 ("text", `String text);
111 ("type", `String "text");
112 ] in
113 let assoc = match annotations with
114 | Some annotations -> ("annotations", Annotated.yojson_of_annotation annotations) :: assoc
115 | None -> assoc
116 in
117 `Assoc assoc
118
119 let t_of_yojson = function
120 | `Assoc fields ->
121 let text = match List.assoc_opt "text" fields with
122 | Some (`String s) -> s
123 | _ -> raise (Json.Of_json ("Missing or invalid 'text' field", `Assoc fields))
124 in
125 let _ = match List.assoc_opt "type" fields with
126 | Some (`String "text") -> ()
127 | _ -> raise (Json.Of_json ("Missing or invalid 'type' field", `Assoc fields))
128 in
129 let annotations = List.assoc_opt "annotations" fields |> Option.map Annotated.annotation_of_yojson in
130 { text; annotations }
131 | j -> raise (Json.Of_json ("Expected object for TextContent", j))
132end
133
134module ImageContent = struct
135 type t = {
136 data: string;
137 mime_type: string;
138 annotations: Annotated.annotation option;
139 }
140
141 let yojson_of_t { data; mime_type; annotations } =
142 let assoc = [
143 ("data", `String data);
144 ("mimeType", `String mime_type);
145 ("type", `String "image");
146 ] in
147 let assoc = match annotations with
148 | Some annotations -> ("annotations", Annotated.yojson_of_annotation annotations) :: assoc
149 | None -> assoc
150 in
151 `Assoc assoc
152
153 let t_of_yojson = function
154 | `Assoc fields ->
155 let data = match List.assoc_opt "data" fields with
156 | Some (`String s) -> s
157 | _ -> raise (Json.Of_json ("Missing or invalid 'data' field", `Assoc fields))
158 in
159 let mime_type = match List.assoc_opt "mimeType" fields with
160 | Some (`String s) -> s
161 | _ -> raise (Json.Of_json ("Missing or invalid 'mimeType' field", `Assoc fields))
162 in
163 let _ = match List.assoc_opt "type" fields with
164 | Some (`String "image") -> ()
165 | _ -> raise (Json.Of_json ("Missing or invalid 'type' field", `Assoc fields))
166 in
167 let annotations = List.assoc_opt "annotations" fields |> Option.map Annotated.annotation_of_yojson in
168 { data; mime_type; annotations }
169 | j -> raise (Json.Of_json ("Expected object for ImageContent", j))
170end
171
172module AudioContent = struct
173 type t = {
174 data: string;
175 mime_type: string;
176 annotations: Annotated.annotation option;
177 }
178
179 let yojson_of_t { data; mime_type; annotations } =
180 let assoc = [
181 ("data", `String data);
182 ("mimeType", `String mime_type);
183 ("type", `String "audio");
184 ] in
185 let assoc = match annotations with
186 | Some annotations -> ("annotations", Annotated.yojson_of_annotation annotations) :: assoc
187 | None -> assoc
188 in
189 `Assoc assoc
190
191 let t_of_yojson = function
192 | `Assoc fields ->
193 let data = match List.assoc_opt "data" fields with
194 | Some (`String s) -> s
195 | _ -> raise (Json.Of_json ("Missing or invalid 'data' field", `Assoc fields))
196 in
197 let mime_type = match List.assoc_opt "mimeType" fields with
198 | Some (`String s) -> s
199 | _ -> raise (Json.Of_json ("Missing or invalid 'mimeType' field", `Assoc fields))
200 in
201 let _ = match List.assoc_opt "type" fields with
202 | Some (`String "audio") -> ()
203 | _ -> raise (Json.Of_json ("Missing or invalid 'type' field", `Assoc fields))
204 in
205 let annotations = List.assoc_opt "annotations" fields |> Option.map Annotated.annotation_of_yojson in
206 { data; mime_type; annotations }
207 | j -> raise (Json.Of_json ("Expected object for AudioContent", j))
208end
209
210module ResourceContents = struct
211 type t = {
212 uri: string;
213 mime_type: string option;
214 }
215
216 let yojson_of_t { uri; mime_type } =
217 let assoc = [
218 ("uri", `String uri);
219 ] in
220 let assoc = match mime_type with
221 | Some mime_type -> ("mimeType", `String mime_type) :: assoc
222 | None -> assoc
223 in
224 `Assoc assoc
225
226 let t_of_yojson = function
227 | `Assoc fields ->
228 let uri = match List.assoc_opt "uri" fields with
229 | Some (`String s) -> s
230 | _ -> raise (Json.Of_json ("Missing or invalid 'uri' field", `Assoc fields))
231 in
232 let mime_type = List.assoc_opt "mimeType" fields |> Option.map (function
233 | `String s -> s
234 | j -> raise (Json.Of_json ("Expected string for mimeType", j))
235 ) in
236 { uri; mime_type }
237 | j -> raise (Json.Of_json ("Expected object for ResourceContents", j))
238end
239
240module TextResourceContents = struct
241 type t = {
242 uri: string;
243 text: string;
244 mime_type: string option;
245 }
246
247 let yojson_of_t { uri; text; mime_type } =
248 let assoc = [
249 ("uri", `String uri);
250 ("text", `String text);
251 ] in
252 let assoc = match mime_type with
253 | Some mime_type -> ("mimeType", `String mime_type) :: assoc
254 | None -> assoc
255 in
256 `Assoc assoc
257
258 let t_of_yojson = function
259 | `Assoc fields ->
260 let uri = match List.assoc_opt "uri" fields with
261 | Some (`String s) -> s
262 | _ -> raise (Json.Of_json ("Missing or invalid 'uri' field", `Assoc fields))
263 in
264 let text = match List.assoc_opt "text" fields with
265 | Some (`String s) -> s
266 | _ -> raise (Json.Of_json ("Missing or invalid 'text' field", `Assoc fields))
267 in
268 let mime_type = List.assoc_opt "mimeType" fields |> Option.map (function
269 | `String s -> s
270 | j -> raise (Json.Of_json ("Expected string for mimeType", j))
271 ) in
272 { uri; text; mime_type }
273 | j -> raise (Json.Of_json ("Expected object for TextResourceContents", j))
274end
275
276module BlobResourceContents = struct
277 type t = {
278 uri: string;
279 blob: string;
280 mime_type: string option;
281 }
282
283 let yojson_of_t { uri; blob; mime_type } =
284 let assoc = [
285 ("uri", `String uri);
286 ("blob", `String blob);
287 ] in
288 let assoc = match mime_type with
289 | Some mime_type -> ("mimeType", `String mime_type) :: assoc
290 | None -> assoc
291 in
292 `Assoc assoc
293
294 let t_of_yojson = function
295 | `Assoc fields ->
296 let uri = match List.assoc_opt "uri" fields with
297 | Some (`String s) -> s
298 | _ -> raise (Json.Of_json ("Missing or invalid 'uri' field", `Assoc fields))
299 in
300 let blob = match List.assoc_opt "blob" fields with
301 | Some (`String s) -> s
302 | _ -> raise (Json.Of_json ("Missing or invalid 'blob' field", `Assoc fields))
303 in
304 let mime_type = List.assoc_opt "mimeType" fields |> Option.map (function
305 | `String s -> s
306 | j -> raise (Json.Of_json ("Expected string for mimeType", j))
307 ) in
308 { uri; blob; mime_type }
309 | j -> raise (Json.Of_json ("Expected object for BlobResourceContents", j))
310end
311
312module EmbeddedResource = struct
313 type t = {
314 resource: [ `Text of TextResourceContents.t | `Blob of BlobResourceContents.t ];
315 annotations: Annotated.annotation option;
316 }
317
318 let yojson_of_t { resource; annotations } =
319 let resource_json = match resource with
320 | `Text txt -> TextResourceContents.yojson_of_t txt
321 | `Blob blob -> BlobResourceContents.yojson_of_t blob
322 in
323 let assoc = [
324 ("resource", resource_json);
325 ("type", `String "resource");
326 ] in
327 let assoc = match annotations with
328 | Some annotations -> ("annotations", Annotated.yojson_of_annotation annotations) :: assoc
329 | None -> assoc
330 in
331 `Assoc assoc
332
333 let t_of_yojson = function
334 | `Assoc fields ->
335 let _ = match List.assoc_opt "type" fields with
336 | Some (`String "resource") -> ()
337 | _ -> raise (Json.Of_json ("Missing or invalid 'type' field", `Assoc fields))
338 in
339 let resource = match List.assoc_opt "resource" fields with
340 | Some (`Assoc res_fields) ->
341 if List.mem_assoc "text" res_fields then
342 `Text (TextResourceContents.t_of_yojson (`Assoc res_fields))
343 else if List.mem_assoc "blob" res_fields then
344 `Blob (BlobResourceContents.t_of_yojson (`Assoc res_fields))
345 else
346 raise (Json.Of_json ("Invalid resource content", `Assoc res_fields))
347 | _ -> raise (Json.Of_json ("Missing or invalid 'resource' field", `Assoc fields))
348 in
349 let annotations = List.assoc_opt "annotations" fields |> Option.map Annotated.annotation_of_yojson in
350 { resource; annotations }
351 | j -> raise (Json.Of_json ("Expected object for EmbeddedResource", j))
352end
353
354(** Tool definition *)
355module Tool = struct
356 type t = {
357 name: string;
358 description: string option;
359 input_schema: Json.t;
360 }
361
362 let yojson_of_t { name; description; input_schema } =
363 let assoc = [
364 ("name", `String name);
365 ("inputSchema", input_schema);
366 ] in
367 let assoc = match description with
368 | Some desc -> ("description", `String desc) :: assoc
369 | None -> assoc
370 in
371 `Assoc assoc
372
373 let t_of_yojson = function
374 | `Assoc fields ->
375 let name = match List.assoc_opt "name" fields with
376 | Some (`String s) -> s
377 | _ -> raise (Json.Of_json ("Missing or invalid 'name' field", `Assoc fields))
378 in
379 let description = match List.assoc_opt "description" fields with
380 | Some (`String s) -> Some s
381 | _ -> None
382 in
383 let input_schema = match List.assoc_opt "inputSchema" fields with
384 | Some json -> json
385 | _ -> raise (Json.Of_json ("Missing 'inputSchema' field", `Assoc fields))
386 in
387 { name; description; input_schema }
388 | j -> raise (Json.Of_json ("Expected object for Tool", j))
389end
390
391type content =
392 | Text of TextContent.t
393 | Image of ImageContent.t
394 | Audio of AudioContent.t
395 | Resource of EmbeddedResource.t
396
397let yojson_of_content = function
398 | Text t -> TextContent.yojson_of_t t
399 | Image i -> ImageContent.yojson_of_t i
400 | Audio a -> AudioContent.yojson_of_t a
401 | Resource r -> EmbeddedResource.yojson_of_t r
402
403let content_of_yojson = function
404 | `Assoc fields ->
405 (match List.assoc_opt "type" fields with
406 | Some (`String "text") -> Text (TextContent.t_of_yojson (`Assoc fields))
407 | Some (`String "image") -> Image (ImageContent.t_of_yojson (`Assoc fields))
408 | Some (`String "audio") -> Audio (AudioContent.t_of_yojson (`Assoc fields))
409 | Some (`String "resource") -> Resource (EmbeddedResource.t_of_yojson (`Assoc fields))
410 | _ -> raise (Json.Of_json ("Invalid or missing content type", `Assoc fields)))
411 | j -> raise (Json.Of_json ("Expected object for content", j))
412
413(** Tool result *)
414module CallToolResult = struct
415 type t = {
416 content: content list;
417 is_error: bool;
418 meta: Json.t option;
419 }
420
421 let yojson_of_t { content; is_error; meta } =
422 let assoc = [
423 ("content", `List (List.map yojson_of_content content));
424 ("isError", `Bool is_error);
425 ] in
426 let assoc = match meta with
427 | Some meta_json -> ("_meta", meta_json) :: assoc
428 | None -> assoc
429 in
430 `Assoc assoc
431
432 let t_of_yojson = function
433 | `Assoc fields ->
434 let content = match List.assoc_opt "content" fields with
435 | Some (`List items) -> List.map content_of_yojson items
436 | _ -> raise (Json.Of_json ("Missing or invalid 'content' field", `Assoc fields))
437 in
438 let is_error = match List.assoc_opt "isError" fields with
439 | Some (`Bool b) -> b
440 | None -> false (* Default to false if not specified *)
441 | _ -> raise (Json.Of_json ("Invalid 'isError' field", `Assoc fields))
442 in
443 let meta = List.assoc_opt "_meta" fields in
444 { content; is_error; meta }
445 | j -> raise (Json.Of_json ("Expected object for CallToolResult", j))
446end
447
448(** Resource definition *)
449module Resource = struct
450 type t = {
451 name: string;
452 uri: string;
453 description: string option;
454 mime_type: string option;
455 size: int option;
456 annotations: Annotated.annotation option;
457 }
458
459 let yojson_of_t { name; uri; description; mime_type; size; annotations } =
460 let assoc = [
461 ("name", `String name);
462 ("uri", `String uri);
463 ] in
464 let assoc = match description with
465 | Some desc -> ("description", `String desc) :: assoc
466 | None -> assoc
467 in
468 let assoc = match mime_type with
469 | Some mime -> ("mimeType", `String mime) :: assoc
470 | None -> assoc
471 in
472 let assoc = match size with
473 | Some s -> ("size", `Int s) :: assoc
474 | None -> assoc
475 in
476 let assoc = match annotations with
477 | Some ann -> ("annotations", Annotated.yojson_of_annotation ann) :: assoc
478 | None -> assoc
479 in
480 `Assoc assoc
481
482 let t_of_yojson = function
483 | `Assoc fields ->
484 let name = match List.assoc_opt "name" fields with
485 | Some (`String s) -> s
486 | _ -> raise (Json.Of_json ("Missing or invalid 'name' field", `Assoc fields))
487 in
488 let uri = match List.assoc_opt "uri" fields with
489 | Some (`String s) -> s
490 | _ -> raise (Json.Of_json ("Missing or invalid 'uri' field", `Assoc fields))
491 in
492 let description = match List.assoc_opt "description" fields with
493 | Some (`String s) -> Some s
494 | _ -> None
495 in
496 let mime_type = match List.assoc_opt "mimeType" fields with
497 | Some (`String s) -> Some s
498 | _ -> None
499 in
500 let size = match List.assoc_opt "size" fields with
501 | Some (`Int s) -> Some s
502 | _ -> None
503 in
504 let annotations = match List.assoc_opt "annotations" fields with
505 | Some json -> Some (Annotated.annotation_of_yojson json)
506 | _ -> None
507 in
508 { name; uri; description; mime_type; size; annotations }
509 | j -> raise (Json.Of_json ("Expected object for Resource", j))
510end
511
512(** Resource Template definition *)
513module ResourceTemplate = struct
514 type t = {
515 name: string;
516 uri_template: string;
517 description: string option;
518 mime_type: string option;
519 annotations: Annotated.annotation option;
520 }
521
522 let yojson_of_t { name; uri_template; description; mime_type; annotations } =
523 let assoc = [
524 ("name", `String name);
525 ("uriTemplate", `String uri_template);
526 ] in
527 let assoc = match description with
528 | Some desc -> ("description", `String desc) :: assoc
529 | None -> assoc
530 in
531 let assoc = match mime_type with
532 | Some mime -> ("mimeType", `String mime) :: assoc
533 | None -> assoc
534 in
535 let assoc = match annotations with
536 | Some ann -> ("annotations", Annotated.yojson_of_annotation ann) :: assoc
537 | None -> assoc
538 in
539 `Assoc assoc
540
541 let t_of_yojson = function
542 | `Assoc fields ->
543 let name = match List.assoc_opt "name" fields with
544 | Some (`String s) -> s
545 | _ -> raise (Json.Of_json ("Missing or invalid 'name' field", `Assoc fields))
546 in
547 let uri_template = match List.assoc_opt "uriTemplate" fields with
548 | Some (`String s) -> s
549 | _ -> raise (Json.Of_json ("Missing or invalid 'uriTemplate' field", `Assoc fields))
550 in
551 let description = match List.assoc_opt "description" fields with
552 | Some (`String s) -> Some s
553 | _ -> None
554 in
555 let mime_type = match List.assoc_opt "mimeType" fields with
556 | Some (`String s) -> Some s
557 | _ -> None
558 in
559 let annotations = match List.assoc_opt "annotations" fields with
560 | Some json -> Some (Annotated.annotation_of_yojson json)
561 | _ -> None
562 in
563 { name; uri_template; description; mime_type; annotations }
564 | j -> raise (Json.Of_json ("Expected object for ResourceTemplate", j))
565end
566
567(** Resource Reference *)
568module ResourceReference = struct
569 type t = {
570 uri: string;
571 }
572
573 let yojson_of_t { uri } =
574 `Assoc [
575 ("type", `String "ref/resource");
576 ("uri", `String uri);
577 ]
578
579 let t_of_yojson = function
580 | `Assoc fields ->
581 let _ = match List.assoc_opt "type" fields with
582 | Some (`String "ref/resource") -> ()
583 | _ -> raise (Json.Of_json ("Missing or invalid 'type' field", `Assoc fields))
584 in
585 let uri = match List.assoc_opt "uri" fields with
586 | Some (`String s) -> s
587 | _ -> raise (Json.Of_json ("Missing or invalid 'uri' field", `Assoc fields))
588 in
589 { uri }
590 | j -> raise (Json.Of_json ("Expected object for ResourceReference", j))
591end
592
593(** Prompt Reference *)
594module PromptReference = struct
595 type t = {
596 name: string;
597 }
598
599 let yojson_of_t { name } =
600 `Assoc [
601 ("type", `String "ref/prompt");
602 ("name", `String name);
603 ]
604
605 let t_of_yojson = function
606 | `Assoc fields ->
607 let _ = match List.assoc_opt "type" fields with
608 | Some (`String "ref/prompt") -> ()
609 | _ -> raise (Json.Of_json ("Missing or invalid 'type' field", `Assoc fields))
610 in
611 let name = match List.assoc_opt "name" fields with
612 | Some (`String s) -> s
613 | _ -> raise (Json.Of_json ("Missing or invalid 'name' field", `Assoc fields))
614 in
615 { name }
616 | j -> raise (Json.Of_json ("Expected object for PromptReference", j))
617end
618
619(** Completion support *)
620module Completion = struct
621
622 module Argument = struct
623 type t = {
624 name: string;
625 value: string;
626 }
627
628 let yojson_of_t { name; value } =
629 `Assoc [
630 ("name", `String name);
631 ("value", `String value);
632 ]
633
634 let t_of_yojson = function
635 | `Assoc fields ->
636 let name = match List.assoc_opt "name" fields with
637 | Some (`String s) -> s
638 | _ -> raise (Json.Of_json ("Missing or invalid 'name' field", `Assoc fields))
639 in
640 let value = match List.assoc_opt "value" fields with
641 | Some (`String s) -> s
642 | _ -> raise (Json.Of_json ("Missing or invalid 'value' field", `Assoc fields))
643 in
644 { name; value }
645 | j -> raise (Json.Of_json ("Expected object for Completion.Argument", j))
646 end
647
648 module Request = struct
649 type reference = [ `Prompt of PromptReference.t | `Resource of ResourceReference.t ]
650
651 type t = {
652 argument: Argument.t;
653 ref: reference;
654 }
655
656 let yojson_of_reference = function
657 | `Prompt p -> PromptReference.yojson_of_t p
658 | `Resource r -> ResourceReference.yojson_of_t r
659
660 let reference_of_yojson = function
661 | `Assoc fields ->
662 (match List.assoc_opt "type" fields with
663 | Some (`String "ref/prompt") -> `Prompt (PromptReference.t_of_yojson (`Assoc fields))
664 | Some (`String "ref/resource") -> `Resource (ResourceReference.t_of_yojson (`Assoc fields))
665 | _ -> raise (Json.Of_json ("Invalid or missing reference type", `Assoc fields)))
666 | j -> raise (Json.Of_json ("Expected object for reference", j))
667
668 let yojson_of_t { argument; ref } =
669 `Assoc [
670 ("argument", Argument.yojson_of_t argument);
671 ("ref", yojson_of_reference ref);
672 ]
673
674 let t_of_yojson = function
675 | `Assoc fields ->
676 let argument = match List.assoc_opt "argument" fields with
677 | Some json -> Argument.t_of_yojson json
678 | _ -> raise (Json.Of_json ("Missing argument field", `Assoc fields))
679 in
680 let ref = match List.assoc_opt "ref" fields with
681 | Some json -> reference_of_yojson json
682 | _ -> raise (Json.Of_json ("Missing ref field", `Assoc fields))
683 in
684 { argument; ref }
685 | j -> raise (Json.Of_json ("Expected object for Completion.Request", j))
686
687 let create ~argument ~ref =
688 { argument; ref }
689
690 let to_params t =
691 yojson_of_t t
692 end
693
694 module Result = struct
695 type completion = {
696 values: string list;
697 has_more: bool option;
698 total: int option;
699 }
700
701 type t = {
702 completion: completion;
703 meta: Json.t option;
704 }
705
706 let yojson_of_completion { values; has_more; total } =
707 let assoc = [
708 ("values", `List (List.map (fun s -> `String s) values));
709 ] in
710 let assoc = match has_more with
711 | Some b -> ("hasMore", `Bool b) :: assoc
712 | None -> assoc
713 in
714 let assoc = match total with
715 | Some n -> ("total", `Int n) :: assoc
716 | None -> assoc
717 in
718 `Assoc assoc
719
720 let completion_of_yojson = function
721 | `Assoc fields ->
722 let values = match List.assoc_opt "values" fields with
723 | Some (`List items) ->
724 List.map (function
725 | `String s -> s
726 | _ -> raise (Json.Of_json ("Expected string in values array", `List items))
727 ) items
728 | _ -> raise (Json.Of_json ("Missing or invalid 'values' field", `Assoc fields))
729 in
730 let has_more = match List.assoc_opt "hasMore" fields with
731 | Some (`Bool b) -> Some b
732 | None -> None
733 | _ -> raise (Json.Of_json ("Invalid 'hasMore' field", `Assoc fields))
734 in
735 let total = match List.assoc_opt "total" fields with
736 | Some (`Int n) -> Some n
737 | None -> None
738 | _ -> raise (Json.Of_json ("Invalid 'total' field", `Assoc fields))
739 in
740 { values; has_more; total }
741 | j -> raise (Json.Of_json ("Expected object for completion", j))
742
743 let yojson_of_t { completion; meta } =
744 let assoc = [
745 ("completion", yojson_of_completion completion);
746 ] in
747 let assoc = match meta with
748 | Some meta_json -> ("_meta", meta_json) :: assoc
749 | None -> assoc
750 in
751 `Assoc assoc
752
753 let t_of_yojson = function
754 | `Assoc fields ->
755 let completion = match List.assoc_opt "completion" fields with
756 | Some json -> completion_of_yojson json
757 | _ -> raise (Json.Of_json ("Missing completion field", `Assoc fields))
758 in
759 let meta = List.assoc_opt "_meta" fields in
760 { completion; meta }
761 | j -> raise (Json.Of_json ("Expected object for Completion.Result", j))
762
763 let create ~completion ?meta () =
764 { completion; meta }
765
766 let to_result t =
767 yojson_of_t t
768 end
769end
770
771(* Message types *)
772
773module PromptMessage = struct
774 type t = {
775 role: Role.t;
776 content: content;
777 }
778
779 let yojson_of_t { role; content } =
780 `Assoc [
781 ("role", Role.yojson_of_t role);
782 ("content", yojson_of_content content);
783 ]
784
785 let t_of_yojson = function
786 | `Assoc fields ->
787 let role = match List.assoc_opt "role" fields with
788 | Some json -> Role.t_of_yojson json
789 | None -> raise (Json.Of_json ("Missing role field", `Assoc fields))
790 in
791 let content = match List.assoc_opt "content" fields with
792 | Some json -> content_of_yojson json
793 | None -> raise (Json.Of_json ("Missing content field", `Assoc fields))
794 in
795 { role; content }
796 | j -> raise (Json.Of_json ("Expected object for PromptMessage", j))
797end
798
799module SamplingMessage = struct
800 type t = {
801 role: Role.t;
802 content: [ `Text of TextContent.t | `Image of ImageContent.t ];
803 }
804
805 let yojson_of_t { role; content } =
806 let content_json = match content with
807 | `Text t -> TextContent.yojson_of_t t
808 | `Image i -> ImageContent.yojson_of_t i
809 in
810 `Assoc [
811 ("role", Role.yojson_of_t role);
812 ("content", content_json);
813 ]
814
815 let t_of_yojson = function
816 | `Assoc fields ->
817 let role = match List.assoc_opt "role" fields with
818 | Some json -> Role.t_of_yojson json
819 | None -> raise (Json.Of_json ("Missing role field", `Assoc fields))
820 in
821 let content = match List.assoc_opt "content" fields with
822 | Some (`Assoc content_fields) ->
823 (match List.assoc_opt "type" content_fields with
824 | Some (`String "text") -> `Text (TextContent.t_of_yojson (`Assoc content_fields))
825 | Some (`String "image") -> `Image (ImageContent.t_of_yojson (`Assoc content_fields))
826 | _ -> raise (Json.Of_json ("Invalid content type", `Assoc content_fields)))
827 | _ -> raise (Json.Of_json ("Missing or invalid content field", `Assoc fields))
828 in
829 { role; content }
830 | j -> raise (Json.Of_json ("Expected object for SamplingMessage", j))
831end
832
833(* Implementation info *)
834
835module Implementation = struct
836 type t = {
837 name: string;
838 version: string;
839 }
840
841 let yojson_of_t { name; version } =
842 `Assoc [
843 ("name", `String name);
844 ("version", `String version);
845 ]
846
847 let t_of_yojson = function
848 | `Assoc fields ->
849 let name = match List.assoc_opt "name" fields with
850 | Some (`String s) -> s
851 | _ -> raise (Json.Of_json ("Missing or invalid 'name' field", `Assoc fields))
852 in
853 let version = match List.assoc_opt "version" fields with
854 | Some (`String s) -> s
855 | _ -> raise (Json.Of_json ("Missing or invalid 'version' field", `Assoc fields))
856 in
857 { name; version }
858 | j -> raise (Json.Of_json ("Expected object for Implementation", j))
859end
860
861(* JSONRPC Message types *)
862
863
864module JSONRPCMessage = struct
865 type notification = {
866 method_: string;
867 params: Json.t option;
868 }
869
870 type request = {
871 id: RequestId.t;
872 method_: string;
873 params: Json.t option;
874 progress_token: ProgressToken.t option;
875 }
876
877 type response = {
878 id: RequestId.t;
879 result: Json.t;
880 }
881
882 type error = {
883 id: RequestId.t;
884 code: int;
885 message: string;
886 data: Json.t option;
887 }
888
889 type t =
890 | Notification of notification
891 | Request of request
892 | Response of response
893 | Error of error
894
895 let yojson_of_notification (n: notification) =
896 let assoc = [
897 ("jsonrpc", `String "2.0");
898 ("method", `String n.method_);
899 ] in
900 let assoc = match n.params with
901 | Some params -> ("params", params) :: assoc
902 | None -> assoc
903 in
904 `Assoc assoc
905
906 let yojson_of_request (r: request) =
907 let assoc = [
908 ("jsonrpc", `String "2.0");
909 ("id", Id.yojson_of_t r.id);
910 ("method", `String r.method_);
911 ] in
912 let assoc = match r.params with
913 | Some params ->
914 let params_json = match params with
915 | `Assoc fields ->
916 let fields = match r.progress_token with
917 | Some token ->
918 let meta = `Assoc [ "progressToken", ProgressToken.yojson_of_t token ] in
919 ("_meta", meta) :: fields
920 | None -> fields
921 in
922 `Assoc fields
923 | _ -> params
924 in
925 ("params", params_json) :: assoc
926 | None -> assoc
927 in
928 `Assoc assoc
929
930 let yojson_of_response (r: response) =
931 `Assoc [
932 ("jsonrpc", `String "2.0");
933 ("id", Id.yojson_of_t r.id);
934 ("result", r.result);
935 ]
936
937 let yojson_of_error (e: error) =
938 let error_assoc = [
939 ("code", `Int e.code);
940 ("message", `String e.message);
941 ] in
942 let error_assoc = match e.data with
943 | Some data -> ("data", data) :: error_assoc
944 | None -> error_assoc
945 in
946 `Assoc [
947 ("jsonrpc", `String "2.0");
948 ("id", Id.yojson_of_t e.id);
949 ("error", `Assoc error_assoc);
950 ]
951
952 let yojson_of_t = function
953 | Notification n -> yojson_of_notification n
954 | Request r -> yojson_of_request r
955 | Response r -> yojson_of_response r
956 | Error e -> yojson_of_error e
957
958 let notification_of_yojson = function
959 | `Assoc fields ->
960 let method_ = match List.assoc_opt "method" fields with
961 | Some (`String s) -> s
962 | _ -> raise (Json.Of_json ("Missing or invalid 'method' field", `Assoc fields))
963 in
964 let params = List.assoc_opt "params" fields in
965 { method_; params }
966 | j -> raise (Json.Of_json ("Expected object for notification", j))
967
968 let request_of_yojson = function
969 | `Assoc fields ->
970 let id = match List.assoc_opt "id" fields with
971 | Some id_json -> Id.t_of_yojson id_json
972 | _ -> raise (Json.Of_json ("Missing or invalid 'id' field", `Assoc fields))
973 in
974 let method_ = match List.assoc_opt "method" fields with
975 | Some (`String s) -> s
976 | _ -> raise (Json.Of_json ("Missing or invalid 'method' field", `Assoc fields))
977 in
978 let params = List.assoc_opt "params" fields in
979 let progress_token =
980 match params with
981 | Some (`Assoc param_fields) ->
982 (match List.assoc_opt "_meta" param_fields with
983 | Some (`Assoc meta_fields) ->
984 (match List.assoc_opt "progressToken" meta_fields with
985 | Some token_json -> Some (ProgressToken.t_of_yojson token_json)
986 | None -> None)
987 | _ -> None)
988 | _ -> None
989 in
990 { id; method_; params; progress_token }
991 | j -> raise (Json.Of_json ("Expected object for request", j))
992
993 let response_of_yojson = function
994 | `Assoc fields ->
995 let id = match List.assoc_opt "id" fields with
996 | Some id_json -> Id.t_of_yojson id_json
997 | _ -> raise (Json.Of_json ("Missing or invalid 'id' field", `Assoc fields))
998 in
999 let result = match List.assoc_opt "result" fields with
1000 | Some result -> result
1001 | _ -> raise (Json.Of_json ("Missing 'result' field", `Assoc fields))
1002 in
1003 { id; result }
1004 | j -> raise (Json.Of_json ("Expected object for response", j))
1005
1006 let error_of_yojson = function
1007 | `Assoc fields ->
1008 let id = match List.assoc_opt "id" fields with
1009 | Some id_json -> Id.t_of_yojson id_json
1010 | _ -> raise (Json.Of_json ("Missing or invalid 'id' field", `Assoc fields))
1011 in
1012 let error = match List.assoc_opt "error" fields with
1013 | Some (`Assoc error_fields) -> error_fields
1014 | _ -> raise (Json.Of_json ("Missing or invalid 'error' field", `Assoc fields))
1015 in
1016 let code = match List.assoc_opt "code" error with
1017 | Some (`Int code) -> code
1018 | _ -> raise (Json.Of_json ("Missing or invalid 'code' field in error", `Assoc error))
1019 in
1020 let message = match List.assoc_opt "message" error with
1021 | Some (`String msg) -> msg
1022 | _ -> raise (Json.Of_json ("Missing or invalid 'message' field in error", `Assoc error))
1023 in
1024 let data = List.assoc_opt "data" error in
1025 { id; code; message; data }
1026 | j -> raise (Json.Of_json ("Expected object for error", j))
1027
1028 let t_of_yojson json =
1029 match json with
1030 | `Assoc fields ->
1031 let _jsonrpc = match List.assoc_opt "jsonrpc" fields with
1032 | Some (`String "2.0") -> ()
1033 | _ -> raise (Json.Of_json ("Missing or invalid 'jsonrpc' field", json))
1034 in
1035 if List.mem_assoc "method" fields then
1036 if List.mem_assoc "id" fields then
1037 Request (request_of_yojson json)
1038 else
1039 Notification (notification_of_yojson json)
1040 else if List.mem_assoc "result" fields then
1041 Response (response_of_yojson json)
1042 else if List.mem_assoc "error" fields then
1043 Error (error_of_yojson json)
1044 else
1045 raise (Json.Of_json ("Invalid JSONRPC message format", json))
1046 | j -> raise (Json.Of_json ("Expected object for JSONRPC message", j))
1047
1048 let create_notification ?(params=None) ~method_ () =
1049 Notification { method_; params }
1050
1051 let create_request ?(params=None) ?(progress_token=None) ~id ~method_ () =
1052 Request { id; method_; params; progress_token }
1053
1054 let create_response ~id ~result =
1055 Response { id; result }
1056
1057 let create_error ~id ~code ~message ?(data=None) () =
1058 Error { id; code; message; data }
1059end
1060
1061(* MCP-specific request/response types *)
1062
1063module Initialize = struct
1064 module Request = struct
1065 type t = {
1066 capabilities: Json.t; (* ClientCapabilities *)
1067 client_info: Implementation.t;
1068 protocol_version: string;
1069 }
1070
1071 let yojson_of_t { capabilities; client_info; protocol_version } =
1072 `Assoc [
1073 ("capabilities", capabilities);
1074 ("clientInfo", Implementation.yojson_of_t client_info);
1075 ("protocolVersion", `String protocol_version);
1076 ]
1077
1078 let t_of_yojson = function
1079 | `Assoc fields ->
1080 let capabilities = match List.assoc_opt "capabilities" fields with
1081 | Some json -> json
1082 | None -> raise (Json.Of_json ("Missing capabilities field", `Assoc fields))
1083 in
1084 let client_info = match List.assoc_opt "clientInfo" fields with
1085 | Some json -> Implementation.t_of_yojson json
1086 | None -> raise (Json.Of_json ("Missing clientInfo field", `Assoc fields))
1087 in
1088 let protocol_version = match List.assoc_opt "protocolVersion" fields with
1089 | Some (`String s) -> s
1090 | _ -> raise (Json.Of_json ("Missing or invalid protocolVersion field", `Assoc fields))
1091 in
1092 { capabilities; client_info; protocol_version }
1093 | j -> raise (Json.Of_json ("Expected object for InitializeRequest", j))
1094
1095 let create ~capabilities ~client_info ~protocol_version =
1096 { capabilities; client_info; protocol_version }
1097
1098 let to_jsonrpc ~id t =
1099 let params = yojson_of_t t in
1100 JSONRPCMessage.create_request ~id ~method_:"initialize" ~params:(Some params) ()
1101 end
1102
1103 module Result = struct
1104 type t = {
1105 capabilities: Json.t; (* ServerCapabilities *)
1106 server_info: Implementation.t;
1107 protocol_version: string;
1108 instructions: string option;
1109 meta: Json.t option;
1110 }
1111
1112 let yojson_of_t { capabilities; server_info; protocol_version; instructions; meta } =
1113 let assoc = [
1114 ("capabilities", capabilities);
1115 ("serverInfo", Implementation.yojson_of_t server_info);
1116 ("protocolVersion", `String protocol_version);
1117 ] in
1118 let assoc = match instructions with
1119 | Some instr -> ("instructions", `String instr) :: assoc
1120 | None -> assoc
1121 in
1122 let assoc = match meta with
1123 | Some meta -> ("_meta", meta) :: assoc
1124 | None -> assoc
1125 in
1126 `Assoc assoc
1127
1128 let t_of_yojson = function
1129 | `Assoc fields ->
1130 let capabilities = match List.assoc_opt "capabilities" fields with
1131 | Some json -> json
1132 | None -> raise (Json.Of_json ("Missing capabilities field", `Assoc fields))
1133 in
1134 let server_info = match List.assoc_opt "serverInfo" fields with
1135 | Some json -> Implementation.t_of_yojson json
1136 | None -> raise (Json.Of_json ("Missing serverInfo field", `Assoc fields))
1137 in
1138 let protocol_version = match List.assoc_opt "protocolVersion" fields with
1139 | Some (`String s) -> s
1140 | _ -> raise (Json.Of_json ("Missing or invalid protocolVersion field", `Assoc fields))
1141 in
1142 let instructions = match List.assoc_opt "instructions" fields with
1143 | Some (`String s) -> Some s
1144 | _ -> None
1145 in
1146 let meta = List.assoc_opt "_meta" fields in
1147 { capabilities; server_info; protocol_version; instructions; meta }
1148 | j -> raise (Json.Of_json ("Expected object for InitializeResult", j))
1149
1150 let create ~capabilities ~server_info ~protocol_version ?instructions ?meta () =
1151 { capabilities; server_info; protocol_version; instructions; meta }
1152
1153 let to_jsonrpc ~id t =
1154 JSONRPCMessage.create_response ~id ~result:(yojson_of_t t)
1155 end
1156end
1157
1158module Initialized = struct
1159 module Notification = struct
1160 type t = {
1161 meta: Json.t option;
1162 }
1163
1164 let yojson_of_t { meta } =
1165 let assoc = [] in
1166 let assoc = match meta with
1167 | Some meta -> ("_meta", meta) :: assoc
1168 | None -> assoc
1169 in
1170 `Assoc assoc
1171
1172 let t_of_yojson = function
1173 | `Assoc fields ->
1174 let meta = List.assoc_opt "_meta" fields in
1175 { meta }
1176 | j -> raise (Json.Of_json ("Expected object for InitializedNotification", j))
1177
1178 let create ?meta () = { meta }
1179
1180 let to_jsonrpc t =
1181 let params = match yojson_of_t t with
1182 | `Assoc [] -> None
1183 | json -> Some json
1184 in
1185 JSONRPCMessage.create_notification ~method_:"notifications/initialized" ~params ()
1186 end
1187end
1188
1189(* Export the main interface for using the MCP protocol *)
1190
1191let parse_message json =
1192 JSONRPCMessage.t_of_yojson json
1193
1194let create_notification = JSONRPCMessage.create_notification
1195let create_request = JSONRPCMessage.create_request
1196let create_response = JSONRPCMessage.create_response
1197let create_error = JSONRPCMessage.create_error
1198
1199(* Helper functions *)
1200let create_completion_request ~id ~argument ~ref =
1201 let params = Completion.Request.to_params { argument; ref } in
1202 create_request ~id ~method_:"completion/complete" ~params:(Some params) ()
1203
1204let create_completion_response ~id ~values ?(has_more=None) ?(total=None) ?(meta=None) () =
1205 let completion = { Completion.Result.values; has_more; total } in
1206 let result = Completion.Result.to_result { completion; meta } in
1207 create_response ~id ~result