···

       
5
       
 
       
  (modules mcp))

     

       
6
       
 
       


     

       
7
       
 
       
(library

     

       
8
       
-
       
  (name mcp_message)

     

       
9
       
-
       
  (public_name mcp.message)

     

       
10
       
 
       
  (libraries mcp jsonrpc unix yojson)

     

       
11
       
-
       
  (modules mcp_message)

     

       
12
       
 
       
  (flags (:standard -w -67 -w -27 -w -32 -w -33 -w -34)))

     

       
13
       
 
       


     

       
14
       
 
       
(library

     

       
15
       
 
       
  (name mcp_sdk)

     

       
16
       
 
       
  (public_name mcp.sdk)

     

       
17
       
-
       
  (libraries mcp mcp_message jsonrpc unix yojson)

     

       
18
       
 
       
  (modules mcp_sdk)

     

       
19
       
 
       
  (flags (:standard -w -67 -w -27 -w -32)))

     

       
20
       
 
       


     

···

       
5
       
 
       
  (modules mcp))

     

       
6
       
 
       


     

       
7
       
 
       
(library

     

       
8
       
+
       
  (name mcp_rpc)

     

       
9
       
+
       
  (public_name mcp.rpc)

     

       
10
       
 
       
  (libraries mcp jsonrpc unix yojson)

     

       
11
       
+
       
  (modules mcp_rpc)

     

       
12
       
 
       
  (flags (:standard -w -67 -w -27 -w -32 -w -33 -w -34)))

     

       
13
       
 
       


     

       
14
       
 
       
(library

     

       
15
       
 
       
  (name mcp_sdk)

     

       
16
       
 
       
  (public_name mcp.sdk)

     

       
17
       
+
       
  (libraries mcp mcp_rpc jsonrpc unix yojson)

     

       
18
       
 
       
  (modules mcp_sdk)

     

       
19
       
 
       
  (flags (:standard -w -67 -w -27 -w -32)))

     

       
20
       
 
       


     

···

       
1
       
 
       
open Jsonrpc

     

       
2
       
 
       


     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
3
       
 
       
(* Error codes for JSON-RPC *)

     

       
4
       
 
       
module ErrorCode = struct

     

       
5
       
 
       
  type t = 

     
···

       
207
       
 
       
    `Assoc assoc

     

       
208
       
 
       


     

       
209
       
 
       
  let t_of_yojson = function

     

       
210
       
-
       
    | `Assoc fields ->

     

       
211
       
-
       
      let text = match List.assoc_opt "text" fields with

     

       
212
       
-
       
        | Some (`String s) -> s

     

       
213
       
-
       
        | _ -> raise (Json.Of_json ("Missing or invalid 'text' field", `Assoc fields))

     

       
214
       
-
       
      in

     

       
215
       
-
       
      let _ = match List.assoc_opt "type" fields with

     

       
216
       
-
       
        | Some (`String "text") -> ()

     

       
217
       
-
       
        | _ -> raise (Json.Of_json ("Missing or invalid 'type' field", `Assoc fields))

     

       
218
       
-
       
      in

     

       
219
       
 
       
      let annotations = List.assoc_opt "annotations" fields |> Option.map Annotated.annotation_of_yojson in

     

       
220
       
 
       
      { text; annotations }

     

       
221
       
 
       
    | j -> raise (Json.Of_json ("Expected object for TextContent", j))

     
···

       
241
       
 
       
    `Assoc assoc

     

       
242
       
 
       


     

       
243
       
 
       
  let t_of_yojson = function

     

       
244
       
-
       
    | `Assoc fields ->

     

       
245
       
-
       
      let data = match List.assoc_opt "data" fields with

     

       
246
       
-
       
        | Some (`String s) -> s

     

       
247
       
-
       
        | _ -> raise (Json.Of_json ("Missing or invalid 'data' field", `Assoc fields))

     

       
248
       
-
       
      in

     

       
249
       
-
       
      let mime_type = match List.assoc_opt "mimeType" fields with

     

       
250
       
-
       
        | Some (`String s) -> s

     

       
251
       
-
       
        | _ -> raise (Json.Of_json ("Missing or invalid 'mimeType' field", `Assoc fields))

     

       
252
       
-
       
      in

     

       
253
       
-
       
      let _ = match List.assoc_opt "type" fields with

     

       
254
       
-
       
        | Some (`String "image") -> ()

     

       
255
       
-
       
        | _ -> raise (Json.Of_json ("Missing or invalid 'type' field", `Assoc fields))

     

       
256
       
-
       
      in

     

       
257
       
 
       
      let annotations = List.assoc_opt "annotations" fields |> Option.map Annotated.annotation_of_yojson in

     

       
258
       
 
       
      { data; mime_type; annotations }

     

       
259
       
 
       
    | j -> raise (Json.Of_json ("Expected object for ImageContent", j))

     
···

       
279
       
 
       
    `Assoc assoc

     

       
280
       
 
       


     

       
281
       
 
       
  let t_of_yojson = function

     

       
282
       
-
       
    | `Assoc fields ->

     

       
283
       
-
       
      let data = match List.assoc_opt "data" fields with

     

       
284
       
-
       
        | Some (`String s) -> s

     

       
285
       
-
       
        | _ -> raise (Json.Of_json ("Missing or invalid 'data' field", `Assoc fields))

     

       
286
       
-
       
      in

     

       
287
       
-
       
      let mime_type = match List.assoc_opt "mimeType" fields with

     

       
288
       
-
       
        | Some (`String s) -> s

     

       
289
       
-
       
        | _ -> raise (Json.Of_json ("Missing or invalid 'mimeType' field", `Assoc fields))

     

       
290
       
-
       
      in

     

       
291
       
-
       
      let _ = match List.assoc_opt "type" fields with

     

       
292
       
-
       
        | Some (`String "audio") -> ()

     

       
293
       
-
       
        | _ -> raise (Json.Of_json ("Missing or invalid 'type' field", `Assoc fields))

     

       
294
       
-
       
      in

     

       
295
       
 
       
      let annotations = List.assoc_opt "annotations" fields |> Option.map Annotated.annotation_of_yojson in

     

       
296
       
 
       
      { data; mime_type; annotations }

     

       
297
       
 
       
    | j -> raise (Json.Of_json ("Expected object for AudioContent", j))

     
···

       
314
       
 
       
    `Assoc assoc

     

       
315
       
 
       


     

       
316
       
 
       
  let t_of_yojson = function

     

       
317
       
-
       
    | `Assoc fields ->

     

       
318
       
-
       
      let uri = match List.assoc_opt "uri" fields with

     

       
319
       
-
       
        | Some (`String s) -> s

     

       
320
       
-
       
        | _ -> raise (Json.Of_json ("Missing or invalid 'uri' field", `Assoc fields))

     

       
