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