···
3
-
(* Standard error codes *)
3
+
(* Utility functions for JSON parsing *)
5
+
(* Helper to raise a Json.Of_json exception with formatted message *)
6
+
let json_error fmt json =
7
+
Printf.ksprintf (fun msg -> raise (Json.Of_json (msg, json))) fmt
9
+
(* Extract a string field from JSON object or raise an error *)
10
+
let get_string_field fields name json =
11
+
match List.assoc_opt name fields with
12
+
| Some (`String s) -> s
13
+
| _ -> json_error "Missing or invalid '%s' field" json name
15
+
(* Extract an optional string field from JSON object *)
16
+
let get_optional_string_field fields name =
17
+
List.assoc_opt name fields
18
+
|> Option.map (function
20
+
| j -> json_error "Expected string for %s" j name)
22
+
(* Extract an int field from JSON object or raise an error *)
23
+
let get_int_field fields name json =
24
+
match List.assoc_opt name fields with
25
+
| Some (`Int i) -> i
26
+
| _ -> json_error "Missing or invalid '%s' field" json name
28
+
(* Extract a float field from JSON object or raise an error *)
29
+
let get_float_field fields name json =
30
+
match List.assoc_opt name fields with
31
+
| Some (`Float f) -> f
32
+
| _ -> json_error "Missing or invalid '%s' field" json name
34
+
(* Extract a boolean field from JSON object or raise an error *)
35
+
let get_bool_field fields name json =
36
+
match List.assoc_opt name fields with
37
+
| Some (`Bool b) -> b
38
+
| _ -> json_error "Missing or invalid '%s' field" json name
40
+
(* Extract an object field from JSON object or raise an error *)
41
+
let get_object_field fields name json =
42
+
match List.assoc_opt name fields with
43
+
| Some (`Assoc obj) -> obj
44
+
| _ -> json_error "Missing or invalid '%s' field" json name
46
+
(* Extract a list field from JSON object or raise an error *)
47
+
let get_list_field fields name json =
48
+
match List.assoc_opt name fields with
49
+
| Some (`List items) -> items
50
+
| _ -> json_error "Missing or invalid '%s' field" json name
52
+
(* Verify a specific string value in a field *)
53
+
let verify_string_field fields name expected_value json =
54
+
match List.assoc_opt name fields with
55
+
| Some (`String s) when s = expected_value -> ()
57
+
json_error "Field '%s' missing or not equal to '%s'" json name
61
+
(* Error codes for JSON-RPC *)
module ErrorCode = struct
5
-
let parse_error = -32700
6
-
let invalid_request = -32600
7
-
let method_not_found = -32601
8
-
let invalid_params = -32602
9
-
let internal_error = -32603
10
-
let resource_not_found = -32002
11
-
let server_error_start = -32000
12
-
let server_error_end = -32099
64
+
| ParseError (* -32700 - Invalid JSON *)
65
+
| InvalidRequest (* -32600 - Invalid JSON-RPC request *)
66
+
| MethodNotFound (* -32601 - Method not available *)
67
+
| InvalidParams (* -32602 - Invalid method parameters *)
68
+
| InternalError (* -32603 - Internal JSON-RPC error *)
70
+
(* -32002 - Custom MCP error: requested resource not found *)
71
+
| AuthRequired (* -32001 - Custom MCP error: authentication required *)
72
+
| CustomError of int (* For any other error codes *)
74
+
(* Convert the error code to its integer representation *)
75
+
let to_int = function
76
+
| ParseError -> -32700
77
+
| InvalidRequest -> -32600
78
+
| MethodNotFound -> -32601
79
+
| InvalidParams -> -32602
80
+
| InternalError -> -32603
81
+
| ResourceNotFound -> -32002
82
+
| AuthRequired -> -32001
83
+
| CustomError code -> code
85
+
(* Get error message for standard error codes *)
86
+
let to_message = function
87
+
| ParseError -> "Parse error"
88
+
| InvalidRequest -> "Invalid Request"
89
+
| MethodNotFound -> "Method not found"
90
+
| InvalidParams -> "Invalid params"
91
+
| InternalError -> "Internal error"
92
+
| ResourceNotFound -> "Resource not found"
93
+
| AuthRequired -> "Authentication required"
94
+
| CustomError _ -> "Error"
97
+
(* Protocol method types *)
98
+
module Method = struct
99
+
(* Method type representing all MCP protocol methods *)
101
+
(* Initialization and lifecycle methods *)
104
+
(* Resource methods *)
107
+
| ResourceTemplatesList
108
+
| ResourcesSubscribe
109
+
| ResourcesListChanged
115
+
(* Prompt methods *)
118
+
| PromptsListChanged
119
+
(* Progress notifications *)
122
+
(* Convert method type to string representation *)
123
+
let to_string = function
124
+
| Initialize -> "initialize"
125
+
| Initialized -> "notifications/initialized"
126
+
| ResourcesList -> "resources/list"
127
+
| ResourcesRead -> "resources/read"
128
+
| ResourceTemplatesList -> "resources/templates/list"
129
+
| ResourcesSubscribe -> "resources/subscribe"
130
+
| ResourcesListChanged -> "notifications/resources/list_changed"
131
+
| ResourcesUpdated -> "notifications/resources/updated"
132
+
| ToolsList -> "tools/list"
133
+
| ToolsCall -> "tools/call"
134
+
| ToolsListChanged -> "notifications/tools/list_changed"
135
+
| PromptsList -> "prompts/list"
136
+
| PromptsGet -> "prompts/get"
137
+
| PromptsListChanged -> "notifications/prompts/list_changed"
138
+
| Progress -> "notifications/progress"
140
+
(* Convert string to method type *)
141
+
let of_string = function
142
+
| "initialize" -> Initialize
143
+
| "notifications/initialized" -> Initialized
144
+
| "resources/list" -> ResourcesList
145
+
| "resources/read" -> ResourcesRead
146
+
| "resources/templates/list" -> ResourceTemplatesList
147
+
| "resources/subscribe" -> ResourcesSubscribe
148
+
| "notifications/resources/list_changed" -> ResourcesListChanged
149
+
| "notifications/resources/updated" -> ResourcesUpdated
150
+
| "tools/list" -> ToolsList
151
+
| "tools/call" -> ToolsCall
152
+
| "notifications/tools/list_changed" -> ToolsListChanged
153
+
| "prompts/list" -> PromptsList
154
+
| "prompts/get" -> PromptsGet
155
+
| "notifications/prompts/list_changed" -> PromptsListChanged
156
+
| "notifications/progress" -> Progress
157
+
| s -> failwith ("Unknown MCP method: " ^ s)
···
type t = [ `User | `Assistant ]
20
-
let to_string = function
22
-
| `Assistant -> "assistant"
165
+
let to_string = function `User -> "user" | `Assistant -> "assistant"
| "assistant" -> `Assistant
27
-
| s -> raise (Json.Of_json ("Unknown role: " ^ s, `String s))
170
+
| s -> Util.json_error "Unknown role: %s" (`String s) s
let yojson_of_t t = `String (to_string t)
let t_of_yojson = function
| `String s -> of_string s
32
-
| j -> raise (Json.Of_json ("Expected string for Role", j))
176
+
| j -> Util.json_error "Expected string for Role" j
module ProgressToken = struct
···
let yojson_of_t t = `String t
let t_of_yojson = function
49
-
| j -> raise (Json.Of_json ("Expected string for Cursor", j))
194
+
| j -> Util.json_error "Expected string for Cursor" j
module Annotated = struct
56
-
annotations: annotation option;
59
-
audience: Role.t list option;
60
-
priority: float option;
200
+
type t = { annotations : annotation option }
201
+
and annotation = { audience : Role.t list option; priority : float option }
let yojson_of_annotation { audience; priority } =
65
-
let assoc = match audience with
66
-
| Some audience -> ("audience", `List (List.map Role.yojson_of_t audience)) :: assoc
206
+
match audience with
208
+
("audience", `List (List.map Role.yojson_of_t audience)) :: assoc
69
-
let assoc = match priority with
212
+
match priority with
| Some priority -> ("priority", `Float priority) :: assoc
···
let annotation_of_yojson = function
77
-
let audience = List.assoc_opt "audience" fields |> Option.map (function
78
-
| `List items -> List.map Role.t_of_yojson items
79
-
| j -> raise (Json.Of_json ("Expected list for audience", j))
81
-
let priority = List.assoc_opt "priority" fields |> Option.map (function
83
-
| j -> raise (Json.Of_json ("Expected float for priority", j))
85
-
{ audience; priority }
86
-
| j -> raise (Json.Of_json ("Expected object for annotation", j))
221
+
List.assoc_opt "audience" fields
222
+
|> Option.map (function
223
+
| `List items -> List.map Role.t_of_yojson items
224
+
| j -> Util.json_error "Expected list for audience" j)
227
+
List.assoc_opt "priority" fields
228
+
|> Option.map (function
230
+
| j -> Util.json_error "Expected float for priority" j)
232
+
{ audience; priority }
233
+
| j -> Util.json_error "Expected object for annotation" j
let yojson_of_t { annotations } =
90
-
| Some annotations -> `Assoc [ "annotations", yojson_of_annotation annotations ]
237
+
| Some annotations ->
238
+
`Assoc [ ("annotations", yojson_of_annotation annotations) ]
let t_of_yojson = function
95
-
let annotations = List.assoc_opt "annotations" fields |> Option.map annotation_of_yojson in
97
-
| j -> raise (Json.Of_json ("Expected object for Annotated", j))
244
+
List.assoc_opt "annotations" fields |> Option.map annotation_of_yojson
247
+
| j -> Util.json_error "Expected object for Annotated" j
module TextContent = struct
105
-
annotations: Annotated.annotation option;
253
+
type t = { text : string; annotations : Annotated.annotation option }
let yojson_of_t { text; annotations } =
110
-
("text", `String text);
111
-
("type", `String "text");
113
-
let assoc = match annotations with
114
-
| Some annotations -> ("annotations", Annotated.yojson_of_annotation annotations) :: assoc
256
+
let assoc = [ ("text", `String text); ("type", `String "text") ] in
258
+
match annotations with
259
+
| Some annotations ->
260
+
("annotations", Annotated.yojson_of_annotation annotations) :: assoc
let t_of_yojson = function
121
-
let text = match List.assoc_opt "text" fields with
122
-
| Some (`String s) -> s
123
-
| _ -> raise (Json.Of_json ("Missing or invalid 'text' field", `Assoc fields))
125
-
let _ = match List.assoc_opt "type" fields with
126
-
| Some (`String "text") -> ()
127
-
| _ -> raise (Json.Of_json ("Missing or invalid 'type' field", `Assoc fields))
129
-
let annotations = List.assoc_opt "annotations" fields |> Option.map Annotated.annotation_of_yojson in
130
-
{ text; annotations }
131
-
| j -> raise (Json.Of_json ("Expected object for TextContent", j))
266
+
| `Assoc fields as json ->
267
+
let text = Util.get_string_field fields "text" json in
268
+
Util.verify_string_field fields "type" "text" json;
270
+
List.assoc_opt "annotations" fields
271
+
|> Option.map Annotated.annotation_of_yojson
273
+
{ text; annotations }
274
+
| j -> Util.json_error "Expected object for TextContent" j
module ImageContent = struct
138
-
annotations: Annotated.annotation option;
280
+
mime_type : string;
281
+
annotations : Annotated.annotation option;
let yojson_of_t { data; mime_type; annotations } =
143
-
("data", `String data);
144
-
("mimeType", `String mime_type);
145
-
("type", `String "image");
147
-
let assoc = match annotations with
148
-
| Some annotations -> ("annotations", Annotated.yojson_of_annotation annotations) :: assoc
287
+
("type", `String "image");
288
+
("data", `String data);
289
+
("mimeType", `String mime_type);
293
+
match annotations with
294
+
| Some annotations ->
295
+
("annotations", Annotated.yojson_of_annotation annotations) :: assoc
let t_of_yojson = function
155
-
let data = match List.assoc_opt "data" fields with
156
-
| Some (`String s) -> s
157
-
| _ -> raise (Json.Of_json ("Missing or invalid 'data' field", `Assoc fields))
159
-
let mime_type = match List.assoc_opt "mimeType" fields with
160
-
| Some (`String s) -> s
161
-
| _ -> raise (Json.Of_json ("Missing or invalid 'mimeType' field", `Assoc fields))
163
-
let _ = match List.assoc_opt "type" fields with
164
-
| Some (`String "image") -> ()
165
-
| _ -> raise (Json.Of_json ("Missing or invalid 'type' field", `Assoc fields))
167
-
let annotations = List.assoc_opt "annotations" fields |> Option.map Annotated.annotation_of_yojson in
168
-
{ data; mime_type; annotations }
169
-
| j -> raise (Json.Of_json ("Expected object for ImageContent", j))
301
+
| `Assoc fields as json ->
302
+
let data = Util.get_string_field fields "data" json in
303
+
let mime_type = Util.get_string_field fields "mimeType" json in
304
+
Util.verify_string_field fields "type" "image" json;
306
+
List.assoc_opt "annotations" fields
307
+
|> Option.map Annotated.annotation_of_yojson
309
+
{ data; mime_type; annotations }
310
+
| j -> Util.json_error "Expected object for ImageContent" j
module AudioContent = struct
176
-
annotations: Annotated.annotation option;
316
+
mime_type : string;
317
+
annotations : Annotated.annotation option;
let yojson_of_t { data; mime_type; annotations } =
181
-
("data", `String data);
182
-
("mimeType", `String mime_type);
183
-
("type", `String "audio");
185
-
let assoc = match annotations with
186
-
| Some annotations -> ("annotations", Annotated.yojson_of_annotation annotations) :: assoc
323
+
("type", `String "audio");
324
+
("data", `String data);
325
+
("mimeType", `String mime_type);
329
+
match annotations with
330
+
| Some annotations ->
331
+
("annotations", Annotated.yojson_of_annotation annotations) :: assoc
let t_of_yojson = function
193
-
let data = match List.assoc_opt "data" fields with
194
-
| Some (`String s) -> s
195
-
| _ -> raise (Json.Of_json ("Missing or invalid 'data' field", `Assoc fields))
197
-
let mime_type = match List.assoc_opt "mimeType" fields with
198
-
| Some (`String s) -> s
199
-
| _ -> raise (Json.Of_json ("Missing or invalid 'mimeType' field", `Assoc fields))
201
-
let _ = match List.assoc_opt "type" fields with
202
-
| Some (`String "audio") -> ()
203
-
| _ -> raise (Json.Of_json ("Missing or invalid 'type' field", `Assoc fields))
205
-
let annotations = List.assoc_opt "annotations" fields |> Option.map Annotated.annotation_of_yojson in
206
-
{ data; mime_type; annotations }
207
-
| j -> raise (Json.Of_json ("Expected object for AudioContent", j))
337
+
| `Assoc fields as json ->
338
+
let data = Util.get_string_field fields "data" json in
339
+
let mime_type = Util.get_string_field fields "mimeType" json in
340
+
Util.verify_string_field fields "type" "audio" json;
342
+
List.assoc_opt "annotations" fields
343
+
|> Option.map Annotated.annotation_of_yojson
345
+
{ data; mime_type; annotations }
346
+
| j -> Util.json_error "Expected object for AudioContent" j
module ResourceContents = struct
213
-
mime_type: string option;
350
+
type t = { uri : string; mime_type : string option }
let yojson_of_t { uri; mime_type } =
218
-
("uri", `String uri);
220
-
let assoc = match mime_type with
353
+
let assoc = [ ("uri", `String uri) ] in
355
+
match mime_type with
| Some mime_type -> ("mimeType", `String mime_type) :: assoc
let t_of_yojson = function
228
-
let uri = match List.assoc_opt "uri" fields with
229
-
| Some (`String s) -> s
230
-
| _ -> raise (Json.Of_json ("Missing or invalid 'uri' field", `Assoc fields))
232
-
let mime_type = List.assoc_opt "mimeType" fields |> Option.map (function
234
-
| j -> raise (Json.Of_json ("Expected string for mimeType", j))
237
-
| j -> raise (Json.Of_json ("Expected object for ResourceContents", j))
362
+
| `Assoc fields as json ->
363
+
let uri = Util.get_string_field fields "uri" json in
364
+
let mime_type = Util.get_optional_string_field fields "mimeType" in
366
+
| j -> Util.json_error "Expected object for ResourceContents" j
module TextResourceContents = struct
244
-
mime_type: string option;
370
+
type t = { uri : string; text : string; mime_type : string option }
let yojson_of_t { uri; text; mime_type } =
249
-
("uri", `String uri);
250
-
("text", `String text);
252
-
let assoc = match mime_type with
373
+
let assoc = [ ("uri", `String uri); ("text", `String text) ] in
375
+
match mime_type with
| Some mime_type -> ("mimeType", `String mime_type) :: assoc
let t_of_yojson = function
260
-
let uri = match List.assoc_opt "uri" fields with
261
-
| Some (`String s) -> s
262
-
| _ -> raise (Json.Of_json ("Missing or invalid 'uri' field", `Assoc fields))
264
-
let text = match List.assoc_opt "text" fields with
265
-
| Some (`String s) -> s
266
-
| _ -> raise (Json.Of_json ("Missing or invalid 'text' field", `Assoc fields))
268
-
let mime_type = List.assoc_opt "mimeType" fields |> Option.map (function
270
-
| j -> raise (Json.Of_json ("Expected string for mimeType", j))
272
-
{ uri; text; mime_type }
273
-
| j -> raise (Json.Of_json ("Expected object for TextResourceContents", j))
382
+
| `Assoc fields as json ->
383
+
let uri = Util.get_string_field fields "uri" json in
384
+
let text = Util.get_string_field fields "text" json in
385
+
let mime_type = Util.get_optional_string_field fields "mimeType" in
386
+
{ uri; text; mime_type }
387
+
| j -> Util.json_error "Expected object for TextResourceContents" j
module BlobResourceContents = struct
280
-
mime_type: string option;
391
+
type t = { uri : string; blob : string; mime_type : string option }
let yojson_of_t { uri; blob; mime_type } =
285
-
("uri", `String uri);
286
-
("blob", `String blob);
288
-
let assoc = match mime_type with
394
+
let assoc = [ ("uri", `String uri); ("blob", `String blob) ] in
396
+
match mime_type with
| Some mime_type -> ("mimeType", `String mime_type) :: assoc
let t_of_yojson = function
296
-
let uri = match List.assoc_opt "uri" fields with
297
-
| Some (`String s) -> s
298
-
| _ -> raise (Json.Of_json ("Missing or invalid 'uri' field", `Assoc fields))
300
-
let blob = match List.assoc_opt "blob" fields with
301
-
| Some (`String s) -> s
302
-
| _ -> raise (Json.Of_json ("Missing or invalid 'blob' field", `Assoc fields))
304
-
let mime_type = List.assoc_opt "mimeType" fields |> Option.map (function
306
-
| j -> raise (Json.Of_json ("Expected string for mimeType", j))
308
-
{ uri; blob; mime_type }
309
-
| j -> raise (Json.Of_json ("Expected object for BlobResourceContents", j))
403
+
| `Assoc fields as json ->
404
+
let uri = Util.get_string_field fields "uri" json in
405
+
let blob = Util.get_string_field fields "blob" json in
406
+
let mime_type = Util.get_optional_string_field fields "mimeType" in
407
+
{ uri; blob; mime_type }
408
+
| j -> Util.json_error "Expected object for BlobResourceContents" j
module EmbeddedResource = struct
314
-
resource: [ `Text of TextResourceContents.t | `Blob of BlobResourceContents.t ];
315
-
annotations: Annotated.annotation option;
414
+
[ `Text of TextResourceContents.t | `Blob of BlobResourceContents.t ];
415
+
annotations : Annotated.annotation option;
let yojson_of_t { resource; annotations } =
319
-
let resource_json = match resource with
419
+
let resource_json =
420
+
match resource with
| `Text txt -> TextResourceContents.yojson_of_t txt
| `Blob blob -> BlobResourceContents.yojson_of_t blob
324
-
("resource", resource_json);
325
-
("type", `String "resource");
327
-
let assoc = match annotations with
328
-
| Some annotations -> ("annotations", Annotated.yojson_of_annotation annotations) :: assoc
424
+
let assoc = [ ("resource", resource_json); ("type", `String "resource") ] in
426
+
match annotations with
427
+
| Some annotations ->
428
+
("annotations", Annotated.yojson_of_annotation annotations) :: assoc
let t_of_yojson = function
335
-
let _ = match List.assoc_opt "type" fields with
336
-
| Some (`String "resource") -> ()
337
-
| _ -> raise (Json.Of_json ("Missing or invalid 'type' field", `Assoc fields))
339
-
let resource = match List.assoc_opt "resource" fields with
340
-
| Some (`Assoc res_fields) ->
341
-
if List.mem_assoc "text" res_fields then
342
-
`Text (TextResourceContents.t_of_yojson (`Assoc res_fields))
343
-
else if List.mem_assoc "blob" res_fields then
344
-
`Blob (BlobResourceContents.t_of_yojson (`Assoc res_fields))
434
+
| `Assoc fields as json ->
435
+
Util.verify_string_field fields "type" "resource" json;
436
+
let resource_fields =
437
+
match List.assoc_opt "resource" fields with
438
+
| Some (`Assoc res_fields) -> res_fields
439
+
| _ -> Util.json_error "Missing or invalid 'resource' field" json
442
+
if List.mem_assoc "text" resource_fields then
443
+
`Text (TextResourceContents.t_of_yojson (`Assoc resource_fields))
444
+
else if List.mem_assoc "blob" resource_fields then
445
+
`Blob (BlobResourceContents.t_of_yojson (`Assoc resource_fields))
346
-
raise (Json.Of_json ("Invalid resource content", `Assoc res_fields))
347
-
| _ -> raise (Json.Of_json ("Missing or invalid 'resource' field", `Assoc fields))
349
-
let annotations = List.assoc_opt "annotations" fields |> Option.map Annotated.annotation_of_yojson in
350
-
{ resource; annotations }
351
-
| j -> raise (Json.Of_json ("Expected object for EmbeddedResource", j))
447
+
Util.json_error "Invalid resource content" (`Assoc resource_fields)
450
+
List.assoc_opt "annotations" fields
451
+
|> Option.map Annotated.annotation_of_yojson
453
+
{ resource; annotations }
454
+
| j -> Util.json_error "Expected object for EmbeddedResource" j
354
-
(** Tool definition *)
355
-
module Tool = struct
358
-
description: string option;
359
-
input_schema: Json.t;
362
-
let yojson_of_t { name; description; input_schema } =
364
-
("name", `String name);
365
-
("inputSchema", input_schema);
367
-
let assoc = match description with
368
-
| Some desc -> ("description", `String desc) :: assoc
373
-
let t_of_yojson = function
375
-
let name = match List.assoc_opt "name" fields with
376
-
| Some (`String s) -> s
377
-
| _ -> raise (Json.Of_json ("Missing or invalid 'name' field", `Assoc fields))
379
-
let description = match List.assoc_opt "description" fields with
380
-
| Some (`String s) -> Some s
383
-
let input_schema = match List.assoc_opt "inputSchema" fields with
384
-
| Some json -> json
385
-
| _ -> raise (Json.Of_json ("Missing 'inputSchema' field", `Assoc fields))
387
-
{ name; description; input_schema }
388
-
| j -> raise (Json.Of_json ("Expected object for Tool", j))
| Image of ImageContent.t
| Audio of AudioContent.t
···
| Resource r -> EmbeddedResource.yojson_of_t r
let content_of_yojson = function
405
-
(match List.assoc_opt "type" fields with
406
-
| Some (`String "text") -> Text (TextContent.t_of_yojson (`Assoc fields))
407
-
| Some (`String "image") -> Image (ImageContent.t_of_yojson (`Assoc fields))
408
-
| Some (`String "audio") -> Audio (AudioContent.t_of_yojson (`Assoc fields))
409
-
| Some (`String "resource") -> Resource (EmbeddedResource.t_of_yojson (`Assoc fields))
410
-
| _ -> raise (Json.Of_json ("Invalid or missing content type", `Assoc fields)))
411
-
| j -> raise (Json.Of_json ("Expected object for content", j))
414
-
module CallToolResult = struct
416
-
content: content list;
418
-
meta: Json.t option;
421
-
let yojson_of_t { content; is_error; meta } =
423
-
("content", `List (List.map yojson_of_content content));
424
-
("isError", `Bool is_error);
426
-
let assoc = match meta with
427
-
| Some meta_json -> ("_meta", meta_json) :: assoc
432
-
let t_of_yojson = function
434
-
let content = match List.assoc_opt "content" fields with
435
-
| Some (`List items) -> List.map content_of_yojson items
436
-
| _ -> raise (Json.Of_json ("Missing or invalid 'content' field", `Assoc fields))
438
-
let is_error = match List.assoc_opt "isError" fields with
439
-
| Some (`Bool b) -> b
440
-
| None -> false (* Default to false if not specified *)
441
-
| _ -> raise (Json.Of_json ("Invalid 'isError' field", `Assoc fields))
443
-
let meta = List.assoc_opt "_meta" fields in
444
-
{ content; is_error; meta }
445
-
| j -> raise (Json.Of_json ("Expected object for CallToolResult", j))
448
-
(** Resource definition *)
449
-
module Resource = struct
453
-
description: string option;
454
-
mime_type: string option;
456
-
annotations: Annotated.annotation option;
459
-
let yojson_of_t { name; uri; description; mime_type; size; annotations } =
461
-
("name", `String name);
462
-
("uri", `String uri);
464
-
let assoc = match description with
465
-
| Some desc -> ("description", `String desc) :: assoc
468
-
let assoc = match mime_type with
469
-
| Some mime -> ("mimeType", `String mime) :: assoc
472
-
let assoc = match size with
473
-
| Some s -> ("size", `Int s) :: assoc
476
-
let assoc = match annotations with
477
-
| Some ann -> ("annotations", Annotated.yojson_of_annotation ann) :: assoc
482
-
let t_of_yojson = function
484
-
let name = match List.assoc_opt "name" fields with
485
-
| Some (`String s) -> s
486
-
| _ -> raise (Json.Of_json ("Missing or invalid 'name' field", `Assoc fields))
488
-
let uri = match List.assoc_opt "uri" fields with
489
-
| Some (`String s) -> s
490
-
| _ -> raise (Json.Of_json ("Missing or invalid 'uri' field", `Assoc fields))
492
-
let description = match List.assoc_opt "description" fields with
493
-
| Some (`String s) -> Some s
496
-
let mime_type = match List.assoc_opt "mimeType" fields with
497
-
| Some (`String s) -> Some s
500
-
let size = match List.assoc_opt "size" fields with
501
-
| Some (`Int s) -> Some s
504
-
let annotations = match List.assoc_opt "annotations" fields with
505
-
| Some json -> Some (Annotated.annotation_of_yojson json)
508
-
{ name; uri; description; mime_type; size; annotations }
509
-
| j -> raise (Json.Of_json ("Expected object for Resource", j))
512
-
(** Resource Template definition *)
513
-
module ResourceTemplate = struct
516
-
uri_template: string;
517
-
description: string option;
518
-
mime_type: string option;
519
-
annotations: Annotated.annotation option;
522
-
let yojson_of_t { name; uri_template; description; mime_type; annotations } =
524
-
("name", `String name);
525
-
("uriTemplate", `String uri_template);
527
-
let assoc = match description with
528
-
| Some desc -> ("description", `String desc) :: assoc
531
-
let assoc = match mime_type with
532
-
| Some mime -> ("mimeType", `String mime) :: assoc
535
-
let assoc = match annotations with
536
-
| Some ann -> ("annotations", Annotated.yojson_of_annotation ann) :: assoc
541
-
let t_of_yojson = function
543
-
let name = match List.assoc_opt "name" fields with
544
-
| Some (`String s) -> s
545
-
| _ -> raise (Json.Of_json ("Missing or invalid 'name' field", `Assoc fields))
547
-
let uri_template = match List.assoc_opt "uriTemplate" fields with
548
-
| Some (`String s) -> s
549
-
| _ -> raise (Json.Of_json ("Missing or invalid 'uriTemplate' field", `Assoc fields))
551
-
let description = match List.assoc_opt "description" fields with
552
-
| Some (`String s) -> Some s
555
-
let mime_type = match List.assoc_opt "mimeType" fields with
556
-
| Some (`String s) -> Some s
559
-
let annotations = match List.assoc_opt "annotations" fields with
560
-
| Some json -> Some (Annotated.annotation_of_yojson json)
563
-
{ name; uri_template; description; mime_type; annotations }
564
-
| j -> raise (Json.Of_json ("Expected object for ResourceTemplate", j))
567
-
(** Resource Reference *)
568
-
module ResourceReference = struct
573
-
let yojson_of_t { uri } =
575
-
("type", `String "ref/resource");
576
-
("uri", `String uri);
579
-
let t_of_yojson = function
581
-
let _ = match List.assoc_opt "type" fields with
582
-
| Some (`String "ref/resource") -> ()
583
-
| _ -> raise (Json.Of_json ("Missing or invalid 'type' field", `Assoc fields))
585
-
let uri = match List.assoc_opt "uri" fields with
586
-
| Some (`String s) -> s
587
-
| _ -> raise (Json.Of_json ("Missing or invalid 'uri' field", `Assoc fields))
590
-
| j -> raise (Json.Of_json ("Expected object for ResourceReference", j))
593
-
(** Prompt Reference *)
594
-
module PromptReference = struct
599
-
let yojson_of_t { name } =
601
-
("type", `String "ref/prompt");
602
-
("name", `String name);
605
-
let t_of_yojson = function
607
-
let _ = match List.assoc_opt "type" fields with
608
-
| Some (`String "ref/prompt") -> ()
609
-
| _ -> raise (Json.Of_json ("Missing or invalid 'type' field", `Assoc fields))
611
-
let name = match List.assoc_opt "name" fields with
612
-
| Some (`String s) -> s
613
-
| _ -> raise (Json.Of_json ("Missing or invalid 'name' field", `Assoc fields))
616
-
| j -> raise (Json.Of_json ("Expected object for PromptReference", j))
619
-
(** Completion support *)
620
-
module Completion = struct
622
-
module Argument = struct
628
-
let yojson_of_t { name; value } =
630
-
("name", `String name);
631
-
("value", `String value);
634
-
let t_of_yojson = function
636
-
let name = match List.assoc_opt "name" fields with
637
-
| Some (`String s) -> s
638
-
| _ -> raise (Json.Of_json ("Missing or invalid 'name' field", `Assoc fields))
640
-
let value = match List.assoc_opt "value" fields with
641
-
| Some (`String s) -> s
642
-
| _ -> raise (Json.Of_json ("Missing or invalid 'value' field", `Assoc fields))
645
-
| j -> raise (Json.Of_json ("Expected object for Completion.Argument", j))
648
-
module Request = struct
649
-
type reference = [ `Prompt of PromptReference.t | `Resource of ResourceReference.t ]
652
-
argument: Argument.t;
656
-
let yojson_of_reference = function
657
-
| `Prompt p -> PromptReference.yojson_of_t p
658
-
| `Resource r -> ResourceReference.yojson_of_t r
660
-
let reference_of_yojson = function
662
-
(match List.assoc_opt "type" fields with
663
-
| Some (`String "ref/prompt") -> `Prompt (PromptReference.t_of_yojson (`Assoc fields))
664
-
| Some (`String "ref/resource") -> `Resource (ResourceReference.t_of_yojson (`Assoc fields))
665
-
| _ -> raise (Json.Of_json ("Invalid or missing reference type", `Assoc fields)))
666
-
| j -> raise (Json.Of_json ("Expected object for reference", j))
668
-
let yojson_of_t { argument; ref } =
670
-
("argument", Argument.yojson_of_t argument);
671
-
("ref", yojson_of_reference ref);
674
-
let t_of_yojson = function
676
-
let argument = match List.assoc_opt "argument" fields with
677
-
| Some json -> Argument.t_of_yojson json
678
-
| _ -> raise (Json.Of_json ("Missing argument field", `Assoc fields))
680
-
let ref = match List.assoc_opt "ref" fields with
681
-
| Some json -> reference_of_yojson json
682
-
| _ -> raise (Json.Of_json ("Missing ref field", `Assoc fields))
685
-
| j -> raise (Json.Of_json ("Expected object for Completion.Request", j))
687
-
let create ~argument ~ref =
694
-
module Result = struct
695
-
type completion = {
696
-
values: string list;
697
-
has_more: bool option;
702
-
completion: completion;
703
-
meta: Json.t option;
706
-
let yojson_of_completion { values; has_more; total } =
708
-
("values", `List (List.map (fun s -> `String s) values));
710
-
let assoc = match has_more with
711
-
| Some b -> ("hasMore", `Bool b) :: assoc
714
-
let assoc = match total with
715
-
| Some n -> ("total", `Int n) :: assoc
720
-
let completion_of_yojson = function
722
-
let values = match List.assoc_opt "values" fields with
723
-
| Some (`List items) ->
726
-
| _ -> raise (Json.Of_json ("Expected string in values array", `List items))
728
-
| _ -> raise (Json.Of_json ("Missing or invalid 'values' field", `Assoc fields))
730
-
let has_more = match List.assoc_opt "hasMore" fields with
731
-
| Some (`Bool b) -> Some b
733
-
| _ -> raise (Json.Of_json ("Invalid 'hasMore' field", `Assoc fields))
735
-
let total = match List.assoc_opt "total" fields with
736
-
| Some (`Int n) -> Some n
738
-
| _ -> raise (Json.Of_json ("Invalid 'total' field", `Assoc fields))
740
-
{ values; has_more; total }
741
-
| j -> raise (Json.Of_json ("Expected object for completion", j))
743
-
let yojson_of_t { completion; meta } =
745
-
("completion", yojson_of_completion completion);
747
-
let assoc = match meta with
748
-
| Some meta_json -> ("_meta", meta_json) :: assoc
753
-
let t_of_yojson = function
755
-
let completion = match List.assoc_opt "completion" fields with
756
-
| Some json -> completion_of_yojson json
757
-
| _ -> raise (Json.Of_json ("Missing completion field", `Assoc fields))
759
-
let meta = List.assoc_opt "_meta" fields in
760
-
{ completion; meta }
761
-
| j -> raise (Json.Of_json ("Expected object for Completion.Result", j))
763
-
let create ~completion ?meta () =
764
-
{ completion; meta }
470
+
| `Assoc fields as json -> (
471
+
match List.assoc_opt "type" fields with
472
+
| Some (`String "text") -> Text (TextContent.t_of_yojson json)
473
+
| Some (`String "image") -> Image (ImageContent.t_of_yojson json)
474
+
| Some (`String "audio") -> Audio (AudioContent.t_of_yojson json)
475
+
| Some (`String "resource") ->
476
+
Resource (EmbeddedResource.t_of_yojson json)
477
+
| _ -> Util.json_error "Invalid or missing content type" json)
478
+
| j -> Util.json_error "Expected object for content" j
module PromptMessage = struct
483
+
type t = { role : Role.t; content : content }
let yojson_of_t { role; content } =
781
-
("role", Role.yojson_of_t role);
782
-
("content", yojson_of_content content);
488
+
("role", Role.yojson_of_t role); ("content", yojson_of_content content);
let t_of_yojson = function
787
-
let role = match List.assoc_opt "role" fields with
788
-
| Some json -> Role.t_of_yojson json
789
-
| None -> raise (Json.Of_json ("Missing role field", `Assoc fields))
791
-
let content = match List.assoc_opt "content" fields with
792
-
| Some json -> content_of_yojson json
793
-
| None -> raise (Json.Of_json ("Missing content field", `Assoc fields))
796
-
| j -> raise (Json.Of_json ("Expected object for PromptMessage", j))
492
+
| `Assoc fields as json ->
494
+
match List.assoc_opt "role" fields with
495
+
| Some json -> Role.t_of_yojson json
496
+
| None -> Util.json_error "Missing role field" json
499
+
match List.assoc_opt "content" fields with
500
+
| Some json -> content_of_yojson json
501
+
| None -> Util.json_error "Missing content field" json
504
+
| j -> Util.json_error "Expected object for PromptMessage" j
module SamplingMessage = struct
802
-
content: [ `Text of TextContent.t | `Image of ImageContent.t ];
511
+
[ `Text of TextContent.t
512
+
| `Image of ImageContent.t
513
+
| `Audio of AudioContent.t ];
let yojson_of_t { role; content } =
806
-
let content_json = match content with
| `Text t -> TextContent.yojson_of_t t
| `Image i -> ImageContent.yojson_of_t i
521
+
| `Audio a -> AudioContent.yojson_of_t a
811
-
("role", Role.yojson_of_t role);
812
-
("content", content_json);
523
+
`Assoc [ ("role", Role.yojson_of_t role); ("content", content_json) ]
let t_of_yojson = function
817
-
let role = match List.assoc_opt "role" fields with
818
-
| Some json -> Role.t_of_yojson json
819
-
| None -> raise (Json.Of_json ("Missing role field", `Assoc fields))
821
-
let content = match List.assoc_opt "content" fields with
822
-
| Some (`Assoc content_fields) ->
823
-
(match List.assoc_opt "type" content_fields with
824
-
| Some (`String "text") -> `Text (TextContent.t_of_yojson (`Assoc content_fields))
825
-
| Some (`String "image") -> `Image (ImageContent.t_of_yojson (`Assoc content_fields))
826
-
| _ -> raise (Json.Of_json ("Invalid content type", `Assoc content_fields)))
827
-
| _ -> raise (Json.Of_json ("Missing or invalid content field", `Assoc fields))
830
-
| j -> raise (Json.Of_json ("Expected object for SamplingMessage", j))
526
+
| `Assoc fields as json ->
528
+
match List.assoc_opt "role" fields with
529
+
| Some json -> Role.t_of_yojson json
530
+
| None -> Util.json_error "Missing role field" json
533
+
match List.assoc_opt "content" fields with
534
+
| Some (`Assoc content_fields) -> content_fields
535
+
| _ -> Util.json_error "Missing or invalid content field" json
538
+
match List.assoc_opt "type" content_obj with
539
+
| Some (`String ty) -> ty
541
+
Util.json_error "Missing or invalid content type"
542
+
(`Assoc content_obj)
545
+
match content_type with
546
+
| "text" -> `Text (TextContent.t_of_yojson (`Assoc content_obj))
547
+
| "image" -> `Image (ImageContent.t_of_yojson (`Assoc content_obj))
548
+
| "audio" -> `Audio (AudioContent.t_of_yojson (`Assoc content_obj))
550
+
Util.json_error "Invalid content type: %s" (`Assoc content_obj)
554
+
| j -> Util.json_error "Expected object for SamplingMessage" j
(* Implementation info *)
module Implementation = struct
560
+
type t = { name : string; version : string }
let yojson_of_t { name; version } =
843
-
("name", `String name);
844
-
("version", `String version);
563
+
`Assoc [ ("name", `String name); ("version", `String version) ]
let t_of_yojson = function
849
-
let name = match List.assoc_opt "name" fields with
850
-
| Some (`String s) -> s
851
-
| _ -> raise (Json.Of_json ("Missing or invalid 'name' field", `Assoc fields))
853
-
let version = match List.assoc_opt "version" fields with
854
-
| Some (`String s) -> s
855
-
| _ -> raise (Json.Of_json ("Missing or invalid 'version' field", `Assoc fields))
858
-
| j -> raise (Json.Of_json ("Expected object for Implementation", j))
566
+
| `Assoc fields as json ->
567
+
let name = Util.get_string_field fields "name" json in
568
+
let version = Util.get_string_field fields "version" json in
570
+
| j -> Util.json_error "Expected object for Implementation" j
(* JSONRPC Message types *)
module JSONRPCMessage = struct
865
-
type notification = {
867
-
params: Json.t option;
576
+
type notification = { meth : Method.t; params : Json.t option }
873
-
params: Json.t option;
874
-
progress_token: ProgressToken.t option;
581
+
params : Json.t option;
582
+
progress_token : ProgressToken.t option;
585
+
type response = { id : RequestId.t; result : Json.t }
886
-
data: Json.t option;
591
+
data : Json.t option;
···
895
-
let yojson_of_notification (n: notification) =
897
-
("jsonrpc", `String "2.0");
898
-
("method", `String n.method_);
900
-
let assoc = match n.params with
600
+
let yojson_of_notification (n : notification) =
603
+
("jsonrpc", `String "2.0"); ("method", `String (Method.to_string n.meth));
607
+
match n.params with
| Some params -> ("params", params) :: assoc
906
-
let yojson_of_request (r: request) =
908
-
("jsonrpc", `String "2.0");
909
-
("id", Id.yojson_of_t r.id);
910
-
("method", `String r.method_);
912
-
let assoc = match r.params with
613
+
let yojson_of_request (r : request) =
616
+
("jsonrpc", `String "2.0");
617
+
("id", Id.yojson_of_t r.id);
618
+
("method", `String (Method.to_string r.meth));
622
+
match r.params with
914
-
let params_json = match params with
916
-
let fields = match r.progress_token with
918
-
let meta = `Assoc [ "progressToken", ProgressToken.yojson_of_t token ] in
919
-
("_meta", meta) :: fields
925
-
("params", params_json) :: assoc
628
+
match r.progress_token with
632
+
[ ("progressToken", ProgressToken.yojson_of_t token) ]
634
+
("_meta", meta) :: fields
640
+
("params", params_json) :: assoc
930
-
let yojson_of_response (r: response) =
932
-
("jsonrpc", `String "2.0");
933
-
("id", Id.yojson_of_t r.id);
934
-
("result", r.result);
645
+
let yojson_of_response (r : response) =
648
+
("jsonrpc", `String "2.0");
649
+
("id", Id.yojson_of_t r.id);
650
+
("result", r.result);
937
-
let yojson_of_error (e: error) =
938
-
let error_assoc = [
939
-
("code", `Int e.code);
940
-
("message", `String e.message);
942
-
let error_assoc = match e.data with
653
+
let yojson_of_error (e : error) =
655
+
[ ("code", `Int e.code); ("message", `String e.message) ]
| Some data -> ("data", data) :: error_assoc
947
-
("jsonrpc", `String "2.0");
948
-
("id", Id.yojson_of_t e.id);
949
-
("error", `Assoc error_assoc);
664
+
("jsonrpc", `String "2.0");
665
+
("id", Id.yojson_of_t e.id);
666
+
("error", `Assoc error_assoc);
let yojson_of_t = function
| Notification n -> yojson_of_notification n
···
let notification_of_yojson = function
960
-
let method_ = match List.assoc_opt "method" fields with
961
-
| Some (`String s) -> s
962
-
| _ -> raise (Json.Of_json ("Missing or invalid 'method' field", `Assoc fields))
964
-
let params = List.assoc_opt "params" fields in
965
-
{ method_; params }
966
-
| j -> raise (Json.Of_json ("Expected object for notification", j))
678
+
match List.assoc_opt "method" fields with
679
+
| Some (`String s) -> (
680
+
try Method.of_string s
681
+
with Failure msg -> Util.json_error "%s" (`String s) msg)
683
+
Util.json_error "Missing or invalid 'method' field"
686
+
let params = List.assoc_opt "params" fields in
688
+
| j -> Util.json_error "Expected object for notification" j
let request_of_yojson = function
970
-
let id = match List.assoc_opt "id" fields with
971
-
| Some id_json -> Id.t_of_yojson id_json
972
-
| _ -> raise (Json.Of_json ("Missing or invalid 'id' field", `Assoc fields))
974
-
let method_ = match List.assoc_opt "method" fields with
975
-
| Some (`String s) -> s
976
-
| _ -> raise (Json.Of_json ("Missing or invalid 'method' field", `Assoc fields))
978
-
let params = List.assoc_opt "params" fields in
979
-
let progress_token =
981
-
| Some (`Assoc param_fields) ->
982
-
(match List.assoc_opt "_meta" param_fields with
983
-
| Some (`Assoc meta_fields) ->
984
-
(match List.assoc_opt "progressToken" meta_fields with
985
-
| Some token_json -> Some (ProgressToken.t_of_yojson token_json)
990
-
{ id; method_; params; progress_token }
991
-
| j -> raise (Json.Of_json ("Expected object for request", j))
693
+
match List.assoc_opt "id" fields with
694
+
| Some id_json -> Id.t_of_yojson id_json
695
+
| _ -> Util.json_error "Missing or invalid 'id' field" (`Assoc fields)
698
+
match List.assoc_opt "method" fields with
699
+
| Some (`String s) -> (
700
+
try Method.of_string s
701
+
with Failure msg -> Util.json_error "%s" (`String s) msg)
703
+
Util.json_error "Missing or invalid 'method' field"
706
+
let params = List.assoc_opt "params" fields in
707
+
let progress_token =
709
+
| Some (`Assoc param_fields) -> (
710
+
match List.assoc_opt "_meta" param_fields with
711
+
| Some (`Assoc meta_fields) -> (
712
+
match List.assoc_opt "progressToken" meta_fields with
713
+
| Some token_json ->
714
+
Some (ProgressToken.t_of_yojson token_json)
719
+
{ id; meth; params; progress_token }
720
+
| j -> Util.json_error "Expected object for request" j
let response_of_yojson = function
995
-
let id = match List.assoc_opt "id" fields with
996
-
| Some id_json -> Id.t_of_yojson id_json
997
-
| _ -> raise (Json.Of_json ("Missing or invalid 'id' field", `Assoc fields))
999
-
let result = match List.assoc_opt "result" fields with
1000
-
| Some result -> result
1001
-
| _ -> raise (Json.Of_json ("Missing 'result' field", `Assoc fields))
1004
-
| j -> raise (Json.Of_json ("Expected object for response", j))
725
+
match List.assoc_opt "id" fields with
726
+
| Some id_json -> Id.t_of_yojson id_json
727
+
| _ -> Util.json_error "Missing or invalid 'id' field" (`Assoc fields)
730
+
match List.assoc_opt "result" fields with
731
+
| Some result -> result
732
+
| _ -> Util.json_error "Missing 'result' field" (`Assoc fields)
735
+
| j -> Util.json_error "Expected object for response" j
let error_of_yojson = function
1007
-
| `Assoc fields ->
1008
-
let id = match List.assoc_opt "id" fields with
1009
-
| Some id_json -> Id.t_of_yojson id_json
1010
-
| _ -> raise (Json.Of_json ("Missing or invalid 'id' field", `Assoc fields))
1012
-
let error = match List.assoc_opt "error" fields with
1013
-
| Some (`Assoc error_fields) -> error_fields
1014
-
| _ -> raise (Json.Of_json ("Missing or invalid 'error' field", `Assoc fields))
1016
-
let code = match List.assoc_opt "code" error with
1017
-
| Some (`Int code) -> code
1018
-
| _ -> raise (Json.Of_json ("Missing or invalid 'code' field in error", `Assoc error))
1020
-
let message = match List.assoc_opt "message" error with
1021
-
| Some (`String msg) -> msg
1022
-
| _ -> raise (Json.Of_json ("Missing or invalid 'message' field in error", `Assoc error))
1024
-
let data = List.assoc_opt "data" error in
1025
-
{ id; code; message; data }
1026
-
| j -> raise (Json.Of_json ("Expected object for error", j))
738
+
| `Assoc fields as json ->
740
+
match List.assoc_opt "id" fields with
741
+
| Some id_json -> Id.t_of_yojson id_json
742
+
| _ -> Util.json_error "Missing or invalid 'id' field" json
745
+
match List.assoc_opt "error" fields with
746
+
| Some (`Assoc error_fields) -> error_fields
747
+
| _ -> Util.json_error "Missing or invalid 'error' field" json
750
+
match List.assoc_opt "code" error with
751
+
| Some (`Int code) -> code
753
+
Util.json_error "Missing or invalid 'code' field in error"
757
+
match List.assoc_opt "message" error with
758
+
| Some (`String msg) -> msg
760
+
Util.json_error "Missing or invalid 'message' field in error"
763
+
let data = List.assoc_opt "data" error in
764
+
{ id; code; message; data }
765
+
| j -> Util.json_error "Expected object for error" j
1031
-
let _jsonrpc = match List.assoc_opt "jsonrpc" fields with
1032
-
| Some (`String "2.0") -> ()
1033
-
| _ -> raise (Json.Of_json ("Missing or invalid 'jsonrpc' field", json))
1035
-
if List.mem_assoc "method" fields then
1036
-
if List.mem_assoc "id" fields then
1037
-
Request (request_of_yojson json)
1039
-
Notification (notification_of_yojson json)
1040
-
else if List.mem_assoc "result" fields then
1041
-
Response (response_of_yojson json)
1042
-
else if List.mem_assoc "error" fields then
1043
-
Error (error_of_yojson json)
1045
-
raise (Json.Of_json ("Invalid JSONRPC message format", json))
1046
-
| j -> raise (Json.Of_json ("Expected object for JSONRPC message", j))
771
+
match List.assoc_opt "jsonrpc" fields with
772
+
| Some (`String "2.0") -> ()
773
+
| _ -> Util.json_error "Missing or invalid 'jsonrpc' field" json
775
+
if List.mem_assoc "method" fields then
776
+
if List.mem_assoc "id" fields then Request (request_of_yojson json)
777
+
else Notification (notification_of_yojson json)
778
+
else if List.mem_assoc "result" fields then
779
+
Response (response_of_yojson json)
780
+
else if List.mem_assoc "error" fields then Error (error_of_yojson json)
781
+
else Util.json_error "Invalid JSONRPC message format" json
782
+
| j -> Util.json_error "Expected object for JSONRPC message" j
1048
-
let create_notification ?(params=None) ~method_ () =
1049
-
Notification { method_; params }
784
+
let create_notification ?(params = None) ~meth () =
785
+
Notification { meth; params }
1051
-
let create_request ?(params=None) ?(progress_token=None) ~id ~method_ () =
1052
-
Request { id; method_; params; progress_token }
787
+
let create_request ?(params = None) ?(progress_token = None) ~id ~meth () =
788
+
Request { id; meth; params; progress_token }
1054
-
let create_response ~id ~result =
1055
-
Response { id; result }
790
+
let create_response ~id ~result = Response { id; result }
1057
-
let create_error ~id ~code ~message ?(data=None) () =
792
+
let create_error ~id ~code ~message ?(data = None) () =
Error { id; code; message; data }
···
module Initialize = struct
1066
-
capabilities: Json.t; (* ClientCapabilities *)
1067
-
client_info: Implementation.t;
1068
-
protocol_version: string;
801
+
capabilities : Json.t; (* ClientCapabilities *)
802
+
client_info : Implementation.t;
803
+
protocol_version : string;
let yojson_of_t { capabilities; client_info; protocol_version } =
1073
-
("capabilities", capabilities);
1074
-
("clientInfo", Implementation.yojson_of_t client_info);
1075
-
("protocolVersion", `String protocol_version);
809
+
("capabilities", capabilities);
810
+
("clientInfo", Implementation.yojson_of_t client_info);
811
+
("protocolVersion", `String protocol_version);
let t_of_yojson = function
1079
-
| `Assoc fields ->
1080
-
let capabilities = match List.assoc_opt "capabilities" fields with
1081
-
| Some json -> json
1082
-
| None -> raise (Json.Of_json ("Missing capabilities field", `Assoc fields))
1084
-
let client_info = match List.assoc_opt "clientInfo" fields with
1085
-
| Some json -> Implementation.t_of_yojson json
1086
-
| None -> raise (Json.Of_json ("Missing clientInfo field", `Assoc fields))
1088
-
let protocol_version = match List.assoc_opt "protocolVersion" fields with
1089
-
| Some (`String s) -> s
1090
-
| _ -> raise (Json.Of_json ("Missing or invalid protocolVersion field", `Assoc fields))
1092
-
{ capabilities; client_info; protocol_version }
1093
-
| j -> raise (Json.Of_json ("Expected object for InitializeRequest", j))
815
+
| `Assoc fields as json ->
817
+
match List.assoc_opt "capabilities" fields with
818
+
| Some json -> json
819
+
| None -> Util.json_error "Missing capabilities field" json
822
+
match List.assoc_opt "clientInfo" fields with
823
+
| Some json -> Implementation.t_of_yojson json
824
+
| None -> Util.json_error "Missing clientInfo field" json
826
+
let protocol_version =
827
+
Util.get_string_field fields "protocolVersion" json
829
+
{ capabilities; client_info; protocol_version }
830
+
| j -> Util.json_error "Expected object for InitializeRequest" j
let create ~capabilities ~client_info ~protocol_version =
{ capabilities; client_info; protocol_version }
let params = yojson_of_t t in
1100
-
JSONRPCMessage.create_request ~id ~method_:"initialize" ~params:(Some params) ()
837
+
JSONRPCMessage.create_request ~id ~meth:Method.Initialize
838
+
~params:(Some params) ()
1105
-
capabilities: Json.t; (* ServerCapabilities *)
1106
-
server_info: Implementation.t;
1107
-
protocol_version: string;
1108
-
instructions: string option;
1109
-
meta: Json.t option;
843
+
capabilities : Json.t; (* ServerCapabilities *)
844
+
server_info : Implementation.t;
845
+
protocol_version : string;
846
+
instructions : string option;
847
+
meta : Json.t option;
1112
-
let yojson_of_t { capabilities; server_info; protocol_version; instructions; meta } =
1114
-
("capabilities", capabilities);
1115
-
("serverInfo", Implementation.yojson_of_t server_info);
1116
-
("protocolVersion", `String protocol_version);
1118
-
let assoc = match instructions with
851
+
{ capabilities; server_info; protocol_version; instructions; meta } =
854
+
("capabilities", capabilities);
855
+
("serverInfo", Implementation.yojson_of_t server_info);
856
+
("protocolVersion", `String protocol_version);
860
+
match instructions with
| Some instr -> ("instructions", `String instr) :: assoc
1122
-
let assoc = match meta with
1123
-
| Some meta -> ("_meta", meta) :: assoc
865
+
match meta with Some meta -> ("_meta", meta) :: assoc | None -> assoc
let t_of_yojson = function
1129
-
| `Assoc fields ->
1130
-
let capabilities = match List.assoc_opt "capabilities" fields with
1131
-
| Some json -> json
1132
-
| None -> raise (Json.Of_json ("Missing capabilities field", `Assoc fields))
1134
-
let server_info = match List.assoc_opt "serverInfo" fields with
1135
-
| Some json -> Implementation.t_of_yojson json
1136
-
| None -> raise (Json.Of_json ("Missing serverInfo field", `Assoc fields))
1138
-
let protocol_version = match List.assoc_opt "protocolVersion" fields with
1139
-
| Some (`String s) -> s
1140
-
| _ -> raise (Json.Of_json ("Missing or invalid protocolVersion field", `Assoc fields))
1142
-
let instructions = match List.assoc_opt "instructions" fields with
1143
-
| Some (`String s) -> Some s
1146
-
let meta = List.assoc_opt "_meta" fields in
1147
-
{ capabilities; server_info; protocol_version; instructions; meta }
1148
-
| j -> raise (Json.Of_json ("Expected object for InitializeResult", j))
870
+
| `Assoc fields as json ->
872
+
match List.assoc_opt "capabilities" fields with
873
+
| Some json -> json
874
+
| None -> Util.json_error "Missing capabilities field" json
877
+
match List.assoc_opt "serverInfo" fields with
878
+
| Some json -> Implementation.t_of_yojson json
879
+
| None -> Util.json_error "Missing serverInfo field" json
881
+
let protocol_version =
882
+
Util.get_string_field fields "protocolVersion" json
885
+
Util.get_optional_string_field fields "instructions"
887
+
let meta = List.assoc_opt "_meta" fields in
888
+
{ capabilities; server_info; protocol_version; instructions; meta }
889
+
| j -> Util.json_error "Expected object for InitializeResult" j
1150
-
let create ~capabilities ~server_info ~protocol_version ?instructions ?meta () =
891
+
let create ~capabilities ~server_info ~protocol_version ?instructions ?meta
{ capabilities; server_info; protocol_version; instructions; meta }
···
module Initialized = struct
module Notification = struct
1161
-
meta: Json.t option;
902
+
type t = { meta : Json.t option }
let yojson_of_t { meta } =
1166
-
let assoc = match meta with
1167
-
| Some meta -> ("_meta", meta) :: assoc
907
+
match meta with Some meta -> ("_meta", meta) :: assoc | None -> assoc
let t_of_yojson = function
1174
-
let meta = List.assoc_opt "_meta" fields in
1176
-
| j -> raise (Json.Of_json ("Expected object for InitializedNotification", j))
913
+
let meta = List.assoc_opt "_meta" fields in
915
+
| j -> Util.json_error "Expected object for InitializedNotification" j
let create ?meta () = { meta }
1181
-
let params = match yojson_of_t t with
1182
-
| `Assoc [] -> None
1183
-
| json -> Some json
921
+
match yojson_of_t t with `Assoc [] -> None | json -> Some json
1185
-
JSONRPCMessage.create_notification ~method_:"notifications/initialized" ~params ()
923
+
JSONRPCMessage.create_notification ~meth:Method.Initialized ~params ()
(* Export the main interface for using the MCP protocol *)
1191
-
let parse_message json =
1192
-
JSONRPCMessage.t_of_yojson json
929
+
let parse_message json = JSONRPCMessage.t_of_yojson json
1194
-
let create_notification = JSONRPCMessage.create_notification
1195
-
let create_request = JSONRPCMessage.create_request
931
+
let create_notification ?(params = None) ~meth () =
932
+
JSONRPCMessage.create_notification ~params ~meth ()
934
+
let create_request ?(params = None) ?(progress_token = None) ~id ~meth () =
935
+
JSONRPCMessage.create_request ~params ~progress_token ~id ~meth ()
let create_response = JSONRPCMessage.create_response
let create_error = JSONRPCMessage.create_error
1199
-
(* Helper functions *)
1200
-
let create_completion_request ~id ~argument ~ref =
1201
-
let params = Completion.Request.to_params { argument; ref } in
1202
-
create_request ~id ~method_:"completion/complete" ~params:(Some params) ()
1204
-
let create_completion_response ~id ~values ?(has_more=None) ?(total=None) ?(meta=None) () =
1205
-
let completion = { Completion.Result.values; has_more; total } in
1206
-
let result = Completion.Result.to_result { completion; meta } in
1207
-
create_response ~id ~result
940
+
(* Content type constructors *)
941
+
let make_text_content text = Text TextContent.{ text; annotations = None }
943
+
let make_image_content data mime_type =
944
+
Image ImageContent.{ data; mime_type; annotations = None }
946
+
let make_audio_content data mime_type =
947
+
Audio AudioContent.{ data; mime_type; annotations = None }
949
+
let make_resource_text_content uri text mime_type =
953
+
resource = `Text TextResourceContents.{ uri; text; mime_type };
954
+
annotations = None;
957
+
let make_resource_blob_content uri blob mime_type =
961
+
resource = `Blob BlobResourceContents.{ uri; blob; mime_type };
962
+
annotations = None;
anil.recoil.org
