···
+
type t = [ `User | `Assistant ]
+
let to_string = function
+
| `Assistant -> "assistant"
+
let of_string = function
+
| "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))
+
module ProgressToken = struct
+
type t = [ `String of string | `Int of int ]
+
include (Id : Json.Jsonable.S with type t := t)
+
let yojson_of_t t = `String t
+
let t_of_yojson = function
+
| j -> raise (Json.Of_json ("Expected string for Cursor", j))
+
module Annotated = struct
+
annotations: annotation option;
+
audience: Role.t list option;
+
priority: float option;
+
let yojson_of_annotation { audience; priority } =
+
let assoc = match audience with
+
| Some audience -> ("audience", `List (List.map Role.yojson_of_t audience)) :: assoc
+
let assoc = match priority with
+
| Some priority -> ("priority", `Float priority) :: assoc
+
let annotation_of_yojson = function
+
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))
+
let priority = List.assoc_opt "priority" fields |> Option.map (function
+
| j -> raise (Json.Of_json ("Expected float for priority", j))
+
| j -> raise (Json.Of_json ("Expected object for annotation", j))
+
let yojson_of_t { annotations } =
+
| Some annotations -> `Assoc [ "annotations", yojson_of_annotation annotations ]
+
let t_of_yojson = function
+
let annotations = List.assoc_opt "annotations" fields |> Option.map annotation_of_yojson in
+
| j -> raise (Json.Of_json ("Expected object for Annotated", j))
+
module TextContent = struct
+
annotations: Annotated.annotation option;
+
let yojson_of_t { text; annotations } =
+
("text", `String text);
+
("type", `String "text");
+
let assoc = match annotations with
+
| Some annotations -> ("annotations", Annotated.yojson_of_annotation annotations) :: assoc
+
let t_of_yojson = function
+
let text = match List.assoc_opt "text" fields with
+
| Some (`String s) -> s
+
| _ -> raise (Json.Of_json ("Missing or invalid 'text' field", `Assoc fields))
+
let _ = match List.assoc_opt "type" fields with
+
| Some (`String "text") -> ()
+
| _ -> raise (Json.Of_json ("Missing or invalid 'type' field", `Assoc fields))
+
let annotations = List.assoc_opt "annotations" fields |> Option.map Annotated.annotation_of_yojson in
+
| j -> raise (Json.Of_json ("Expected object for TextContent", j))
+
module ImageContent = struct
+
annotations: Annotated.annotation option;
+
let yojson_of_t { data; mime_type; annotations } =
+
("data", `String data);
+
("mimeType", `String mime_type);
+
("type", `String "image");
+
let assoc = match annotations with
+
| Some annotations -> ("annotations", Annotated.yojson_of_annotation annotations) :: assoc
+
let t_of_yojson = function
+
let data = match List.assoc_opt "data" fields with
+
| Some (`String s) -> s
+
| _ -> raise (Json.Of_json ("Missing or invalid 'data' field", `Assoc fields))
+
let mime_type = match List.assoc_opt "mimeType" fields with
+
| Some (`String s) -> s
+
| _ -> raise (Json.Of_json ("Missing or invalid 'mimeType' field", `Assoc fields))
+
let _ = match List.assoc_opt "type" fields with
+
| Some (`String "image") -> ()
+
| _ -> raise (Json.Of_json ("Missing or invalid 'type' field", `Assoc fields))
+
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))
+
module ResourceContents = struct
+
mime_type: string option;
+
let yojson_of_t { uri; mime_type } =
+
let assoc = match mime_type with
+
| Some mime_type -> ("mimeType", `String mime_type) :: 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 mime_type = List.assoc_opt "mimeType" fields |> Option.map (function
+
| j -> raise (Json.Of_json ("Expected string for mimeType", j))
+
| j -> raise (Json.Of_json ("Expected object for ResourceContents", j))
+
module TextResourceContents = struct
+
mime_type: string option;
+
let yojson_of_t { uri; text; mime_type } =
+
("text", `String text);
+
let assoc = match mime_type with
+
| Some mime_type -> ("mimeType", `String mime_type) :: 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 text = match List.assoc_opt "text" fields with
+
| Some (`String s) -> s
+
| _ -> raise (Json.Of_json ("Missing or invalid 'text' field", `Assoc fields))
+
let mime_type = List.assoc_opt "mimeType" fields |> Option.map (function
+
| j -> raise (Json.Of_json ("Expected string for mimeType", j))
+
{ uri; text; mime_type }
+
| j -> raise (Json.Of_json ("Expected object for TextResourceContents", j))
+
module BlobResourceContents = struct
+
mime_type: string option;
+
let yojson_of_t { uri; blob; mime_type } =
+
("blob", `String blob);
+
let assoc = match mime_type with
+
| Some mime_type -> ("mimeType", `String mime_type) :: 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 blob = match List.assoc_opt "blob" fields with
+
| Some (`String s) -> s
+
| _ -> raise (Json.Of_json ("Missing or invalid 'blob' field", `Assoc fields))
+
let mime_type = List.assoc_opt "mimeType" fields |> Option.map (function
+
| j -> raise (Json.Of_json ("Expected string for mimeType", j))
+
{ uri; blob; mime_type }
+
| j -> raise (Json.Of_json ("Expected object for BlobResourceContents", j))
+
module EmbeddedResource = struct
+
resource: [ `Text of TextResourceContents.t | `Blob of BlobResourceContents.t ];
+
annotations: Annotated.annotation option;
+
let yojson_of_t { resource; annotations } =
+
let resource_json = match resource with
+
| `Text txt -> TextResourceContents.yojson_of_t txt
+
| `Blob blob -> BlobResourceContents.yojson_of_t blob
+
("resource", resource_json);
+
("type", `String "resource");
+
let assoc = match annotations with
+
| Some annotations -> ("annotations", Annotated.yojson_of_annotation annotations) :: assoc
+
let t_of_yojson = function
+
let _ = match List.assoc_opt "type" fields with
+
| Some (`String "resource") -> ()
+
| _ -> raise (Json.Of_json ("Missing or invalid 'type' field", `Assoc fields))
+
let resource = match List.assoc_opt "resource" fields with
+
| Some (`Assoc res_fields) ->
+
if List.mem_assoc "text" res_fields then
+
`Text (TextResourceContents.t_of_yojson (`Assoc res_fields))
+
else if List.mem_assoc "blob" res_fields then
+
`Blob (BlobResourceContents.t_of_yojson (`Assoc res_fields))
+
raise (Json.Of_json ("Invalid resource content", `Assoc res_fields))
+
| _ -> raise (Json.Of_json ("Missing or invalid 'resource' field", `Assoc fields))
+
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))
+
| Text of TextContent.t
+
| Image of ImageContent.t
+
| Resource of EmbeddedResource.t
+
let yojson_of_content = function
+
| Text t -> TextContent.yojson_of_t t
+
| Image i -> ImageContent.yojson_of_t i
+
| Resource r -> EmbeddedResource.yojson_of_t r
+
let content_of_yojson = function
+
(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 "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))
+
module PromptMessage = struct
+
let yojson_of_t { role; content } =
+
("role", Role.yojson_of_t role);
+
("content", yojson_of_content content);
+
let t_of_yojson = function
+
let role = match List.assoc_opt "role" fields with
+
| Some json -> Role.t_of_yojson json
+
| None -> raise (Json.Of_json ("Missing role field", `Assoc fields))
+
let content = match List.assoc_opt "content" fields with
+
| Some json -> content_of_yojson json
+
| None -> raise (Json.Of_json ("Missing content field", `Assoc fields))
+
| j -> raise (Json.Of_json ("Expected object for PromptMessage", j))
+
module SamplingMessage = struct
+
content: [ `Text of TextContent.t | `Image of ImageContent.t ];
+
let yojson_of_t { role; content } =
+
let content_json = match content with
+
| `Text t -> TextContent.yojson_of_t t
+
| `Image i -> ImageContent.yojson_of_t i
+
("role", Role.yojson_of_t role);
+
("content", content_json);
+
let t_of_yojson = function
+
let role = match List.assoc_opt "role" fields with
+
| Some json -> Role.t_of_yojson json
+
| None -> raise (Json.Of_json ("Missing role field", `Assoc fields))
+
let content = match List.assoc_opt "content" fields with
+
| Some (`Assoc content_fields) ->
+
(match List.assoc_opt "type" content_fields with
+
| Some (`String "text") -> `Text (TextContent.t_of_yojson (`Assoc content_fields))
+
| Some (`String "image") -> `Image (ImageContent.t_of_yojson (`Assoc content_fields))
+
| _ -> raise (Json.Of_json ("Invalid content type", `Assoc content_fields)))
+
| _ -> raise (Json.Of_json ("Missing or invalid content field", `Assoc fields))
+
| j -> raise (Json.Of_json ("Expected object for SamplingMessage", j))
+
(* Implementation info *)
+
module Implementation = struct
+
let yojson_of_t { name; version } =
+
("name", `String name);
+
("version", `String version);
+
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 version = match List.assoc_opt "version" fields with
+
| Some (`String s) -> s
+
| _ -> raise (Json.Of_json ("Missing or invalid 'version' field", `Assoc fields))
+
| j -> raise (Json.Of_json ("Expected object for Implementation", j))
+
(* JSONRPC Message types *)
+
module JSONRPCMessage = struct
+
progress_token: ProgressToken.t option;
+
| Notification of notification
+
let yojson_of_notification (n: notification) =
+
("jsonrpc", `String "2.0");
+
("method", `String n.method_);
+
let assoc = match n.params with
+
| Some params -> ("params", params) :: assoc
+
let yojson_of_request (r: request) =
+
("jsonrpc", `String "2.0");
+
("id", Id.yojson_of_t r.id);
+
("method", `String r.method_);
+
let assoc = match r.params with
+
let params_json = match params with
+
let fields = match r.progress_token with
+
let meta = `Assoc [ "progressToken", ProgressToken.yojson_of_t token ] in
+
("_meta", meta) :: fields
+
("params", params_json) :: assoc
+
let yojson_of_response (r: response) =
+
("jsonrpc", `String "2.0");
+
("id", Id.yojson_of_t r.id);
+
let yojson_of_error (e: error) =
+
("message", `String e.message);
+
let error_assoc = match e.data with
+
| Some data -> ("data", data) :: error_assoc
+
("jsonrpc", `String "2.0");
+
("id", Id.yojson_of_t e.id);
+
("error", `Assoc error_assoc);
+
let yojson_of_t = function
+
| Notification n -> yojson_of_notification n
+
| Request r -> yojson_of_request r
+
| Response r -> yojson_of_response r
+
| Error e -> yojson_of_error e
+
let notification_of_yojson = function
+
let method_ = match List.assoc_opt "method" fields with
+
| Some (`String s) -> s
+
| _ -> raise (Json.Of_json ("Missing or invalid 'method' field", `Assoc fields))
+
let params = List.assoc_opt "params" fields in
+
| j -> raise (Json.Of_json ("Expected object for notification", j))
+
let request_of_yojson = function
+
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))
+
let method_ = match List.assoc_opt "method" fields with
+
| Some (`String s) -> s
+
| _ -> raise (Json.Of_json ("Missing or invalid 'method' field", `Assoc fields))
+
let params = List.assoc_opt "params" fields in
+
| Some (`Assoc param_fields) ->
+
(match List.assoc_opt "_meta" param_fields with
+
| Some (`Assoc meta_fields) ->
+
(match List.assoc_opt "progressToken" meta_fields with
+
| Some token_json -> Some (ProgressToken.t_of_yojson token_json)
+
{ id; method_; params; progress_token }
+
| j -> raise (Json.Of_json ("Expected object for request", j))
+
let response_of_yojson = function
+
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))
+
let result = match List.assoc_opt "result" fields with
+
| Some result -> result
+
| _ -> raise (Json.Of_json ("Missing 'result' field", `Assoc fields))
+
| j -> raise (Json.Of_json ("Expected object for response", j))
+
let error_of_yojson = function
+
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))
+
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))
+
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))
+
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))
+
let data = List.assoc_opt "data" error in
+
{ id; code; message; data }
+
| j -> raise (Json.Of_json ("Expected object for error", j))
+
let _jsonrpc = match List.assoc_opt "jsonrpc" fields with
+
| Some (`String "2.0") -> ()
+
| _ -> raise (Json.Of_json ("Missing or invalid 'jsonrpc' field", json))
+
if List.mem_assoc "method" fields then
+
if List.mem_assoc "id" fields then
+
Request (request_of_yojson json)
+
Notification (notification_of_yojson json)
+
else if List.mem_assoc "result" fields then
+
Response (response_of_yojson json)
+
else if List.mem_assoc "error" fields then
+
Error (error_of_yojson json)
+
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) ~method_ () =
+
Notification { method_; params }
+
let create_request ?(params=None) ?(progress_token=None) ~id ~method_ () =
+
Request { id; method_; params; progress_token }
+
let create_response ~id ~result =
+
Response { id; result }
+
let create_error ~id ~code ~message ?(data=None) () =
+
Error { id; code; message; data }
+
(* MCP-specific request/response types *)
+
module Initialize = struct
+
module Request = struct
+
capabilities: Json.t; (* ClientCapabilities *)
+
client_info: Implementation.t;
+
protocol_version: string;
+
let yojson_of_t { capabilities; client_info; protocol_version } =
+
("capabilities", capabilities);
+
("clientInfo", Implementation.yojson_of_t client_info);
+
("protocolVersion", `String protocol_version);
+
let t_of_yojson = function
+
let capabilities = match List.assoc_opt "capabilities" fields with
+
| None -> raise (Json.Of_json ("Missing capabilities field", `Assoc fields))
+
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", `Assoc fields))
+
let protocol_version = match List.assoc_opt "protocolVersion" fields with
+
| Some (`String s) -> s
+
| _ -> raise (Json.Of_json ("Missing or invalid protocolVersion field", `Assoc fields))
+
{ 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 }
+
let params = yojson_of_t t in
+
JSONRPCMessage.create_request ~id ~method_:"initialize" ~params:(Some params) ()
+
capabilities: Json.t; (* ServerCapabilities *)
+
server_info: Implementation.t;
+
protocol_version: string;
+
instructions: string option;
+
let yojson_of_t { capabilities; server_info; protocol_version; instructions; meta } =
+
("capabilities", capabilities);
+
("serverInfo", Implementation.yojson_of_t server_info);
+
("protocolVersion", `String protocol_version);
+
let assoc = match instructions with
+
| Some instr -> ("instructions", `String instr) :: assoc
+
let assoc = match meta with
+
| Some meta -> ("_meta", meta) :: assoc
+
let t_of_yojson = function
+
let capabilities = match List.assoc_opt "capabilities" fields with
+
| None -> raise (Json.Of_json ("Missing capabilities field", `Assoc fields))
+
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", `Assoc fields))
+
let protocol_version = match List.assoc_opt "protocolVersion" fields with
+
| Some (`String s) -> s
+
| _ -> raise (Json.Of_json ("Missing or invalid protocolVersion field", `Assoc fields))
+
let instructions = match List.assoc_opt "instructions" fields with
+
| Some (`String s) -> Some s
+
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 }
+
JSONRPCMessage.create_response ~id ~result:(yojson_of_t t)
+
module Initialized = struct
+
module Notification = struct
+
let yojson_of_t { meta } =
+
let assoc = match meta with
+
| Some meta -> ("_meta", meta) :: assoc
+
let t_of_yojson = function
+
let meta = List.assoc_opt "_meta" fields in
+
| j -> raise (Json.Of_json ("Expected object for InitializedNotification", j))
+
let create ?meta () = { meta }
+
let params = match yojson_of_t t with
+
JSONRPCMessage.create_notification ~method_:"notifications/initialized" ~params ()
+
(* Export the main interface for using the MCP protocol *)
+
let parse_message json =
+
JSONRPCMessage.t_of_yojson json
+
let create_notification = JSONRPCMessage.create_notification
+
let create_request = JSONRPCMessage.create_request
+
let create_response = JSONRPCMessage.create_response
+
let create_error = JSONRPCMessage.create_error
anil.recoil.org