···
1
+
(* Mcp_message - High-level RPC message definitions for Model Context Protocol *)
7
+
module ResourcesList = struct
8
+
module Request = struct
10
+
cursor: Cursor.t option;
13
+
let yojson_of_t { cursor } =
15
+
let assoc = match cursor with
16
+
| Some c -> ("cursor", Cursor.yojson_of_t c) :: assoc
21
+
let t_of_yojson = function
23
+
let cursor = List.assoc_opt "cursor" fields |> Option.map Cursor.t_of_yojson in
25
+
| j -> raise (Json.Of_json ("Expected object for ResourcesList.Request.t", j))
29
+
module Resource = struct
33
+
description: string option;
34
+
mime_type: string option;
38
+
let yojson_of_t { uri; name; description; mime_type; size } =
40
+
("uri", `String uri);
41
+
("name", `String name);
43
+
let assoc = match description with
44
+
| Some desc -> ("description", `String desc) :: assoc
47
+
let assoc = match mime_type with
48
+
| Some mime -> ("mimeType", `String mime) :: assoc
51
+
let assoc = match size with
52
+
| Some s -> ("size", `Int s) :: assoc
57
+
let t_of_yojson = function
59
+
let uri = match List.assoc_opt "uri" fields with
60
+
| Some (`String s) -> s
61
+
| _ -> raise (Json.Of_json ("Missing or invalid 'uri' field", `Assoc fields))
63
+
let name = match List.assoc_opt "name" fields with
64
+
| Some (`String s) -> s
65
+
| _ -> raise (Json.Of_json ("Missing or invalid 'name' field", `Assoc fields))
67
+
let description = List.assoc_opt "description" fields |> Option.map (function
69
+
| j -> raise (Json.Of_json ("Expected string for description", j))
71
+
let mime_type = List.assoc_opt "mimeType" fields |> Option.map (function
73
+
| j -> raise (Json.Of_json ("Expected string for mimeType", j))
75
+
let size = List.assoc_opt "size" fields |> Option.map (function
77
+
| j -> raise (Json.Of_json ("Expected int for size", j))
79
+
{ uri; name; description; mime_type; size }
80
+
| j -> raise (Json.Of_json ("Expected object for ResourcesList.Resource.t", j))
83
+
module Response = struct
85
+
resources: Resource.t list;
86
+
next_cursor: Cursor.t option;
89
+
let yojson_of_t { resources; next_cursor } =
91
+
("resources", `List (List.map Resource.yojson_of_t resources));
93
+
let assoc = match next_cursor with
94
+
| Some c -> ("nextCursor", Cursor.yojson_of_t c) :: assoc
99
+
let t_of_yojson = function
101
+
let resources = match List.assoc_opt "resources" fields with
102
+
| Some (`List items) -> List.map Resource.t_of_yojson items
103
+
| _ -> raise (Json.Of_json ("Missing or invalid 'resources' field", `Assoc fields))
105
+
let next_cursor = List.assoc_opt "nextCursor" fields |> Option.map Cursor.t_of_yojson in
106
+
{ resources; next_cursor }
107
+
| j -> raise (Json.Of_json ("Expected object for ResourcesList.Response.t", j))
111
+
(* Request/response creation helpers *)
112
+
let create_request ?cursor ?id () =
113
+
let id = match id with
115
+
| None -> `Int (Random.int 10000)
117
+
let params = Request.yojson_of_t { cursor } in
118
+
JSONRPCMessage.create_request ~id ~method_:Method.resources_list ~params:(Some params) ()
120
+
let create_response ~id ~resources ?next_cursor () =
121
+
let result = Response.yojson_of_t { resources; next_cursor } in
122
+
JSONRPCMessage.create_response ~id ~result
125
+
(* Resources/Read *)
126
+
module ResourcesRead = struct
127
+
module Request = struct
132
+
let yojson_of_t { uri } =
134
+
("uri", `String uri);
137
+
let t_of_yojson = function
139
+
let uri = match List.assoc_opt "uri" fields with
140
+
| Some (`String s) -> s
141
+
| _ -> raise (Json.Of_json ("Missing or invalid 'uri' field", `Assoc fields))
144
+
| j -> raise (Json.Of_json ("Expected object for ResourcesRead.Request.t", j))
148
+
module ResourceContent = struct
150
+
| TextResource of TextResourceContents.t
151
+
| BlobResource of BlobResourceContents.t
153
+
let yojson_of_t = function
154
+
| TextResource tr -> TextResourceContents.yojson_of_t tr
155
+
| BlobResource br -> BlobResourceContents.yojson_of_t br
157
+
let t_of_yojson json =
160
+
if List.mem_assoc "text" fields then
161
+
TextResource (TextResourceContents.t_of_yojson json)
162
+
else if List.mem_assoc "blob" fields then
163
+
BlobResource (BlobResourceContents.t_of_yojson json)
165
+
raise (Json.Of_json ("Invalid resource content", json))
166
+
| j -> raise (Json.Of_json ("Expected object for ResourcesRead.ResourceContent.t", j))
170
+
module Response = struct
172
+
contents: ResourceContent.t list;
175
+
let yojson_of_t { contents } =
177
+
("contents", `List (List.map ResourceContent.yojson_of_t contents));
180
+
let t_of_yojson = function
182
+
let contents = match List.assoc_opt "contents" fields with
183
+
| Some (`List items) -> List.map ResourceContent.t_of_yojson items
184
+
| _ -> raise (Json.Of_json ("Missing or invalid 'contents' field", `Assoc fields))
187
+
| j -> raise (Json.Of_json ("Expected object for ResourcesRead.Response.t", j))
191
+
(* Request/response creation helpers *)
192
+
let create_request ~uri ?id () =
193
+
let id = match id with
195
+
| None -> `Int (Random.int 10000)
197
+
let params = Request.yojson_of_t { uri } in
198
+
JSONRPCMessage.create_request ~id ~method_:Method.resources_read ~params:(Some params) ()
200
+
let create_response ~id ~contents () =
201
+
let result = Response.yojson_of_t { contents } in
202
+
JSONRPCMessage.create_response ~id ~result
206
+
module ToolsList = struct
207
+
module Request = struct
209
+
cursor: Cursor.t option;
212
+
let yojson_of_t { cursor } =
214
+
let assoc = match cursor with
215
+
| Some c -> ("cursor", Cursor.yojson_of_t c) :: assoc
220
+
let t_of_yojson = function
222
+
let cursor = List.assoc_opt "cursor" fields |> Option.map Cursor.t_of_yojson in
224
+
| j -> raise (Json.Of_json ("Expected object for ToolsList.Request.t", j))
228
+
module Tool = struct
231
+
description: string option;
232
+
input_schema: Json.t;
233
+
annotations: Json.t option;
236
+
let yojson_of_t { name; description; input_schema; annotations } =
238
+
("name", `String name);
239
+
("inputSchema", input_schema);
241
+
let assoc = match description with
242
+
| Some desc -> ("description", `String desc) :: assoc
245
+
let assoc = match annotations with
246
+
| Some anno -> ("annotations", anno) :: assoc
251
+
let t_of_yojson = function
253
+
let name = match List.assoc_opt "name" fields with
254
+
| Some (`String s) -> s
255
+
| _ -> raise (Json.Of_json ("Missing or invalid 'name' field", `Assoc fields))
257
+
let description = List.assoc_opt "description" fields |> Option.map (function
259
+
| j -> raise (Json.Of_json ("Expected string for description", j))
261
+
let input_schema = match List.assoc_opt "inputSchema" fields with
262
+
| Some schema -> schema
263
+
| None -> raise (Json.Of_json ("Missing 'inputSchema' field", `Assoc fields))
265
+
let annotations = List.assoc_opt "annotations" fields in
266
+
{ name; description; input_schema; annotations }
267
+
| j -> raise (Json.Of_json ("Expected object for ToolsList.Tool.t", j))
271
+
module Response = struct
273
+
tools: Tool.t list;
274
+
next_cursor: Cursor.t option;
277
+
let yojson_of_t { tools; next_cursor } =
279
+
("tools", `List (List.map Tool.yojson_of_t tools));
281
+
let assoc = match next_cursor with
282
+
| Some c -> ("nextCursor", Cursor.yojson_of_t c) :: assoc
287
+
let t_of_yojson = function
289
+
let tools = match List.assoc_opt "tools" fields with
290
+
| Some (`List items) -> List.map Tool.t_of_yojson items
291
+
| _ -> raise (Json.Of_json ("Missing or invalid 'tools' field", `Assoc fields))
293
+
let next_cursor = List.assoc_opt "nextCursor" fields |> Option.map Cursor.t_of_yojson in
294
+
{ tools; next_cursor }
295
+
| j -> raise (Json.Of_json ("Expected object for ToolsList.Response.t", j))
299
+
(* Request/response creation helpers *)
300
+
let create_request ?cursor ?id () =
301
+
let id = match id with
303
+
| None -> `Int (Random.int 10000)
305
+
let params = Request.yojson_of_t { cursor } in
306
+
JSONRPCMessage.create_request ~id ~method_:Method.tools_list ~params:(Some params) ()
308
+
let create_response ~id ~tools ?next_cursor () =
309
+
let result = Response.yojson_of_t { tools; next_cursor } in
310
+
JSONRPCMessage.create_response ~id ~result
314
+
module ToolsCall = struct
315
+
module Request = struct
321
+
let yojson_of_t { name; arguments } =
323
+
("name", `String name);
324
+
("arguments", arguments);
327
+
let t_of_yojson = function
329
+
let name = match List.assoc_opt "name" fields with
330
+
| Some (`String s) -> s
331
+
| _ -> raise (Json.Of_json ("Missing or invalid 'name' field", `Assoc fields))
333
+
let arguments = match List.assoc_opt "arguments" fields with
334
+
| Some json -> json
335
+
| None -> raise (Json.Of_json ("Missing 'arguments' field", `Assoc fields))
337
+
{ name; arguments }
338
+
| j -> raise (Json.Of_json ("Expected object for ToolsCall.Request.t", j))
342
+
module ToolContent = struct
344
+
| Text of TextContent.t
345
+
| Image of ImageContent.t
346
+
| Audio of AudioContent.t
347
+
| Resource of EmbeddedResource.t
349
+
let yojson_of_t = function
350
+
| Text t -> TextContent.yojson_of_t t
351
+
| Image i -> ImageContent.yojson_of_t i
352
+
| Audio a -> AudioContent.yojson_of_t a
353
+
| Resource r -> EmbeddedResource.yojson_of_t r
355
+
let t_of_yojson json =
358
+
(match List.assoc_opt "type" fields with
359
+
| Some (`String "text") -> Text (TextContent.t_of_yojson json)
360
+
| Some (`String "image") -> Image (ImageContent.t_of_yojson json)
361
+
| Some (`String "audio") -> Audio (AudioContent.t_of_yojson json)
362
+
| Some (`String "resource") -> Resource (EmbeddedResource.t_of_yojson json)
363
+
| _ -> raise (Json.Of_json ("Invalid or missing content type", json)))
364
+
| j -> raise (Json.Of_json ("Expected object for ToolsCall.ToolContent.t", j))
368
+
module Response = struct
370
+
content: ToolContent.t list;
374
+
let yojson_of_t { content; is_error } =
376
+
("content", `List (List.map ToolContent.yojson_of_t content));
377
+
("isError", `Bool is_error);
380
+
let t_of_yojson = function
382
+
let content = match List.assoc_opt "content" fields with
383
+
| Some (`List items) -> List.map ToolContent.t_of_yojson items
384
+
| _ -> raise (Json.Of_json ("Missing or invalid 'content' field", `Assoc fields))
386
+
let is_error = match List.assoc_opt "isError" fields with
387
+
| Some (`Bool b) -> b
390
+
{ content; is_error }
391
+
| j -> raise (Json.Of_json ("Expected object for ToolsCall.Response.t", j))
395
+
(* Request/response creation helpers *)
396
+
let create_request ~name ~arguments ?id () =
397
+
let id = match id with
399
+
| None -> `Int (Random.int 10000)
401
+
let params = Request.yojson_of_t { name; arguments } in
402
+
JSONRPCMessage.create_request ~id ~method_:Method.tools_call ~params:(Some params) ()
404
+
let create_response ~id ~content ~is_error () =
405
+
let result = Response.yojson_of_t { content; is_error } in
406
+
JSONRPCMessage.create_response ~id ~result
410
+
module PromptsList = struct
411
+
module PromptArgument = struct
414
+
description: string option;
418
+
let yojson_of_t { name; description; required } =
420
+
("name", `String name);
422
+
let assoc = match description with
423
+
| Some desc -> ("description", `String desc) :: assoc
426
+
let assoc = if required then
427
+
("required", `Bool true) :: assoc
433
+
let t_of_yojson = function
435
+
let name = match List.assoc_opt "name" fields with
436
+
| Some (`String s) -> s
437
+
| _ -> raise (Json.Of_json ("Missing or invalid 'name' field", `Assoc fields))
439
+
let description = List.assoc_opt "description" fields |> Option.map (function
441
+
| j -> raise (Json.Of_json ("Expected string for description", j))
443
+
let required = match List.assoc_opt "required" fields with
444
+
| Some (`Bool b) -> b
447
+
{ name; description; required }
448
+
| j -> raise (Json.Of_json ("Expected object for PromptsList.PromptArgument.t", j))
452
+
module Prompt = struct
455
+
description: string option;
456
+
arguments: PromptArgument.t list;
459
+
let yojson_of_t { name; description; arguments } =
461
+
("name", `String name);
463
+
let assoc = match description with
464
+
| Some desc -> ("description", `String desc) :: assoc
467
+
let assoc = if arguments <> [] then
468
+
("arguments", `List (List.map PromptArgument.yojson_of_t arguments)) :: assoc
474
+
let t_of_yojson = function
476
+
let name = match List.assoc_opt "name" fields with
477
+
| Some (`String s) -> s
478
+
| _ -> raise (Json.Of_json ("Missing or invalid 'name' field", `Assoc fields))
480
+
let description = List.assoc_opt "description" fields |> Option.map (function
482
+
| j -> raise (Json.Of_json ("Expected string for description", j))
484
+
let arguments = match List.assoc_opt "arguments" fields with
485
+
| Some (`List items) -> List.map PromptArgument.t_of_yojson items
488
+
{ name; description; arguments }
489
+
| j -> raise (Json.Of_json ("Expected object for PromptsList.Prompt.t", j))
493
+
module Request = struct
495
+
cursor: Cursor.t option;
498
+
let yojson_of_t { cursor } =
500
+
let assoc = match cursor with
501
+
| Some c -> ("cursor", Cursor.yojson_of_t c) :: assoc
506
+
let t_of_yojson = function
508
+
let cursor = List.assoc_opt "cursor" fields |> Option.map Cursor.t_of_yojson in
510
+
| j -> raise (Json.Of_json ("Expected object for PromptsList.Request.t", j))
514
+
module Response = struct
516
+
prompts: Prompt.t list;
517
+
next_cursor: Cursor.t option;
520
+
let yojson_of_t { prompts; next_cursor } =
522
+
("prompts", `List (List.map Prompt.yojson_of_t prompts));
524
+
let assoc = match next_cursor with
525
+
| Some c -> ("nextCursor", Cursor.yojson_of_t c) :: assoc
530
+
let t_of_yojson = function
532
+
let prompts = match List.assoc_opt "prompts" fields with
533
+
| Some (`List items) -> List.map Prompt.t_of_yojson items
534
+
| _ -> raise (Json.Of_json ("Missing or invalid 'prompts' field", `Assoc fields))
536
+
let next_cursor = List.assoc_opt "nextCursor" fields |> Option.map Cursor.t_of_yojson in
537
+
{ prompts; next_cursor }
538
+
| j -> raise (Json.Of_json ("Expected object for PromptsList.Response.t", j))
542
+
(* Request/response creation helpers *)
543
+
let create_request ?cursor ?id () =
544
+
let id = match id with
546
+
| None -> `Int (Random.int 10000)
548
+
let params = Request.yojson_of_t { cursor } in
549
+
JSONRPCMessage.create_request ~id ~method_:Method.prompts_list ~params:(Some params) ()
551
+
let create_response ~id ~prompts ?next_cursor () =
552
+
let result = Response.yojson_of_t { prompts; next_cursor } in
553
+
JSONRPCMessage.create_response ~id ~result
557
+
module PromptsGet = struct
558
+
module Request = struct
561
+
arguments: (string * string) list;
564
+
let yojson_of_t { name; arguments } =
565
+
let args_json = `Assoc (List.map (fun (k, v) -> (k, `String v)) arguments) in
567
+
("name", `String name);
568
+
("arguments", args_json);
571
+
let t_of_yojson = function
573
+
let name = match List.assoc_opt "name" fields with
574
+
| Some (`String s) -> s
575
+
| _ -> raise (Json.Of_json ("Missing or invalid 'name' field", `Assoc fields))
577
+
let arguments = match List.assoc_opt "arguments" fields with
578
+
| Some (`Assoc args) ->
579
+
List.map (fun (k, v) ->
581
+
| `String s -> (k, s)
582
+
| _ -> raise (Json.Of_json ("Expected string value for argument", v))
586
+
{ name; arguments }
587
+
| j -> raise (Json.Of_json ("Expected object for PromptsGet.Request.t", j))
591
+
module Response = struct
593
+
description: string option;
594
+
messages: PromptMessage.t list;
597
+
let yojson_of_t { description; messages } =
599
+
("messages", `List (List.map PromptMessage.yojson_of_t messages));
601
+
let assoc = match description with
602
+
| Some desc -> ("description", `String desc) :: assoc
607
+
let t_of_yojson = function
609
+
let messages = match List.assoc_opt "messages" fields with
610
+
| Some (`List items) -> List.map PromptMessage.t_of_yojson items
611
+
| _ -> raise (Json.Of_json ("Missing or invalid 'messages' field", `Assoc fields))
613
+
let description = List.assoc_opt "description" fields |> Option.map (function
615
+
| j -> raise (Json.Of_json ("Expected string for description", j))
617
+
{ description; messages }
618
+
| j -> raise (Json.Of_json ("Expected object for PromptsGet.Response.t", j))
622
+
(* Request/response creation helpers *)
623
+
let create_request ~name ~arguments ?id () =
624
+
let id = match id with
626
+
| None -> `Int (Random.int 10000)
628
+
let params = Request.yojson_of_t { name; arguments } in
629
+
JSONRPCMessage.create_request ~id ~method_:Method.prompts_get ~params:(Some params) ()
631
+
let create_response ~id ?description ~messages () =
632
+
let result = Response.yojson_of_t { description; messages } in
633
+
JSONRPCMessage.create_response ~id ~result
636
+
(* List Changed Notifications *)
637
+
module ListChanged = struct
638
+
(* No parameters for these notifications *)
640
+
let create_resources_notification () =
641
+
JSONRPCMessage.create_notification ~method_:Method.resources_list_changed ()
643
+
let create_tools_notification () =
644
+
JSONRPCMessage.create_notification ~method_:Method.tools_list_changed ()
646
+
let create_prompts_notification () =
647
+
JSONRPCMessage.create_notification ~method_:Method.prompts_list_changed ()
650
+
(* Resource Updated Notification *)
651
+
module ResourceUpdated = struct
652
+
module Notification = struct
657
+
let yojson_of_t { uri } =
659
+
("uri", `String uri);
662
+
let t_of_yojson = function
664
+
let uri = match List.assoc_opt "uri" fields with
665
+
| Some (`String s) -> s
666
+
| _ -> raise (Json.Of_json ("Missing or invalid 'uri' field", `Assoc fields))
669
+
| j -> raise (Json.Of_json ("Expected object for ResourceUpdated.Notification.t", j))
673
+
let create_notification ~uri () =
674
+
let params = Notification.yojson_of_t { uri } in
675
+
JSONRPCMessage.create_notification ~method_:Method.resources_updated ~params:(Some params) ()
678
+
(* Progress Notification *)
679
+
module Progress = struct
680
+
module Notification = struct
684
+
progress_token: ProgressToken.t;
687
+
let yojson_of_t { progress; total; progress_token } =
689
+
("progress", `Float progress);
690
+
("total", `Float total);
691
+
("progressToken", ProgressToken.yojson_of_t progress_token);
694
+
let t_of_yojson = function
696
+
let progress = match List.assoc_opt "progress" fields with
697
+
| Some (`Float f) -> f
698
+
| _ -> raise (Json.Of_json ("Missing or invalid 'progress' field", `Assoc fields))
700
+
let total = match List.assoc_opt "total" fields with
701
+
| Some (`Float f) -> f
702
+
| _ -> raise (Json.Of_json ("Missing or invalid 'total' field", `Assoc fields))
704
+
let progress_token = match List.assoc_opt "progressToken" fields with
705
+
| Some token -> ProgressToken.t_of_yojson token
706
+
| _ -> raise (Json.Of_json ("Missing or invalid 'progressToken' field", `Assoc fields))
708
+
{ progress; total; progress_token }
709
+
| j -> raise (Json.Of_json ("Expected object for Progress.Notification.t", j))
713
+
let create_notification ~progress ~total ~progress_token () =
714
+
let params = Notification.yojson_of_t { progress; total; progress_token } in
715
+
JSONRPCMessage.create_notification ~method_:Method.progress ~params:(Some params) ()
718
+
(* Type aliases for backward compatibility *)
719
+
type request = ResourcesList.Request.t
720
+
type response = ResourcesList.Response.t
721
+
type resource = ResourcesList.Resource.t
722
+
type resource_content = ResourcesRead.ResourceContent.t
723
+
type tool = ToolsList.Tool.t
724
+
type tool_content = ToolsCall.ToolContent.t
725
+
type prompt = PromptsList.Prompt.t
726
+
type prompt_argument = PromptsList.PromptArgument.t
anil.recoil.org