···
6
+
type t = [ `User | `Assistant ]
8
+
let to_string = function
10
+
| `Assistant -> "assistant"
12
+
let of_string = function
14
+
| "assistant" -> `Assistant
15
+
| s -> raise (Json.Of_json ("Unknown role: " ^ s, `String s))
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))
23
+
module ProgressToken = struct
24
+
type t = [ `String of string | `Int of int ]
26
+
include (Id : Json.Jsonable.S with type t := t)
29
+
module RequestId = Id
31
+
module Cursor = struct
34
+
let yojson_of_t t = `String t
35
+
let t_of_yojson = function
37
+
| j -> raise (Json.Of_json ("Expected string for Cursor", j))
42
+
module Annotated = struct
44
+
annotations: annotation option;
47
+
audience: Role.t list option;
48
+
priority: float option;
51
+
let yojson_of_annotation { audience; priority } =
53
+
let assoc = match audience with
54
+
| Some audience -> ("audience", `List (List.map Role.yojson_of_t audience)) :: assoc
57
+
let assoc = match priority with
58
+
| Some priority -> ("priority", `Float priority) :: assoc
63
+
let annotation_of_yojson = function
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))
69
+
let priority = List.assoc_opt "priority" fields |> Option.map (function
71
+
| j -> raise (Json.Of_json ("Expected float for priority", j))
73
+
{ audience; priority }
74
+
| j -> raise (Json.Of_json ("Expected object for annotation", j))
76
+
let yojson_of_t { annotations } =
77
+
match annotations with
78
+
| Some annotations -> `Assoc [ "annotations", yojson_of_annotation annotations ]
81
+
let t_of_yojson = function
83
+
let annotations = List.assoc_opt "annotations" fields |> Option.map annotation_of_yojson in
85
+
| j -> raise (Json.Of_json ("Expected object for Annotated", j))
90
+
module TextContent = struct
93
+
annotations: Annotated.annotation option;
96
+
let yojson_of_t { text; annotations } =
98
+
("text", `String text);
99
+
("type", `String "text");
101
+
let assoc = match annotations with
102
+
| Some annotations -> ("annotations", Annotated.yojson_of_annotation annotations) :: assoc
107
+
let t_of_yojson = function
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))
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))
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))
122
+
module ImageContent = struct
126
+
annotations: Annotated.annotation option;
129
+
let yojson_of_t { data; mime_type; annotations } =
131
+
("data", `String data);
132
+
("mimeType", `String mime_type);
133
+
("type", `String "image");
135
+
let assoc = match annotations with
136
+
| Some annotations -> ("annotations", Annotated.yojson_of_annotation annotations) :: assoc
141
+
let t_of_yojson = function
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))
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))
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))
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))
160
+
module ResourceContents = struct
163
+
mime_type: string option;
166
+
let yojson_of_t { uri; mime_type } =
168
+
("uri", `String uri);
170
+
let assoc = match mime_type with
171
+
| Some mime_type -> ("mimeType", `String mime_type) :: assoc
176
+
let t_of_yojson = function
178
+
let uri = match List.assoc_opt "uri" fields with
179
+
| Some (`String s) -> s
180
+
| _ -> raise (Json.Of_json ("Missing or invalid 'uri' field", `Assoc fields))
182
+
let mime_type = List.assoc_opt "mimeType" fields |> Option.map (function
184
+
| j -> raise (Json.Of_json ("Expected string for mimeType", j))
187
+
| j -> raise (Json.Of_json ("Expected object for ResourceContents", j))
190
+
module TextResourceContents = struct
194
+
mime_type: string option;
197
+
let yojson_of_t { uri; text; mime_type } =
199
+
("uri", `String uri);
200
+
("text", `String text);
202
+
let assoc = match mime_type with
203
+
| Some mime_type -> ("mimeType", `String mime_type) :: assoc
208
+
let t_of_yojson = function
210
+
let uri = match List.assoc_opt "uri" fields with
211
+
| Some (`String s) -> s
212
+
| _ -> raise (Json.Of_json ("Missing or invalid 'uri' field", `Assoc fields))
214
+
let text = match List.assoc_opt "text" fields with
215
+
| Some (`String s) -> s
216
+
| _ -> raise (Json.Of_json ("Missing or invalid 'text' field", `Assoc fields))
218
+
let mime_type = List.assoc_opt "mimeType" fields |> Option.map (function
220
+
| j -> raise (Json.Of_json ("Expected string for mimeType", j))
222
+
{ uri; text; mime_type }
223
+
| j -> raise (Json.Of_json ("Expected object for TextResourceContents", j))
226
+
module BlobResourceContents = struct
230
+
mime_type: string option;
233
+
let yojson_of_t { uri; blob; mime_type } =
235
+
("uri", `String uri);
236
+
("blob", `String blob);
238
+
let assoc = match mime_type with
239
+
| Some mime_type -> ("mimeType", `String mime_type) :: assoc
244
+
let t_of_yojson = function
246
+
let uri = match List.assoc_opt "uri" fields with
247
+
| Some (`String s) -> s
248
+
| _ -> raise (Json.Of_json ("Missing or invalid 'uri' field", `Assoc fields))
250
+
let blob = match List.assoc_opt "blob" fields with
251
+
| Some (`String s) -> s
252
+
| _ -> raise (Json.Of_json ("Missing or invalid 'blob' field", `Assoc fields))
254
+
let mime_type = List.assoc_opt "mimeType" fields |> Option.map (function
256
+
| j -> raise (Json.Of_json ("Expected string for mimeType", j))
258
+
{ uri; blob; mime_type }
259
+
| j -> raise (Json.Of_json ("Expected object for BlobResourceContents", j))
262
+
module EmbeddedResource = struct
264
+
resource: [ `Text of TextResourceContents.t | `Blob of BlobResourceContents.t ];
265
+
annotations: Annotated.annotation option;
268
+
let yojson_of_t { resource; annotations } =
269
+
let resource_json = match resource with
270
+
| `Text txt -> TextResourceContents.yojson_of_t txt
271
+
| `Blob blob -> BlobResourceContents.yojson_of_t blob
274
+
("resource", resource_json);
275
+
("type", `String "resource");
277
+
let assoc = match annotations with
278
+
| Some annotations -> ("annotations", Annotated.yojson_of_annotation annotations) :: assoc
283
+
let t_of_yojson = function
285
+
let _ = match List.assoc_opt "type" fields with
286
+
| Some (`String "resource") -> ()
287
+
| _ -> raise (Json.Of_json ("Missing or invalid 'type' field", `Assoc fields))
289
+
let resource = match List.assoc_opt "resource" fields with
290
+
| Some (`Assoc res_fields) ->
291
+
if List.mem_assoc "text" res_fields then
292
+
`Text (TextResourceContents.t_of_yojson (`Assoc res_fields))
293
+
else if List.mem_assoc "blob" res_fields then
294
+
`Blob (BlobResourceContents.t_of_yojson (`Assoc res_fields))
296
+
raise (Json.Of_json ("Invalid resource content", `Assoc res_fields))
297
+
| _ -> raise (Json.Of_json ("Missing or invalid 'resource' field", `Assoc fields))
299
+
let annotations = List.assoc_opt "annotations" fields |> Option.map Annotated.annotation_of_yojson in
300
+
{ resource; annotations }
301
+
| j -> raise (Json.Of_json ("Expected object for EmbeddedResource", j))
305
+
| Text of TextContent.t
306
+
| Image of ImageContent.t
307
+
| Resource of EmbeddedResource.t
309
+
let yojson_of_content = function
310
+
| Text t -> TextContent.yojson_of_t t
311
+
| Image i -> ImageContent.yojson_of_t i
312
+
| Resource r -> EmbeddedResource.yojson_of_t r
314
+
let content_of_yojson = function
316
+
(match List.assoc_opt "type" fields with
317
+
| Some (`String "text") -> Text (TextContent.t_of_yojson (`Assoc fields))
318
+
| Some (`String "image") -> Image (ImageContent.t_of_yojson (`Assoc fields))
319
+
| Some (`String "resource") -> Resource (EmbeddedResource.t_of_yojson (`Assoc fields))
320
+
| _ -> raise (Json.Of_json ("Invalid or missing content type", `Assoc fields)))
321
+
| j -> raise (Json.Of_json ("Expected object for content", j))
323
+
(* Message types *)
325
+
module PromptMessage = struct
331
+
let yojson_of_t { role; content } =
333
+
("role", Role.yojson_of_t role);
334
+
("content", yojson_of_content content);
337
+
let t_of_yojson = function
339
+
let role = match List.assoc_opt "role" fields with
340
+
| Some json -> Role.t_of_yojson json
341
+
| None -> raise (Json.Of_json ("Missing role field", `Assoc fields))
343
+
let content = match List.assoc_opt "content" fields with
344
+
| Some json -> content_of_yojson json
345
+
| None -> raise (Json.Of_json ("Missing content field", `Assoc fields))
348
+
| j -> raise (Json.Of_json ("Expected object for PromptMessage", j))
351
+
module SamplingMessage = struct
354
+
content: [ `Text of TextContent.t | `Image of ImageContent.t ];
357
+
let yojson_of_t { role; content } =
358
+
let content_json = match content with
359
+
| `Text t -> TextContent.yojson_of_t t
360
+
| `Image i -> ImageContent.yojson_of_t i
363
+
("role", Role.yojson_of_t role);
364
+
("content", content_json);
367
+
let t_of_yojson = function
369
+
let role = match List.assoc_opt "role" fields with
370
+
| Some json -> Role.t_of_yojson json
371
+
| None -> raise (Json.Of_json ("Missing role field", `Assoc fields))
373
+
let content = match List.assoc_opt "content" fields with
374
+
| Some (`Assoc content_fields) ->
375
+
(match List.assoc_opt "type" content_fields with
376
+
| Some (`String "text") -> `Text (TextContent.t_of_yojson (`Assoc content_fields))
377
+
| Some (`String "image") -> `Image (ImageContent.t_of_yojson (`Assoc content_fields))
378
+
| _ -> raise (Json.Of_json ("Invalid content type", `Assoc content_fields)))
379
+
| _ -> raise (Json.Of_json ("Missing or invalid content field", `Assoc fields))
382
+
| j -> raise (Json.Of_json ("Expected object for SamplingMessage", j))
385
+
(* Implementation info *)
387
+
module Implementation = struct
393
+
let yojson_of_t { name; version } =
395
+
("name", `String name);
396
+
("version", `String version);
399
+
let t_of_yojson = function
401
+
let name = match List.assoc_opt "name" fields with
402
+
| Some (`String s) -> s
403
+
| _ -> raise (Json.Of_json ("Missing or invalid 'name' field", `Assoc fields))
405
+
let version = match List.assoc_opt "version" fields with
406
+
| Some (`String s) -> s
407
+
| _ -> raise (Json.Of_json ("Missing or invalid 'version' field", `Assoc fields))
410
+
| j -> raise (Json.Of_json ("Expected object for Implementation", j))
413
+
(* JSONRPC Message types *)
415
+
module JSONRPCMessage = struct
416
+
type notification = {
418
+
params: Json.t option;
424
+
params: Json.t option;
425
+
progress_token: ProgressToken.t option;
437
+
data: Json.t option;
441
+
| Notification of notification
442
+
| Request of request
443
+
| Response of response
446
+
let yojson_of_notification (n: notification) =
448
+
("jsonrpc", `String "2.0");
449
+
("method", `String n.method_);
451
+
let assoc = match n.params with
452
+
| Some params -> ("params", params) :: assoc
457
+
let yojson_of_request (r: request) =
459
+
("jsonrpc", `String "2.0");
460
+
("id", Id.yojson_of_t r.id);
461
+
("method", `String r.method_);
463
+
let assoc = match r.params with
465
+
let params_json = match params with
467
+
let fields = match r.progress_token with
469
+
let meta = `Assoc [ "progressToken", ProgressToken.yojson_of_t token ] in
470
+
("_meta", meta) :: fields
476
+
("params", params_json) :: assoc
481
+
let yojson_of_response (r: response) =
483
+
("jsonrpc", `String "2.0");
484
+
("id", Id.yojson_of_t r.id);
485
+
("result", r.result);
488
+
let yojson_of_error (e: error) =
489
+
let error_assoc = [
490
+
("code", `Int e.code);
491
+
("message", `String e.message);
493
+
let error_assoc = match e.data with
494
+
| Some data -> ("data", data) :: error_assoc
495
+
| None -> error_assoc
498
+
("jsonrpc", `String "2.0");
499
+
("id", Id.yojson_of_t e.id);
500
+
("error", `Assoc error_assoc);
503
+
let yojson_of_t = function
504
+
| Notification n -> yojson_of_notification n
505
+
| Request r -> yojson_of_request r
506
+
| Response r -> yojson_of_response r
507
+
| Error e -> yojson_of_error e
509
+
let notification_of_yojson = function
511
+
let method_ = match List.assoc_opt "method" fields with
512
+
| Some (`String s) -> s
513
+
| _ -> raise (Json.Of_json ("Missing or invalid 'method' field", `Assoc fields))
515
+
let params = List.assoc_opt "params" fields in
516
+
{ method_; params }
517
+
| j -> raise (Json.Of_json ("Expected object for notification", j))
519
+
let request_of_yojson = function
521
+
let id = match List.assoc_opt "id" fields with
522
+
| Some id_json -> Id.t_of_yojson id_json
523
+
| _ -> raise (Json.Of_json ("Missing or invalid 'id' field", `Assoc fields))
525
+
let method_ = match List.assoc_opt "method" fields with
526
+
| Some (`String s) -> s
527
+
| _ -> raise (Json.Of_json ("Missing or invalid 'method' field", `Assoc fields))
529
+
let params = List.assoc_opt "params" fields in
530
+
let progress_token =
532
+
| Some (`Assoc param_fields) ->
533
+
(match List.assoc_opt "_meta" param_fields with
534
+
| Some (`Assoc meta_fields) ->
535
+
(match List.assoc_opt "progressToken" meta_fields with
536
+
| Some token_json -> Some (ProgressToken.t_of_yojson token_json)
541
+
{ id; method_; params; progress_token }
542
+
| j -> raise (Json.Of_json ("Expected object for request", j))
544
+
let response_of_yojson = function
546
+
let id = match List.assoc_opt "id" fields with
547
+
| Some id_json -> Id.t_of_yojson id_json
548
+
| _ -> raise (Json.Of_json ("Missing or invalid 'id' field", `Assoc fields))
550
+
let result = match List.assoc_opt "result" fields with
551
+
| Some result -> result
552
+
| _ -> raise (Json.Of_json ("Missing 'result' field", `Assoc fields))
555
+
| j -> raise (Json.Of_json ("Expected object for response", j))
557
+
let error_of_yojson = function
559
+
let id = match List.assoc_opt "id" fields with
560
+
| Some id_json -> Id.t_of_yojson id_json
561
+
| _ -> raise (Json.Of_json ("Missing or invalid 'id' field", `Assoc fields))
563
+
let error = match List.assoc_opt "error" fields with
564
+
| Some (`Assoc error_fields) -> error_fields
565
+
| _ -> raise (Json.Of_json ("Missing or invalid 'error' field", `Assoc fields))
567
+
let code = match List.assoc_opt "code" error with
568
+
| Some (`Int code) -> code
569
+
| _ -> raise (Json.Of_json ("Missing or invalid 'code' field in error", `Assoc error))
571
+
let message = match List.assoc_opt "message" error with
572
+
| Some (`String msg) -> msg
573
+
| _ -> raise (Json.Of_json ("Missing or invalid 'message' field in error", `Assoc error))
575
+
let data = List.assoc_opt "data" error in
576
+
{ id; code; message; data }
577
+
| j -> raise (Json.Of_json ("Expected object for error", j))
579
+
let t_of_yojson json =
582
+
let _jsonrpc = match List.assoc_opt "jsonrpc" fields with
583
+
| Some (`String "2.0") -> ()
584
+
| _ -> raise (Json.Of_json ("Missing or invalid 'jsonrpc' field", json))
586
+
if List.mem_assoc "method" fields then
587
+
if List.mem_assoc "id" fields then
588
+
Request (request_of_yojson json)
590
+
Notification (notification_of_yojson json)
591
+
else if List.mem_assoc "result" fields then
592
+
Response (response_of_yojson json)
593
+
else if List.mem_assoc "error" fields then
594
+
Error (error_of_yojson json)
596
+
raise (Json.Of_json ("Invalid JSONRPC message format", json))
597
+
| j -> raise (Json.Of_json ("Expected object for JSONRPC message", j))
599
+
let create_notification ?(params=None) ~method_ () =
600
+
Notification { method_; params }
602
+
let create_request ?(params=None) ?(progress_token=None) ~id ~method_ () =
603
+
Request { id; method_; params; progress_token }
605
+
let create_response ~id ~result =
606
+
Response { id; result }
608
+
let create_error ~id ~code ~message ?(data=None) () =
609
+
Error { id; code; message; data }
612
+
(* MCP-specific request/response types *)
614
+
module Initialize = struct
615
+
module Request = struct
617
+
capabilities: Json.t; (* ClientCapabilities *)
618
+
client_info: Implementation.t;
619
+
protocol_version: string;
622
+
let yojson_of_t { capabilities; client_info; protocol_version } =
624
+
("capabilities", capabilities);
625
+
("clientInfo", Implementation.yojson_of_t client_info);
626
+
("protocolVersion", `String protocol_version);
629
+
let t_of_yojson = function
631
+
let capabilities = match List.assoc_opt "capabilities" fields with
632
+
| Some json -> json
633
+
| None -> raise (Json.Of_json ("Missing capabilities field", `Assoc fields))
635
+
let client_info = match List.assoc_opt "clientInfo" fields with
636
+
| Some json -> Implementation.t_of_yojson json
637
+
| None -> raise (Json.Of_json ("Missing clientInfo field", `Assoc fields))
639
+
let protocol_version = match List.assoc_opt "protocolVersion" fields with
640
+
| Some (`String s) -> s
641
+
| _ -> raise (Json.Of_json ("Missing or invalid protocolVersion field", `Assoc fields))
643
+
{ capabilities; client_info; protocol_version }
644
+
| j -> raise (Json.Of_json ("Expected object for InitializeRequest", j))
646
+
let create ~capabilities ~client_info ~protocol_version =
647
+
{ capabilities; client_info; protocol_version }
649
+
let to_jsonrpc ~id t =
650
+
let params = yojson_of_t t in
651
+
JSONRPCMessage.create_request ~id ~method_:"initialize" ~params:(Some params) ()
654
+
module Result = struct
656
+
capabilities: Json.t; (* ServerCapabilities *)
657
+
server_info: Implementation.t;
658
+
protocol_version: string;
659
+
instructions: string option;
660
+
meta: Json.t option;
663
+
let yojson_of_t { capabilities; server_info; protocol_version; instructions; meta } =
665
+
("capabilities", capabilities);
666
+
("serverInfo", Implementation.yojson_of_t server_info);
667
+
("protocolVersion", `String protocol_version);
669
+
let assoc = match instructions with
670
+
| Some instr -> ("instructions", `String instr) :: assoc
673
+
let assoc = match meta with
674
+
| Some meta -> ("_meta", meta) :: assoc
679
+
let t_of_yojson = function
681
+
let capabilities = match List.assoc_opt "capabilities" fields with
682
+
| Some json -> json
683
+
| None -> raise (Json.Of_json ("Missing capabilities field", `Assoc fields))
685
+
let server_info = match List.assoc_opt "serverInfo" fields with
686
+
| Some json -> Implementation.t_of_yojson json
687
+
| None -> raise (Json.Of_json ("Missing serverInfo field", `Assoc fields))
689
+
let protocol_version = match List.assoc_opt "protocolVersion" fields with
690
+
| Some (`String s) -> s
691
+
| _ -> raise (Json.Of_json ("Missing or invalid protocolVersion field", `Assoc fields))
693
+
let instructions = match List.assoc_opt "instructions" fields with
694
+
| Some (`String s) -> Some s
697
+
let meta = List.assoc_opt "_meta" fields in
698
+
{ capabilities; server_info; protocol_version; instructions; meta }
699
+
| j -> raise (Json.Of_json ("Expected object for InitializeResult", j))
701
+
let create ~capabilities ~server_info ~protocol_version ?instructions ?meta () =
702
+
{ capabilities; server_info; protocol_version; instructions; meta }
704
+
let to_jsonrpc ~id t =
705
+
JSONRPCMessage.create_response ~id ~result:(yojson_of_t t)
709
+
module Initialized = struct
710
+
module Notification = struct
712
+
meta: Json.t option;
715
+
let yojson_of_t { meta } =
717
+
let assoc = match meta with
718
+
| Some meta -> ("_meta", meta) :: assoc
723
+
let t_of_yojson = function
725
+
let meta = List.assoc_opt "_meta" fields in
727
+
| j -> raise (Json.Of_json ("Expected object for InitializedNotification", j))
729
+
let create ?meta () = { meta }
732
+
let params = match yojson_of_t t with
733
+
| `Assoc [] -> None
734
+
| json -> Some json
736
+
JSONRPCMessage.create_notification ~method_:"notifications/initialized" ~params ()
740
+
(* Export the main interface for using the MCP protocol *)
742
+
let parse_message json =
743
+
JSONRPCMessage.t_of_yojson json
745
+
let create_notification = JSONRPCMessage.create_notification
746
+
let create_request = JSONRPCMessage.create_request
747
+
let create_response = JSONRPCMessage.create_response
748
+
let create_error = JSONRPCMessage.create_error
anil.recoil.org