forked from
anil.recoil.org/ocaml-imap
IMAP in OCaml
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>
+210
-4
+52
-1
lib/imap/flag.ml
+52
-1
lib/imap/flag.ml
···
5
5
6
6
(** Message Flags
7
7
8
-
IMAP message flags as specified in RFC 9051 Section 2.3.2. *)
8
+
Re-exports from {!Mail_flag} for IMAP-specific use.
9
+
See {{:https://datatracker.ietf.org/doc/html/rfc9051#section-2.3.2}RFC 9051 Section 2.3.2}. *)
10
+
11
+
(** {1 System Flags} *)
9
12
10
13
type system =
11
14
| Seen (** Message has been read *)
···
20
23
| Flagged -> Fmt.string ppf "\\Flagged"
21
24
| Deleted -> Fmt.string ppf "\\Deleted"
22
25
| Draft -> Fmt.string ppf "\\Draft"
26
+
27
+
(** {1 Flags} *)
23
28
24
29
type t =
25
30
| System of system
···
47
52
| "\\DRAFT" -> Some (System Draft)
48
53
| _ ->
49
54
if String.length s > 0 && s.[0] <> '\\' then Some (Keyword s) else None
55
+
56
+
(** {1 Conversion to/from mail-flag} *)
57
+
58
+
let system_to_keyword : system -> Mail_flag.Keyword.t = function
59
+
| Seen -> `Seen
60
+
| Answered -> `Answered
61
+
| Flagged -> `Flagged
62
+
| Deleted -> `Deleted
63
+
| Draft -> `Draft
64
+
65
+
let system_of_keyword : Mail_flag.Keyword.standard -> system option = function
66
+
| `Seen -> Some Seen
67
+
| `Answered -> Some Answered
68
+
| `Flagged -> Some Flagged
69
+
| `Deleted -> Some Deleted
70
+
| `Draft -> Some Draft
71
+
| `Forwarded -> None
72
+
73
+
let to_mail_flag : t -> Mail_flag.Imap_wire.flag = function
74
+
| System Seen -> Mail_flag.Imap_wire.System `Seen
75
+
| System Answered -> Mail_flag.Imap_wire.System `Answered
76
+
| System Flagged -> Mail_flag.Imap_wire.System `Flagged
77
+
| System Deleted -> Mail_flag.Imap_wire.System `Deleted
78
+
| System Draft -> Mail_flag.Imap_wire.System `Draft
79
+
| Keyword k -> Mail_flag.Imap_wire.Keyword (Mail_flag.Keyword.of_string k)
80
+
81
+
let of_mail_flag : Mail_flag.Imap_wire.flag -> t = function
82
+
| Mail_flag.Imap_wire.System `Seen -> System Seen
83
+
| Mail_flag.Imap_wire.System `Answered -> System Answered
84
+
| Mail_flag.Imap_wire.System `Flagged -> System Flagged
85
+
| Mail_flag.Imap_wire.System `Deleted -> System Deleted
86
+
| Mail_flag.Imap_wire.System `Draft -> System Draft
87
+
| Mail_flag.Imap_wire.Keyword k -> Keyword (Mail_flag.Keyword.to_string k)
88
+
89
+
let to_keyword : t -> Mail_flag.Keyword.t = function
90
+
| System s -> system_to_keyword s
91
+
| Keyword k -> Mail_flag.Keyword.of_string k
92
+
93
+
let of_keyword (k : Mail_flag.Keyword.t) : t =
94
+
match k with
95
+
| `Seen -> System Seen
96
+
| `Answered -> System Answered
97
+
| `Flagged -> System Flagged
98
+
| `Deleted -> System Deleted
99
+
| `Draft -> System Draft
100
+
| other -> Keyword (Mail_flag.Keyword.to_string other)
+26
-1
lib/imap/flag.mli
+26
-1
lib/imap/flag.mli
···
5
5
6
6
(** Message Flags
7
7
8
-
IMAP message flags as specified in RFC 9051 Section 2.3.2. *)
8
+
Re-exports from {!Mail_flag} for IMAP-specific use.
9
+
See {{:https://datatracker.ietf.org/doc/html/rfc9051#section-2.3.2}RFC 9051 Section 2.3.2}. *)
9
10
10
11
(** {1 System Flags} *)
11
12
···
36
37
val pp : Format.formatter -> t -> unit
37
38
val to_string : t -> string
38
39
val of_string : string -> t option
40
+
41
+
(** {1 Conversion to/from mail-flag}
42
+
43
+
These functions allow interoperability with the {!Mail_flag} library
44
+
for cross-protocol flag handling. *)
45
+
46
+
val system_to_keyword : system -> Mail_flag.Keyword.t
47
+
(** [system_to_keyword sys] converts an IMAP system flag to a mail-flag keyword. *)
48
+
49
+
val system_of_keyword : Mail_flag.Keyword.standard -> system option
50
+
(** [system_of_keyword kw] converts a standard mail-flag keyword to an IMAP system flag.
51
+
Returns [None] for keywords like [`Forwarded] that have no IMAP system flag equivalent. *)
52
+
53
+
val to_mail_flag : t -> Mail_flag.Imap_wire.flag
54
+
(** [to_mail_flag flag] converts an IMAP flag to a mail-flag wire format flag. *)
55
+
56
+
val of_mail_flag : Mail_flag.Imap_wire.flag -> t
57
+
(** [of_mail_flag flag] converts a mail-flag wire format flag to an IMAP flag. *)
58
+
59
+
val to_keyword : t -> Mail_flag.Keyword.t
60
+
(** [to_keyword flag] converts an IMAP flag to a mail-flag keyword. *)
61
+
62
+
val of_keyword : Mail_flag.Keyword.t -> t
63
+
(** [of_keyword kw] converts a mail-flag keyword to an IMAP flag. *)
+102
-1
lib/imap/list_attr.ml
+102
-1
lib/imap/list_attr.ml
···
5
5
6
6
(** LIST Command Attributes
7
7
8
-
Mailbox attributes returned by LIST command.
8
+
Re-exports from {!Mail_flag.Mailbox_attr}.
9
9
See RFC 9051 Section 7.2.2. *)
10
10
11
11
type t =
···
43
43
| Extension s -> Fmt.string ppf s
44
44
45
45
let to_string a = Fmt.str "%a" pp a
46
+
47
+
let of_string s =
48
+
let s' = String.lowercase_ascii s in
49
+
(* Remove leading backslash if present *)
50
+
let s' = if String.length s' > 0 && s'.[0] = '\\' then
51
+
String.sub s' 1 (String.length s' - 1)
52
+
else s'
53
+
in
54
+
match s' with
55
+
| "noinferiors" -> Noinferiors
56
+
| "noselect" -> Noselect
57
+
| "marked" -> Marked
58
+
| "unmarked" -> Unmarked
59
+
| "subscribed" -> Subscribed
60
+
| "haschildren" -> Haschildren
61
+
| "hasnochildren" -> Hasnochildren
62
+
| "all" -> All
63
+
| "archive" -> Archive
64
+
| "drafts" -> Drafts
65
+
| "flagged" -> Flagged
66
+
| "junk" | "spam" -> Junk
67
+
| "sent" -> Sent
68
+
| "trash" -> Trash
69
+
| _ -> Extension s
70
+
71
+
(** {1 Conversion to/from mail-flag} *)
72
+
73
+
let to_mailbox_attr : t -> Mail_flag.Mailbox_attr.t = function
74
+
| Noinferiors -> `Noinferiors
75
+
| Noselect -> `Noselect
76
+
| Marked -> `Marked
77
+
| Unmarked -> `Unmarked
78
+
| Subscribed -> `Subscribed
79
+
| Haschildren -> `HasChildren
80
+
| Hasnochildren -> `HasNoChildren
81
+
| All -> `All
82
+
| Archive -> `Archive
83
+
| Drafts -> `Drafts
84
+
| Flagged -> `Flagged
85
+
| Junk -> `Junk
86
+
| Sent -> `Sent
87
+
| Trash -> `Trash
88
+
| Extension s -> `Extension s
89
+
90
+
let of_mailbox_attr : Mail_flag.Mailbox_attr.t -> t = function
91
+
| `Noinferiors -> Noinferiors
92
+
| `Noselect -> Noselect
93
+
| `Marked -> Marked
94
+
| `Unmarked -> Unmarked
95
+
| `Subscribed -> Subscribed
96
+
| `HasChildren -> Haschildren
97
+
| `HasNoChildren -> Hasnochildren
98
+
| `NonExistent -> Noselect (* NonExistent implies Noselect *)
99
+
| `Remote -> Extension "\\Remote"
100
+
| `All -> All
101
+
| `Archive -> Archive
102
+
| `Drafts -> Drafts
103
+
| `Flagged -> Flagged
104
+
| `Important -> Extension "\\Important"
105
+
| `Inbox -> Extension "\\Inbox"
106
+
| `Junk -> Junk
107
+
| `Sent -> Sent
108
+
| `Trash -> Trash
109
+
| `Snoozed -> Extension "\\Snoozed"
110
+
| `Scheduled -> Extension "\\Scheduled"
111
+
| `Memos -> Extension "\\Memos"
112
+
| `Extension s -> Extension s
113
+
114
+
let to_jmap_role : t -> string option = function
115
+
| All -> Some "all"
116
+
| Archive -> Some "archive"
117
+
| Drafts -> Some "drafts"
118
+
| Flagged -> Some "flagged"
119
+
| Junk -> Some "junk"
120
+
| Sent -> Some "sent"
121
+
| Trash -> Some "trash"
122
+
| Subscribed -> Some "subscribed"
123
+
| Noinferiors | Noselect | Marked | Unmarked
124
+
| Haschildren | Hasnochildren | Extension _ -> None
125
+
126
+
let of_jmap_role s =
127
+
match String.lowercase_ascii s with
128
+
| "all" -> Some All
129
+
| "archive" -> Some Archive
130
+
| "drafts" -> Some Drafts
131
+
| "flagged" -> Some Flagged
132
+
| "junk" -> Some Junk
133
+
| "sent" -> Some Sent
134
+
| "trash" -> Some Trash
135
+
| "subscribed" -> Some Subscribed
136
+
| _ -> None
137
+
138
+
let is_special_use = function
139
+
| All | Archive | Drafts | Flagged | Junk | Sent | Trash -> true
140
+
| Subscribed -> true (* Also a JMAP role *)
141
+
| Noinferiors | Noselect | Marked | Unmarked
142
+
| Haschildren | Hasnochildren | Extension _ -> false
143
+
144
+
let is_selectable = function
145
+
| Noselect -> false
146
+
| _ -> true
+29
-1
lib/imap/list_attr.mli
+29
-1
lib/imap/list_attr.mli
···
5
5
6
6
(** LIST Command Attributes
7
7
8
-
Mailbox attributes returned by LIST command.
8
+
Re-exports from {!Mail_flag.Mailbox_attr}.
9
9
See RFC 9051 Section 7.2.2. *)
10
10
11
11
type t =
···
27
27
28
28
val pp : Format.formatter -> t -> unit
29
29
val to_string : t -> string
30
+
val of_string : string -> t
31
+
32
+
(** {1 Conversion to/from mail-flag}
33
+
34
+
These functions allow interoperability with the {!Mail_flag} library
35
+
for cross-protocol attribute handling. *)
36
+
37
+
val to_mailbox_attr : t -> Mail_flag.Mailbox_attr.t
38
+
(** [to_mailbox_attr attr] converts an IMAP list attribute to a mail-flag mailbox attribute. *)
39
+
40
+
val of_mailbox_attr : Mail_flag.Mailbox_attr.t -> t
41
+
(** [of_mailbox_attr attr] converts a mail-flag mailbox attribute to an IMAP list attribute. *)
42
+
43
+
val to_jmap_role : t -> string option
44
+
(** [to_jmap_role attr] converts a special-use attribute to its JMAP role string.
45
+
Returns [None] for LIST attributes that don't correspond to JMAP roles. *)
46
+
47
+
val of_jmap_role : string -> t option
48
+
(** [of_jmap_role role] parses a JMAP role string into a special-use attribute.
49
+
Returns [None] if the role string is not recognized. *)
50
+
51
+
val is_special_use : t -> bool
52
+
(** [is_special_use attr] returns [true] if the attribute is a special-use
53
+
role (as opposed to a LIST attribute or extension). *)
54
+
55
+
val is_selectable : t -> bool
56
+
(** [is_selectable attr] returns [false] if the attribute indicates the
57
+
mailbox cannot be selected (i.e., [Noselect]). *)