···
+
(** Authentication credentials for a JMAP server *)
+
(** Connection to a JMAP mail server *)
+
session: Jmap.Types.session;
+
config: Jmap.Api.config;
+
(** Convert JSON mail object to OCaml type *)
+
let mailbox_of_json json =
+
let id = get_string (find json ["id"]) in
+
let name = get_string (find json ["name"]) in
+
let parent_id = find_opt json ["parentId"] |> Option.map get_string in
+
let role = find_opt json ["role"] |> Option.map (fun r -> Json.mailbox_role_of_string (get_string r)) in
+
let sort_order = get_int (find json ["sortOrder"]) in
+
let total_emails = get_int (find json ["totalEmails"]) in
+
let unread_emails = get_int (find json ["unreadEmails"]) in
+
let total_threads = get_int (find json ["totalThreads"]) in
+
let unread_threads = get_int (find json ["unreadThreads"]) in
+
let is_subscribed = get_bool (find json ["isSubscribed"]) in
+
let rights_json = find json ["myRights"] in
+
Types.may_read_items = get_bool (find rights_json ["mayReadItems"]);
+
may_add_items = get_bool (find rights_json ["mayAddItems"]);
+
may_remove_items = get_bool (find rights_json ["mayRemoveItems"]);
+
may_set_seen = get_bool (find rights_json ["maySetSeen"]);
+
may_set_keywords = get_bool (find rights_json ["maySetKeywords"]);
+
may_create_child = get_bool (find rights_json ["mayCreateChild"]);
+
may_rename = get_bool (find rights_json ["mayRename"]);
+
may_delete = get_bool (find rights_json ["mayDelete"]);
+
may_submit = get_bool (find rights_json ["maySubmit"]);
+
| Not_found -> Error (Parse_error "Required field not found in mailbox object")
+
| Invalid_argument msg -> Error (Parse_error msg)
+
| e -> Error (Parse_error (Printexc.to_string e))
+
(** Convert JSON email object to OCaml type *)
+
let email_of_json json =
+
let id = get_string (find json ["id"]) in
+
let blob_id = get_string (find json ["blobId"]) in
+
let thread_id = get_string (find json ["threadId"]) in
+
(* Process mailboxIds map *)
+
let mailbox_ids_json = find json ["mailboxIds"] in
+
let mailbox_ids = match mailbox_ids_json with
+
| `O items -> List.map (fun (id, v) -> (id, get_bool v)) items
+
| _ -> raise (Invalid_argument "mailboxIds is not an object")
+
(* Process keywords map *)
+
let keywords_json = find json ["keywords"] in
+
let keywords = match keywords_json with
+
| `O items -> List.map (fun (k, v) ->
+
(Json.keyword_of_string k, get_bool v)) items
+
| _ -> raise (Invalid_argument "keywords is not an object")
+
let size = get_int (find json ["size"]) in
+
let received_at = get_string (find json ["receivedAt"]) in
+
let message_id = match find json ["messageId"] with
+
| `A ids -> List.map (fun id -> get_string id) ids
+
| _ -> raise (Invalid_argument "messageId is not an array")
+
(* Parse optional fields *)
+
let parse_email_addresses opt_json =
+
Some (List.map (fun addr_json ->
+
let name = find_opt addr_json ["name"] |> Option.map get_string in
+
let email = get_string (find addr_json ["email"]) in
+
let parameters = match find_opt addr_json ["parameters"] with
+
| Some (`O items) -> List.map (fun (k, v) -> (k, get_string v)) items
+
{ Types.name; email; parameters }
+
let in_reply_to = find_opt json ["inReplyTo"] |> Option.map (function
+
| `A ids -> List.map get_string ids
+
let references = find_opt json ["references"] |> Option.map (function
+
| `A ids -> List.map get_string ids
+
let sender = parse_email_addresses (find_opt json ["sender"]) in
+
let from = parse_email_addresses (find_opt json ["from"]) in
+
let to_ = parse_email_addresses (find_opt json ["to"]) in
+
let cc = parse_email_addresses (find_opt json ["cc"]) in
+
let bcc = parse_email_addresses (find_opt json ["bcc"]) in
+
let reply_to = parse_email_addresses (find_opt json ["replyTo"]) in
+
let subject = find_opt json ["subject"] |> Option.map get_string in
+
let sent_at = find_opt json ["sentAt"] |> Option.map get_string in
+
let has_attachment = find_opt json ["hasAttachment"] |> Option.map get_bool in
+
let preview = find_opt json ["preview"] |> Option.map get_string in
+
(* Body parts parsing would go here - omitting for brevity *)
+
| Not_found -> Error (Parse_error "Required field not found in email object")
+
| Invalid_argument msg -> Error (Parse_error msg)
+
| e -> Error (Parse_error (Printexc.to_string e))
+
(** Login to a JMAP server and establish a connection
+
@param uri The URI of the JMAP server
+
@param credentials Authentication credentials
+
@return A connection object if successful
+
let login ~uri ~credentials =
+
let* session_result = get_session (Uri.of_string uri)
+
~username:credentials.username
+
~authentication_token:credentials.password
+
match session_result with
+
let api_uri = Uri.of_string session.api_url in
+
username = credentials.username;
+
authentication_token = credentials.password;
+
Lwt.return (Ok { session; config })
+
| Error e -> Lwt.return (Error e)
+
(** Get all mailboxes for an account
+
@param conn The JMAP connection
+
@param account_id The account ID to get mailboxes for
+
@return A list of mailboxes if successful
+
let get_mailboxes conn ~account_id =
+
using = ["urn:ietf:params:jmap:core"; Types.capability_mail];
+
("accountId", `String account_id);
+
let* response_result = make_request conn.config request in
+
match response_result with
+
let method_response = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) ->
+
inv.name = "Mailbox/get") response.method_responses in
+
let args = method_response.arguments in
+
match Ezjsonm.find_opt args ["list"] with
+
| Some (`A mailbox_list) ->
+
let parse_results = List.map mailbox_of_json mailbox_list in
+
let (successes, failures) = List.partition Result.is_ok parse_results in
+
if List.length failures > 0 then
+
Error (Parse_error "Failed to parse some mailboxes")
+
Ok (List.map Result.get_ok successes)
+
| _ -> Error (Parse_error "Mailbox list not found in response")
+
| Not_found -> Error (Parse_error "Mailbox/get method response not found")
+
| e -> Error (Parse_error (Printexc.to_string e))
+
| Error e -> Lwt.return (Error e)
+
(** Get a specific mailbox by ID
+
@param conn The JMAP connection
+
@param account_id The account ID
+
@param mailbox_id The mailbox ID to retrieve
+
@return The mailbox if found
+
let get_mailbox conn ~account_id ~mailbox_id =
+
using = ["urn:ietf:params:jmap:core"; Types.capability_mail];
+
("accountId", `String account_id);
+
("ids", `A [`String mailbox_id]);
+
let* response_result = make_request conn.config request in
+
match response_result with
+
let method_response = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) ->
+
inv.name = "Mailbox/get") response.method_responses in
+
let args = method_response.arguments in
+
match Ezjsonm.find_opt args ["list"] with
+
| Some (`A [mailbox]) -> mailbox_of_json mailbox
+
| Some (`A []) -> Error (Parse_error ("Mailbox not found: " ^ mailbox_id))
+
| _ -> Error (Parse_error "Expected single mailbox in response")
+
| Not_found -> Error (Parse_error "Mailbox/get method response not found")
+
| e -> Error (Parse_error (Printexc.to_string e))
+
| Error e -> Lwt.return (Error e)
+
(** Get messages in a mailbox
+
@param conn The JMAP connection
+
@param account_id The account ID
+
@param mailbox_id The mailbox ID to get messages from
+
@param limit Optional limit on number of messages to return
+
@return The list of email messages if successful
+
let get_messages_in_mailbox conn ~account_id ~mailbox_id ?limit () =
+
(* First query the emails in the mailbox *)
+
using = ["urn:ietf:params:jmap:core"; Types.capability_mail];
+
("accountId", `String account_id);
+
("filter", `O [("inMailbox", `String mailbox_id)]);
+
("sort", `A [`O [("property", `String "receivedAt"); ("isAscending", `Bool false)]]);
+
| Some l -> [("limit", `Float (float_of_int l))]
+
let* query_result = make_request conn.config query_request in
+
match query_result with
+
let query_method = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) ->
+
inv.name = "Email/query") query_response.method_responses in
+
let args = query_method.arguments in
+
match Ezjsonm.find_opt args ["ids"] with
+
let email_ids = List.map (function
+
| _ -> raise (Invalid_argument "Email ID is not a string")
+
(* If we have IDs, fetch the actual email objects *)
+
if List.length email_ids > 0 then
+
using = ["urn:ietf:params:jmap:core"; Types.capability_mail];
+
("accountId", `String account_id);
+
("ids", `A (List.map (fun id -> `String id) email_ids));
+
let* get_result = make_request conn.config get_request in
+
let get_method = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) ->
+
inv.name = "Email/get") get_response.method_responses in
+
let args = get_method.arguments in
+
match Ezjsonm.find_opt args ["list"] with
+
| Some (`A email_list) ->
+
let parse_results = List.map email_of_json email_list in
+
let (successes, failures) = List.partition Result.is_ok parse_results in
+
if List.length failures > 0 then
+
Lwt.return (Error (Parse_error "Failed to parse some emails"))
+
Lwt.return (Ok (List.map Result.get_ok successes))
+
| _ -> Lwt.return (Error (Parse_error "Email list not found in response"))
+
| Not_found -> Lwt.return (Error (Parse_error "Email/get method response not found"))
+
| e -> Lwt.return (Error (Parse_error (Printexc.to_string e))))
+
| Error e -> Lwt.return (Error e)
+
(* No emails in mailbox *)
+
| _ -> Lwt.return (Error (Parse_error "Email IDs not found in query response"))
+
| Not_found -> Lwt.return (Error (Parse_error "Email/query method response not found"))
+
| Invalid_argument msg -> Lwt.return (Error (Parse_error msg))
+
| e -> Lwt.return (Error (Parse_error (Printexc.to_string e))))
+
| Error e -> Lwt.return (Error e)
+
(** Get a single email message by ID
+
@param conn The JMAP connection
+
@param account_id The account ID
+
@param email_id The email ID to retrieve
+
@return The email message if found
+
let get_email conn ~account_id ~email_id =
+
using = ["urn:ietf:params:jmap:core"; Types.capability_mail];
+
("accountId", `String account_id);
+
("ids", `A [`String email_id]);
+
let* response_result = make_request conn.config request in
+
match response_result with
+
let method_response = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) ->
+
inv.name = "Email/get") response.method_responses in
+
let args = method_response.arguments in
+
match Ezjsonm.find_opt args ["list"] with
+
| Some (`A [email]) -> email_of_json email
+
| Some (`A []) -> Error (Parse_error ("Email not found: " ^ email_id))
+
| _ -> Error (Parse_error "Expected single email in response")
+
| Not_found -> Error (Parse_error "Email/get method response not found")
+
| e -> Error (Parse_error (Printexc.to_string e))
+
| Error e -> Lwt.return (Error e)
anil.recoil.org