Model Context Protocol in OCaml
anil.recoil.org
1(* Mcp_message - High-level RPC message definitions for Model Context Protocol *)
2
3open Mcp
4open Jsonrpc
5
6(* Resources/List *)
7module ResourcesList = struct
8 module Request = struct
9 type t = {
10 cursor: Cursor.t option;
11 }
12
13 let yojson_of_t { cursor } =
14 let assoc = [] in
15 let assoc = match cursor with
16 | Some c -> ("cursor", Cursor.yojson_of_t c) :: assoc
17 | None -> assoc
18 in
19 `Assoc assoc
20
21 let t_of_yojson = function
22 | `Assoc fields ->
23 let cursor = List.assoc_opt "cursor" fields |> Option.map Cursor.t_of_yojson in
24 { cursor }
25 | j -> raise (Json.Of_json ("Expected object for ResourcesList.Request.t", j))
26
27 end
28
29 module Resource = struct
30 type t = {
31 uri: string;
32 name: string;
33 description: string option;
34 mime_type: string option;
35 size: int option;
36 }
37
38 let yojson_of_t { uri; name; description; mime_type; size } =
39 let assoc = [
40 ("uri", `String uri);
41 ("name", `String name);
42 ] in
43 let assoc = match description with
44 | Some desc -> ("description", `String desc) :: assoc
45 | None -> assoc
46 in
47 let assoc = match mime_type with
48 | Some mime -> ("mimeType", `String mime) :: assoc
49 | None -> assoc
50 in
51 let assoc = match size with
52 | Some s -> ("size", `Int s) :: assoc
53 | None -> assoc
54 in
55 `Assoc assoc
56
57 let t_of_yojson = function
58 | `Assoc fields ->
59 let uri = match List.assoc_opt "uri" fields with
60 | Some (`String s) -> s
61 | _ -> raise (Json.Of_json ("Missing or invalid 'uri' field", `Assoc fields))
62 in
63 let name = match List.assoc_opt "name" fields with
64 | Some (`String s) -> s
65 | _ -> raise (Json.Of_json ("Missing or invalid 'name' field", `Assoc fields))
66 in
67 let description = List.assoc_opt "description" fields |> Option.map (function
68 | `String s -> s
69 | j -> raise (Json.Of_json ("Expected string for description", j))
70 ) in
71 let mime_type = List.assoc_opt "mimeType" fields |> Option.map (function
72 | `String s -> s
73 | j -> raise (Json.Of_json ("Expected string for mimeType", j))
74 ) in
75 let size = List.assoc_opt "size" fields |> Option.map (function
76 | `Int i -> i
77 | j -> raise (Json.Of_json ("Expected int for size", j))
78 ) in
79 { uri; name; description; mime_type; size }
80 | j -> raise (Json.Of_json ("Expected object for ResourcesList.Resource.t", j))
81 end
82
83 module Response = struct
84 type t = {
85 resources: Resource.t list;
86 next_cursor: Cursor.t option;
87 }
88
89 let yojson_of_t { resources; next_cursor } =
90 let assoc = [
91 ("resources", `List (List.map Resource.yojson_of_t resources));
92 ] in
93 let assoc = match next_cursor with
94 | Some c -> ("nextCursor", Cursor.yojson_of_t c) :: assoc
95 | None -> assoc
96 in
97 `Assoc assoc
98
99 let t_of_yojson = function
100 | `Assoc fields ->
101 let resources = match List.assoc_opt "resources" fields with
102 | Some (`List items) -> List.map Resource.t_of_yojson items
103 | _ -> raise (Json.Of_json ("Missing or invalid 'resources' field", `Assoc fields))
104 in
105 let next_cursor = List.assoc_opt "nextCursor" fields |> Option.map Cursor.t_of_yojson in
106 { resources; next_cursor }
107 | j -> raise (Json.Of_json ("Expected object for ResourcesList.Response.t", j))
108
109 end
110
111 (* Request/response creation helpers *)
112 let create_request ?cursor ?id () =
113 let id = match id with
114 | Some i -> i
115 | None -> `Int (Random.int 10000)
116 in
117 let params = Request.yojson_of_t { cursor } in
118 JSONRPCMessage.create_request ~id ~meth:Method.ResourcesList ~params:(Some params) ()
119
120 let create_response ~id ~resources ?next_cursor () =
121 let result = Response.yojson_of_t { resources; next_cursor } in
122 JSONRPCMessage.create_response ~id ~result
123end
124
125(* Resources/Read *)
126module ResourcesRead = struct
127 module Request = struct
128 type t = {
129 uri: string;
130 }
131
132 let yojson_of_t { uri } =
133 `Assoc [
134 ("uri", `String uri);
135 ]
136
137 let t_of_yojson = function
138 | `Assoc fields ->
139 let uri = match List.assoc_opt "uri" fields with
140 | Some (`String s) -> s
141 | _ -> raise (Json.Of_json ("Missing or invalid 'uri' field", `Assoc fields))
142 in
143 { uri }
144 | j -> raise (Json.Of_json ("Expected object for ResourcesRead.Request.t", j))
145
146 end
147
148 module ResourceContent = struct
149 type t =
150 | TextResource of TextResourceContents.t
151 | BlobResource of BlobResourceContents.t
152
153 let yojson_of_t = function
154 | TextResource tr -> TextResourceContents.yojson_of_t tr
155 | BlobResource br -> BlobResourceContents.yojson_of_t br
156
157 let t_of_yojson json =
158 match json with
159 | `Assoc fields ->
160 if List.mem_assoc "text" fields then
161 TextResource (TextResourceContents.t_of_yojson json)
162 else if List.mem_assoc "blob" fields then
163 BlobResource (BlobResourceContents.t_of_yojson json)
164 else
165 raise (Json.Of_json ("Invalid resource content", json))
166 | j -> raise (Json.Of_json ("Expected object for ResourcesRead.ResourceContent.t", j))
167
168 end
169
170 module Response = struct
171 type t = {
172 contents: ResourceContent.t list;
173 }
174
175 let yojson_of_t { contents } =
176 `Assoc [
177 ("contents", `List (List.map ResourceContent.yojson_of_t contents));
178 ]
179
180 let t_of_yojson = function
181 | `Assoc fields ->
182 let contents = match List.assoc_opt "contents" fields with
183 | Some (`List items) -> List.map ResourceContent.t_of_yojson items
184 | _ -> raise (Json.Of_json ("Missing or invalid 'contents' field", `Assoc fields))
185 in
186 { contents }
187 | j -> raise (Json.Of_json ("Expected object for ResourcesRead.Response.t", j))
188
189 end
190
191 (* Request/response creation helpers *)
192 let create_request ~uri ?id () =
193 let id = match id with
194 | Some i -> i
195 | None -> `Int (Random.int 10000)
196 in
197 let params = Request.yojson_of_t { uri } in
198 JSONRPCMessage.create_request ~id ~meth:Method.ResourcesRead ~params:(Some params) ()
199
200 let create_response ~id ~contents () =
201 let result = Response.yojson_of_t { contents } in
202 JSONRPCMessage.create_response ~id ~result
203end
204
205(* Tools/List *)
206module ToolsList = struct
207 module Request = struct
208 type t = {
209 cursor: Cursor.t option;
210 }
211
212 let yojson_of_t { cursor } =
213 let assoc = [] in
214 let assoc = match cursor with
215 | Some c -> ("cursor", Cursor.yojson_of_t c) :: assoc
216 | None -> assoc
217 in
218 `Assoc assoc
219
220 let t_of_yojson = function
221 | `Assoc fields ->
222 let cursor = List.assoc_opt "cursor" fields |> Option.map Cursor.t_of_yojson in
223 { cursor }
224 | j -> raise (Json.Of_json ("Expected object for ToolsList.Request.t", j))
225
226 end
227
228 module Tool = struct
229 type t = {
230 name: string;
231 description: string option;
232 input_schema: Json.t;
233 annotations: Json.t option;
234 }
235
236 let yojson_of_t { name; description; input_schema; annotations } =
237 let assoc = [
238 ("name", `String name);
239 ("inputSchema", input_schema);
240 ] in
241 let assoc = match description with
242 | Some desc -> ("description", `String desc) :: assoc
243 | None -> assoc
244 in
245 let assoc = match annotations with
246 | Some anno -> ("annotations", anno) :: assoc
247 | None -> assoc
248 in
249 `Assoc assoc
250
251 let t_of_yojson = function
252 | `Assoc fields ->
253 let name = match List.assoc_opt "name" fields with
254 | Some (`String s) -> s
255 | _ -> raise (Json.Of_json ("Missing or invalid 'name' field", `Assoc fields))
256 in
257 let description = List.assoc_opt "description" fields |> Option.map (function
258 | `String s -> s
259 | j -> raise (Json.Of_json ("Expected string for description", j))
260 ) in
261 let input_schema = match List.assoc_opt "inputSchema" fields with
262 | Some schema -> schema
263 | None -> raise (Json.Of_json ("Missing 'inputSchema' field", `Assoc fields))
264 in
265 let annotations = List.assoc_opt "annotations" fields in
266 { name; description; input_schema; annotations }
267 | j -> raise (Json.Of_json ("Expected object for ToolsList.Tool.t", j))
268
269 end
270
271 module Response = struct
272 type t = {
273 tools: Tool.t list;
274 next_cursor: Cursor.t option;
275 }
276
277 let yojson_of_t { tools; next_cursor } =
278 let assoc = [
279 ("tools", `List (List.map Tool.yojson_of_t tools));
280 ] in
281 let assoc = match next_cursor with
282 | Some c -> ("nextCursor", Cursor.yojson_of_t c) :: assoc
283 | None -> assoc
284 in
285 `Assoc assoc
286
287 let t_of_yojson = function
288 | `Assoc fields ->
289 let tools = match List.assoc_opt "tools" fields with
290 | Some (`List items) -> List.map Tool.t_of_yojson items
291 | _ -> raise (Json.Of_json ("Missing or invalid 'tools' field", `Assoc fields))
292 in
293 let next_cursor = List.assoc_opt "nextCursor" fields |> Option.map Cursor.t_of_yojson in
294 { tools; next_cursor }
295 | j -> raise (Json.Of_json ("Expected object for ToolsList.Response.t", j))
296
297 end
298
299 (* Request/response creation helpers *)
300 let create_request ?cursor ?id () =
301 let id = match id with
302 | Some i -> i
303 | None -> `Int (Random.int 10000)
304 in
305 let params = Request.yojson_of_t { cursor } in
306 JSONRPCMessage.create_request ~id ~meth:Method.ToolsList ~params:(Some params) ()
307
308 let create_response ~id ~tools ?next_cursor () =
309 let result = Response.yojson_of_t { tools; next_cursor } in
310 JSONRPCMessage.create_response ~id ~result
311end
312
313(* Tools/Call *)
314module ToolsCall = struct
315 module Request = struct
316 type t = {
317 name: string;
318 arguments: Json.t;
319 }
320
321 let yojson_of_t { name; arguments } =
322 `Assoc [
323 ("name", `String name);
324 ("arguments", arguments);
325 ]
326
327 let t_of_yojson = function
328 | `Assoc fields ->
329 let name = match List.assoc_opt "name" fields with
330 | Some (`String s) -> s
331 | _ -> raise (Json.Of_json ("Missing or invalid 'name' field", `Assoc fields))
332 in
333 let arguments = match List.assoc_opt "arguments" fields with
334 | Some json -> json
335 | None -> raise (Json.Of_json ("Missing 'arguments' field", `Assoc fields))
336 in
337 { name; arguments }
338 | j -> raise (Json.Of_json ("Expected object for ToolsCall.Request.t", j))
339
340 end
341
342 module ToolContent = struct
343 type t =
344 | Text of TextContent.t
345 | Image of ImageContent.t
346 | Audio of AudioContent.t
347 | Resource of EmbeddedResource.t
348
349 let yojson_of_t = function
350 | Text t -> TextContent.yojson_of_t t
351 | Image i -> ImageContent.yojson_of_t i
352 | Audio a -> AudioContent.yojson_of_t a
353 | Resource r -> EmbeddedResource.yojson_of_t r
354
355 let t_of_yojson json =
356 match json with
357 | `Assoc fields ->
358 (match List.assoc_opt "type" fields with
359 | Some (`String "text") -> Text (TextContent.t_of_yojson json)
360 | Some (`String "image") -> Image (ImageContent.t_of_yojson json)
361 | Some (`String "audio") -> Audio (AudioContent.t_of_yojson json)
362 | Some (`String "resource") -> Resource (EmbeddedResource.t_of_yojson json)
363 | _ -> raise (Json.Of_json ("Invalid or missing content type", json)))
364 | j -> raise (Json.Of_json ("Expected object for ToolsCall.ToolContent.t", j))
365
366 end
367
368 module Response = struct
369 type t = {
370 content: ToolContent.t list;
371 is_error: bool;
372 }
373
374 let yojson_of_t { content; is_error } =
375 `Assoc [
376 ("content", `List (List.map ToolContent.yojson_of_t content));
377 ("isError", `Bool is_error);
378 ]
379
380 let t_of_yojson = function
381 | `Assoc fields ->
382 let content = match List.assoc_opt "content" fields with
383 | Some (`List items) -> List.map ToolContent.t_of_yojson items
384 | _ -> raise (Json.Of_json ("Missing or invalid 'content' field", `Assoc fields))
385 in
386 let is_error = match List.assoc_opt "isError" fields with
387 | Some (`Bool b) -> b
388 | _ -> false
389 in
390 { content; is_error }
391 | j -> raise (Json.Of_json ("Expected object for ToolsCall.Response.t", j))
392
393 end
394
395 (* Request/response creation helpers *)
396 let create_request ~name ~arguments ?id () =
397 let id = match id with
398 | Some i -> i
399 | None -> `Int (Random.int 10000)
400 in
401 let params = Request.yojson_of_t { name; arguments } in
402 JSONRPCMessage.create_request ~id ~meth:Method.ToolsCall ~params:(Some params) ()
403
404 let create_response ~id ~content ~is_error () =
405 let result = Response.yojson_of_t { content; is_error } in
406 JSONRPCMessage.create_response ~id ~result
407end
408
409(* Prompts/List *)
410module PromptsList = struct
411 module PromptArgument = struct
412 type t = {
413 name: string;
414 description: string option;
415 required: bool;
416 }
417
418 let yojson_of_t { name; description; required } =
419 let assoc = [
420 ("name", `String name);
421 ] in
422 let assoc = match description with
423 | Some desc -> ("description", `String desc) :: assoc
424 | None -> assoc
425 in
426 let assoc = if required then
427 ("required", `Bool true) :: assoc
428 else
429 assoc
430 in
431 `Assoc assoc
432
433 let t_of_yojson = function
434 | `Assoc fields ->
435 let name = match List.assoc_opt "name" fields with
436 | Some (`String s) -> s
437 | _ -> raise (Json.Of_json ("Missing or invalid 'name' field", `Assoc fields))
438 in
439 let description = List.assoc_opt "description" fields |> Option.map (function
440 | `String s -> s
441 | j -> raise (Json.Of_json ("Expected string for description", j))
442 ) in
443 let required = match List.assoc_opt "required" fields with
444 | Some (`Bool b) -> b
445 | _ -> false
446 in
447 { name; description; required }
448 | j -> raise (Json.Of_json ("Expected object for PromptsList.PromptArgument.t", j))
449
450 end
451
452 module Prompt = struct
453 type t = {
454 name: string;
455 description: string option;
456 arguments: PromptArgument.t list;
457 }
458
459 let yojson_of_t { name; description; arguments } =
460 let assoc = [
461 ("name", `String name);
462 ] in
463 let assoc = match description with
464 | Some desc -> ("description", `String desc) :: assoc
465 | None -> assoc
466 in
467 let assoc = if arguments <> [] then
468 ("arguments", `List (List.map PromptArgument.yojson_of_t arguments)) :: assoc
469 else
470 assoc
471 in
472 `Assoc assoc
473
474 let t_of_yojson = function
475 | `Assoc fields ->
476 let name = match List.assoc_opt "name" fields with
477 | Some (`String s) -> s
478 | _ -> raise (Json.Of_json ("Missing or invalid 'name' field", `Assoc fields))
479 in
480 let description = List.assoc_opt "description" fields |> Option.map (function
481 | `String s -> s
482 | j -> raise (Json.Of_json ("Expected string for description", j))
483 ) in
484 let arguments = match List.assoc_opt "arguments" fields with
485 | Some (`List items) -> List.map PromptArgument.t_of_yojson items
486 | _ -> []
487 in
488 { name; description; arguments }
489 | j -> raise (Json.Of_json ("Expected object for PromptsList.Prompt.t", j))
490
491 end
492
493 module Request = struct
494 type t = {
495 cursor: Cursor.t option;
496 }
497
498 let yojson_of_t { cursor } =
499 let assoc = [] in
500 let assoc = match cursor with
501 | Some c -> ("cursor", Cursor.yojson_of_t c) :: assoc
502 | None -> assoc
503 in
504 `Assoc assoc
505
506 let t_of_yojson = function
507 | `Assoc fields ->
508 let cursor = List.assoc_opt "cursor" fields |> Option.map Cursor.t_of_yojson in
509 { cursor }
510 | j -> raise (Json.Of_json ("Expected object for PromptsList.Request.t", j))
511
512 end
513
514 module Response = struct
515 type t = {
516 prompts: Prompt.t list;
517 next_cursor: Cursor.t option;
518 }
519
520 let yojson_of_t { prompts; next_cursor } =
521 let assoc = [
522 ("prompts", `List (List.map Prompt.yojson_of_t prompts));
523 ] in
524 let assoc = match next_cursor with
525 | Some c -> ("nextCursor", Cursor.yojson_of_t c) :: assoc
526 | None -> assoc
527 in
528 `Assoc assoc
529
530 let t_of_yojson = function
531 | `Assoc fields ->
532 let prompts = match List.assoc_opt "prompts" fields with
533 | Some (`List items) -> List.map Prompt.t_of_yojson items
534 | _ -> raise (Json.Of_json ("Missing or invalid 'prompts' field", `Assoc fields))
535 in
536 let next_cursor = List.assoc_opt "nextCursor" fields |> Option.map Cursor.t_of_yojson in
537 { prompts; next_cursor }
538 | j -> raise (Json.Of_json ("Expected object for PromptsList.Response.t", j))
539
540 end
541
542 (* Request/response creation helpers *)
543 let create_request ?cursor ?id () =
544 let id = match id with
545 | Some i -> i
546 | None -> `Int (Random.int 10000)
547 in
548 let params = Request.yojson_of_t { cursor } in
549 JSONRPCMessage.create_request ~id ~meth:Method.PromptsList ~params:(Some params) ()
550
551 let create_response ~id ~prompts ?next_cursor () =
552 let result = Response.yojson_of_t { prompts; next_cursor } in
553 JSONRPCMessage.create_response ~id ~result
554end
555
556(* Prompts/Get *)
557module PromptsGet = struct
558 module Request = struct
559 type t = {
560 name: string;
561 arguments: (string * string) list;
562 }
563
564 let yojson_of_t { name; arguments } =
565 let args_json = `Assoc (List.map (fun (k, v) -> (k, `String v)) arguments) in
566 `Assoc [
567 ("name", `String name);
568 ("arguments", args_json);
569 ]
570
571 let t_of_yojson = function
572 | `Assoc fields ->
573 let name = match List.assoc_opt "name" fields with
574 | Some (`String s) -> s
575 | _ -> raise (Json.Of_json ("Missing or invalid 'name' field", `Assoc fields))
576 in
577 let arguments = match List.assoc_opt "arguments" fields with
578 | Some (`Assoc args) ->
579 List.map (fun (k, v) ->
580 match v with
581 | `String s -> (k, s)
582 | _ -> raise (Json.Of_json ("Expected string value for argument", v))
583 ) args
584 | _ -> []
585 in
586 { name; arguments }
587 | j -> raise (Json.Of_json ("Expected object for PromptsGet.Request.t", j))
588
589 end
590
591 module Response = struct
592 type t = {
593 description: string option;
594 messages: PromptMessage.t list;
595 }
596
597 let yojson_of_t { description; messages } =
598 let assoc = [
599 ("messages", `List (List.map PromptMessage.yojson_of_t messages));
600 ] in
601 let assoc = match description with
602 | Some desc -> ("description", `String desc) :: assoc
603 | None -> assoc
604 in
605 `Assoc assoc
606
607 let t_of_yojson = function
608 | `Assoc fields ->
609 let messages = match List.assoc_opt "messages" fields with
610 | Some (`List items) -> List.map PromptMessage.t_of_yojson items
611 | _ -> raise (Json.Of_json ("Missing or invalid 'messages' field", `Assoc fields))
612 in
613 let description = List.assoc_opt "description" fields |> Option.map (function
614 | `String s -> s
615 | j -> raise (Json.Of_json ("Expected string for description", j))
616 ) in
617 { description; messages }
618 | j -> raise (Json.Of_json ("Expected object for PromptsGet.Response.t", j))
619
620 end
621
622 (* Request/response creation helpers *)
623 let create_request ~name ~arguments ?id () =
624 let id = match id with
625 | Some i -> i
626 | None -> `Int (Random.int 10000)
627 in
628 let params = Request.yojson_of_t { name; arguments } in
629 JSONRPCMessage.create_request ~id ~meth:Method.PromptsGet ~params:(Some params) ()
630
631 let create_response ~id ?description ~messages () =
632 let result = Response.yojson_of_t { description; messages } in
633 JSONRPCMessage.create_response ~id ~result
634end
635
636(* List Changed Notifications *)
637module ListChanged = struct
638 (* No parameters for these notifications *)
639
640 let create_resources_notification () =
641 JSONRPCMessage.create_notification ~meth:Method.ResourcesListChanged ()
642
643 let create_tools_notification () =
644 JSONRPCMessage.create_notification ~meth:Method.ToolsListChanged ()
645
646 let create_prompts_notification () =
647 JSONRPCMessage.create_notification ~meth:Method.PromptsListChanged ()
648end
649
650(* Resource Updated Notification *)
651module ResourceUpdated = struct
652 module Notification = struct
653 type t = {
654 uri: string;
655 }
656
657 let yojson_of_t { uri } =
658 `Assoc [
659 ("uri", `String uri);
660 ]
661
662 let t_of_yojson = function
663 | `Assoc fields ->
664 let uri = match List.assoc_opt "uri" fields with
665 | Some (`String s) -> s
666 | _ -> raise (Json.Of_json ("Missing or invalid 'uri' field", `Assoc fields))
667 in
668 { uri }
669 | j -> raise (Json.Of_json ("Expected object for ResourceUpdated.Notification.t", j))
670
671 end
672
673 let create_notification ~uri () =
674 let params = Notification.yojson_of_t { uri } in
675 JSONRPCMessage.create_notification ~meth:Method.ResourcesUpdated ~params:(Some params) ()
676end
677
678(* Progress Notification *)
679module Progress = struct
680 module Notification = struct
681 type t = {
682 progress: float;
683 total: float;
684 progress_token: ProgressToken.t;
685 }
686
687 let yojson_of_t { progress; total; progress_token } =
688 `Assoc [
689 ("progress", `Float progress);
690 ("total", `Float total);
691 ("progressToken", ProgressToken.yojson_of_t progress_token);
692 ]
693
694 let t_of_yojson = function
695 | `Assoc fields ->
696 let progress = match List.assoc_opt "progress" fields with
697 | Some (`Float f) -> f
698 | _ -> raise (Json.Of_json ("Missing or invalid 'progress' field", `Assoc fields))
699 in
700 let total = match List.assoc_opt "total" fields with
701 | Some (`Float f) -> f
702 | _ -> raise (Json.Of_json ("Missing or invalid 'total' field", `Assoc fields))
703 in
704 let progress_token = match List.assoc_opt "progressToken" fields with
705 | Some token -> ProgressToken.t_of_yojson token
706 | _ -> raise (Json.Of_json ("Missing or invalid 'progressToken' field", `Assoc fields))
707 in
708 { progress; total; progress_token }
709 | j -> raise (Json.Of_json ("Expected object for Progress.Notification.t", j))
710
711 end
712
713 let create_notification ~progress ~total ~progress_token () =
714 let params = Notification.yojson_of_t { progress; total; progress_token } in
715 JSONRPCMessage.create_notification ~meth:Method.Progress ~params:(Some params) ()
716end
717
718(* Type aliases for backward compatibility *)
719type request = ResourcesList.Request.t
720type response = ResourcesList.Response.t
721type resource = ResourcesList.Resource.t
722type resource_content = ResourcesRead.ResourceContent.t
723type tool = ToolsList.Tool.t
724type tool_content = ToolsCall.ToolContent.t
725type prompt = PromptsList.Prompt.t
726type prompt_argument = PromptsList.PromptArgument.t