···
updated : id list option;
not_updated : (id * set_error) list option;
+
(** {1:message_flags Message Flags and Mailbox Attributes} *)
+
(** Flag color defined by the combination of MailFlagBit0, MailFlagBit1, and MailFlagBit2 keywords *)
+
| Red (** Bit pattern 000 *)
+
| Orange (** Bit pattern 100 *)
+
| Yellow (** Bit pattern 010 *)
+
| Green (** Bit pattern 111 *)
+
| Blue (** Bit pattern 001 *)
+
| Purple (** Bit pattern 101 *)
+
| Gray (** Bit pattern 011 *)
+
(** Standard message keywords as defined in draft-ietf-mailmaint-messageflag-mailboxattribute-02 *)
+
| Notify (** Indicate a notification should be shown for this message *)
+
| Muted (** User is not interested in future replies to this thread *)
+
| Followed (** User is particularly interested in future replies to this thread *)
+
| Memo (** Message is a note-to-self about another message in the same thread *)
+
| HasMemo (** Message has an associated memo with the $memo keyword *)
+
| HasAttachment (** Message has an attachment *)
+
| HasNoAttachment (** Message does not have an attachment *)
+
| AutoSent (** Message was sent automatically as a response due to a user rule *)
+
| Unsubscribed (** User has unsubscribed from the thread this message is in *)
+
| CanUnsubscribe (** Message has an RFC8058-compliant List-Unsubscribe header *)
+
| Imported (** Message was imported from another mailbox *)
+
| IsTrusted (** Server has verified authenticity of the from name and email *)
+
| MaskedEmail (** Message was received via an alias created for an individual sender *)
+
| New (** Message should be made more prominent due to a recent action *)
+
| MailFlagBit0 (** Bit 0 of the 3-bit flag color pattern *)
+
| MailFlagBit1 (** Bit 1 of the 3-bit flag color pattern *)
+
| MailFlagBit2 (** Bit 2 of the 3-bit flag color pattern *)
+
| OtherKeyword of string (** Other non-standard keywords *)
+
(** Special mailbox attribute names as defined in draft-ietf-mailmaint-messageflag-mailboxattribute-02 *)
+
type mailbox_attribute =
+
| Snoozed (** Mailbox containing messages that have been snoozed *)
+
| Scheduled (** Mailbox containing messages scheduled to be sent later *)
+
| Memos (** Mailbox containing messages with the $memo keyword *)
+
| OtherAttribute of string (** Other non-standard mailbox attributes *)
+
(** Functions for working with flag colors based on the specification in
+
draft-ietf-mailmaint-messageflag-mailboxattribute-02, section 3.1. *)
+
(** Convert bit pattern to flag color *)
+
let flag_color_of_bits bit0 bit1 bit2 =
+
match (bit0, bit1, bit2) with
+
| (false, false, false) -> Red (* 000 *)
+
| (true, false, false) -> Orange (* 100 *)
+
| (false, true, false) -> Yellow (* 010 *)
+
| (true, true, true) -> Green (* 111 *)
+
| (false, false, true) -> Blue (* 001 *)
+
| (true, false, true) -> Purple (* 101 *)
+
| (false, true, true) -> Gray (* 011 *)
+
| (true, true, false) -> Green (* 110 - not in spec, defaulting to green *)
+
(** Get bits for a flag color *)
+
let bits_of_flag_color = function
+
| Red -> (false, false, false)
+
| Orange -> (true, false, false)
+
| Yellow -> (false, true, false)
+
| Green -> (true, true, true)
+
| Blue -> (false, false, true)
+
| Purple -> (true, false, true)
+
| Gray -> (false, true, true)
+
(** Check if a keyword list contains a flag color *)
+
let has_flag_color keywords =
+
let has_bit0 = List.exists (function
+
| (Custom s, true) when s = "$MailFlagBit0" -> true
+
let has_bit1 = List.exists (function
+
| (Custom s, true) when s = "$MailFlagBit1" -> true
+
let has_bit2 = List.exists (function
+
| (Custom s, true) when s = "$MailFlagBit2" -> true
+
has_bit0 || has_bit1 || has_bit2
+
(** Extract flag color from keywords if present *)
+
let get_flag_color keywords =
+
(* First check if the message has the \Flagged system flag *)
+
let is_flagged = List.exists (function
+
| (Flagged, true) -> true
+
(* Get values of each bit flag *)
+
let bit0 = List.exists (function
+
| (Custom s, true) when s = "$MailFlagBit0" -> true
+
let bit1 = List.exists (function
+
| (Custom s, true) when s = "$MailFlagBit1" -> true
+
let bit2 = List.exists (function
+
| (Custom s, true) when s = "$MailFlagBit2" -> true
+
Some (flag_color_of_bits bit0 bit1 bit2)
+
(** Convert a message keyword to its string representation *)
+
let string_of_message_keyword = function
+
| Followed -> "$followed"
+
| HasMemo -> "$hasmemo"
+
| HasAttachment -> "$hasattachment"
+
| HasNoAttachment -> "$hasnoattachment"
+
| AutoSent -> "$autosent"
+
| Unsubscribed -> "$unsubscribed"
+
| CanUnsubscribe -> "$canunsubscribe"
+
| Imported -> "$imported"
+
| IsTrusted -> "$istrusted"
+
| MaskedEmail -> "$maskedemail"
+
| MailFlagBit0 -> "$MailFlagBit0"
+
| MailFlagBit1 -> "$MailFlagBit1"
+
| MailFlagBit2 -> "$MailFlagBit2"
+
(** Parse a string into a message keyword *)
+
let message_keyword_of_string = function
+
| "$followed" -> Followed
+
| "$hasmemo" -> HasMemo
+
| "$hasattachment" -> HasAttachment
+
| "$hasnoattachment" -> HasNoAttachment
+
| "$autosent" -> AutoSent
+
| "$unsubscribed" -> Unsubscribed
+
| "$canunsubscribe" -> CanUnsubscribe
+
| "$imported" -> Imported
+
| "$istrusted" -> IsTrusted
+
| "$maskedemail" -> MaskedEmail
+
| "$MailFlagBit0" -> MailFlagBit0
+
| "$MailFlagBit1" -> MailFlagBit1
+
| "$MailFlagBit2" -> MailFlagBit2
+
(** Convert a mailbox attribute to its string representation *)
+
let string_of_mailbox_attribute = function
+
| Scheduled -> "Scheduled"
+
| OtherAttribute s -> s
+
(** Parse a string into a mailbox attribute *)
+
let mailbox_attribute_of_string = function
+
| "Scheduled" -> Scheduled
+
| s -> OtherAttribute s
(** {1 JSON serialization} *)
···
| e -> Error (Parse_error (Printexc.to_string e))
+
| Error e -> Lwt.return (Error e)
+
(** Helper functions for working with message flags and mailbox attributes *)
+
(** Check if an email has a specific message keyword
+
@param email The email to check
+
@param keyword The message keyword to look for
+
@return true if the email has the keyword, false otherwise
+
let has_message_keyword (email:Types.email) keyword =
+
let keyword_string = string_of_message_keyword keyword in
+
| (Custom s, true) when s = keyword_string -> true
+
(** Add a message keyword to an email
+
@param conn The JMAP connection
+
@param account_id The account ID
+
@param email_id The email ID
+
@param keyword The message keyword to add
+
@return Success or error
+
let add_message_keyword conn ~account_id ~email_id ~keyword =
+
let keyword_string = Types.string_of_message_keyword keyword in
+
Jmap.Capability.to_string Jmap.Capability.Core;
+
Capability.to_string Capability.Mail
+
("accountId", `String account_id);
+
(keyword_string, `Bool true)
+
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/set") response.method_responses in
+
let args = method_response.arguments in
+
match Ezjsonm.find_opt args ["updated"] with
+
| Some (`A ids) -> Ok ()
+
match Ezjsonm.find_opt args ["notUpdated"] with
+
Error (Parse_error ("Failed to update email: " ^ email_id))
+
| _ -> Error (Parse_error "Unexpected response format")
+
| Not_found -> Error (Parse_error "Email/set method response not found")
+
| e -> Error (Parse_error (Printexc.to_string e))
+
| Error e -> Lwt.return (Error e)
+
(** Set a flag color for an email
+
@param conn The JMAP connection
+
@param account_id The account ID
+
@param email_id The email ID
+
@param color The flag color to set
+
@return Success or error
+
let set_flag_color conn ~account_id ~email_id ~color =
+
(* Get the bit pattern for the color *)
+
let (bit0, bit1, bit2) = Types.bits_of_flag_color color in
+
(* Build the keywords update object *)
+
("$flagged", `Bool true);
+
("$MailFlagBit0", `Bool bit0);
+
("$MailFlagBit1", `Bool bit1);
+
("$MailFlagBit2", `Bool bit2);
+
Jmap.Capability.to_string Jmap.Capability.Core;
+
Capability.to_string Capability.Mail
+
("accountId", `String account_id);
+
("keywords", `O keywords)
+
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/set") response.method_responses in
+
let args = method_response.arguments in
+
match Ezjsonm.find_opt args ["updated"] with
+
| Some (`A ids) -> Ok ()
+
match Ezjsonm.find_opt args ["notUpdated"] with
+
Error (Parse_error ("Failed to update email: " ^ email_id))
+
| _ -> Error (Parse_error "Unexpected response format")
+
| Not_found -> Error (Parse_error "Email/set method response not found")
+
| e -> Error (Parse_error (Printexc.to_string e))
+
| Error e -> Lwt.return (Error e)
+
(** Convert an email's keywords to typed message_keyword list
+
@param email The email to analyze
+
@return List of message keywords
+
let get_message_keywords (email:Types.email) =
+
List.filter_map (function
+
| (Custom s, true) -> Some (message_keyword_of_string s)
+
(** Get emails with a specific message keyword
+
@param conn The JMAP connection
+
@param account_id The account ID
+
@param keyword The message keyword to search for
+
@param limit Optional limit on number of emails to return
+
@return List of emails with the keyword if successful
+
let get_emails_with_keyword conn ~account_id ~keyword ?limit () =
+
let keyword_string = Types.string_of_message_keyword keyword in
+
(* Query for emails with the specified keyword *)
+
Jmap.Capability.to_string Jmap.Capability.Core;
+
Capability.to_string Capability.Mail
+
("accountId", `String account_id);
+
("filter", `O [("hasKeyword", `String keyword_string)]);
+
("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
+
Jmap.Capability.to_string Jmap.Capability.Core;
+
Capability.to_string 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 with the keyword *)
+
| _ -> 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)
anil.recoil.org