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