+75 -145

lib/core/jmap_types.ml

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

+1 -1

lib/dune

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

+10

lib/mail/mail_email.ml

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

+25

lib/mail/mail_email.mli

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

+33

lib/mail/mail_mailbox.ml

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

+9

lib/mail/mail_mailbox.mli

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