321
       
-
       
      in

     

       
322
       
-
       
      let mime_type = List.assoc_opt "mimeType" fields |> Option.map (function

     

       
323
       
-
       
        | `String s -> s

     

       
324
       
-
       
        | j -> raise (Json.Of_json ("Expected string for mimeType", j))

     

       
325
       
-
       
      ) in

     

       
326
       
 
       
      { uri; mime_type }

     

       
327
       
 
       
    | j -> raise (Json.Of_json ("Expected object for ResourceContents", j))

     

       
328
       
 
       
end

     
···

       
346
       
 
       
    `Assoc assoc

     

       
347
       
 
       


     

       
348
       
 
       
  let t_of_yojson = function

     

       
349
       
-
       
    | `Assoc fields ->

     

       
350
       
-
       
      let uri = match List.assoc_opt "uri" fields with

     

       
351
       
-
       
        | Some (`String s) -> s

     

       
352
       
-
       
        | _ -> raise (Json.Of_json ("Missing or invalid 'uri' field", `Assoc fields))

     

       
353
       
-
       
      in

     

       
354
       
-
       
      let text = match List.assoc_opt "text" fields with

     

       
355
       
-
       
        | Some (`String s) -> s

     

       
356
       
-
       
        | _ -> raise (Json.Of_json ("Missing or invalid 'text' field", `Assoc fields))

     

       
357
       
-
       
      in

     

       
358
       
-
       
      let mime_type = List.assoc_opt "mimeType" fields |> Option.map (function

     

       
359
       
-
       
        | `String s -> s

     

       
360
       
-
       
        | j -> raise (Json.Of_json ("Expected string for mimeType", j))

     

       
361
       
-
       
      ) in

     

       
362
       
 
       
      { uri; text; mime_type }

     

       
363
       
 
       
    | j -> raise (Json.Of_json ("Expected object for TextResourceContents", j))

     

       
364
       
 
       
end

     
···

       
382
       
 
       
    `Assoc assoc

     

       
383
       
 
       


     

       
384
       
 
       
  let t_of_yojson = function

     

       
385
       
-
       
    | `Assoc fields ->

     

       
386
       
-
       
      let uri = match List.assoc_opt "uri" fields with

     

       
387
       
-
       
        | Some (`String s) -> s

     

       
388
       
-
       
        | _ -> raise (Json.Of_json ("Missing or invalid 'uri' field", `Assoc fields))

     

       
389
       
-
       
      in

     

       
390
       
-
       
      let blob = match List.assoc_opt "blob" fields with

     

       
391
       
-
       
        | Some (`String s) -> s

     

       
392
       
-
       
        | _ -> raise (Json.Of_json ("Missing or invalid 'blob' field", `Assoc fields))

     

       
393
       
-
       
      in

     

       
394
       
-
       
      let mime_type = List.assoc_opt "mimeType" fields |> Option.map (function

     

       
395
       
-
       
        | `String s -> s

     

       
396
       
-
       
        | j -> raise (Json.Of_json ("Expected string for mimeType", j))

     

       
397
       
-
       
      ) in

     

       
398
       
 
       
      { uri; blob; mime_type }

     

       
399
       
 
       
    | j -> raise (Json.Of_json ("Expected object for BlobResourceContents", j))

     

       
400
       
 
       
end

     
···

       
421
       
 
       
    `Assoc assoc

     

       
422
       
 
       


     

       
423
       
 
       
  let t_of_yojson = function

     

       
424
       
-
       
    | `Assoc fields ->

     

       
425
       
-
       
      let _ = match List.assoc_opt "type" fields with

     

       
426
       
-
       
        | Some (`String "resource") -> ()

     

       
427
       
-
       
        | _ -> raise (Json.Of_json ("Missing or invalid 'type' field", `Assoc fields))

     

       
0
       
 
       

     

       
428
       
 
       
      in

     

       
429
       
-
       
      let resource = match List.assoc_opt "resource" fields with

     

       
430
       
-
       
        | Some (`Assoc res_fields) ->

     

       
431
       
-
       
          if List.mem_assoc "text" res_fields then

     

       
432
       
-
       
            `Text (TextResourceContents.t_of_yojson (`Assoc res_fields))

     

       
433
       
-
       
          else if List.mem_assoc "blob" res_fields then

     

       
434
       
-
       
            `Blob (BlobResourceContents.t_of_yojson (`Assoc res_fields))

     

       
435
       
-
       
          else

     

       
436
       
-
       
            raise (Json.Of_json ("Invalid resource content", `Assoc res_fields))

     

       
437
       
-
       
        | _ -> raise (Json.Of_json ("Missing or invalid 'resource' field", `Assoc fields))

     

       
438
       
 
       
      in

     

       
439
       
 
       
      let annotations = List.assoc_opt "annotations" fields |> Option.map Annotated.annotation_of_yojson in

     

       
440
       
 
       
      { resource; annotations }

     
···

       
478
       
 
       
    ]

     

       
479
       
 
       


     

       
480
       
 
       
  let t_of_yojson = function

     

       
481
       
-
       
    | `Assoc fields ->

     

       
482
       
 
       
      let role = match List.assoc_opt "role" fields with

     

       
483
       
 
       
        | Some json -> Role.t_of_yojson json

     

       
484
       
-
       
        | None -> raise (Json.Of_json ("Missing role field", `Assoc fields))

     

       
485
       
 
       
      in

     

       
486
       
 
       
      let content = match List.assoc_opt "content" fields with

     

       
487
       
 
       
        | Some json -> content_of_yojson json

     

       
488
       
