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