jon.recoil.org
forked from
anil.recoil.org/ocaml-jmap
this repo has no description
Add unified mail-flag library for IMAP/JMAP interoperability
New mail-flag library providing shared types for email protocols:
Core modules:
- keyword.ml: Unified message keywords (RFC 8621, draft-ietf-mailmaint)
- Standard: Seen, Answered, Flagged, Draft, Deleted, Forwarded
- Spam: Phishing, Junk, NotJunk
- Extended: HasAttachment, Muted, Followed, Notify, etc.
- Apple Mail flag color bits
- mailbox_attr.ml: Mailbox attributes and roles (RFC 6154, RFC 5258)
- LIST attributes: Noinferiors, Noselect, HasChildren, etc.
- Special-use roles: Inbox, Drafts, Sent, Trash, Archive, etc.
- Extended: Snoozed, Scheduled, Memos
- flag_color.ml: Apple Mail 7-color encoding via 3-bit keywords
Wire format adapters:
- imap_wire.ml: IMAP protocol serialization (\Seen, $forwarded)
- jmap_wire.ml: JMAP JSON format ({"$seen": true})
Integration:
- ocaml-imap: Flag and List_attr modules now interop with mail-flag
- ocaml-jmap: Keyword and Role modules now use mail-flag types
54 tests for mail-flag library, all existing tests pass.
Co-Authored-By: Claude Opus 4.5 <noreply@anthropic.com>
anil.recoil.org
+75
-145
lib/core/jmap_types.ml
+75
-145
lib/core/jmap_types.ml
···
82
82
(** {1 Keyword Type} *)
83
83
84
84
module Keyword = struct
85
-
(** RFC 8621 standard keywords *)
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. *)
86
92
type standard = [
87
93
| `Seen
88
94
| `Flagged
···
95
101
]
96
102
97
103
(** 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
-
]
104
+
type extended = Mail_flag.Keyword.extended
114
105
115
106
(** Apple Mail flag color keywords *)
116
-
type flag_bits = [
117
-
| `MailFlagBit0
118
-
| `MailFlagBit1
119
-
| `MailFlagBit2
120
-
]
107
+
type flag_bits = Mail_flag.Keyword.flag_bit
121
108
109
+
(** Unified keyword type for JMAP.
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
-
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
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
159
123
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
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)
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
-
type flag_color = [
195
-
| `Red
196
-
| `Orange
197
-
| `Yellow
198
-
| `Green
199
-
| `Blue
200
-
| `Purple
201
-
| `Gray
202
-
]
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
-
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
138
+
let mail_flag_keywords = List.map to_mail_flag keywords in
139
+
Mail_flag.Keyword.flag_color_of_keywords mail_flag_keywords
218
140
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]
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
227
144
end
228
145
229
146
(** {1 Mailbox Role Type} *)
230
147
231
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
+
232
152
(** RFC 8621 standard roles *)
233
153
type standard = [
234
154
| `Inbox
···
250
170
| `Memos
251
171
]
252
172
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
-
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
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
276
195
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"
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
293
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)
294
224
295
225
let pp ppf r = Format.pp_print_string ppf (to_string r)
296
226
end