this repo has no description
implementation of MCP protocol parser in OCaml
🤖 Generated with [Claude Code](https://claude.ai/code)
Co-Authored-By: Claude <noreply@anthropic.com>
+1026
+748
lib/mcp.ml
+748
lib/mcp.ml
···
1
+
open Jsonrpc
2
+
3
+
(* Common types *)
4
+
5
+
module Role = struct
6
+
type t = [ `User | `Assistant ]
7
+
8
+
let to_string = function
9
+
| `User -> "user"
10
+
| `Assistant -> "assistant"
11
+
12
+
let of_string = function
13
+
| "user" -> `User
14
+
| "assistant" -> `Assistant
15
+
| s -> raise (Json.Of_json ("Unknown role: " ^ s, `String s))
16
+
17
+
let yojson_of_t t = `String (to_string t)
18
+
let t_of_yojson = function
19
+
| `String s -> of_string s
20
+
| j -> raise (Json.Of_json ("Expected string for Role", j))
21
+
end
22
+
23
+
module ProgressToken = struct
24
+
type t = [ `String of string | `Int of int ]
25
+
26
+
include (Id : Json.Jsonable.S with type t := t)
27
+
end
28
+
29
+
module RequestId = Id
30
+
31
+
module Cursor = struct
32
+
type t = string
33
+
34
+
let yojson_of_t t = `String t
35
+
let t_of_yojson = function
36
+
| `String s -> s
37
+
| j -> raise (Json.Of_json ("Expected string for Cursor", j))
38
+
end
39
+
40
+
(* Annotations *)
41
+
42
+
module Annotated = struct
43
+
type t = {
44
+
annotations: annotation option;
45
+
}
46
+
and annotation = {
47
+
audience: Role.t list option;
48
+
priority: float option;
49
+
}
50
+
51
+
let yojson_of_annotation { audience; priority } =
52
+
let assoc = [] in
53
+
let assoc = match audience with
54
+
| Some audience -> ("audience", `List (List.map Role.yojson_of_t audience)) :: assoc
55
+
| None -> assoc
56
+
in
57
+
let assoc = match priority with
58
+
| Some priority -> ("priority", `Float priority) :: assoc
59
+
| None -> assoc
60
+
in
61
+
`Assoc assoc
62
+
63
+
let annotation_of_yojson = function
64
+
| `Assoc fields ->
65
+
let audience = List.assoc_opt "audience" fields |> Option.map (function
66
+
| `List items -> List.map Role.t_of_yojson items
67
+
| j -> raise (Json.Of_json ("Expected list for audience", j))
68
+
) in
69
+
let priority = List.assoc_opt "priority" fields |> Option.map (function
70
+
| `Float f -> f
71
+
| j -> raise (Json.Of_json ("Expected float for priority", j))
72
+
) in
73
+
{ audience; priority }
74
+
| j -> raise (Json.Of_json ("Expected object for annotation", j))
75
+
76
+
let yojson_of_t { annotations } =
77
+
match annotations with
78
+
| Some annotations -> `Assoc [ "annotations", yojson_of_annotation annotations ]
79
+
| None -> `Assoc []
80
+
81
+
let t_of_yojson = function
82
+
| `Assoc fields ->
83
+
let annotations = List.assoc_opt "annotations" fields |> Option.map annotation_of_yojson in
84
+
{ annotations }
85
+
| j -> raise (Json.Of_json ("Expected object for Annotated", j))
86
+
end
87
+
88
+
(* Content types *)
89
+
90
+
module TextContent = struct
91
+
type t = {
92
+
text: string;
93
+
annotations: Annotated.annotation option;
94
+
}
95
+
96
+
let yojson_of_t { text; annotations } =
97
+
let assoc = [
98
+
("text", `String text);
99
+
("type", `String "text");
100
+
] in
101
+
let assoc = match annotations with
102
+
| Some annotations -> ("annotations", Annotated.yojson_of_annotation annotations) :: assoc
103
+
| None -> assoc
104
+
in
105
+
`Assoc assoc
106
+
107
+
let t_of_yojson = function
108
+
| `Assoc fields ->
109
+
let text = match List.assoc_opt "text" fields with
110
+
| Some (`String s) -> s
111
+
| _ -> raise (Json.Of_json ("Missing or invalid 'text' field", `Assoc fields))
112
+
in
113
+
let _ = match List.assoc_opt "type" fields with
114
+
| Some (`String "text") -> ()
115
+
| _ -> raise (Json.Of_json ("Missing or invalid 'type' field", `Assoc fields))
116
+
in
117
+
let annotations = List.assoc_opt "annotations" fields |> Option.map Annotated.annotation_of_yojson in
118
+
{ text; annotations }
119
+
| j -> raise (Json.Of_json ("Expected object for TextContent", j))
120
+
end
121
+
122
+
module ImageContent = struct
123
+
type t = {
124
+
data: string;
125
+
mime_type: string;
126
+
annotations: Annotated.annotation option;
127
+
}
128
+
129
+
let yojson_of_t { data; mime_type; annotations } =
130
+
let assoc = [
131
+
("data", `String data);
132
+
("mimeType", `String mime_type);
133
+
("type", `String "image");
134
+
] in
135
+
let assoc = match annotations with
136
+
| Some annotations -> ("annotations", Annotated.yojson_of_annotation annotations) :: assoc
137
+
| None -> assoc
138
+
in
139
+
`Assoc assoc
140
+
141
+
let t_of_yojson = function
142
+
| `Assoc fields ->
143
+
let data = match List.assoc_opt "data" fields with
144
+
| Some (`String s) -> s
145
+
| _ -> raise (Json.Of_json ("Missing or invalid 'data' field", `Assoc fields))
146
+
in
147
+
let mime_type = match List.assoc_opt "mimeType" fields with
148
+
| Some (`String s) -> s
149
+
| _ -> raise (Json.Of_json ("Missing or invalid 'mimeType' field", `Assoc fields))
150
+
in
151
+
let _ = match List.assoc_opt "type" fields with
152
+
| Some (`String "image") -> ()
153
+
| _ -> raise (Json.Of_json ("Missing or invalid 'type' field", `Assoc fields))
154
+
in
155
+
let annotations = List.assoc_opt "annotations" fields |> Option.map Annotated.annotation_of_yojson in
156
+
{ data; mime_type; annotations }
157
+
| j -> raise (Json.Of_json ("Expected object for ImageContent", j))
158
+
end
159
+
160
+
module ResourceContents = struct
161
+
type t = {
162
+
uri: string;
163
+
mime_type: string option;
164
+
}
165
+
166
+
let yojson_of_t { uri; mime_type } =
167
+
let assoc = [
168
+
("uri", `String uri);
169
+
] in
170
+
let assoc = match mime_type with
171
+
| Some mime_type -> ("mimeType", `String mime_type) :: assoc
172
+
| None -> assoc
173
+
in
174
+
`Assoc assoc
175
+
176
+
let t_of_yojson = function
177
+
| `Assoc fields ->
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))
181
+
in
182
+
let mime_type = List.assoc_opt "mimeType" fields |> Option.map (function
183
+
| `String s -> s
184
+
| j -> raise (Json.Of_json ("Expected string for mimeType", j))
185
+
) in
186
+
{ uri; mime_type }
187
+
| j -> raise (Json.Of_json ("Expected object for ResourceContents", j))
188
+
end
189
+
190
+
module TextResourceContents = struct
191
+
type t = {
192
+
uri: string;
193
+
text: string;
194
+
mime_type: string option;
195
+
}
196
+
197
+
let yojson_of_t { uri; text; mime_type } =
198
+
let assoc = [
199
+
("uri", `String uri);
200
+
("text", `String text);
201
+
] in
202
+
let assoc = match mime_type with
203
+
| Some mime_type -> ("mimeType", `String mime_type) :: assoc
204
+
| None -> assoc
205
+
in
206
+
`Assoc assoc
207
+
208
+
let t_of_yojson = function
209
+
| `Assoc fields ->
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))
213
+
in
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))
217
+
in
218
+
let mime_type = List.assoc_opt "mimeType" fields |> Option.map (function
219
+
| `String s -> s
220
+
| j -> raise (Json.Of_json ("Expected string for mimeType", j))
221
+
) in
222
+
{ uri; text; mime_type }
223
+
| j -> raise (Json.Of_json ("Expected object for TextResourceContents", j))
224
+
end
225
+
226
+
module BlobResourceContents = struct
227
+
type t = {
228
+
uri: string;
229
+
blob: string;
230
+
mime_type: string option;
231
+
}
232
+
233
+
let yojson_of_t { uri; blob; mime_type } =
234
+
let assoc = [
235
+
("uri", `String uri);
236
+
("blob", `String blob);
237
+
] in
238
+
let assoc = match mime_type with
239
+
| Some mime_type -> ("mimeType", `String mime_type) :: assoc
240
+
| None -> assoc
241
+
in
242
+
`Assoc assoc
243
+
244
+
let t_of_yojson = function
245
+
| `Assoc fields ->
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))
249
+
in
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))
253
+
in
254
+
let mime_type = List.assoc_opt "mimeType" fields |> Option.map (function
255
+
| `String s -> s
256
+
| j -> raise (Json.Of_json ("Expected string for mimeType", j))
257
+
) in
258
+
{ uri; blob; mime_type }
259
+
| j -> raise (Json.Of_json ("Expected object for BlobResourceContents", j))
260
+
end
261
+
262
+
module EmbeddedResource = struct
263
+
type t = {
264
+
resource: [ `Text of TextResourceContents.t | `Blob of BlobResourceContents.t ];
265
+
annotations: Annotated.annotation option;
266
+
}
267
+
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
272
+
in
273
+
let assoc = [
274
+
("resource", resource_json);
275
+
("type", `String "resource");
276
+
] in
277
+
let assoc = match annotations with
278
+
| Some annotations -> ("annotations", Annotated.yojson_of_annotation annotations) :: assoc
279
+
| None -> assoc
280
+
in
281
+
`Assoc assoc
282
+
283
+
let t_of_yojson = function
284
+
| `Assoc fields ->
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))
288
+
in
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))
295
+
else
296
+
raise (Json.Of_json ("Invalid resource content", `Assoc res_fields))
297
+
| _ -> raise (Json.Of_json ("Missing or invalid 'resource' field", `Assoc fields))
298
+
in
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))
302
+
end
303
+
304
+
type content =
305
+
| Text of TextContent.t
306
+
| Image of ImageContent.t
307
+
| Resource of EmbeddedResource.t
308
+
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
313
+
314
+
let content_of_yojson = function
315
+
| `Assoc fields ->
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))
322
+
323
+
(* Message types *)
324
+
325
+
module PromptMessage = struct
326
+
type t = {
327
+
role: Role.t;
328
+
content: content;
329
+
}
330
+
331
+
let yojson_of_t { role; content } =
332
+
`Assoc [
333
+
("role", Role.yojson_of_t role);
334
+
("content", yojson_of_content content);
335
+
]
336
+
337
+
let t_of_yojson = function
338
+
| `Assoc fields ->
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))
342
+
in
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))
346
+
in
347
+
{ role; content }
348
+
| j -> raise (Json.Of_json ("Expected object for PromptMessage", j))
349
+
end
350
+
351
+
module SamplingMessage = struct
352
+
type t = {
353
+
role: Role.t;
354
+
content: [ `Text of TextContent.t | `Image of ImageContent.t ];
355
+
}
356
+
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
361
+
in
362
+
`Assoc [
363
+
("role", Role.yojson_of_t role);
364
+
("content", content_json);
365
+
]
366
+
367
+
let t_of_yojson = function
368
+
| `Assoc fields ->
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))
372
+
in
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))
380
+
in
381
+
{ role; content }
382
+
| j -> raise (Json.Of_json ("Expected object for SamplingMessage", j))
383
+
end
384
+
385
+
(* Implementation info *)
386
+
387
+
module Implementation = struct
388
+
type t = {
389
+
name: string;
390
+
version: string;
391
+
}
392
+
393
+
let yojson_of_t { name; version } =
394
+
`Assoc [
395
+
("name", `String name);
396
+
("version", `String version);
397
+
]
398
+
399
+
let t_of_yojson = function
400
+
| `Assoc fields ->
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))
404
+
in
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))
408
+
in
409
+
{ name; version }
410
+
| j -> raise (Json.Of_json ("Expected object for Implementation", j))
411
+
end
412
+
413
+
(* JSONRPC Message types *)
414
+
415
+
module JSONRPCMessage = struct
416
+
type notification = {
417
+
method_: string;
418
+
params: Json.t option;
419
+
}
420
+
421
+
type request = {
422
+
id: RequestId.t;
423
+
method_: string;
424
+
params: Json.t option;
425
+
progress_token: ProgressToken.t option;
426
+
}
427
+
428
+
type response = {
429
+
id: RequestId.t;
430
+
result: Json.t;
431
+
}
432
+
433
+
type error = {
434
+
id: RequestId.t;
435
+
code: int;
436
+
message: string;
437
+
data: Json.t option;
438
+
}
439
+
440
+
type t =
441
+
| Notification of notification
442
+
| Request of request
443
+
| Response of response
444
+
| Error of error
445
+
446
+
let yojson_of_notification (n: notification) =
447
+
let assoc = [
448
+
("jsonrpc", `String "2.0");
449
+
("method", `String n.method_);
450
+
] in
451
+
let assoc = match n.params with
452
+
| Some params -> ("params", params) :: assoc
453
+
| None -> assoc
454
+
in
455
+
`Assoc assoc
456
+
457
+
let yojson_of_request (r: request) =
458
+
let assoc = [
459
+
("jsonrpc", `String "2.0");
460
+
("id", Id.yojson_of_t r.id);
461
+
("method", `String r.method_);
462
+
] in
463
+
let assoc = match r.params with
464
+
| Some params ->
465
+
let params_json = match params with
466
+
| `Assoc fields ->
467
+
let fields = match r.progress_token with
468
+
| Some token ->
469
+
let meta = `Assoc [ "progressToken", ProgressToken.yojson_of_t token ] in
470
+
("_meta", meta) :: fields
471
+
| None -> fields
472
+
in
473
+
`Assoc fields
474
+
| _ -> params
475
+
in
476
+
("params", params_json) :: assoc
477
+
| None -> assoc
478
+
in
479
+
`Assoc assoc
480
+
481
+
let yojson_of_response (r: response) =
482
+
`Assoc [
483
+
("jsonrpc", `String "2.0");
484
+
("id", Id.yojson_of_t r.id);
485
+
("result", r.result);
486
+
]
487
+
488
+
let yojson_of_error (e: error) =
489
+
let error_assoc = [
490
+
("code", `Int e.code);
491
+
("message", `String e.message);
492
+
] in
493
+
let error_assoc = match e.data with
494
+
| Some data -> ("data", data) :: error_assoc
495
+
| None -> error_assoc
496
+
in
497
+
`Assoc [
498
+
("jsonrpc", `String "2.0");
499
+
("id", Id.yojson_of_t e.id);
500
+
("error", `Assoc error_assoc);
501
+
]
502
+
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
508
+
509
+
let notification_of_yojson = function
510
+
| `Assoc fields ->
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))
514
+
in
515
+
let params = List.assoc_opt "params" fields in
516
+
{ method_; params }
517
+
| j -> raise (Json.Of_json ("Expected object for notification", j))
518
+
519
+
let request_of_yojson = function
520
+
| `Assoc fields ->
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))
524
+
in
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))
528
+
in
529
+
let params = List.assoc_opt "params" fields in
530
+
let progress_token =
531
+
match params with
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)
537
+
| None -> None)
538
+
| _ -> None)
539
+
| _ -> None
540
+
in
541
+
{ id; method_; params; progress_token }
542
+
| j -> raise (Json.Of_json ("Expected object for request", j))
543
+
544
+
let response_of_yojson = function
545
+
| `Assoc fields ->
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))
549
+
in
550
+
let result = match List.assoc_opt "result" fields with
551
+
| Some result -> result
552
+
| _ -> raise (Json.Of_json ("Missing 'result' field", `Assoc fields))
553
+
in
554
+
{ id; result }
555
+
| j -> raise (Json.Of_json ("Expected object for response", j))
556
+
557
+
let error_of_yojson = function
558
+
| `Assoc fields ->
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))
562
+
in
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))
566
+
in
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))
570
+
in
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))
574
+
in
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))
578
+
579
+
let t_of_yojson json =
580
+
match json with
581
+
| `Assoc fields ->
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))
585
+
in
586
+
if List.mem_assoc "method" fields then
587
+
if List.mem_assoc "id" fields then
588
+
Request (request_of_yojson json)
589
+
else
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)
595
+
else
596
+
raise (Json.Of_json ("Invalid JSONRPC message format", json))
597
+
| j -> raise (Json.Of_json ("Expected object for JSONRPC message", j))
598
+
599
+
let create_notification ?(params=None) ~method_ () =
600
+
Notification { method_; params }
601
+
602
+
let create_request ?(params=None) ?(progress_token=None) ~id ~method_ () =
603
+
Request { id; method_; params; progress_token }
604
+
605
+
let create_response ~id ~result =
606
+
Response { id; result }
607
+
608
+
let create_error ~id ~code ~message ?(data=None) () =
609
+
Error { id; code; message; data }
610
+
end
611
+
612
+
(* MCP-specific request/response types *)
613
+
614
+
module Initialize = struct
615
+
module Request = struct
616
+
type t = {
617
+
capabilities: Json.t; (* ClientCapabilities *)
618
+
client_info: Implementation.t;
619
+
protocol_version: string;
620
+
}
621
+
622
+
let yojson_of_t { capabilities; client_info; protocol_version } =
623
+
`Assoc [
624
+
("capabilities", capabilities);
625
+
("clientInfo", Implementation.yojson_of_t client_info);
626
+
("protocolVersion", `String protocol_version);
627
+
]
628
+
629
+
let t_of_yojson = function
630
+
| `Assoc fields ->
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))
634
+
in
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))
638
+
in
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))
642
+
in
643
+
{ capabilities; client_info; protocol_version }
644
+
| j -> raise (Json.Of_json ("Expected object for InitializeRequest", j))
645
+
646
+
let create ~capabilities ~client_info ~protocol_version =
647
+
{ capabilities; client_info; protocol_version }
648
+
649
+
let to_jsonrpc ~id t =
650
+
let params = yojson_of_t t in
651
+
JSONRPCMessage.create_request ~id ~method_:"initialize" ~params:(Some params) ()
652
+
end
653
+
654
+
module Result = struct
655
+
type t = {
656
+
capabilities: Json.t; (* ServerCapabilities *)
657
+
server_info: Implementation.t;
658
+
protocol_version: string;
659
+
instructions: string option;
660
+
meta: Json.t option;
661
+
}
662
+
663
+
let yojson_of_t { capabilities; server_info; protocol_version; instructions; meta } =
664
+
let assoc = [
665
+
("capabilities", capabilities);
666
+
("serverInfo", Implementation.yojson_of_t server_info);
667
+
("protocolVersion", `String protocol_version);
668
+
] in
669
+
let assoc = match instructions with
670
+
| Some instr -> ("instructions", `String instr) :: assoc
671
+
| None -> assoc
672
+
in
673
+
let assoc = match meta with
674
+
| Some meta -> ("_meta", meta) :: assoc
675
+
| None -> assoc
676
+
in
677
+
`Assoc assoc
678
+
679
+
let t_of_yojson = function
680
+
| `Assoc fields ->
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))
684
+
in
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))
688
+
in
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))
692
+
in
693
+
let instructions = match List.assoc_opt "instructions" fields with
694
+
| Some (`String s) -> Some s
695
+
| _ -> None
696
+
in
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))
700
+
701
+
let create ~capabilities ~server_info ~protocol_version ?instructions ?meta () =
702
+
{ capabilities; server_info; protocol_version; instructions; meta }
703
+
704
+
let to_jsonrpc ~id t =
705
+
JSONRPCMessage.create_response ~id ~result:(yojson_of_t t)
706
+
end
707
+
end
708
+
709
+
module Initialized = struct
710
+
module Notification = struct
711
+
type t = {
712
+
meta: Json.t option;
713
+
}
714
+
715
+
let yojson_of_t { meta } =
716
+
let assoc = [] in
717
+
let assoc = match meta with
718
+
| Some meta -> ("_meta", meta) :: assoc
719
+
| None -> assoc
720
+
in
721
+
`Assoc assoc
722
+
723
+
let t_of_yojson = function
724
+
| `Assoc fields ->
725
+
let meta = List.assoc_opt "_meta" fields in
726
+
{ meta }
727
+
| j -> raise (Json.Of_json ("Expected object for InitializedNotification", j))
728
+
729
+
let create ?meta () = { meta }
730
+
731
+
let to_jsonrpc t =
732
+
let params = match yojson_of_t t with
733
+
| `Assoc [] -> None
734
+
| json -> Some json
735
+
in
736
+
JSONRPCMessage.create_notification ~method_:"notifications/initialized" ~params ()
737
+
end
738
+
end
739
+
740
+
(* Export the main interface for using the MCP protocol *)
741
+
742
+
let parse_message json =
743
+
JSONRPCMessage.t_of_yojson json
744
+
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
+275
lib/mcp.mli
+275
lib/mcp.mli
···
1
+
(** MCP - Model Context Protocol implementation *)
2
+
3
+
open Jsonrpc
4
+
5
+
(** Common types *)
6
+
7
+
(** Roles for conversation participants *)
8
+
module Role : sig
9
+
type t = [ `User | `Assistant ]
10
+
11
+
val to_string : t -> string
12
+
val of_string : string -> t
13
+
14
+
val yojson_of_t : t -> Json.t
15
+
val t_of_yojson : Json.t -> t
16
+
end
17
+
18
+
(** Progress tokens for long-running operations *)
19
+
module ProgressToken : sig
20
+
type t = [ `String of string | `Int of int ]
21
+
22
+
include Json.Jsonable.S with type t := t
23
+
end
24
+
25
+
(** Request IDs *)
26
+
module RequestId : sig
27
+
type t = [ `String of string | `Int of int ]
28
+
29
+
include Json.Jsonable.S with type t := t
30
+
end
31
+
32
+
(** Cursors for pagination *)
33
+
module Cursor : sig
34
+
type t = string
35
+
36
+
val yojson_of_t : t -> Json.t
37
+
val t_of_yojson : Json.t -> t
38
+
end
39
+
40
+
(** Annotations for objects *)
41
+
module Annotated : sig
42
+
type t = {
43
+
annotations: annotation option;
44
+
}
45
+
and annotation = {
46
+
audience: Role.t list option;
47
+
priority: float option;
48
+
}
49
+
50
+
val yojson_of_annotation : annotation -> Json.t
51
+
val annotation_of_yojson : Json.t -> annotation
52
+
53
+
val yojson_of_t : t -> Json.t
54
+
val t_of_yojson : Json.t -> t
55
+
end
56
+
57
+
(** Text content *)
58
+
module TextContent : sig
59
+
type t = {
60
+
text: string;
61
+
annotations: Annotated.annotation option;
62
+
}
63
+
64
+
val yojson_of_t : t -> Json.t
65
+
val t_of_yojson : Json.t -> t
66
+
end
67
+
68
+
(** Image content *)
69
+
module ImageContent : sig
70
+
type t = {
71
+
data: string;
72
+
mime_type: string;
73
+
annotations: Annotated.annotation option;
74
+
}
75
+
76
+
val yojson_of_t : t -> Json.t
77
+
val t_of_yojson : Json.t -> t
78
+
end
79
+
80
+
(** Base resource contents *)
81
+
module ResourceContents : sig
82
+
type t = {
83
+
uri: string;
84
+
mime_type: string option;
85
+
}
86
+
87
+
val yojson_of_t : t -> Json.t
88
+
val t_of_yojson : Json.t -> t
89
+
end
90
+
91
+
(** Text resource contents *)
92
+
module TextResourceContents : sig
93
+
type t = {
94
+
uri: string;
95
+
text: string;
96
+
mime_type: string option;
97
+
}
98
+
99
+
val yojson_of_t : t -> Json.t
100
+
val t_of_yojson : Json.t -> t
101
+
end
102
+
103
+
(** Binary resource contents *)
104
+
module BlobResourceContents : sig
105
+
type t = {
106
+
uri: string;
107
+
blob: string;
108
+
mime_type: string option;
109
+
}
110
+
111
+
val yojson_of_t : t -> Json.t
112
+
val t_of_yojson : Json.t -> t
113
+
end
114
+
115
+
(** Embedded resource *)
116
+
module EmbeddedResource : sig
117
+
type t = {
118
+
resource: [ `Text of TextResourceContents.t | `Blob of BlobResourceContents.t ];
119
+
annotations: Annotated.annotation option;
120
+
}
121
+
122
+
val yojson_of_t : t -> Json.t
123
+
val t_of_yojson : Json.t -> t
124
+
end
125
+
126
+
(** Content type used in messages *)
127
+
type content =
128
+
| Text of TextContent.t
129
+
| Image of ImageContent.t
130
+
| Resource of EmbeddedResource.t
131
+
132
+
val yojson_of_content : content -> Json.t
133
+
val content_of_yojson : Json.t -> content
134
+
135
+
(** Message for prompts *)
136
+
module PromptMessage : sig
137
+
type t = {
138
+
role: Role.t;
139
+
content: content;
140
+
}
141
+
142
+
val yojson_of_t : t -> Json.t
143
+
val t_of_yojson : Json.t -> t
144
+
end
145
+
146
+
(** Message for sampling *)
147
+
module SamplingMessage : sig
148
+
type t = {
149
+
role: Role.t;
150
+
content: [ `Text of TextContent.t | `Image of ImageContent.t ];
151
+
}
152
+
153
+
val yojson_of_t : t -> Json.t
154
+
val t_of_yojson : Json.t -> t
155
+
end
156
+
157
+
(** Implementation information *)
158
+
module Implementation : sig
159
+
type t = {
160
+
name: string;
161
+
version: string;
162
+
}
163
+
164
+
val yojson_of_t : t -> Json.t
165
+
val t_of_yojson : Json.t -> t
166
+
end
167
+
168
+
(** JSONRPC message types *)
169
+
module JSONRPCMessage : sig
170
+
type notification = {
171
+
method_: string;
172
+
params: Json.t option;
173
+
}
174
+
175
+
type request = {
176
+
id: RequestId.t;
177
+
method_: string;
178
+
params: Json.t option;
179
+
progress_token: ProgressToken.t option;
180
+
}
181
+
182
+
type response = {
183
+
id: RequestId.t;
184
+
result: Json.t;
185
+
}
186
+
187
+
type error = {
188
+
id: RequestId.t;
189
+
code: int;
190
+
message: string;
191
+
data: Json.t option;
192
+
}
193
+
194
+
type t =
195
+
| Notification of notification
196
+
| Request of request
197
+
| Response of response
198
+
| Error of error
199
+
200
+
val yojson_of_notification : notification -> Json.t
201
+
val yojson_of_request : request -> Json.t
202
+
val yojson_of_response : response -> Json.t
203
+
val yojson_of_error : error -> Json.t
204
+
val yojson_of_t : t -> Json.t
205
+
206
+
val notification_of_yojson : Json.t -> notification
207
+
val request_of_yojson : Json.t -> request
208
+
val response_of_yojson : Json.t -> response
209
+
val error_of_yojson : Json.t -> error
210
+
val t_of_yojson : Json.t -> t
211
+
212
+
val create_notification : ?params:Json.t option -> method_:string -> unit -> t
213
+
val create_request : ?params:Json.t option -> ?progress_token:ProgressToken.t option -> id:RequestId.t -> method_:string -> unit -> t
214
+
val create_response : id:RequestId.t -> result:Json.t -> t
215
+
val create_error : id:RequestId.t -> code:int -> message:string -> ?data:Json.t option -> unit -> t
216
+
end
217
+
218
+
(** Initialize request/response *)
219
+
module Initialize : sig
220
+
(** Initialize request *)
221
+
module Request : sig
222
+
type t = {
223
+
capabilities: Json.t; (** ClientCapabilities *)
224
+
client_info: Implementation.t;
225
+
protocol_version: string;
226
+
}
227
+
228
+
val yojson_of_t : t -> Json.t
229
+
val t_of_yojson : Json.t -> t
230
+
231
+
val create : capabilities:Json.t -> client_info:Implementation.t -> protocol_version:string -> t
232
+
val to_jsonrpc : id:RequestId.t -> t -> JSONRPCMessage.t
233
+
end
234
+
235
+
(** Initialize result *)
236
+
module Result : sig
237
+
type t = {
238
+
capabilities: Json.t; (** ServerCapabilities *)
239
+
server_info: Implementation.t;
240
+
protocol_version: string;
241
+
instructions: string option;
242
+
meta: Json.t option;
243
+
}
244
+
245
+
val yojson_of_t : t -> Json.t
246
+
val t_of_yojson : Json.t -> t
247
+
248
+
val create : capabilities:Json.t -> server_info:Implementation.t -> protocol_version:string -> ?instructions:string -> ?meta:Json.t -> unit -> t
249
+
val to_jsonrpc : id:RequestId.t -> t -> JSONRPCMessage.t
250
+
end
251
+
end
252
+
253
+
(** Initialized notification *)
254
+
module Initialized : sig
255
+
module Notification : sig
256
+
type t = {
257
+
meta: Json.t option;
258
+
}
259
+
260
+
val yojson_of_t : t -> Json.t
261
+
val t_of_yojson : Json.t -> t
262
+
263
+
val create : ?meta:Json.t -> unit -> t
264
+
val to_jsonrpc : t -> JSONRPCMessage.t
265
+
end
266
+
end
267
+
268
+
(** Parse a JSON message into an MCP message *)
269
+
val parse_message : Json.t -> JSONRPCMessage.t
270
+
271
+
(** Create JSONRPC message helpers *)
272
+
val create_notification : ?params:Json.t option -> method_:string -> unit -> JSONRPCMessage.t
273
+
val create_request : ?params:Json.t option -> ?progress_token:ProgressToken.t option -> id:RequestId.t -> method_:string -> unit -> JSONRPCMessage.t
274
+
val create_response : id:RequestId.t -> result:Json.t -> JSONRPCMessage.t
275
+
val create_error : id:RequestId.t -> code:int -> message:string -> ?data:Json.t option -> unit -> JSONRPCMessage.t