-
       
        | None -> raise (Json.Of_json ("Missing content field", `Assoc fields))

     

       
489
       
 
       
      in

     

       
490
       
 
       
      { role; content }

     

       
491
       
 
       
    | j -> raise (Json.Of_json ("Expected object for PromptMessage", j))

     
···

       
509
       
 
       
    ]

     

       
510
       
 
       


     

       
511
       
 
       
  let t_of_yojson = function

     

       
512
       
-
       
    | `Assoc fields ->

     

       
513
       
 
       
      let role = match List.assoc_opt "role" fields with

     

       
514
       
 
       
        | Some json -> Role.t_of_yojson json

     

       
515
       
-
       
        | None -> raise (Json.Of_json ("Missing role field", `Assoc fields))

     

       
516
       
 
       
      in

     

       
517
       
-
       
      let content = match List.assoc_opt "content" fields with

     

       
518
       
-
       
        | Some (`Assoc content_fields) ->

     

       
519
       
-
       
          (match List.assoc_opt "type" content_fields with

     

       
520
       
-
       
           | Some (`String "text") -> `Text (TextContent.t_of_yojson (`Assoc content_fields))

     

       
521
       
-
       
           | Some (`String "image") -> `Image (ImageContent.t_of_yojson (`Assoc content_fields))

     

       
522
       
-
       
           | Some (`String "audio") -> `Audio (AudioContent.t_of_yojson (`Assoc content_fields))

     

       
523
       
-
       
           | _ -> raise (Json.Of_json ("Invalid content type", `Assoc content_fields)))

     

       
524
       
-
       
        | _ -> raise (Json.Of_json ("Missing or invalid content field", `Assoc fields))

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
525
       
 
       
      in

     

       
526
       
 
       
      { role; content }

     

       
527
       
 
       
    | j -> raise (Json.Of_json ("Expected object for SamplingMessage", j))

     
···

       
542
       
 
       
    ]

     

       
543
       
 
       


     

       
544
       
 
       
  let t_of_yojson = function

     

       
545
       
-
       
    | `Assoc fields ->

     

       
546
       
-
       
      let name = match List.assoc_opt "name" fields with

     

       
547
       
-
       
        | Some (`String s) -> s

     

       
548
       
-
       
        | _ -> raise (Json.Of_json ("Missing or invalid 'name' field", `Assoc fields))

     

       
549
       
-
       
      in

     

       
550
       
-
       
      let version = match List.assoc_opt "version" fields with

     

       
551
       
-
       
        | Some (`String s) -> s

     

       
552
       
-
       
        | _ -> raise (Json.Of_json ("Missing or invalid 'version' field", `Assoc fields))

     

       
553
       
-
       
      in

     

       
554
       
 
       
      { name; version }

     

       
555
       
 
       
    | j -> raise (Json.Of_json ("Expected object for Implementation", j))

     

       
556
       
 
       
end

     
···

       
776
       
 
       
      ]

     

       
777
       
 
       


     

       
778
       
 
       
    let t_of_yojson = function

     

       
779
       
-
       
      | `Assoc fields ->

     

       
780
       
 
       
        let capabilities = match List.assoc_opt "capabilities" fields with

     

       
781
       
 
       
          | Some json -> json

     

       
782
       
-
       
          | None -> raise (Json.Of_json ("Missing capabilities field", `Assoc fields))

     

       
783
       
 
       
        in

     

       
784
       
 
       
        let client_info = match List.assoc_opt "clientInfo" fields with

     

       
785
       
 
       
          | Some json -> Implementation.t_of_yojson json

     

       
786
       
-
       
          | None -> raise (Json.Of_json ("Missing clientInfo field", `Assoc fields))

     

       
787
       
 
       
        in

     

       
788
       
-
       
        let protocol_version = match List.assoc_opt "protocolVersion" fields with

     

       
789
       
-
       
          | Some (`String s) -> s

     

       
790
       
-
       
          | _ -> raise (Json.Of_json ("Missing or invalid protocolVersion field", `Assoc fields))

     

       
791
       
-
       
        in

     

       
792
       
 
       
        { capabilities; client_info; protocol_version }

     

       
793
       
 
       
      | j -> raise (Json.Of_json ("Expected object for InitializeRequest", j))

     

       
794
       
 
       


     
···

       
826
       
 
       
      `Assoc assoc

     

       
827
       
 
       


     

       
828
       
 
       
    let t_of_yojson = function

     

       
829
       
-
       
      | `Assoc fields ->

     

       
830
       
 
       
        let capabilities = match List.assoc_opt "capabilities" fields with

     

       
831
       
 
       
          | Some json -> json

     

       
832
       
-
       
          | None -> raise (Json.Of_json ("Missing capabilities field", `Assoc fields))

     

       
833
       
 
       
        in

     

       
834
       
 
       
        let server_info = match List.assoc_opt "serverInfo" fields with

     

       
835
       
 
       
          | Some json -> Implementation.t_of_yojson json

     

       
836
       
-
       
          | None -> raise (Json.Of_json ("Missing serverInfo field", `Assoc fields))

     

       
837
       
-
       
        in

     

       
838
       
-
       
        let protocol_version = match List.assoc_opt "protocolVersion" fields with

     

       
839
       
-
       
          | Some (`String s) -> s

     

       
840
       
-
       
          | _ -> raise (Json.Of_json ("Missing or invalid protocolVersion field", `Assoc fields))

     

       
841
       
-
       
        in

     

       
842
       
-
       
        let instructions = match List.assoc_opt "instructions" fields with

     

       
843
       
-
       
          | Some (`String s) -> Some s

     

       
844
       
-
       
          | _ -> None

     

       
845
       
 
       
        in

     

       
0
       
 
       

     

       
0
       
 
       

     

       
846
       
 
       
        let meta = List.assoc_opt "_meta" fields in

     

       
847
       
 
       
        { capabilities; server_info; protocol_version; instructions; meta }

     

       
848
       
 
       
      | j -> raise (Json.Of_json ("Expected object for InitializeResult", j))

     

···

       
1
       
 
       
open Jsonrpc

     

       
2
       
 
       


     

       
3
       
+
       
(* Utility functions for JSON parsing *)

     

       
4
       
+
       
module Util = struct

     

       
5
       
+
       
  (* Extract a string field from JSON object or raise an error *)

     

       
6
       
+
       
  let get_string_field fields name json =

     

       
7
       
+
       
    match List.assoc_opt name fields with

     

       
8
       
+
       
    | Some (`String s) -> s

     

       
9
       
+
       
    | _ -> raise (Json.Of_json (Printf.sprintf "Missing or invalid '%s' field" name, json))

     

       
10
       
+
       
  

     

       
11
       
+
       
  (* Extract an optional string field from JSON object *)

     

       
12
       
+
       
  let get_optional_string_field fields name =

     

       
13
       
+
       
    List.assoc_opt name fields |> Option.map (function

     

       
14
       
+
       
      | `String s -> s

     

       
15
       
+
       
      | j -> raise (Json.Of_json (Printf.sprintf "Expected string for %s" name, j))

     

       
16
       
+
       
    )

     

       
17
       
+
       
  

     

       
18
       
+
       
  (* Extract an int field from JSON object or raise an error *)

     

       
19
       
+
       
  let get_int_field fields name json =

     

       
20
       
+
       
    match List.assoc_opt name fields with

     

       
21
       
+
       
    | Some (`Int i) -> i

     

       
22
       
+
       
    | _ -> raise (Json.Of_json (Printf.sprintf "Missing or invalid '%s' field" name, json))

     

       
23
       
+
       
    

     

       
24
       
+
       
  (* Extract a float field from JSON object or raise an error *)

     

       
25
       
+
       
  let get_float_field fields name json =

     

       
26
       
+
       
    match List.assoc_opt name fields with

     

       
27
       
+
       
    | Some (`Float f) -> f

     

       
28
       
+
       
    | _ -> raise (Json.Of_json (Printf.sprintf "Missing or invalid '%s' field" name, json))

     

       
29
       
+
       
  

     

       
30
       
+
       
  (* Extract a boolean field from JSON object or raise an error *)

     

       
31
       
+
       
  let get_bool_field fields name json =

     

       
32
       
+
       
    match List.assoc_opt name fields with

     

       
33
       
+
       
    | Some (`Bool b) -> b

     

       
34
       
+
       
    | _ -> raise (Json.Of_json (Printf.sprintf "Missing or invalid '%s' field" name, json))

     

       
35
       
+
       
    

     

       
36
       
+
       
  (* Extract an object field from JSON object or raise an error *)

     

       
37
       
+
       
  let get_object_field fields name json =

     

       
38
       
+
       
    match List.assoc_opt name fields with

     

       
39
       
+
       
    | Some (`Assoc obj) -> obj

     

       
40
       
+
       
    | _ -> raise (Json.Of_json (Printf.sprintf "Missing or invalid '%s' field" name, json))

     

       
41
       
+
       
    

     

       
42
       
+
       
  (* Extract a list field from JSON object or raise an error *)

     

       
43
       
+
       
  let get_list_field fields name json =

     

       
44
       
+
       
    match List.assoc_opt name fields with

     

       
45
       
+
       
    | Some (`List items) -> items

     

       
46
       
+
       
    | _ -> raise (Json.Of_json (Printf.sprintf "Missing or invalid '%s' field" name, json))

     

       
47
       
+
       
    

     

       
48
       
+
       
  (* Verify a specific string value in a field *)

     

       
49
       
+
       
  let verify_string_field fields name expected_value json =

     

       
50
       
+
       
    match List.assoc_opt name fields with

     

       
51
       
+
       
    | Some (`String s) when s = expected_value -> ()

     

       
52
       
+
       
    | _ -> raise (Json.Of_json (Printf.sprintf "Field '%s' missing or not equal to '%s'" name expected_value, json))

     

       
53
       
+
       
end

     

       
54
       
+
       


     

       
55
       
 
       
(* Error codes for JSON-RPC *)

     

       
56
       
 
       
module ErrorCode = struct

     

       
57
       
 
       
  type t = 

     
···

       
259
       
 
       
    `Assoc assoc

     

       
260
       
 
       


     

       
261
       
 
       
  let t_of_yojson = function

     

       
262
       
+
       
    | `Assoc fields as json ->

     

       
263
       
+
       
      let text = Util.get_string_field fields "text" json in

     

       
264
       
+
       
      Util.verify_string_field fields "type" "text" json;

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
265
       
 
       
      let annotations = List.assoc_opt "annotations" fields |> Option.map Annotated.annotation_of_yojson in

     

       
266
       
 
       
      { text; annotations }

     

       
267
       
 
       
    | j -> raise (Json.Of_json ("Expected object for TextContent", j))

     
···

       
287
       
 
       
    `Assoc assoc

     

       
288
       
 
       


     

       
289
       
 
       
  let t_of_yojson = function

     

       
290
       
+
       
    | `Assoc fields as json ->

     

       
291
       
+
       
      let data = Util.get_string_field fields "data" json in

     

       
292
       
+
       
      let mime_type = Util.get_string_field fields "mimeType" json in

     

       
293
       
+
       
      Util.verify_string_field fields "type" "image" json;

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
294
       
 
       
      let annotations = List.assoc_opt "annotations" fields |> Option.map Annotated.annotation_of_yojson in

     

       
295
       
 
       
      { data; mime_type; annotations }

     

       
296
       
 
       
    | j -> raise (Json.Of_json ("Expected object for ImageContent", j))

     
···

       
316
       
 
       
    `Assoc assoc

     

       
317
       
 
       


     

       
318
       
 
       
  let t_of_yojson = function

     

       
319
       
+
       
    | `Assoc fields as json ->

     

       
320
       
+
       
      let data = Util.get_string_field fields "data" json in

     

       
321
       
+
       
      let mime_type = Util.get_string_field fields "mimeType" json in

     

       
322
       
+
       
      Util.verify_string_field fields "type" "audio" json;

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
323
       
 
       
      let annotations = List.assoc_opt "annotations" fields |> Option.map Annotated.annotation_of_yojson in

     

       
324
       
 
       
      { data; mime_type; annotations }

     

       
325
       
 
       
    | j -> raise (Json.Of_json ("Expected object for AudioContent", j))

     
···

       
342
       
 
       
    `Assoc assoc

     

       
343
       
 
       


     

       
344
       
 
       
  let t_of_yojson = function

     

       
345
       
+
       
    | `Assoc fields as json ->

     

       
346
       
+
       
      let uri = Util.get_string_field fields "uri" json in

     

       
347
       
+
       
      let mime_type = Util.get_optional_string_field fields "mimeType" in

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
348
       
 
       
      { uri; mime_type }

     

       
349
       
 
       
    | j -> raise (Json.Of_json ("Expected object for ResourceContents", j))

     

       
350
       
 
       
end

     
···

       
368
       
 
       
    `Assoc assoc

     

       
369
       
 
       


     

       
370
       
 
       
  let t_of_yojson = function

     

       
371
       
+
       
    | `Assoc fields as json ->

     

       
372
       
+
       
      let uri = Util.get_string_field fields "uri" json in

     

       
373
       
+
       
      let text = Util.get_string_field fields "text" json in

     

       
374
       
+
       
      let mime_type = Util.get_optional_string_field fields "mimeType" in

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
375
       
 
       
      { uri; text; mime_type }

     

       
376
       
 
       
    | j -> raise (Json.Of_json ("Expected object for TextResourceContents", j))

     

       
377
       
 
       
end

     
···

       
395
       
 
       
    `Assoc assoc

     

       
396
       
 
       


     

       
397
       
 
       
  let t_of_yojson = function

     

       
398
       
+
       
    | `Assoc fields as json ->

     

       
399
       
+
       
      let uri = Util.get_string_field fields "uri" json in

     

       
400
       
+
       
      let blob = Util.get_string_field fields "blob" json in

     

       
401
       
+
       
      let mime_type = Util.get_optional_string_field fields "mimeType" in

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
402
       
 
       
      { uri; blob; mime_type }

     

       
403
       
 
       
    | j -> raise (Json.Of_json ("Expected object for BlobResourceContents", j))

     

       
404
       
 
       
end

     
···

       
425
       
 
       
    `Assoc assoc

     

       
426
       
 
       


     

       
427
       
 
       
  let t_of_yojson = function

     

       
428
       
+
       
    | `Assoc fields as json ->

     

       
429
       
+
       
      Util.verify_string_field fields "type" "resource" json;

     

       
430
       
+
       
      let resource_fields = match List.assoc_opt "resource" fields with

     

       
431
       
+
       
        | Some (`Assoc res_fields) -> res_fields

     

       
432
       
+
       
        | _ -> raise (Json.Of_json ("Missing or invalid 'resource' field", json))

     

       
433
       
 
       
      in

     

       
434
       
+
       
      let resource = 

     

       
435
       
+
       
        if List.mem_assoc "text" resource_fields then

     

       
436
       
+
       
          `Text (TextResourceContents.t_of_yojson (`Assoc resource_fields))

     

       
437
       
+
       
        else if List.mem_assoc "blob" resource_fields then

     

       
438
       
+
       
          `Blob (BlobResourceContents.t_of_yojson (`Assoc resource_fields))

     

       
439
       
+
       
        else

     

       
440
       
+
       
          raise (Json.Of_json ("Invalid resource content", `Assoc resource_fields))

     

       
0
       
 
       

     

       
0
       
 
       

     

       
441
       
 
       
      in

     

       
442
       
 
       
      let annotations = List.assoc_opt "annotations" fields |> Option.map Annotated.annotation_of_yojson in

     

       
443
       
 
       
      { resource; annotations }

     
···

       
481
       
 
       
    ]

     

       
482
       
 
       


     

       
483
       
 
       
  let t_of_yojson = function

     

       
484
       
+
       
    | `Assoc fields as json ->

     

       
485
       
 
       
      let role = match List.assoc_opt "role" fields with

     

       
486
       
 
       
        | Some json -> Role.t_of_yojson json

     

       
487
       
+
       
        | None -> raise (Json.Of_json ("Missing role field", json))

     

       
488
       
 
       
      in

     

       
489
       
 
       
      let content = match List.assoc_opt "content" fields with

     

       
490
       
 
       
        | Some json -> content_of_yojson json

     

       
491
       
+
       
        | None -> raise (Json.Of_json ("Missing content field", json))

     

       
492
       
 
       
      in

     

       
493
       
 
       
      { role; content }

     

       
494
       
 
       
    | j -> raise (Json.Of_json ("Expected object for PromptMessage", j))

     
···

       
512
       
 
       
    ]

     

       
513
       
 
       


     

       
514
       
 
       
  let t_of_yojson = function

     

       
515
       
+
       
    | `Assoc fields as json ->

     

       
516
       
 
       
      let role = match List.assoc_opt "role" fields with

     

       
517
       
 
       
        | Some json -> Role.t_of_yojson json

     

       
518
       
+
       
        | None -> raise (Json.Of_json ("Missing role field", json))

     

       
519
       
 
       
      in

     

       
520
       
+
       
      let content_obj = match List.assoc_opt "content" fields with

     

       
521
       
+
       
        | Some (`Assoc content_fields) -> content_fields

     

       
522
       
+
       
        | _ -> raise (Json.Of_json ("Missing or invalid content field", json))

     

       
523
       
+
       
      in

     

       
524
       
+
       
      let content_type = match List.assoc_opt "type" content_obj with

     

       
525
       
+
       
        | Some (`String ty) -> ty

     

       
526
       
+
       
        | _ -> raise (Json.Of_json ("Missing or invalid content type", `Assoc content_obj))

     

       
527
       
+
       
      in

     

       
528
       
+
       
      let content = 

     

       
529
       
+
       
        match content_type with

     

       
530
       
+
       
        | "text" -> `Text (TextContent.t_of_yojson (`Assoc content_obj))

     

       
531
       
+
       
        | "image" -> `Image (ImageContent.t_of_yojson (`Assoc content_obj))

     

       
532
       
+
       
        | "audio" -> `Audio (AudioContent.t_of_yojson (`Assoc content_obj))

     

       
533
       
+
       
        | _ -> raise (Json.Of_json (Printf.sprintf "Invalid content type: %s" content_type, `Assoc content_obj))

     

       
534
       
 
       
      in

     

       
535
       
 
       
      { role; content }

     

       
536
       
 
       
    | j -> raise (Json.Of_json ("Expected object for SamplingMessage", j))

     
···

       
551
       
 
       
    ]

     

       
552
       
 
       


     

       
553
       
 
       
  let t_of_yojson = function

     

       
554
       
+
       
    | `Assoc fields as json ->

     

       
555
       
+
       
      let name = Util.get_string_field fields "name" json in

     

       
556
       
+
       
      let version = Util.get_string_field fields "version" json in

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
557
       
 
       
      { name; version }

     

       
558
       
 
       
    | j -> raise (Json.Of_json ("Expected object for Implementation", j))

     

       
559
       
 
       
end

     
···

       
779
       
 
       
      ]

     

       
780
       
 
       


     

       
781
       
 
       
    let t_of_yojson = function

     

       
782
       
+
       
      | `Assoc fields as json ->

     

       
783
       
 
       
        let capabilities = match List.assoc_opt "capabilities" fields with

     

       
784
       
 
       
          | Some json -> json

     

       
785
       
+
       
          | None -> raise (Json.Of_json ("Missing capabilities field", json))

     

       
786
       
 
       
        in

     

       
787
       
 
       
        let client_info = match List.assoc_opt "clientInfo" fields with

     

       
788
       
 
       
          | Some json -> Implementation.t_of_yojson json

     

       
789
       
+
       
          | None -> raise (Json.Of_json ("Missing clientInfo field", json))

     

       
790
       
 
       
        in

     

       
791
       
+
       
        let protocol_version = Util.get_string_field fields "protocolVersion" json in

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
792
       
 
       
        { capabilities; client_info; protocol_version }

     

       
793
       
 
       
      | j -> raise (Json.Of_json ("Expected object for InitializeRequest", j))

     

       
794
       
 
       


     
···

       
826
       
 
       
      `Assoc assoc

     

       
827
       
 
       


     

       
828
       
 
       
    let t_of_yojson = function

     

       
829
       
+
       
      | `Assoc fields as json ->

     

       
830
       
 
       
        let capabilities = match List.assoc_opt "capabilities" fields with

     

       
831
       
 
       
          | Some json -> json

     

       
832
       
+
       
          | None -> raise (Json.Of_json ("Missing capabilities field", json))

     

       
833
       
 
       
        in

     

       
834
       
 
       
        let server_info = match List.assoc_opt "serverInfo" fields with

     

       
835
       
 
       
          | Some json -> Implementation.t_of_yojson json

     

       
836
       
+
       
          | None -> raise (Json.Of_json ("Missing serverInfo field", json))

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
837
       
 
       
        in

     

       
838
       
+
       
        let protocol_version = Util.get_string_field fields "protocolVersion" json in

     

       
839
       
+
       
        let instructions = Util.get_optional_string_field fields "instructions" in

     

       
840
       
 
       
        let meta = List.assoc_opt "_meta" fields in

     

       
841
       
 
       
        { capabilities; server_info; protocol_version; instructions; meta }

     

       
842
       
 
       
      | j -> raise (Json.Of_json ("Expected object for InitializeResult", j))

     

···

       
23
       
 
       


     

       
24
       
 
       
open Jsonrpc

     

       
25
       
 
       


     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
26
       
 
       
(** Error codes for JSON-RPC *)

     

       
27
       
 
       
module ErrorCode : sig

     

       
28
       
 
       
  (** Standard JSON-RPC error codes with MCP-specific additions *)

     

···

       
23
       
 
       


     

       
24
       
 
       
open Jsonrpc

     

       
25
       
 
       


     

       
26
       
+
       
(** Utility functions for JSON parsing *)

     

       
27
       
+
       
module Util : sig

     

       
28
       
+
       
  (** Extract a string field from JSON object or raise an error 

     

       
29
       
+
       
      @param fields Assoc list of fields from JSON object

     

       
30
       
+
       
      @param name Field name to extract

     

       
31
       
+
       
      @param json Original JSON for error context

     

       
32
       
+
       
      @return The string value of the field

     

       
33
       
+
       
      @raise Json.Of_json if the field is missing or not a string

     

       
34
       
+
       
  *)

     

       
35
       
+
       
  val get_string_field : (string * Json.t) list -> string -> Json.t -> string

     

       
36
       
+
       
  

     

       
37
       
+
       
  (** Extract an optional string field from JSON object

     

       
38
       
+
       
      @param fields Assoc list of fields from JSON object

     

       
39
       
+
       
      @param name Field name to extract

     

       
40
       
+
       
      @return Some string if present and a string, None if missing

     

       
41
       
+
       
      @raise Json.Of_json if the field exists but is not a string

     

       
42
       
+
       
  *)

     

       
43
       
+
       
  val get_optional_string_field : (string * Json.t) list -> string -> string option

     

       
44
       
+
       
  

     

       
45
       
+
       
  (** Extract an int field from JSON object or raise an error

     

       
46
       
+
       
      @param fields Assoc list of fields from JSON object

     

       
47
       
+
       
      @param name Field name to extract

     

       
48
       
+
       
      @param json Original JSON for error context

     

       
49
       
+
       
      @return The int value of the field

     

       
50
       
+
       
      @raise Json.Of_json if the field is missing or not an int

     

       
51
       
+
       
  *)

     

       
52
       
+
       
  val get_int_field : (string * Json.t) list -> string -> Json.t -> int

     

       
53
       
+
       
  

     

       
54
       
+
       
  (** Extract a float field from JSON object or raise an error

     

       
55
       
+
       
      @param fields Assoc list of fields from JSON object

     

       
56
       
+
       
      @param name Field name to extract

     

       
57
       
+
       
      @param json Original JSON for error context

     

       
58
       
+
       
      @return The float value of the field

     

       
59
       
+
       
      @raise Json.Of_json if the field is missing or not a float

     

       
60
       
+
       
  *)

     

       
61
       
+
       
  val get_float_field : (string * Json.t) list -> string -> Json.t -> float

     

       
62
       
+
       
  

     

       
63
       
+
       
  (** Extract a boolean field from JSON object or raise an error

     

       
64
       
+
       
      @param fields Assoc list of fields from JSON object

     

       
65
       
+
       
      @param name Field name to extract

     

       
66
       
+
       
      @param json Original JSON for error context

     

       
67
       
+
       
      @return The boolean value of the field

     

       
68
       
+
       
      @raise Json.Of_json if the field is missing or not a boolean

     

       
69
       
+
       
  *)

     

       
70
       
+
       
  val get_bool_field : (string * Json.t) list -> string -> Json.t -> bool

     

       
71
       
+
       
  

     

       
72
       
+
       
  (** Extract an object field from JSON object or raise an error

     

       
73
       
+
       
      @param fields Assoc list of fields from JSON object

     

       
74
       
+
       
      @param name Field name to extract

     

       
75
       
+
       
      @param json Original JSON for error context

     

       
76
       
+
       
      @return The object as an assoc list

     

       
77
       
+
       
      @raise Json.Of_json if the field is missing or not an object

     

       
78
       
+
       
  *)

     

       
79
       
+
       
  val get_object_field : (string * Json.t) list -> string -> Json.t -> (string * Json.t) list

     

       
80
       
+
       
  

     

       
81
       
+
       
  (** Extract a list field from JSON object or raise an error

     

       
82
       
+
       
      @param fields Assoc list of fields from JSON object

     

       
83
       
+
       
      @param name Field name to extract

     

       
84
       
+
       
      @param json Original JSON for error context

     

       
85
       
+
       
      @return The list items

     

       
86
       
+
       
      @raise Json.Of_json if the field is missing or not a list

     

       
87
       
+
       
  *)

     

       
88
       
+
       
  val get_list_field : (string * Json.t) list -> string -> Json.t -> Json.t list

     

       
89
       
+
       
  

     

       
90
       
+
       
  (** Verify a specific string value in a field

     

       
91
       
+
       
      @param fields Assoc list of fields from JSON object

     

       
92
       
+
       
      @param name Field name to check

     

       
93
       
+
       
      @param expected_value The expected string value

     

       
94
       
+
       
      @param json Original JSON for error context

     

       
95
       
+
       
      @raise Json.Of_json if the field is missing or not equal to expected_value

     

       
96
       
+
       
  *)

     

       
97
       
+
       
  val verify_string_field : (string * Json.t) list -> string -> string -> Json.t -> unit

     

       
98
       
+
       
end

     

       
99
       
+
       


     

       
100
       
 
       
(** Error codes for JSON-RPC *)

     

       
101
       
 
       
module ErrorCode : sig

     

       
102
       
 
       
  (** Standard JSON-RPC error codes with MCP-specific additions *)

     

···

       
74
       
 
       
      | None -> assoc

     

       
75
       
 
       
    in

     

       
76
       
 
       
    `Assoc assoc

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
77
       
 
       
end

     

       
78
       
 
       


     

       
79
       
 
       
(* Resources for the MCP server *)

     
···

       
165
       
 
       
    `Assoc assoc

     

       
166
       
 
       
end

     

       
167
       
 
       


     

       
168
       
-
       
(* Content type constructors have been moved to the Mcp module *)

     

       
169
       
-
       


     

       
170
       
-
       
(* Tool result handling using Mcp_message.ToolsCall.ToolContent *)

     

       
171
       
-
       


     

       
172
       
-
       
let create_tool_result contents ~is_error =

     

       
173
       
-
       
  (* Use the original Mcp.content values as is *)

     

       
174
       
-
       
  let content = List.map (fun content ->

     

       
175
       
-
       
    match content with

     

       
176
       
-
       
    | Text text_content -> 

     

       
177
       
-
       
        Mcp_message.ToolsCall.ToolContent.Text text_content

     

       
178
       
-
       
    | Image image_content -> 

     

       
179
       
-
       
        Mcp_message.ToolsCall.ToolContent.Image image_content

     

       
180
       
-
       
    | Audio audio_content -> 

     

       
181
       
-
       
        Mcp_message.ToolsCall.ToolContent.Audio audio_content

     

       
182
       
-
       
    | Resource resource_content ->

     

       
183
       
-
       
        Mcp_message.ToolsCall.ToolContent.Resource resource_content

     

       
184
       
-
       
  ) contents in

     

       
185
       
-
       
  

     

       
186
       
-
       
  (* Use the ToolsCall.Response module's JSON conversion *)

     

       
187
       
-
       
  Mcp_message.ToolsCall.Response.yojson_of_t { content; is_error }

     

       
188
       
-
       


     

       
189
       
-
       
(* Using error codes from Mcp.ErrorCode module *)

     

       
190
       
-
       


     

       
191
       
 
       
let make_tool_schema properties required =

     

       
192
       
 
       
  let props = List.map (fun (name, schema_type, description) ->

     

       
193
       
 
       
    (name, `Assoc [

     
···

       
280
       
 
       
  server.tools <- tool :: server.tools;

     

       
281
       
 
       
  tool

     

       
282
       
 
       


     

       
283
       
-
       
(* Create a rich tool result with multiple content types *)

     

       
284
       
-
       
let create_rich_tool_result ?(text=None) ?(image=None) ?(audio=None) ?(resource=None) ~is_error () =

     

       
285
       
-
       
  let contents = [] in

     

       
286
       
-
       
  

     

       
287
       
-
       
  (* Add text content if provided *)

     

       
288
       
-
       
  let contents = match text with

     

       
289
       
-
       
    | Some text -> (Mcp.make_text_content text) :: contents

     

       
290
       
-
       
    | None -> contents

     

       
291
       
-
       
  in

     

       
292
       
-
       
  

     

       
293
       
-
       
  (* Add image content if provided *)

     

       
294
       
-
       
  let contents = match image with

     

       
295
       
-
       
    | Some (data, mime_type) -> (Mcp.make_image_content data mime_type) :: contents

     

       
296
       
-
       
    | None -> contents

     

       
297
       
-
       
  in

     

       
298
       
-
       
  

     

       
299
       
-
       
  (* Add audio content if provided *)

     

       
300
       
-
       
  let contents = match audio with

     

       
301
       
-
       
    | Some (data, mime_type) -> (Mcp.make_audio_content data mime_type) :: contents

     

       
302
       
-
       
    | None -> contents

     

       
303
       
-
       
  in

     

       
304
       
-
       
  

     

       
305
       
-
       
  (* Add resource content if provided *)

     

       
306
       
-
       
  let contents = match resource with

     

       
307
       
-
       
    | Some (uri, data, is_blob, mime_type) -> 

     

       
308
       
-
       
        (if is_blob then 

     

       
309
       
-
       
           Mcp.make_resource_blob_content uri data mime_type

     

       
310
       
-
       
         else 

     

       
311
       
-
       
           Mcp.make_resource_text_content uri data mime_type) :: contents

     

       
312
       
-
       
    | None -> contents

     

       
313
       
-
       
  in

     

       
314
       
-
       
  

     

       
315
       
-
       
  (* Create the final tool result *)

     

       
316
       
-
       
  create_tool_result (List.rev contents) ~is_error

     

       
317
       
-
       


     

       
318
       
 
       
(* Create and register a tool in one step *)

     

       
319
       
 
       
let add_tool server ~name ?description ?(schema_properties=[]) ?(schema_required=[]) handler =

     

       
320
       
 
       
  let input_schema = make_tool_schema schema_properties schema_required in

     
···

       
401
       
 
       
  let capabilities = default_capabilities ~with_tools ~with_resources ~with_prompts () in

     

       
402
       
 
       
  set_capabilities server capabilities;

     

       
403
       
 
       
  server

     

       
404
       
-
       


     

       
405
       
-
       
(* The MCP message helpers have been moved to Mcp_message module. 

     

       
406
       
-
       
   This module now reexports them through open statements. *)

     

···

       
74
       
 
       
      | None -> assoc

     

       
75
       
 
       
    in

     

       
76
       
 
       
    `Assoc assoc

     

       
77
       
+
       
    

     

       
78
       
+
       
  (* Create a tool result with content *)

     

       
79
       
+
       
  let create_tool_result content ~is_error =

     

       
80
       
+
       
    `Assoc [

     

       
81
       
+
       
      ("content", `List (List.map Mcp.yojson_of_content content));

     

       
82
       
+
       
      ("isError", `Bool is_error);

     

       
83
       
+
       
    ]

     

       
84
       
+
       


     

       
85
       
+
       
  (* Create a tool error result with structured content *)

     

       
86
       
+
       
  let create_error_result error =

     

       
87
       
+
       
    create_tool_result [Mcp.make_text_content error] ~is_error:true

     

       
88
       
+
       
  

     

       
89
       
+
       
  (* Handle tool execution errors *)

     

       
90
       
+
       
  let handle_execution_error err =

     

       
91
       
+
       
    Log.error (Printf.sprintf "Tool execution failed: %s" err);

     

       
92
       
+
       
    create_error_result (Printf.sprintf "Error executing tool: %s" err)

     

       
93
       
+
       
  

     

       
94
       
+
       
  (* Handle unknown tool error *)

     

       
95
       
+
       
  let handle_unknown_tool_error name =

     

       
96
       
+
       
    Log.error (Printf.sprintf "Unknown tool: %s" name);

     

       
97
       
+
       
    create_error_result (Printf.sprintf "Unknown tool: %s" name)

     

       
98
       
+
       
  

     

       
99
       
+
       
  (* Handle general tool execution exception *)

     

       
100
       
+
       
  let handle_execution_exception exn =

     

       
101
       
+
       
    Log.error (Printf.sprintf "Exception executing tool: %s" (Printexc.to_string exn));

     

       
102
       
+
       
    create_error_result (Printf.sprintf "Internal error: %s" (Printexc.to_string exn))

     

       
103
       
 
       
end

     

       
104
       
 
       


     

       
105
       
 
       
(* Resources for the MCP server *)

     
···

       
191
       
 
       
    `Assoc assoc

     

       
192
       
 
       
end

     

       
193
       
 
       


     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
194
       
 
       
let make_tool_schema properties required =

     

       
195
       
 
       
  let props = List.map (fun (name, schema_type, description) ->

     

       
196
       
 
       
    (name, `Assoc [

     
···

       
283
       
 
       
  server.tools <- tool :: server.tools;

     

       
284
       
 
       
  tool

     

       
285
       
 
       


     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
286
       
 
       
(* Create and register a tool in one step *)

     

       
287
       
 
       
let add_tool server ~name ?description ?(schema_properties=[]) ?(schema_required=[]) handler =

     

       
288
       
 
       
  let input_schema = make_tool_schema schema_properties schema_required in

     
···

       
369
       
 
       
  let capabilities = default_capabilities ~with_tools ~with_resources ~with_prompts () in

     

       
370
       
 
       
  set_capabilities server capabilities;

     

       
371
       
 
       
  server

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

···

       
41
       
 
       


     

       
42
       
 
       
  val create : name:string -> ?description:string -> input_schema:Json.t -> handler:handler -> unit -> t

     

       
43
       
 
       
  val to_json : t -> Json.t

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
44
       
 
       
end

     

       
45
       
 
       


     

       
46
       
 
       
(** Resources for the MCP server *)

     
···

       
113
       
 
       


     

       
114
       
 
       
(** Configure server with default capabilities based on registered components *)

     

       
115
       
 
       
val configure_server : server -> ?with_tools:bool -> ?with_resources:bool -> ?with_prompts:bool -> unit -> server

     

       
116
       
-
       


     

       
117
       
-
       
val create_tool_result : content list -> is_error:bool -> Json.t

     

       
118
       
-
       


     

       
119
       
-
       
(** Create a rich tool result with multiple content types *)

     

       
120
       
-
       
val create_rich_tool_result : 

     

       
121
       
-
       
  ?text:string option -> 

     

       
122
       
-
       
  ?image:(string * string) option -> 

     

       
123
       
-
       
  ?audio:(string * string) option ->

     

       
124
       
-
       
  ?resource:(string * string * bool * string option) option -> 

     

       
125
       
-
       
  is_error:bool -> 

     

       
126
       
-
       
  unit -> Json.t

     

       
127
       
 
       


     

       
128
       
 
       
val make_tool_schema : (string * string * string) list -> string list -> Json.t

     

···

       
41
       
 
       


     

       
42
       
 
       
  val create : name:string -> ?description:string -> input_schema:Json.t -> handler:handler -> unit -> t

     

       
43
       
 
       
  val to_json : t -> Json.t

     

       
44
       
+
       
  

     

       
45
       
+
       
  (** Create a tool result with content *)

     

       
46
       
+
       
  val create_tool_result : Mcp.content list -> is_error:bool -> Json.t

     

       
47
       
+
       
  

     

       
48
       
+
       
  (** Create a tool error result with structured content *)

     

       
49
       
+
       
  val create_error_result : string -> Json.t

     

       
50
       
+
       
  

     

       
51
       
+
       
  (** Handle tool execution errors *)

     

       
52
       
+
       
  val handle_execution_error : string -> Json.t

     

       
53
       
+
       
  

     

       
54
       
+
       
  (** Handle unknown tool error *)

     

       
55
       
+
       
  val handle_unknown_tool_error : string -> Json.t

     

       
56
       
+
       
  

     

       
57
       
+
       
  (** Handle general tool execution exception *)

     

       
58
       
+
       
  val handle_execution_exception : exn -> Json.t

     

       
59
       
 
       
end

     

       
60
       
 
       


     

       
61
       
 
       
(** Resources for the MCP server *)

     
···

       
128
       
 
       


     

       
129
       
 
       
(** Configure server with default capabilities based on registered components *)

     

       
130
       
 
       
val configure_server : server -> ?with_tools:bool -> ?with_resources:bool -> ?with_prompts:bool -> unit -> server

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
131
       
 
       


     

       
132
       
 
       
val make_tool_schema : (string * string * string) list -> string list -> Json.t

     

···

       
80
       
 
       
  in

     

       
81
       
 
       
  create_error ~id ~code:error_code ~message ~data:(Some error_data) ()

     

       
82
       
 
       


     

       
83
       
-
       
(* Create a tool error result with structured content *)

     

       
84
       
-
       
let create_tool_error_result error =

     

       
85
       
-
       
  create_tool_result [make_text_content error] ~is_error:true

     

       
86
       
-
       


     

       
87
       
-
       
(* Handle tool execution errors *)

     

       
88
       
-
       
let handle_tool_execution_error err =

     

       
89
       
-
       
  Log.error (Printf.sprintf "Tool execution failed: %s" err);

     

       
90
       
-
       
  create_tool_error_result (Printf.sprintf "Error executing tool: %s" err)

     

       
91
       
-
       


     

       
92
       
-
       
(* Handle unknown tool error *)

     

       
93
       
-
       
let handle_unknown_tool_error name =

     

       
94
       
-
       
  Log.error (Printf.sprintf "Unknown tool: %s" name);

     

       
95
       
-
       
  create_tool_error_result (Printf.sprintf "Unknown tool: %s" name)

     

       
96
       
-
       


     

       
97
       
-
       
(* Handle general tool execution exception *)

     

       
98
       
-
       
let handle_tool_execution_exception exn =

     

       
99
       
-
       
  Log.error (Printf.sprintf "Exception executing tool: %s" (Printexc.to_string exn));

     

       
100
       
-
       
  create_tool_error_result (Printf.sprintf "Internal error: %s" (Printexc.to_string exn))

     

       
101
       
 
       


     

       
102
       
 
       
(* Execute a tool *)

     

       
103
       
 
       
let execute_tool server ctx name args =

     
···

       
110
       
 
       
    | Ok result -> 

     

       
111
       
 
       
        Log.debug "Tool execution succeeded";

     

       
112
       
 
       
        result

     

       
113
       
-
       
    | Error err -> handle_tool_execution_error err

     

       
114
       
 
       
  with

     

       
115
       
-
       
  | Not_found -> handle_unknown_tool_error name

     

       
116
       
-
       
  | exn -> handle_tool_execution_exception exn

     

       
117
       
 
       


     

       
118
       
 
       
(* Process tools/call request *)

     

       
119
       
 
       
let handle_tools_call server req =

     

···

       
80
       
 
       
  in

     

       
81
       
 
       
  create_error ~id ~code:error_code ~message ~data:(Some error_data) ()

     

       
82
       
 
       


     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
83
       
 
       


     

       
84
       
 
       
(* Execute a tool *)

     

       
85
       
 
       
let execute_tool server ctx name args =

     
···

       
92
       
 
       
    | Ok result -> 

     

       
93
       
 
       
        Log.debug "Tool execution succeeded";

     

       
94
       
 
       
        result

     

       
95
       
+
       
    | Error err -> Tool.handle_execution_error err

     

       
96
       
 
       
  with

     

       
97
       
+
       
  | Not_found -> Tool.handle_unknown_tool_error name

     

       
98
       
+
       
  | exn -> Tool.handle_execution_exception exn

     

       
99
       
 
       


     

       
100
       
 
       
(* Process tools/call request *)

     

       
101
       
 
       
let handle_tools_call server req =