···
+
(* Mcp_message - High-level RPC message definitions for Model Context Protocol *)
+
module ResourcesList = struct
+
module Request = struct
+
cursor: Cursor.t option;
+
let yojson_of_t { cursor } =
+
let assoc = match cursor with
+
| Some c -> ("cursor", Cursor.yojson_of_t c) :: assoc
+
let t_of_yojson = function
+
let cursor = List.assoc_opt "cursor" fields |> Option.map Cursor.t_of_yojson in
+
| j -> raise (Json.Of_json ("Expected object for ResourcesList.Request.t", j))
+
module Resource = struct
+
description: string option;
+
mime_type: string option;
+
let yojson_of_t { uri; name; description; mime_type; size } =
+
("name", `String name);
+
let assoc = match description with
+
| Some desc -> ("description", `String desc) :: assoc
+
let assoc = match mime_type with
+
| Some mime -> ("mimeType", `String mime) :: assoc
+
let assoc = match size with
+
| Some s -> ("size", `Int s) :: assoc
+
let t_of_yojson = function
+
let uri = match List.assoc_opt "uri" fields with
+
| Some (`String s) -> s
+
| _ -> raise (Json.Of_json ("Missing or invalid 'uri' field", `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))
+
let description = List.assoc_opt "description" fields |> Option.map (function
+
| j -> raise (Json.Of_json ("Expected string for description", j))
+
let mime_type = List.assoc_opt "mimeType" fields |> Option.map (function
+
| j -> raise (Json.Of_json ("Expected string for mimeType", j))
+
let size = List.assoc_opt "size" fields |> Option.map (function
+
| j -> raise (Json.Of_json ("Expected int for size", j))
+
{ uri; name; description; mime_type; size }
+
| j -> raise (Json.Of_json ("Expected object for ResourcesList.Resource.t", j))
+
module Response = struct
+
resources: Resource.t list;
+
next_cursor: Cursor.t option;
+
let yojson_of_t { resources; next_cursor } =
+
("resources", `List (List.map Resource.yojson_of_t resources));
+
let assoc = match next_cursor with
+
| Some c -> ("nextCursor", Cursor.yojson_of_t c) :: assoc
+
let t_of_yojson = function
+
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))
+
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))
+
(* Request/response creation helpers *)
+
let create_request ?cursor ?id () =
+
| None -> `Int (Random.int 10000)
+
let params = Request.yojson_of_t { cursor } in
+
JSONRPCMessage.create_request ~id ~method_:Method.resources_list ~params:(Some params) ()
+
let create_response ~id ~resources ?next_cursor () =
+
let result = Response.yojson_of_t { resources; next_cursor } in
+
JSONRPCMessage.create_response ~id ~result
+
module ResourcesRead = struct
+
module Request = struct
+
let yojson_of_t { uri } =
+
let t_of_yojson = function
+
let uri = match List.assoc_opt "uri" fields with
+
| Some (`String s) -> s
+
| _ -> raise (Json.Of_json ("Missing or invalid 'uri' field", `Assoc fields))
+
| j -> raise (Json.Of_json ("Expected object for ResourcesRead.Request.t", j))
+
module ResourceContent = struct
+
| TextResource of TextResourceContents.t
+
| BlobResource of BlobResourceContents.t
+
let yojson_of_t = function
+
| TextResource tr -> TextResourceContents.yojson_of_t tr
+
| BlobResource br -> BlobResourceContents.yojson_of_t br
+
if List.mem_assoc "text" fields then
+
TextResource (TextResourceContents.t_of_yojson json)
+
else if List.mem_assoc "blob" fields then
+
BlobResource (BlobResourceContents.t_of_yojson json)
+
raise (Json.Of_json ("Invalid resource content", json))
+
| j -> raise (Json.Of_json ("Expected object for ResourcesRead.ResourceContent.t", j))
+
module Response = struct
+
contents: ResourceContent.t list;
+
let yojson_of_t { contents } =
+
("contents", `List (List.map ResourceContent.yojson_of_t contents));
+
let t_of_yojson = function
+
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))
+
| j -> raise (Json.Of_json ("Expected object for ResourcesRead.Response.t", j))
+
(* Request/response creation helpers *)
+
let create_request ~uri ?id () =
+
| None -> `Int (Random.int 10000)
+
let params = Request.yojson_of_t { uri } in
+
JSONRPCMessage.create_request ~id ~method_:Method.resources_read ~params:(Some params) ()
+
let create_response ~id ~contents () =
+
let result = Response.yojson_of_t { contents } in
+
JSONRPCMessage.create_response ~id ~result
+
module ToolsList = struct
+
module Request = struct
+
cursor: Cursor.t option;
+
let yojson_of_t { cursor } =
+
let assoc = match cursor with
+
| Some c -> ("cursor", Cursor.yojson_of_t c) :: assoc
+
let t_of_yojson = function
+
let cursor = List.assoc_opt "cursor" fields |> Option.map Cursor.t_of_yojson in
+
| j -> raise (Json.Of_json ("Expected object for ToolsList.Request.t", j))
+
description: string option;
+
annotations: Json.t option;
+
let yojson_of_t { name; description; input_schema; annotations } =
+
("name", `String name);
+
("inputSchema", input_schema);
+
let assoc = match description with
+
| Some desc -> ("description", `String desc) :: assoc
+
let assoc = match annotations with
+
| Some anno -> ("annotations", anno) :: assoc
+
let t_of_yojson = function
+
let name = match List.assoc_opt "name" fields with
+
| Some (`String s) -> s
+
| _ -> raise (Json.Of_json ("Missing or invalid 'name' field", `Assoc fields))
+
let description = List.assoc_opt "description" fields |> Option.map (function
+
| j -> raise (Json.Of_json ("Expected string for description", j))
+
let input_schema = match List.assoc_opt "inputSchema" fields with
+
| Some schema -> schema
+
| None -> raise (Json.Of_json ("Missing 'inputSchema' field", `Assoc fields))
+
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))
+
module Response = struct
+
next_cursor: Cursor.t option;
+
let yojson_of_t { tools; next_cursor } =
+
("tools", `List (List.map Tool.yojson_of_t tools));
+
let assoc = match next_cursor with
+
| Some c -> ("nextCursor", Cursor.yojson_of_t c) :: assoc
+
let t_of_yojson = function
+
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))
+
let next_cursor = List.assoc_opt "nextCursor" fields |> Option.map Cursor.t_of_yojson in
+
| j -> raise (Json.Of_json ("Expected object for ToolsList.Response.t", j))
+
(* Request/response creation helpers *)
+
let create_request ?cursor ?id () =
+
| None -> `Int (Random.int 10000)
+
let params = Request.yojson_of_t { cursor } in
+
JSONRPCMessage.create_request ~id ~method_:Method.tools_list ~params:(Some params) ()
+
let create_response ~id ~tools ?next_cursor () =
+
let result = Response.yojson_of_t { tools; next_cursor } in
+
JSONRPCMessage.create_response ~id ~result
+
module ToolsCall = struct
+
module Request = struct
+
let yojson_of_t { name; arguments } =
+
("name", `String name);
+
("arguments", arguments);
+
let t_of_yojson = function
+
let name = match List.assoc_opt "name" fields with
+
| Some (`String s) -> s
+
| _ -> raise (Json.Of_json ("Missing or invalid 'name' field", `Assoc fields))
+
let arguments = match List.assoc_opt "arguments" fields with
+
| None -> raise (Json.Of_json ("Missing 'arguments' field", `Assoc fields))
+
| j -> raise (Json.Of_json ("Expected object for ToolsCall.Request.t", j))
+
module ToolContent = struct
+
| Text of TextContent.t
+
| Image of ImageContent.t
+
| Audio of AudioContent.t
+
| Resource of EmbeddedResource.t
+
let yojson_of_t = function
+
| Text t -> TextContent.yojson_of_t t
+
| Image i -> ImageContent.yojson_of_t i
+
| Audio a -> AudioContent.yojson_of_t a
+
| Resource r -> EmbeddedResource.yojson_of_t r
+
(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)
+
| _ -> raise (Json.Of_json ("Invalid or missing content type", json)))
+
| j -> raise (Json.Of_json ("Expected object for ToolsCall.ToolContent.t", j))
+
module Response = struct
+
content: ToolContent.t list;
+
let yojson_of_t { content; is_error } =
+
("content", `List (List.map ToolContent.yojson_of_t content));
+
("isError", `Bool is_error);
+
let t_of_yojson = function
+
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))
+
let is_error = match List.assoc_opt "isError" fields with
+
| j -> raise (Json.Of_json ("Expected object for ToolsCall.Response.t", j))
+
(* Request/response creation helpers *)
+
let create_request ~name ~arguments ?id () =
+
| None -> `Int (Random.int 10000)
+
let params = Request.yojson_of_t { name; arguments } in
+
JSONRPCMessage.create_request ~id ~method_:Method.tools_call ~params:(Some params) ()
+
let create_response ~id ~content ~is_error () =
+
let result = Response.yojson_of_t { content; is_error } in
+
JSONRPCMessage.create_response ~id ~result
+
module PromptsList = struct
+
module PromptArgument = struct
+
description: string option;
+
let yojson_of_t { name; description; required } =
+
("name", `String name);
+
let assoc = match description with
+
| Some desc -> ("description", `String desc) :: assoc
+
let assoc = if required then
+
("required", `Bool true) :: assoc
+
let t_of_yojson = function
+
let name = match List.assoc_opt "name" fields with
+
| Some (`String s) -> s
+
| _ -> raise (Json.Of_json ("Missing or invalid 'name' field", `Assoc fields))
+
let description = List.assoc_opt "description" fields |> Option.map (function
+
| j -> raise (Json.Of_json ("Expected string for description", j))
+
let required = match List.assoc_opt "required" fields with
+
{ name; description; required }
+
| j -> raise (Json.Of_json ("Expected object for PromptsList.PromptArgument.t", j))
+
description: string option;
+
arguments: PromptArgument.t list;
+
let yojson_of_t { name; description; arguments } =
+
("name", `String name);
+
let assoc = match description with
+
| Some desc -> ("description", `String desc) :: assoc
+
let assoc = if arguments <> [] then
+
("arguments", `List (List.map PromptArgument.yojson_of_t arguments)) :: assoc
+
let t_of_yojson = function
+
let name = match List.assoc_opt "name" fields with
+
| Some (`String s) -> s
+
| _ -> raise (Json.Of_json ("Missing or invalid 'name' field", `Assoc fields))
+
let description = List.assoc_opt "description" fields |> Option.map (function
+
| j -> raise (Json.Of_json ("Expected string for description", j))
+
let arguments = match List.assoc_opt "arguments" fields with
+
| Some (`List items) -> List.map PromptArgument.t_of_yojson items
+
{ name; description; arguments }
+
| j -> raise (Json.Of_json ("Expected object for PromptsList.Prompt.t", j))
+
module Request = struct
+
cursor: Cursor.t option;
+
let yojson_of_t { cursor } =
+
let assoc = match cursor with
+
| Some c -> ("cursor", Cursor.yojson_of_t c) :: assoc
+
let t_of_yojson = function
+
let cursor = List.assoc_opt "cursor" fields |> Option.map Cursor.t_of_yojson in
+
| j -> raise (Json.Of_json ("Expected object for PromptsList.Request.t", j))
+
module Response = struct
+
prompts: Prompt.t list;
+
next_cursor: Cursor.t option;
+
let yojson_of_t { prompts; next_cursor } =
+
("prompts", `List (List.map Prompt.yojson_of_t prompts));
+
let assoc = match next_cursor with
+
| Some c -> ("nextCursor", Cursor.yojson_of_t c) :: assoc
+
let t_of_yojson = function
+
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))
+
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))
+
(* Request/response creation helpers *)
+
let create_request ?cursor ?id () =
+
| None -> `Int (Random.int 10000)
+
let params = Request.yojson_of_t { cursor } in
+
JSONRPCMessage.create_request ~id ~method_:Method.prompts_list ~params:(Some params) ()
+
let create_response ~id ~prompts ?next_cursor () =
+
let result = Response.yojson_of_t { prompts; next_cursor } in
+
JSONRPCMessage.create_response ~id ~result
+
module PromptsGet = struct
+
module Request = struct
+
arguments: (string * string) list;
+
let yojson_of_t { name; arguments } =
+
let args_json = `Assoc (List.map (fun (k, v) -> (k, `String v)) arguments) in
+
("name", `String name);
+
("arguments", args_json);
+
let t_of_yojson = function
+
let name = match List.assoc_opt "name" fields with
+
| Some (`String s) -> s
+
| _ -> raise (Json.Of_json ("Missing or invalid 'name' field", `Assoc fields))
+
let arguments = match List.assoc_opt "arguments" fields with
+
| Some (`Assoc args) ->
+
List.map (fun (k, v) ->
+
| _ -> raise (Json.Of_json ("Expected string value for argument", v))
+
| j -> raise (Json.Of_json ("Expected object for PromptsGet.Request.t", j))
+
module Response = struct
+
description: string option;
+
messages: PromptMessage.t list;
+
let yojson_of_t { description; messages } =
+
("messages", `List (List.map PromptMessage.yojson_of_t messages));
+
let assoc = match description with
+
| Some desc -> ("description", `String desc) :: assoc
+
let t_of_yojson = function
+
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))
+
let description = List.assoc_opt "description" fields |> Option.map (function
+
| j -> raise (Json.Of_json ("Expected string for description", j))
+
{ description; messages }
+
| j -> raise (Json.Of_json ("Expected object for PromptsGet.Response.t", j))
+
(* Request/response creation helpers *)
+
let create_request ~name ~arguments ?id () =
+
| None -> `Int (Random.int 10000)
+
let params = Request.yojson_of_t { name; arguments } in
+
JSONRPCMessage.create_request ~id ~method_:Method.prompts_get ~params:(Some params) ()
+
let create_response ~id ?description ~messages () =
+
let result = Response.yojson_of_t { description; messages } in
+
JSONRPCMessage.create_response ~id ~result
+
(* List Changed Notifications *)
+
module ListChanged = struct
+
(* No parameters for these notifications *)
+
let create_resources_notification () =
+
JSONRPCMessage.create_notification ~method_:Method.resources_list_changed ()
+
let create_tools_notification () =
+
JSONRPCMessage.create_notification ~method_:Method.tools_list_changed ()
+
let create_prompts_notification () =
+
JSONRPCMessage.create_notification ~method_:Method.prompts_list_changed ()
+
(* Resource Updated Notification *)
+
module ResourceUpdated = struct
+
module Notification = struct
+
let yojson_of_t { uri } =
+
let t_of_yojson = function
+
let uri = match List.assoc_opt "uri" fields with
+
| Some (`String s) -> s
+
| _ -> raise (Json.Of_json ("Missing or invalid 'uri' field", `Assoc fields))
+
| j -> raise (Json.Of_json ("Expected object for ResourceUpdated.Notification.t", j))
+
let create_notification ~uri () =
+
let params = Notification.yojson_of_t { uri } in
+
JSONRPCMessage.create_notification ~method_:Method.resources_updated ~params:(Some params) ()
+
(* Progress Notification *)
+
module Progress = struct
+
module Notification = struct
+
progress_token: ProgressToken.t;
+
let yojson_of_t { progress; total; progress_token } =
+
("progress", `Float progress);
+
("total", `Float total);
+
("progressToken", ProgressToken.yojson_of_t progress_token);
+
let t_of_yojson = function
+
let progress = match List.assoc_opt "progress" fields with
+
| _ -> raise (Json.Of_json ("Missing or invalid 'progress' field", `Assoc fields))
+
let total = match List.assoc_opt "total" fields with
+
| _ -> raise (Json.Of_json ("Missing or invalid 'total' field", `Assoc fields))
+
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))
+
{ progress; total; progress_token }
+
| j -> raise (Json.Of_json ("Expected object for Progress.Notification.t", j))
+
let create_notification ~progress ~total ~progress_token () =
+
let params = Notification.yojson_of_t { progress; total; progress_token } in
+
JSONRPCMessage.create_notification ~method_:Method.progress ~params:(Some params) ()
+
(* Type aliases for backward compatibility *)
+
type request = ResourcesList.Request.t
+
type response = ResourcesList.Response.t
+
type resource = ResourcesList.Resource.t
+
type resource_content = ResourcesRead.ResourceContent.t
+
type tool = ToolsList.Tool.t
+
type tool_content = ToolsCall.ToolContent.t
+
type prompt = PromptsList.Prompt.t
+
type prompt_argument = PromptsList.PromptArgument.t
anil.recoil.org