Model Context Protocol in OCaml
anil.recoil.org
1open Jsonrpc
2
3(* Utility functions for JSON parsing *)
4module Util = struct
5 (* Extract a string field from JSON object or raise an error *)
6 let get_string_field fields name json =
7 match List.assoc_opt name fields with
8 | Some (`String s) -> s
9 | _ -> raise (Json.Of_json (Printf.sprintf "Missing or invalid '%s' field" name, json))
10
11 (* Extract an optional string field from JSON object *)
12 let get_optional_string_field fields name =
13 List.assoc_opt name fields |> Option.map (function
14 | `String s -> s
15 | j -> raise (Json.Of_json (Printf.sprintf "Expected string for %s" name, j))
16 )
17
18 (* Extract an int field from JSON object or raise an error *)
19 let get_int_field fields name json =
20 match List.assoc_opt name fields with
21 | Some (`Int i) -> i
22 | _ -> raise (Json.Of_json (Printf.sprintf "Missing or invalid '%s' field" name, json))
23
24 (* Extract a float field from JSON object or raise an error *)
25 let get_float_field fields name json =
26 match List.assoc_opt name fields with
27 | Some (`Float f) -> f
28 | _ -> raise (Json.Of_json (Printf.sprintf "Missing or invalid '%s' field" name, json))
29
30 (* Extract a boolean field from JSON object or raise an error *)
31 let get_bool_field fields name json =
32 match List.assoc_opt name fields with
33 | Some (`Bool b) -> b
34 | _ -> raise (Json.Of_json (Printf.sprintf "Missing or invalid '%s' field" name, json))
35
36 (* Extract an object field from JSON object or raise an error *)
37 let get_object_field fields name json =
38 match List.assoc_opt name fields with
39 | Some (`Assoc obj) -> obj
40 | _ -> raise (Json.Of_json (Printf.sprintf "Missing or invalid '%s' field" name, json))
41
42 (* Extract a list field from JSON object or raise an error *)
43 let get_list_field fields name json =
44 match List.assoc_opt name fields with
45 | Some (`List items) -> items
46 | _ -> raise (Json.Of_json (Printf.sprintf "Missing or invalid '%s' field" name, json))
47
48 (* Verify a specific string value in a field *)
49 let verify_string_field fields name expected_value json =
50 match List.assoc_opt name fields with
51 | Some (`String s) when s = expected_value -> ()
52 | _ -> raise (Json.Of_json (Printf.sprintf "Field '%s' missing or not equal to '%s'" name expected_value, json))
53end
54
55(* Error codes for JSON-RPC *)
56module ErrorCode = struct
57 type t =
58 | ParseError (* -32700 - Invalid JSON *)
59 | InvalidRequest (* -32600 - Invalid JSON-RPC request *)
60 | MethodNotFound (* -32601 - Method not available *)
61 | InvalidParams (* -32602 - Invalid method parameters *)
62 | InternalError (* -32603 - Internal JSON-RPC error *)
63 | ResourceNotFound (* -32002 - Custom MCP error: requested resource not found *)
64 | AuthRequired (* -32001 - Custom MCP error: authentication required *)
65 | CustomError of int (* For any other error codes *)
66
67 (* Convert the error code to its integer representation *)
68 let to_int = function
69 | ParseError -> -32700
70 | InvalidRequest -> -32600
71 | MethodNotFound -> -32601
72 | InvalidParams -> -32602
73 | InternalError -> -32603
74 | ResourceNotFound -> -32002
75 | AuthRequired -> -32001
76 | CustomError code -> code
77
78 (* Get error message for standard error codes *)
79 let to_message = function
80 | ParseError -> "Parse error"
81 | InvalidRequest -> "Invalid Request"
82 | MethodNotFound -> "Method not found"
83 | InvalidParams -> "Invalid params"
84 | InternalError -> "Internal error"
85 | ResourceNotFound -> "Resource not found"
86 | AuthRequired -> "Authentication required"
87 | CustomError _ -> "Error"
88end
89
90(* Protocol method types *)
91module Method = struct
92 (* Method type representing all MCP protocol methods *)
93 type t =
94 (* Initialization and lifecycle methods *)
95 | Initialize
96 | Initialized
97
98 (* Resource methods *)
99 | ResourcesList
100 | ResourcesRead
101 | ResourcesTemplatesList
102 | ResourcesSubscribe
103 | ResourcesListChanged
104 | ResourcesUpdated
105
106 (* Tool methods *)
107 | ToolsList
108 | ToolsCall
109 | ToolsListChanged
110
111 (* Prompt methods *)
112 | PromptsList
113 | PromptsGet
114 | PromptsListChanged
115
116 (* Progress notifications *)
117 | Progress
118
119 (* Convert method type to string representation *)
120 let to_string = function
121 | Initialize -> "initialize"
122 | Initialized -> "notifications/initialized"
123 | ResourcesList -> "resources/list"
124 | ResourcesRead -> "resources/read"
125 | ResourcesTemplatesList -> "resources/templates/list"
126 | ResourcesSubscribe -> "resources/subscribe"
127 | ResourcesListChanged -> "notifications/resources/list_changed"
128 | ResourcesUpdated -> "notifications/resources/updated"
129 | ToolsList -> "tools/list"
130 | ToolsCall -> "tools/call"
131 | ToolsListChanged -> "notifications/tools/list_changed"
132 | PromptsList -> "prompts/list"
133 | PromptsGet -> "prompts/get"
134 | PromptsListChanged -> "notifications/prompts/list_changed"
135 | Progress -> "notifications/progress"
136
137 (* Convert string to method type *)
138 let of_string = function
139 | "initialize" -> Initialize
140 | "notifications/initialized" -> Initialized
141 | "resources/list" -> ResourcesList
142 | "resources/read" -> ResourcesRead
143 | "resources/templates/list" -> ResourcesTemplatesList
144 | "resources/subscribe" -> ResourcesSubscribe
145 | "notifications/resources/list_changed" -> ResourcesListChanged
146 | "notifications/resources/updated" -> ResourcesUpdated
147 | "tools/list" -> ToolsList
148 | "tools/call" -> ToolsCall
149 | "notifications/tools/list_changed" -> ToolsListChanged
150 | "prompts/list" -> PromptsList
151 | "prompts/get" -> PromptsGet
152 | "notifications/prompts/list_changed" -> PromptsListChanged
153 | "notifications/progress" -> Progress
154 | s -> failwith ("Unknown MCP method: " ^ s)
155end
156
157(* Common types *)
158
159module Role = struct
160 type t = [ `User | `Assistant ]
161
162 let to_string = function
163 | `User -> "user"
164 | `Assistant -> "assistant"
165
166 let of_string = function
167 | "user" -> `User
168 | "assistant" -> `Assistant
169 | s -> raise (Json.Of_json ("Unknown role: " ^ s, `String s))
170
171 let yojson_of_t t = `String (to_string t)
172 let t_of_yojson = function
173 | `String s -> of_string s
174 | j -> raise (Json.Of_json ("Expected string for Role", j))
175end
176
177module ProgressToken = struct
178 type t = [ `String of string | `Int of int ]
179
180 include (Id : Json.Jsonable.S with type t := t)
181end
182
183module RequestId = Id
184
185module Cursor = struct
186 type t = string
187
188 let yojson_of_t t = `String t
189 let t_of_yojson = function
190 | `String s -> s
191 | j -> raise (Json.Of_json ("Expected string for Cursor", j))
192end
193
194(* Annotations *)
195
196module Annotated = struct
197 type t = {
198 annotations: annotation option;
199 }
200 and annotation = {
201 audience: Role.t list option;
202 priority: float option;
203 }
204
205 let yojson_of_annotation { audience; priority } =
206 let assoc = [] in
207 let assoc = match audience with
208 | Some audience -> ("audience", `List (List.map Role.yojson_of_t audience)) :: assoc
209 | None -> assoc
210 in
211 let assoc = match priority with
212 | Some priority -> ("priority", `Float priority) :: assoc
213 | None -> assoc
214 in
215 `Assoc assoc
216
217 let annotation_of_yojson = function
218 | `Assoc fields ->
219 let audience = List.assoc_opt "audience" fields |> Option.map (function
220 | `List items -> List.map Role.t_of_yojson items
221 | j -> raise (Json.Of_json ("Expected list for audience", j))
222 ) in
223 let priority = List.assoc_opt "priority" fields |> Option.map (function
224 | `Float f -> f
225 | j -> raise (Json.Of_json ("Expected float for priority", j))
226 ) in
227 { audience; priority }
228 | j -> raise (Json.Of_json ("Expected object for annotation", j))
229
230 let yojson_of_t { annotations } =
231 match annotations with
232 | Some annotations -> `Assoc [ "annotations", yojson_of_annotation annotations ]
233 | None -> `Assoc []
234
235 let t_of_yojson = function
236 | `Assoc fields ->
237 let annotations = List.assoc_opt "annotations" fields |> Option.map annotation_of_yojson in
238 { annotations }
239 | j -> raise (Json.Of_json ("Expected object for Annotated", j))
240end
241
242(* Content types *)
243
244module TextContent = struct
245 type t = {
246 text: string;
247 annotations: Annotated.annotation option;
248 }
249
250 let yojson_of_t { text; annotations } =
251 let assoc = [
252 ("text", `String text);
253 ("type", `String "text");
254 ] in
255 let assoc = match annotations with
256 | Some annotations -> ("annotations", Annotated.yojson_of_annotation annotations) :: assoc
257 | None -> assoc
258 in
259 `Assoc assoc
260
261 let t_of_yojson = function
262 | `Assoc fields as json ->
263 let text = Util.get_string_field fields "text" json in
264 Util.verify_string_field fields "type" "text" json;
265 let annotations = List.assoc_opt "annotations" fields |> Option.map Annotated.annotation_of_yojson in
266 { text; annotations }
267 | j -> raise (Json.Of_json ("Expected object for TextContent", j))
268end
269
270module ImageContent = struct
271 type t = {
272 data: string;
273 mime_type: string;
274 annotations: Annotated.annotation option;
275 }
276
277 let yojson_of_t { data; mime_type; annotations } =
278 let assoc = [
279 ("type", `String "image");
280 ("data", `String data);
281 ("mimeType", `String mime_type);
282 ] in
283 let assoc = match annotations with
284 | Some annotations -> ("annotations", Annotated.yojson_of_annotation annotations) :: assoc
285 | None -> assoc
286 in
287 `Assoc assoc
288
289 let t_of_yojson = function
290 | `Assoc fields as json ->
291 let data = Util.get_string_field fields "data" json in
292 let mime_type = Util.get_string_field fields "mimeType" json in
293 Util.verify_string_field fields "type" "image" json;
294 let annotations = List.assoc_opt "annotations" fields |> Option.map Annotated.annotation_of_yojson in
295 { data; mime_type; annotations }
296 | j -> raise (Json.Of_json ("Expected object for ImageContent", j))
297end
298
299module AudioContent = struct
300 type t = {
301 data: string;
302 mime_type: string;
303 annotations: Annotated.annotation option;
304 }
305
306 let yojson_of_t { data; mime_type; annotations } =
307 let assoc = [
308 ("type", `String "audio");
309 ("data", `String data);
310 ("mimeType", `String mime_type);
311 ] in
312 let assoc = match annotations with
313 | Some annotations -> ("annotations", Annotated.yojson_of_annotation annotations) :: assoc
314 | None -> assoc
315 in
316 `Assoc assoc
317
318 let t_of_yojson = function
319 | `Assoc fields as json ->
320 let data = Util.get_string_field fields "data" json in
321 let mime_type = Util.get_string_field fields "mimeType" json in
322 Util.verify_string_field fields "type" "audio" json;
323 let annotations = List.assoc_opt "annotations" fields |> Option.map Annotated.annotation_of_yojson in
324 { data; mime_type; annotations }
325 | j -> raise (Json.Of_json ("Expected object for AudioContent", j))
326end
327
328module ResourceContents = struct
329 type t = {
330 uri: string;
331 mime_type: string option;
332 }
333
334 let yojson_of_t { uri; mime_type } =
335 let assoc = [
336 ("uri", `String uri);
337 ] in
338 let assoc = match mime_type with
339 | Some mime_type -> ("mimeType", `String mime_type) :: assoc
340 | None -> assoc
341 in
342 `Assoc assoc
343
344 let t_of_yojson = function
345 | `Assoc fields as json ->
346 let uri = Util.get_string_field fields "uri" json in
347 let mime_type = Util.get_optional_string_field fields "mimeType" in
348 { uri; mime_type }
349 | j -> raise (Json.Of_json ("Expected object for ResourceContents", j))
350end
351
352module TextResourceContents = struct
353 type t = {
354 uri: string;
355 text: string;
356 mime_type: string option;
357 }
358
359 let yojson_of_t { uri; text; mime_type } =
360 let assoc = [
361 ("uri", `String uri);
362 ("text", `String text);
363 ] in
364 let assoc = match mime_type with
365 | Some mime_type -> ("mimeType", `String mime_type) :: assoc
366 | None -> assoc
367 in
368 `Assoc assoc
369
370 let t_of_yojson = function
371 | `Assoc fields as json ->
372 let uri = Util.get_string_field fields "uri" json in
373 let text = Util.get_string_field fields "text" json in
374 let mime_type = Util.get_optional_string_field fields "mimeType" in
375 { uri; text; mime_type }
376 | j -> raise (Json.Of_json ("Expected object for TextResourceContents", j))
377end
378
379module BlobResourceContents = struct
380 type t = {
381 uri: string;
382 blob: string;
383 mime_type: string option;
384 }
385
386 let yojson_of_t { uri; blob; mime_type } =
387 let assoc = [
388 ("uri", `String uri);
389 ("blob", `String blob);
390 ] in
391 let assoc = match mime_type with
392 | Some mime_type -> ("mimeType", `String mime_type) :: assoc
393 | None -> assoc
394 in
395 `Assoc assoc
396
397 let t_of_yojson = function
398 | `Assoc fields as json ->
399 let uri = Util.get_string_field fields "uri" json in
400 let blob = Util.get_string_field fields "blob" json in
401 let mime_type = Util.get_optional_string_field fields "mimeType" in
402 { uri; blob; mime_type }
403 | j -> raise (Json.Of_json ("Expected object for BlobResourceContents", j))
404end
405
406module EmbeddedResource = struct
407 type t = {
408 resource: [ `Text of TextResourceContents.t | `Blob of BlobResourceContents.t ];
409 annotations: Annotated.annotation option;
410 }
411
412 let yojson_of_t { resource; annotations } =
413 let resource_json = match resource with
414 | `Text txt -> TextResourceContents.yojson_of_t txt
415 | `Blob blob -> BlobResourceContents.yojson_of_t blob
416 in
417 let assoc = [
418 ("resource", resource_json);
419 ("type", `String "resource");
420 ] in
421 let assoc = match annotations with
422 | Some annotations -> ("annotations", Annotated.yojson_of_annotation annotations) :: assoc
423 | None -> assoc
424 in
425 `Assoc assoc
426
427 let t_of_yojson = function
428 | `Assoc fields as json ->
429 Util.verify_string_field fields "type" "resource" json;
430 let resource_fields = match List.assoc_opt "resource" fields with
431 | Some (`Assoc res_fields) -> res_fields
432 | _ -> raise (Json.Of_json ("Missing or invalid 'resource' field", json))
433 in
434 let resource =
435 if List.mem_assoc "text" resource_fields then
436 `Text (TextResourceContents.t_of_yojson (`Assoc resource_fields))
437 else if List.mem_assoc "blob" resource_fields then
438 `Blob (BlobResourceContents.t_of_yojson (`Assoc resource_fields))
439 else
440 raise (Json.Of_json ("Invalid resource content", `Assoc resource_fields))
441 in
442 let annotations = List.assoc_opt "annotations" fields |> Option.map Annotated.annotation_of_yojson in
443 { resource; annotations }
444 | j -> raise (Json.Of_json ("Expected object for EmbeddedResource", j))
445end
446
447type content =
448 | Text of TextContent.t
449 | Image of ImageContent.t
450 | Audio of AudioContent.t
451 | Resource of EmbeddedResource.t
452
453let yojson_of_content = function
454 | Text t -> TextContent.yojson_of_t t
455 | Image i -> ImageContent.yojson_of_t i
456 | Audio a -> AudioContent.yojson_of_t a
457 | Resource r -> EmbeddedResource.yojson_of_t r
458
459let content_of_yojson = function
460 | `Assoc fields ->
461 (match List.assoc_opt "type" fields with
462 | Some (`String "text") -> Text (TextContent.t_of_yojson (`Assoc fields))
463 | Some (`String "image") -> Image (ImageContent.t_of_yojson (`Assoc fields))
464 | Some (`String "audio") -> Audio (AudioContent.t_of_yojson (`Assoc fields))
465 | Some (`String "resource") -> Resource (EmbeddedResource.t_of_yojson (`Assoc fields))
466 | _ -> raise (Json.Of_json ("Invalid or missing content type", `Assoc fields)))
467 | j -> raise (Json.Of_json ("Expected object for content", j))
468
469(* Message types *)
470
471module PromptMessage = struct
472 type t = {
473 role: Role.t;
474 content: content;
475 }
476
477 let yojson_of_t { role; content } =
478 `Assoc [
479 ("role", Role.yojson_of_t role);
480 ("content", yojson_of_content content);
481 ]
482
483 let t_of_yojson = function
484 | `Assoc fields as json ->
485 let role = match List.assoc_opt "role" fields with
486 | Some json -> Role.t_of_yojson json
487 | None -> raise (Json.Of_json ("Missing role field", json))
488 in
489 let content = match List.assoc_opt "content" fields with
490 | Some json -> content_of_yojson json
491 | None -> raise (Json.Of_json ("Missing content field", json))
492 in
493 { role; content }
494 | j -> raise (Json.Of_json ("Expected object for PromptMessage", j))
495end
496
497module SamplingMessage = struct
498 type t = {
499 role: Role.t;
500 content: [ `Text of TextContent.t | `Image of ImageContent.t | `Audio of AudioContent.t ];
501 }
502
503 let yojson_of_t { role; content } =
504 let content_json = match content with
505 | `Text t -> TextContent.yojson_of_t t
506 | `Image i -> ImageContent.yojson_of_t i
507 | `Audio a -> AudioContent.yojson_of_t a
508 in
509 `Assoc [
510 ("role", Role.yojson_of_t role);
511 ("content", content_json);
512 ]
513
514 let t_of_yojson = function
515 | `Assoc fields as json ->
516 let role = match List.assoc_opt "role" fields with
517 | Some json -> Role.t_of_yojson json
518 | None -> raise (Json.Of_json ("Missing role field", json))
519 in
520 let content_obj = match List.assoc_opt "content" fields with
521 | Some (`Assoc content_fields) -> content_fields
522 | _ -> raise (Json.Of_json ("Missing or invalid content field", json))
523 in
524 let content_type = match List.assoc_opt "type" content_obj with
525 | Some (`String ty) -> ty
526 | _ -> raise (Json.Of_json ("Missing or invalid content type", `Assoc content_obj))
527 in
528 let content =
529 match content_type with
530 | "text" -> `Text (TextContent.t_of_yojson (`Assoc content_obj))
531 | "image" -> `Image (ImageContent.t_of_yojson (`Assoc content_obj))
532 | "audio" -> `Audio (AudioContent.t_of_yojson (`Assoc content_obj))
533 | _ -> raise (Json.Of_json (Printf.sprintf "Invalid content type: %s" content_type, `Assoc content_obj))
534 in
535 { role; content }
536 | j -> raise (Json.Of_json ("Expected object for SamplingMessage", j))
537end
538
539(* Implementation info *)
540
541module Implementation = struct
542 type t = {
543 name: string;
544 version: string;
545 }
546
547 let yojson_of_t { name; version } =
548 `Assoc [
549 ("name", `String name);
550 ("version", `String version);
551 ]
552
553 let t_of_yojson = function
554 | `Assoc fields as json ->
555 let name = Util.get_string_field fields "name" json in
556 let version = Util.get_string_field fields "version" json in
557 { name; version }
558 | j -> raise (Json.Of_json ("Expected object for Implementation", j))
559end
560
561(* JSONRPC Message types *)
562
563module JSONRPCMessage = struct
564 type notification = {
565 meth: Method.t;
566 params: Json.t option;
567 }
568
569 type request = {
570 id: RequestId.t;
571 meth: Method.t;
572 params: Json.t option;
573 progress_token: ProgressToken.t option;
574 }
575
576 type response = {
577 id: RequestId.t;
578 result: Json.t;
579 }
580
581 type error = {
582 id: RequestId.t;
583 code: int;
584 message: string;
585 data: Json.t option;
586 }
587
588 type t =
589 | Notification of notification
590 | Request of request
591 | Response of response
592 | Error of error
593
594 let yojson_of_notification (n: notification) =
595 let assoc = [
596 ("jsonrpc", `String "2.0");
597 ("method", `String (Method.to_string n.meth));
598 ] in
599 let assoc = match n.params with
600 | Some params -> ("params", params) :: assoc
601 | None -> assoc
602 in
603 `Assoc assoc
604
605 let yojson_of_request (r: request) =
606 let assoc = [
607 ("jsonrpc", `String "2.0");
608 ("id", Id.yojson_of_t r.id);
609 ("method", `String (Method.to_string r.meth));
610 ] in
611 let assoc = match r.params with
612 | Some params ->
613 let params_json = match params with
614 | `Assoc fields ->
615 let fields = match r.progress_token with
616 | Some token ->
617 let meta = `Assoc [ "progressToken", ProgressToken.yojson_of_t token ] in
618 ("_meta", meta) :: fields
619 | None -> fields
620 in
621 `Assoc fields
622 | _ -> params
623 in
624 ("params", params_json) :: assoc
625 | None -> assoc
626 in
627 `Assoc assoc
628
629 let yojson_of_response (r: response) =
630 `Assoc [
631 ("jsonrpc", `String "2.0");
632 ("id", Id.yojson_of_t r.id);
633 ("result", r.result);
634 ]
635
636 let yojson_of_error (e: error) =
637 let error_assoc = [
638 ("code", `Int e.code);
639 ("message", `String e.message);
640 ] in
641 let error_assoc = match e.data with
642 | Some data -> ("data", data) :: error_assoc
643 | None -> error_assoc
644 in
645 `Assoc [
646 ("jsonrpc", `String "2.0");
647 ("id", Id.yojson_of_t e.id);
648 ("error", `Assoc error_assoc);
649 ]
650
651 let yojson_of_t = function
652 | Notification n -> yojson_of_notification n
653 | Request r -> yojson_of_request r
654 | Response r -> yojson_of_response r
655 | Error e -> yojson_of_error e
656
657 let notification_of_yojson = function
658 | `Assoc fields ->
659 let meth = match List.assoc_opt "method" fields with
660 | Some (`String s) ->
661 (try Method.of_string s
662 with Failure msg -> raise (Json.Of_json (msg, `String s)))
663 | _ -> raise (Json.Of_json ("Missing or invalid 'method' field", `Assoc fields))
664 in
665 let params = List.assoc_opt "params" fields in
666 { meth; params }
667 | j -> raise (Json.Of_json ("Expected object for notification", j))
668
669 let request_of_yojson = function
670 | `Assoc fields ->
671 let id = match List.assoc_opt "id" fields with
672 | Some id_json -> Id.t_of_yojson id_json
673 | _ -> raise (Json.Of_json ("Missing or invalid 'id' field", `Assoc fields))
674 in
675 let meth = match List.assoc_opt "method" fields with
676 | Some (`String s) ->
677 (try Method.of_string s
678 with Failure msg -> raise (Json.Of_json (msg, `String s)))
679 | _ -> raise (Json.Of_json ("Missing or invalid 'method' field", `Assoc fields))
680 in
681 let params = List.assoc_opt "params" fields in
682 let progress_token =
683 match params with
684 | Some (`Assoc param_fields) ->
685 (match List.assoc_opt "_meta" param_fields with
686 | Some (`Assoc meta_fields) ->
687 (match List.assoc_opt "progressToken" meta_fields with
688 | Some token_json -> Some (ProgressToken.t_of_yojson token_json)
689 | None -> None)
690 | _ -> None)
691 | _ -> None
692 in
693 { id; meth; params; progress_token }
694 | j -> raise (Json.Of_json ("Expected object for request", j))
695
696 let response_of_yojson = function
697 | `Assoc fields ->
698 let id = match List.assoc_opt "id" fields with
699 | Some id_json -> Id.t_of_yojson id_json
700 | _ -> raise (Json.Of_json ("Missing or invalid 'id' field", `Assoc fields))
701 in
702 let result = match List.assoc_opt "result" fields with
703 | Some result -> result
704 | _ -> raise (Json.Of_json ("Missing 'result' field", `Assoc fields))
705 in
706 { id; result }
707 | j -> raise (Json.Of_json ("Expected object for response", j))
708
709 let error_of_yojson = function
710 | `Assoc fields ->
711 let id = match List.assoc_opt "id" fields with
712 | Some id_json -> Id.t_of_yojson id_json
713 | _ -> raise (Json.Of_json ("Missing or invalid 'id' field", `Assoc fields))
714 in
715 let error = match List.assoc_opt "error" fields with
716 | Some (`Assoc error_fields) -> error_fields
717 | _ -> raise (Json.Of_json ("Missing or invalid 'error' field", `Assoc fields))
718 in
719 let code = match List.assoc_opt "code" error with
720 | Some (`Int code) -> code
721 | _ -> raise (Json.Of_json ("Missing or invalid 'code' field in error", `Assoc error))
722 in
723 let message = match List.assoc_opt "message" error with
724 | Some (`String msg) -> msg
725 | _ -> raise (Json.Of_json ("Missing or invalid 'message' field in error", `Assoc error))
726 in
727 let data = List.assoc_opt "data" error in
728 { id; code; message; data }
729 | j -> raise (Json.Of_json ("Expected object for error", j))
730
731 let t_of_yojson json =
732 match json with
733 | `Assoc fields ->
734 let _jsonrpc = match List.assoc_opt "jsonrpc" fields with
735 | Some (`String "2.0") -> ()
736 | _ -> raise (Json.Of_json ("Missing or invalid 'jsonrpc' field", json))
737 in
738 if List.mem_assoc "method" fields then
739 if List.mem_assoc "id" fields then
740 Request (request_of_yojson json)
741 else
742 Notification (notification_of_yojson json)
743 else if List.mem_assoc "result" fields then
744 Response (response_of_yojson json)
745 else if List.mem_assoc "error" fields then
746 Error (error_of_yojson json)
747 else
748 raise (Json.Of_json ("Invalid JSONRPC message format", json))
749 | j -> raise (Json.Of_json ("Expected object for JSONRPC message", j))
750
751 let create_notification ?(params=None) ~meth () =
752 Notification { meth; params }
753
754 let create_request ?(params=None) ?(progress_token=None) ~id ~meth () =
755 Request { id; meth; params; progress_token }
756
757 let create_response ~id ~result =
758 Response { id; result }
759
760 let create_error ~id ~code ~message ?(data=None) () =
761 Error { id; code; message; data }
762end
763
764(* MCP-specific request/response types *)
765
766module Initialize = struct
767 module Request = struct
768 type t = {
769 capabilities: Json.t; (* ClientCapabilities *)
770 client_info: Implementation.t;
771 protocol_version: string;
772 }
773
774 let yojson_of_t { capabilities; client_info; protocol_version } =
775 `Assoc [
776 ("capabilities", capabilities);
777 ("clientInfo", Implementation.yojson_of_t client_info);
778 ("protocolVersion", `String protocol_version);
779 ]
780
781 let t_of_yojson = function
782 | `Assoc fields as json ->
783 let capabilities = match List.assoc_opt "capabilities" fields with
784 | Some json -> json
785 | None -> raise (Json.Of_json ("Missing capabilities field", json))
786 in
787 let client_info = match List.assoc_opt "clientInfo" fields with
788 | Some json -> Implementation.t_of_yojson json
789 | None -> raise (Json.Of_json ("Missing clientInfo field", json))
790 in
791 let protocol_version = Util.get_string_field fields "protocolVersion" json in
792 { capabilities; client_info; protocol_version }
793 | j -> raise (Json.Of_json ("Expected object for InitializeRequest", j))
794
795 let create ~capabilities ~client_info ~protocol_version =
796 { capabilities; client_info; protocol_version }
797
798 let to_jsonrpc ~id t =
799 let params = yojson_of_t t in
800 JSONRPCMessage.create_request ~id ~meth:Method.Initialize ~params:(Some params) ()
801 end
802
803 module Result = struct
804 type t = {
805 capabilities: Json.t; (* ServerCapabilities *)
806 server_info: Implementation.t;
807 protocol_version: string;
808 instructions: string option;
809 meta: Json.t option;
810 }
811
812 let yojson_of_t { capabilities; server_info; protocol_version; instructions; meta } =
813 let assoc = [
814 ("capabilities", capabilities);
815 ("serverInfo", Implementation.yojson_of_t server_info);
816 ("protocolVersion", `String protocol_version);
817 ] in
818 let assoc = match instructions with
819 | Some instr -> ("instructions", `String instr) :: assoc
820 | None -> assoc
821 in
822 let assoc = match meta with
823 | Some meta -> ("_meta", meta) :: assoc
824 | None -> assoc
825 in
826 `Assoc assoc
827
828 let t_of_yojson = function
829 | `Assoc fields as json ->
830 let capabilities = match List.assoc_opt "capabilities" fields with
831 | Some json -> json
832 | None -> raise (Json.Of_json ("Missing capabilities field", json))
833 in
834 let server_info = match List.assoc_opt "serverInfo" fields with
835 | Some json -> Implementation.t_of_yojson json
836 | None -> raise (Json.Of_json ("Missing serverInfo field", json))
837 in
838 let protocol_version = Util.get_string_field fields "protocolVersion" json in
839 let instructions = Util.get_optional_string_field fields "instructions" in
840 let meta = List.assoc_opt "_meta" fields in
841 { capabilities; server_info; protocol_version; instructions; meta }
842 | j -> raise (Json.Of_json ("Expected object for InitializeResult", j))
843
844 let create ~capabilities ~server_info ~protocol_version ?instructions ?meta () =
845 { capabilities; server_info; protocol_version; instructions; meta }
846
847 let to_jsonrpc ~id t =
848 JSONRPCMessage.create_response ~id ~result:(yojson_of_t t)
849 end
850end
851
852module Initialized = struct
853 module Notification = struct
854 type t = {
855 meta: Json.t option;
856 }
857
858 let yojson_of_t { meta } =
859 let assoc = [] in
860 let assoc = match meta with
861 | Some meta -> ("_meta", meta) :: assoc
862 | None -> assoc
863 in
864 `Assoc assoc
865
866 let t_of_yojson = function
867 | `Assoc fields ->
868 let meta = List.assoc_opt "_meta" fields in
869 { meta }
870 | j -> raise (Json.Of_json ("Expected object for InitializedNotification", j))
871
872 let create ?meta () = { meta }
873
874 let to_jsonrpc t =
875 let params = match yojson_of_t t with
876 | `Assoc [] -> None
877 | json -> Some json
878 in
879 JSONRPCMessage.create_notification ~meth:Method.Initialized ~params ()
880 end
881end
882
883
884(* Export the main interface for using the MCP protocol *)
885
886let parse_message json =
887 JSONRPCMessage.t_of_yojson json
888
889let create_notification ?(params=None) ~meth () =
890 JSONRPCMessage.create_notification ~params ~meth ()
891
892let create_request ?(params=None) ?(progress_token=None) ~id ~meth () =
893 JSONRPCMessage.create_request ~params ~progress_token ~id ~meth ()
894
895let create_response = JSONRPCMessage.create_response
896let create_error = JSONRPCMessage.create_error
897
898(* Content type constructors *)
899let make_text_content text =
900 Text (TextContent.{ text; annotations = None })
901
902let make_image_content data mime_type =
903 Image (ImageContent.{ data; mime_type; annotations = None })
904
905let make_audio_content data mime_type =
906 Audio (AudioContent.{ data; mime_type; annotations = None })
907
908let make_resource_text_content uri text mime_type =
909 Resource (EmbeddedResource.{
910 resource = `Text TextResourceContents.{ uri; text; mime_type };
911 annotations = None;
912 })
913
914let make_resource_blob_content uri blob mime_type =
915 Resource (EmbeddedResource.{
916 resource = `Blob BlobResourceContents.{ uri; blob; mime_type };
917 annotations = None;
918 })