···
limit: string option; (* For "limit" error *)
+
(** Error that may occur during API requests *)
+
| Connection_error of string
+
| HTTP_error of int * string
+
| Parse_error of string
+
(** Result type for API operations *)
+
type 'a result = ('a, error) Stdlib.result
+
(** Configuration for a JMAP API client *)
+
authentication_token: string;
+
(** Convert Ezjsonm.value to string *)
+
let json_to_string json =
+
Ezjsonm.to_string ~minify:false json
+
(** Parse response string as JSON value *)
+
let parse_json_string str =
+
try Ok (Ezjsonm.from_string str)
+
with e -> Error (Parse_error (Printexc.to_string e))
+
(** Parse JSON response as a JMAP response object *)
+
let parse_response json =
+
match Ezjsonm.find json ["methodResponses"] with
+
| `A [`String name; args; `String method_call_id] ->
+
{ name; arguments = args; method_call_id }
+
| _ -> raise (Invalid_argument "Invalid invocation format in response")
+
| _ -> raise (Invalid_argument "methodResponses is not an array")
+
let obj = Ezjsonm.find json ["createdIds"] in
+
| `O items -> Some (List.map (fun (k, v) ->
+
| `String id -> (k, id)
+
| _ -> raise (Invalid_argument "createdIds value is not a string")
+
match Ezjsonm.find json ["sessionState"] with
+
| _ -> raise (Invalid_argument "sessionState is not a string")
+
Ok { method_responses; created_ids = created_ids_opt; session_state }
+
| Not_found -> Error (Parse_error "Required field not found in response")
+
| Invalid_argument msg -> Error (Parse_error msg)
+
| e -> Error (Parse_error (Printexc.to_string e))
+
(** Serialize a JMAP request object to JSON *)
+
let serialize_request req =
+
let method_calls_json =
+
`A (List.map (fun inv ->
+
`A [`String inv.name; inv.arguments; `String inv.method_call_id]
+
let using_json = `A (List.map (fun s -> `String s) req.using) in
+
("methodCalls", method_calls_json)
+
let json = match req.created_ids with
+
let created_ids_json = `O (List.map (fun (k, v) -> (k, `String v)) ids) in
+
Ezjsonm.update json ["createdIds"] created_ids_json
+
(** Make a raw HTTP request *)
+
let make_http_request ~headers ~body uri =
+
let open Cohttp_lwt_unix in
+
let headers = Header.add_list (Header.init ()) headers in
+
let* resp, body = Client.post ~headers ~body:(Cohttp_lwt.Body.of_string body) uri in
+
let* body_str = Cohttp_lwt.Body.to_string body in
+
let status = Response.status resp |> Code.code_of_status in
+
if status >= 200 && status < 300 then
+
Lwt.return (Ok body_str)
+
Lwt.return (Error (HTTP_error (status, body_str))))
+
(fun e -> Lwt.return (Error (Connection_error (Printexc.to_string e))))
+
(** Make a raw JMAP API request
+
let make_request config req =
+
let body = serialize_request req in
+
("Content-Type", "application/json");
+
("Content-Length", string_of_int (String.length body));
+
("Authorization", "Basic " ^ Base64.encode_string (config.username ^ ":" ^ config.authentication_token))
+
let* result = make_http_request ~headers ~body config.api_uri in
+
(match parse_json_string response_body with
+
| Ok json -> Lwt.return (parse_response json)
+
| Error e -> Lwt.return (Error e))
+
| Error e -> Lwt.return (Error e)
+
(** Parse a JSON object as a Session object *)
+
let parse_session_object json =
+
match Ezjsonm.find json ["capabilities"] with
+
| _ -> raise (Invalid_argument "capabilities is not an object")
+
match Ezjsonm.find json ["accounts"] with
+
| `O items -> List.map (fun (id, json) ->
+
let name = Ezjsonm.get_string (Ezjsonm.find json ["name"]) in
+
let is_personal = Ezjsonm.get_bool (Ezjsonm.find json ["isPersonal"]) in
+
let is_read_only = Ezjsonm.get_bool (Ezjsonm.find json ["isReadOnly"]) in
+
let account_capabilities =
+
match Ezjsonm.find json ["accountCapabilities"] with
+
| _ -> raise (Invalid_argument "accountCapabilities is not an object")
+
(id, { name; is_personal; is_read_only; account_capabilities })
+
| _ -> raise (Invalid_argument "account value is not an object")
+
| _ -> raise (Invalid_argument "accounts is not an object")
+
match Ezjsonm.find_opt json ["primaryAccounts"] with
+
| Some (`O items) -> List.map (fun (k, v) ->
+
| `String id -> (k, id)
+
| _ -> raise (Invalid_argument "primaryAccounts value is not a string")
+
| Some _ -> raise (Invalid_argument "primaryAccounts is not an object")
+
let username = Ezjsonm.get_string (Ezjsonm.find json ["username"]) in
+
let api_url = Ezjsonm.get_string (Ezjsonm.find json ["apiUrl"]) in
+
let download_url = Ezjsonm.get_string (Ezjsonm.find json ["downloadUrl"]) in
+
let upload_url = Ezjsonm.get_string (Ezjsonm.find json ["uploadUrl"]) in
+
try Some (Ezjsonm.get_string (Ezjsonm.find json ["eventSourceUrl"]))
+
let state = Ezjsonm.get_string (Ezjsonm.find json ["state"]) in
+
Ok { capabilities; accounts; primary_accounts; username;
+
api_url; download_url; upload_url; event_source_url; state }
+
| Not_found -> Error (Parse_error "Required field not found in session object")
+
| Invalid_argument msg -> Error (Parse_error msg)
+
| e -> Error (Parse_error (Printexc.to_string e))
+
(** Fetch a Session object from a JMAP server
+
let get_session uri ?username ?authentication_token () =
+
match (username, authentication_token) with
+
| (Some u, Some t) -> [
+
("Content-Type", "application/json");
+
("Authorization", "Basic " ^ Base64.encode_string (u ^ ":" ^ t))
+
| _ -> [("Content-Type", "application/json")]
+
let* result = make_http_request ~headers ~body:"" uri in
+
(match parse_json_string response_body with
+
| Ok json -> Lwt.return (parse_session_object json)
+
| Error e -> Lwt.return (Error e))
+
| Error e -> Lwt.return (Error e)
+
(** Upload a binary blob to the server
+
let upload_blob config ~account_id ~content_type data =
+
let upload_url_template = config.api_uri |> Uri.to_string in
+
(* Replace {accountId} with the actual account ID *)
+
let upload_url = Str.global_replace (Str.regexp "{accountId}") account_id upload_url_template in
+
let upload_uri = Uri.of_string upload_url in
+
("Content-Type", content_type);
+
("Content-Length", string_of_int (String.length data));
+
("Authorization", "Basic " ^ Base64.encode_string (config.username ^ ":" ^ config.authentication_token))
+
let* result = make_http_request ~headers ~body:data upload_uri in
+
(match parse_json_string response_body with
+
let account_id = Ezjsonm.get_string (Ezjsonm.find json ["accountId"]) in
+
let blob_id = Ezjsonm.get_string (Ezjsonm.find json ["blobId"]) in
+
let type_ = Ezjsonm.get_string (Ezjsonm.find json ["type"]) in
+
let size = Ezjsonm.get_int (Ezjsonm.find json ["size"]) in
+
Lwt.return (Ok { account_id; blob_id; type_; size })
+
| Not_found -> Lwt.return (Error (Parse_error "Required field not found in upload response"))
+
| e -> Lwt.return (Error (Parse_error (Printexc.to_string e))))
+
| Error e -> Lwt.return (Error e))
+
| Error e -> Lwt.return (Error e)
+
(** Download a binary blob from the server
+
let download_blob config ~account_id ~blob_id ?type_ ?name () =
+
let download_url_template = config.api_uri |> Uri.to_string in
+
(* Replace template variables with actual values *)
+
let url = Str.global_replace (Str.regexp "{accountId}") account_id download_url_template in
+
let url = Str.global_replace (Str.regexp "{blobId}") blob_id url in
+
let url = match type_ with
+
| Some t -> Str.global_replace (Str.regexp "{type}") (Uri.pct_encode t) url
+
| None -> Str.global_replace (Str.regexp "{type}") "" url
+
let url = match name with
+
| Some n -> Str.global_replace (Str.regexp "{name}") (Uri.pct_encode n) url
+
| None -> Str.global_replace (Str.regexp "{name}") "file" url
+
let download_uri = Uri.of_string url in
+
("Authorization", "Basic " ^ Base64.encode_string (config.username ^ ":" ^ config.authentication_token))
+
let* result = make_http_request ~headers ~body:"" download_uri in
anil.recoil.org