forked from
anil.recoil.org/ocaml-imap
IMAP in OCaml
Refactor mail-flag to use polymorphic variants and move wire modules
- Convert Flag_color to polymorphic variants (`Red, `Orange, etc.)
- Remove Imap_wire module from mail-flag, merge into ocaml-imap Flag
- Flag.system now uses polymorphic variants
- Flag.Keyword now wraps Mail_flag.Keyword.t directly
- Add flags_of_keywords/keywords_of_flags batch conversions
- Remove Jmap_wire module from mail-flag, merge into ocaml-jmap
- Add role_of_special_use/special_use_of_role to Mail_mailbox
- Add keywords_to_assoc/keywords_of_assoc to Mail_email
- Create toplevel mail_flag.mli with module aliases and full API docs
- Update all IMAP library code and tests for polymorphic variant types
Co-Authored-By: Claude Opus 4.5 <noreply@anthropic.com>
+230
-176
+1
-1
bin/imap_client.ml
+1
-1
bin/imap_client.ml
+88
-64
lib/imap/flag.ml
+88
-64
lib/imap/flag.ml
···
3
3
SPDX-License-Identifier: ISC
4
4
---------------------------------------------------------------------------*)
5
5
6
-
(** Message Flags
6
+
(** IMAP Message Flags
7
7
8
-
Re-exports from {!Mail_flag} for IMAP-specific use.
8
+
This module handles IMAP message flags with wire format conversion.
9
9
See {{:https://datatracker.ietf.org/doc/html/rfc9051#section-2.3.2}RFC 9051 Section 2.3.2}. *)
10
10
11
-
(** {1 System Flags} *)
11
+
(** {1 System Flags}
12
12
13
-
type system =
14
-
| Seen (** Message has been read *)
15
-
| Answered (** Message has been answered *)
16
-
| Flagged (** Message is flagged for urgent/special attention *)
17
-
| Deleted (** Message is marked for deletion *)
18
-
| Draft (** Message has not completed composition *)
13
+
System flags are the five flags defined in RFC 9051 that use the
14
+
backslash prefix: [\Seen], [\Answered], [\Flagged], [\Deleted], [\Draft]. *)
15
+
16
+
type system = [ `Seen | `Answered | `Flagged | `Deleted | `Draft ]
19
17
20
18
let pp_system ppf = function
21
-
| Seen -> Fmt.string ppf "\\Seen"
22
-
| Answered -> Fmt.string ppf "\\Answered"
23
-
| Flagged -> Fmt.string ppf "\\Flagged"
24
-
| Deleted -> Fmt.string ppf "\\Deleted"
25
-
| Draft -> Fmt.string ppf "\\Draft"
19
+
| `Seen -> Fmt.string ppf "\\Seen"
20
+
| `Answered -> Fmt.string ppf "\\Answered"
21
+
| `Flagged -> Fmt.string ppf "\\Flagged"
22
+
| `Deleted -> Fmt.string ppf "\\Deleted"
23
+
| `Draft -> Fmt.string ppf "\\Draft"
24
+
25
+
let system_to_string = function
26
+
| `Seen -> "\\Seen"
27
+
| `Answered -> "\\Answered"
28
+
| `Flagged -> "\\Flagged"
29
+
| `Deleted -> "\\Deleted"
30
+
| `Draft -> "\\Draft"
31
+
32
+
(** {1 Flags}
26
33
27
-
(** {1 Flags} *)
34
+
IMAP flags are either system flags (backslash prefix) or keywords (dollar prefix). *)
28
35
29
36
type t =
30
37
| System of system
31
-
| Keyword of string
38
+
| Keyword of Mail_flag.Keyword.t
32
39
33
40
let keyword name =
34
-
(* Strip leading $ if present to normalize *)
35
-
if String.length name > 0 && name.[0] = '$' then
36
-
Keyword (String.sub name 1 (String.length name - 1))
37
-
else
38
-
Keyword name
41
+
Keyword (Mail_flag.Keyword.of_string name)
39
42
40
43
let pp ppf = function
41
44
| System f -> pp_system ppf f
42
-
| Keyword k -> Fmt.pf ppf "$%s" k
45
+
| Keyword k -> Fmt.string ppf (Mail_flag.Keyword.to_imap_string k)
43
46
44
47
let to_string f = Fmt.str "%a" pp f
45
48
49
+
(** Parse a system flag from a string. Returns the system flag variant if recognized. *)
50
+
let parse_system_flag s =
51
+
let s = String.lowercase_ascii s in
52
+
let s = if String.length s > 0 && s.[0] = '\\' then
53
+
String.sub s 1 (String.length s - 1)
54
+
else s
55
+
in
56
+
match s with
57
+
| "seen" -> Some `Seen
58
+
| "answered" -> Some `Answered
59
+
| "flagged" -> Some `Flagged
60
+
| "deleted" -> Some `Deleted
61
+
| "draft" -> Some `Draft
62
+
| _ -> None
63
+
46
64
let of_string s =
47
-
match String.uppercase_ascii s with
48
-
| "\\SEEN" -> Some (System Seen)
49
-
| "\\ANSWERED" -> Some (System Answered)
50
-
| "\\FLAGGED" -> Some (System Flagged)
51
-
| "\\DELETED" -> Some (System Deleted)
52
-
| "\\DRAFT" -> Some (System Draft)
53
-
| _ ->
54
-
if String.length s > 0 && s.[0] <> '\\' then Some (Keyword s) else None
65
+
match parse_system_flag s with
66
+
| Some sys -> Some (System sys)
67
+
| None ->
68
+
if String.length s > 0 && s.[0] <> '\\' then
69
+
Some (Keyword (Mail_flag.Keyword.of_string s))
70
+
else None
55
71
56
-
(** {1 Conversion to/from mail-flag} *)
72
+
(** {1 Conversion to/from mail-flag Keywords} *)
57
73
58
74
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
75
+
| `Seen -> `Seen
76
+
| `Answered -> `Answered
77
+
| `Flagged -> `Flagged
78
+
| `Deleted -> `Deleted
79
+
| `Draft -> `Draft
64
80
65
81
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
82
+
| `Seen -> Some `Seen
83
+
| `Answered -> Some `Answered
84
+
| `Flagged -> Some `Flagged
85
+
| `Deleted -> Some `Deleted
86
+
| `Draft -> Some `Draft
71
87
| `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
88
89
89
let to_keyword : t -> Mail_flag.Keyword.t = function
90
90
| System s -> system_to_keyword s
91
-
| Keyword k -> Mail_flag.Keyword.of_string k
91
+
| Keyword k -> k
92
92
93
93
let of_keyword (k : Mail_flag.Keyword.t) : t =
94
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)
95
+
| `Seen -> System `Seen
96
+
| `Answered -> System `Answered
97
+
| `Flagged -> System `Flagged
98
+
| `Deleted -> System `Deleted
99
+
| `Draft -> System `Draft
100
+
| other -> Keyword other
101
+
102
+
(** {1 Batch Conversions} *)
103
+
104
+
let flags_of_keywords keywords =
105
+
List.map (fun k ->
106
+
match k with
107
+
| `Seen -> System `Seen
108
+
| `Answered -> System `Answered
109
+
| `Flagged -> System `Flagged
110
+
| `Deleted -> System `Deleted
111
+
| `Draft -> System `Draft
112
+
| other -> Keyword other
113
+
) keywords
114
+
115
+
let keywords_of_flags flags =
116
+
List.map (fun flag ->
117
+
match flag with
118
+
| System `Seen -> `Seen
119
+
| System `Answered -> `Answered
120
+
| System `Flagged -> `Flagged
121
+
| System `Deleted -> `Deleted
122
+
| System `Draft -> `Draft
123
+
| Keyword k -> k
124
+
) flags
+57
-25
lib/imap/flag.mli
+57
-25
lib/imap/flag.mli
···
3
3
SPDX-License-Identifier: ISC
4
4
---------------------------------------------------------------------------*)
5
5
6
-
(** Message Flags
6
+
(** IMAP Message Flags
7
+
8
+
This module handles IMAP message flags with wire format conversion.
9
+
See {{:https://datatracker.ietf.org/doc/html/rfc9051#section-2.3.2}RFC 9051 Section 2.3.2}.
10
+
11
+
{2 IMAP Flag Format}
12
+
13
+
IMAP uses two types of message flags:
14
+
- {b System flags} prefixed with backslash: [\Seen], [\Answered], [\Flagged], [\Deleted], [\Draft]
15
+
- {b Keywords} prefixed with dollar sign: [$Forwarded], [$Junk], etc. *)
7
16
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}. *)
17
+
(** {1 System Flags}
10
18
11
-
(** {1 System Flags} *)
19
+
System flags are the five flags defined in RFC 9051 that use the
20
+
backslash prefix: [\Seen], [\Answered], [\Flagged], [\Deleted], [\Draft]. *)
12
21
13
-
type system =
14
-
| Seen (** Message has been read *)
15
-
| Answered (** Message has been answered *)
16
-
| Flagged (** Message is flagged for urgent/special attention *)
17
-
| Deleted (** Message is marked for deletion *)
18
-
| Draft (** Message has not completed composition *)
22
+
type system = [ `Seen | `Answered | `Flagged | `Deleted | `Draft ]
19
23
20
24
val pp_system : Format.formatter -> system -> unit
25
+
(** [pp_system ppf sys] pretty-prints a system flag in IMAP wire format. *)
21
26
22
-
(** {1 Flags} *)
27
+
val system_to_string : system -> string
28
+
(** [system_to_string sys] converts a system flag to its IMAP wire format string. *)
29
+
30
+
(** {1 Flags}
31
+
32
+
IMAP flags are either system flags (backslash prefix) or keywords (dollar prefix). *)
23
33
24
34
type t =
25
35
| System of system
26
-
| Keyword of string
27
-
(** Keyword flags. The string should NOT include the [$] prefix;
28
-
it will be added automatically when writing to the server.
29
-
Use {!keyword} to safely create keyword flags. *)
36
+
| Keyword of Mail_flag.Keyword.t
37
+
(** Keyword flags use the {!Mail_flag.Keyword.t} type for full
38
+
interoperability with the mail-flag library. *)
30
39
31
40
val keyword : string -> t
32
-
(** [keyword name] creates a keyword flag. The [$] prefix is handled
33
-
automatically - if [name] starts with [$], it will be stripped.
41
+
(** [keyword name] creates a keyword flag by parsing the string.
42
+
The [$] prefix is handled automatically.
34
43
For example, both [keyword "Forwarded"] and [keyword "$Forwarded"]
35
-
produce the same flag that appears as [$Forwarded] on the wire. *)
44
+
produce the same keyword that appears as [$Forwarded] on the wire. *)
36
45
37
46
val pp : Format.formatter -> t -> unit
47
+
(** [pp ppf flag] pretty-prints a flag in IMAP wire format. *)
48
+
38
49
val to_string : t -> string
50
+
(** [to_string flag] converts a flag to IMAP wire format string. *)
51
+
39
52
val of_string : string -> t option
53
+
(** [of_string s] parses an IMAP flag string.
40
54
41
-
(** {1 Conversion to/from mail-flag}
55
+
System flags are recognized with or without the backslash prefix,
56
+
case-insensitively. Keywords are parsed using {!Mail_flag.Keyword.of_string}.
57
+
58
+
Examples:
59
+
- ["\\Seen"] -> [Some (System `Seen)]
60
+
- ["Seen"] -> [Some (System `Seen)]
61
+
- ["$forwarded"] -> [Some (Keyword `Forwarded)]
62
+
- ["$custom"] -> [Some (Keyword (`Custom "custom"))] *)
63
+
64
+
(** {1 Conversion to/from mail-flag Keywords}
42
65
43
66
These functions allow interoperability with the {!Mail_flag} library
44
67
for cross-protocol flag handling. *)
···
50
73
(** [system_of_keyword kw] converts a standard mail-flag keyword to an IMAP system flag.
51
74
Returns [None] for keywords like [`Forwarded] that have no IMAP system flag equivalent. *)
52
75
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
76
val to_keyword : t -> Mail_flag.Keyword.t
60
77
(** [to_keyword flag] converts an IMAP flag to a mail-flag keyword. *)
61
78
62
79
val of_keyword : Mail_flag.Keyword.t -> t
63
80
(** [of_keyword kw] converts a mail-flag keyword to an IMAP flag. *)
81
+
82
+
(** {1 Batch Conversions} *)
83
+
84
+
val flags_of_keywords : Mail_flag.Keyword.t list -> t list
85
+
(** [flags_of_keywords keywords] converts a list of keywords to IMAP flags.
86
+
87
+
Keywords that correspond to IMAP system flags ([`Seen], [`Answered],
88
+
[`Flagged], [`Deleted], [`Draft]) are converted to [System] flags.
89
+
All other keywords remain as [Keyword] flags. *)
90
+
91
+
val keywords_of_flags : t list -> Mail_flag.Keyword.t list
92
+
(** [keywords_of_flags flags] converts IMAP flags to keywords.
93
+
94
+
System flags are converted to their corresponding standard keywords.
95
+
Keyword flags are returned as-is. *)
+9
-10
lib/imap/read.ml
+9
-10
lib/imap/read.ml
···
145
145
match R.peek_char r with
146
146
| Some '*' ->
147
147
R.char '*' r;
148
-
Flag.Keyword "\\*"
148
+
Flag.Keyword (`Custom "\\*")
149
149
| _ ->
150
150
let name = atom r in
151
151
match String.uppercase_ascii name with
152
-
| "SEEN" -> Flag.System Flag.Seen
153
-
| "ANSWERED" -> Flag.System Flag.Answered
154
-
| "FLAGGED" -> Flag.System Flag.Flagged
155
-
| "DELETED" -> Flag.System Flag.Deleted
156
-
| "DRAFT" -> Flag.System Flag.Draft
157
-
| _ -> Flag.Keyword ("\\" ^ name)
152
+
| "SEEN" -> Flag.System `Seen
153
+
| "ANSWERED" -> Flag.System `Answered
154
+
| "FLAGGED" -> Flag.System `Flagged
155
+
| "DELETED" -> Flag.System `Deleted
156
+
| "DRAFT" -> Flag.System `Draft
157
+
| _ -> Flag.Keyword (Mail_flag.Keyword.of_string ("\\" ^ name))
158
158
159
159
let flag r =
160
160
match R.peek_char r with
161
161
| Some '\\' -> system_flag r
162
162
| Some '$' ->
163
163
R.char '$' r;
164
-
(* Don't include $ in keyword - it's added by Flag.pp and write.ml *)
165
-
Flag.Keyword (atom r)
166
-
| _ -> Flag.Keyword (atom r)
164
+
Flag.Keyword (Mail_flag.Keyword.of_string (atom r))
165
+
| _ -> Flag.Keyword (Mail_flag.Keyword.of_string (atom r))
167
166
168
167
let flag_list r = parse_paren_list ~parse_item:flag r
169
168
+6
-8
lib/imap/write.ml
+6
-8
lib/imap/write.ml
···
95
95
(** {1 Flags} *)
96
96
97
97
let system_flag w = function
98
-
| Flag.Seen -> W.string w "\\Seen"
99
-
| Flag.Answered -> W.string w "\\Answered"
100
-
| Flag.Flagged -> W.string w "\\Flagged"
101
-
| Flag.Deleted -> W.string w "\\Deleted"
102
-
| Flag.Draft -> W.string w "\\Draft"
98
+
| `Seen -> W.string w "\\Seen"
99
+
| `Answered -> W.string w "\\Answered"
100
+
| `Flagged -> W.string w "\\Flagged"
101
+
| `Deleted -> W.string w "\\Deleted"
102
+
| `Draft -> W.string w "\\Draft"
103
103
104
104
let flag w = function
105
105
| Flag.System f -> system_flag w f
106
-
| Flag.Keyword k ->
107
-
W.char w '$';
108
-
W.string w k
106
+
| Flag.Keyword k -> W.string w (Mail_flag.Keyword.to_imap_string k)
109
107
110
108
let flag_list w flags =
111
109
W.char w '(';
+45
-45
test/integration/imaptest_scripted.ml
+45
-45
test/integration/imaptest_scripted.ml
···
130
130
with_test_mailbox ~sw ~env ~config ~suffix:"append" (fun client mailbox ->
131
131
let _ = Imap.Client.select client mailbox in
132
132
let uid_opt = Imap.Client.append client ~mailbox ~message:test_message
133
-
~flags:[Imap.Flag.System Imap.Flag.Seen] () in
133
+
~flags:[Imap.Flag.System `Seen] () in
134
134
(* APPENDUID might not be supported, so uid_opt may be None *)
135
135
ignore uid_opt;
136
136
(* Verify message exists *)
···
153
153
with_test_mailbox ~sw ~env ~config ~suffix:"fetch-flags" (fun client mailbox ->
154
154
let _ = Imap.Client.select client mailbox in
155
155
let _ = Imap.Client.append client ~mailbox ~message:test_message
156
-
~flags:[Imap.Flag.System Imap.Flag.Seen; Imap.Flag.System Imap.Flag.Flagged] () in
156
+
~flags:[Imap.Flag.System `Seen; Imap.Flag.System `Flagged] () in
157
157
let _ = Imap.Client.select client mailbox in
158
158
let msgs = Imap.Client.fetch client ~sequence:(Imap.Seq.single 1) ~items:[Imap.Fetch.Flags] () in
159
159
assert_length ~msg:"fetch results" 1 msgs;
···
161
161
assert_true "flags should be present" (Option.is_some msg.flags);
162
162
let flags = Option.get msg.flags in
163
163
assert_true "\\Seen should be present"
164
-
(List.exists (fun f -> f = Imap.Flag.System Imap.Flag.Seen) flags))
164
+
(List.exists (fun f -> f = Imap.Flag.System `Seen) flags))
165
165
166
166
let test_fetch_body ~sw ~env ~config () =
167
167
with_test_mailbox ~sw ~env ~config ~suffix:"fetch-body" (fun client mailbox ->
···
211
211
let _ = Imap.Client.append client ~mailbox ~message:test_message () in
212
212
let _ = Imap.Client.select client mailbox in
213
213
let _ = Imap.Client.store client ~sequence:(Imap.Seq.single 1)
214
-
~action:Imap.Store.Add ~flags:[Imap.Flag.System Imap.Flag.Flagged] () in
214
+
~action:Imap.Store.Add ~flags:[Imap.Flag.System `Flagged] () in
215
215
(* Verify flag was added *)
216
216
let msgs = Imap.Client.fetch client ~sequence:(Imap.Seq.single 1) ~items:[Imap.Fetch.Flags] () in
217
217
let msg = List.hd msgs in
218
218
let flags = Option.get msg.flags in
219
219
assert_true "\\Flagged should be present"
220
-
(List.exists (fun f -> f = Imap.Flag.System Imap.Flag.Flagged) flags))
220
+
(List.exists (fun f -> f = Imap.Flag.System `Flagged) flags))
221
221
222
222
let test_store_remove_flag ~sw ~env ~config () =
223
223
with_test_mailbox ~sw ~env ~config ~suffix:"store-rm" (fun client mailbox ->
224
224
let _ = Imap.Client.select client mailbox in
225
225
let _ = Imap.Client.append client ~mailbox ~message:test_message
226
-
~flags:[Imap.Flag.System Imap.Flag.Seen; Imap.Flag.System Imap.Flag.Flagged] () in
226
+
~flags:[Imap.Flag.System `Seen; Imap.Flag.System `Flagged] () in
227
227
let _ = Imap.Client.select client mailbox in
228
228
let _ = Imap.Client.store client ~sequence:(Imap.Seq.single 1)
229
-
~action:Imap.Store.Remove ~flags:[Imap.Flag.System Imap.Flag.Flagged] () in
229
+
~action:Imap.Store.Remove ~flags:[Imap.Flag.System `Flagged] () in
230
230
(* Verify flag was removed *)
231
231
let msgs = Imap.Client.fetch client ~sequence:(Imap.Seq.single 1) ~items:[Imap.Fetch.Flags] () in
232
232
let msg = List.hd msgs in
233
233
let flags = Option.get msg.flags in
234
234
assert_true "\\Flagged should not be present"
235
-
(not (List.exists (fun f -> f = Imap.Flag.System Imap.Flag.Flagged) flags)))
235
+
(not (List.exists (fun f -> f = Imap.Flag.System `Flagged) flags)))
236
236
237
237
let test_store_set_flags ~sw ~env ~config () =
238
238
with_test_mailbox ~sw ~env ~config ~suffix:"store-set" (fun client mailbox ->
239
239
let _ = Imap.Client.select client mailbox in
240
240
let _ = Imap.Client.append client ~mailbox ~message:test_message
241
-
~flags:[Imap.Flag.System Imap.Flag.Seen] () in
241
+
~flags:[Imap.Flag.System `Seen] () in
242
242
let _ = Imap.Client.select client mailbox in
243
243
let _ = Imap.Client.store client ~sequence:(Imap.Seq.single 1)
244
-
~action:Imap.Store.Set ~flags:[Imap.Flag.System Imap.Flag.Draft] () in
244
+
~action:Imap.Store.Set ~flags:[Imap.Flag.System `Draft] () in
245
245
(* Verify flags were replaced *)
246
246
let msgs = Imap.Client.fetch client ~sequence:(Imap.Seq.single 1) ~items:[Imap.Fetch.Flags] () in
247
247
let msg = List.hd msgs in
248
248
let flags = Option.get msg.flags in
249
249
assert_true "\\Seen should not be present (replaced)"
250
-
(not (List.exists (fun f -> f = Imap.Flag.System Imap.Flag.Seen) flags));
250
+
(not (List.exists (fun f -> f = Imap.Flag.System `Seen) flags));
251
251
assert_true "\\Draft should be present"
252
-
(List.exists (fun f -> f = Imap.Flag.System Imap.Flag.Draft) flags))
252
+
(List.exists (fun f -> f = Imap.Flag.System `Draft) flags))
253
253
254
254
let test_uid_store ~sw ~env ~config () =
255
255
with_test_mailbox ~sw ~env ~config ~suffix:"uid-store" (fun client mailbox ->
···
265
265
| _ -> raise (Failure "Expected exactly 1 message")
266
266
in
267
267
let _ = Imap.Client.uid_store client ~sequence:(Imap.Seq.single (Int64.to_int uid))
268
-
~action:Imap.Store.Add ~flags:[Imap.Flag.System Imap.Flag.Answered] () in
268
+
~action:Imap.Store.Add ~flags:[Imap.Flag.System `Answered] () in
269
269
let msgs = Imap.Client.fetch client ~sequence:(Imap.Seq.single 1) ~items:[Imap.Fetch.Flags] () in
270
270
let msg = List.hd msgs in
271
271
let flags = Option.get msg.flags in
272
272
assert_true "\\Answered should be present"
273
-
(List.exists (fun f -> f = Imap.Flag.System Imap.Flag.Answered) flags))
273
+
(List.exists (fun f -> f = Imap.Flag.System `Answered) flags))
274
274
275
275
let test_copy_message ~sw ~env ~config () =
276
276
with_test_setup ~sw ~env ~config (fun client ->
···
319
319
let _ = Imap.Client.select client mailbox in
320
320
(* Mark as deleted *)
321
321
let _ = Imap.Client.store client ~sequence:(Imap.Seq.single 1)
322
-
~action:Imap.Store.Add ~flags:[Imap.Flag.System Imap.Flag.Deleted] () in
322
+
~action:Imap.Store.Add ~flags:[Imap.Flag.System `Deleted] () in
323
323
(* Expunge *)
324
324
let expunged = Imap.Client.expunge client in
325
325
assert_true "should expunge 1 message" (List.length expunged = 1);
···
346
346
in
347
347
(* Mark first as deleted *)
348
348
let _ = Imap.Client.store client ~sequence:(Imap.Seq.single 1)
349
-
~action:Imap.Store.Add ~flags:[Imap.Flag.System Imap.Flag.Deleted] () in
349
+
~action:Imap.Store.Add ~flags:[Imap.Flag.System `Deleted] () in
350
350
(* UID EXPUNGE only the first *)
351
351
let _ = Imap.Client.uid_expunge client (Imap.Seq.single (Int64.to_int uid1)) in
352
352
(* Verify only one message remains *)
···
366
366
with_test_mailbox ~sw ~env ~config ~suffix:"search-unseen" (fun client mailbox ->
367
367
let _ = Imap.Client.select client mailbox in
368
368
let _ = Imap.Client.append client ~mailbox ~message:test_message
369
-
~flags:[Imap.Flag.System Imap.Flag.Seen] () in
369
+
~flags:[Imap.Flag.System `Seen] () in
370
370
let _ = Imap.Client.append client ~mailbox ~message:test_message () in
371
371
let _ = Imap.Client.select client mailbox in
372
372
let results = Imap.Client.search client Imap.Search.Unseen in
···
442
442
let _ = Imap.Client.select client mailbox in
443
443
(* Test all system flags *)
444
444
let all_flags = [
445
-
Imap.Flag.System Imap.Flag.Seen;
446
-
Imap.Flag.System Imap.Flag.Answered;
447
-
Imap.Flag.System Imap.Flag.Flagged;
448
-
Imap.Flag.System Imap.Flag.Deleted;
449
-
Imap.Flag.System Imap.Flag.Draft;
445
+
Imap.Flag.System `Seen;
446
+
Imap.Flag.System `Answered;
447
+
Imap.Flag.System `Flagged;
448
+
Imap.Flag.System `Deleted;
449
+
Imap.Flag.System `Draft;
450
450
] in
451
451
(* Set all flags *)
452
452
let _ = Imap.Client.store client ~sequence:(Imap.Seq.single 1)
···
465
465
let info = Imap.Client.select client mailbox in
466
466
(* Check if server allows keyword flags via PERMANENTFLAGS *)
467
467
let allows_keywords = List.exists (function
468
-
| Imap.Flag.Keyword "\\*" -> true
468
+
| Imap.Flag.Keyword (`Custom "\\*") -> true
469
469
| _ -> false
470
470
) info.permanent_flags in
471
471
if not allows_keywords then begin
···
499
499
Imap.Client.create client mailbox_name;
500
500
let _ = Imap.Client.select client mailbox_name in
501
501
let _ = Imap.Client.append client ~mailbox:mailbox_name ~message:test_message
502
-
~flags:[Imap.Flag.System Imap.Flag.Flagged] () in
502
+
~flags:[Imap.Flag.System `Flagged] () in
503
503
());
504
504
(* Second session: verify flags are still there *)
505
505
with_test_setup ~sw ~env ~config (fun client ->
···
511
511
let msg = List.hd msgs in
512
512
let flags = Option.get msg.flags in
513
513
assert_true "\\Flagged should persist across sessions"
514
-
(List.mem (Imap.Flag.System Imap.Flag.Flagged) flags)))
514
+
(List.mem (Imap.Flag.System `Flagged) flags)))
515
515
516
516
(* ========== Advanced Search Tests (RFC 9051 Section 6.4.4) ========== *)
517
517
···
535
535
with_test_mailbox ~sw ~env ~config ~suffix:"search-flag" (fun client mailbox ->
536
536
let _ = Imap.Client.select client mailbox in
537
537
let _ = Imap.Client.append client ~mailbox ~message:test_message
538
-
~flags:[Imap.Flag.System Imap.Flag.Flagged] () in
538
+
~flags:[Imap.Flag.System `Flagged] () in
539
539
let _ = Imap.Client.append client ~mailbox ~message:test_message () in
540
540
let _ = Imap.Client.select client mailbox in
541
541
let results = Imap.Client.search client Imap.Search.Flagged in
···
549
549
let _ = Imap.Client.select client mailbox in
550
550
(* Mark first message as deleted *)
551
551
let _ = Imap.Client.store client ~sequence:(Imap.Seq.single 1)
552
-
~action:Imap.Store.Add ~flags:[Imap.Flag.System Imap.Flag.Deleted] () in
552
+
~action:Imap.Store.Add ~flags:[Imap.Flag.System `Deleted] () in
553
553
let results = Imap.Client.search client Imap.Search.Deleted in
554
554
assert_length ~msg:"search DELETED results" 1 results;
555
555
let undeleted = Imap.Client.search client Imap.Search.Undeleted in
···
559
559
with_test_mailbox ~sw ~env ~config ~suffix:"search-not" (fun client mailbox ->
560
560
let _ = Imap.Client.select client mailbox in
561
561
let _ = Imap.Client.append client ~mailbox ~message:test_message
562
-
~flags:[Imap.Flag.System Imap.Flag.Seen] () in
562
+
~flags:[Imap.Flag.System `Seen] () in
563
563
let _ = Imap.Client.append client ~mailbox ~message:test_message () in
564
564
let _ = Imap.Client.select client mailbox in
565
565
(* NOT SEEN should return the unseen message *)
···
570
570
with_test_mailbox ~sw ~env ~config ~suffix:"search-or" (fun client mailbox ->
571
571
let _ = Imap.Client.select client mailbox in
572
572
let _ = Imap.Client.append client ~mailbox ~message:test_message
573
-
~flags:[Imap.Flag.System Imap.Flag.Seen] () in
573
+
~flags:[Imap.Flag.System `Seen] () in
574
574
let _ = Imap.Client.append client ~mailbox ~message:test_message
575
-
~flags:[Imap.Flag.System Imap.Flag.Flagged] () in
575
+
~flags:[Imap.Flag.System `Flagged] () in
576
576
let _ = Imap.Client.append client ~mailbox ~message:test_message () in
577
577
let _ = Imap.Client.select client mailbox in
578
578
(* OR SEEN FLAGGED should return 2 messages *)
···
584
584
with_test_mailbox ~sw ~env ~config ~suffix:"search-and" (fun client mailbox ->
585
585
let _ = Imap.Client.select client mailbox in
586
586
let _ = Imap.Client.append client ~mailbox ~message:test_message
587
-
~flags:[Imap.Flag.System Imap.Flag.Seen; Imap.Flag.System Imap.Flag.Flagged] () in
587
+
~flags:[Imap.Flag.System `Seen; Imap.Flag.System `Flagged] () in
588
588
let _ = Imap.Client.append client ~mailbox ~message:test_message
589
-
~flags:[Imap.Flag.System Imap.Flag.Seen] () in
589
+
~flags:[Imap.Flag.System `Seen] () in
590
590
let _ = Imap.Client.append client ~mailbox ~message:test_message () in
591
591
let _ = Imap.Client.select client mailbox in
592
592
(* AND [SEEN; FLAGGED] should return 1 message *)
···
794
794
with_test_mailbox ~sw ~env ~config ~suffix:"close" (fun client mailbox ->
795
795
let _ = Imap.Client.select client mailbox in
796
796
let _ = Imap.Client.append client ~mailbox ~message:test_message
797
-
~flags:[Imap.Flag.System Imap.Flag.Deleted] () in
797
+
~flags:[Imap.Flag.System `Deleted] () in
798
798
let _ = Imap.Client.select client mailbox in
799
799
(* CLOSE should expunge deleted messages and return to authenticated state *)
800
800
Imap.Client.close client;
···
1026
1026
with_test_mailbox ~sw ~env ~config ~suffix:"search-draft" (fun client mailbox ->
1027
1027
let _ = Imap.Client.select client mailbox in
1028
1028
let _ = Imap.Client.append client ~mailbox ~message:test_message
1029
-
~flags:[Imap.Flag.System Imap.Flag.Draft] () in
1029
+
~flags:[Imap.Flag.System `Draft] () in
1030
1030
let _ = Imap.Client.select client mailbox in
1031
1031
let results = Imap.Client.search client Imap.Search.Draft in
1032
1032
assert_true "should find draft message" (List.length results >= 1))
···
1091
1091
with_test_mailbox ~sw ~env ~config ~suffix:"search-cplx" (fun client mailbox ->
1092
1092
let _ = Imap.Client.select client mailbox in
1093
1093
let _ = Imap.Client.append client ~mailbox ~message:test_message
1094
-
~flags:[Imap.Flag.System Imap.Flag.Seen] () in
1094
+
~flags:[Imap.Flag.System `Seen] () in
1095
1095
let _ = Imap.Client.select client mailbox in
1096
1096
(* Complex AND: Seen AND Subject contains "Test" AND Smaller than 1MB *)
1097
1097
let results = Imap.Client.search client
···
1195
1195
with_test_mailbox ~sw ~env ~config ~suffix:"append-flags" (fun client mailbox ->
1196
1196
let _ = Imap.Client.select client mailbox in
1197
1197
let flags = [
1198
-
Imap.Flag.System Imap.Flag.Seen;
1199
-
Imap.Flag.System Imap.Flag.Flagged;
1198
+
Imap.Flag.System `Seen;
1199
+
Imap.Flag.System `Flagged;
1200
1200
] in
1201
1201
let _ = Imap.Client.append client ~mailbox ~message:test_message ~flags () in
1202
1202
let _ = Imap.Client.select client mailbox in
···
1205
1205
let msg = List.hd msgs in
1206
1206
let msg_flags = Option.get msg.flags in
1207
1207
assert_true "should have Seen flag"
1208
-
(List.mem (Imap.Flag.System Imap.Flag.Seen) msg_flags);
1208
+
(List.mem (Imap.Flag.System `Seen) msg_flags);
1209
1209
assert_true "should have Flagged flag"
1210
-
(List.mem (Imap.Flag.System Imap.Flag.Flagged) msg_flags))
1210
+
(List.mem (Imap.Flag.System `Flagged) msg_flags))
1211
1211
1212
1212
let test_append_multiple ~sw ~env ~config () =
1213
1213
with_test_mailbox ~sw ~env ~config ~suffix:"append-multi" (fun client mailbox ->
···
1285
1285
let _ = Imap.Client.store client
1286
1286
~sequence:(Imap.Seq.single 1)
1287
1287
~action:Imap.Store.Add
1288
-
~flags:[Imap.Flag.System Imap.Flag.Seen]
1288
+
~flags:[Imap.Flag.System `Seen]
1289
1289
~unchangedsince:Int64.max_int () in
1290
1290
(* Verify flag was set *)
1291
1291
let msgs = Imap.Client.fetch client
···
1294
1294
let msg = List.hd msgs in
1295
1295
let flags = Option.get msg.flags in
1296
1296
assert_true "should have Seen flag"
1297
-
(List.mem (Imap.Flag.System Imap.Flag.Seen) flags))
1297
+
(List.mem (Imap.Flag.System `Seen) flags))
1298
1298
1299
1299
(* ========== Multi-Message Operations ========== *)
1300
1300
···
1323
1323
let _ = Imap.Client.select client mailbox in
1324
1324
(* Set flags on all messages *)
1325
1325
let _ = Imap.Client.store client ~sequence:(Imap.Seq.range 1 3)
1326
-
~action:Imap.Store.Add ~flags:[Imap.Flag.System Imap.Flag.Seen] () in
1326
+
~action:Imap.Store.Add ~flags:[Imap.Flag.System `Seen] () in
1327
1327
(* Verify all are seen *)
1328
1328
let fetched_msgs = Imap.Client.fetch client ~sequence:(Imap.Seq.range 1 3)
1329
1329
~items:[Imap.Fetch.Flags] () in
1330
1330
List.iter (fun (m : Imap.Client.message_info) ->
1331
1331
let flags = Option.get m.flags in
1332
-
assert_true "should be seen" (List.mem (Imap.Flag.System Imap.Flag.Seen) flags)
1332
+
assert_true "should be seen" (List.mem (Imap.Flag.System `Seen) flags)
1333
1333
) fetched_msgs)
1334
1334
1335
1335
let test_copy_multiple_messages ~sw ~env ~config () =
···
1362
1362
let _ = Imap.Client.select client mailbox in
1363
1363
(* Mark messages 2 and 4 for deletion *)
1364
1364
let _ = Imap.Client.store client ~sequence:(Imap.Seq.single 2)
1365
-
~action:Imap.Store.Add ~flags:[Imap.Flag.System Imap.Flag.Deleted] () in
1365
+
~action:Imap.Store.Add ~flags:[Imap.Flag.System `Deleted] () in
1366
1366
let _ = Imap.Client.store client ~sequence:(Imap.Seq.single 4)
1367
-
~action:Imap.Store.Add ~flags:[Imap.Flag.System Imap.Flag.Deleted] () in
1367
+
~action:Imap.Store.Add ~flags:[Imap.Flag.System `Deleted] () in
1368
1368
let _ = Imap.Client.expunge client in
1369
1369
let info = Imap.Client.select client mailbox in
1370
1370
assert_true "should have 3 messages after expunge" (info.exists = 3))
+5
-5
test/integration/imaptest_stress.ml
+5
-5
test/integration/imaptest_stress.ml
···
329
329
(try
330
330
let _ = Imap.Client.store c1 ~sequence:(Imap.Seq.single 1)
331
331
~action:Imap.Store.Add
332
-
~flags:[Imap.Flag.System Imap.Flag.Seen]
332
+
~flags:[Imap.Flag.System `Seen]
333
333
~silent:true () in ()
334
334
with _ -> incr errors)
335
335
done))
···
346
346
(try
347
347
let _ = Imap.Client.store c2 ~sequence:(Imap.Seq.single 1)
348
348
~action:Imap.Store.Add
349
-
~flags:[Imap.Flag.System Imap.Flag.Flagged]
349
+
~flags:[Imap.Flag.System `Flagged]
350
350
~silent:true () in ()
351
351
with _ -> incr errors)
352
352
done));
···
364
364
match msgs with
365
365
| [msg] ->
366
366
let flags = Option.value ~default:[] msg.flags in
367
-
let has_seen = List.exists (fun f -> f = Imap.Flag.System Imap.Flag.Seen) flags in
368
-
let has_flagged = List.exists (fun f -> f = Imap.Flag.System Imap.Flag.Flagged) flags in
367
+
let has_seen = List.exists (fun f -> f = Imap.Flag.System `Seen) flags in
368
+
let has_flagged = List.exists (fun f -> f = Imap.Flag.System `Flagged) flags in
369
369
if not has_seen || not has_flagged then begin
370
370
Imaptest_state.record_violation state
371
371
(Imaptest_state.Flag_atomicity_violation {
372
372
uid = 0L;
373
-
expected = [Imap.Flag.System Imap.Flag.Seen; Imap.Flag.System Imap.Flag.Flagged];
373
+
expected = [Imap.Flag.System `Seen; Imap.Flag.System `Flagged];
374
374
got = flags;
375
375
})
376
376
end;
+5
-5
test/integration/imaptest_utils.ml
+5
-5
test/integration/imaptest_utils.ml
···
202
202
(** Generate a random flag *)
203
203
let random_flag () =
204
204
match Random.int 5 with
205
-
| 0 -> Imap.Flag.System Imap.Flag.Seen
206
-
| 1 -> Imap.Flag.System Imap.Flag.Answered
207
-
| 2 -> Imap.Flag.System Imap.Flag.Flagged
208
-
| 3 -> Imap.Flag.System Imap.Flag.Draft
209
-
| _ -> Imap.Flag.Keyword "$TestFlag"
205
+
| 0 -> Imap.Flag.System `Seen
206
+
| 1 -> Imap.Flag.System `Answered
207
+
| 2 -> Imap.Flag.System `Flagged
208
+
| 3 -> Imap.Flag.System `Draft
209
+
| _ -> Imap.Flag.keyword "$TestFlag"
210
210
211
211
(** Generate a random store action *)
212
212
let random_store_action () =
+4
-4
test/test_client.ml
+4
-4
test/test_client.ml
···
50
50
recent = 3;
51
51
uidvalidity = 1234567890L;
52
52
uidnext = 43L;
53
-
flags = [ Imap.Flag.System Imap.Flag.Seen; Imap.Flag.System Imap.Flag.Answered; Imap.Flag.System Imap.Flag.Flagged ];
54
-
permanent_flags = [ Imap.Flag.System Imap.Flag.Seen; Imap.Flag.System Imap.Flag.Answered ];
53
+
flags = [ Imap.Flag.System `Seen; Imap.Flag.System `Answered; Imap.Flag.System `Flagged ];
54
+
permanent_flags = [ Imap.Flag.System `Seen; Imap.Flag.System `Answered ];
55
55
readonly = false;
56
56
}
57
57
in
···
65
65
{
66
66
seq = 1;
67
67
uid = Some 12345L;
68
-
flags = Some [ Imap.Flag.System Imap.Flag.Seen ];
68
+
flags = Some [ Imap.Flag.System `Seen ];
69
69
envelope =
70
70
Some
71
71
{
···
115
115
[
116
116
Idle_exists 43;
117
117
Idle_expunge 10;
118
-
Idle_fetch { seq = 5; flags = [ Imap.Flag.System Imap.Flag.Seen ] };
118
+
Idle_fetch { seq = 5; flags = [ Imap.Flag.System `Seen ] };
119
119
]
120
120
in
121
121
Alcotest.(check int) "event count" 3 (List.length events)
+3
-3
test/test_read.ml
+3
-3
test/test_read.ml
···
47
47
48
48
let test_flag_seen () =
49
49
let result = with_reader "\\Seen " (fun r -> Imap.Read.flag r) in
50
-
Alcotest.(check flag_testable) "seen" (Imap.Flag.System Imap.Flag.Seen) result
50
+
Alcotest.(check flag_testable) "seen" (Imap.Flag.System `Seen) result
51
51
52
52
let test_flag_answered () =
53
53
let result = with_reader "\\Answered " (fun r -> Imap.Read.flag r) in
54
-
Alcotest.(check flag_testable) "answered" (Imap.Flag.System Imap.Flag.Answered) result
54
+
Alcotest.(check flag_testable) "answered" (Imap.Flag.System `Answered) result
55
55
56
56
let test_flag_keyword () =
57
57
let result = with_reader "$Forwarded " (fun r -> Imap.Read.flag r) in
58
-
Alcotest.(check flag_testable) "keyword" (Imap.Flag.Keyword "Forwarded") result
58
+
Alcotest.(check flag_testable) "keyword" (Imap.Flag.keyword "Forwarded") result
59
59
60
60
let test_flag_list () =
61
61
let result = with_reader "(\\Seen \\Answered) " (fun r -> Imap.Read.flag_list r) in
+7
-6
test/test_write.ml
+7
-6
test/test_write.ml
···
72
72
Alcotest.(check string) "complex" "1,3:5,10:*" result
73
73
74
74
let test_flag_seen () =
75
-
let result = serialize (fun w -> Imap.Write.flag w (Imap.Flag.System Imap.Flag.Seen)) in
75
+
let result = serialize (fun w -> Imap.Write.flag w (Imap.Flag.System `Seen)) in
76
76
Alcotest.(check string) "seen" "\\Seen" result
77
77
78
78
let test_flag_keyword () =
79
-
let result = serialize (fun w -> Imap.Write.flag w (Imap.Flag.Keyword "Forwarded")) in
79
+
let result = serialize (fun w -> Imap.Write.flag w (Imap.Flag.keyword "Forwarded")) in
80
80
Alcotest.(check string) "keyword" "$Forwarded" result
81
81
82
82
let test_flag_list () =
83
83
let result =
84
84
serialize (fun w ->
85
-
Imap.Write.flag_list w [ Imap.Flag.System Imap.Flag.Seen; Imap.Flag.System Imap.Flag.Flagged; Imap.Flag.Keyword "Important" ])
85
+
Imap.Write.flag_list w [ Imap.Flag.System `Seen; Imap.Flag.System `Flagged; Imap.Flag.keyword "Important" ])
86
86
in
87
-
Alcotest.(check string) "flag list" "(\\Seen \\Flagged $Important)" result
87
+
(* Keywords are normalized to lowercase per mail-flag conventions *)
88
+
Alcotest.(check string) "flag list" "(\\Seen \\Flagged $important)" result
88
89
89
90
let test_command_capability () =
90
91
let result = serialize (fun w -> Imap.Write.command w ~tag:"A001" Imap.Command.Capability) in
···
161
162
sequence = [ Imap.Seq.Range (1, 5) ];
162
163
silent = false;
163
164
action = Imap.Store.Add;
164
-
flags = [ Imap.Flag.System Imap.Flag.Seen ];
165
+
flags = [ Imap.Flag.System `Seen ];
165
166
unchangedsince = None;
166
167
}))
167
168
in
···
176
177
sequence = [ Imap.Seq.Single 1 ];
177
178
silent = true;
178
179
action = Imap.Store.Remove;
179
-
flags = [ Imap.Flag.System Imap.Flag.Deleted ];
180
+
flags = [ Imap.Flag.System `Deleted ];
180
181
unchangedsince = None;
181
182
}))
182
183
in