anil.recoil.org
OCaml HTML5 parser/serialiser based on Python's JustHTML
Add unified mail-flag library for IMAP/JMAP interoperability
New mail-flag library providing shared types for email protocols:
Core modules:
- keyword.ml: Unified message keywords (RFC 8621, draft-ietf-mailmaint)
- Standard: Seen, Answered, Flagged, Draft, Deleted, Forwarded
- Spam: Phishing, Junk, NotJunk
- Extended: HasAttachment, Muted, Followed, Notify, etc.
- Apple Mail flag color bits
- mailbox_attr.ml: Mailbox attributes and roles (RFC 6154, RFC 5258)
- LIST attributes: Noinferiors, Noselect, HasChildren, etc.
- Special-use roles: Inbox, Drafts, Sent, Trash, Archive, etc.
- Extended: Snoozed, Scheduled, Memos
- flag_color.ml: Apple Mail 7-color encoding via 3-bit keywords
Wire format adapters:
- imap_wire.ml: IMAP protocol serialization (\Seen, $forwarded)
- jmap_wire.ml: JMAP JSON format ({"$seen": true})
Integration:
- ocaml-imap: Flag and List_attr modules now interop with mail-flag
- ocaml-jmap: Keyword and Role modules now use mail-flag types
54 tests for mail-flag library, all existing tests pass.
Co-Authored-By: Claude Opus 4.5 <noreply@anthropic.com>
+13
mail-flag/dune-project
+13
mail-flag/dune-project
···
1
+
(lang dune 3.0)
2
+
(name mail-flag)
3
+
(generate_opam_files true)
4
+
5
+
(package
6
+
(name mail-flag)
7
+
(synopsis "Unified message flags and mailbox attributes for IMAP/JMAP")
8
+
(description
9
+
"Type-safe message keywords, system flags, and mailbox attributes for email protocols. Supports RFC 9051 (IMAP4rev2), RFC 8621 (JMAP Mail), RFC 6154 (Special-Use), and draft-ietf-mailmaint extensions.")
10
+
(depends
11
+
(ocaml (>= 5.0))
12
+
(fmt (>= 0.9))
13
+
(alcotest :with-test)))
+4
mail-flag/lib/dune
+4
mail-flag/lib/dune
+101
mail-flag/lib/flag_color.ml
+101
mail-flag/lib/flag_color.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Apple Mail flag colors.
7
+
8
+
See {{:https://datatracker.ietf.org/doc/draft-ietf-mailmaint-messageflag-mailboxattribute#section-3}
9
+
draft-ietf-mailmaint-messageflag-mailboxattribute Section 3}.
10
+
11
+
The Apple Mail flag color encoding uses three keywords to represent
12
+
colors as a 3-bit pattern:
13
+
- [$MailFlagBit0]: bit 0
14
+
- [$MailFlagBit1]: bit 1
15
+
- [$MailFlagBit2]: bit 2
16
+
17
+
Bit patterns (bit0, bit1, bit2):
18
+
- Red: (false, false, false) = 000
19
+
- Orange: (true, false, false) = 100
20
+
- Yellow: (false, true, false) = 010
21
+
- Green: (true, true, false) = 110
22
+
- Blue: (false, false, true) = 001
23
+
- Purple: (true, false, true) = 101
24
+
- Gray: (false, true, true) = 011
25
+
- 111: undefined *)
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 *)
35
+
36
+
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 *)
44
+
45
+
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 *)
54
+
55
+
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 ]
63
+
64
+
let of_keywords (keywords : [ `MailFlagBit0 | `MailFlagBit1 | `MailFlagBit2 ] list) =
65
+
let has k = List.exists (fun x -> x = k) keywords in
66
+
let bit0 = has `MailFlagBit0 in
67
+
let bit1 = has `MailFlagBit1 in
68
+
let bit2 = has `MailFlagBit2 in
69
+
(* If no bits are set, we cannot distinguish between "no flag color"
70
+
and "Red" (which is 000). Return None to indicate ambiguity. *)
71
+
if not bit0 && not bit1 && not bit2 then None
72
+
else of_bits (bit0, bit1, bit2)
73
+
74
+
let of_keywords_default_red (keywords : [ `MailFlagBit0 | `MailFlagBit1 | `MailFlagBit2 ] list) =
75
+
let has k = List.exists (fun x -> x = k) keywords in
76
+
let bit0 = has `MailFlagBit0 in
77
+
let bit1 = has `MailFlagBit1 in
78
+
let bit2 = has `MailFlagBit2 in
79
+
of_bits (bit0, bit1, bit2)
80
+
81
+
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"
89
+
90
+
let of_string s =
91
+
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
99
+
| _ -> None
100
+
101
+
let pp ppf color = Format.pp_print_string ppf (to_string color)
+72
mail-flag/lib/flag_color.mli
+72
mail-flag/lib/flag_color.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Apple Mail flag colors.
7
+
8
+
This module implements the Apple Mail flag color encoding using the
9
+
[$MailFlagBit0], [$MailFlagBit1], and [$MailFlagBit2] keywords.
10
+
11
+
See {{:https://datatracker.ietf.org/doc/draft-ietf-mailmaint-messageflag-mailboxattribute#section-3}
12
+
draft-ietf-mailmaint-messageflag-mailboxattribute Section 3}.
13
+
14
+
Colors are encoded as a 3-bit pattern where each bit corresponds to
15
+
a keyword:
16
+
- Bit 0: [$MailFlagBit0]
17
+
- Bit 1: [$MailFlagBit1]
18
+
- Bit 2: [$MailFlagBit2]
19
+
20
+
The bit patterns are:
21
+
- Red: 000 (no bits set)
22
+
- Orange: 100 (bit 0 only)
23
+
- Yellow: 010 (bit 1 only)
24
+
- Green: 110 (bits 0 and 1)
25
+
- Blue: 001 (bit 2 only)
26
+
- Purple: 101 (bits 0 and 2)
27
+
- Gray: 011 (bits 1 and 2)
28
+
- 111: undefined (all bits set) *)
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 *)
38
+
39
+
val to_bits : t -> bool * bool * bool
40
+
(** [to_bits color] converts [color] to a [(bit0, bit1, bit2)] tuple
41
+
representing which [$MailFlagBit*] keywords should be set.
42
+
43
+
Example: [to_bits Green] returns [(true, true, false)]. *)
44
+
45
+
val of_bits : bool * bool * bool -> t option
46
+
(** [of_bits (bit0, bit1, bit2)] converts a bit pattern to a color.
47
+
Returns [None] for the undefined pattern [(true, true, true)] (111). *)
48
+
49
+
val to_keywords : t -> [ `MailFlagBit0 | `MailFlagBit1 | `MailFlagBit2 ] list
50
+
(** [to_keywords color] returns the list of keyword bits that should be
51
+
set for [color]. Red returns an empty list since no bits are needed. *)
52
+
53
+
val of_keywords : [ `MailFlagBit0 | `MailFlagBit1 | `MailFlagBit2 ] list -> t option
54
+
(** [of_keywords keywords] extracts a color from a list of keyword bits.
55
+
Returns [None] if the pattern is 111 (undefined) or if no bits are
56
+
present in the list (which would indicate no flag color is set,
57
+
rather than Red). Use {!of_keywords_default_red} if you want to
58
+
treat an empty list as Red. *)
59
+
60
+
val of_keywords_default_red : [ `MailFlagBit0 | `MailFlagBit1 | `MailFlagBit2 ] list -> t option
61
+
(** [of_keywords_default_red keywords] is like {!of_keywords} but treats
62
+
an empty keyword list as Red. Returns [None] only for pattern 111. *)
63
+
64
+
val pp : Format.formatter -> t -> unit
65
+
(** [pp ppf color] pretty-prints the color name to [ppf]. *)
66
+
67
+
val to_string : t -> string
68
+
(** [to_string color] returns the lowercase color name. *)
69
+
70
+
val of_string : string -> t option
71
+
(** [of_string s] parses a color name (case-insensitive).
72
+
Returns [None] if [s] is not a valid color name. *)
+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] *)
+207
mail-flag/lib/keyword.ml
+207
mail-flag/lib/keyword.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Implementation of unified message keywords. *)
7
+
8
+
type standard = [
9
+
| `Seen
10
+
| `Answered
11
+
| `Flagged
12
+
| `Draft
13
+
| `Deleted
14
+
| `Forwarded
15
+
]
16
+
17
+
type spam = [
18
+
| `Phishing
19
+
| `Junk
20
+
| `NotJunk
21
+
]
22
+
23
+
type extended = [
24
+
| `HasAttachment
25
+
| `HasNoAttachment
26
+
| `Memo
27
+
| `HasMemo
28
+
| `CanUnsubscribe
29
+
| `Unsubscribed
30
+
| `Muted
31
+
| `Followed
32
+
| `AutoSent
33
+
| `Imported
34
+
| `IsTrusted
35
+
| `MaskedEmail
36
+
| `New
37
+
| `Notify
38
+
]
39
+
40
+
type flag_bit = [
41
+
| `MailFlagBit0
42
+
| `MailFlagBit1
43
+
| `MailFlagBit2
44
+
]
45
+
46
+
type t = [ standard | spam | extended | flag_bit | `Custom of string ]
47
+
48
+
(** Normalize a keyword string by removing the $ prefix and converting to lowercase. *)
49
+
let normalize s =
50
+
let s = String.lowercase_ascii s in
51
+
if String.length s > 0 && s.[0] = '$' then
52
+
String.sub s 1 (String.length s - 1)
53
+
else if String.length s > 0 && s.[0] = '\\' then
54
+
String.sub s 1 (String.length s - 1)
55
+
else
56
+
s
57
+
58
+
let of_string s =
59
+
match normalize s with
60
+
| "seen" -> `Seen
61
+
| "answered" -> `Answered
62
+
| "flagged" -> `Flagged
63
+
| "draft" -> `Draft
64
+
| "deleted" -> `Deleted
65
+
| "forwarded" -> `Forwarded
66
+
| "phishing" -> `Phishing
67
+
| "junk" -> `Junk
68
+
| "notjunk" -> `NotJunk
69
+
| "hasattachment" -> `HasAttachment
70
+
| "hasnoattachment" -> `HasNoAttachment
71
+
| "memo" -> `Memo
72
+
| "hasmemo" -> `HasMemo
73
+
| "canunsubscribe" -> `CanUnsubscribe
74
+
| "unsubscribed" -> `Unsubscribed
75
+
| "muted" -> `Muted
76
+
| "followed" -> `Followed
77
+
| "autosent" -> `AutoSent
78
+
| "imported" -> `Imported
79
+
| "istrusted" -> `IsTrusted
80
+
| "maskedemail" -> `MaskedEmail
81
+
| "new" -> `New
82
+
| "notify" -> `Notify
83
+
| "mailflagbit0" -> `MailFlagBit0
84
+
| "mailflagbit1" -> `MailFlagBit1
85
+
| "mailflagbit2" -> `MailFlagBit2
86
+
| other -> `Custom other
87
+
88
+
let to_string = function
89
+
| `Seen -> "$seen"
90
+
| `Answered -> "$answered"
91
+
| `Flagged -> "$flagged"
92
+
| `Draft -> "$draft"
93
+
| `Deleted -> "$deleted"
94
+
| `Forwarded -> "$forwarded"
95
+
| `Phishing -> "$phishing"
96
+
| `Junk -> "$junk"
97
+
| `NotJunk -> "$notjunk"
98
+
| `HasAttachment -> "$hasattachment"
99
+
| `HasNoAttachment -> "$hasnoattachment"
100
+
| `Memo -> "$memo"
101
+
| `HasMemo -> "$hasmemo"
102
+
| `CanUnsubscribe -> "$canunsubscribe"
103
+
| `Unsubscribed -> "$unsubscribed"
104
+
| `Muted -> "$muted"
105
+
| `Followed -> "$followed"
106
+
| `AutoSent -> "$autosent"
107
+
| `Imported -> "$imported"
108
+
| `IsTrusted -> "$istrusted"
109
+
| `MaskedEmail -> "$maskedemail"
110
+
| `New -> "$new"
111
+
| `Notify -> "$notify"
112
+
| `MailFlagBit0 -> "$MailFlagBit0"
113
+
| `MailFlagBit1 -> "$MailFlagBit1"
114
+
| `MailFlagBit2 -> "$MailFlagBit2"
115
+
| `Custom s -> s
116
+
117
+
let to_imap_string = function
118
+
(* Standard keywords that map to IMAP system flags *)
119
+
| `Seen -> "\\Seen"
120
+
| `Answered -> "\\Answered"
121
+
| `Flagged -> "\\Flagged"
122
+
| `Draft -> "\\Draft"
123
+
| `Deleted -> "\\Deleted"
124
+
(* Non-system keywords use $ prefix *)
125
+
| `Forwarded -> "$Forwarded"
126
+
| `Phishing -> "$Phishing"
127
+
| `Junk -> "$Junk"
128
+
| `NotJunk -> "$NotJunk"
129
+
| `HasAttachment -> "$HasAttachment"
130
+
| `HasNoAttachment -> "$HasNoAttachment"
131
+
| `Memo -> "$Memo"
132
+
| `HasMemo -> "$HasMemo"
133
+
| `CanUnsubscribe -> "$CanUnsubscribe"
134
+
| `Unsubscribed -> "$Unsubscribed"
135
+
| `Muted -> "$Muted"
136
+
| `Followed -> "$Followed"
137
+
| `AutoSent -> "$AutoSent"
138
+
| `Imported -> "$Imported"
139
+
| `IsTrusted -> "$IsTrusted"
140
+
| `MaskedEmail -> "$MaskedEmail"
141
+
| `New -> "$New"
142
+
| `Notify -> "$Notify"
143
+
| `MailFlagBit0 -> "$MailFlagBit0"
144
+
| `MailFlagBit1 -> "$MailFlagBit1"
145
+
| `MailFlagBit2 -> "$MailFlagBit2"
146
+
| `Custom s ->
147
+
if String.length s > 0 && (s.[0] = '$' || s.[0] = '\\') then s
148
+
else "$" ^ s
149
+
150
+
let is_standard = function
151
+
| `Seen | `Answered | `Flagged | `Draft | `Deleted -> true
152
+
| _ -> false
153
+
154
+
let is_mutually_exclusive k1 k2 =
155
+
match (k1, k2) with
156
+
| (`HasAttachment, `HasNoAttachment) | (`HasNoAttachment, `HasAttachment) -> true
157
+
| (`Junk, `NotJunk) | (`NotJunk, `Junk) -> true
158
+
| (`Muted, `Followed) | (`Followed, `Muted) -> true
159
+
| _ -> false
160
+
161
+
let pp ppf k = Fmt.string ppf (to_string k)
162
+
163
+
let equal k1 k2 =
164
+
match (k1, k2) with
165
+
| (`Custom s1, `Custom s2) -> String.equal (String.lowercase_ascii s1) (String.lowercase_ascii s2)
166
+
| _ -> k1 = k2
167
+
168
+
let compare k1 k2 =
169
+
match (k1, k2) with
170
+
| (`Custom s1, `Custom s2) -> String.compare (String.lowercase_ascii s1) (String.lowercase_ascii s2)
171
+
| (`Custom _, _) -> 1
172
+
| (_, `Custom _) -> -1
173
+
| _ -> Stdlib.compare k1 k2
174
+
175
+
(** Apple Mail flag colors *)
176
+
type flag_color = [
177
+
| `Red
178
+
| `Orange
179
+
| `Yellow
180
+
| `Green
181
+
| `Blue
182
+
| `Purple
183
+
| `Gray
184
+
]
185
+
186
+
let flag_color_of_keywords keywords =
187
+
let has_bit0 = List.exists (fun k -> k = `MailFlagBit0) keywords in
188
+
let has_bit1 = List.exists (fun k -> k = `MailFlagBit1) keywords in
189
+
let has_bit2 = List.exists (fun k -> k = `MailFlagBit2) keywords in
190
+
match (has_bit0, has_bit1, has_bit2) with
191
+
| (false, false, false) -> Some `Red
192
+
| (true, false, false) -> Some `Orange
193
+
| (false, true, false) -> Some `Yellow
194
+
| (true, true, true) -> Some `Green
195
+
| (false, false, true) -> Some `Blue
196
+
| (true, false, true) -> Some `Purple
197
+
| (false, true, true) -> Some `Gray
198
+
| (true, true, false) -> None (* Invalid encoding *)
199
+
200
+
let flag_color_to_keywords = function
201
+
| `Red -> []
202
+
| `Orange -> [`MailFlagBit0]
203
+
| `Yellow -> [`MailFlagBit1]
204
+
| `Green -> [`MailFlagBit0; `MailFlagBit1; `MailFlagBit2]
205
+
| `Blue -> [`MailFlagBit2]
206
+
| `Purple -> [`MailFlagBit0; `MailFlagBit2]
207
+
| `Gray -> [`MailFlagBit1; `MailFlagBit2]
+177
mail-flag/lib/keyword.mli
+177
mail-flag/lib/keyword.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Unified Message Keywords for IMAP and JMAP
7
+
8
+
This module provides a unified representation of message keywords that
9
+
works across both IMAP ({{:https://datatracker.ietf.org/doc/html/rfc9051}RFC 9051})
10
+
and JMAP ({{:https://datatracker.ietf.org/doc/html/rfc8621}RFC 8621}) protocols.
11
+
12
+
{2 Keyword Types}
13
+
14
+
Keywords are organized into categories based on their specification:
15
+
- {!standard}: Core flags from RFC 8621 Section 4.1.1 that map to IMAP system flags
16
+
- {!spam}: Spam-related keywords for junk mail handling
17
+
- {!extended}: Extended keywords from draft-ietf-mailmaint
18
+
- {!flag_bit}: Apple Mail flag color bits
19
+
20
+
{2 Protocol Mapping}
21
+
22
+
IMAP system flags ([\Seen], [\Answered], etc.) map to JMAP keywords
23
+
([$seen], [$answered], etc.). The {!to_string} and {!to_imap_string}
24
+
functions handle these conversions. *)
25
+
26
+
(** {1 Keyword Types} *)
27
+
28
+
(** Standard keywords per {{:https://datatracker.ietf.org/doc/html/rfc8621#section-4.1.1}RFC 8621 Section 4.1.1}.
29
+
30
+
These keywords have direct mappings to IMAP system flags defined in
31
+
{{:https://datatracker.ietf.org/doc/html/rfc9051#section-2.3.2}RFC 9051 Section 2.3.2}. *)
32
+
type standard = [
33
+
| `Seen (** Message has been read. Maps to IMAP [\Seen]. *)
34
+
| `Answered (** Message has been answered. Maps to IMAP [\Answered]. *)
35
+
| `Flagged (** Message is flagged/starred. Maps to IMAP [\Flagged]. *)
36
+
| `Draft (** Message is a draft. Maps to IMAP [\Draft]. *)
37
+
| `Deleted (** Message marked for deletion. IMAP only, maps to [\Deleted]. *)
38
+
| `Forwarded (** Message has been forwarded. JMAP [$forwarded] keyword. *)
39
+
]
40
+
41
+
(** Spam-related keywords for junk mail handling.
42
+
43
+
These keywords help mail clients and servers coordinate spam filtering
44
+
decisions across protocol boundaries. *)
45
+
type spam = [
46
+
| `Phishing (** Message is a phishing attempt. JMAP [$phishing]. *)
47
+
| `Junk (** Message is spam/junk. JMAP [$junk]. *)
48
+
| `NotJunk (** Message explicitly marked as not junk. JMAP [$notjunk]. *)
49
+
]
50
+
51
+
(** Extended keywords per draft-ietf-mailmaint.
52
+
53
+
These keywords provide additional metadata for enhanced mail client features
54
+
beyond basic read/reply tracking. *)
55
+
type extended = [
56
+
| `HasAttachment (** Message has attachments. *)
57
+
| `HasNoAttachment (** Message has no attachments. Mutually exclusive with [`HasAttachment]. *)
58
+
| `Memo (** Message is a memo. *)
59
+
| `HasMemo (** Message has an associated memo. *)
60
+
| `CanUnsubscribe (** Message has unsubscribe capability (List-Unsubscribe header). *)
61
+
| `Unsubscribed (** User has unsubscribed from this sender. *)
62
+
| `Muted (** Thread is muted. Mutually exclusive with [`Followed]. *)
63
+
| `Followed (** Thread is followed. Mutually exclusive with [`Muted]. *)
64
+
| `AutoSent (** Message was sent automatically. *)
65
+
| `Imported (** Message was imported from another source. *)
66
+
| `IsTrusted (** Sender is trusted. *)
67
+
| `MaskedEmail (** Message was sent to a masked email address. *)
68
+
| `New (** Message is new (not yet processed by client). *)
69
+
| `Notify (** User should be notified about this message. *)
70
+
]
71
+
72
+
(** Apple Mail flag color bits.
73
+
74
+
Apple Mail uses a 3-bit encoding for flag colors. The color is determined
75
+
by the combination of bits set. See {!flag_color_of_keywords} for the
76
+
mapping. *)
77
+
type flag_bit = [
78
+
| `MailFlagBit0 (** Bit 0 of Apple Mail flag color encoding. *)
79
+
| `MailFlagBit1 (** Bit 1 of Apple Mail flag color encoding. *)
80
+
| `MailFlagBit2 (** Bit 2 of Apple Mail flag color encoding. *)
81
+
]
82
+
83
+
(** Unified keyword type combining all keyword categories.
84
+
85
+
Use [`Custom s] for server-specific or application-specific keywords
86
+
not covered by the standard categories. *)
87
+
type t = [ standard | spam | extended | flag_bit | `Custom of string ]
88
+
89
+
(** {1 Conversion Functions} *)
90
+
91
+
val of_string : string -> t
92
+
(** [of_string s] parses a keyword string.
93
+
94
+
Handles both JMAP format ([$seen]) and bare format ([seen]).
95
+
Parsing is case-insensitive for known keywords.
96
+
97
+
Examples:
98
+
- ["$seen"] -> [`Seen]
99
+
- ["seen"] -> [`Seen]
100
+
- ["SEEN"] -> [`Seen]
101
+
- ["\\Seen"] -> [`Seen] (IMAP system flag format)
102
+
- ["my-custom-flag"] -> [`Custom "my-custom-flag"] *)
103
+
104
+
val to_string : t -> string
105
+
(** [to_string k] converts a keyword to canonical JMAP format.
106
+
107
+
Standard and extended keywords are returned with [$] prefix in lowercase.
108
+
Apple Mail flag bits preserve their mixed case.
109
+
Custom keywords are returned as-is.
110
+
111
+
Examples:
112
+
- [`Seen] -> ["$seen"]
113
+
- [`MailFlagBit0] -> ["$MailFlagBit0"]
114
+
- [`Custom "foo"] -> ["foo"] *)
115
+
116
+
val to_imap_string : t -> string
117
+
(** [to_imap_string k] converts a keyword to IMAP format.
118
+
119
+
Standard keywords that map to IMAP system flags use backslash prefix.
120
+
Other keywords use [$] prefix with appropriate casing.
121
+
122
+
Examples:
123
+
- [`Seen] -> ["\\Seen"]
124
+
- [`Deleted] -> ["\\Deleted"]
125
+
- [`Forwarded] -> ["$Forwarded"]
126
+
- [`MailFlagBit0] -> ["$MailFlagBit0"] *)
127
+
128
+
(** {1 Predicates} *)
129
+
130
+
val is_standard : t -> bool
131
+
(** [is_standard k] returns [true] if [k] maps to an IMAP system flag.
132
+
133
+
The standard keywords are: [`Seen], [`Answered], [`Flagged], [`Draft],
134
+
and [`Deleted]. Note that [`Forwarded] is {i not} an IMAP system flag. *)
135
+
136
+
val is_mutually_exclusive : t -> t -> bool
137
+
(** [is_mutually_exclusive k1 k2] returns [true] if keywords [k1] and [k2]
138
+
cannot both be set on the same message.
139
+
140
+
Mutually exclusive pairs:
141
+
- [`HasAttachment] and [`HasNoAttachment]
142
+
- [`Junk] and [`NotJunk]
143
+
- [`Muted] and [`Followed] *)
144
+
145
+
(** {1 Pretty Printing} *)
146
+
147
+
val pp : Format.formatter -> t -> unit
148
+
(** [pp ppf k] pretty-prints keyword [k] in JMAP format. *)
149
+
150
+
val equal : t -> t -> bool
151
+
(** [equal k1 k2] tests equality of keywords. *)
152
+
153
+
val compare : t -> t -> int
154
+
(** [compare k1 k2] provides total ordering on keywords. *)
155
+
156
+
(** {1 Apple Mail Flag Colors} *)
157
+
158
+
(** Apple Mail flag colors encoded as 3-bit values. *)
159
+
type flag_color = [
160
+
| `Red (** No bits set *)
161
+
| `Orange (** Bit 0 only *)
162
+
| `Yellow (** Bit 1 only *)
163
+
| `Green (** All bits set *)
164
+
| `Blue (** Bit 2 only *)
165
+
| `Purple (** Bits 0 and 2 *)
166
+
| `Gray (** Bits 1 and 2 *)
167
+
]
168
+
169
+
val flag_color_of_keywords : t list -> flag_color option
170
+
(** [flag_color_of_keywords keywords] extracts the Apple Mail flag color
171
+
from a list of keywords.
172
+
173
+
Returns [None] if bits 0 and 1 are set but not bit 2 (invalid encoding). *)
174
+
175
+
val flag_color_to_keywords : flag_color -> t list
176
+
(** [flag_color_to_keywords color] returns the keyword bits needed to
177
+
represent the given flag color. *)
+149
mail-flag/lib/mailbox_attr.ml
+149
mail-flag/lib/mailbox_attr.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Implementation of unified mailbox attributes and roles. *)
7
+
8
+
type list_attr = [
9
+
| `Noinferiors
10
+
| `Noselect
11
+
| `Marked
12
+
| `Unmarked
13
+
| `Subscribed
14
+
| `HasChildren
15
+
| `HasNoChildren
16
+
| `NonExistent
17
+
| `Remote
18
+
]
19
+
20
+
type special_use = [
21
+
| `All
22
+
| `Archive
23
+
| `Drafts
24
+
| `Flagged
25
+
| `Important
26
+
| `Inbox
27
+
| `Junk
28
+
| `Sent
29
+
| `Subscribed
30
+
| `Trash
31
+
| `Snoozed
32
+
| `Scheduled
33
+
| `Memos
34
+
]
35
+
36
+
type t = [ list_attr | special_use | `Extension of string ]
37
+
38
+
(** Normalize attribute string by removing backslash prefix and converting to lowercase. *)
39
+
let normalize s =
40
+
let s = String.lowercase_ascii s in
41
+
if String.length s > 0 && s.[0] = '\\' then
42
+
String.sub s 1 (String.length s - 1)
43
+
else
44
+
s
45
+
46
+
let of_string s =
47
+
match normalize s with
48
+
(* LIST attributes *)
49
+
| "noinferiors" -> `Noinferiors
50
+
| "noselect" -> `Noselect
51
+
| "marked" -> `Marked
52
+
| "unmarked" -> `Unmarked
53
+
| "subscribed" -> `Subscribed
54
+
| "haschildren" -> `HasChildren
55
+
| "hasnochildren" -> `HasNoChildren
56
+
| "nonexistent" -> `NonExistent
57
+
| "remote" -> `Remote
58
+
(* Special-use roles *)
59
+
| "all" -> `All
60
+
| "archive" -> `Archive
61
+
| "drafts" -> `Drafts
62
+
| "flagged" -> `Flagged
63
+
| "important" -> `Important
64
+
| "inbox" -> `Inbox
65
+
| "junk" | "spam" -> `Junk
66
+
| "sent" -> `Sent
67
+
| "trash" -> `Trash
68
+
| "snoozed" -> `Snoozed
69
+
| "scheduled" -> `Scheduled
70
+
| "memos" -> `Memos
71
+
| other -> `Extension other
72
+
73
+
let to_string = function
74
+
(* LIST attributes *)
75
+
| `Noinferiors -> "\\Noinferiors"
76
+
| `Noselect -> "\\Noselect"
77
+
| `Marked -> "\\Marked"
78
+
| `Unmarked -> "\\Unmarked"
79
+
| `Subscribed -> "\\Subscribed"
80
+
| `HasChildren -> "\\HasChildren"
81
+
| `HasNoChildren -> "\\HasNoChildren"
82
+
| `NonExistent -> "\\NonExistent"
83
+
| `Remote -> "\\Remote"
84
+
(* Special-use roles *)
85
+
| `All -> "\\All"
86
+
| `Archive -> "\\Archive"
87
+
| `Drafts -> "\\Drafts"
88
+
| `Flagged -> "\\Flagged"
89
+
| `Important -> "\\Important"
90
+
| `Inbox -> "\\Inbox"
91
+
| `Junk -> "\\Junk"
92
+
| `Sent -> "\\Sent"
93
+
| `Trash -> "\\Trash"
94
+
| `Snoozed -> "\\Snoozed"
95
+
| `Scheduled -> "\\Scheduled"
96
+
| `Memos -> "\\Memos"
97
+
| `Extension s ->
98
+
if String.length s > 0 && s.[0] = '\\' then s
99
+
else "\\" ^ s
100
+
101
+
let to_jmap_role = function
102
+
(* Special-use roles have JMAP equivalents *)
103
+
| `All -> Some "all"
104
+
| `Archive -> Some "archive"
105
+
| `Drafts -> Some "drafts"
106
+
| `Flagged -> Some "flagged"
107
+
| `Important -> Some "important"
108
+
| `Inbox -> Some "inbox"
109
+
| `Junk -> Some "junk"
110
+
| `Sent -> Some "sent"
111
+
| `Trash -> Some "trash"
112
+
| `Snoozed -> Some "snoozed"
113
+
| `Scheduled -> Some "scheduled"
114
+
| `Memos -> Some "memos"
115
+
(* LIST attributes and extensions have no JMAP role *)
116
+
| `Noinferiors | `Noselect | `Marked | `Unmarked | `Subscribed
117
+
| `HasChildren | `HasNoChildren | `NonExistent | `Remote
118
+
| `Extension _ -> None
119
+
120
+
let of_jmap_role s =
121
+
match String.lowercase_ascii s with
122
+
| "all" -> Some `All
123
+
| "archive" -> Some `Archive
124
+
| "drafts" -> Some `Drafts
125
+
| "flagged" -> Some `Flagged
126
+
| "important" -> Some `Important
127
+
| "inbox" -> Some `Inbox
128
+
| "junk" -> Some `Junk
129
+
| "sent" -> Some `Sent
130
+
| "trash" -> Some `Trash
131
+
| "snoozed" -> Some `Snoozed
132
+
| "scheduled" -> Some `Scheduled
133
+
| "memos" -> Some `Memos
134
+
| "subscribed" -> Some `Subscribed
135
+
| _ -> None
136
+
137
+
let is_special_use = function
138
+
| `All | `Archive | `Drafts | `Flagged | `Important | `Inbox
139
+
| `Junk | `Sent | `Trash | `Snoozed | `Scheduled | `Memos -> true
140
+
| `Subscribed -> true (* Also a JMAP role *)
141
+
| `Noinferiors | `Noselect | `Marked | `Unmarked
142
+
| `HasChildren | `HasNoChildren | `NonExistent | `Remote
143
+
| `Extension _ -> false
144
+
145
+
let is_selectable = function
146
+
| `Noselect | `NonExistent -> false
147
+
| _ -> true
148
+
149
+
let pp ppf attr = Fmt.string ppf (to_string attr)
+188
mail-flag/lib/mailbox_attr.mli
+188
mail-flag/lib/mailbox_attr.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Unified Mailbox Attributes and Roles
7
+
8
+
This module provides a unified representation of mailbox attributes
9
+
across IMAP and JMAP protocols. It combines IMAP LIST response attributes
10
+
({{:https://www.rfc-editor.org/rfc/rfc9051#section-7.2.2}RFC 9051 Section 7.2.2}),
11
+
special-use mailbox flags ({{:https://www.rfc-editor.org/rfc/rfc6154}RFC 6154}),
12
+
and JMAP mailbox roles ({{:https://www.rfc-editor.org/rfc/rfc8621}RFC 8621}).
13
+
14
+
{2 References}
15
+
- {{:https://www.rfc-editor.org/rfc/rfc9051}RFC 9051} - IMAP4rev2
16
+
- {{:https://www.rfc-editor.org/rfc/rfc6154}RFC 6154} - IMAP LIST Extension for Special-Use Mailboxes
17
+
- {{:https://www.rfc-editor.org/rfc/rfc5258}RFC 5258} - IMAP4 LIST Command Extensions
18
+
- {{:https://www.rfc-editor.org/rfc/rfc8457}RFC 8457} - IMAP \$Important Keyword and \Important Special-Use Attribute
19
+
- {{:https://www.rfc-editor.org/rfc/rfc8621}RFC 8621} - JMAP for Mail *)
20
+
21
+
(** {1 IMAP LIST Attributes}
22
+
23
+
Attributes returned in IMAP LIST responses per
24
+
{{:https://www.rfc-editor.org/rfc/rfc9051#section-7.2.2}RFC 9051 Section 7.2.2}. *)
25
+
26
+
type list_attr = [
27
+
| `Noinferiors
28
+
(** [\Noinferiors] - No child mailboxes are possible under this mailbox.
29
+
The mailbox cannot have inferior (child) mailboxes, either because the
30
+
underlying storage doesn't support it or because the mailbox name is at
31
+
the hierarchy depth limit for this mailbox store. *)
32
+
| `Noselect
33
+
(** [\Noselect] - This mailbox cannot be selected. It exists only to hold
34
+
child mailboxes and is not a valid destination for messages. Stratum
35
+
only, not a real mailbox. *)
36
+
| `Marked
37
+
(** [\Marked] - The mailbox has been marked "interesting" by the server.
38
+
This typically indicates the mailbox contains new messages since the
39
+
last time it was selected. *)
40
+
| `Unmarked
41
+
(** [\Unmarked] - The mailbox is not "interesting". The mailbox does not
42
+
contain new messages since the last time it was selected. *)
43
+
| `Subscribed
44
+
(** [\Subscribed] - The mailbox is subscribed. Returned when the
45
+
SUBSCRIBED selection option is specified or implied. *)
46
+
| `HasChildren
47
+
(** [\HasChildren] - The mailbox has child mailboxes. Part of the
48
+
CHILDREN return option ({{:https://www.rfc-editor.org/rfc/rfc5258}RFC 5258}). *)
49
+
| `HasNoChildren
50
+
(** [\HasNoChildren] - The mailbox has no child mailboxes. Part of the
51
+
CHILDREN return option ({{:https://www.rfc-editor.org/rfc/rfc5258}RFC 5258}). *)
52
+
| `NonExistent
53
+
(** [\NonExistent] - The mailbox name does not refer to an existing mailbox.
54
+
This attribute is returned when a mailbox is part of the hierarchy but
55
+
doesn't actually exist ({{:https://www.rfc-editor.org/rfc/rfc5258}RFC 5258}).
56
+
Implies [\Noselect]. *)
57
+
| `Remote
58
+
(** [\Remote] - The mailbox is located on a remote server.
59
+
({{:https://www.rfc-editor.org/rfc/rfc5258}RFC 5258}) *)
60
+
]
61
+
62
+
(** {1 Special-Use Roles}
63
+
64
+
Special-use mailbox roles per {{:https://www.rfc-editor.org/rfc/rfc6154}RFC 6154}
65
+
and {{:https://www.rfc-editor.org/rfc/rfc8621}RFC 8621}. These identify
66
+
mailboxes with specific purposes. *)
67
+
68
+
type special_use = [
69
+
| `All
70
+
(** [\All] - A virtual mailbox containing all messages in the user's
71
+
message store. Implementations may omit some messages. *)
72
+
| `Archive
73
+
(** [\Archive] - A mailbox used to archive messages. The meaning of
74
+
"archived" may vary by server. *)
75
+
| `Drafts
76
+
(** [\Drafts] - A mailbox used to hold draft messages, typically messages
77
+
being composed but not yet sent. *)
78
+
| `Flagged
79
+
(** [\Flagged] - A virtual mailbox containing all messages marked with
80
+
the [\Flagged] flag. *)
81
+
| `Important
82
+
(** [\Important] - A mailbox used to hold messages deemed important to
83
+
the user. ({{:https://www.rfc-editor.org/rfc/rfc8457}RFC 8457}) *)
84
+
| `Inbox
85
+
(** [inbox] - The user's inbox. This is a JMAP role
86
+
({{:https://www.rfc-editor.org/rfc/rfc8621}RFC 8621}) without a direct
87
+
IMAP special-use equivalent since INBOX is always special in IMAP. *)
88
+
| `Junk
89
+
(** [\Junk] - A mailbox used to hold messages that have been identified
90
+
as spam or junk mail. Also known as "Spam" folder. *)
91
+
| `Sent
92
+
(** [\Sent] - A mailbox used to hold copies of messages that have been
93
+
sent. *)
94
+
| `Subscribed
95
+
(** [subscribed] - A JMAP virtual mailbox role
96
+
({{:https://www.rfc-editor.org/rfc/rfc8621}RFC 8621}) representing
97
+
all subscribed mailboxes. *)
98
+
| `Trash
99
+
(** [\Trash] - A mailbox used to hold messages that have been deleted or
100
+
marked for deletion. *)
101
+
| `Snoozed
102
+
(** [snoozed] - A mailbox for messages that have been snoozed until a
103
+
later time. (draft-ietf-mailmaint-special-use-extensions) *)
104
+
| `Scheduled
105
+
(** [scheduled] - A mailbox for messages scheduled to be sent at a
106
+
future time. (draft-ietf-mailmaint-special-use-extensions) *)
107
+
| `Memos
108
+
(** [memos] - A mailbox for memo/note messages.
109
+
(draft-ietf-mailmaint-special-use-extensions) *)
110
+
]
111
+
112
+
(** {1 Unified Attribute Type} *)
113
+
114
+
type t = [ list_attr | special_use | `Extension of string ]
115
+
(** The unified mailbox attribute type combining LIST attributes, special-use
116
+
roles, and server-specific extensions. Extensions are represented with
117
+
their original string form (without leading backslash if present). *)
118
+
119
+
(** {1 Conversion Functions} *)
120
+
121
+
val of_string : string -> t
122
+
(** [of_string s] parses a mailbox attribute from its IMAP wire format.
123
+
The input may optionally include the leading backslash. Parsing is
124
+
case-insensitive. Unknown attributes are returned as [`Extension s].
125
+
126
+
Examples:
127
+
- [of_string "\\Drafts"] returns [`Drafts]
128
+
- [of_string "drafts"] returns [`Drafts]
129
+
- [of_string "\\X-Custom"] returns [`Extension "X-Custom"] *)
130
+
131
+
val to_string : t -> string
132
+
(** [to_string attr] converts an attribute to its IMAP wire format with
133
+
the leading backslash prefix for standard attributes.
134
+
135
+
Examples:
136
+
- [to_string `Drafts] returns ["\\Drafts"]
137
+
- [to_string `HasChildren] returns ["\\HasChildren"]
138
+
- [to_string (`Extension "X-Custom")] returns ["\\X-Custom"] *)
139
+
140
+
val to_jmap_role : t -> string option
141
+
(** [to_jmap_role attr] converts a special-use attribute to its JMAP role
142
+
string (lowercase). Returns [None] for LIST attributes that don't
143
+
correspond to JMAP roles.
144
+
145
+
Examples:
146
+
- [to_jmap_role `Drafts] returns [Some "drafts"]
147
+
- [to_jmap_role `Inbox] returns [Some "inbox"]
148
+
- [to_jmap_role `Noselect] returns [None] *)
149
+
150
+
val of_jmap_role : string -> special_use option
151
+
(** [of_jmap_role s] parses a JMAP role string into a special-use attribute.
152
+
Returns [None] if the role string is not recognized. The input should
153
+
be lowercase as per JMAP conventions.
154
+
155
+
Examples:
156
+
- [of_jmap_role "drafts"] returns [Some `Drafts]
157
+
- [of_jmap_role "inbox"] returns [Some `Inbox]
158
+
- [of_jmap_role "unknown"] returns [None] *)
159
+
160
+
(** {1 Predicates} *)
161
+
162
+
val is_special_use : t -> bool
163
+
(** [is_special_use attr] returns [true] if the attribute is a special-use
164
+
role (as opposed to a LIST attribute or extension).
165
+
166
+
Examples:
167
+
- [is_special_use `Drafts] returns [true]
168
+
- [is_special_use `Noselect] returns [false]
169
+
- [is_special_use (`Extension "x")] returns [false] *)
170
+
171
+
val is_selectable : t -> bool
172
+
(** [is_selectable attr] returns [false] if the attribute indicates the
173
+
mailbox cannot be selected. This is [true] for [`Noselect] and
174
+
[`NonExistent] attributes, and [false] for all others.
175
+
176
+
Note: A mailbox may have multiple attributes. To determine if a mailbox
177
+
is selectable, check that no attribute returns [false] from this function.
178
+
179
+
Examples:
180
+
- [is_selectable `Noselect] returns [false]
181
+
- [is_selectable `NonExistent] returns [false]
182
+
- [is_selectable `Drafts] returns [true]
183
+
- [is_selectable `HasChildren] returns [true] *)
184
+
185
+
(** {1 Pretty Printing} *)
186
+
187
+
val pp : Format.formatter -> t -> unit
188
+
(** [pp ppf attr] pretty-prints the attribute in IMAP wire format. *)
+26
mail-flag/mail-flag.opam
+26
mail-flag/mail-flag.opam
···
1
+
# This file is generated by dune, edit dune-project instead
2
+
opam-version: "2.0"
3
+
synopsis: "Unified message flags and mailbox attributes for IMAP/JMAP"
4
+
description:
5
+
"Type-safe message keywords, system flags, and mailbox attributes for email protocols. Supports RFC 9051 (IMAP4rev2), RFC 8621 (JMAP Mail), RFC 6154 (Special-Use), and draft-ietf-mailmaint extensions."
6
+
depends: [
7
+
"dune" {>= "3.0"}
8
+
"ocaml" {>= "5.0"}
9
+
"fmt" {>= "0.9"}
10
+
"alcotest" {with-test}
11
+
"odoc" {with-doc}
12
+
]
13
+
build: [
14
+
["dune" "subst"] {dev}
15
+
[
16
+
"dune"
17
+
"build"
18
+
"-p"
19
+
name
20
+
"-j"
21
+
jobs
22
+
"@install"
23
+
"@runtest" {with-test}
24
+
"@doc" {with-doc}
25
+
]
26
+
]
+15
mail-flag/test/dune
+15
mail-flag/test/dune
···
1
+
(test
2
+
(name test_keyword)
3
+
(libraries mail-flag alcotest))
4
+
5
+
(test
6
+
(name test_mailbox_attr)
7
+
(libraries mail-flag alcotest))
8
+
9
+
(test
10
+
(name test_flag_color)
11
+
(libraries mail-flag alcotest))
12
+
13
+
(test
14
+
(name test_wire)
15
+
(libraries mail-flag alcotest))
+165
mail-flag/test/test_flag_color.ml
+165
mail-flag/test/test_flag_color.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Tests for the Flag_color module. *)
7
+
8
+
open Mail_flag
9
+
10
+
let color_testable =
11
+
Alcotest.testable Flag_color.pp (=)
12
+
13
+
let test_to_bits () =
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)
22
+
23
+
let test_of_bits () =
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));
32
+
(* 111 is undefined *)
33
+
Alcotest.(check (option color_testable)) "111 = undefined" None (Flag_color.of_bits (true, true, true))
34
+
35
+
let test_bits_roundtrip () =
36
+
(* Test that to_bits -> of_bits preserves the color *)
37
+
let test_color c =
38
+
let bits = Flag_color.to_bits c in
39
+
Alcotest.(check (option color_testable)) (Flag_color.to_string c) (Some c) (Flag_color.of_bits bits)
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
48
+
49
+
let test_to_keywords () =
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));
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))
68
+
69
+
let test_of_keywords () =
70
+
(* Test keyword list to color conversion *)
71
+
(* Empty list returns None (ambiguous: no color vs Red) *)
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]);
79
+
(* All bits = undefined *)
80
+
Alcotest.(check (option color_testable)) "all bits = undefined" None
81
+
(Flag_color.of_keywords [`MailFlagBit0; `MailFlagBit1; `MailFlagBit2])
82
+
83
+
let test_of_keywords_default_red () =
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)
88
+
(Flag_color.of_keywords_default_red [`MailFlagBit0; `MailFlagBit1]);
89
+
(* All bits still undefined *)
90
+
Alcotest.(check (option color_testable)) "all bits = undefined" None
91
+
(Flag_color.of_keywords_default_red [`MailFlagBit0; `MailFlagBit1; `MailFlagBit2])
92
+
93
+
let test_keywords_roundtrip () =
94
+
(* Test that to_keywords -> of_keywords_default_red preserves non-red colors *)
95
+
let test_color c =
96
+
let kws = Flag_color.to_keywords c in
97
+
Alcotest.(check (option color_testable)) (Flag_color.to_string c) (Some c) (Flag_color.of_keywords_default_red kws)
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
106
+
107
+
let test_to_string () =
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)
116
+
117
+
let test_of_string () =
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");
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");
130
+
(* Unknown *)
131
+
Alcotest.(check (option color_testable)) "unknown" None (Flag_color.of_string "unknown")
132
+
133
+
let test_string_roundtrip () =
134
+
(* Test that to_string -> of_string preserves the color *)
135
+
let test_color c =
136
+
let s = Flag_color.to_string c in
137
+
Alcotest.(check (option color_testable)) s (Some c) (Flag_color.of_string s)
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
146
+
147
+
let () =
148
+
Alcotest.run "Flag_color" [
149
+
"bits", [
150
+
Alcotest.test_case "to_bits" `Quick test_to_bits;
151
+
Alcotest.test_case "of_bits" `Quick test_of_bits;
152
+
Alcotest.test_case "roundtrip" `Quick test_bits_roundtrip;
153
+
];
154
+
"keywords", [
155
+
Alcotest.test_case "to_keywords" `Quick test_to_keywords;
156
+
Alcotest.test_case "of_keywords" `Quick test_of_keywords;
157
+
Alcotest.test_case "of_keywords_default_red" `Quick test_of_keywords_default_red;
158
+
Alcotest.test_case "roundtrip" `Quick test_keywords_roundtrip;
159
+
];
160
+
"strings", [
161
+
Alcotest.test_case "to_string" `Quick test_to_string;
162
+
Alcotest.test_case "of_string" `Quick test_of_string;
163
+
Alcotest.test_case "roundtrip" `Quick test_string_roundtrip;
164
+
];
165
+
]
+212
mail-flag/test/test_keyword.ml
+212
mail-flag/test/test_keyword.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Tests for the Keyword module. *)
7
+
8
+
open Mail_flag
9
+
10
+
let keyword_testable =
11
+
Alcotest.testable Keyword.pp Keyword.equal
12
+
13
+
let test_of_string_standard () =
14
+
(* Test standard keywords with $ prefix *)
15
+
Alcotest.(check keyword_testable) "seen with $" `Seen (Keyword.of_string "$seen");
16
+
Alcotest.(check keyword_testable) "answered with $" `Answered (Keyword.of_string "$answered");
17
+
Alcotest.(check keyword_testable) "flagged with $" `Flagged (Keyword.of_string "$flagged");
18
+
Alcotest.(check keyword_testable) "draft with $" `Draft (Keyword.of_string "$draft");
19
+
Alcotest.(check keyword_testable) "deleted with $" `Deleted (Keyword.of_string "$deleted");
20
+
Alcotest.(check keyword_testable) "forwarded with $" `Forwarded (Keyword.of_string "$forwarded")
21
+
22
+
let test_of_string_no_prefix () =
23
+
(* Test standard keywords without prefix *)
24
+
Alcotest.(check keyword_testable) "seen no prefix" `Seen (Keyword.of_string "seen");
25
+
Alcotest.(check keyword_testable) "answered no prefix" `Answered (Keyword.of_string "answered");
26
+
Alcotest.(check keyword_testable) "flagged no prefix" `Flagged (Keyword.of_string "flagged")
27
+
28
+
let test_of_string_case_insensitive () =
29
+
(* Test case insensitivity *)
30
+
Alcotest.(check keyword_testable) "SEEN uppercase" `Seen (Keyword.of_string "$SEEN");
31
+
Alcotest.(check keyword_testable) "Seen mixed" `Seen (Keyword.of_string "Seen");
32
+
Alcotest.(check keyword_testable) "FORWARDED uppercase" `Forwarded (Keyword.of_string "$FORWARDED")
33
+
34
+
let test_of_string_imap_format () =
35
+
(* Test IMAP system flag format with backslash *)
36
+
Alcotest.(check keyword_testable) "\\Seen" `Seen (Keyword.of_string "\\Seen");
37
+
Alcotest.(check keyword_testable) "\\Answered" `Answered (Keyword.of_string "\\Answered");
38
+
Alcotest.(check keyword_testable) "\\Draft" `Draft (Keyword.of_string "\\Draft")
39
+
40
+
let test_of_string_spam () =
41
+
(* Test spam-related keywords *)
42
+
Alcotest.(check keyword_testable) "phishing" `Phishing (Keyword.of_string "$phishing");
43
+
Alcotest.(check keyword_testable) "junk" `Junk (Keyword.of_string "$junk");
44
+
Alcotest.(check keyword_testable) "notjunk" `NotJunk (Keyword.of_string "$notjunk")
45
+
46
+
let test_of_string_extended () =
47
+
(* Test extended keywords *)
48
+
Alcotest.(check keyword_testable) "hasattachment" `HasAttachment (Keyword.of_string "$hasattachment");
49
+
Alcotest.(check keyword_testable) "hasnoattachment" `HasNoAttachment (Keyword.of_string "$hasnoattachment");
50
+
Alcotest.(check keyword_testable) "muted" `Muted (Keyword.of_string "$muted");
51
+
Alcotest.(check keyword_testable) "followed" `Followed (Keyword.of_string "$followed")
52
+
53
+
let test_of_string_flag_bits () =
54
+
(* Test Apple Mail flag bits *)
55
+
Alcotest.(check keyword_testable) "mailflagbit0" `MailFlagBit0 (Keyword.of_string "$mailflagbit0");
56
+
Alcotest.(check keyword_testable) "mailflagbit1" `MailFlagBit1 (Keyword.of_string "$mailflagbit1");
57
+
Alcotest.(check keyword_testable) "mailflagbit2" `MailFlagBit2 (Keyword.of_string "$mailflagbit2")
58
+
59
+
let test_of_string_custom () =
60
+
(* Test custom keywords *)
61
+
Alcotest.(check keyword_testable) "custom keyword" (`Custom "my-label") (Keyword.of_string "my-label");
62
+
Alcotest.(check keyword_testable) "custom with $" (`Custom "custom") (Keyword.of_string "$custom")
63
+
64
+
let test_to_string () =
65
+
(* Test conversion to JMAP format *)
66
+
Alcotest.(check string) "seen" "$seen" (Keyword.to_string `Seen);
67
+
Alcotest.(check string) "answered" "$answered" (Keyword.to_string `Answered);
68
+
Alcotest.(check string) "flagged" "$flagged" (Keyword.to_string `Flagged);
69
+
Alcotest.(check string) "draft" "$draft" (Keyword.to_string `Draft);
70
+
Alcotest.(check string) "deleted" "$deleted" (Keyword.to_string `Deleted);
71
+
Alcotest.(check string) "forwarded" "$forwarded" (Keyword.to_string `Forwarded);
72
+
Alcotest.(check string) "junk" "$junk" (Keyword.to_string `Junk);
73
+
Alcotest.(check string) "mailflagbit0" "$MailFlagBit0" (Keyword.to_string `MailFlagBit0);
74
+
Alcotest.(check string) "custom" "my-label" (Keyword.to_string (`Custom "my-label"))
75
+
76
+
let test_to_imap_string () =
77
+
(* Test conversion to IMAP format *)
78
+
Alcotest.(check string) "seen" "\\Seen" (Keyword.to_imap_string `Seen);
79
+
Alcotest.(check string) "answered" "\\Answered" (Keyword.to_imap_string `Answered);
80
+
Alcotest.(check string) "flagged" "\\Flagged" (Keyword.to_imap_string `Flagged);
81
+
Alcotest.(check string) "draft" "\\Draft" (Keyword.to_imap_string `Draft);
82
+
Alcotest.(check string) "deleted" "\\Deleted" (Keyword.to_imap_string `Deleted);
83
+
(* Non-system flags use $ prefix *)
84
+
Alcotest.(check string) "forwarded" "$Forwarded" (Keyword.to_imap_string `Forwarded);
85
+
Alcotest.(check string) "junk" "$Junk" (Keyword.to_imap_string `Junk);
86
+
Alcotest.(check string) "mailflagbit0" "$MailFlagBit0" (Keyword.to_imap_string `MailFlagBit0)
87
+
88
+
let test_is_standard () =
89
+
(* Test is_standard predicate *)
90
+
Alcotest.(check bool) "seen is standard" true (Keyword.is_standard `Seen);
91
+
Alcotest.(check bool) "answered is standard" true (Keyword.is_standard `Answered);
92
+
Alcotest.(check bool) "flagged is standard" true (Keyword.is_standard `Flagged);
93
+
Alcotest.(check bool) "draft is standard" true (Keyword.is_standard `Draft);
94
+
Alcotest.(check bool) "deleted is standard" true (Keyword.is_standard `Deleted);
95
+
(* Forwarded is NOT an IMAP system flag *)
96
+
Alcotest.(check bool) "forwarded is not standard" false (Keyword.is_standard `Forwarded);
97
+
Alcotest.(check bool) "junk is not standard" false (Keyword.is_standard `Junk);
98
+
Alcotest.(check bool) "custom is not standard" false (Keyword.is_standard (`Custom "x"))
99
+
100
+
let test_mutual_exclusion () =
101
+
(* Test mutually exclusive pairs *)
102
+
Alcotest.(check bool) "has/hasno attachment" true
103
+
(Keyword.is_mutually_exclusive `HasAttachment `HasNoAttachment);
104
+
Alcotest.(check bool) "hasno/has attachment" true
105
+
(Keyword.is_mutually_exclusive `HasNoAttachment `HasAttachment);
106
+
Alcotest.(check bool) "junk/notjunk" true
107
+
(Keyword.is_mutually_exclusive `Junk `NotJunk);
108
+
Alcotest.(check bool) "notjunk/junk" true
109
+
(Keyword.is_mutually_exclusive `NotJunk `Junk);
110
+
Alcotest.(check bool) "muted/followed" true
111
+
(Keyword.is_mutually_exclusive `Muted `Followed);
112
+
Alcotest.(check bool) "followed/muted" true
113
+
(Keyword.is_mutually_exclusive `Followed `Muted);
114
+
(* Non-exclusive pairs *)
115
+
Alcotest.(check bool) "seen/flagged" false
116
+
(Keyword.is_mutually_exclusive `Seen `Flagged);
117
+
Alcotest.(check bool) "seen/seen" false
118
+
(Keyword.is_mutually_exclusive `Seen `Seen);
119
+
Alcotest.(check bool) "junk/muted" false
120
+
(Keyword.is_mutually_exclusive `Junk `Muted)
121
+
122
+
let test_equal () =
123
+
(* Test equality *)
124
+
Alcotest.(check bool) "same keyword" true (Keyword.equal `Seen `Seen);
125
+
Alcotest.(check bool) "different keywords" false (Keyword.equal `Seen `Flagged);
126
+
(* Custom keywords are compared case-insensitively *)
127
+
Alcotest.(check bool) "custom same" true (Keyword.equal (`Custom "label") (`Custom "label"));
128
+
Alcotest.(check bool) "custom case insensitive" true (Keyword.equal (`Custom "Label") (`Custom "label"));
129
+
Alcotest.(check bool) "custom different" false (Keyword.equal (`Custom "a") (`Custom "b"))
130
+
131
+
let test_compare () =
132
+
(* Test comparison *)
133
+
Alcotest.(check int) "same keyword" 0 (Keyword.compare `Seen `Seen);
134
+
Alcotest.(check bool) "custom vs non-custom" true (Keyword.compare (`Custom "a") `Seen > 0);
135
+
Alcotest.(check bool) "non-custom vs custom" true (Keyword.compare `Seen (`Custom "a") < 0)
136
+
137
+
let pp_flag_color ppf c =
138
+
let s = match c with
139
+
| `Red -> "Red" | `Orange -> "Orange" | `Yellow -> "Yellow"
140
+
| `Green -> "Green" | `Blue -> "Blue" | `Purple -> "Purple" | `Gray -> "Gray"
141
+
in
142
+
Format.pp_print_string ppf s
143
+
144
+
let eq_flag_color a b =
145
+
match (a, b) with
146
+
| `Red, `Red | `Orange, `Orange | `Yellow, `Yellow
147
+
| `Green, `Green | `Blue, `Blue | `Purple, `Purple | `Gray, `Gray -> true
148
+
| _ -> false
149
+
150
+
let flag_color_testable = Alcotest.testable pp_flag_color eq_flag_color
151
+
152
+
let test_flag_color_of_keywords () =
153
+
(* Test Apple Mail flag color extraction *)
154
+
Alcotest.(check (option flag_color_testable))
155
+
"no bits = red" (Some `Red) (Keyword.flag_color_of_keywords []);
156
+
Alcotest.(check (option flag_color_testable))
157
+
"bit0 = orange" (Some `Orange) (Keyword.flag_color_of_keywords [`MailFlagBit0]);
158
+
Alcotest.(check (option flag_color_testable))
159
+
"bit1 = yellow" (Some `Yellow) (Keyword.flag_color_of_keywords [`MailFlagBit1]);
160
+
Alcotest.(check (option flag_color_testable))
161
+
"bit2 = blue" (Some `Blue) (Keyword.flag_color_of_keywords [`MailFlagBit2]);
162
+
Alcotest.(check (option flag_color_testable))
163
+
"bits 0,2 = purple" (Some `Purple) (Keyword.flag_color_of_keywords [`MailFlagBit0; `MailFlagBit2]);
164
+
Alcotest.(check (option flag_color_testable))
165
+
"bits 1,2 = gray" (Some `Gray) (Keyword.flag_color_of_keywords [`MailFlagBit1; `MailFlagBit2]);
166
+
Alcotest.(check (option flag_color_testable))
167
+
"all bits = green" (Some `Green) (Keyword.flag_color_of_keywords [`MailFlagBit0; `MailFlagBit1; `MailFlagBit2]);
168
+
(* Invalid encoding: bits 0 and 1 but not 2 *)
169
+
Alcotest.(check (option flag_color_testable))
170
+
"bits 0,1 = invalid" None (Keyword.flag_color_of_keywords [`MailFlagBit0; `MailFlagBit1])
171
+
172
+
let test_flag_color_to_keywords () =
173
+
(* Test Apple Mail flag color encoding *)
174
+
Alcotest.(check int) "red = no bits" 0 (List.length (Keyword.flag_color_to_keywords `Red));
175
+
Alcotest.(check int) "orange = 1 bit" 1 (List.length (Keyword.flag_color_to_keywords `Orange));
176
+
Alcotest.(check int) "yellow = 1 bit" 1 (List.length (Keyword.flag_color_to_keywords `Yellow));
177
+
Alcotest.(check int) "blue = 1 bit" 1 (List.length (Keyword.flag_color_to_keywords `Blue));
178
+
Alcotest.(check int) "purple = 2 bits" 2 (List.length (Keyword.flag_color_to_keywords `Purple));
179
+
Alcotest.(check int) "gray = 2 bits" 2 (List.length (Keyword.flag_color_to_keywords `Gray));
180
+
Alcotest.(check int) "green = 3 bits" 3 (List.length (Keyword.flag_color_to_keywords `Green))
181
+
182
+
let () =
183
+
Alcotest.run "Keyword" [
184
+
"of_string", [
185
+
Alcotest.test_case "standard keywords" `Quick test_of_string_standard;
186
+
Alcotest.test_case "no prefix" `Quick test_of_string_no_prefix;
187
+
Alcotest.test_case "case insensitive" `Quick test_of_string_case_insensitive;
188
+
Alcotest.test_case "IMAP format" `Quick test_of_string_imap_format;
189
+
Alcotest.test_case "spam keywords" `Quick test_of_string_spam;
190
+
Alcotest.test_case "extended keywords" `Quick test_of_string_extended;
191
+
Alcotest.test_case "flag bits" `Quick test_of_string_flag_bits;
192
+
Alcotest.test_case "custom" `Quick test_of_string_custom;
193
+
];
194
+
"to_string", [
195
+
Alcotest.test_case "JMAP format" `Quick test_to_string;
196
+
];
197
+
"to_imap_string", [
198
+
Alcotest.test_case "IMAP format" `Quick test_to_imap_string;
199
+
];
200
+
"predicates", [
201
+
Alcotest.test_case "is_standard" `Quick test_is_standard;
202
+
Alcotest.test_case "is_mutually_exclusive" `Quick test_mutual_exclusion;
203
+
];
204
+
"equality", [
205
+
Alcotest.test_case "equal" `Quick test_equal;
206
+
Alcotest.test_case "compare" `Quick test_compare;
207
+
];
208
+
"flag_color", [
209
+
Alcotest.test_case "of_keywords" `Quick test_flag_color_of_keywords;
210
+
Alcotest.test_case "to_keywords" `Quick test_flag_color_to_keywords;
211
+
];
212
+
]
+174
mail-flag/test/test_mailbox_attr.ml
+174
mail-flag/test/test_mailbox_attr.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Tests for the Mailbox_attr module. *)
7
+
8
+
open Mail_flag
9
+
10
+
let attr_testable =
11
+
Alcotest.testable Mailbox_attr.pp (fun a b ->
12
+
Mailbox_attr.to_string a = Mailbox_attr.to_string b)
13
+
14
+
(* A testable for special_use which is a subtype of t *)
15
+
let pp_special_use ppf (x : Mailbox_attr.special_use) =
16
+
Mailbox_attr.pp ppf (x :> Mailbox_attr.t)
17
+
18
+
let special_use_testable : Mailbox_attr.special_use Alcotest.testable =
19
+
Alcotest.testable pp_special_use (fun a b ->
20
+
Mailbox_attr.to_string (a :> Mailbox_attr.t) = Mailbox_attr.to_string (b :> Mailbox_attr.t))
21
+
22
+
let test_of_string_special_use () =
23
+
(* Test special-use attributes with backslash prefix *)
24
+
Alcotest.(check attr_testable) "\\Drafts" `Drafts (Mailbox_attr.of_string "\\Drafts");
25
+
Alcotest.(check attr_testable) "\\Sent" `Sent (Mailbox_attr.of_string "\\Sent");
26
+
Alcotest.(check attr_testable) "\\Trash" `Trash (Mailbox_attr.of_string "\\Trash");
27
+
Alcotest.(check attr_testable) "\\Junk" `Junk (Mailbox_attr.of_string "\\Junk");
28
+
Alcotest.(check attr_testable) "\\Archive" `Archive (Mailbox_attr.of_string "\\Archive");
29
+
Alcotest.(check attr_testable) "\\All" `All (Mailbox_attr.of_string "\\All");
30
+
Alcotest.(check attr_testable) "\\Flagged" `Flagged (Mailbox_attr.of_string "\\Flagged");
31
+
Alcotest.(check attr_testable) "\\Important" `Important (Mailbox_attr.of_string "\\Important");
32
+
Alcotest.(check attr_testable) "\\Inbox" `Inbox (Mailbox_attr.of_string "\\Inbox")
33
+
34
+
let test_of_string_no_backslash () =
35
+
(* Test special-use attributes without backslash prefix *)
36
+
Alcotest.(check attr_testable) "drafts" `Drafts (Mailbox_attr.of_string "drafts");
37
+
Alcotest.(check attr_testable) "sent" `Sent (Mailbox_attr.of_string "sent");
38
+
Alcotest.(check attr_testable) "trash" `Trash (Mailbox_attr.of_string "trash");
39
+
Alcotest.(check attr_testable) "inbox" `Inbox (Mailbox_attr.of_string "inbox")
40
+
41
+
let test_of_string_case_insensitive () =
42
+
(* Test case insensitivity *)
43
+
Alcotest.(check attr_testable) "DRAFTS" `Drafts (Mailbox_attr.of_string "DRAFTS");
44
+
Alcotest.(check attr_testable) "\\SENT" `Sent (Mailbox_attr.of_string "\\SENT");
45
+
Alcotest.(check attr_testable) "Trash" `Trash (Mailbox_attr.of_string "Trash")
46
+
47
+
let test_of_string_list_attrs () =
48
+
(* Test LIST attributes *)
49
+
Alcotest.(check attr_testable) "\\Noinferiors" `Noinferiors (Mailbox_attr.of_string "\\Noinferiors");
50
+
Alcotest.(check attr_testable) "\\Noselect" `Noselect (Mailbox_attr.of_string "\\Noselect");
51
+
Alcotest.(check attr_testable) "\\Marked" `Marked (Mailbox_attr.of_string "\\Marked");
52
+
Alcotest.(check attr_testable) "\\Unmarked" `Unmarked (Mailbox_attr.of_string "\\Unmarked");
53
+
Alcotest.(check attr_testable) "\\Subscribed" `Subscribed (Mailbox_attr.of_string "\\Subscribed");
54
+
Alcotest.(check attr_testable) "\\HasChildren" `HasChildren (Mailbox_attr.of_string "\\HasChildren");
55
+
Alcotest.(check attr_testable) "\\HasNoChildren" `HasNoChildren (Mailbox_attr.of_string "\\HasNoChildren");
56
+
Alcotest.(check attr_testable) "\\NonExistent" `NonExistent (Mailbox_attr.of_string "\\NonExistent");
57
+
Alcotest.(check attr_testable) "\\Remote" `Remote (Mailbox_attr.of_string "\\Remote")
58
+
59
+
let test_of_string_junk_alias () =
60
+
(* Test that "spam" is recognized as Junk *)
61
+
Alcotest.(check attr_testable) "spam" `Junk (Mailbox_attr.of_string "spam");
62
+
Alcotest.(check attr_testable) "\\Spam" `Junk (Mailbox_attr.of_string "\\Spam")
63
+
64
+
let test_of_string_extended () =
65
+
(* Test extended special-use attributes *)
66
+
Alcotest.(check attr_testable) "\\Snoozed" `Snoozed (Mailbox_attr.of_string "\\Snoozed");
67
+
Alcotest.(check attr_testable) "\\Scheduled" `Scheduled (Mailbox_attr.of_string "\\Scheduled");
68
+
Alcotest.(check attr_testable) "\\Memos" `Memos (Mailbox_attr.of_string "\\Memos")
69
+
70
+
let test_of_string_extension () =
71
+
(* Test unknown extensions *)
72
+
Alcotest.(check attr_testable) "X-Custom" (`Extension "x-custom") (Mailbox_attr.of_string "X-Custom");
73
+
Alcotest.(check attr_testable) "\\X-MyAttr" (`Extension "x-myattr") (Mailbox_attr.of_string "\\X-MyAttr")
74
+
75
+
let test_to_string () =
76
+
(* Test conversion to IMAP wire format *)
77
+
Alcotest.(check string) "Drafts" "\\Drafts" (Mailbox_attr.to_string `Drafts);
78
+
Alcotest.(check string) "Sent" "\\Sent" (Mailbox_attr.to_string `Sent);
79
+
Alcotest.(check string) "Trash" "\\Trash" (Mailbox_attr.to_string `Trash);
80
+
Alcotest.(check string) "Junk" "\\Junk" (Mailbox_attr.to_string `Junk);
81
+
Alcotest.(check string) "Inbox" "\\Inbox" (Mailbox_attr.to_string `Inbox);
82
+
Alcotest.(check string) "Noselect" "\\Noselect" (Mailbox_attr.to_string `Noselect);
83
+
Alcotest.(check string) "HasChildren" "\\HasChildren" (Mailbox_attr.to_string `HasChildren);
84
+
Alcotest.(check string) "Extension" "\\x-custom" (Mailbox_attr.to_string (`Extension "x-custom"))
85
+
86
+
let test_to_jmap_role () =
87
+
(* Test special-use to JMAP role conversion *)
88
+
Alcotest.(check (option string)) "drafts role" (Some "drafts") (Mailbox_attr.to_jmap_role `Drafts);
89
+
Alcotest.(check (option string)) "sent role" (Some "sent") (Mailbox_attr.to_jmap_role `Sent);
90
+
Alcotest.(check (option string)) "trash role" (Some "trash") (Mailbox_attr.to_jmap_role `Trash);
91
+
Alcotest.(check (option string)) "junk role" (Some "junk") (Mailbox_attr.to_jmap_role `Junk);
92
+
Alcotest.(check (option string)) "inbox role" (Some "inbox") (Mailbox_attr.to_jmap_role `Inbox);
93
+
Alcotest.(check (option string)) "archive role" (Some "archive") (Mailbox_attr.to_jmap_role `Archive);
94
+
Alcotest.(check (option string)) "all role" (Some "all") (Mailbox_attr.to_jmap_role `All);
95
+
Alcotest.(check (option string)) "flagged role" (Some "flagged") (Mailbox_attr.to_jmap_role `Flagged);
96
+
Alcotest.(check (option string)) "important role" (Some "important") (Mailbox_attr.to_jmap_role `Important);
97
+
Alcotest.(check (option string)) "snoozed role" (Some "snoozed") (Mailbox_attr.to_jmap_role `Snoozed);
98
+
Alcotest.(check (option string)) "scheduled role" (Some "scheduled") (Mailbox_attr.to_jmap_role `Scheduled);
99
+
Alcotest.(check (option string)) "memos role" (Some "memos") (Mailbox_attr.to_jmap_role `Memos);
100
+
(* LIST attributes have no JMAP role *)
101
+
Alcotest.(check (option string)) "noselect no role" None (Mailbox_attr.to_jmap_role `Noselect);
102
+
Alcotest.(check (option string)) "haschildren no role" None (Mailbox_attr.to_jmap_role `HasChildren);
103
+
Alcotest.(check (option string)) "extension no role" None (Mailbox_attr.to_jmap_role (`Extension "x"))
104
+
105
+
let test_of_jmap_role () =
106
+
(* Test JMAP role to special-use conversion *)
107
+
Alcotest.(check (option special_use_testable)) "drafts" (Some `Drafts) (Mailbox_attr.of_jmap_role "drafts");
108
+
Alcotest.(check (option special_use_testable)) "sent" (Some `Sent) (Mailbox_attr.of_jmap_role "sent");
109
+
Alcotest.(check (option special_use_testable)) "trash" (Some `Trash) (Mailbox_attr.of_jmap_role "trash");
110
+
Alcotest.(check (option special_use_testable)) "junk" (Some `Junk) (Mailbox_attr.of_jmap_role "junk");
111
+
Alcotest.(check (option special_use_testable)) "inbox" (Some `Inbox) (Mailbox_attr.of_jmap_role "inbox");
112
+
Alcotest.(check (option special_use_testable)) "unknown" None (Mailbox_attr.of_jmap_role "unknown")
113
+
114
+
let test_is_special_use () =
115
+
(* Test is_special_use predicate *)
116
+
Alcotest.(check bool) "drafts is special-use" true (Mailbox_attr.is_special_use `Drafts);
117
+
Alcotest.(check bool) "sent is special-use" true (Mailbox_attr.is_special_use `Sent);
118
+
Alcotest.(check bool) "inbox is special-use" true (Mailbox_attr.is_special_use `Inbox);
119
+
Alcotest.(check bool) "subscribed is special-use" true (Mailbox_attr.is_special_use `Subscribed);
120
+
(* LIST attributes are not special-use *)
121
+
Alcotest.(check bool) "noselect not special-use" false (Mailbox_attr.is_special_use `Noselect);
122
+
Alcotest.(check bool) "haschildren not special-use" false (Mailbox_attr.is_special_use `HasChildren);
123
+
Alcotest.(check bool) "extension not special-use" false (Mailbox_attr.is_special_use (`Extension "x"))
124
+
125
+
let test_is_selectable () =
126
+
(* Test is_selectable predicate *)
127
+
Alcotest.(check bool) "drafts selectable" true (Mailbox_attr.is_selectable `Drafts);
128
+
Alcotest.(check bool) "inbox selectable" true (Mailbox_attr.is_selectable `Inbox);
129
+
Alcotest.(check bool) "haschildren selectable" true (Mailbox_attr.is_selectable `HasChildren);
130
+
(* Noselect and NonExistent are not selectable *)
131
+
Alcotest.(check bool) "noselect not selectable" false (Mailbox_attr.is_selectable `Noselect);
132
+
Alcotest.(check bool) "nonexistent not selectable" false (Mailbox_attr.is_selectable `NonExistent)
133
+
134
+
let test_roundtrip () =
135
+
(* Test that to_string -> of_string preserves the attribute *)
136
+
let test_attr attr =
137
+
let s = Mailbox_attr.to_string attr in
138
+
Alcotest.(check attr_testable) ("roundtrip " ^ s) attr (Mailbox_attr.of_string s)
139
+
in
140
+
test_attr `Drafts;
141
+
test_attr `Sent;
142
+
test_attr `Trash;
143
+
test_attr `Junk;
144
+
test_attr `Inbox;
145
+
test_attr `Noselect;
146
+
test_attr `HasChildren;
147
+
test_attr `Snoozed
148
+
149
+
let () =
150
+
Alcotest.run "Mailbox_attr" [
151
+
"of_string", [
152
+
Alcotest.test_case "special-use with backslash" `Quick test_of_string_special_use;
153
+
Alcotest.test_case "special-use no backslash" `Quick test_of_string_no_backslash;
154
+
Alcotest.test_case "case insensitive" `Quick test_of_string_case_insensitive;
155
+
Alcotest.test_case "LIST attributes" `Quick test_of_string_list_attrs;
156
+
Alcotest.test_case "junk/spam alias" `Quick test_of_string_junk_alias;
157
+
Alcotest.test_case "extended attributes" `Quick test_of_string_extended;
158
+
Alcotest.test_case "extensions" `Quick test_of_string_extension;
159
+
];
160
+
"to_string", [
161
+
Alcotest.test_case "IMAP wire format" `Quick test_to_string;
162
+
];
163
+
"JMAP roles", [
164
+
Alcotest.test_case "to_jmap_role" `Quick test_to_jmap_role;
165
+
Alcotest.test_case "of_jmap_role" `Quick test_of_jmap_role;
166
+
];
167
+
"predicates", [
168
+
Alcotest.test_case "is_special_use" `Quick test_is_special_use;
169
+
Alcotest.test_case "is_selectable" `Quick test_is_selectable;
170
+
];
171
+
"roundtrip", [
172
+
Alcotest.test_case "to_string -> of_string" `Quick test_roundtrip;
173
+
];
174
+
]
+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
+
]
+52
-1
ocaml-imap/lib/imap/flag.ml
+52
-1
ocaml-imap/lib/imap/flag.ml
···
5
5
6
6
(** Message Flags
7
7
8
-
IMAP message flags as specified in RFC 9051 Section 2.3.2. *)
8
+
Re-exports from {!Mail_flag} for IMAP-specific use.
9
+
See {{:https://datatracker.ietf.org/doc/html/rfc9051#section-2.3.2}RFC 9051 Section 2.3.2}. *)
10
+
11
+
(** {1 System Flags} *)
9
12
10
13
type system =
11
14
| Seen (** Message has been read *)
···
20
23
| Flagged -> Fmt.string ppf "\\Flagged"
21
24
| Deleted -> Fmt.string ppf "\\Deleted"
22
25
| Draft -> Fmt.string ppf "\\Draft"
26
+
27
+
(** {1 Flags} *)
23
28
24
29
type t =
25
30
| System of system
···
47
52
| "\\DRAFT" -> Some (System Draft)
48
53
| _ ->
49
54
if String.length s > 0 && s.[0] <> '\\' then Some (Keyword s) else None
55
+
56
+
(** {1 Conversion to/from mail-flag} *)
57
+
58
+
let system_to_keyword : system -> Mail_flag.Keyword.t = function
59
+
| Seen -> `Seen
60
+
| Answered -> `Answered
61
+
| Flagged -> `Flagged
62
+
| Deleted -> `Deleted
63
+
| Draft -> `Draft
64
+
65
+
let system_of_keyword : Mail_flag.Keyword.standard -> system option = function
66
+
| `Seen -> Some Seen
67
+
| `Answered -> Some Answered
68
+
| `Flagged -> Some Flagged
69
+
| `Deleted -> Some Deleted
70
+
| `Draft -> Some Draft
71
+
| `Forwarded -> None
72
+
73
+
let to_mail_flag : t -> Mail_flag.Imap_wire.flag = function
74
+
| System Seen -> Mail_flag.Imap_wire.System `Seen
75
+
| System Answered -> Mail_flag.Imap_wire.System `Answered
76
+
| System Flagged -> Mail_flag.Imap_wire.System `Flagged
77
+
| System Deleted -> Mail_flag.Imap_wire.System `Deleted
78
+
| System Draft -> Mail_flag.Imap_wire.System `Draft
79
+
| Keyword k -> Mail_flag.Imap_wire.Keyword (Mail_flag.Keyword.of_string k)
80
+
81
+
let of_mail_flag : Mail_flag.Imap_wire.flag -> t = function
82
+
| Mail_flag.Imap_wire.System `Seen -> System Seen
83
+
| Mail_flag.Imap_wire.System `Answered -> System Answered
84
+
| Mail_flag.Imap_wire.System `Flagged -> System Flagged
85
+
| Mail_flag.Imap_wire.System `Deleted -> System Deleted
86
+
| Mail_flag.Imap_wire.System `Draft -> System Draft
87
+
| Mail_flag.Imap_wire.Keyword k -> Keyword (Mail_flag.Keyword.to_string k)
88
+
89
+
let to_keyword : t -> Mail_flag.Keyword.t = function
90
+
| System s -> system_to_keyword s
91
+
| Keyword k -> Mail_flag.Keyword.of_string k
92
+
93
+
let of_keyword (k : Mail_flag.Keyword.t) : t =
94
+
match k with
95
+
| `Seen -> System Seen
96
+
| `Answered -> System Answered
97
+
| `Flagged -> System Flagged
98
+
| `Deleted -> System Deleted
99
+
| `Draft -> System Draft
100
+
| other -> Keyword (Mail_flag.Keyword.to_string other)
+26
-1
ocaml-imap/lib/imap/flag.mli
+26
-1
ocaml-imap/lib/imap/flag.mli
···
5
5
6
6
(** Message Flags
7
7
8
-
IMAP message flags as specified in RFC 9051 Section 2.3.2. *)
8
+
Re-exports from {!Mail_flag} for IMAP-specific use.
9
+
See {{:https://datatracker.ietf.org/doc/html/rfc9051#section-2.3.2}RFC 9051 Section 2.3.2}. *)
9
10
10
11
(** {1 System Flags} *)
11
12
···
36
37
val pp : Format.formatter -> t -> unit
37
38
val to_string : t -> string
38
39
val of_string : string -> t option
40
+
41
+
(** {1 Conversion to/from mail-flag}
42
+
43
+
These functions allow interoperability with the {!Mail_flag} library
44
+
for cross-protocol flag handling. *)
45
+
46
+
val system_to_keyword : system -> Mail_flag.Keyword.t
47
+
(** [system_to_keyword sys] converts an IMAP system flag to a mail-flag keyword. *)
48
+
49
+
val system_of_keyword : Mail_flag.Keyword.standard -> system option
50
+
(** [system_of_keyword kw] converts a standard mail-flag keyword to an IMAP system flag.
51
+
Returns [None] for keywords like [`Forwarded] that have no IMAP system flag equivalent. *)
52
+
53
+
val to_mail_flag : t -> Mail_flag.Imap_wire.flag
54
+
(** [to_mail_flag flag] converts an IMAP flag to a mail-flag wire format flag. *)
55
+
56
+
val of_mail_flag : Mail_flag.Imap_wire.flag -> t
57
+
(** [of_mail_flag flag] converts a mail-flag wire format flag to an IMAP flag. *)
58
+
59
+
val to_keyword : t -> Mail_flag.Keyword.t
60
+
(** [to_keyword flag] converts an IMAP flag to a mail-flag keyword. *)
61
+
62
+
val of_keyword : Mail_flag.Keyword.t -> t
63
+
(** [of_keyword kw] converts a mail-flag keyword to an IMAP flag. *)
+102
-1
ocaml-imap/lib/imap/list_attr.ml
+102
-1
ocaml-imap/lib/imap/list_attr.ml
···
5
5
6
6
(** LIST Command Attributes
7
7
8
-
Mailbox attributes returned by LIST command.
8
+
Re-exports from {!Mail_flag.Mailbox_attr}.
9
9
See RFC 9051 Section 7.2.2. *)
10
10
11
11
type t =
···
43
43
| Extension s -> Fmt.string ppf s
44
44
45
45
let to_string a = Fmt.str "%a" pp a
46
+
47
+
let of_string s =
48
+
let s' = String.lowercase_ascii s in
49
+
(* Remove leading backslash if present *)
50
+
let s' = if String.length s' > 0 && s'.[0] = '\\' then
51
+
String.sub s' 1 (String.length s' - 1)
52
+
else s'
53
+
in
54
+
match s' with
55
+
| "noinferiors" -> Noinferiors
56
+
| "noselect" -> Noselect
57
+
| "marked" -> Marked
58
+
| "unmarked" -> Unmarked
59
+
| "subscribed" -> Subscribed
60
+
| "haschildren" -> Haschildren
61
+
| "hasnochildren" -> Hasnochildren
62
+
| "all" -> All
63
+
| "archive" -> Archive
64
+
| "drafts" -> Drafts
65
+
| "flagged" -> Flagged
66
+
| "junk" | "spam" -> Junk
67
+
| "sent" -> Sent
68
+
| "trash" -> Trash
69
+
| _ -> Extension s
70
+
71
+
(** {1 Conversion to/from mail-flag} *)
72
+
73
+
let to_mailbox_attr : t -> Mail_flag.Mailbox_attr.t = function
74
+
| Noinferiors -> `Noinferiors
75
+
| Noselect -> `Noselect
76
+
| Marked -> `Marked
77
+
| Unmarked -> `Unmarked
78
+
| Subscribed -> `Subscribed
79
+
| Haschildren -> `HasChildren
80
+
| Hasnochildren -> `HasNoChildren
81
+
| All -> `All
82
+
| Archive -> `Archive
83
+
| Drafts -> `Drafts
84
+
| Flagged -> `Flagged
85
+
| Junk -> `Junk
86
+
| Sent -> `Sent
87
+
| Trash -> `Trash
88
+
| Extension s -> `Extension s
89
+
90
+
let of_mailbox_attr : Mail_flag.Mailbox_attr.t -> t = function
91
+
| `Noinferiors -> Noinferiors
92
+
| `Noselect -> Noselect
93
+
| `Marked -> Marked
94
+
| `Unmarked -> Unmarked
95
+
| `Subscribed -> Subscribed
96
+
| `HasChildren -> Haschildren
97
+
| `HasNoChildren -> Hasnochildren
98
+
| `NonExistent -> Noselect (* NonExistent implies Noselect *)
99
+
| `Remote -> Extension "\\Remote"
100
+
| `All -> All
101
+
| `Archive -> Archive
102
+
| `Drafts -> Drafts
103
+
| `Flagged -> Flagged
104
+
| `Important -> Extension "\\Important"
105
+
| `Inbox -> Extension "\\Inbox"
106
+
| `Junk -> Junk
107
+
| `Sent -> Sent
108
+
| `Trash -> Trash
109
+
| `Snoozed -> Extension "\\Snoozed"
110
+
| `Scheduled -> Extension "\\Scheduled"
111
+
| `Memos -> Extension "\\Memos"
112
+
| `Extension s -> Extension s
113
+
114
+
let to_jmap_role : t -> string option = function
115
+
| All -> Some "all"
116
+
| Archive -> Some "archive"
117
+
| Drafts -> Some "drafts"
118
+
| Flagged -> Some "flagged"
119
+
| Junk -> Some "junk"
120
+
| Sent -> Some "sent"
121
+
| Trash -> Some "trash"
122
+
| Subscribed -> Some "subscribed"
123
+
| Noinferiors | Noselect | Marked | Unmarked
124
+
| Haschildren | Hasnochildren | Extension _ -> None
125
+
126
+
let of_jmap_role s =
127
+
match String.lowercase_ascii s with
128
+
| "all" -> Some All
129
+
| "archive" -> Some Archive
130
+
| "drafts" -> Some Drafts
131
+
| "flagged" -> Some Flagged
132
+
| "junk" -> Some Junk
133
+
| "sent" -> Some Sent
134
+
| "trash" -> Some Trash
135
+
| "subscribed" -> Some Subscribed
136
+
| _ -> None
137
+
138
+
let is_special_use = function
139
+
| All | Archive | Drafts | Flagged | Junk | Sent | Trash -> true
140
+
| Subscribed -> true (* Also a JMAP role *)
141
+
| Noinferiors | Noselect | Marked | Unmarked
142
+
| Haschildren | Hasnochildren | Extension _ -> false
143
+
144
+
let is_selectable = function
145
+
| Noselect -> false
146
+
| _ -> true
+29
-1
ocaml-imap/lib/imap/list_attr.mli
+29
-1
ocaml-imap/lib/imap/list_attr.mli
···
5
5
6
6
(** LIST Command Attributes
7
7
8
-
Mailbox attributes returned by LIST command.
8
+
Re-exports from {!Mail_flag.Mailbox_attr}.
9
9
See RFC 9051 Section 7.2.2. *)
10
10
11
11
type t =
···
27
27
28
28
val pp : Format.formatter -> t -> unit
29
29
val to_string : t -> string
30
+
val of_string : string -> t
31
+
32
+
(** {1 Conversion to/from mail-flag}
33
+
34
+
These functions allow interoperability with the {!Mail_flag} library
35
+
for cross-protocol attribute handling. *)
36
+
37
+
val to_mailbox_attr : t -> Mail_flag.Mailbox_attr.t
38
+
(** [to_mailbox_attr attr] converts an IMAP list attribute to a mail-flag mailbox attribute. *)
39
+
40
+
val of_mailbox_attr : Mail_flag.Mailbox_attr.t -> t
41
+
(** [of_mailbox_attr attr] converts a mail-flag mailbox attribute to an IMAP list attribute. *)
42
+
43
+
val to_jmap_role : t -> string option
44
+
(** [to_jmap_role attr] converts a special-use attribute to its JMAP role string.
45
+
Returns [None] for LIST attributes that don't correspond to JMAP roles. *)
46
+
47
+
val of_jmap_role : string -> t option
48
+
(** [of_jmap_role role] parses a JMAP role string into a special-use attribute.
49
+
Returns [None] if the role string is not recognized. *)
50
+
51
+
val is_special_use : t -> bool
52
+
(** [is_special_use attr] returns [true] if the attribute is a special-use
53
+
role (as opposed to a LIST attribute or extension). *)
54
+
55
+
val is_selectable : t -> bool
56
+
(** [is_selectable attr] returns [false] if the attribute indicates the
57
+
mailbox cannot be selected (i.e., [Noselect]). *)
+75
-145
ocaml-jmap/lib/core/jmap_types.ml
+75
-145
ocaml-jmap/lib/core/jmap_types.ml
···
82
82
(** {1 Keyword Type} *)
83
83
84
84
module Keyword = struct
85
-
(** RFC 8621 standard keywords *)
85
+
(** Re-export core types from mail-flag.
86
+
Note: mail-flag's [standard] type includes [`Deleted] (IMAP only)
87
+
which is not part of JMAP's standard keywords. The JMAP standard
88
+
keyword type below excludes [`Deleted] for JMAP compliance. *)
89
+
90
+
(** RFC 8621 standard keywords (JMAP subset of mail-flag standard).
91
+
This excludes [`Deleted] which is IMAP-only. *)
86
92
type standard = [
87
93
| `Seen
88
94
| `Flagged
···
95
101
]
96
102
97
103
(** draft-ietf-mailmaint extended keywords *)
98
-
type extended = [
99
-
| `Notify
100
-
| `Muted
101
-
| `Followed
102
-
| `Memo
103
-
| `HasMemo
104
-
| `HasAttachment
105
-
| `HasNoAttachment
106
-
| `AutoSent
107
-
| `Unsubscribed
108
-
| `CanUnsubscribe
109
-
| `Imported
110
-
| `IsTrusted
111
-
| `MaskedEmail
112
-
| `New
113
-
]
104
+
type extended = Mail_flag.Keyword.extended
114
105
115
106
(** Apple Mail flag color keywords *)
116
-
type flag_bits = [
117
-
| `MailFlagBit0
118
-
| `MailFlagBit1
119
-
| `MailFlagBit2
120
-
]
107
+
type flag_bits = Mail_flag.Keyword.flag_bit
121
108
109
+
(** Unified keyword type for JMAP.
110
+
This is compatible with mail-flag's keyword type but excludes [`Deleted]. *)
122
111
type t = [
123
112
| standard
124
113
| extended
···
126
115
| `Custom of string
127
116
]
128
117
129
-
let of_string = function
130
-
(* RFC 8621 standard keywords *)
131
-
| "$seen" -> `Seen
132
-
| "$flagged" -> `Flagged
133
-
| "$answered" -> `Answered
134
-
| "$draft" -> `Draft
135
-
| "$forwarded" -> `Forwarded
136
-
| "$phishing" -> `Phishing
137
-
| "$junk" -> `Junk
138
-
| "$notjunk" -> `NotJunk
139
-
(* draft-ietf-mailmaint extended keywords *)
140
-
| "$notify" -> `Notify
141
-
| "$muted" -> `Muted
142
-
| "$followed" -> `Followed
143
-
| "$memo" -> `Memo
144
-
| "$hasmemo" -> `HasMemo
145
-
| "$hasattachment" -> `HasAttachment
146
-
| "$hasnoattachment" -> `HasNoAttachment
147
-
| "$autosent" -> `AutoSent
148
-
| "$unsubscribed" -> `Unsubscribed
149
-
| "$canunsubscribe" -> `CanUnsubscribe
150
-
| "$imported" -> `Imported
151
-
| "$istrusted" -> `IsTrusted
152
-
| "$maskedemail" -> `MaskedEmail
153
-
| "$new" -> `New
154
-
(* Apple Mail flag color keywords *)
155
-
| "$MailFlagBit0" -> `MailFlagBit0
156
-
| "$MailFlagBit1" -> `MailFlagBit1
157
-
| "$MailFlagBit2" -> `MailFlagBit2
158
-
| s -> `Custom s
118
+
(** Convert from mail-flag keyword to JMAP keyword.
119
+
[`Deleted] is converted to a custom keyword since JMAP doesn't support it. *)
120
+
let of_mail_flag : Mail_flag.Keyword.t -> t = function
121
+
| `Deleted -> `Custom "$deleted"
122
+
| #t as k -> k
159
123
160
-
let to_string = function
161
-
(* RFC 8621 standard keywords *)
162
-
| `Seen -> "$seen"
163
-
| `Flagged -> "$flagged"
164
-
| `Answered -> "$answered"
165
-
| `Draft -> "$draft"
166
-
| `Forwarded -> "$forwarded"
167
-
| `Phishing -> "$phishing"
168
-
| `Junk -> "$junk"
169
-
| `NotJunk -> "$notjunk"
170
-
(* draft-ietf-mailmaint extended keywords *)
171
-
| `Notify -> "$notify"
172
-
| `Muted -> "$muted"
173
-
| `Followed -> "$followed"
174
-
| `Memo -> "$memo"
175
-
| `HasMemo -> "$hasmemo"
176
-
| `HasAttachment -> "$hasattachment"
177
-
| `HasNoAttachment -> "$hasnoattachment"
178
-
| `AutoSent -> "$autosent"
179
-
| `Unsubscribed -> "$unsubscribed"
180
-
| `CanUnsubscribe -> "$canunsubscribe"
181
-
| `Imported -> "$imported"
182
-
| `IsTrusted -> "$istrusted"
183
-
| `MaskedEmail -> "$maskedemail"
184
-
| `New -> "$new"
185
-
(* Apple Mail flag color keywords *)
186
-
| `MailFlagBit0 -> "$MailFlagBit0"
187
-
| `MailFlagBit1 -> "$MailFlagBit1"
188
-
| `MailFlagBit2 -> "$MailFlagBit2"
189
-
| `Custom s -> s
124
+
(** Convert JMAP keyword to mail-flag keyword. *)
125
+
let to_mail_flag (k : t) : Mail_flag.Keyword.t =
126
+
(k :> Mail_flag.Keyword.t)
127
+
128
+
let of_string s = of_mail_flag (Mail_flag.Keyword.of_string s)
129
+
130
+
let to_string (k : t) = Mail_flag.Keyword.to_string (to_mail_flag k)
190
131
191
132
let pp ppf k = Format.pp_print_string ppf (to_string k)
192
133
193
134
(** Apple Mail flag colors *)
194
-
type flag_color = [
195
-
| `Red
196
-
| `Orange
197
-
| `Yellow
198
-
| `Green
199
-
| `Blue
200
-
| `Purple
201
-
| `Gray
202
-
]
135
+
type flag_color = Mail_flag.Keyword.flag_color
203
136
204
137
let flag_color_of_keywords (keywords : t list) : flag_color option =
205
-
let has k = List.mem k keywords in
206
-
let bit0 = has `MailFlagBit0 in
207
-
let bit1 = has `MailFlagBit1 in
208
-
let bit2 = has `MailFlagBit2 in
209
-
match (bit0, bit1, bit2) with
210
-
| (false, false, false) -> Some `Red
211
-
| (true, false, false) -> Some `Orange
212
-
| (false, true, false) -> Some `Yellow
213
-
| (true, true, true) -> Some `Green
214
-
| (false, false, true) -> Some `Blue
215
-
| (true, false, true) -> Some `Purple
216
-
| (false, true, true) -> Some `Gray
217
-
| (true, true, false) -> None
138
+
let mail_flag_keywords = List.map to_mail_flag keywords in
139
+
Mail_flag.Keyword.flag_color_of_keywords mail_flag_keywords
218
140
219
-
let flag_color_to_keywords : flag_color -> t list = function
220
-
| `Red -> []
221
-
| `Orange -> [`MailFlagBit0]
222
-
| `Yellow -> [`MailFlagBit1]
223
-
| `Green -> [`MailFlagBit0; `MailFlagBit1; `MailFlagBit2]
224
-
| `Blue -> [`MailFlagBit2]
225
-
| `Purple -> [`MailFlagBit0; `MailFlagBit2]
226
-
| `Gray -> [`MailFlagBit1; `MailFlagBit2]
141
+
let flag_color_to_keywords (color : flag_color) : t list =
142
+
Mail_flag.Keyword.flag_color_to_keywords color
143
+
|> List.map of_mail_flag
227
144
end
228
145
229
146
(** {1 Mailbox Role Type} *)
230
147
231
148
module Role = struct
149
+
(** Re-export special-use mailbox attributes from mail-flag as JMAP roles.
150
+
JMAP roles correspond to the special_use subset of mailbox attributes. *)
151
+
232
152
(** RFC 8621 standard roles *)
233
153
type standard = [
234
154
| `Inbox
···
250
170
| `Memos
251
171
]
252
172
173
+
(** JMAP role type - corresponds to mail-flag's special_use type *)
253
174
type t = [
254
175
| standard
255
176
| extended
256
177
| `Custom of string
257
178
]
258
179
259
-
let of_string = function
260
-
(* RFC 8621 standard roles *)
261
-
| "inbox" -> `Inbox
262
-
| "sent" -> `Sent
263
-
| "drafts" -> `Drafts
264
-
| "trash" -> `Trash
265
-
| "junk" -> `Junk
266
-
| "archive" -> `Archive
267
-
| "flagged" -> `Flagged
268
-
| "important" -> `Important
269
-
| "all" -> `All
270
-
| "subscribed" -> `Subscribed
271
-
(* draft-ietf-mailmaint extended roles *)
272
-
| "snoozed" -> `Snoozed
273
-
| "scheduled" -> `Scheduled
274
-
| "memos" -> `Memos
275
-
| s -> `Custom s
180
+
(** Convert from mail-flag special_use to JMAP role *)
181
+
let of_special_use : Mail_flag.Mailbox_attr.special_use -> t = function
182
+
| `All -> `All
183
+
| `Archive -> `Archive
184
+
| `Drafts -> `Drafts
185
+
| `Flagged -> `Flagged
186
+
| `Important -> `Important
187
+
| `Inbox -> `Inbox
188
+
| `Junk -> `Junk
189
+
| `Sent -> `Sent
190
+
| `Subscribed -> `Subscribed
191
+
| `Trash -> `Trash
192
+
| `Snoozed -> `Snoozed
193
+
| `Scheduled -> `Scheduled
194
+
| `Memos -> `Memos
276
195
277
-
let to_string = function
278
-
(* RFC 8621 standard roles *)
279
-
| `Inbox -> "inbox"
280
-
| `Sent -> "sent"
281
-
| `Drafts -> "drafts"
282
-
| `Trash -> "trash"
283
-
| `Junk -> "junk"
284
-
| `Archive -> "archive"
285
-
| `Flagged -> "flagged"
286
-
| `Important -> "important"
287
-
| `All -> "all"
288
-
| `Subscribed -> "subscribed"
289
-
(* draft-ietf-mailmaint extended roles *)
290
-
| `Snoozed -> "snoozed"
291
-
| `Scheduled -> "scheduled"
292
-
| `Memos -> "memos"
196
+
(** Convert JMAP role to mail-flag special_use.
197
+
Returns None for custom roles that don't map to special_use. *)
198
+
let to_special_use : t -> Mail_flag.Mailbox_attr.special_use option = function
199
+
| `All -> Some `All
200
+
| `Archive -> Some `Archive
201
+
| `Drafts -> Some `Drafts
202
+
| `Flagged -> Some `Flagged
203
+
| `Important -> Some `Important
204
+
| `Inbox -> Some `Inbox
205
+
| `Junk -> Some `Junk
206
+
| `Sent -> Some `Sent
207
+
| `Subscribed -> Some `Subscribed
208
+
| `Trash -> Some `Trash
209
+
| `Snoozed -> Some `Snoozed
210
+
| `Scheduled -> Some `Scheduled
211
+
| `Memos -> Some `Memos
212
+
| `Custom _ -> None
213
+
214
+
let of_string s =
215
+
match Mail_flag.Mailbox_attr.of_jmap_role s with
216
+
| Some special_use -> of_special_use special_use
217
+
| None -> `Custom s
218
+
219
+
let to_string : t -> string = function
293
220
| `Custom s -> s
221
+
| #Mail_flag.Mailbox_attr.special_use as role ->
222
+
(* safe because to_jmap_role returns Some for all special_use *)
223
+
Option.get (Mail_flag.Mailbox_attr.to_jmap_role role)
294
224
295
225
let pp ppf r = Format.pp_print_string ppf (to_string r)
296
226
end