···
updated : id list option;
not_updated : (id * set_error) list option;
860
+
(** {1:message_flags Message Flags and Mailbox Attributes} *)
862
+
(** Flag color defined by the combination of MailFlagBit0, MailFlagBit1, and MailFlagBit2 keywords *)
864
+
| Red (** Bit pattern 000 *)
865
+
| Orange (** Bit pattern 100 *)
866
+
| Yellow (** Bit pattern 010 *)
867
+
| Green (** Bit pattern 111 *)
868
+
| Blue (** Bit pattern 001 *)
869
+
| Purple (** Bit pattern 101 *)
870
+
| Gray (** Bit pattern 011 *)
872
+
(** Standard message keywords as defined in draft-ietf-mailmaint-messageflag-mailboxattribute-02 *)
873
+
type message_keyword =
874
+
| Notify (** Indicate a notification should be shown for this message *)
875
+
| Muted (** User is not interested in future replies to this thread *)
876
+
| Followed (** User is particularly interested in future replies to this thread *)
877
+
| Memo (** Message is a note-to-self about another message in the same thread *)
878
+
| HasMemo (** Message has an associated memo with the $memo keyword *)
879
+
| HasAttachment (** Message has an attachment *)
880
+
| HasNoAttachment (** Message does not have an attachment *)
881
+
| AutoSent (** Message was sent automatically as a response due to a user rule *)
882
+
| Unsubscribed (** User has unsubscribed from the thread this message is in *)
883
+
| CanUnsubscribe (** Message has an RFC8058-compliant List-Unsubscribe header *)
884
+
| Imported (** Message was imported from another mailbox *)
885
+
| IsTrusted (** Server has verified authenticity of the from name and email *)
886
+
| MaskedEmail (** Message was received via an alias created for an individual sender *)
887
+
| New (** Message should be made more prominent due to a recent action *)
888
+
| MailFlagBit0 (** Bit 0 of the 3-bit flag color pattern *)
889
+
| MailFlagBit1 (** Bit 1 of the 3-bit flag color pattern *)
890
+
| MailFlagBit2 (** Bit 2 of the 3-bit flag color pattern *)
891
+
| OtherKeyword of string (** Other non-standard keywords *)
893
+
(** Special mailbox attribute names as defined in draft-ietf-mailmaint-messageflag-mailboxattribute-02 *)
894
+
type mailbox_attribute =
895
+
| Snoozed (** Mailbox containing messages that have been snoozed *)
896
+
| Scheduled (** Mailbox containing messages scheduled to be sent later *)
897
+
| Memos (** Mailbox containing messages with the $memo keyword *)
898
+
| OtherAttribute of string (** Other non-standard mailbox attributes *)
900
+
(** Functions for working with flag colors based on the specification in
901
+
draft-ietf-mailmaint-messageflag-mailboxattribute-02, section 3.1. *)
903
+
(** Convert bit pattern to flag color *)
904
+
let flag_color_of_bits bit0 bit1 bit2 =
905
+
match (bit0, bit1, bit2) with
906
+
| (false, false, false) -> Red (* 000 *)
907
+
| (true, false, false) -> Orange (* 100 *)
908
+
| (false, true, false) -> Yellow (* 010 *)
909
+
| (true, true, true) -> Green (* 111 *)
910
+
| (false, false, true) -> Blue (* 001 *)
911
+
| (true, false, true) -> Purple (* 101 *)
912
+
| (false, true, true) -> Gray (* 011 *)
913
+
| (true, true, false) -> Green (* 110 - not in spec, defaulting to green *)
915
+
(** Get bits for a flag color *)
916
+
let bits_of_flag_color = function
917
+
| Red -> (false, false, false)
918
+
| Orange -> (true, false, false)
919
+
| Yellow -> (false, true, false)
920
+
| Green -> (true, true, true)
921
+
| Blue -> (false, false, true)
922
+
| Purple -> (true, false, true)
923
+
| Gray -> (false, true, true)
925
+
(** Check if a keyword list contains a flag color *)
926
+
let has_flag_color keywords =
927
+
let has_bit0 = List.exists (function
928
+
| (Custom s, true) when s = "$MailFlagBit0" -> true
932
+
let has_bit1 = List.exists (function
933
+
| (Custom s, true) when s = "$MailFlagBit1" -> true
937
+
let has_bit2 = List.exists (function
938
+
| (Custom s, true) when s = "$MailFlagBit2" -> true
942
+
has_bit0 || has_bit1 || has_bit2
944
+
(** Extract flag color from keywords if present *)
945
+
let get_flag_color keywords =
946
+
(* First check if the message has the \Flagged system flag *)
947
+
let is_flagged = List.exists (function
948
+
| (Flagged, true) -> true
952
+
if not is_flagged then
955
+
(* Get values of each bit flag *)
956
+
let bit0 = List.exists (function
957
+
| (Custom s, true) when s = "$MailFlagBit0" -> true
961
+
let bit1 = List.exists (function
962
+
| (Custom s, true) when s = "$MailFlagBit1" -> true
966
+
let bit2 = List.exists (function
967
+
| (Custom s, true) when s = "$MailFlagBit2" -> true
971
+
Some (flag_color_of_bits bit0 bit1 bit2)
973
+
(** Convert a message keyword to its string representation *)
974
+
let string_of_message_keyword = function
975
+
| Notify -> "$notify"
976
+
| Muted -> "$muted"
977
+
| Followed -> "$followed"
979
+
| HasMemo -> "$hasmemo"
980
+
| HasAttachment -> "$hasattachment"
981
+
| HasNoAttachment -> "$hasnoattachment"
982
+
| AutoSent -> "$autosent"
983
+
| Unsubscribed -> "$unsubscribed"
984
+
| CanUnsubscribe -> "$canunsubscribe"
985
+
| Imported -> "$imported"
986
+
| IsTrusted -> "$istrusted"
987
+
| MaskedEmail -> "$maskedemail"
989
+
| MailFlagBit0 -> "$MailFlagBit0"
990
+
| MailFlagBit1 -> "$MailFlagBit1"
991
+
| MailFlagBit2 -> "$MailFlagBit2"
992
+
| OtherKeyword s -> s
994
+
(** Parse a string into a message keyword *)
995
+
let message_keyword_of_string = function
996
+
| "$notify" -> Notify
997
+
| "$muted" -> Muted
998
+
| "$followed" -> Followed
1000
+
| "$hasmemo" -> HasMemo
1001
+
| "$hasattachment" -> HasAttachment
1002
+
| "$hasnoattachment" -> HasNoAttachment
1003
+
| "$autosent" -> AutoSent
1004
+
| "$unsubscribed" -> Unsubscribed
1005
+
| "$canunsubscribe" -> CanUnsubscribe
1006
+
| "$imported" -> Imported
1007
+
| "$istrusted" -> IsTrusted
1008
+
| "$maskedemail" -> MaskedEmail
1010
+
| "$MailFlagBit0" -> MailFlagBit0
1011
+
| "$MailFlagBit1" -> MailFlagBit1
1012
+
| "$MailFlagBit2" -> MailFlagBit2
1013
+
| s -> OtherKeyword s
1015
+
(** Convert a mailbox attribute to its string representation *)
1016
+
let string_of_mailbox_attribute = function
1017
+
| Snoozed -> "Snoozed"
1018
+
| Scheduled -> "Scheduled"
1019
+
| Memos -> "Memos"
1020
+
| OtherAttribute s -> s
1022
+
(** Parse a string into a mailbox attribute *)
1023
+
let mailbox_attribute_of_string = function
1024
+
| "Snoozed" -> Snoozed
1025
+
| "Scheduled" -> Scheduled
1026
+
| "Memos" -> Memos
1027
+
| s -> OtherAttribute s
(** {1 JSON serialization} *)
···
| e -> Error (Parse_error (Printexc.to_string e))
1481
-
| Error e -> Lwt.return (Error e)
1650
+
| Error e -> Lwt.return (Error e)
1652
+
(** Helper functions for working with message flags and mailbox attributes *)
1654
+
(** Check if an email has a specific message keyword
1655
+
@param email The email to check
1656
+
@param keyword The message keyword to look for
1657
+
@return true if the email has the keyword, false otherwise
1660
+
let has_message_keyword (email:Types.email) keyword =
1662
+
let keyword_string = string_of_message_keyword keyword in
1663
+
List.exists (function
1664
+
| (Custom s, true) when s = keyword_string -> true
1668
+
(** Add a message keyword to an email
1669
+
@param conn The JMAP connection
1670
+
@param account_id The account ID
1671
+
@param email_id The email ID
1672
+
@param keyword The message keyword to add
1673
+
@return Success or error
1676
+
let add_message_keyword conn ~account_id ~email_id ~keyword =
1677
+
let keyword_string = Types.string_of_message_keyword keyword in
1681
+
Jmap.Capability.to_string Jmap.Capability.Core;
1682
+
Capability.to_string Capability.Mail
1686
+
name = "Email/set";
1688
+
("accountId", `String account_id);
1692
+
(keyword_string, `Bool true)
1697
+
method_call_id = "m1";
1700
+
created_ids = None;
1703
+
let* response_result = make_request conn.config request in
1704
+
match response_result with
1708
+
let method_response = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) ->
1709
+
inv.name = "Email/set") response.method_responses in
1710
+
let args = method_response.arguments in
1711
+
match Ezjsonm.find_opt args ["updated"] with
1712
+
| Some (`A ids) -> Ok ()
1714
+
match Ezjsonm.find_opt args ["notUpdated"] with
1715
+
| Some (`O errors) ->
1716
+
Error (Parse_error ("Failed to update email: " ^ email_id))
1717
+
| _ -> Error (Parse_error "Unexpected response format")
1719
+
| Not_found -> Error (Parse_error "Email/set method response not found")
1720
+
| e -> Error (Parse_error (Printexc.to_string e))
1723
+
| Error e -> Lwt.return (Error e)
1725
+
(** Set a flag color for an email
1726
+
@param conn The JMAP connection
1727
+
@param account_id The account ID
1728
+
@param email_id The email ID
1729
+
@param color The flag color to set
1730
+
@return Success or error
1733
+
let set_flag_color conn ~account_id ~email_id ~color =
1734
+
(* Get the bit pattern for the color *)
1735
+
let (bit0, bit1, bit2) = Types.bits_of_flag_color color in
1737
+
(* Build the keywords update object *)
1739
+
("$flagged", `Bool true);
1740
+
("$MailFlagBit0", `Bool bit0);
1741
+
("$MailFlagBit1", `Bool bit1);
1742
+
("$MailFlagBit2", `Bool bit2);
1747
+
Jmap.Capability.to_string Jmap.Capability.Core;
1748
+
Capability.to_string Capability.Mail
1752
+
name = "Email/set";
1754
+
("accountId", `String account_id);
1757
+
("keywords", `O keywords)
1761
+
method_call_id = "m1";
1764
+
created_ids = None;
1767
+
let* response_result = make_request conn.config request in
1768
+
match response_result with
1772
+
let method_response = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) ->
1773
+
inv.name = "Email/set") response.method_responses in
1774
+
let args = method_response.arguments in
1775
+
match Ezjsonm.find_opt args ["updated"] with
1776
+
| Some (`A ids) -> Ok ()
1778
+
match Ezjsonm.find_opt args ["notUpdated"] with
1779
+
| Some (`O errors) ->
1780
+
Error (Parse_error ("Failed to update email: " ^ email_id))
1781
+
| _ -> Error (Parse_error "Unexpected response format")
1783
+
| Not_found -> Error (Parse_error "Email/set method response not found")
1784
+
| e -> Error (Parse_error (Printexc.to_string e))
1787
+
| Error e -> Lwt.return (Error e)
1789
+
(** Convert an email's keywords to typed message_keyword list
1790
+
@param email The email to analyze
1791
+
@return List of message keywords
1794
+
let get_message_keywords (email:Types.email) =
1796
+
List.filter_map (function
1797
+
| (Custom s, true) -> Some (message_keyword_of_string s)
1801
+
(** Get emails with a specific message keyword
1802
+
@param conn The JMAP connection
1803
+
@param account_id The account ID
1804
+
@param keyword The message keyword to search for
1805
+
@param limit Optional limit on number of emails to return
1806
+
@return List of emails with the keyword if successful
1809
+
let get_emails_with_keyword conn ~account_id ~keyword ?limit () =
1810
+
let keyword_string = Types.string_of_message_keyword keyword in
1812
+
(* Query for emails with the specified keyword *)
1813
+
let query_request = {
1815
+
Jmap.Capability.to_string Jmap.Capability.Core;
1816
+
Capability.to_string Capability.Mail
1820
+
name = "Email/query";
1822
+
("accountId", `String account_id);
1823
+
("filter", `O [("hasKeyword", `String keyword_string)]);
1824
+
("sort", `A [`O [("property", `String "receivedAt"); ("isAscending", `Bool false)]]);
1825
+
] @ (match limit with
1826
+
| Some l -> [("limit", `Float (float_of_int l))]
1829
+
method_call_id = "q1";
1832
+
created_ids = None;
1835
+
let* query_result = make_request conn.config query_request in
1836
+
match query_result with
1837
+
| Ok query_response ->
1839
+
let query_method = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) ->
1840
+
inv.name = "Email/query") query_response.method_responses in
1841
+
let args = query_method.arguments in
1842
+
match Ezjsonm.find_opt args ["ids"] with
1843
+
| Some (`A ids) ->
1844
+
let email_ids = List.map (function
1845
+
| `String id -> id
1846
+
| _ -> raise (Invalid_argument "Email ID is not a string")
1849
+
(* If we have IDs, fetch the actual email objects *)
1850
+
if List.length email_ids > 0 then
1851
+
let get_request = {
1853
+
Jmap.Capability.to_string Jmap.Capability.Core;
1854
+
Capability.to_string Capability.Mail
1858
+
name = "Email/get";
1860
+
("accountId", `String account_id);
1861
+
("ids", `A (List.map (fun id -> `String id) email_ids));
1863
+
method_call_id = "g1";
1866
+
created_ids = None;
1869
+
let* get_result = make_request conn.config get_request in
1870
+
match get_result with
1871
+
| Ok get_response ->
1873
+
let get_method = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) ->
1874
+
inv.name = "Email/get") get_response.method_responses in
1875
+
let args = get_method.arguments in
1876
+
match Ezjsonm.find_opt args ["list"] with
1877
+
| Some (`A email_list) ->
1878
+
let parse_results = List.map email_of_json email_list in
1879
+
let (successes, failures) = List.partition Result.is_ok parse_results in
1880
+
if List.length failures > 0 then
1881
+
Lwt.return (Error (Parse_error "Failed to parse some emails"))
1883
+
Lwt.return (Ok (List.map Result.get_ok successes))
1884
+
| _ -> Lwt.return (Error (Parse_error "Email list not found in response"))
1886
+
| Not_found -> Lwt.return (Error (Parse_error "Email/get method response not found"))
1887
+
| e -> Lwt.return (Error (Parse_error (Printexc.to_string e))))
1888
+
| Error e -> Lwt.return (Error e)
1890
+
(* No emails with the keyword *)
1891
+
Lwt.return (Ok [])
1893
+
| _ -> Lwt.return (Error (Parse_error "Email IDs not found in query response"))
1895
+
| Not_found -> Lwt.return (Error (Parse_error "Email/query method response not found"))
1896
+
| Invalid_argument msg -> Lwt.return (Error (Parse_error msg))
1897
+
| e -> Lwt.return (Error (Parse_error (Printexc.to_string e))))
1898
+
| Error e -> Lwt.return (Error e)
anil.recoil.org