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