Model Context Protocol in OCaml

Refactor JSON error handling to use Util.json_error helper

- Update all instances of direct 'raise (Json.Of_json' to use the centralized helper
- Use consistent error message formatting with the helper in both mcp.ml and mcp_rpc.ml
- Ensure all JSON parsing errors include the JSON object in the error message
- Maintain standard naming patterns for all error messages

🤖 Generated with [Claude Code](https://claude.ai/code)

Co-Authored-By: Claude <noreply@anthropic.com>

Changed files
+143 -131
lib
+70 -66
lib/mcp.ml
···
(* Utility functions for JSON parsing *)
module Util = struct
(* Extract a string field from JSON object or raise an error *)
let get_string_field fields name json =
match List.assoc_opt name fields with
| Some (`String s) -> s
-
| _ -> raise (Json.Of_json (Printf.sprintf "Missing or invalid '%s' field" name, json))
(* Extract an optional string field from JSON object *)
let get_optional_string_field fields name =
List.assoc_opt name fields |> Option.map (function
| `String s -> s
-
| j -> raise (Json.Of_json (Printf.sprintf "Expected string for %s" name, j))
)
(* Extract an int field from JSON object or raise an error *)
let get_int_field fields name json =
match List.assoc_opt name fields with
| Some (`Int i) -> i
-
| _ -> raise (Json.Of_json (Printf.sprintf "Missing or invalid '%s' field" name, json))
(* Extract a float field from JSON object or raise an error *)
let get_float_field fields name json =
match List.assoc_opt name fields with
| Some (`Float f) -> f
-
| _ -> raise (Json.Of_json (Printf.sprintf "Missing or invalid '%s' field" name, json))
(* Extract a boolean field from JSON object or raise an error *)
let get_bool_field fields name json =
match List.assoc_opt name fields with
| Some (`Bool b) -> b
-
| _ -> raise (Json.Of_json (Printf.sprintf "Missing or invalid '%s' field" name, json))
(* Extract an object field from JSON object or raise an error *)
let get_object_field fields name json =
match List.assoc_opt name fields with
| Some (`Assoc obj) -> obj
-
| _ -> raise (Json.Of_json (Printf.sprintf "Missing or invalid '%s' field" name, json))
(* Extract a list field from JSON object or raise an error *)
let get_list_field fields name json =
match List.assoc_opt name fields with
| Some (`List items) -> items
-
| _ -> raise (Json.Of_json (Printf.sprintf "Missing or invalid '%s' field" name, json))
(* Verify a specific string value in a field *)
let verify_string_field fields name expected_value json =
match List.assoc_opt name fields with
| Some (`String s) when s = expected_value -> ()
-
| _ -> raise (Json.Of_json (Printf.sprintf "Field '%s' missing or not equal to '%s'" name expected_value, json))
end
(* Error codes for JSON-RPC *)
···
let of_string = function
| "user" -> `User
| "assistant" -> `Assistant
-
| s -> raise (Json.Of_json ("Unknown role: " ^ s, `String s))
let yojson_of_t t = `String (to_string t)
let t_of_yojson = function
| `String s -> of_string s
-
| j -> raise (Json.Of_json ("Expected string for Role", j))
end
module ProgressToken = struct
···
let yojson_of_t t = `String t
let t_of_yojson = function
| `String s -> s
-
| j -> raise (Json.Of_json ("Expected string for Cursor", j))
end
(* Annotations *)
···
| `Assoc fields ->
let audience = List.assoc_opt "audience" fields |> Option.map (function
| `List items -> List.map Role.t_of_yojson items
-
| j -> raise (Json.Of_json ("Expected list for audience", j))
) in
let priority = List.assoc_opt "priority" fields |> Option.map (function
| `Float f -> f
-
| j -> raise (Json.Of_json ("Expected float for priority", j))
) in
{ audience; priority }
-
| j -> raise (Json.Of_json ("Expected object for annotation", j))
let yojson_of_t { annotations } =
match annotations with
···
| `Assoc fields ->
let annotations = List.assoc_opt "annotations" fields |> Option.map annotation_of_yojson in
{ annotations }
-
| j -> raise (Json.Of_json ("Expected object for Annotated", j))
end
(* Content types *)
···
Util.verify_string_field fields "type" "text" json;
let annotations = List.assoc_opt "annotations" fields |> Option.map Annotated.annotation_of_yojson in
{ text; annotations }
-
| j -> raise (Json.Of_json ("Expected object for TextContent", j))
end
module ImageContent = struct
···
Util.verify_string_field fields "type" "image" json;
let annotations = List.assoc_opt "annotations" fields |> Option.map Annotated.annotation_of_yojson in
{ data; mime_type; annotations }
-
| j -> raise (Json.Of_json ("Expected object for ImageContent", j))
end
module AudioContent = struct
···
Util.verify_string_field fields "type" "audio" json;
let annotations = List.assoc_opt "annotations" fields |> Option.map Annotated.annotation_of_yojson in
{ data; mime_type; annotations }
-
| j -> raise (Json.Of_json ("Expected object for AudioContent", j))
end
module ResourceContents = struct
···
let uri = Util.get_string_field fields "uri" json in
let mime_type = Util.get_optional_string_field fields "mimeType" in
{ uri; mime_type }
-
| j -> raise (Json.Of_json ("Expected object for ResourceContents", j))
end
module TextResourceContents = struct
···
let text = Util.get_string_field fields "text" json in
let mime_type = Util.get_optional_string_field fields "mimeType" in
{ uri; text; mime_type }
-
| j -> raise (Json.Of_json ("Expected object for TextResourceContents", j))
end
module BlobResourceContents = struct
···
let blob = Util.get_string_field fields "blob" json in
let mime_type = Util.get_optional_string_field fields "mimeType" in
{ uri; blob; mime_type }
-
| j -> raise (Json.Of_json ("Expected object for BlobResourceContents", j))
end
module EmbeddedResource = struct
···
Util.verify_string_field fields "type" "resource" json;
let resource_fields = match List.assoc_opt "resource" fields with
| Some (`Assoc res_fields) -> res_fields
-
| _ -> raise (Json.Of_json ("Missing or invalid 'resource' field", json))
in
let resource =
if List.mem_assoc "text" resource_fields then
···
else if List.mem_assoc "blob" resource_fields then
`Blob (BlobResourceContents.t_of_yojson (`Assoc resource_fields))
else
-
raise (Json.Of_json ("Invalid resource content", `Assoc resource_fields))
in
let annotations = List.assoc_opt "annotations" fields |> Option.map Annotated.annotation_of_yojson in
{ resource; annotations }
-
| j -> raise (Json.Of_json ("Expected object for EmbeddedResource", j))
end
type content =
···
| Resource r -> EmbeddedResource.yojson_of_t r
let content_of_yojson = function
-
| `Assoc fields ->
(match List.assoc_opt "type" fields with
-
| Some (`String "text") -> Text (TextContent.t_of_yojson (`Assoc fields))
-
| Some (`String "image") -> Image (ImageContent.t_of_yojson (`Assoc fields))
-
| Some (`String "audio") -> Audio (AudioContent.t_of_yojson (`Assoc fields))
-
| Some (`String "resource") -> Resource (EmbeddedResource.t_of_yojson (`Assoc fields))
-
| _ -> raise (Json.Of_json ("Invalid or missing content type", `Assoc fields)))
-
| j -> raise (Json.Of_json ("Expected object for content", j))
(* Message types *)
···
| `Assoc fields as json ->
let role = match List.assoc_opt "role" fields with
| Some json -> Role.t_of_yojson json
-
| None -> raise (Json.Of_json ("Missing role field", json))
in
let content = match List.assoc_opt "content" fields with
| Some json -> content_of_yojson json
-
| None -> raise (Json.Of_json ("Missing content field", json))
in
{ role; content }
-
| j -> raise (Json.Of_json ("Expected object for PromptMessage", j))
end
module SamplingMessage = struct
···
| `Assoc fields as json ->
let role = match List.assoc_opt "role" fields with
| Some json -> Role.t_of_yojson json
-
| None -> raise (Json.Of_json ("Missing role field", json))
in
let content_obj = match List.assoc_opt "content" fields with
| Some (`Assoc content_fields) -> content_fields
-
| _ -> raise (Json.Of_json ("Missing or invalid content field", json))
in
let content_type = match List.assoc_opt "type" content_obj with
| Some (`String ty) -> ty
-
| _ -> raise (Json.Of_json ("Missing or invalid content type", `Assoc content_obj))
in
let content =
match content_type with
| "text" -> `Text (TextContent.t_of_yojson (`Assoc content_obj))
| "image" -> `Image (ImageContent.t_of_yojson (`Assoc content_obj))
| "audio" -> `Audio (AudioContent.t_of_yojson (`Assoc content_obj))
-
| _ -> raise (Json.Of_json (Printf.sprintf "Invalid content type: %s" content_type, `Assoc content_obj))
in
{ role; content }
-
| j -> raise (Json.Of_json ("Expected object for SamplingMessage", j))
end
(* Implementation info *)
···
let name = Util.get_string_field fields "name" json in
let version = Util.get_string_field fields "version" json in
{ name; version }
-
| j -> raise (Json.Of_json ("Expected object for Implementation", j))
end
(* JSONRPC Message types *)
···
let meth = match List.assoc_opt "method" fields with
| Some (`String s) ->
(try Method.of_string s
-
with Failure msg -> raise (Json.Of_json (msg, `String s)))
-
| _ -> raise (Json.Of_json ("Missing or invalid 'method' field", `Assoc fields))
in
let params = List.assoc_opt "params" fields in
{ meth; params }
-
| j -> raise (Json.Of_json ("Expected object for notification", j))
let request_of_yojson = function
| `Assoc fields ->
let id = match List.assoc_opt "id" fields with
| Some id_json -> Id.t_of_yojson id_json
-
| _ -> raise (Json.Of_json ("Missing or invalid 'id' field", `Assoc fields))
in
let meth = match List.assoc_opt "method" fields with
| Some (`String s) ->
(try Method.of_string s
-
with Failure msg -> raise (Json.Of_json (msg, `String s)))
-
| _ -> raise (Json.Of_json ("Missing or invalid 'method' field", `Assoc fields))
in
let params = List.assoc_opt "params" fields in
let progress_token =
···
| _ -> None
in
{ id; meth; params; progress_token }
-
| j -> raise (Json.Of_json ("Expected object for request", j))
let response_of_yojson = function
| `Assoc fields ->
let id = match List.assoc_opt "id" fields with
| Some id_json -> Id.t_of_yojson id_json
-
| _ -> raise (Json.Of_json ("Missing or invalid 'id' field", `Assoc fields))
in
let result = match List.assoc_opt "result" fields with
| Some result -> result
-
| _ -> raise (Json.Of_json ("Missing 'result' field", `Assoc fields))
in
{ id; result }
-
| j -> raise (Json.Of_json ("Expected object for response", j))
let error_of_yojson = function
-
| `Assoc fields ->
let id = match List.assoc_opt "id" fields with
| Some id_json -> Id.t_of_yojson id_json
-
| _ -> raise (Json.Of_json ("Missing or invalid 'id' field", `Assoc fields))
in
let error = match List.assoc_opt "error" fields with
| Some (`Assoc error_fields) -> error_fields
-
| _ -> raise (Json.Of_json ("Missing or invalid 'error' field", `Assoc fields))
in
let code = match List.assoc_opt "code" error with
| Some (`Int code) -> code
-
| _ -> raise (Json.Of_json ("Missing or invalid 'code' field in error", `Assoc error))
in
let message = match List.assoc_opt "message" error with
| Some (`String msg) -> msg
-
| _ -> raise (Json.Of_json ("Missing or invalid 'message' field in error", `Assoc error))
in
let data = List.assoc_opt "data" error in
{ id; code; message; data }
-
| j -> raise (Json.Of_json ("Expected object for error", j))
let t_of_yojson json =
match json with
| `Assoc fields ->
let _jsonrpc = match List.assoc_opt "jsonrpc" fields with
| Some (`String "2.0") -> ()
-
| _ -> raise (Json.Of_json ("Missing or invalid 'jsonrpc' field", json))
in
if List.mem_assoc "method" fields then
if List.mem_assoc "id" fields then
···
else if List.mem_assoc "error" fields then
Error (error_of_yojson json)
else
-
raise (Json.Of_json ("Invalid JSONRPC message format", json))
-
| j -> raise (Json.Of_json ("Expected object for JSONRPC message", j))
let create_notification ?(params=None) ~meth () =
Notification { meth; params }
···
| `Assoc fields as json ->
let capabilities = match List.assoc_opt "capabilities" fields with
| Some json -> json
-
| None -> raise (Json.Of_json ("Missing capabilities field", json))
in
let client_info = match List.assoc_opt "clientInfo" fields with
| Some json -> Implementation.t_of_yojson json
-
| None -> raise (Json.Of_json ("Missing clientInfo field", json))
in
let protocol_version = Util.get_string_field fields "protocolVersion" json in
{ capabilities; client_info; protocol_version }
-
| j -> raise (Json.Of_json ("Expected object for InitializeRequest", j))
let create ~capabilities ~client_info ~protocol_version =
{ capabilities; client_info; protocol_version }
···
| `Assoc fields as json ->
let capabilities = match List.assoc_opt "capabilities" fields with
| Some json -> json
-
| None -> raise (Json.Of_json ("Missing capabilities field", json))
in
let server_info = match List.assoc_opt "serverInfo" fields with
| Some json -> Implementation.t_of_yojson json
-
| None -> raise (Json.Of_json ("Missing serverInfo field", json))
in
let protocol_version = Util.get_string_field fields "protocolVersion" json in
let instructions = Util.get_optional_string_field fields "instructions" in
let meta = List.assoc_opt "_meta" fields in
{ capabilities; server_info; protocol_version; instructions; meta }
-
| j -> raise (Json.Of_json ("Expected object for InitializeResult", j))
let create ~capabilities ~server_info ~protocol_version ?instructions ?meta () =
{ capabilities; server_info; protocol_version; instructions; meta }
···
| `Assoc fields ->
let meta = List.assoc_opt "_meta" fields in
{ meta }
-
| j -> raise (Json.Of_json ("Expected object for InitializedNotification", j))
let create ?meta () = { meta }
···
(* Utility functions for JSON parsing *)
module Util = struct
+
(* Helper to raise a Json.Of_json exception with formatted message *)
+
let json_error fmt json =
+
Printf.ksprintf (fun msg -> raise (Json.Of_json (msg, json))) fmt
+
(* Extract a string field from JSON object or raise an error *)
let get_string_field fields name json =
match List.assoc_opt name fields with
| Some (`String s) -> s
+
| _ -> json_error "Missing or invalid '%s' field" json name
(* Extract an optional string field from JSON object *)
let get_optional_string_field fields name =
List.assoc_opt name fields |> Option.map (function
| `String s -> s
+
| j -> json_error "Expected string for %s" j name
)
(* Extract an int field from JSON object or raise an error *)
let get_int_field fields name json =
match List.assoc_opt name fields with
| Some (`Int i) -> i
+
| _ -> json_error "Missing or invalid '%s' field" json name
(* Extract a float field from JSON object or raise an error *)
let get_float_field fields name json =
match List.assoc_opt name fields with
| Some (`Float f) -> f
+
| _ -> json_error "Missing or invalid '%s' field" json name
(* Extract a boolean field from JSON object or raise an error *)
let get_bool_field fields name json =
match List.assoc_opt name fields with
| Some (`Bool b) -> b
+
| _ -> json_error "Missing or invalid '%s' field" json name
(* Extract an object field from JSON object or raise an error *)
let get_object_field fields name json =
match List.assoc_opt name fields with
| Some (`Assoc obj) -> obj
+
| _ -> json_error "Missing or invalid '%s' field" json name
(* Extract a list field from JSON object or raise an error *)
let get_list_field fields name json =
match List.assoc_opt name fields with
| Some (`List items) -> items
+
| _ -> json_error "Missing or invalid '%s' field" json name
(* Verify a specific string value in a field *)
let verify_string_field fields name expected_value json =
match List.assoc_opt name fields with
| Some (`String s) when s = expected_value -> ()
+
| _ -> json_error "Field '%s' missing or not equal to '%s'" json name expected_value
end
(* Error codes for JSON-RPC *)
···
let of_string = function
| "user" -> `User
| "assistant" -> `Assistant
+
| s -> Util.json_error "Unknown role: %s" (`String s) s
let yojson_of_t t = `String (to_string t)
let t_of_yojson = function
| `String s -> of_string s
+
| j -> Util.json_error "Expected string for Role" j
end
module ProgressToken = struct
···
let yojson_of_t t = `String t
let t_of_yojson = function
| `String s -> s
+
| j -> Util.json_error "Expected string for Cursor" j
end
(* Annotations *)
···
| `Assoc fields ->
let audience = List.assoc_opt "audience" fields |> Option.map (function
| `List items -> List.map Role.t_of_yojson items
+
| j -> Util.json_error "Expected list for audience" j
) in
let priority = List.assoc_opt "priority" fields |> Option.map (function
| `Float f -> f
+
| j -> Util.json_error "Expected float for priority" j
) in
{ audience; priority }
+
| j -> Util.json_error "Expected object for annotation" j
let yojson_of_t { annotations } =
match annotations with
···
| `Assoc fields ->
let annotations = List.assoc_opt "annotations" fields |> Option.map annotation_of_yojson in
{ annotations }
+
| j -> Util.json_error "Expected object for Annotated" j
end
(* Content types *)
···
Util.verify_string_field fields "type" "text" json;
let annotations = List.assoc_opt "annotations" fields |> Option.map Annotated.annotation_of_yojson in
{ text; annotations }
+
| j -> Util.json_error "Expected object for TextContent" j
end
module ImageContent = struct
···
Util.verify_string_field fields "type" "image" json;
let annotations = List.assoc_opt "annotations" fields |> Option.map Annotated.annotation_of_yojson in
{ data; mime_type; annotations }
+
| j -> Util.json_error "Expected object for ImageContent" j
end
module AudioContent = struct
···
Util.verify_string_field fields "type" "audio" json;
let annotations = List.assoc_opt "annotations" fields |> Option.map Annotated.annotation_of_yojson in
{ data; mime_type; annotations }
+
| j -> Util.json_error "Expected object for AudioContent" j
end
module ResourceContents = struct
···
let uri = Util.get_string_field fields "uri" json in
let mime_type = Util.get_optional_string_field fields "mimeType" in
{ uri; mime_type }
+
| j -> Util.json_error "Expected object for ResourceContents" j
end
module TextResourceContents = struct
···
let text = Util.get_string_field fields "text" json in
let mime_type = Util.get_optional_string_field fields "mimeType" in
{ uri; text; mime_type }
+
| j -> Util.json_error "Expected object for TextResourceContents" j
end
module BlobResourceContents = struct
···
let blob = Util.get_string_field fields "blob" json in
let mime_type = Util.get_optional_string_field fields "mimeType" in
{ uri; blob; mime_type }
+
| j -> Util.json_error "Expected object for BlobResourceContents" j
end
module EmbeddedResource = struct
···
Util.verify_string_field fields "type" "resource" json;
let resource_fields = match List.assoc_opt "resource" fields with
| Some (`Assoc res_fields) -> res_fields
+
| _ -> Util.json_error "Missing or invalid 'resource' field" json
in
let resource =
if List.mem_assoc "text" resource_fields then
···
else if List.mem_assoc "blob" resource_fields then
`Blob (BlobResourceContents.t_of_yojson (`Assoc resource_fields))
else
+
Util.json_error "Invalid resource content" (`Assoc resource_fields)
in
let annotations = List.assoc_opt "annotations" fields |> Option.map Annotated.annotation_of_yojson in
{ resource; annotations }
+
| j -> Util.json_error "Expected object for EmbeddedResource" j
end
type content =
···
| Resource r -> EmbeddedResource.yojson_of_t r
let content_of_yojson = function
+
| `Assoc fields as json ->
(match List.assoc_opt "type" fields with
+
| Some (`String "text") -> Text (TextContent.t_of_yojson json)
+
| Some (`String "image") -> Image (ImageContent.t_of_yojson json)
+
| Some (`String "audio") -> Audio (AudioContent.t_of_yojson json)
+
| Some (`String "resource") -> Resource (EmbeddedResource.t_of_yojson json)
+
| _ -> Util.json_error "Invalid or missing content type" json)
+
| j -> Util.json_error "Expected object for content" j
(* Message types *)
···
| `Assoc fields as json ->
let role = match List.assoc_opt "role" fields with
| Some json -> Role.t_of_yojson json
+
| None -> Util.json_error "Missing role field" json
in
let content = match List.assoc_opt "content" fields with
| Some json -> content_of_yojson json
+
| None -> Util.json_error "Missing content field" json
in
{ role; content }
+
| j -> Util.json_error "Expected object for PromptMessage" j
end
module SamplingMessage = struct
···
| `Assoc fields as json ->
let role = match List.assoc_opt "role" fields with
| Some json -> Role.t_of_yojson json
+
| None -> Util.json_error "Missing role field" json
in
let content_obj = match List.assoc_opt "content" fields with
| Some (`Assoc content_fields) -> content_fields
+
| _ -> Util.json_error "Missing or invalid content field" json
in
let content_type = match List.assoc_opt "type" content_obj with
| Some (`String ty) -> ty
+
| _ -> Util.json_error "Missing or invalid content type" (`Assoc content_obj)
in
let content =
match content_type with
| "text" -> `Text (TextContent.t_of_yojson (`Assoc content_obj))
| "image" -> `Image (ImageContent.t_of_yojson (`Assoc content_obj))
| "audio" -> `Audio (AudioContent.t_of_yojson (`Assoc content_obj))
+
| _ -> Util.json_error "Invalid content type: %s" (`Assoc content_obj) content_type
in
{ role; content }
+
| j -> Util.json_error "Expected object for SamplingMessage" j
end
(* Implementation info *)
···
let name = Util.get_string_field fields "name" json in
let version = Util.get_string_field fields "version" json in
{ name; version }
+
| j -> Util.json_error "Expected object for Implementation" j
end
(* JSONRPC Message types *)
···
let meth = match List.assoc_opt "method" fields with
| Some (`String s) ->
(try Method.of_string s
+
with Failure msg -> Util.json_error "%s" (`String s) msg)
+
| _ -> Util.json_error "Missing or invalid 'method' field" (`Assoc fields)
in
let params = List.assoc_opt "params" fields in
{ meth; params }
+
| j -> Util.json_error "Expected object for notification" j
let request_of_yojson = function
| `Assoc fields ->
let id = match List.assoc_opt "id" fields with
| Some id_json -> Id.t_of_yojson id_json
+
| _ -> Util.json_error "Missing or invalid 'id' field" (`Assoc fields)
in
let meth = match List.assoc_opt "method" fields with
| Some (`String s) ->
(try Method.of_string s
+
with Failure msg -> Util.json_error "%s" (`String s) msg)
+
| _ -> Util.json_error "Missing or invalid 'method' field" (`Assoc fields)
in
let params = List.assoc_opt "params" fields in
let progress_token =
···
| _ -> None
in
{ id; meth; params; progress_token }
+
| j -> Util.json_error "Expected object for request" j
let response_of_yojson = function
| `Assoc fields ->
let id = match List.assoc_opt "id" fields with
| Some id_json -> Id.t_of_yojson id_json
+
| _ -> Util.json_error "Missing or invalid 'id' field" (`Assoc fields)
in
let result = match List.assoc_opt "result" fields with
| Some result -> result
+
| _ -> Util.json_error "Missing 'result' field" (`Assoc fields)
in
{ id; result }
+
| j -> Util.json_error "Expected object for response" j
let error_of_yojson = function
+
| `Assoc fields as json ->
let id = match List.assoc_opt "id" fields with
| Some id_json -> Id.t_of_yojson id_json
+
| _ -> Util.json_error "Missing or invalid 'id' field" json
in
let error = match List.assoc_opt "error" fields with
| Some (`Assoc error_fields) -> error_fields
+
| _ -> Util.json_error "Missing or invalid 'error' field" json
in
let code = match List.assoc_opt "code" error with
| Some (`Int code) -> code
+
| _ -> Util.json_error "Missing or invalid 'code' field in error" (`Assoc error)
in
let message = match List.assoc_opt "message" error with
| Some (`String msg) -> msg
+
| _ -> Util.json_error "Missing or invalid 'message' field in error" (`Assoc error)
in
let data = List.assoc_opt "data" error in
{ id; code; message; data }
+
| j -> Util.json_error "Expected object for error" j
let t_of_yojson json =
match json with
| `Assoc fields ->
let _jsonrpc = match List.assoc_opt "jsonrpc" fields with
| Some (`String "2.0") -> ()
+
| _ -> Util.json_error "Missing or invalid 'jsonrpc' field" json
in
if List.mem_assoc "method" fields then
if List.mem_assoc "id" fields then
···
else if List.mem_assoc "error" fields then
Error (error_of_yojson json)
else
+
Util.json_error "Invalid JSONRPC message format" json
+
| j -> Util.json_error "Expected object for JSONRPC message" j
let create_notification ?(params=None) ~meth () =
Notification { meth; params }
···
| `Assoc fields as json ->
let capabilities = match List.assoc_opt "capabilities" fields with
| Some json -> json
+
| None -> Util.json_error "Missing capabilities field" json
in
let client_info = match List.assoc_opt "clientInfo" fields with
| Some json -> Implementation.t_of_yojson json
+
| None -> Util.json_error "Missing clientInfo field" json
in
let protocol_version = Util.get_string_field fields "protocolVersion" json in
{ capabilities; client_info; protocol_version }
+
| j -> Util.json_error "Expected object for InitializeRequest" j
let create ~capabilities ~client_info ~protocol_version =
{ capabilities; client_info; protocol_version }
···
| `Assoc fields as json ->
let capabilities = match List.assoc_opt "capabilities" fields with
| Some json -> json
+
| None -> Util.json_error "Missing capabilities field" json
in
let server_info = match List.assoc_opt "serverInfo" fields with
| Some json -> Implementation.t_of_yojson json
+
| None -> Util.json_error "Missing serverInfo field" json
in
let protocol_version = Util.get_string_field fields "protocolVersion" json in
let instructions = Util.get_optional_string_field fields "instructions" in
let meta = List.assoc_opt "_meta" fields in
{ capabilities; server_info; protocol_version; instructions; meta }
+
| j -> Util.json_error "Expected object for InitializeResult" j
let create ~capabilities ~server_info ~protocol_version ?instructions ?meta () =
{ capabilities; server_info; protocol_version; instructions; meta }
···
| `Assoc fields ->
let meta = List.assoc_opt "_meta" fields in
{ meta }
+
| j -> Util.json_error "Expected object for InitializedNotification" j
let create ?meta () = { meta }
+8
lib/mcp.mli
···
(** Utility functions for JSON parsing *)
module Util : sig
(** Extract a string field from JSON object or raise an error
@param fields Assoc list of fields from JSON object
@param name Field name to extract
···
(** Utility functions for JSON parsing *)
module Util : sig
+
(** Helper to raise a Json.Of_json exception with formatted message
+
@param fmt Format string for the error message
+
@param json JSON value to include in the exception
+
@return Never returns, always raises an exception
+
@raise Json.Of_json with the formatted message and JSON value
+
*)
+
val json_error : ('a, unit, string, 'b) format4 -> Json.t -> 'a
+
(** Extract a string field from JSON object or raise an error
@param fields Assoc list of fields from JSON object
@param name Field name to extract
+65 -65
lib/mcp_rpc.ml
···
| `Assoc fields ->
let cursor = List.assoc_opt "cursor" fields |> Option.map Cursor.t_of_yojson in
{ cursor }
-
| j -> raise (Json.Of_json ("Expected object for ResourcesList.Request.t", j))
end
···
`Assoc assoc
let t_of_yojson = function
-
| `Assoc fields ->
let uri = match List.assoc_opt "uri" fields with
| Some (`String s) -> s
-
| _ -> raise (Json.Of_json ("Missing or invalid 'uri' field", `Assoc fields))
in
let name = match List.assoc_opt "name" fields with
| Some (`String s) -> s
-
| _ -> raise (Json.Of_json ("Missing or invalid 'name' field", `Assoc fields))
in
let description = List.assoc_opt "description" fields |> Option.map (function
| `String s -> s
-
| j -> raise (Json.Of_json ("Expected string for description", j))
) in
let mime_type = List.assoc_opt "mimeType" fields |> Option.map (function
| `String s -> s
-
| j -> raise (Json.Of_json ("Expected string for mimeType", j))
) in
let size = List.assoc_opt "size" fields |> Option.map (function
| `Int i -> i
-
| j -> raise (Json.Of_json ("Expected int for size", j))
) in
{ uri; name; description; mime_type; size }
-
| j -> raise (Json.Of_json ("Expected object for ResourcesList.Resource.t", j))
end
module Response = struct
···
`Assoc assoc
let t_of_yojson = function
-
| `Assoc fields ->
let resources = match List.assoc_opt "resources" fields with
| Some (`List items) -> List.map Resource.t_of_yojson items
-
| _ -> raise (Json.Of_json ("Missing or invalid 'resources' field", `Assoc fields))
in
let next_cursor = List.assoc_opt "nextCursor" fields |> Option.map Cursor.t_of_yojson in
{ resources; next_cursor }
-
| j -> raise (Json.Of_json ("Expected object for ResourcesList.Response.t", j))
end
···
]
let t_of_yojson = function
-
| `Assoc fields ->
let uri = match List.assoc_opt "uri" fields with
| Some (`String s) -> s
-
| _ -> raise (Json.Of_json ("Missing or invalid 'uri' field", `Assoc fields))
in
{ uri }
-
| j -> raise (Json.Of_json ("Expected object for ResourcesRead.Request.t", j))
end
···
else if List.mem_assoc "blob" fields then
BlobResource (BlobResourceContents.t_of_yojson json)
else
-
raise (Json.Of_json ("Invalid resource content", json))
-
| j -> raise (Json.Of_json ("Expected object for ResourcesRead.ResourceContent.t", j))
end
···
]
let t_of_yojson = function
-
| `Assoc fields ->
let contents = match List.assoc_opt "contents" fields with
| Some (`List items) -> List.map ResourceContent.t_of_yojson items
-
| _ -> raise (Json.Of_json ("Missing or invalid 'contents' field", `Assoc fields))
in
{ contents }
-
| j -> raise (Json.Of_json ("Expected object for ResourcesRead.Response.t", j))
end
···
| `Assoc fields ->
let cursor = List.assoc_opt "cursor" fields |> Option.map Cursor.t_of_yojson in
{ cursor }
-
| j -> raise (Json.Of_json ("Expected object for ToolsList.Request.t", j))
end
···
`Assoc assoc
let t_of_yojson = function
-
| `Assoc fields ->
let name = match List.assoc_opt "name" fields with
| Some (`String s) -> s
-
| _ -> raise (Json.Of_json ("Missing or invalid 'name' field", `Assoc fields))
in
let description = List.assoc_opt "description" fields |> Option.map (function
| `String s -> s
-
| j -> raise (Json.Of_json ("Expected string for description", j))
) in
let input_schema = match List.assoc_opt "inputSchema" fields with
| Some schema -> schema
-
| None -> raise (Json.Of_json ("Missing 'inputSchema' field", `Assoc fields))
in
let annotations = List.assoc_opt "annotations" fields in
{ name; description; input_schema; annotations }
-
| j -> raise (Json.Of_json ("Expected object for ToolsList.Tool.t", j))
end
···
`Assoc assoc
let t_of_yojson = function
-
| `Assoc fields ->
let tools = match List.assoc_opt "tools" fields with
| Some (`List items) -> List.map Tool.t_of_yojson items
-
| _ -> raise (Json.Of_json ("Missing or invalid 'tools' field", `Assoc fields))
in
let next_cursor = List.assoc_opt "nextCursor" fields |> Option.map Cursor.t_of_yojson in
{ tools; next_cursor }
-
| j -> raise (Json.Of_json ("Expected object for ToolsList.Response.t", j))
end
···
]
let t_of_yojson = function
-
| `Assoc fields ->
let name = match List.assoc_opt "name" fields with
| Some (`String s) -> s
-
| _ -> raise (Json.Of_json ("Missing or invalid 'name' field", `Assoc fields))
in
let arguments = match List.assoc_opt "arguments" fields with
| Some json -> json
-
| None -> raise (Json.Of_json ("Missing 'arguments' field", `Assoc fields))
in
{ name; arguments }
-
| j -> raise (Json.Of_json ("Expected object for ToolsCall.Request.t", j))
end
···
| Some (`String "image") -> Image (ImageContent.t_of_yojson json)
| Some (`String "audio") -> Audio (AudioContent.t_of_yojson json)
| Some (`String "resource") -> Resource (EmbeddedResource.t_of_yojson json)
-
| _ -> raise (Json.Of_json ("Invalid or missing content type", json)))
-
| j -> raise (Json.Of_json ("Expected object for ToolsCall.ToolContent.t", j))
end
···
]
let t_of_yojson = function
-
| `Assoc fields ->
let content = match List.assoc_opt "content" fields with
| Some (`List items) -> List.map ToolContent.t_of_yojson items
-
| _ -> raise (Json.Of_json ("Missing or invalid 'content' field", `Assoc fields))
in
let is_error = match List.assoc_opt "isError" fields with
| Some (`Bool b) -> b
| _ -> false
in
{ content; is_error }
-
| j -> raise (Json.Of_json ("Expected object for ToolsCall.Response.t", j))
end
···
`Assoc assoc
let t_of_yojson = function
-
| `Assoc fields ->
let name = match List.assoc_opt "name" fields with
| Some (`String s) -> s
-
| _ -> raise (Json.Of_json ("Missing or invalid 'name' field", `Assoc fields))
in
let description = List.assoc_opt "description" fields |> Option.map (function
| `String s -> s
-
| j -> raise (Json.Of_json ("Expected string for description", j))
) in
let required = match List.assoc_opt "required" fields with
| Some (`Bool b) -> b
| _ -> false
in
{ name; description; required }
-
| j -> raise (Json.Of_json ("Expected object for PromptsList.PromptArgument.t", j))
end
···
`Assoc assoc
let t_of_yojson = function
-
| `Assoc fields ->
let name = match List.assoc_opt "name" fields with
| Some (`String s) -> s
-
| _ -> raise (Json.Of_json ("Missing or invalid 'name' field", `Assoc fields))
in
let description = List.assoc_opt "description" fields |> Option.map (function
| `String s -> s
-
| j -> raise (Json.Of_json ("Expected string for description", j))
) in
let arguments = match List.assoc_opt "arguments" fields with
| Some (`List items) -> List.map PromptArgument.t_of_yojson items
| _ -> []
in
{ name; description; arguments }
-
| j -> raise (Json.Of_json ("Expected object for PromptsList.Prompt.t", j))
end
···
| `Assoc fields ->
let cursor = List.assoc_opt "cursor" fields |> Option.map Cursor.t_of_yojson in
{ cursor }
-
| j -> raise (Json.Of_json ("Expected object for PromptsList.Request.t", j))
end
···
`Assoc assoc
let t_of_yojson = function
-
| `Assoc fields ->
let prompts = match List.assoc_opt "prompts" fields with
| Some (`List items) -> List.map Prompt.t_of_yojson items
-
| _ -> raise (Json.Of_json ("Missing or invalid 'prompts' field", `Assoc fields))
in
let next_cursor = List.assoc_opt "nextCursor" fields |> Option.map Cursor.t_of_yojson in
{ prompts; next_cursor }
-
| j -> raise (Json.Of_json ("Expected object for PromptsList.Response.t", j))
end
···
]
let t_of_yojson = function
-
| `Assoc fields ->
let name = match List.assoc_opt "name" fields with
| Some (`String s) -> s
-
| _ -> raise (Json.Of_json ("Missing or invalid 'name' field", `Assoc fields))
in
let arguments = match List.assoc_opt "arguments" fields with
| Some (`Assoc args) ->
List.map (fun (k, v) ->
match v with
| `String s -> (k, s)
-
| _ -> raise (Json.Of_json ("Expected string value for argument", v))
) args
| _ -> []
in
{ name; arguments }
-
| j -> raise (Json.Of_json ("Expected object for PromptsGet.Request.t", j))
end
···
`Assoc assoc
let t_of_yojson = function
-
| `Assoc fields ->
let messages = match List.assoc_opt "messages" fields with
| Some (`List items) -> List.map PromptMessage.t_of_yojson items
-
| _ -> raise (Json.Of_json ("Missing or invalid 'messages' field", `Assoc fields))
in
let description = List.assoc_opt "description" fields |> Option.map (function
| `String s -> s
-
| j -> raise (Json.Of_json ("Expected string for description", j))
) in
{ description; messages }
-
| j -> raise (Json.Of_json ("Expected object for PromptsGet.Response.t", j))
end
···
]
let t_of_yojson = function
-
| `Assoc fields ->
let uri = match List.assoc_opt "uri" fields with
| Some (`String s) -> s
-
| _ -> raise (Json.Of_json ("Missing or invalid 'uri' field", `Assoc fields))
in
{ uri }
-
| j -> raise (Json.Of_json ("Expected object for ResourceUpdated.Notification.t", j))
end
···
]
let t_of_yojson = function
-
| `Assoc fields ->
let progress = match List.assoc_opt "progress" fields with
| Some (`Float f) -> f
-
| _ -> raise (Json.Of_json ("Missing or invalid 'progress' field", `Assoc fields))
in
let total = match List.assoc_opt "total" fields with
| Some (`Float f) -> f
-
| _ -> raise (Json.Of_json ("Missing or invalid 'total' field", `Assoc fields))
in
let progress_token = match List.assoc_opt "progressToken" fields with
| Some token -> ProgressToken.t_of_yojson token
-
| _ -> raise (Json.Of_json ("Missing or invalid 'progressToken' field", `Assoc fields))
in
{ progress; total; progress_token }
-
| j -> raise (Json.Of_json ("Expected object for Progress.Notification.t", j))
end
···
| `Assoc fields ->
let cursor = List.assoc_opt "cursor" fields |> Option.map Cursor.t_of_yojson in
{ cursor }
+
| j -> Util.json_error "Expected object for ResourcesList.Request.t" j
end
···
`Assoc assoc
let t_of_yojson = function
+
| `Assoc fields as json ->
let uri = match List.assoc_opt "uri" fields with
| Some (`String s) -> s
+
| _ -> Util.json_error "Missing or invalid 'uri' field" json
in
let name = match List.assoc_opt "name" fields with
| Some (`String s) -> s
+
| _ -> Util.json_error "Missing or invalid 'name' field" json
in
let description = List.assoc_opt "description" fields |> Option.map (function
| `String s -> s
+
| j -> Util.json_error "Expected string for description" j
) in
let mime_type = List.assoc_opt "mimeType" fields |> Option.map (function
| `String s -> s
+
| j -> Util.json_error "Expected string for mimeType" j
) in
let size = List.assoc_opt "size" fields |> Option.map (function
| `Int i -> i
+
| j -> Util.json_error "Expected int for size" j
) in
{ uri; name; description; mime_type; size }
+
| j -> Util.json_error "Expected object for ResourcesList.Resource.t" j
end
module Response = struct
···
`Assoc assoc
let t_of_yojson = function
+
| `Assoc fields as json ->
let resources = match List.assoc_opt "resources" fields with
| Some (`List items) -> List.map Resource.t_of_yojson items
+
| _ -> Util.json_error "Missing or invalid 'resources' field" json
in
let next_cursor = List.assoc_opt "nextCursor" fields |> Option.map Cursor.t_of_yojson in
{ resources; next_cursor }
+
| j -> Util.json_error "Expected object for ResourcesList.Response.t" j
end
···
]
let t_of_yojson = function
+
| `Assoc fields as json ->
let uri = match List.assoc_opt "uri" fields with
| Some (`String s) -> s
+
| _ -> Util.json_error "Missing or invalid 'uri' field" json
in
{ uri }
+
| j -> Util.json_error "Expected object for ResourcesRead.Request.t" j
end
···
else if List.mem_assoc "blob" fields then
BlobResource (BlobResourceContents.t_of_yojson json)
else
+
Util.json_error "Invalid resource content" json
+
| j -> Util.json_error "Expected object for ResourcesRead.ResourceContent.t" j
end
···
]
let t_of_yojson = function
+
| `Assoc fields as json ->
let contents = match List.assoc_opt "contents" fields with
| Some (`List items) -> List.map ResourceContent.t_of_yojson items
+
| _ -> Util.json_error "Missing or invalid 'contents' field" json
in
{ contents }
+
| j -> Util.json_error "Expected object for ResourcesRead.Response.t" j
end
···
| `Assoc fields ->
let cursor = List.assoc_opt "cursor" fields |> Option.map Cursor.t_of_yojson in
{ cursor }
+
| j -> Util.json_error "Expected object for ToolsList.Request.t" j
end
···
`Assoc assoc
let t_of_yojson = function
+
| `Assoc fields as json ->
let name = match List.assoc_opt "name" fields with
| Some (`String s) -> s
+
| _ -> Util.json_error "Missing or invalid 'name' field" json
in
let description = List.assoc_opt "description" fields |> Option.map (function
| `String s -> s
+
| j -> Util.json_error "Expected string for description" j
) in
let input_schema = match List.assoc_opt "inputSchema" fields with
| Some schema -> schema
+
| None -> Util.json_error "Missing 'inputSchema' field" json
in
let annotations = List.assoc_opt "annotations" fields in
{ name; description; input_schema; annotations }
+
| j -> Util.json_error "Expected object for ToolsList.Tool.t" j
end
···
`Assoc assoc
let t_of_yojson = function
+
| `Assoc fields as json ->
let tools = match List.assoc_opt "tools" fields with
| Some (`List items) -> List.map Tool.t_of_yojson items
+
| _ -> Util.json_error "Missing or invalid 'tools' field" json
in
let next_cursor = List.assoc_opt "nextCursor" fields |> Option.map Cursor.t_of_yojson in
{ tools; next_cursor }
+
| j -> Util.json_error "Expected object for ToolsList.Response.t" j
end
···
]
let t_of_yojson = function
+
| `Assoc fields as json ->
let name = match List.assoc_opt "name" fields with
| Some (`String s) -> s
+
| _ -> Util.json_error "Missing or invalid 'name' field" json
in
let arguments = match List.assoc_opt "arguments" fields with
| Some json -> json
+
| None -> Util.json_error "Missing 'arguments' field" json
in
{ name; arguments }
+
| j -> Util.json_error "Expected object for ToolsCall.Request.t" j
end
···
| Some (`String "image") -> Image (ImageContent.t_of_yojson json)
| Some (`String "audio") -> Audio (AudioContent.t_of_yojson json)
| Some (`String "resource") -> Resource (EmbeddedResource.t_of_yojson json)
+
| _ -> Util.json_error "Invalid or missing content type" json)
+
| j -> Util.json_error "Expected object for ToolsCall.ToolContent.t" j
end
···
]
let t_of_yojson = function
+
| `Assoc fields as json ->
let content = match List.assoc_opt "content" fields with
| Some (`List items) -> List.map ToolContent.t_of_yojson items
+
| _ -> Util.json_error "Missing or invalid 'content' field" json
in
let is_error = match List.assoc_opt "isError" fields with
| Some (`Bool b) -> b
| _ -> false
in
{ content; is_error }
+
| j -> Util.json_error "Expected object for ToolsCall.Response.t" j
end
···
`Assoc assoc
let t_of_yojson = function
+
| `Assoc fields as json ->
let name = match List.assoc_opt "name" fields with
| Some (`String s) -> s
+
| _ -> Util.json_error "Missing or invalid 'name' field" json
in
let description = List.assoc_opt "description" fields |> Option.map (function
| `String s -> s
+
| j -> Util.json_error "Expected string for description" j
) in
let required = match List.assoc_opt "required" fields with
| Some (`Bool b) -> b
| _ -> false
in
{ name; description; required }
+
| j -> Util.json_error "Expected object for PromptsList.PromptArgument.t" j
end
···
`Assoc assoc
let t_of_yojson = function
+
| `Assoc fields as json ->
let name = match List.assoc_opt "name" fields with
| Some (`String s) -> s
+
| _ -> Util.json_error "Missing or invalid 'name' field" json
in
let description = List.assoc_opt "description" fields |> Option.map (function
| `String s -> s
+
| j -> Util.json_error "Expected string for description" j
) in
let arguments = match List.assoc_opt "arguments" fields with
| Some (`List items) -> List.map PromptArgument.t_of_yojson items
| _ -> []
in
{ name; description; arguments }
+
| j -> Util.json_error "Expected object for PromptsList.Prompt.t" j
end
···
| `Assoc fields ->
let cursor = List.assoc_opt "cursor" fields |> Option.map Cursor.t_of_yojson in
{ cursor }
+
| j -> Util.json_error "Expected object for PromptsList.Request.t" j
end
···
`Assoc assoc
let t_of_yojson = function
+
| `Assoc fields as json ->
let prompts = match List.assoc_opt "prompts" fields with
| Some (`List items) -> List.map Prompt.t_of_yojson items
+
| _ -> Util.json_error "Missing or invalid 'prompts' field" json
in
let next_cursor = List.assoc_opt "nextCursor" fields |> Option.map Cursor.t_of_yojson in
{ prompts; next_cursor }
+
| j -> Util.json_error "Expected object for PromptsList.Response.t" j
end
···
]
let t_of_yojson = function
+
| `Assoc fields as json ->
let name = match List.assoc_opt "name" fields with
| Some (`String s) -> s
+
| _ -> Util.json_error "Missing or invalid 'name' field" json
in
let arguments = match List.assoc_opt "arguments" fields with
| Some (`Assoc args) ->
List.map (fun (k, v) ->
match v with
| `String s -> (k, s)
+
| _ -> Util.json_error "Expected string value for argument" v
) args
| _ -> []
in
{ name; arguments }
+
| j -> Util.json_error "Expected object for PromptsGet.Request.t" j
end
···
`Assoc assoc
let t_of_yojson = function
+
| `Assoc fields as json ->
let messages = match List.assoc_opt "messages" fields with
| Some (`List items) -> List.map PromptMessage.t_of_yojson items
+
| _ -> Util.json_error "Missing or invalid 'messages' field" json
in
let description = List.assoc_opt "description" fields |> Option.map (function
| `String s -> s
+
| j -> Util.json_error "Expected string for description" j
) in
{ description; messages }
+
| j -> Util.json_error "Expected object for PromptsGet.Response.t" j
end
···
]
let t_of_yojson = function
+
| `Assoc fields as json ->
let uri = match List.assoc_opt "uri" fields with
| Some (`String s) -> s
+
| _ -> Util.json_error "Missing or invalid 'uri' field" json
in
{ uri }
+
| j -> Util.json_error "Expected object for ResourceUpdated.Notification.t" j
end
···
]
let t_of_yojson = function
+
| `Assoc fields as json ->
let progress = match List.assoc_opt "progress" fields with
| Some (`Float f) -> f
+
| _ -> Util.json_error "Missing or invalid 'progress' field" json
in
let total = match List.assoc_opt "total" fields with
| Some (`Float f) -> f
+
| _ -> Util.json_error "Missing or invalid 'total' field" json
in
let progress_token = match List.assoc_opt "progressToken" fields with
| Some token -> ProgressToken.t_of_yojson token
+
| _ -> Util.json_error "Missing or invalid 'progressToken' field" json
in
{ progress; total; progress_token }
+
| j -> Util.json_error "Expected object for Progress.Notification.t" j
end