anil.recoil.org
My aggregated monorepo of OCaml code, automaintained
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>
+45
-44
mail-flag/lib/flag_color.ml
+45
-44
mail-flag/lib/flag_color.ml
···
24
24
- Gray: (false, true, true) = 011
25
25
- 111: undefined *)
26
26
27
-
type t =
28
-
| Red (** Bit pattern: 000 *)
29
-
| Orange (** Bit pattern: 100 *)
30
-
| Yellow (** Bit pattern: 010 *)
31
-
| Green (** Bit pattern: 110 *)
32
-
| Blue (** Bit pattern: 001 *)
33
-
| Purple (** Bit pattern: 101 *)
34
-
| Gray (** Bit pattern: 011 *)
27
+
type t = [
28
+
| `Red (** Bit pattern: 000 *)
29
+
| `Orange (** Bit pattern: 100 *)
30
+
| `Yellow (** Bit pattern: 010 *)
31
+
| `Green (** Bit pattern: 110 *)
32
+
| `Blue (** Bit pattern: 001 *)
33
+
| `Purple (** Bit pattern: 101 *)
34
+
| `Gray (** Bit pattern: 011 *)
35
+
]
35
36
36
37
let to_bits = function
37
-
| Red -> (false, false, false) (* 000 *)
38
-
| Orange -> (true, false, false) (* 100 *)
39
-
| Yellow -> (false, true, false) (* 010 *)
40
-
| Green -> (true, true, false) (* 110 *)
41
-
| Blue -> (false, false, true) (* 001 *)
42
-
| Purple -> (true, false, true) (* 101 *)
43
-
| Gray -> (false, true, true) (* 011 *)
38
+
| `Red -> (false, false, false) (* 000 *)
39
+
| `Orange -> (true, false, false) (* 100 *)
40
+
| `Yellow -> (false, true, false) (* 010 *)
41
+
| `Green -> (true, true, false) (* 110 *)
42
+
| `Blue -> (false, false, true) (* 001 *)
43
+
| `Purple -> (true, false, true) (* 101 *)
44
+
| `Gray -> (false, true, true) (* 011 *)
44
45
45
46
let of_bits = function
46
-
| (false, false, false) -> Some Red (* 000 *)
47
-
| (true, false, false) -> Some Orange (* 100 *)
48
-
| (false, true, false) -> Some Yellow (* 010 *)
49
-
| (true, true, false) -> Some Green (* 110 *)
50
-
| (false, false, true) -> Some Blue (* 001 *)
51
-
| (true, false, true) -> Some Purple (* 101 *)
52
-
| (false, true, true) -> Some Gray (* 011 *)
53
-
| (true, true, true) -> None (* 111 - undefined *)
47
+
| (false, false, false) -> Some `Red (* 000 *)
48
+
| (true, false, false) -> Some `Orange (* 100 *)
49
+
| (false, true, false) -> Some `Yellow (* 010 *)
50
+
| (true, true, false) -> Some `Green (* 110 *)
51
+
| (false, false, true) -> Some `Blue (* 001 *)
52
+
| (true, false, true) -> Some `Purple (* 101 *)
53
+
| (false, true, true) -> Some `Gray (* 011 *)
54
+
| (true, true, true) -> None (* 111 - undefined *)
54
55
55
56
let to_keywords = function
56
-
| Red -> []
57
-
| Orange -> [ `MailFlagBit0 ]
58
-
| Yellow -> [ `MailFlagBit1 ]
59
-
| Green -> [ `MailFlagBit0; `MailFlagBit1 ]
60
-
| Blue -> [ `MailFlagBit2 ]
61
-
| Purple -> [ `MailFlagBit0; `MailFlagBit2 ]
62
-
| Gray -> [ `MailFlagBit1; `MailFlagBit2 ]
57
+
| `Red -> []
58
+
| `Orange -> [ `MailFlagBit0 ]
59
+
| `Yellow -> [ `MailFlagBit1 ]
60
+
| `Green -> [ `MailFlagBit0; `MailFlagBit1 ]
61
+
| `Blue -> [ `MailFlagBit2 ]
62
+
| `Purple -> [ `MailFlagBit0; `MailFlagBit2 ]
63
+
| `Gray -> [ `MailFlagBit1; `MailFlagBit2 ]
63
64
64
65
let of_keywords (keywords : [ `MailFlagBit0 | `MailFlagBit1 | `MailFlagBit2 ] list) =
65
66
let has k = List.exists (fun x -> x = k) keywords in
···
79
80
of_bits (bit0, bit1, bit2)
80
81
81
82
let to_string = function
82
-
| Red -> "red"
83
-
| Orange -> "orange"
84
-
| Yellow -> "yellow"
85
-
| Green -> "green"
86
-
| Blue -> "blue"
87
-
| Purple -> "purple"
88
-
| Gray -> "gray"
83
+
| `Red -> "red"
84
+
| `Orange -> "orange"
85
+
| `Yellow -> "yellow"
86
+
| `Green -> "green"
87
+
| `Blue -> "blue"
88
+
| `Purple -> "purple"
89
+
| `Gray -> "gray"
89
90
90
91
let of_string s =
91
92
match String.lowercase_ascii s with
92
-
| "red" -> Some Red
93
-
| "orange" -> Some Orange
94
-
| "yellow" -> Some Yellow
95
-
| "green" -> Some Green
96
-
| "blue" -> Some Blue
97
-
| "purple" -> Some Purple
98
-
| "gray" | "grey" -> Some Gray
93
+
| "red" -> Some `Red
94
+
| "orange" -> Some `Orange
95
+
| "yellow" -> Some `Yellow
96
+
| "green" -> Some `Green
97
+
| "blue" -> Some `Blue
98
+
| "purple" -> Some `Purple
99
+
| "gray" | "grey" -> Some `Gray
99
100
| _ -> None
100
101
101
102
let pp ppf color = Format.pp_print_string ppf (to_string color)
+9
-8
mail-flag/lib/flag_color.mli
+9
-8
mail-flag/lib/flag_color.mli
···
27
27
- Gray: 011 (bits 1 and 2)
28
28
- 111: undefined (all bits set) *)
29
29
30
-
type t =
31
-
| Red (** Bit pattern: 000 *)
32
-
| Orange (** Bit pattern: 100 *)
33
-
| Yellow (** Bit pattern: 010 *)
34
-
| Green (** Bit pattern: 110 *)
35
-
| Blue (** Bit pattern: 001 *)
36
-
| Purple (** Bit pattern: 101 *)
37
-
| Gray (** Bit pattern: 011 *)
30
+
type t = [
31
+
| `Red (** Bit pattern: 000 *)
32
+
| `Orange (** Bit pattern: 100 *)
33
+
| `Yellow (** Bit pattern: 010 *)
34
+
| `Green (** Bit pattern: 110 *)
35
+
| `Blue (** Bit pattern: 001 *)
36
+
| `Purple (** Bit pattern: 101 *)
37
+
| `Gray (** Bit pattern: 011 *)
38
+
]
38
39
39
40
val to_bits : t -> bool * bool * bool
40
41
(** [to_bits color] converts [color] to a [(bit0, bit1, bit2)] tuple
-70
mail-flag/lib/imap_wire.ml
-70
mail-flag/lib/imap_wire.ml
···
1
-
(*---------------------------------------------------------------------------
2
-
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
-
SPDX-License-Identifier: ISC
4
-
---------------------------------------------------------------------------*)
5
-
6
-
(** IMAP Wire Format Conversion
7
-
8
-
Implementation of IMAP wire format conversion for message flags and
9
-
mailbox attributes. See {{:https://datatracker.ietf.org/doc/html/rfc9051#section-2.3.2}RFC 9051 Section 2.3.2}. *)
10
-
11
-
type flag =
12
-
| System of [ `Seen | `Answered | `Flagged | `Deleted | `Draft ]
13
-
| Keyword of Keyword.t
14
-
15
-
(** Check if a string represents an IMAP system flag.
16
-
Returns the system flag variant if recognized, None otherwise. *)
17
-
let parse_system_flag s =
18
-
let s = String.lowercase_ascii s in
19
-
(* Remove backslash prefix if present *)
20
-
let s = if String.length s > 0 && s.[0] = '\\' then
21
-
String.sub s 1 (String.length s - 1)
22
-
else s
23
-
in
24
-
match s with
25
-
| "seen" -> Some `Seen
26
-
| "answered" -> Some `Answered
27
-
| "flagged" -> Some `Flagged
28
-
| "deleted" -> Some `Deleted
29
-
| "draft" -> Some `Draft
30
-
| _ -> None
31
-
32
-
let flag_of_string s =
33
-
match parse_system_flag s with
34
-
| Some sys -> System sys
35
-
| None -> Keyword (Keyword.of_string s)
36
-
37
-
let flag_to_string = function
38
-
| System `Seen -> "\\Seen"
39
-
| System `Answered -> "\\Answered"
40
-
| System `Flagged -> "\\Flagged"
41
-
| System `Deleted -> "\\Deleted"
42
-
| System `Draft -> "\\Draft"
43
-
| Keyword k -> Keyword.to_imap_string k
44
-
45
-
let flags_of_keywords keywords =
46
-
List.map (fun k ->
47
-
match k with
48
-
| `Seen -> System `Seen
49
-
| `Answered -> System `Answered
50
-
| `Flagged -> System `Flagged
51
-
| `Deleted -> System `Deleted
52
-
| `Draft -> System `Draft
53
-
| other -> Keyword other
54
-
) keywords
55
-
56
-
let keywords_of_flags flags =
57
-
List.map (fun flag ->
58
-
match flag with
59
-
| System `Seen -> `Seen
60
-
| System `Answered -> `Answered
61
-
| System `Flagged -> `Flagged
62
-
| System `Deleted -> `Deleted
63
-
| System `Draft -> `Draft
64
-
| Keyword k -> k
65
-
) flags
66
-
67
-
let attr_of_string = Mailbox_attr.of_string
68
-
let attr_to_string = Mailbox_attr.to_string
69
-
70
-
let pp_flag ppf flag = Fmt.string ppf (flag_to_string flag)
-106
mail-flag/lib/imap_wire.mli
-106
mail-flag/lib/imap_wire.mli
···
1
-
(*---------------------------------------------------------------------------
2
-
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
-
SPDX-License-Identifier: ISC
4
-
---------------------------------------------------------------------------*)
5
-
6
-
(** IMAP Wire Format Conversion
7
-
8
-
Converts between mail-flag types and IMAP protocol format.
9
-
See {{:https://datatracker.ietf.org/doc/html/rfc9051#section-2.3.2}RFC 9051 Section 2.3.2}
10
-
for the flag format specification.
11
-
12
-
{2 IMAP Flag Format}
13
-
14
-
IMAP uses two types of message flags:
15
-
- {b System flags} prefixed with backslash: [\Seen], [\Answered], [\Flagged], [\Deleted], [\Draft]
16
-
- {b Keywords} prefixed with dollar sign: [$Forwarded], [$Junk], etc.
17
-
18
-
This module handles the conversion between the internal {!Keyword.t} representation
19
-
and the IMAP wire format. *)
20
-
21
-
(** {1 Message Flags} *)
22
-
23
-
(** IMAP message flag - either system flag or keyword.
24
-
25
-
System flags are the five flags defined in
26
-
{{:https://datatracker.ietf.org/doc/html/rfc9051#section-2.3.2}RFC 9051 Section 2.3.2}:
27
-
[\Seen], [\Answered], [\Flagged], [\Deleted], [\Draft].
28
-
29
-
Keywords are user-defined or server-defined flags that start with [$]. *)
30
-
type flag =
31
-
| System of [ `Seen | `Answered | `Flagged | `Deleted | `Draft ]
32
-
| Keyword of Keyword.t
33
-
34
-
val flag_of_string : string -> flag
35
-
(** [flag_of_string s] parses an IMAP flag string.
36
-
37
-
System flags are recognized with or without the backslash prefix,
38
-
case-insensitively. Keywords are parsed using {!Keyword.of_string}.
39
-
40
-
Examples:
41
-
- ["\\Seen"] -> [System `Seen]
42
-
- ["Seen"] -> [System `Seen]
43
-
- ["$forwarded"] -> [Keyword `Forwarded]
44
-
- ["$custom"] -> [Keyword (`Custom "custom")] *)
45
-
46
-
val flag_to_string : flag -> string
47
-
(** [flag_to_string flag] converts a flag to IMAP wire format.
48
-
49
-
System flags are returned with backslash prefix.
50
-
Keywords are returned with dollar sign prefix.
51
-
52
-
Examples:
53
-
- [System `Seen] -> ["\\Seen"]
54
-
- [Keyword `Forwarded] -> ["$Forwarded"] *)
55
-
56
-
val flags_of_keywords : Keyword.t list -> flag list
57
-
(** [flags_of_keywords keywords] converts a list of keywords to IMAP flags.
58
-
59
-
Keywords that correspond to IMAP system flags ([`Seen], [`Answered],
60
-
[`Flagged], [`Deleted], [`Draft]) are converted to [System] flags.
61
-
All other keywords remain as [Keyword] flags.
62
-
63
-
Example:
64
-
{[
65
-
flags_of_keywords [`Seen; `Forwarded; `Custom "label"]
66
-
(* returns [System `Seen; Keyword `Forwarded; Keyword (`Custom "label")] *)
67
-
]} *)
68
-
69
-
val keywords_of_flags : flag list -> Keyword.t list
70
-
(** [keywords_of_flags flags] converts IMAP flags to keywords.
71
-
72
-
System flags are converted to their corresponding standard keywords.
73
-
Keyword flags are returned as-is.
74
-
75
-
Example:
76
-
{[
77
-
keywords_of_flags [System `Seen; Keyword `Forwarded]
78
-
(* returns [`Seen; `Forwarded] *)
79
-
]} *)
80
-
81
-
(** {1 Mailbox Attributes} *)
82
-
83
-
val attr_of_string : string -> Mailbox_attr.t
84
-
(** [attr_of_string s] parses an IMAP mailbox attribute.
85
-
86
-
Delegates to {!Mailbox_attr.of_string}. The input may optionally
87
-
include the leading backslash. Parsing is case-insensitive.
88
-
89
-
Examples:
90
-
- ["\\Drafts"] -> [`Drafts]
91
-
- ["HasChildren"] -> [`HasChildren] *)
92
-
93
-
val attr_to_string : Mailbox_attr.t -> string
94
-
(** [attr_to_string attr] converts an attribute to IMAP wire format.
95
-
96
-
Delegates to {!Mailbox_attr.to_string}. Returns the attribute with
97
-
leading backslash prefix.
98
-
99
-
Examples:
100
-
- [`Drafts] -> ["\\Drafts"]
101
-
- [`HasChildren] -> ["\\HasChildren"] *)
102
-
103
-
(** {1 Pretty Printing} *)
104
-
105
-
val pp_flag : Format.formatter -> flag -> unit
106
-
(** [pp_flag ppf flag] pretty-prints a flag in IMAP wire format. *)
-34
mail-flag/lib/jmap_wire.ml
-34
mail-flag/lib/jmap_wire.ml
···
1
-
(*---------------------------------------------------------------------------
2
-
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
-
SPDX-License-Identifier: ISC
4
-
---------------------------------------------------------------------------*)
5
-
6
-
(** JMAP Wire Format Conversion
7
-
8
-
Implementation of JMAP wire format conversion for message keywords and
9
-
mailbox roles. See {{:https://datatracker.ietf.org/doc/html/rfc8621#section-4.1.1}RFC 8621 Section 4.1.1}. *)
10
-
11
-
let keywords_to_assoc keywords =
12
-
List.map (fun k -> (Keyword.to_string k, true)) keywords
13
-
14
-
let keywords_of_assoc assoc =
15
-
List.filter_map (fun (s, v) ->
16
-
if v then Some (Keyword.of_string s) else None
17
-
) assoc
18
-
19
-
let role_to_string = function
20
-
| `All -> "all"
21
-
| `Archive -> "archive"
22
-
| `Drafts -> "drafts"
23
-
| `Flagged -> "flagged"
24
-
| `Important -> "important"
25
-
| `Inbox -> "inbox"
26
-
| `Junk -> "junk"
27
-
| `Sent -> "sent"
28
-
| `Subscribed -> "subscribed"
29
-
| `Trash -> "trash"
30
-
| `Snoozed -> "snoozed"
31
-
| `Scheduled -> "scheduled"
32
-
| `Memos -> "memos"
33
-
34
-
let role_of_string = Mailbox_attr.of_jmap_role
-80
mail-flag/lib/jmap_wire.mli
-80
mail-flag/lib/jmap_wire.mli
···
1
-
(*---------------------------------------------------------------------------
2
-
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
-
SPDX-License-Identifier: ISC
4
-
---------------------------------------------------------------------------*)
5
-
6
-
(** JMAP Wire Format Conversion
7
-
8
-
Converts between mail-flag types and JMAP JSON format.
9
-
See {{:https://datatracker.ietf.org/doc/html/rfc8621#section-4.1.1}RFC 8621 Section 4.1.1}
10
-
for the keywords format specification.
11
-
12
-
{2 JMAP Keywords Format}
13
-
14
-
In JMAP, message keywords are represented as a JSON object where each key
15
-
is a keyword string (with [$] prefix for standard keywords) and the value
16
-
is always [true]:
17
-
18
-
{v
19
-
{
20
-
"$seen": true,
21
-
"$flagged": true,
22
-
"$forwarded": true,
23
-
"my-custom-label": true
24
-
}
25
-
v}
26
-
27
-
Keywords with [false] values are simply absent from the object. This module
28
-
provides conversion functions between the internal {!Keyword.t} list
29
-
representation and the association list format used for JSON encoding. *)
30
-
31
-
(** {1 Keywords as JSON} *)
32
-
33
-
val keywords_to_assoc : Keyword.t list -> (string * bool) list
34
-
(** [keywords_to_assoc keywords] converts a keyword list to JMAP keywords
35
-
object entries.
36
-
37
-
Each keyword is converted to a [(string, true)] pair using
38
-
{!Keyword.to_string} for the string representation.
39
-
40
-
Example:
41
-
{[
42
-
keywords_to_assoc [`Seen; `Flagged; `Custom "label"]
43
-
(* returns [("$seen", true); ("$flagged", true); ("label", true)] *)
44
-
]} *)
45
-
46
-
val keywords_of_assoc : (string * bool) list -> Keyword.t list
47
-
(** [keywords_of_assoc assoc] parses JMAP keywords from object entries.
48
-
49
-
Only entries with [true] value are included in the result.
50
-
Entries with [false] value are ignored (they represent the absence
51
-
of the keyword).
52
-
53
-
Example:
54
-
{[
55
-
keywords_of_assoc [("$seen", true); ("$draft", false); ("label", true)]
56
-
(* returns [`Seen; `Custom "label"] *)
57
-
]} *)
58
-
59
-
(** {1 Mailbox Roles} *)
60
-
61
-
val role_to_string : Mailbox_attr.special_use -> string
62
-
(** [role_to_string role] converts a special-use attribute to JMAP role string.
63
-
64
-
JMAP roles are lowercase strings without any prefix.
65
-
66
-
Examples:
67
-
- [`Drafts] -> ["drafts"]
68
-
- [`Inbox] -> ["inbox"]
69
-
- [`Junk] -> ["junk"] *)
70
-
71
-
val role_of_string : string -> Mailbox_attr.special_use option
72
-
(** [role_of_string s] parses a JMAP role string into a special-use attribute.
73
-
74
-
Returns [None] if the role string is not recognized. The input should
75
-
be lowercase as per JMAP conventions, but parsing is case-insensitive.
76
-
77
-
Examples:
78
-
- ["drafts"] -> [Some `Drafts]
79
-
- ["inbox"] -> [Some `Inbox]
80
-
- ["unknown"] -> [None] *)
+46
mail-flag/lib/mail_flag.ml
+46
mail-flag/lib/mail_flag.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Unified Mail Flags for IMAP and JMAP
7
+
8
+
This library provides a unified representation of message flags and mailbox
9
+
attributes that works across both IMAP (RFC 9051) and JMAP (RFC 8621) protocols.
10
+
11
+
The core types use polymorphic variants for type safety and extensibility. *)
12
+
13
+
(** {1 Module Aliases} *)
14
+
15
+
module Keyword = Keyword
16
+
module Mailbox_attr = Mailbox_attr
17
+
module Flag_color = Flag_color
18
+
19
+
(** {1 Type Aliases} *)
20
+
21
+
(** Standard message keywords that map to IMAP system flags. *)
22
+
type standard = Keyword.standard
23
+
24
+
(** Spam-related keywords for junk mail handling. *)
25
+
type spam = Keyword.spam
26
+
27
+
(** Extended keywords from draft-ietf-mailmaint. *)
28
+
type extended = Keyword.extended
29
+
30
+
(** Apple Mail flag color bit keywords. *)
31
+
type flag_bit = Keyword.flag_bit
32
+
33
+
(** Unified message keyword type combining all categories. *)
34
+
type keyword = Keyword.t
35
+
36
+
(** IMAP LIST response attributes. *)
37
+
type list_attr = Mailbox_attr.list_attr
38
+
39
+
(** Special-use mailbox roles. *)
40
+
type special_use = Mailbox_attr.special_use
41
+
42
+
(** Unified mailbox attribute type. *)
43
+
type mailbox_attr = Mailbox_attr.t
44
+
45
+
(** Apple Mail flag colors. *)
46
+
type flag_color = Flag_color.t
+286
mail-flag/lib/mail_flag.mli
+286
mail-flag/lib/mail_flag.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Unified Mail Flags for IMAP and JMAP
7
+
8
+
This library provides a unified representation of message flags and mailbox
9
+
attributes that works across both IMAP
10
+
({{:https://datatracker.ietf.org/doc/html/rfc9051}RFC 9051}) and JMAP
11
+
({{:https://datatracker.ietf.org/doc/html/rfc8621}RFC 8621}) protocols.
12
+
13
+
{2 Overview}
14
+
15
+
The library defines three main concepts:
16
+
17
+
- {!Keyword}: Message keywords/flags like [`Seen], [`Flagged], [`Junk]
18
+
- {!Mailbox_attr}: Mailbox attributes and special-use roles like [`Drafts], [`Inbox]
19
+
- {!Flag_color}: Apple Mail flag color encoding
20
+
21
+
All types use polymorphic variants for:
22
+
- Type safety: The compiler catches invalid flag combinations
23
+
- Extensibility: Custom flags via [`Custom] and [`Extension] variants
24
+
- Interoperability: Easy conversion between protocol representations
25
+
26
+
{2 Protocol Mapping}
27
+
28
+
{b IMAP system flags} ([\Seen], [\Answered], etc.) map to {!standard} keywords.
29
+
Use {!Keyword.to_imap_string} for wire format conversion.
30
+
31
+
{b JMAP keywords} ([$seen], [$answered], etc.) are the canonical form.
32
+
Use {!Keyword.to_string} for JMAP format.
33
+
34
+
{b Mailbox roles} work similarly with {!Mailbox_attr.to_string} for IMAP
35
+
and {!Mailbox_attr.to_jmap_role} for JMAP.
36
+
37
+
{2 References}
38
+
39
+
- {{:https://www.rfc-editor.org/rfc/rfc9051}RFC 9051} - IMAP4rev2
40
+
- {{:https://www.rfc-editor.org/rfc/rfc8621}RFC 8621} - JMAP for Mail
41
+
- {{:https://www.rfc-editor.org/rfc/rfc6154}RFC 6154} - IMAP Special-Use Mailboxes
42
+
- {{:https://datatracker.ietf.org/doc/draft-ietf-mailmaint-messageflag-mailboxattribute}
43
+
draft-ietf-mailmaint} - Extended keywords and attributes *)
44
+
45
+
(** {1 Modules} *)
46
+
47
+
(** Message keywords for both IMAP and JMAP.
48
+
49
+
See {!module:Keyword} for the full API. *)
50
+
module Keyword : sig
51
+
(** {1 Keyword Types} *)
52
+
53
+
(** Standard keywords per RFC 8621 Section 4.1.1 that map to IMAP system flags. *)
54
+
type standard = [
55
+
| `Seen (** Message has been read. Maps to IMAP [\Seen]. *)
56
+
| `Answered (** Message has been answered. Maps to IMAP [\Answered]. *)
57
+
| `Flagged (** Message is flagged/starred. Maps to IMAP [\Flagged]. *)
58
+
| `Draft (** Message is a draft. Maps to IMAP [\Draft]. *)
59
+
| `Deleted (** Message marked for deletion. Maps to IMAP [\Deleted]. *)
60
+
| `Forwarded (** Message has been forwarded. JMAP [$forwarded]. *)
61
+
]
62
+
63
+
(** Spam-related keywords for junk mail handling. *)
64
+
type spam = [
65
+
| `Phishing (** Message is a phishing attempt. *)
66
+
| `Junk (** Message is spam/junk. *)
67
+
| `NotJunk (** Message explicitly marked as not junk. *)
68
+
]
69
+
70
+
(** Extended keywords per draft-ietf-mailmaint. *)
71
+
type extended = [
72
+
| `HasAttachment (** Message has attachments. *)
73
+
| `HasNoAttachment (** Message has no attachments. *)
74
+
| `Memo (** Message is a memo. *)
75
+
| `HasMemo (** Message has an associated memo. *)
76
+
| `CanUnsubscribe (** Message has unsubscribe capability. *)
77
+
| `Unsubscribed (** User has unsubscribed from this sender. *)
78
+
| `Muted (** Thread is muted. *)
79
+
| `Followed (** Thread is followed. *)
80
+
| `AutoSent (** Message was sent automatically. *)
81
+
| `Imported (** Message was imported from another source. *)
82
+
| `IsTrusted (** Sender is trusted. *)
83
+
| `MaskedEmail (** Message was sent to a masked email address. *)
84
+
| `New (** Message is new (not yet processed). *)
85
+
| `Notify (** User should be notified about this message. *)
86
+
]
87
+
88
+
(** Apple Mail flag color bits. *)
89
+
type flag_bit = [
90
+
| `MailFlagBit0 (** Bit 0 of Apple Mail flag color encoding. *)
91
+
| `MailFlagBit1 (** Bit 1 of Apple Mail flag color encoding. *)
92
+
| `MailFlagBit2 (** Bit 2 of Apple Mail flag color encoding. *)
93
+
]
94
+
95
+
(** Unified keyword type combining all categories. *)
96
+
type t = [ standard | spam | extended | flag_bit | `Custom of string ]
97
+
98
+
(** {1 Conversion Functions} *)
99
+
100
+
val of_string : string -> t
101
+
(** [of_string s] parses a keyword string.
102
+
Handles JMAP format ([$seen]), IMAP format ([\Seen]), and bare format ([seen]).
103
+
Unknown keywords become [`Custom]. *)
104
+
105
+
val to_string : t -> string
106
+
(** [to_string k] converts a keyword to canonical JMAP format (e.g., ["$seen"]). *)
107
+
108
+
val to_imap_string : t -> string
109
+
(** [to_imap_string k] converts a keyword to IMAP wire format.
110
+
Standard keywords use backslash ([\Seen]), others use dollar ([$Forwarded]). *)
111
+
112
+
(** {1 Predicates} *)
113
+
114
+
val is_standard : t -> bool
115
+
(** [is_standard k] returns [true] if [k] maps to an IMAP system flag. *)
116
+
117
+
val is_mutually_exclusive : t -> t -> bool
118
+
(** [is_mutually_exclusive k1 k2] returns [true] if keywords cannot both be set.
119
+
Mutually exclusive pairs: HasAttachment/HasNoAttachment, Junk/NotJunk, Muted/Followed. *)
120
+
121
+
(** {1 Comparison and Pretty Printing} *)
122
+
123
+
val equal : t -> t -> bool
124
+
val compare : t -> t -> int
125
+
val pp : Format.formatter -> t -> unit
126
+
127
+
(** {1 Apple Mail Flag Colors} *)
128
+
129
+
type flag_color = [
130
+
| `Red | `Orange | `Yellow | `Green | `Blue | `Purple | `Gray
131
+
]
132
+
133
+
val flag_color_of_keywords : t list -> flag_color option
134
+
(** Extract Apple Mail flag color from keywords. Returns [None] for invalid encoding. *)
135
+
136
+
val flag_color_to_keywords : flag_color -> t list
137
+
(** Convert flag color to the keyword bits needed to represent it. *)
138
+
end
139
+
140
+
(** Mailbox attributes and special-use roles.
141
+
142
+
See {!module:Mailbox_attr} for the full API. *)
143
+
module Mailbox_attr : sig
144
+
(** {1 Attribute Types} *)
145
+
146
+
(** IMAP LIST response attributes per RFC 9051 Section 7.2.2. *)
147
+
type list_attr = [
148
+
| `Noinferiors (** No child mailboxes possible. *)
149
+
| `Noselect (** Mailbox cannot be selected. *)
150
+
| `Marked (** Mailbox has new messages. *)
151
+
| `Unmarked (** Mailbox has no new messages. *)
152
+
| `Subscribed (** Mailbox is subscribed. *)
153
+
| `HasChildren (** Mailbox has child mailboxes. *)
154
+
| `HasNoChildren (** Mailbox has no children. *)
155
+
| `NonExistent (** Mailbox does not exist. *)
156
+
| `Remote (** Mailbox is on a remote server. *)
157
+
]
158
+
159
+
(** Special-use mailbox roles per RFC 6154 and RFC 8621. *)
160
+
type special_use = [
161
+
| `All (** Virtual mailbox with all messages. *)
162
+
| `Archive (** Archive mailbox. *)
163
+
| `Drafts (** Drafts mailbox. *)
164
+
| `Flagged (** Virtual mailbox with flagged messages. *)
165
+
| `Important (** Important messages mailbox. *)
166
+
| `Inbox (** User's inbox. *)
167
+
| `Junk (** Spam/junk mailbox. *)
168
+
| `Sent (** Sent messages mailbox. *)
169
+
| `Subscribed (** JMAP virtual subscribed mailbox. *)
170
+
| `Trash (** Trash/deleted messages mailbox. *)
171
+
| `Snoozed (** Snoozed messages (draft-ietf-mailmaint). *)
172
+
| `Scheduled (** Scheduled to send (draft-ietf-mailmaint). *)
173
+
| `Memos (** Memo messages (draft-ietf-mailmaint). *)
174
+
]
175
+
176
+
(** Unified mailbox attribute type. *)
177
+
type t = [ list_attr | special_use | `Extension of string ]
178
+
179
+
(** {1 Conversion Functions} *)
180
+
181
+
val of_string : string -> t
182
+
(** [of_string s] parses a mailbox attribute from IMAP wire format.
183
+
Unknown attributes become [`Extension]. *)
184
+
185
+
val to_string : t -> string
186
+
(** [to_string attr] converts to IMAP wire format with backslash prefix. *)
187
+
188
+
val to_jmap_role : t -> string option
189
+
(** [to_jmap_role attr] converts to JMAP role string (lowercase).
190
+
Returns [None] for LIST attributes without JMAP equivalents. *)
191
+
192
+
val of_jmap_role : string -> special_use option
193
+
(** [of_jmap_role s] parses a JMAP role string into a special-use attribute. *)
194
+
195
+
(** {1 Predicates} *)
196
+
197
+
val is_special_use : t -> bool
198
+
(** [is_special_use attr] returns [true] if attribute is a special-use role. *)
199
+
200
+
val is_selectable : t -> bool
201
+
(** [is_selectable attr] returns [false] for Noselect and NonExistent. *)
202
+
203
+
(** {1 Pretty Printing} *)
204
+
205
+
val pp : Format.formatter -> t -> unit
206
+
end
207
+
208
+
(** Apple Mail flag colors.
209
+
210
+
See {!module:Flag_color} for the full API. *)
211
+
module Flag_color : sig
212
+
(** Flag colors encoded as 3-bit values using [$MailFlagBit*] keywords. *)
213
+
type t = [
214
+
| `Red (** Bit pattern: 000 *)
215
+
| `Orange (** Bit pattern: 100 *)
216
+
| `Yellow (** Bit pattern: 010 *)
217
+
| `Green (** Bit pattern: 110 *)
218
+
| `Blue (** Bit pattern: 001 *)
219
+
| `Purple (** Bit pattern: 101 *)
220
+
| `Gray (** Bit pattern: 011 *)
221
+
]
222
+
223
+
(** {1 Bit Pattern Conversion} *)
224
+
225
+
val to_bits : t -> bool * bool * bool
226
+
(** [to_bits color] returns [(bit0, bit1, bit2)] tuple. *)
227
+
228
+
val of_bits : bool * bool * bool -> t option
229
+
(** [of_bits (b0, b1, b2)] converts bit pattern to color.
230
+
Returns [None] for undefined pattern (true, true, true). *)
231
+
232
+
(** {1 Keyword Conversion} *)
233
+
234
+
val to_keywords : t -> [ `MailFlagBit0 | `MailFlagBit1 | `MailFlagBit2 ] list
235
+
(** [to_keywords color] returns keyword bits for the color. *)
236
+
237
+
val of_keywords : [ `MailFlagBit0 | `MailFlagBit1 | `MailFlagBit2 ] list -> t option
238
+
(** [of_keywords kws] extracts color from keyword bits.
239
+
Returns [None] if no bits set (ambiguous) or pattern is 111 (undefined). *)
240
+
241
+
val of_keywords_default_red : [ `MailFlagBit0 | `MailFlagBit1 | `MailFlagBit2 ] list -> t option
242
+
(** Like {!of_keywords} but treats empty list as Red. *)
243
+
244
+
(** {1 String Conversion} *)
245
+
246
+
val to_string : t -> string
247
+
(** [to_string color] returns lowercase color name. *)
248
+
249
+
val of_string : string -> t option
250
+
(** [of_string s] parses color name (case-insensitive, accepts "grey"). *)
251
+
252
+
(** {1 Pretty Printing} *)
253
+
254
+
val pp : Format.formatter -> t -> unit
255
+
end
256
+
257
+
(** {1 Type Aliases}
258
+
259
+
Convenient type aliases for use without module qualification. *)
260
+
261
+
(** Standard message keywords that map to IMAP system flags. *)
262
+
type standard = Keyword.standard
263
+
264
+
(** Spam-related keywords. *)
265
+
type spam = Keyword.spam
266
+
267
+
(** Extended keywords from draft-ietf-mailmaint. *)
268
+
type extended = Keyword.extended
269
+
270
+
(** Apple Mail flag color bit keywords. *)
271
+
type flag_bit = Keyword.flag_bit
272
+
273
+
(** Unified message keyword type. *)
274
+
type keyword = Keyword.t
275
+
276
+
(** IMAP LIST response attributes. *)
277
+
type list_attr = Mailbox_attr.list_attr
278
+
279
+
(** Special-use mailbox roles. *)
280
+
type special_use = Mailbox_attr.special_use
281
+
282
+
(** Unified mailbox attribute type. *)
283
+
type mailbox_attr = Mailbox_attr.t
284
+
285
+
(** Apple Mail flag colors. *)
286
+
type flag_color = Flag_color.t
-4
mail-flag/test/dune
-4
mail-flag/test/dune
+77
-77
mail-flag/test/test_flag_color.ml
+77
-77
mail-flag/test/test_flag_color.ml
···
12
12
13
13
let test_to_bits () =
14
14
(* Test color to bit pattern conversion *)
15
-
Alcotest.(check (triple bool bool bool)) "red" (false, false, false) (Flag_color.to_bits Red);
16
-
Alcotest.(check (triple bool bool bool)) "orange" (true, false, false) (Flag_color.to_bits Orange);
17
-
Alcotest.(check (triple bool bool bool)) "yellow" (false, true, false) (Flag_color.to_bits Yellow);
18
-
Alcotest.(check (triple bool bool bool)) "green" (true, true, false) (Flag_color.to_bits Green);
19
-
Alcotest.(check (triple bool bool bool)) "blue" (false, false, true) (Flag_color.to_bits Blue);
20
-
Alcotest.(check (triple bool bool bool)) "purple" (true, false, true) (Flag_color.to_bits Purple);
21
-
Alcotest.(check (triple bool bool bool)) "gray" (false, true, true) (Flag_color.to_bits Gray)
15
+
Alcotest.(check (triple bool bool bool)) "red" (false, false, false) (Flag_color.to_bits `Red);
16
+
Alcotest.(check (triple bool bool bool)) "orange" (true, false, false) (Flag_color.to_bits `Orange);
17
+
Alcotest.(check (triple bool bool bool)) "yellow" (false, true, false) (Flag_color.to_bits `Yellow);
18
+
Alcotest.(check (triple bool bool bool)) "green" (true, true, false) (Flag_color.to_bits `Green);
19
+
Alcotest.(check (triple bool bool bool)) "blue" (false, false, true) (Flag_color.to_bits `Blue);
20
+
Alcotest.(check (triple bool bool bool)) "purple" (true, false, true) (Flag_color.to_bits `Purple);
21
+
Alcotest.(check (triple bool bool bool)) "gray" (false, true, true) (Flag_color.to_bits `Gray)
22
22
23
23
let test_of_bits () =
24
24
(* Test bit pattern to color conversion *)
25
-
Alcotest.(check (option color_testable)) "000 = red" (Some Red) (Flag_color.of_bits (false, false, false));
26
-
Alcotest.(check (option color_testable)) "100 = orange" (Some Orange) (Flag_color.of_bits (true, false, false));
27
-
Alcotest.(check (option color_testable)) "010 = yellow" (Some Yellow) (Flag_color.of_bits (false, true, false));
28
-
Alcotest.(check (option color_testable)) "110 = green" (Some Green) (Flag_color.of_bits (true, true, false));
29
-
Alcotest.(check (option color_testable)) "001 = blue" (Some Blue) (Flag_color.of_bits (false, false, true));
30
-
Alcotest.(check (option color_testable)) "101 = purple" (Some Purple) (Flag_color.of_bits (true, false, true));
31
-
Alcotest.(check (option color_testable)) "011 = gray" (Some Gray) (Flag_color.of_bits (false, true, true));
25
+
Alcotest.(check (option color_testable)) "000 = red" (Some `Red) (Flag_color.of_bits (false, false, false));
26
+
Alcotest.(check (option color_testable)) "100 = orange" (Some `Orange) (Flag_color.of_bits (true, false, false));
27
+
Alcotest.(check (option color_testable)) "010 = yellow" (Some `Yellow) (Flag_color.of_bits (false, true, false));
28
+
Alcotest.(check (option color_testable)) "110 = green" (Some `Green) (Flag_color.of_bits (true, true, false));
29
+
Alcotest.(check (option color_testable)) "001 = blue" (Some `Blue) (Flag_color.of_bits (false, false, true));
30
+
Alcotest.(check (option color_testable)) "101 = purple" (Some `Purple) (Flag_color.of_bits (true, false, true));
31
+
Alcotest.(check (option color_testable)) "011 = gray" (Some `Gray) (Flag_color.of_bits (false, true, true));
32
32
(* 111 is undefined *)
33
33
Alcotest.(check (option color_testable)) "111 = undefined" None (Flag_color.of_bits (true, true, true))
34
34
···
38
38
let bits = Flag_color.to_bits c in
39
39
Alcotest.(check (option color_testable)) (Flag_color.to_string c) (Some c) (Flag_color.of_bits bits)
40
40
in
41
-
test_color Red;
42
-
test_color Orange;
43
-
test_color Yellow;
44
-
test_color Green;
45
-
test_color Blue;
46
-
test_color Purple;
47
-
test_color Gray
41
+
test_color `Red;
42
+
test_color `Orange;
43
+
test_color `Yellow;
44
+
test_color `Green;
45
+
test_color `Blue;
46
+
test_color `Purple;
47
+
test_color `Gray
48
48
49
49
let test_to_keywords () =
50
50
(* Test color to keyword list conversion *)
51
-
Alcotest.(check int) "red = 0 keywords" 0 (List.length (Flag_color.to_keywords Red));
52
-
Alcotest.(check int) "orange = 1 keyword" 1 (List.length (Flag_color.to_keywords Orange));
53
-
Alcotest.(check int) "yellow = 1 keyword" 1 (List.length (Flag_color.to_keywords Yellow));
54
-
Alcotest.(check int) "green = 2 keywords" 2 (List.length (Flag_color.to_keywords Green));
55
-
Alcotest.(check int) "blue = 1 keyword" 1 (List.length (Flag_color.to_keywords Blue));
56
-
Alcotest.(check int) "purple = 2 keywords" 2 (List.length (Flag_color.to_keywords Purple));
57
-
Alcotest.(check int) "gray = 2 keywords" 2 (List.length (Flag_color.to_keywords Gray));
51
+
Alcotest.(check int) "red = 0 keywords" 0 (List.length (Flag_color.to_keywords `Red));
52
+
Alcotest.(check int) "orange = 1 keyword" 1 (List.length (Flag_color.to_keywords `Orange));
53
+
Alcotest.(check int) "yellow = 1 keyword" 1 (List.length (Flag_color.to_keywords `Yellow));
54
+
Alcotest.(check int) "green = 2 keywords" 2 (List.length (Flag_color.to_keywords `Green));
55
+
Alcotest.(check int) "blue = 1 keyword" 1 (List.length (Flag_color.to_keywords `Blue));
56
+
Alcotest.(check int) "purple = 2 keywords" 2 (List.length (Flag_color.to_keywords `Purple));
57
+
Alcotest.(check int) "gray = 2 keywords" 2 (List.length (Flag_color.to_keywords `Gray));
58
58
(* Check specific keywords *)
59
-
Alcotest.(check bool) "orange has bit0" true (List.mem `MailFlagBit0 (Flag_color.to_keywords Orange));
60
-
Alcotest.(check bool) "yellow has bit1" true (List.mem `MailFlagBit1 (Flag_color.to_keywords Yellow));
61
-
Alcotest.(check bool) "blue has bit2" true (List.mem `MailFlagBit2 (Flag_color.to_keywords Blue));
62
-
Alcotest.(check bool) "green has bit0" true (List.mem `MailFlagBit0 (Flag_color.to_keywords Green));
63
-
Alcotest.(check bool) "green has bit1" true (List.mem `MailFlagBit1 (Flag_color.to_keywords Green));
64
-
Alcotest.(check bool) "purple has bit0" true (List.mem `MailFlagBit0 (Flag_color.to_keywords Purple));
65
-
Alcotest.(check bool) "purple has bit2" true (List.mem `MailFlagBit2 (Flag_color.to_keywords Purple));
66
-
Alcotest.(check bool) "gray has bit1" true (List.mem `MailFlagBit1 (Flag_color.to_keywords Gray));
67
-
Alcotest.(check bool) "gray has bit2" true (List.mem `MailFlagBit2 (Flag_color.to_keywords Gray))
59
+
Alcotest.(check bool) "orange has bit0" true (List.mem `MailFlagBit0 (Flag_color.to_keywords `Orange));
60
+
Alcotest.(check bool) "yellow has bit1" true (List.mem `MailFlagBit1 (Flag_color.to_keywords `Yellow));
61
+
Alcotest.(check bool) "blue has bit2" true (List.mem `MailFlagBit2 (Flag_color.to_keywords `Blue));
62
+
Alcotest.(check bool) "green has bit0" true (List.mem `MailFlagBit0 (Flag_color.to_keywords `Green));
63
+
Alcotest.(check bool) "green has bit1" true (List.mem `MailFlagBit1 (Flag_color.to_keywords `Green));
64
+
Alcotest.(check bool) "purple has bit0" true (List.mem `MailFlagBit0 (Flag_color.to_keywords `Purple));
65
+
Alcotest.(check bool) "purple has bit2" true (List.mem `MailFlagBit2 (Flag_color.to_keywords `Purple));
66
+
Alcotest.(check bool) "gray has bit1" true (List.mem `MailFlagBit1 (Flag_color.to_keywords `Gray));
67
+
Alcotest.(check bool) "gray has bit2" true (List.mem `MailFlagBit2 (Flag_color.to_keywords `Gray))
68
68
69
69
let test_of_keywords () =
70
70
(* Test keyword list to color conversion *)
71
71
(* Empty list returns None (ambiguous: no color vs Red) *)
72
72
Alcotest.(check (option color_testable)) "empty = None" None (Flag_color.of_keywords []);
73
-
Alcotest.(check (option color_testable)) "bit0 = orange" (Some Orange) (Flag_color.of_keywords [`MailFlagBit0]);
74
-
Alcotest.(check (option color_testable)) "bit1 = yellow" (Some Yellow) (Flag_color.of_keywords [`MailFlagBit1]);
75
-
Alcotest.(check (option color_testable)) "bit2 = blue" (Some Blue) (Flag_color.of_keywords [`MailFlagBit2]);
76
-
Alcotest.(check (option color_testable)) "bits 0,1 = green" (Some Green) (Flag_color.of_keywords [`MailFlagBit0; `MailFlagBit1]);
77
-
Alcotest.(check (option color_testable)) "bits 0,2 = purple" (Some Purple) (Flag_color.of_keywords [`MailFlagBit0; `MailFlagBit2]);
78
-
Alcotest.(check (option color_testable)) "bits 1,2 = gray" (Some Gray) (Flag_color.of_keywords [`MailFlagBit1; `MailFlagBit2]);
73
+
Alcotest.(check (option color_testable)) "bit0 = orange" (Some `Orange) (Flag_color.of_keywords [`MailFlagBit0]);
74
+
Alcotest.(check (option color_testable)) "bit1 = yellow" (Some `Yellow) (Flag_color.of_keywords [`MailFlagBit1]);
75
+
Alcotest.(check (option color_testable)) "bit2 = blue" (Some `Blue) (Flag_color.of_keywords [`MailFlagBit2]);
76
+
Alcotest.(check (option color_testable)) "bits 0,1 = green" (Some `Green) (Flag_color.of_keywords [`MailFlagBit0; `MailFlagBit1]);
77
+
Alcotest.(check (option color_testable)) "bits 0,2 = purple" (Some `Purple) (Flag_color.of_keywords [`MailFlagBit0; `MailFlagBit2]);
78
+
Alcotest.(check (option color_testable)) "bits 1,2 = gray" (Some `Gray) (Flag_color.of_keywords [`MailFlagBit1; `MailFlagBit2]);
79
79
(* All bits = undefined *)
80
80
Alcotest.(check (option color_testable)) "all bits = undefined" None
81
81
(Flag_color.of_keywords [`MailFlagBit0; `MailFlagBit1; `MailFlagBit2])
82
82
83
83
let test_of_keywords_default_red () =
84
84
(* Test keyword list to color with Red default for empty list *)
85
-
Alcotest.(check (option color_testable)) "empty = red" (Some Red) (Flag_color.of_keywords_default_red []);
86
-
Alcotest.(check (option color_testable)) "bit0 = orange" (Some Orange) (Flag_color.of_keywords_default_red [`MailFlagBit0]);
87
-
Alcotest.(check (option color_testable)) "bits 0,1 = green" (Some Green)
85
+
Alcotest.(check (option color_testable)) "empty = red" (Some `Red) (Flag_color.of_keywords_default_red []);
86
+
Alcotest.(check (option color_testable)) "bit0 = orange" (Some `Orange) (Flag_color.of_keywords_default_red [`MailFlagBit0]);
87
+
Alcotest.(check (option color_testable)) "bits 0,1 = green" (Some `Green)
88
88
(Flag_color.of_keywords_default_red [`MailFlagBit0; `MailFlagBit1]);
89
89
(* All bits still undefined *)
90
90
Alcotest.(check (option color_testable)) "all bits = undefined" None
···
96
96
let kws = Flag_color.to_keywords c in
97
97
Alcotest.(check (option color_testable)) (Flag_color.to_string c) (Some c) (Flag_color.of_keywords_default_red kws)
98
98
in
99
-
test_color Red;
100
-
test_color Orange;
101
-
test_color Yellow;
102
-
test_color Green;
103
-
test_color Blue;
104
-
test_color Purple;
105
-
test_color Gray
99
+
test_color `Red;
100
+
test_color `Orange;
101
+
test_color `Yellow;
102
+
test_color `Green;
103
+
test_color `Blue;
104
+
test_color `Purple;
105
+
test_color `Gray
106
106
107
107
let test_to_string () =
108
108
(* Test color to string conversion *)
109
-
Alcotest.(check string) "red" "red" (Flag_color.to_string Red);
110
-
Alcotest.(check string) "orange" "orange" (Flag_color.to_string Orange);
111
-
Alcotest.(check string) "yellow" "yellow" (Flag_color.to_string Yellow);
112
-
Alcotest.(check string) "green" "green" (Flag_color.to_string Green);
113
-
Alcotest.(check string) "blue" "blue" (Flag_color.to_string Blue);
114
-
Alcotest.(check string) "purple" "purple" (Flag_color.to_string Purple);
115
-
Alcotest.(check string) "gray" "gray" (Flag_color.to_string Gray)
109
+
Alcotest.(check string) "red" "red" (Flag_color.to_string `Red);
110
+
Alcotest.(check string) "orange" "orange" (Flag_color.to_string `Orange);
111
+
Alcotest.(check string) "yellow" "yellow" (Flag_color.to_string `Yellow);
112
+
Alcotest.(check string) "green" "green" (Flag_color.to_string `Green);
113
+
Alcotest.(check string) "blue" "blue" (Flag_color.to_string `Blue);
114
+
Alcotest.(check string) "purple" "purple" (Flag_color.to_string `Purple);
115
+
Alcotest.(check string) "gray" "gray" (Flag_color.to_string `Gray)
116
116
117
117
let test_of_string () =
118
118
(* Test string to color conversion *)
119
-
Alcotest.(check (option color_testable)) "red" (Some Red) (Flag_color.of_string "red");
120
-
Alcotest.(check (option color_testable)) "orange" (Some Orange) (Flag_color.of_string "orange");
121
-
Alcotest.(check (option color_testable)) "yellow" (Some Yellow) (Flag_color.of_string "yellow");
122
-
Alcotest.(check (option color_testable)) "green" (Some Green) (Flag_color.of_string "green");
123
-
Alcotest.(check (option color_testable)) "blue" (Some Blue) (Flag_color.of_string "blue");
124
-
Alcotest.(check (option color_testable)) "purple" (Some Purple) (Flag_color.of_string "purple");
125
-
Alcotest.(check (option color_testable)) "gray" (Some Gray) (Flag_color.of_string "gray");
126
-
Alcotest.(check (option color_testable)) "grey" (Some Gray) (Flag_color.of_string "grey");
119
+
Alcotest.(check (option color_testable)) "red" (Some `Red) (Flag_color.of_string "red");
120
+
Alcotest.(check (option color_testable)) "orange" (Some `Orange) (Flag_color.of_string "orange");
121
+
Alcotest.(check (option color_testable)) "yellow" (Some `Yellow) (Flag_color.of_string "yellow");
122
+
Alcotest.(check (option color_testable)) "green" (Some `Green) (Flag_color.of_string "green");
123
+
Alcotest.(check (option color_testable)) "blue" (Some `Blue) (Flag_color.of_string "blue");
124
+
Alcotest.(check (option color_testable)) "purple" (Some `Purple) (Flag_color.of_string "purple");
125
+
Alcotest.(check (option color_testable)) "gray" (Some `Gray) (Flag_color.of_string "gray");
126
+
Alcotest.(check (option color_testable)) "grey" (Some `Gray) (Flag_color.of_string "grey");
127
127
(* Case insensitive *)
128
-
Alcotest.(check (option color_testable)) "RED" (Some Red) (Flag_color.of_string "RED");
129
-
Alcotest.(check (option color_testable)) "Orange" (Some Orange) (Flag_color.of_string "Orange");
128
+
Alcotest.(check (option color_testable)) "RED" (Some `Red) (Flag_color.of_string "RED");
129
+
Alcotest.(check (option color_testable)) "Orange" (Some `Orange) (Flag_color.of_string "Orange");
130
130
(* Unknown *)
131
131
Alcotest.(check (option color_testable)) "unknown" None (Flag_color.of_string "unknown")
132
132
···
136
136
let s = Flag_color.to_string c in
137
137
Alcotest.(check (option color_testable)) s (Some c) (Flag_color.of_string s)
138
138
in
139
-
test_color Red;
140
-
test_color Orange;
141
-
test_color Yellow;
142
-
test_color Green;
143
-
test_color Blue;
144
-
test_color Purple;
145
-
test_color Gray
139
+
test_color `Red;
140
+
test_color `Orange;
141
+
test_color `Yellow;
142
+
test_color `Green;
143
+
test_color `Blue;
144
+
test_color `Purple;
145
+
test_color `Gray
146
146
147
147
let () =
148
148
Alcotest.run "Flag_color" [
-190
mail-flag/test/test_wire.ml
-190
mail-flag/test/test_wire.ml
···
1
-
(*---------------------------------------------------------------------------
2
-
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
-
SPDX-License-Identifier: ISC
4
-
---------------------------------------------------------------------------*)
5
-
6
-
(** Tests for the Imap_wire and Jmap_wire modules. *)
7
-
8
-
open Mail_flag
9
-
10
-
let keyword_testable =
11
-
Alcotest.testable Keyword.pp Keyword.equal
12
-
13
-
let flag_testable =
14
-
Alcotest.testable Imap_wire.pp_flag (fun a b ->
15
-
Imap_wire.flag_to_string a = Imap_wire.flag_to_string b)
16
-
17
-
(* IMAP Wire Tests *)
18
-
19
-
let test_imap_flag_of_string_system () =
20
-
(* Test parsing of IMAP system flags *)
21
-
Alcotest.(check flag_testable) "\\Seen" (Imap_wire.System `Seen) (Imap_wire.flag_of_string "\\Seen");
22
-
Alcotest.(check flag_testable) "\\Answered" (Imap_wire.System `Answered) (Imap_wire.flag_of_string "\\Answered");
23
-
Alcotest.(check flag_testable) "\\Flagged" (Imap_wire.System `Flagged) (Imap_wire.flag_of_string "\\Flagged");
24
-
Alcotest.(check flag_testable) "\\Deleted" (Imap_wire.System `Deleted) (Imap_wire.flag_of_string "\\Deleted");
25
-
Alcotest.(check flag_testable) "\\Draft" (Imap_wire.System `Draft) (Imap_wire.flag_of_string "\\Draft")
26
-
27
-
let test_imap_flag_of_string_system_no_backslash () =
28
-
(* Test parsing of system flags without backslash *)
29
-
Alcotest.(check flag_testable) "Seen" (Imap_wire.System `Seen) (Imap_wire.flag_of_string "Seen");
30
-
Alcotest.(check flag_testable) "answered" (Imap_wire.System `Answered) (Imap_wire.flag_of_string "answered")
31
-
32
-
let test_imap_flag_of_string_keyword () =
33
-
(* Test parsing of IMAP keywords *)
34
-
Alcotest.(check flag_testable) "$forwarded" (Imap_wire.Keyword `Forwarded) (Imap_wire.flag_of_string "$forwarded");
35
-
Alcotest.(check flag_testable) "$junk" (Imap_wire.Keyword `Junk) (Imap_wire.flag_of_string "$junk");
36
-
Alcotest.(check flag_testable) "$MailFlagBit0" (Imap_wire.Keyword `MailFlagBit0) (Imap_wire.flag_of_string "$MailFlagBit0")
37
-
38
-
let test_imap_flag_of_string_custom () =
39
-
(* Test parsing of custom keywords *)
40
-
Alcotest.(check flag_testable) "custom" (Imap_wire.Keyword (`Custom "custom")) (Imap_wire.flag_of_string "custom")
41
-
42
-
let test_imap_flag_to_string () =
43
-
(* Test conversion to IMAP wire format *)
44
-
Alcotest.(check string) "\\Seen" "\\Seen" (Imap_wire.flag_to_string (System `Seen));
45
-
Alcotest.(check string) "\\Answered" "\\Answered" (Imap_wire.flag_to_string (System `Answered));
46
-
Alcotest.(check string) "\\Flagged" "\\Flagged" (Imap_wire.flag_to_string (System `Flagged));
47
-
Alcotest.(check string) "\\Deleted" "\\Deleted" (Imap_wire.flag_to_string (System `Deleted));
48
-
Alcotest.(check string) "\\Draft" "\\Draft" (Imap_wire.flag_to_string (System `Draft));
49
-
Alcotest.(check string) "$Forwarded" "$Forwarded" (Imap_wire.flag_to_string (Keyword `Forwarded));
50
-
Alcotest.(check string) "$Junk" "$Junk" (Imap_wire.flag_to_string (Keyword `Junk))
51
-
52
-
let test_imap_flags_of_keywords () =
53
-
(* Test conversion from keyword list to flag list *)
54
-
let flags = Imap_wire.flags_of_keywords [`Seen; `Forwarded; `Custom "label"] in
55
-
Alcotest.(check int) "3 flags" 3 (List.length flags);
56
-
Alcotest.(check flag_testable) "first is system" (System `Seen) (List.nth flags 0);
57
-
Alcotest.(check flag_testable) "second is keyword" (Keyword `Forwarded) (List.nth flags 1);
58
-
Alcotest.(check flag_testable) "third is custom" (Keyword (`Custom "label")) (List.nth flags 2)
59
-
60
-
let test_imap_keywords_of_flags () =
61
-
(* Test conversion from flag list to keyword list *)
62
-
let keywords = Imap_wire.keywords_of_flags [System `Seen; Keyword `Forwarded] in
63
-
Alcotest.(check int) "2 keywords" 2 (List.length keywords);
64
-
Alcotest.(check keyword_testable) "first" `Seen (List.nth keywords 0);
65
-
Alcotest.(check keyword_testable) "second" `Forwarded (List.nth keywords 1)
66
-
67
-
let test_imap_attr_of_string () =
68
-
(* Test mailbox attribute parsing *)
69
-
let attr = Imap_wire.attr_of_string "\\Drafts" in
70
-
Alcotest.(check string) "\\Drafts" "\\Drafts" (Imap_wire.attr_to_string attr)
71
-
72
-
let test_imap_attr_to_string () =
73
-
(* Test mailbox attribute to string *)
74
-
Alcotest.(check string) "\\Drafts" "\\Drafts" (Imap_wire.attr_to_string `Drafts);
75
-
Alcotest.(check string) "\\HasChildren" "\\HasChildren" (Imap_wire.attr_to_string `HasChildren)
76
-
77
-
(* JMAP Wire Tests *)
78
-
79
-
let test_jmap_keywords_to_assoc () =
80
-
(* Test conversion to JMAP keywords object *)
81
-
let kws = [`Seen; `Flagged; `Custom "label"] in
82
-
let assoc = Jmap_wire.keywords_to_assoc kws in
83
-
Alcotest.(check int) "3 entries" 3 (List.length assoc);
84
-
(* Check that all values are true *)
85
-
List.iter (fun (_, v) ->
86
-
Alcotest.(check bool) "value is true" true v
87
-
) assoc;
88
-
(* Check specific keys *)
89
-
Alcotest.(check bool) "$seen present" true (List.mem_assoc "$seen" assoc);
90
-
Alcotest.(check bool) "$flagged present" true (List.mem_assoc "$flagged" assoc);
91
-
Alcotest.(check bool) "label present" true (List.mem_assoc "label" assoc)
92
-
93
-
let test_jmap_keywords_of_assoc () =
94
-
(* Test conversion from JMAP keywords object *)
95
-
let assoc = [("$seen", true); ("$draft", false); ("label", true)] in
96
-
let keywords = Jmap_wire.keywords_of_assoc assoc in
97
-
(* Only entries with true value are included *)
98
-
Alcotest.(check int) "2 keywords" 2 (List.length keywords);
99
-
Alcotest.(check bool) "seen present" true (List.exists (Keyword.equal `Seen) keywords);
100
-
Alcotest.(check bool) "draft not present" false (List.exists (Keyword.equal `Draft) keywords);
101
-
Alcotest.(check bool) "custom present" true (List.exists (Keyword.equal (`Custom "label")) keywords)
102
-
103
-
let test_jmap_keywords_roundtrip () =
104
-
(* Test roundtrip: keywords -> assoc -> keywords *)
105
-
let original = [`Seen; `Flagged; `Forwarded] in
106
-
let assoc = Jmap_wire.keywords_to_assoc original in
107
-
let result = Jmap_wire.keywords_of_assoc assoc in
108
-
Alcotest.(check int) "same length" (List.length original) (List.length result);
109
-
List.iter (fun k ->
110
-
Alcotest.(check bool) (Keyword.to_string k) true (List.exists (Keyword.equal k) result)
111
-
) original
112
-
113
-
let test_jmap_role_to_string () =
114
-
(* Test role to string conversion *)
115
-
Alcotest.(check string) "drafts" "drafts" (Jmap_wire.role_to_string `Drafts);
116
-
Alcotest.(check string) "sent" "sent" (Jmap_wire.role_to_string `Sent);
117
-
Alcotest.(check string) "trash" "trash" (Jmap_wire.role_to_string `Trash);
118
-
Alcotest.(check string) "junk" "junk" (Jmap_wire.role_to_string `Junk);
119
-
Alcotest.(check string) "inbox" "inbox" (Jmap_wire.role_to_string `Inbox);
120
-
Alcotest.(check string) "archive" "archive" (Jmap_wire.role_to_string `Archive);
121
-
Alcotest.(check string) "all" "all" (Jmap_wire.role_to_string `All);
122
-
Alcotest.(check string) "flagged" "flagged" (Jmap_wire.role_to_string `Flagged);
123
-
Alcotest.(check string) "important" "important" (Jmap_wire.role_to_string `Important);
124
-
Alcotest.(check string) "subscribed" "subscribed" (Jmap_wire.role_to_string `Subscribed);
125
-
Alcotest.(check string) "snoozed" "snoozed" (Jmap_wire.role_to_string `Snoozed);
126
-
Alcotest.(check string) "scheduled" "scheduled" (Jmap_wire.role_to_string `Scheduled);
127
-
Alcotest.(check string) "memos" "memos" (Jmap_wire.role_to_string `Memos)
128
-
129
-
let pp_special_use ppf (su : Mailbox_attr.special_use) =
130
-
Mailbox_attr.pp ppf (su :> Mailbox_attr.t)
131
-
132
-
let special_use_testable : Mailbox_attr.special_use Alcotest.testable =
133
-
Alcotest.testable pp_special_use (fun a b ->
134
-
Mailbox_attr.to_string (a :> Mailbox_attr.t) = Mailbox_attr.to_string (b :> Mailbox_attr.t))
135
-
136
-
let test_jmap_role_of_string () =
137
-
(* Test string to role conversion *)
138
-
Alcotest.(check (option special_use_testable)) "drafts" (Some `Drafts) (Jmap_wire.role_of_string "drafts");
139
-
Alcotest.(check (option special_use_testable)) "sent" (Some `Sent) (Jmap_wire.role_of_string "sent");
140
-
Alcotest.(check (option special_use_testable)) "inbox" (Some `Inbox) (Jmap_wire.role_of_string "inbox");
141
-
Alcotest.(check (option special_use_testable)) "unknown" None (Jmap_wire.role_of_string "unknown")
142
-
143
-
let test_jmap_role_roundtrip () =
144
-
(* Test roundtrip: role -> string -> role *)
145
-
let test_role role =
146
-
let s = Jmap_wire.role_to_string role in
147
-
Alcotest.(check (option special_use_testable)) s (Some role) (Jmap_wire.role_of_string s)
148
-
in
149
-
test_role `Drafts;
150
-
test_role `Sent;
151
-
test_role `Trash;
152
-
test_role `Junk;
153
-
test_role `Inbox;
154
-
test_role `Archive;
155
-
test_role `All;
156
-
test_role `Flagged;
157
-
test_role `Important;
158
-
test_role `Subscribed;
159
-
test_role `Snoozed;
160
-
test_role `Scheduled;
161
-
test_role `Memos
162
-
163
-
let () =
164
-
Alcotest.run "Wire formats" [
165
-
"Imap_wire.flag", [
166
-
Alcotest.test_case "flag_of_string system" `Quick test_imap_flag_of_string_system;
167
-
Alcotest.test_case "flag_of_string no backslash" `Quick test_imap_flag_of_string_system_no_backslash;
168
-
Alcotest.test_case "flag_of_string keyword" `Quick test_imap_flag_of_string_keyword;
169
-
Alcotest.test_case "flag_of_string custom" `Quick test_imap_flag_of_string_custom;
170
-
Alcotest.test_case "flag_to_string" `Quick test_imap_flag_to_string;
171
-
];
172
-
"Imap_wire.flags", [
173
-
Alcotest.test_case "flags_of_keywords" `Quick test_imap_flags_of_keywords;
174
-
Alcotest.test_case "keywords_of_flags" `Quick test_imap_keywords_of_flags;
175
-
];
176
-
"Imap_wire.attr", [
177
-
Alcotest.test_case "attr_of_string" `Quick test_imap_attr_of_string;
178
-
Alcotest.test_case "attr_to_string" `Quick test_imap_attr_to_string;
179
-
];
180
-
"Jmap_wire.keywords", [
181
-
Alcotest.test_case "keywords_to_assoc" `Quick test_jmap_keywords_to_assoc;
182
-
Alcotest.test_case "keywords_of_assoc" `Quick test_jmap_keywords_of_assoc;
183
-
Alcotest.test_case "roundtrip" `Quick test_jmap_keywords_roundtrip;
184
-
];
185
-
"Jmap_wire.role", [
186
-
Alcotest.test_case "role_to_string" `Quick test_jmap_role_to_string;
187
-
Alcotest.test_case "role_of_string" `Quick test_jmap_role_of_string;
188
-
Alcotest.test_case "roundtrip" `Quick test_jmap_role_roundtrip;
189
-
];
190
-
]
+1
-1
ocaml-imap/bin/imap_client.ml
+1
-1
ocaml-imap/bin/imap_client.ml
+88
-64
ocaml-imap/lib/imap/flag.ml
+88
-64
ocaml-imap/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
ocaml-imap/lib/imap/flag.mli
+57
-25
ocaml-imap/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
ocaml-imap/lib/imap/read.ml
+9
-10
ocaml-imap/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
ocaml-imap/lib/imap/write.ml
+6
-8
ocaml-imap/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
ocaml-imap/test/integration/imaptest_scripted.ml
+45
-45
ocaml-imap/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
ocaml-imap/test/integration/imaptest_stress.ml
+5
-5
ocaml-imap/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
ocaml-imap/test/integration/imaptest_utils.ml
+5
-5
ocaml-imap/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
ocaml-imap/test/test_client.ml
+4
-4
ocaml-imap/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
ocaml-imap/test/test_read.ml
+3
-3
ocaml-imap/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
ocaml-imap/test/test_write.ml
+7
-6
ocaml-imap/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
+10
ocaml-jmap/lib/mail/mail_email.ml
+10
ocaml-jmap/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
+
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
ocaml-jmap/lib/mail/mail_email.mli
+25
ocaml-jmap/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
+
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
ocaml-jmap/lib/mail/mail_mailbox.ml
+33
ocaml-jmap/lib/mail/mail_mailbox.ml
···
145
145
~enc:role_to_string
146
146
Jsont.string
147
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
+
148
181
type t = {
149
182
id : Proto_id.t option;
150
183
name : string option;
+9
ocaml-jmap/lib/mail/mail_mailbox.mli
+9
ocaml-jmap/lib/mail/mail_mailbox.mli
···
86
86
val role_of_string : string -> role
87
87
val role_jsont : role Jsont.t
88
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
+
89
98
(** {1 Mailbox} *)
90
99
91
100
type t = {