+75 -145

lib/core/jmap_types.ml

··· 82 (** {1 Keyword Type} *) 83 84 module Keyword = struct 85 - (** RFC 8621 standard keywords *) 0 0 0 0 0 0 86 type standard = [ 87 | `Seen 88 | `Flagged ··· 95 ] 96 97 (** draft-ietf-mailmaint extended keywords *) 98 - type extended = [ 99 - | `Notify 100 - | `Muted 101 - | `Followed 102 - | `Memo 103 - | `HasMemo 104 - | `HasAttachment 105 - | `HasNoAttachment 106 - | `AutoSent 107 - | `Unsubscribed 108 - | `CanUnsubscribe 109 - | `Imported 110 - | `IsTrusted 111 - | `MaskedEmail 112 - | `New 113 - ] 114 115 (** Apple Mail flag color keywords *) 116 - type flag_bits = [ 117 - | `MailFlagBit0 118 - | `MailFlagBit1 119 - | `MailFlagBit2 120 - ] 121 0 0 122 type t = [ 123 | standard 124 | extended ··· 126 | `Custom of string 127 ] 128 129 - let of_string = function 130 - (* RFC 8621 standard keywords *) 131 - | "$seen" -> `Seen 132 - | "$flagged" -> `Flagged 133 - | "$answered" -> `Answered 134 - | "$draft" -> `Draft 135 - | "$forwarded" -> `Forwarded 136 - | "$phishing" -> `Phishing 137 - | "$junk" -> `Junk 138 - | "$notjunk" -> `NotJunk 139 - (* draft-ietf-mailmaint extended keywords *) 140 - | "$notify" -> `Notify 141 - | "$muted" -> `Muted 142 - | "$followed" -> `Followed 143 - | "$memo" -> `Memo 144 - | "$hasmemo" -> `HasMemo 145 - | "$hasattachment" -> `HasAttachment 146 - | "$hasnoattachment" -> `HasNoAttachment 147 - | "$autosent" -> `AutoSent 148 - | "$unsubscribed" -> `Unsubscribed 149 - | "$canunsubscribe" -> `CanUnsubscribe 150 - | "$imported" -> `Imported 151 - | "$istrusted" -> `IsTrusted 152 - | "$maskedemail" -> `MaskedEmail 153 - | "$new" -> `New 154 - (* Apple Mail flag color keywords *) 155 - | "$MailFlagBit0" -> `MailFlagBit0 156 - | "$MailFlagBit1" -> `MailFlagBit1 157 - | "$MailFlagBit2" -> `MailFlagBit2 158 - | s -> `Custom s 159 160 - let to_string = function 161 - (* RFC 8621 standard keywords *) 162 - | `Seen -> "$seen" 163 - | `Flagged -> "$flagged" 164 - | `Answered -> "$answered" 165 - | `Draft -> "$draft" 166 - | `Forwarded -> "$forwarded" 167 - | `Phishing -> "$phishing" 168 - | `Junk -> "$junk" 169 - | `NotJunk -> "$notjunk" 170 - (* draft-ietf-mailmaint extended keywords *) 171 - | `Notify -> "$notify" 172 - | `Muted -> "$muted" 173 - | `Followed -> "$followed" 174 - | `Memo -> "$memo" 175 - | `HasMemo -> "$hasmemo" 176 - | `HasAttachment -> "$hasattachment" 177 - | `HasNoAttachment -> "$hasnoattachment" 178 - | `AutoSent -> "$autosent" 179 - | `Unsubscribed -> "$unsubscribed" 180 - | `CanUnsubscribe -> "$canunsubscribe" 181 - | `Imported -> "$imported" 182 - | `IsTrusted -> "$istrusted" 183 - | `MaskedEmail -> "$maskedemail" 184 - | `New -> "$new" 185 - (* Apple Mail flag color keywords *) 186 - | `MailFlagBit0 -> "$MailFlagBit0" 187 - | `MailFlagBit1 -> "$MailFlagBit1" 188 - | `MailFlagBit2 -> "$MailFlagBit2" 189 - | `Custom s -> s 190 191 let pp ppf k = Format.pp_print_string ppf (to_string k) 192 193 (** Apple Mail flag colors *) 194 - type flag_color = [ 195 - | `Red 196 - | `Orange 197 - | `Yellow 198 - | `Green 199 - | `Blue 200 - | `Purple 201 - | `Gray 202 - ] 203 204 let flag_color_of_keywords (keywords : t list) : flag_color option = 205 - let has k = List.mem k keywords in 206 - let bit0 = has `MailFlagBit0 in 207 - let bit1 = has `MailFlagBit1 in 208 - let bit2 = has `MailFlagBit2 in 209 - match (bit0, bit1, bit2) with 210 - | (false, false, false) -> Some `Red 211 - | (true, false, false) -> Some `Orange 212 - | (false, true, false) -> Some `Yellow 213 - | (true, true, true) -> Some `Green 214 - | (false, false, true) -> Some `Blue 215 - | (true, false, true) -> Some `Purple 216 - | (false, true, true) -> Some `Gray 217 - | (true, true, false) -> None 218 219 - let flag_color_to_keywords : flag_color -> t list = function 220 - | `Red -> [] 221 - | `Orange -> [`MailFlagBit0] 222 - | `Yellow -> [`MailFlagBit1] 223 - | `Green -> [`MailFlagBit0; `MailFlagBit1; `MailFlagBit2] 224 - | `Blue -> [`MailFlagBit2] 225 - | `Purple -> [`MailFlagBit0; `MailFlagBit2] 226 - | `Gray -> [`MailFlagBit1; `MailFlagBit2] 227 end 228 229 (** {1 Mailbox Role Type} *) 230 231 module Role = struct 0 0 0 232 (** RFC 8621 standard roles *) 233 type standard = [ 234 | `Inbox ··· 250 | `Memos 251 ] 252 0 253 type t = [ 254 | standard 255 | extended 256 | `Custom of string 257 ] 258 259 - let of_string = function 260 - (* RFC 8621 standard roles *) 261 - | "inbox" -> `Inbox 262 - | "sent" -> `Sent 263 - | "drafts" -> `Drafts 264 - | "trash" -> `Trash 265 - | "junk" -> `Junk 266 - | "archive" -> `Archive 267 - | "flagged" -> `Flagged 268 - | "important" -> `Important 269 - | "all" -> `All 270 - | "subscribed" -> `Subscribed 271 - (* draft-ietf-mailmaint extended roles *) 272 - | "snoozed" -> `Snoozed 273 - | "scheduled" -> `Scheduled 274 - | "memos" -> `Memos 275 - | s -> `Custom s 276 277 - let to_string = function 278 - (* RFC 8621 standard roles *) 279 - | `Inbox -> "inbox" 280 - | `Sent -> "sent" 281 - | `Drafts -> "drafts" 282 - | `Trash -> "trash" 283 - | `Junk -> "junk" 284 - | `Archive -> "archive" 285 - | `Flagged -> "flagged" 286 - | `Important -> "important" 287 - | `All -> "all" 288 - | `Subscribed -> "subscribed" 289 - (* draft-ietf-mailmaint extended roles *) 290 - | `Snoozed -> "snoozed" 291 - | `Scheduled -> "scheduled" 292 - | `Memos -> "memos" 0 0 0 0 0 0 0 0 293 | `Custom s -> s 0 0 0 294 295 let pp ppf r = Format.pp_print_string ppf (to_string r) 296 end

··· 82 (** {1 Keyword Type} *) 83 84 module Keyword = struct 85 + (** Re-export core types from mail-flag. 86 + Note: mail-flag's [standard] type includes [`Deleted] (IMAP only) 87 + which is not part of JMAP's standard keywords. The JMAP standard 88 + keyword type below excludes [`Deleted] for JMAP compliance. *) 89 + 90 + (** RFC 8621 standard keywords (JMAP subset of mail-flag standard). 91 + This excludes [`Deleted] which is IMAP-only. *) 92 type standard = [ 93 | `Seen 94 | `Flagged ··· 101 ] 102 103 (** draft-ietf-mailmaint extended keywords *) 104 + type extended = Mail_flag.Keyword.extended 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 105 106 (** Apple Mail flag color keywords *) 107 + type flag_bits = Mail_flag.Keyword.flag_bit 0 0 0 0 108 109 + (** Unified keyword type for JMAP. 110 + This is compatible with mail-flag's keyword type but excludes [`Deleted]. *) 111 type t = [ 112 | standard 113 | extended ··· 115 | `Custom of string 116 ] 117 118 + (** Convert from mail-flag keyword to JMAP keyword. 119 + [`Deleted] is converted to a custom keyword since JMAP doesn't support it. *) 120 + let of_mail_flag : Mail_flag.Keyword.t -> t = function 121 + | `Deleted -> `Custom "$deleted" 122 + | #t as k -> k 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 123 124 + (** Convert JMAP keyword to mail-flag keyword. *) 125 + let to_mail_flag (k : t) : Mail_flag.Keyword.t = 126 + (k :> Mail_flag.Keyword.t) 127 + 128 + let of_string s = of_mail_flag (Mail_flag.Keyword.of_string s) 129 + 130 + let to_string (k : t) = Mail_flag.Keyword.to_string (to_mail_flag k) 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 131 132 let pp ppf k = Format.pp_print_string ppf (to_string k) 133 134 (** Apple Mail flag colors *) 135 + type flag_color = Mail_flag.Keyword.flag_color 0 0 0 0 0 0 0 0 136 137 let flag_color_of_keywords (keywords : t list) : flag_color option = 138 + let mail_flag_keywords = List.map to_mail_flag keywords in 139 + Mail_flag.Keyword.flag_color_of_keywords mail_flag_keywords 0 0 0 0 0 0 0 0 0 0 0 140 141 + let flag_color_to_keywords (color : flag_color) : t list = 142 + Mail_flag.Keyword.flag_color_to_keywords color 143 + |> List.map of_mail_flag 0 0 0 0 0 144 end 145 146 (** {1 Mailbox Role Type} *) 147 148 module Role = struct 149 + (** Re-export special-use mailbox attributes from mail-flag as JMAP roles. 150 + JMAP roles correspond to the special_use subset of mailbox attributes. *) 151 + 152 (** RFC 8621 standard roles *) 153 type standard = [ 154 | `Inbox ··· 170 | `Memos 171 ] 172 173 + (** JMAP role type - corresponds to mail-flag's special_use type *) 174 type t = [ 175 | standard 176 | extended 177 | `Custom of string 178 ] 179 180 + (** Convert from mail-flag special_use to JMAP role *) 181 + let of_special_use : Mail_flag.Mailbox_attr.special_use -> t = function 182 + | `All -> `All 183 + | `Archive -> `Archive 184 + | `Drafts -> `Drafts 185 + | `Flagged -> `Flagged 186 + | `Important -> `Important 187 + | `Inbox -> `Inbox 188 + | `Junk -> `Junk 189 + | `Sent -> `Sent 190 + | `Subscribed -> `Subscribed 191 + | `Trash -> `Trash 192 + | `Snoozed -> `Snoozed 193 + | `Scheduled -> `Scheduled 194 + | `Memos -> `Memos 0 0 195 196 + (** Convert JMAP role to mail-flag special_use. 197 + Returns None for custom roles that don't map to special_use. *) 198 + let to_special_use : t -> Mail_flag.Mailbox_attr.special_use option = function 199 + | `All -> Some `All 200 + | `Archive -> Some `Archive 201 + | `Drafts -> Some `Drafts 202 + | `Flagged -> Some `Flagged 203 + | `Important -> Some `Important 204 + | `Inbox -> Some `Inbox 205 + | `Junk -> Some `Junk 206 + | `Sent -> Some `Sent 207 + | `Subscribed -> Some `Subscribed 208 + | `Trash -> Some `Trash 209 + | `Snoozed -> Some `Snoozed 210 + | `Scheduled -> Some `Scheduled 211 + | `Memos -> Some `Memos 212 + | `Custom _ -> None 213 + 214 + let of_string s = 215 + match Mail_flag.Mailbox_attr.of_jmap_role s with 216 + | Some special_use -> of_special_use special_use 217 + | None -> `Custom s 218 + 219 + let to_string : t -> string = function 220 | `Custom s -> s 221 + | #Mail_flag.Mailbox_attr.special_use as role -> 222 + (* safe because to_jmap_role returns Some for all special_use *) 223 + Option.get (Mail_flag.Mailbox_attr.to_jmap_role role) 224 225 let pp ppf r = Format.pp_print_string ppf (to_string r) 226 end

+1 -1

lib/dune

··· 3 (library 4 (name jmap) 5 (public_name jmap) 6 - (libraries jsont json-pointer ptime) 7 (modules 8 ; Core unified interface 9 jmap

··· 3 (library 4 (name jmap) 5 (public_name jmap) 6 + (libraries jsont json-pointer ptime mail-flag) 7 (modules 8 ; Core unified interface 9 jmap

+10

lib/mail/mail_email.ml

··· 525 |> Jsont.Object.opt_mem "maxBodyValueBytes" Proto_int53.Unsigned.jsont 526 ~enc:(fun a -> a.max_body_value_bytes) 527 |> Jsont.Object.finish 0 0 0 0 0 0 0 0 0 0

··· 525 |> Jsont.Object.opt_mem "maxBodyValueBytes" Proto_int53.Unsigned.jsont 526 ~enc:(fun a -> a.max_body_value_bytes) 527 |> Jsont.Object.finish 528 + 529 + (* Conversion to/from mail-flag keywords *) 530 + 531 + let keywords_to_assoc keywords = 532 + List.map (fun k -> (Mail_flag.Keyword.to_string k, true)) keywords 533 + 534 + let keywords_of_assoc assoc = 535 + List.filter_map (fun (s, v) -> 536 + if v then Some (Mail_flag.Keyword.of_string s) else None 537 + ) assoc

+25

lib/mail/mail_email.mli

··· 399 (** Convenience constructor with sensible defaults. *) 400 401 val get_args_extra_jsont : get_args_extra Jsont.t 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0

··· 399 (** Convenience constructor with sensible defaults. *) 400 401 val get_args_extra_jsont : get_args_extra Jsont.t 402 + 403 + (** {1 Conversion to/from mail-flag Keywords} *) 404 + 405 + val keywords_to_assoc : Mail_flag.Keyword.t list -> (string * bool) list 406 + (** [keywords_to_assoc keywords] converts a list of mail-flag keywords to 407 + JMAP keywords object entries. Each keyword is converted to a [(string, true)] 408 + pair using {!Mail_flag.Keyword.to_string} for the string representation. 409 + 410 + Example: 411 + {[ 412 + keywords_to_assoc [`Seen; `Flagged; `Custom "label"] 413 + (* returns [("$seen", true); ("$flagged", true); ("label", true)] *) 414 + ]} *) 415 + 416 + val keywords_of_assoc : (string * bool) list -> Mail_flag.Keyword.t list 417 + (** [keywords_of_assoc assoc] parses JMAP keywords from object entries. 418 + Only entries with [true] value are included in the result. 419 + Entries with [false] value are ignored (they represent the absence 420 + of the keyword). 421 + 422 + Example: 423 + {[ 424 + keywords_of_assoc [("$seen", true); ("$draft", false); ("label", true)] 425 + (* returns [`Seen; `Custom "label"] *) 426 + ]} *)

+33

lib/mail/mail_mailbox.ml

··· 145 ~enc:role_to_string 146 Jsont.string 147 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 148 type t = { 149 id : Proto_id.t option; 150 name : string option;

··· 145 ~enc:role_to_string 146 Jsont.string 147 148 + (** {1 Conversion to/from mail-flag} *) 149 + 150 + let role_of_special_use : Mail_flag.Mailbox_attr.special_use -> role = function 151 + | `All -> `All 152 + | `Archive -> `Archive 153 + | `Drafts -> `Drafts 154 + | `Flagged -> `Flagged 155 + | `Important -> `Important 156 + | `Inbox -> `Inbox 157 + | `Junk -> `Junk 158 + | `Sent -> `Sent 159 + | `Subscribed -> `Subscribed 160 + | `Trash -> `Trash 161 + | `Snoozed -> `Snoozed 162 + | `Scheduled -> `Scheduled 163 + | `Memos -> `Memos 164 + 165 + let special_use_of_role : role -> Mail_flag.Mailbox_attr.special_use option = function 166 + | `All -> Some `All 167 + | `Archive -> Some `Archive 168 + | `Drafts -> Some `Drafts 169 + | `Flagged -> Some `Flagged 170 + | `Important -> Some `Important 171 + | `Inbox -> Some `Inbox 172 + | `Junk -> Some `Junk 173 + | `Sent -> Some `Sent 174 + | `Subscribed -> Some `Subscribed 175 + | `Trash -> Some `Trash 176 + | `Snoozed -> Some `Snoozed 177 + | `Scheduled -> Some `Scheduled 178 + | `Memos -> Some `Memos 179 + | `Other _ -> None 180 + 181 type t = { 182 id : Proto_id.t option; 183 name : string option;

+9

lib/mail/mail_mailbox.mli

··· 86 val role_of_string : string -> role 87 val role_jsont : role Jsont.t 88 0 0 0 0 0 0 0 0 0 89 (** {1 Mailbox} *) 90 91 type t = {

··· 86 val role_of_string : string -> role 87 val role_jsont : role Jsont.t 88 89 + (** {2 Conversion to/from mail-flag} *) 90 + 91 + val role_of_special_use : Mail_flag.Mailbox_attr.special_use -> role 92 + (** [role_of_special_use su] converts a mail-flag special-use attribute to a JMAP role. *) 93 + 94 + val special_use_of_role : role -> Mail_flag.Mailbox_attr.special_use option 95 + (** [special_use_of_role r] converts a JMAP role to a mail-flag special-use attribute. 96 + Returns [None] for [`Other _] roles that don't correspond to standard special-use values. *) 97 + 98 (** {1 Mailbox} *) 99 100 type t = {