jon.recoil.org
forked from
anil.recoil.org/ocaml-jmap
this repo has no description
anil.recoil.org
1(*---------------------------------------------------------------------------
2 Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3 SPDX-License-Identifier: ISC
4 ---------------------------------------------------------------------------*)
5
6(** Email type as defined in RFC 8621 Section 4
7
8 @canonical Jmap.Proto.Email *)
9
10(** {1 Standard Keywords} *)
11
12(** Standard email keywords per RFC 8621 and draft-ietf-mailmaint.
13
14 Keywords are stored as strings in JMAP, but these constants provide
15 type-safe access to standard keywords. *)
16module Keyword : sig
17
18 (** {2 RFC 8621 Standard Keywords} *)
19
20 val draft : string
21 (** ["$draft"] - The Email is a draft the user is composing. *)
22
23 val seen : string
24 (** ["$seen"] - The Email has been read. *)
25
26 val flagged : string
27 (** ["$flagged"] - The Email has been flagged for urgent/special attention. *)
28
29 val answered : string
30 (** ["$answered"] - The Email has been replied to. *)
31
32 val forwarded : string
33 (** ["$forwarded"] - The Email has been forwarded. *)
34
35 val phishing : string
36 (** ["$phishing"] - The Email is highly likely to be phishing. *)
37
38 val junk : string
39 (** ["$junk"] - The Email is definitely spam. *)
40
41 val not_junk : string
42 (** ["$notjunk"] - The Email is definitely not spam. *)
43
44 (** {2 draft-ietf-mailmaint Extended Keywords} *)
45
46 val notify : string
47 (** ["$notify"] - A notification should be shown for this message. *)
48
49 val muted : string
50 (** ["$muted"] - The user is not interested in future replies to this thread. *)
51
52 val followed : string
53 (** ["$followed"] - The user is particularly interested in future replies
54 to this thread. Mutually exclusive with muted. *)
55
56 val memo : string
57 (** ["$memo"] - The message is a note-to-self regarding another message
58 in the same thread. *)
59
60 val has_memo : string
61 (** ["$hasmemo"] - The message has an associated memo with the $memo keyword. *)
62
63 val has_attachment : string
64 (** ["$hasattachment"] - The message has an attachment (server-set). *)
65
66 val has_no_attachment : string
67 (** ["$hasnoattachment"] - The message does not have an attachment (server-set). *)
68
69 val auto_sent : string
70 (** ["$autosent"] - The message was sent automatically as a response
71 due to a user rule or setting (e.g., vacation response). *)
72
73 val unsubscribed : string
74 (** ["$unsubscribed"] - The client has unsubscribed from this mailing list. *)
75
76 val can_unsubscribe : string
77 (** ["$canunsubscribe"] - The message has an RFC8058-compliant
78 List-Unsubscribe header. *)
79
80 val imported : string
81 (** ["$imported"] - The message was imported from another mailbox. *)
82
83 val is_trusted : string
84 (** ["$istrusted"] - The authenticity of the from name and email address
85 have been verified with complete confidence by the server. *)
86
87 val masked_email : string
88 (** ["$maskedemail"] - The message was received via an alias created for
89 an individual sender to hide the user's real email address. *)
90
91 val new_ : string
92 (** ["$new"] - The message should be made more prominent to the user
93 due to a recent action (e.g., awakening from snooze). *)
94
95 (** {2 Apple Mail Flag Color Keywords}
96
97 These 3 keywords form a 3-bit bitmask defining the flag color:
98 - 000 = red, 100 = orange, 010 = yellow, 111 = green
99 - 001 = blue, 101 = purple, 011 = gray
100
101 These are only meaningful when the message has the $flagged keyword set. *)
102
103 val mail_flag_bit0 : string
104 (** ["$MailFlagBit0"] - Bit 0 of the flag color bitmask. *)
105
106 val mail_flag_bit1 : string
107 (** ["$MailFlagBit1"] - Bit 1 of the flag color bitmask. *)
108
109 val mail_flag_bit2 : string
110 (** ["$MailFlagBit2"] - Bit 2 of the flag color bitmask. *)
111
112 (** {2 Flag Color Type}
113
114 High-level type for working with Apple Mail flag colors. *)
115
116 type flag_color = [
117 | `Red (** Bits: 000 *)
118 | `Orange (** Bits: 100 *)
119 | `Yellow (** Bits: 010 *)
120 | `Green (** Bits: 111 *)
121 | `Blue (** Bits: 001 *)
122 | `Purple (** Bits: 101 *)
123 | `Gray (** Bits: 011 *)
124 ]
125
126 val flag_color_to_keywords : flag_color -> string list
127 (** [flag_color_to_keywords color] returns the list of $MailFlagBit keywords
128 that should be set for the given color. *)
129
130 val flag_color_of_keywords : string list -> flag_color option
131 (** [flag_color_of_keywords keywords] extracts the flag color from a list
132 of keywords, if the $MailFlagBit keywords are present. Returns [None]
133 if no color bits are set (defaults to red when $flagged is set). *)
134end
135
136(** {1 Email Properties}
137
138 Polymorphic variants for type-safe property selection in Email/get requests.
139 These correspond to the properties defined in RFC 8621 Section 4.1. *)
140
141(** Metadata properties (RFC 8621 Section 4.1.1).
142 These represent data about the message in the mail store. *)
143type metadata_property = [
144 | `Id
145 | `Blob_id
146 | `Thread_id
147 | `Mailbox_ids
148 | `Keywords
149 | `Size
150 | `Received_at
151]
152
153(** Convenience header properties (RFC 8621 Section 4.1.3).
154 These are shortcuts for specific header:*:form properties. *)
155type header_convenience_property = [
156 | `Message_id (** = header:Message-ID:asMessageIds *)
157 | `In_reply_to (** = header:In-Reply-To:asMessageIds *)
158 | `References (** = header:References:asMessageIds *)
159 | `Sender (** = header:Sender:asAddresses *)
160 | `From (** = header:From:asAddresses *)
161 | `To (** = header:To:asAddresses *)
162 | `Cc (** = header:Cc:asAddresses *)
163 | `Bcc (** = header:Bcc:asAddresses *)
164 | `Reply_to (** = header:Reply-To:asAddresses *)
165 | `Subject (** = header:Subject:asText *)
166 | `Sent_at (** = header:Date:asDate *)
167 | `Headers (** All headers in raw form *)
168]
169
170(** Body properties (RFC 8621 Section 4.1.4).
171 These represent the message body structure and content. *)
172type body_property = [
173 | `Body_structure
174 | `Body_values
175 | `Text_body
176 | `Html_body
177 | `Attachments
178 | `Has_attachment
179 | `Preview
180]
181
182(** All standard Email properties. *)
183type standard_property = [
184 | metadata_property
185 | header_convenience_property
186 | body_property
187]
188
189(** A dynamic header property request.
190 Use [Mail_header.header_property] for type-safe construction. *)
191type header_property = [ `Header of Mail_header.header_property ]
192
193(** Any Email property - standard or dynamic header. *)
194type property = [ standard_property | header_property ]
195
196val property_to_string : [< property ] -> string
197(** Convert a property to its wire name (e.g., [`From] -> "from"). *)
198
199val property_of_string : string -> property option
200(** Parse a property name. Returns [None] for unrecognized properties.
201 Handles both standard properties and header:* properties. *)
202
203val standard_property_of_string : string -> standard_property option
204(** Parse only standard property names (not header:* properties). *)
205
206(** {1 Body Part Properties}
207
208 Properties that can be requested for EmailBodyPart objects
209 via the [bodyProperties] argument. *)
210
211type body_part_property = [
212 | `Part_id
213 | `Blob_id
214 | `Size
215 | `Part_headers (** Named [headers] in the wire format *)
216 | `Name
217 | `Type
218 | `Charset
219 | `Disposition
220 | `Cid
221 | `Language
222 | `Location
223 | `Sub_parts
224]
225
226val body_part_property_to_string : [< body_part_property ] -> string
227(** Convert a body part property to its wire name. *)
228
229val body_part_property_of_string : string -> body_part_property option
230(** Parse a body part property name. *)
231
232(** {1 Email Object} *)
233
234type t = {
235 (* Metadata - server-set, immutable *)
236 id : Proto_id.t option;
237 blob_id : Proto_id.t option;
238 thread_id : Proto_id.t option;
239 size : int64 option;
240 received_at : Ptime.t option;
241
242 (* Metadata - mutable *)
243 mailbox_ids : (Proto_id.t * bool) list option;
244 keywords : (string * bool) list option;
245
246 (* Parsed headers *)
247 message_id : string list option;
248 in_reply_to : string list option;
249 references : string list option;
250 sender : Mail_address.t list option;
251 from : Mail_address.t list option;
252 to_ : Mail_address.t list option;
253 cc : Mail_address.t list option;
254 bcc : Mail_address.t list option;
255 reply_to : Mail_address.t list option;
256 subject : string option;
257 sent_at : Ptime.t option;
258
259 (* Raw headers *)
260 headers : Mail_header.t list option;
261
262 (* Body structure *)
263 body_structure : Mail_body.Part.t option;
264 body_values : (string * Mail_body.Value.t) list option;
265 text_body : Mail_body.Part.t list option;
266 html_body : Mail_body.Part.t list option;
267 attachments : Mail_body.Part.t list option;
268 has_attachment : bool option;
269 preview : string option;
270
271 (* Dynamic header properties - stored as raw JSON for lazy decoding *)
272 dynamic_headers : (string * Jsont.json) list;
273 (** Raw header values from [header:*] property requests.
274 The key is the full property name (e.g., "header:X-Custom:asText").
275 Use {!decode_header_value} to parse into typed values. *)
276}
277
278(** {2 Accessors}
279
280 All accessors return [option] types since the response only includes
281 properties that were requested. *)
282
283val id : t -> Proto_id.t option
284val blob_id : t -> Proto_id.t option
285val thread_id : t -> Proto_id.t option
286val size : t -> int64 option
287val received_at : t -> Ptime.t option
288val mailbox_ids : t -> (Proto_id.t * bool) list option
289val keywords : t -> (string * bool) list option
290val message_id : t -> string list option
291val in_reply_to : t -> string list option
292val references : t -> string list option
293val sender : t -> Mail_address.t list option
294val from : t -> Mail_address.t list option
295val to_ : t -> Mail_address.t list option
296val cc : t -> Mail_address.t list option
297val bcc : t -> Mail_address.t list option
298val reply_to : t -> Mail_address.t list option
299val subject : t -> string option
300val sent_at : t -> Ptime.t option
301val headers : t -> Mail_header.t list option
302val body_structure : t -> Mail_body.Part.t option
303val body_values : t -> (string * Mail_body.Value.t) list option
304val text_body : t -> Mail_body.Part.t list option
305val html_body : t -> Mail_body.Part.t list option
306val attachments : t -> Mail_body.Part.t list option
307val has_attachment : t -> bool option
308val preview : t -> string option
309val dynamic_headers_raw : t -> (string * Jsont.json) list
310(** Get raw dynamic headers. Use {!decode_header_value} to parse them. *)
311
312(** {2 Dynamic Header Decoding} *)
313
314val decode_header_value : string -> Jsont.json -> Mail_header.header_value option
315(** [decode_header_value prop_name json] decodes a raw JSON value into a typed
316 header value based on the property name. The property name determines the form:
317 - [header:Name] or [header:Name:all] -> Raw/Text (String_single/String_all)
318 - [header:Name:asText] -> Text (String_single)
319 - [header:Name:asAddresses] -> Addresses (Addresses_single)
320 - [header:Name:asGroupedAddresses] -> Grouped (Grouped_single)
321 - [header:Name:asMessageIds] -> MessageIds (Strings_single)
322 - [header:Name:asDate] -> Date (Date_single)
323 - [header:Name:asURLs] -> URLs (Strings_single)
324 Returns [None] if the property name is invalid or decoding fails. *)
325
326val get_header : t -> string -> Mail_header.header_value option
327(** [get_header email key] looks up and decodes a dynamic header by its full
328 property name. E.g., [get_header email "header:X-Custom:asText"]. *)
329
330val get_header_string : t -> string -> string option
331(** [get_header_string email key] looks up a string header value.
332 Returns [None] if not found or if the value is not a string type. *)
333
334val get_header_addresses : t -> string -> Mail_address.t list option
335(** [get_header_addresses email key] looks up an addresses header value.
336 Returns [None] if not found or if the value is not an addresses type. *)
337
338val jsont : t Jsont.t
339(** Permissive JSON codec that handles any subset of properties.
340 Unknown [header:*] properties are decoded into {!dynamic_headers}. *)
341
342(** {1 Email Filter Conditions} *)
343
344module Filter_condition : sig
345 type t = {
346 in_mailbox : Proto_id.t option;
347 in_mailbox_other_than : Proto_id.t list option;
348 before : Ptime.t option;
349 after : Ptime.t option;
350 min_size : int64 option;
351 max_size : int64 option;
352 all_in_thread_have_keyword : string option;
353 some_in_thread_have_keyword : string option;
354 none_in_thread_have_keyword : string option;
355 has_keyword : string option;
356 not_keyword : string option;
357 has_attachment : bool option;
358 text : string option;
359 from : string option;
360 to_ : string option;
361 cc : string option;
362 bcc : string option;
363 subject : string option;
364 body : string option;
365 header : (string * string option) option;
366 }
367
368 val jsont : t Jsont.t
369end
370
371(** {1 Email/get Arguments} *)
372
373(** Extra arguments for Email/get beyond standard /get.
374
375 Note: The standard [properties] argument from [Proto_method.get_args]
376 should use {!property} variants converted via {!property_to_string}. *)
377type get_args_extra = {
378 body_properties : body_part_property list option;
379 (** Properties to fetch for each EmailBodyPart.
380 If omitted, defaults to all properties. *)
381 fetch_text_body_values : bool;
382 (** If [true], fetch body values for text/* parts in textBody. *)
383 fetch_html_body_values : bool;
384 (** If [true], fetch body values for text/* parts in htmlBody. *)
385 fetch_all_body_values : bool;
386 (** If [true], fetch body values for all text/* parts. *)
387 max_body_value_bytes : int64 option;
388 (** Maximum size of body values to return. Larger values are truncated. *)
389}
390
391val get_args_extra :
392 ?body_properties:body_part_property list ->
393 ?fetch_text_body_values:bool ->
394 ?fetch_html_body_values:bool ->
395 ?fetch_all_body_values:bool ->
396 ?max_body_value_bytes:int64 ->
397 unit ->
398 get_args_extra
399(** Convenience constructor with sensible defaults. *)
400
401val get_args_extra_jsont : get_args_extra Jsont.t
402
403(** {1 Conversion to/from mail-flag Keywords} *)
404
405val keywords_to_assoc : Mail_flag.Keyword.t list -> (string * bool) list
406(** [keywords_to_assoc keywords] converts a list of mail-flag keywords to
407 JMAP keywords object entries. Each keyword is converted to a [(string, true)]
408 pair using {!Mail_flag.Keyword.to_string} for the string representation.
409
410 Example:
411 {[
412 keywords_to_assoc [`Seen; `Flagged; `Custom "label"]
413 (* returns [("$seen", true); ("$flagged", true); ("label", true)] *)
414 ]} *)
415
416val keywords_of_assoc : (string * bool) list -> Mail_flag.Keyword.t list
417(** [keywords_of_assoc assoc] parses JMAP keywords from object entries.
418 Only entries with [true] value are included in the result.
419 Entries with [false] value are ignored (they represent the absence
420 of the keyword).
421
422 Example:
423 {[
424 keywords_of_assoc [("$seen", true); ("$draft", false); ("label", true)]
425 (* returns [`Seen; `Custom "label"] *)
426 ]} *)