My agentic slop goes here. Not intended for anyone else!
anil.recoil.org
1(** JMAP Email Type
2
3 An Email represents an immutable RFC 5322 message. All metadata extracted
4 from the message (headers, MIME structure, etc.) is exposed through
5 structured properties.
6
7open Jmap_core
8
9 Reference: RFC 8621 Section 4 (Emails)
10 Test files:
11 - test/data/mail/email_get_request.json
12 - test/data/mail/email_get_response.json
13 - test/data/mail/email_get_full_request.json
14 - test/data/mail/email_get_full_response.json
15 - test/data/mail/email_query_request.json
16 - test/data/mail/email_query_response.json
17 - test/data/mail/email_set_request.json
18 - test/data/mail/email_set_response.json
19 - test/data/mail/email_import_request.json
20 - test/data/mail/email_import_response.json
21 - test/data/mail/email_parse_request.json
22 - test/data/mail/email_parse_response.json
23*)
24
25(** Email address type (RFC 8621 Section 4.1.2.2) *)
26module EmailAddress = struct
27 type t = {
28 name : string option; (** Display name (e.g., "John Doe") *)
29 email : string; (** Email address (e.g., "john@example.com") *)
30 }
31
32 (** Parse EmailAddress from JSON.
33 Test files: test/data/mail/email_get_response.json (from, to, cc, etc.)
34
35 Expected structure:
36 {
37 "name": "Bob Smith",
38 "email": "bob@example.com"
39 }
40 *)
41 let of_json json =
42 let open Jmap_core.Parser.Helpers in
43 let fields = expect_object json in
44 let name = get_string_opt "name" fields in
45 let email = get_string "email" fields in
46 { name; email }
47
48 let to_json t =
49 let fields = [("email", `String t.email)] in
50 let fields = match t.name with
51 | Some n -> ("name", `String n) :: fields
52 | None -> fields
53 in
54 `O fields
55
56 (* Accessors *)
57 let name t = t.name
58 let email t = t.email
59
60 (* Constructor *)
61 let v ?name ~email () =
62 { name; email }
63end
64
65(** Email header field (RFC 8621 Section 4.1.4) *)
66module EmailHeader = struct
67 type t = {
68 name : string; (** Header field name (case-insensitive) *)
69 value : string; (** Header field value (decoded) *)
70 }
71
72 let of_json json =
73 let open Jmap_core.Parser.Helpers in
74 let fields = expect_object json in
75 let name = get_string "name" fields in
76 let value = get_string "value" fields in
77 { name; value }
78
79 let to_json t =
80 `O [
81 ("name", `String t.name);
82 ("value", `String t.value);
83 ]
84
85 (* Accessors *)
86 let name t = t.name
87 let value t = t.value
88
89 (* Constructor *)
90 let v ~name ~value =
91 { name; value }
92end
93
94(** MIME body part structure (RFC 8621 Section 4.1.4) *)
95module BodyPart = struct
96 type t = {
97 part_id : string option; (** Part ID for referencing this part *)
98 blob_id : Jmap_core.Id.t option; (** Blob ID for fetching raw content *)
99 size : Jmap_core.Primitives.UnsignedInt.t; (** Size in octets *)
100 headers : EmailHeader.t list; (** All header fields *)
101 name : string option; (** Name from Content-Disposition or Content-Type *)
102 type_ : string; (** Content-Type value (e.g., "text/plain") *)
103 charset : string option; (** Charset parameter from Content-Type *)
104 disposition : string option; (** Content-Disposition value (e.g., "attachment") *)
105 cid : string option; (** Content-ID value (without angle brackets) *)
106 language : string list option; (** Content-Language values *)
107 location : string option; (** Content-Location value *)
108 sub_parts : t list option; (** Sub-parts for multipart/* types *)
109 }
110
111 (** Parse BodyPart from JSON.
112 Test files: test/data/mail/email_get_full_response.json (bodyStructure, textBody, etc.)
113
114 Expected structure (leaf part):
115 {
116 "partId": "1",
117 "blobId": "Gb5f13e2d7b8a9c0d1e2f3a4b5c6d7e8",
118 "size": 2134,
119 "headers": [...],
120 "type": "text/plain",
121 "charset": "utf-8",
122 "disposition": null,
123 "cid": null,
124 "language": null,
125 "location": null
126 }
127
128 Or multipart:
129 {
130 "type": "multipart/mixed",
131 "subParts": [...]
132 }
133 *)
134 let rec of_json json =
135 let open Jmap_core.Parser.Helpers in
136 let fields = expect_object json in
137 let part_id = get_string_opt "partId" fields in
138 let blob_id = match find_field "blobId" fields with
139 | Some (`String s) -> Some (Jmap_core.Id.of_string s)
140 | Some `Null | None -> None
141 | Some _ -> raise (Jmap_core.Error.Parse_error "blobId must be a string")
142 in
143 let size = match find_field "size" fields with
144 | Some s -> Jmap_core.Primitives.UnsignedInt.of_json s
145 | None -> Jmap_core.Primitives.UnsignedInt.of_int 0
146 in
147 let headers = match find_field "headers" fields with
148 | Some (`A items) -> List.map EmailHeader.of_json items
149 | Some `Null | None -> []
150 | Some _ -> raise (Jmap_core.Error.Parse_error "headers must be an array")
151 in
152 let name = get_string_opt "name" fields in
153 let type_ = get_string "type" fields in
154 let charset = get_string_opt "charset" fields in
155 let disposition = get_string_opt "disposition" fields in
156 let cid = get_string_opt "cid" fields in
157 let language = match find_field "language" fields with
158 | Some (`A items) -> Some (List.map expect_string items)
159 | Some `Null | None -> None
160 | Some _ -> raise (Jmap_core.Error.Parse_error "language must be an array")
161 in
162 let location = get_string_opt "location" fields in
163 let sub_parts = match find_field "subParts" fields with
164 | Some (`A items) -> Some (List.map of_json items)
165 | Some `Null | None -> None
166 | Some _ -> raise (Jmap_core.Error.Parse_error "subParts must be an array")
167 in
168 { part_id; blob_id; size; headers; name; type_; charset;
169 disposition; cid; language; location; sub_parts }
170
171 let rec to_json t =
172 let fields = [("type", `String t.type_)] in
173 let fields = match t.part_id with
174 | Some id -> ("partId", `String id) :: fields
175 | None -> fields
176 in
177 let fields = match t.blob_id with
178 | Some id -> ("blobId", Jmap_core.Id.to_json id) :: fields
179 | None -> fields
180 in
181 let fields = ("size", Jmap_core.Primitives.UnsignedInt.to_json t.size) :: fields in
182 let fields = if t.headers <> [] then
183 ("headers", `A (List.map EmailHeader.to_json t.headers)) :: fields
184 else
185 fields
186 in
187 let fields = match t.name with
188 | Some n -> ("name", `String n) :: fields
189 | None -> fields
190 in
191 let fields = match t.charset with
192 | Some c -> ("charset", `String c) :: fields
193 | None -> fields
194 in
195 let fields = match t.disposition with
196 | Some d -> ("disposition", `String d) :: fields
197 | None -> fields
198 in
199 let fields = match t.cid with
200 | Some c -> ("cid", `String c) :: fields
201 | None -> fields
202 in
203 let fields = match t.language with
204 | Some l -> ("language", `A (List.map (fun s -> `String s) l)) :: fields
205 | None -> fields
206 in
207 let fields = match t.location with
208 | Some l -> ("location", `String l) :: fields
209 | None -> fields
210 in
211 let fields = match t.sub_parts with
212 | Some parts -> ("subParts", `A (List.map to_json parts)) :: fields
213 | None -> fields
214 in
215 `O fields
216
217 (* Accessors *)
218 let part_id t = t.part_id
219 let blob_id t = t.blob_id
220 let size t = t.size
221 let headers t = t.headers
222 let name t = t.name
223 let type_ t = t.type_
224 let charset t = t.charset
225 let disposition t = t.disposition
226 let cid t = t.cid
227 let language t = t.language
228 let location t = t.location
229 let sub_parts t = t.sub_parts
230
231 (* Constructor *)
232 let v ?part_id ?blob_id ~size ~headers ?name ~type_ ?charset
233 ?disposition ?cid ?language ?location ?sub_parts () =
234 { part_id; blob_id; size; headers; name; type_; charset;
235 disposition; cid; language; location; sub_parts }
236end
237
238(** Body value content (RFC 8621 Section 4.1.4.3) *)
239module BodyValue = struct
240 type t = {
241 value : string; (** Decoded body part content *)
242 is_encoding_problem : bool; (** True if charset decoding failed *)
243 is_truncated : bool; (** True if value was truncated due to size limits *)
244 }
245
246 (** Parse BodyValue from JSON.
247 Test files: test/data/mail/email_get_full_response.json (bodyValues field)
248
249 Expected structure:
250 {
251 "value": "Hi Alice,\n\nHere's the latest update...",
252 "isEncodingProblem": false,
253 "isTruncated": false
254 }
255 *)
256 let of_json json =
257 let open Jmap_core.Parser.Helpers in
258 let fields = expect_object json in
259 let value = get_string "value" fields in
260 let is_encoding_problem = get_bool_opt "isEncodingProblem" fields false in
261 let is_truncated = get_bool_opt "isTruncated" fields false in
262 { value; is_encoding_problem; is_truncated }
263
264 let to_json t =
265 `O [
266 ("value", `String t.value);
267 ("isEncodingProblem", `Bool t.is_encoding_problem);
268 ("isTruncated", `Bool t.is_truncated);
269 ]
270
271 (* Accessors *)
272 let value t = t.value
273 let is_encoding_problem t = t.is_encoding_problem
274 let is_truncated t = t.is_truncated
275
276 (* Constructor *)
277 let v ~value ~is_encoding_problem ~is_truncated =
278 { value; is_encoding_problem; is_truncated }
279end
280
281(** Email object type (RFC 8621 Section 4.1) *)
282type t = {
283 (* Metadata properties *)
284 id : Jmap_core.Id.t; (** Immutable server-assigned id *)
285 blob_id : Jmap_core.Id.t; (** Blob ID for downloading raw message *)
286 thread_id : Jmap_core.Id.t; (** Thread ID this email belongs to *)
287 mailbox_ids : (Jmap_core.Id.t * bool) list; (** Map of mailbox IDs to true *)
288 keywords : (string * bool) list; (** Map of keywords to true (e.g., "$seen") *)
289 size : Jmap_core.Primitives.UnsignedInt.t; (** Size in octets *)
290 received_at : Jmap_core.Primitives.UTCDate.t; (** Date message was received *)
291
292 (* Header properties - commonly used headers *)
293 message_id : string list option; (** Message-ID header field values *)
294 in_reply_to : string list option; (** In-Reply-To header field values *)
295 references : string list option; (** References header field values *)
296 sender : EmailAddress.t list option; (** Sender header *)
297 from : EmailAddress.t list option; (** From header *)
298 to_ : EmailAddress.t list option; (** To header *)
299 cc : EmailAddress.t list option; (** Cc header *)
300 bcc : EmailAddress.t list option; (** Bcc header *)
301 reply_to : EmailAddress.t list option; (** Reply-To header *)
302 subject : string option; (** Subject header *)
303 sent_at : Jmap_core.Primitives.Date.t option; (** Date header *)
304
305 (* Body properties *)
306 body_structure : BodyPart.t option; (** Full MIME structure *)
307 body_values : (string * BodyValue.t) list option; (** Map of partId to decoded content *)
308 text_body : BodyPart.t list option; (** Text/plain parts for rendering *)
309 html_body : BodyPart.t list option; (** Text/html parts for rendering *)
310 attachments : BodyPart.t list option; (** All attachment parts *)
311 has_attachment : bool; (** True if email has attachments *)
312 preview : string; (** Short plaintext preview (up to 256 chars) *)
313}
314
315(** Accessors *)
316let id t = t.id
317let blob_id t = t.blob_id
318let thread_id t = t.thread_id
319let mailbox_ids t = t.mailbox_ids
320let keywords t = t.keywords
321let size t = t.size
322let received_at t = t.received_at
323let message_id t = t.message_id
324let in_reply_to t = t.in_reply_to
325let references t = t.references
326let sender t = t.sender
327let from t = t.from
328let to_ t = t.to_
329let cc t = t.cc
330let bcc t = t.bcc
331let reply_to t = t.reply_to
332let subject t = t.subject
333let sent_at t = t.sent_at
334let body_structure t = t.body_structure
335let body_values t = t.body_values
336let text_body t = t.text_body
337let html_body t = t.html_body
338let attachments t = t.attachments
339let has_attachment t = t.has_attachment
340let preview t = t.preview
341
342(** Constructor *)
343let v ~id ~blob_id ~thread_id ~mailbox_ids ~keywords ~size ~received_at
344 ?message_id ?in_reply_to ?references ?sender ?from ?to_ ?cc ?bcc
345 ?reply_to ?subject ?sent_at ?body_structure ?body_values ?text_body
346 ?html_body ?attachments ~has_attachment ~preview () =
347 { id; blob_id; thread_id; mailbox_ids; keywords; size; received_at;
348 message_id; in_reply_to; references; sender; from; to_; cc; bcc;
349 reply_to; subject; sent_at; body_structure; body_values; text_body;
350 html_body; attachments; has_attachment; preview }
351
352(** Parse Email from JSON.
353 Test files: test/data/mail/email_get_response.json (list field)
354
355 Expected structure:
356 {
357 "id": "e001",
358 "blobId": "Ge5f13e2d7b8a9c0d1e2f3a4b5c6d7e8f9a0b1c2d3e4f5a6b7c8",
359 "threadId": "t001",
360 "mailboxIds": { "mb001": true },
361 "keywords": { "$seen": true },
362 "size": 15234,
363 "receivedAt": "2025-10-05T09:15:30Z",
364 ...
365 }
366*)
367let of_json json =
368 let open Jmap_core.Parser.Helpers in
369 let fields = expect_object json in
370
371 (* Required fields *)
372 let id = Jmap_core.Id.of_json (require_field "id" fields) in
373 let blob_id = Jmap_core.Id.of_json (require_field "blobId" fields) in
374 let thread_id = Jmap_core.Id.of_json (require_field "threadId" fields) in
375
376 (* mailboxIds - map of id -> bool *)
377 let mailbox_ids = match require_field "mailboxIds" fields with
378 | `O map_fields ->
379 List.map (fun (k, v) ->
380 (Jmap_core.Id.of_string k, expect_bool v)
381 ) map_fields
382 | _ -> raise (Jmap_core.Error.Parse_error "mailboxIds must be an object")
383 in
384
385 (* keywords - map of string -> bool *)
386 let keywords = match require_field "keywords" fields with
387 | `O map_fields ->
388 List.map (fun (k, v) -> (k, expect_bool v)) map_fields
389 | _ -> raise (Jmap_core.Error.Parse_error "keywords must be an object")
390 in
391
392 let size = Jmap_core.Primitives.UnsignedInt.of_json (require_field "size" fields) in
393 let received_at = Jmap_core.Primitives.UTCDate.of_json (require_field "receivedAt" fields) in
394
395 (* Optional header fields *)
396 let message_id = match find_field "messageId" fields with
397 | Some (`A items) -> Some (List.map expect_string items)
398 | Some `Null | None -> None
399 | Some _ -> raise (Jmap_core.Error.Parse_error "messageId must be an array")
400 in
401 let in_reply_to = match find_field "inReplyTo" fields with
402 | Some (`A items) -> Some (List.map expect_string items)
403 | Some `Null | None -> None
404 | Some _ -> raise (Jmap_core.Error.Parse_error "inReplyTo must be an array")
405 in
406 let references = match find_field "references" fields with
407 | Some (`A items) -> Some (List.map expect_string items)
408 | Some `Null | None -> None
409 | Some _ -> raise (Jmap_core.Error.Parse_error "references must be an array")
410 in
411 let sender = match find_field "sender" fields with
412 | Some (`A items) -> Some (List.map EmailAddress.of_json items)
413 | Some `Null | None -> None
414 | Some _ -> raise (Jmap_core.Error.Parse_error "sender must be an array")
415 in
416 let from = match find_field "from" fields with
417 | Some (`A items) -> Some (List.map EmailAddress.of_json items)
418 | Some `Null | None -> None
419 | Some _ -> raise (Jmap_core.Error.Parse_error "from must be an array")
420 in
421 let to_ = match find_field "to" fields with
422 | Some (`A items) -> Some (List.map EmailAddress.of_json items)
423 | Some `Null | None -> None
424 | Some _ -> raise (Jmap_core.Error.Parse_error "to must be an array")
425 in
426 let cc = match find_field "cc" fields with
427 | Some (`A items) -> Some (List.map EmailAddress.of_json items)
428 | Some `Null | None -> None
429 | Some _ -> raise (Jmap_core.Error.Parse_error "cc must be an array")
430 in
431 let bcc = match find_field "bcc" fields with
432 | Some (`A items) -> Some (List.map EmailAddress.of_json items)
433 | Some `Null | None -> None
434 | Some _ -> raise (Jmap_core.Error.Parse_error "bcc must be an array")
435 in
436 let reply_to = match find_field "replyTo" fields with
437 | Some (`A items) -> Some (List.map EmailAddress.of_json items)
438 | Some `Null | None -> None
439 | Some _ -> raise (Jmap_core.Error.Parse_error "replyTo must be an array")
440 in
441 let subject = get_string_opt "subject" fields in
442 let sent_at = match find_field "sentAt" fields with
443 | Some (`String s) -> Some (Jmap_core.Primitives.Date.of_string s)
444 | Some `Null | None -> None
445 | Some _ -> raise (Jmap_core.Error.Parse_error "sentAt must be a string")
446 in
447
448 (* Body properties *)
449 let body_structure = match find_field "bodyStructure" fields with
450 | Some ((`O _) as json) -> Some (BodyPart.of_json json)
451 | Some `Null | None -> None
452 | Some _ -> raise (Jmap_core.Error.Parse_error "bodyStructure must be an object")
453 in
454
455 (* bodyValues - map of partId -> BodyValue *)
456 let body_values = match find_field "bodyValues" fields with
457 | Some (`O map_fields) ->
458 Some (List.map (fun (k, v) -> (k, BodyValue.of_json v)) map_fields)
459 | Some `Null | None -> None
460 | Some _ -> raise (Jmap_core.Error.Parse_error "bodyValues must be an object")
461 in
462
463 let text_body = match find_field "textBody" fields with
464 | Some (`A items) -> Some (List.map BodyPart.of_json items)
465 | Some `Null | None -> None
466 | Some _ -> raise (Jmap_core.Error.Parse_error "textBody must be an array")
467 in
468 let html_body = match find_field "htmlBody" fields with
469 | Some (`A items) -> Some (List.map BodyPart.of_json items)
470 | Some `Null | None -> None
471 | Some _ -> raise (Jmap_core.Error.Parse_error "htmlBody must be an array")
472 in
473 let attachments = match find_field "attachments" fields with
474 | Some (`A items) -> Some (List.map BodyPart.of_json items)
475 | Some `Null | None -> None
476 | Some _ -> raise (Jmap_core.Error.Parse_error "attachments must be an array")
477 in
478
479 let has_attachment = get_bool_opt "hasAttachment" fields false in
480 let preview = get_string "preview" fields in
481
482 { id; blob_id; thread_id; mailbox_ids; keywords; size; received_at;
483 message_id; in_reply_to; references; sender; from; to_; cc; bcc;
484 reply_to; subject; sent_at; body_structure; body_values; text_body;
485 html_body; attachments; has_attachment; preview }
486
487let to_json t =
488 let fields = [
489 ("id", Jmap_core.Id.to_json t.id);
490 ("blobId", Jmap_core.Id.to_json t.blob_id);
491 ("threadId", Jmap_core.Id.to_json t.thread_id);
492 ("mailboxIds", `O (List.map (fun (id, b) ->
493 (Jmap_core.Id.to_string id, `Bool b)) t.mailbox_ids));
494 ("keywords", `O (List.map (fun (k, b) -> (k, `Bool b)) t.keywords));
495 ("size", Jmap_core.Primitives.UnsignedInt.to_json t.size);
496 ("receivedAt", Jmap_core.Primitives.UTCDate.to_json t.received_at);
497 ("hasAttachment", `Bool t.has_attachment);
498 ("preview", `String t.preview);
499 ] in
500
501 (* Add optional fields *)
502 let fields = match t.message_id with
503 | Some ids -> ("messageId", `A (List.map (fun s -> `String s) ids)) :: fields
504 | None -> fields
505 in
506 let fields = match t.in_reply_to with
507 | Some ids -> ("inReplyTo", `A (List.map (fun s -> `String s) ids)) :: fields
508 | None -> fields
509 in
510 let fields = match t.references with
511 | Some ids -> ("references", `A (List.map (fun s -> `String s) ids)) :: fields
512 | None -> fields
513 in
514 let fields = match t.sender with
515 | Some addrs -> ("sender", `A (List.map EmailAddress.to_json addrs)) :: fields
516 | None -> fields
517 in
518 let fields = match t.from with
519 | Some addrs -> ("from", `A (List.map EmailAddress.to_json addrs)) :: fields
520 | None -> fields
521 in
522 let fields = match t.to_ with
523 | Some addrs -> ("to", `A (List.map EmailAddress.to_json addrs)) :: fields
524 | None -> fields
525 in
526 let fields = match t.cc with
527 | Some addrs -> ("cc", `A (List.map EmailAddress.to_json addrs)) :: fields
528 | None -> fields
529 in
530 let fields = match t.bcc with
531 | Some addrs -> ("bcc", `A (List.map EmailAddress.to_json addrs)) :: fields
532 | None -> fields
533 in
534 let fields = match t.reply_to with
535 | Some addrs -> ("replyTo", `A (List.map EmailAddress.to_json addrs)) :: fields
536 | None -> fields
537 in
538 let fields = match t.subject with
539 | Some s -> ("subject", `String s) :: fields
540 | None -> fields
541 in
542 let fields = match t.sent_at with
543 | Some d -> ("sentAt", Jmap_core.Primitives.Date.to_json d) :: fields
544 | None -> fields
545 in
546 let fields = match t.body_structure with
547 | Some bs -> ("bodyStructure", BodyPart.to_json bs) :: fields
548 | None -> fields
549 in
550 let fields = match t.body_values with
551 | Some bv -> ("bodyValues", `O (List.map (fun (k, v) ->
552 (k, BodyValue.to_json v)) bv)) :: fields
553 | None -> fields
554 in
555 let fields = match t.text_body with
556 | Some tb -> ("textBody", `A (List.map BodyPart.to_json tb)) :: fields
557 | None -> fields
558 in
559 let fields = match t.html_body with
560 | Some hb -> ("htmlBody", `A (List.map BodyPart.to_json hb)) :: fields
561 | None -> fields
562 in
563 let fields = match t.attachments with
564 | Some att -> ("attachments", `A (List.map BodyPart.to_json att)) :: fields
565 | None -> fields
566 in
567 `O fields
568
569(** Email-specific filter for /query (RFC 8621 Section 4.4) *)
570module Filter = struct
571 type t = {
572 in_mailbox : Jmap_core.Id.t option; (** Email is in this mailbox *)
573 in_mailbox_other_than : Jmap_core.Id.t list option; (** Email is in a mailbox other than these *)
574 before : Jmap_core.Primitives.UTCDate.t option; (** receivedAt < this date *)
575 after : Jmap_core.Primitives.UTCDate.t option; (** receivedAt >= this date *)
576 min_size : Jmap_core.Primitives.UnsignedInt.t option; (** size >= this value *)
577 max_size : Jmap_core.Primitives.UnsignedInt.t option; (** size < this value *)
578 all_in_thread_have_keyword : string option; (** All emails in thread have this keyword *)
579 some_in_thread_have_keyword : string option; (** Some email in thread has this keyword *)
580 none_in_thread_have_keyword : string option; (** No email in thread has this keyword *)
581 has_keyword : string option; (** Email has this keyword *)
582 not_keyword : string option; (** Email does not have this keyword *)
583 has_attachment : bool option; (** hasAttachment equals this *)
584 text : string option; (** Text appears in subject/body/addresses *)
585 from : string option; (** From header contains this *)
586 to_ : string option; (** To header contains this *)
587 cc : string option; (** Cc header contains this *)
588 bcc : string option; (** Bcc header contains this *)
589 subject : string option; (** Subject header contains this *)
590 body : string option; (** Body contains this text *)
591 header : (string * string) list option; (** Header name contains value *)
592 }
593
594 let of_json json =
595 let open Jmap_core.Parser.Helpers in
596 let fields = expect_object json in
597 let in_mailbox = match find_field "inMailbox" fields with
598 | Some (`String s) -> Some (Jmap_core.Id.of_string s)
599 | Some `Null | None -> None
600 | Some _ -> raise (Jmap_core.Error.Parse_error "inMailbox must be a string")
601 in
602 let in_mailbox_other_than = match find_field "inMailboxOtherThan" fields with
603 | Some (`A items) -> Some (List.map (fun s -> Jmap_core.Id.of_json s) items)
604 | Some `Null | None -> None
605 | Some _ -> raise (Jmap_core.Error.Parse_error "inMailboxOtherThan must be an array")
606 in
607 let before = match find_field "before" fields with
608 | Some (`String s) -> Some (Jmap_core.Primitives.UTCDate.of_string s)
609 | Some `Null | None -> None
610 | Some _ -> raise (Jmap_core.Error.Parse_error "before must be a string")
611 in
612 let after = match find_field "after" fields with
613 | Some (`String s) -> Some (Jmap_core.Primitives.UTCDate.of_string s)
614 | Some `Null | None -> None
615 | Some _ -> raise (Jmap_core.Error.Parse_error "after must be a string")
616 in
617 let min_size = match find_field "minSize" fields with
618 | Some s -> Some (Jmap_core.Primitives.UnsignedInt.of_json s)
619 | None -> None
620 in
621 let max_size = match find_field "maxSize" fields with
622 | Some s -> Some (Jmap_core.Primitives.UnsignedInt.of_json s)
623 | None -> None
624 in
625 let all_in_thread_have_keyword = get_string_opt "allInThreadHaveKeyword" fields in
626 let some_in_thread_have_keyword = get_string_opt "someInThreadHaveKeyword" fields in
627 let none_in_thread_have_keyword = get_string_opt "noneInThreadHaveKeyword" fields in
628 let has_keyword = get_string_opt "hasKeyword" fields in
629 let not_keyword = get_string_opt "notKeyword" fields in
630 let has_attachment = match find_field "hasAttachment" fields with
631 | Some (`Bool b) -> Some b
632 | Some `Null | None -> None
633 | Some _ -> raise (Jmap_core.Error.Parse_error "hasAttachment must be a boolean")
634 in
635 let text = get_string_opt "text" fields in
636 let from = get_string_opt "from" fields in
637 let to_ = get_string_opt "to" fields in
638 let cc = get_string_opt "cc" fields in
639 let bcc = get_string_opt "bcc" fields in
640 let subject = get_string_opt "subject" fields in
641 let body = get_string_opt "body" fields in
642 let header = match find_field "header" fields with
643 | Some (`A items) ->
644 Some (List.map (fun item ->
645 let hdr_fields = expect_object item in
646 let name = get_string "name" hdr_fields in
647 let value = get_string "value" hdr_fields in
648 (name, value)
649 ) items)
650 | Some `Null | None -> None
651 | Some _ -> raise (Jmap_core.Error.Parse_error "header must be an array")
652 in
653 { in_mailbox; in_mailbox_other_than; before; after; min_size; max_size;
654 all_in_thread_have_keyword; some_in_thread_have_keyword;
655 none_in_thread_have_keyword; has_keyword; not_keyword; has_attachment;
656 text; from; to_; cc; bcc; subject; body; header }
657
658 (* Accessors *)
659 let in_mailbox t = t.in_mailbox
660 let in_mailbox_other_than t = t.in_mailbox_other_than
661 let before t = t.before
662 let after t = t.after
663 let min_size t = t.min_size
664 let max_size t = t.max_size
665 let all_in_thread_have_keyword t = t.all_in_thread_have_keyword
666 let some_in_thread_have_keyword t = t.some_in_thread_have_keyword
667 let none_in_thread_have_keyword t = t.none_in_thread_have_keyword
668 let has_keyword t = t.has_keyword
669 let not_keyword t = t.not_keyword
670 let has_attachment t = t.has_attachment
671 let text t = t.text
672 let from t = t.from
673 let to_ t = t.to_
674 let cc t = t.cc
675 let bcc t = t.bcc
676 let subject t = t.subject
677 let body t = t.body
678 let header t = t.header
679
680 (* Constructor *)
681 let v ?in_mailbox ?in_mailbox_other_than ?before ?after ?min_size ?max_size
682 ?all_in_thread_have_keyword ?some_in_thread_have_keyword
683 ?none_in_thread_have_keyword ?has_keyword ?not_keyword ?has_attachment
684 ?text ?from ?to_ ?cc ?bcc ?subject ?body ?header () =
685 { in_mailbox; in_mailbox_other_than; before; after; min_size; max_size;
686 all_in_thread_have_keyword; some_in_thread_have_keyword;
687 none_in_thread_have_keyword; has_keyword; not_keyword; has_attachment;
688 text; from; to_; cc; bcc; subject; body; header }
689
690 (* Convert to JSON *)
691 let to_json t =
692 let fields = [] in
693 let fields = match t.in_mailbox with
694 | Some id -> ("inMailbox", Jmap_core.Id.to_json id) :: fields
695 | None -> fields
696 in
697 let fields = match t.in_mailbox_other_than with
698 | Some ids -> ("inMailboxOtherThan", `A (List.map Jmap_core.Id.to_json ids)) :: fields
699 | None -> fields
700 in
701 let fields = match t.before with
702 | Some d -> ("before", `String (Jmap_core.Primitives.UTCDate.to_string d)) :: fields
703 | None -> fields
704 in
705 let fields = match t.after with
706 | Some d -> ("after", `String (Jmap_core.Primitives.UTCDate.to_string d)) :: fields
707 | None -> fields
708 in
709 let fields = match t.min_size with
710 | Some s -> ("minSize", Jmap_core.Primitives.UnsignedInt.to_json s) :: fields
711 | None -> fields
712 in
713 let fields = match t.max_size with
714 | Some s -> ("maxSize", Jmap_core.Primitives.UnsignedInt.to_json s) :: fields
715 | None -> fields
716 in
717 let fields = match t.all_in_thread_have_keyword with
718 | Some k -> ("allInThreadHaveKeyword", `String k) :: fields
719 | None -> fields
720 in
721 let fields = match t.some_in_thread_have_keyword with
722 | Some k -> ("someInThreadHaveKeyword", `String k) :: fields
723 | None -> fields
724 in
725 let fields = match t.none_in_thread_have_keyword with
726 | Some k -> ("noneInThreadHaveKeyword", `String k) :: fields
727 | None -> fields
728 in
729 let fields = match t.has_keyword with
730 | Some k -> ("hasKeyword", `String k) :: fields
731 | None -> fields
732 in
733 let fields = match t.not_keyword with
734 | Some k -> ("notKeyword", `String k) :: fields
735 | None -> fields
736 in
737 let fields = match t.has_attachment with
738 | Some b -> ("hasAttachment", `Bool b) :: fields
739 | None -> fields
740 in
741 let fields = match t.text with
742 | Some s -> ("text", `String s) :: fields
743 | None -> fields
744 in
745 let fields = match t.from with
746 | Some s -> ("from", `String s) :: fields
747 | None -> fields
748 in
749 let fields = match t.to_ with
750 | Some s -> ("to", `String s) :: fields
751 | None -> fields
752 in
753 let fields = match t.cc with
754 | Some s -> ("cc", `String s) :: fields
755 | None -> fields
756 in
757 let fields = match t.bcc with
758 | Some s -> ("bcc", `String s) :: fields
759 | None -> fields
760 in
761 let fields = match t.subject with
762 | Some s -> ("subject", `String s) :: fields
763 | None -> fields
764 in
765 let fields = match t.body with
766 | Some s -> ("body", `String s) :: fields
767 | None -> fields
768 in
769 let fields = match t.header with
770 | Some hdrs ->
771 let hdr_arr = List.map (fun (name, value) ->
772 `O [("name", `String name); ("value", `String value)]
773 ) hdrs in
774 ("header", `A hdr_arr) :: fields
775 | None -> fields
776 in
777 `O fields
778end
779
780(** Standard /get method (RFC 8621 Section 4.2) *)
781module Get = struct
782 type request = {
783 account_id : Jmap_core.Id.t;
784 ids : Jmap_core.Id.t list option;
785 properties : string list option;
786 (* Email-specific get arguments *)
787 body_properties : string list option; (** Properties to fetch for bodyStructure parts *)
788 fetch_text_body_values : bool option; (** Fetch bodyValues for textBody parts *)
789 fetch_html_body_values : bool option; (** Fetch bodyValues for htmlBody parts *)
790 fetch_all_body_values : bool option; (** Fetch bodyValues for all parts *)
791 max_body_value_bytes : Jmap_core.Primitives.UnsignedInt.t option; (** Truncate large body values *)
792 }
793
794 type response = t Jmap_core.Standard_methods.Get.response
795
796 (* Accessors for request *)
797 let account_id req = req.account_id
798 let ids req = req.ids
799 let properties req = req.properties
800 let body_properties req = req.body_properties
801 let fetch_text_body_values req = req.fetch_text_body_values
802 let fetch_html_body_values req = req.fetch_html_body_values
803 let fetch_all_body_values req = req.fetch_all_body_values
804 let max_body_value_bytes req = req.max_body_value_bytes
805
806 (* Constructor for request *)
807 let request_v ~account_id ?ids ?properties ?body_properties
808 ?fetch_text_body_values ?fetch_html_body_values ?fetch_all_body_values
809 ?max_body_value_bytes () =
810 { account_id; ids; properties; body_properties; fetch_text_body_values;
811 fetch_html_body_values; fetch_all_body_values; max_body_value_bytes }
812
813 (** Parse get request from JSON.
814 Test files:
815 - test/data/mail/email_get_request.json
816 - test/data/mail/email_get_full_request.json
817 *)
818 let request_of_json json =
819 let open Jmap_core.Parser.Helpers in
820 let fields = expect_object json in
821 let account_id = Jmap_core.Id.of_json (require_field "accountId" fields) in
822 let ids = match find_field "ids" fields with
823 | Some (`A items) -> Some (List.map Jmap_core.Id.of_json items)
824 | Some `Null | None -> None
825 | Some _ -> raise (Jmap_core.Error.Parse_error "ids must be an array")
826 in
827 let properties = match find_field "properties" fields with
828 | Some (`A items) -> Some (List.map expect_string items)
829 | Some `Null | None -> None
830 | Some _ -> raise (Jmap_core.Error.Parse_error "properties must be an array")
831 in
832 let body_properties = match find_field "bodyProperties" fields with
833 | Some (`A items) -> Some (List.map expect_string items)
834 | Some `Null | None -> None
835 | Some _ -> raise (Jmap_core.Error.Parse_error "bodyProperties must be an array")
836 in
837 let fetch_text_body_values = match find_field "fetchTextBodyValues" fields with
838 | Some (`Bool b) -> Some b
839 | Some `Null | None -> None
840 | Some _ -> raise (Jmap_core.Error.Parse_error "fetchTextBodyValues must be a boolean")
841 in
842 let fetch_html_body_values = match find_field "fetchHTMLBodyValues" fields with
843 | Some (`Bool b) -> Some b
844 | Some `Null | None -> None
845 | Some _ -> raise (Jmap_core.Error.Parse_error "fetchHTMLBodyValues must be a boolean")
846 in
847 let fetch_all_body_values = match find_field "fetchAllBodyValues" fields with
848 | Some (`Bool b) -> Some b
849 | Some `Null | None -> None
850 | Some _ -> raise (Jmap_core.Error.Parse_error "fetchAllBodyValues must be a boolean")
851 in
852 let max_body_value_bytes = match find_field "maxBodyValueBytes" fields with
853 | Some v -> Some (Jmap_core.Primitives.UnsignedInt.of_json v)
854 | None -> None
855 in
856 { account_id; ids; properties; body_properties; fetch_text_body_values;
857 fetch_html_body_values; fetch_all_body_values; max_body_value_bytes }
858
859 (** Parse get response from JSON.
860 Test files:
861 - test/data/mail/email_get_response.json
862 - test/data/mail/email_get_full_response.json
863 *)
864 let response_of_json json =
865 Jmap_core.Standard_methods.Get.response_of_json of_json json
866
867 (** Convert get request to JSON *)
868 let request_to_json req =
869 let fields = [
870 ("accountId", Jmap_core.Id.to_json req.account_id);
871 ] in
872 let fields = match req.ids with
873 | Some ids -> ("ids", `A (List.map Jmap_core.Id.to_json ids)) :: fields
874 | None -> fields
875 in
876 let fields = match req.properties with
877 | Some props -> ("properties", `A (List.map (fun s -> `String s) props)) :: fields
878 | None -> fields
879 in
880 let fields = match req.body_properties with
881 | Some bp -> ("bodyProperties", `A (List.map (fun s -> `String s) bp)) :: fields
882 | None -> fields
883 in
884 let fields = match req.fetch_text_body_values with
885 | Some ftbv -> ("fetchTextBodyValues", `Bool ftbv) :: fields
886 | None -> fields
887 in
888 let fields = match req.fetch_html_body_values with
889 | Some fhbv -> ("fetchHTMLBodyValues", `Bool fhbv) :: fields
890 | None -> fields
891 in
892 let fields = match req.fetch_all_body_values with
893 | Some fabv -> ("fetchAllBodyValues", `Bool fabv) :: fields
894 | None -> fields
895 in
896 let fields = match req.max_body_value_bytes with
897 | Some mbvb -> ("maxBodyValueBytes", Jmap_core.Primitives.UnsignedInt.to_json mbvb) :: fields
898 | None -> fields
899 in
900 `O fields
901end
902
903(** Standard /changes method (RFC 8621 Section 4.3) *)
904module Changes = struct
905 type request = Jmap_core.Standard_methods.Changes.request
906 type response = Jmap_core.Standard_methods.Changes.response
907
908 let request_of_json json =
909 Jmap_core.Standard_methods.Changes.request_of_json json
910
911 let response_of_json json =
912 Jmap_core.Standard_methods.Changes.response_of_json json
913end
914
915(** Standard /query method (RFC 8621 Section 4.4) *)
916module Query = struct
917 type request = {
918 account_id : Jmap_core.Id.t;
919 filter : Filter.t Jmap_core.Filter.t option;
920 sort : Jmap_core.Comparator.t list option;
921 position : Jmap_core.Primitives.Int53.t option;
922 anchor : Jmap_core.Id.t option;
923 anchor_offset : Jmap_core.Primitives.Int53.t option;
924 limit : Jmap_core.Primitives.UnsignedInt.t option;
925 calculate_total : bool option;
926 (* Email-specific query arguments *)
927 collapse_threads : bool option; (** Return only one email per thread *)
928 }
929
930 type response = Jmap_core.Standard_methods.Query.response
931
932 (* Accessors for request *)
933 let account_id req = req.account_id
934 let filter req = req.filter
935 let sort req = req.sort
936 let position req = req.position
937 let anchor req = req.anchor
938 let anchor_offset req = req.anchor_offset
939 let limit req = req.limit
940 let calculate_total req = req.calculate_total
941 let collapse_threads req = req.collapse_threads
942
943 (* Constructor for request *)
944 let request_v ~account_id ?filter ?sort ?position ?anchor ?anchor_offset
945 ?limit ?calculate_total ?collapse_threads () =
946 { account_id; filter; sort; position; anchor; anchor_offset;
947 limit; calculate_total; collapse_threads }
948
949 (** Parse query request from JSON.
950 Test files: test/data/mail/email_query_request.json *)
951 let request_of_json json =
952 let open Jmap_core.Parser.Helpers in
953 let fields = expect_object json in
954 let account_id = Jmap_core.Id.of_json (require_field "accountId" fields) in
955 let filter = match find_field "filter" fields with
956 | Some v -> Some (Jmap_core.Filter.of_json Filter.of_json v)
957 | None -> None
958 in
959 let sort = match find_field "sort" fields with
960 | Some (`A items) -> Some (List.map Jmap_core.Comparator.of_json items)
961 | Some `Null | None -> None
962 | Some _ -> raise (Jmap_core.Error.Parse_error "sort must be an array")
963 in
964 let position = match find_field "position" fields with
965 | Some v -> Some (Jmap_core.Primitives.Int53.of_json v)
966 | None -> None
967 in
968 let anchor = match find_field "anchor" fields with
969 | Some (`String s) -> Some (Jmap_core.Id.of_string s)
970 | Some `Null | None -> None
971 | Some _ -> raise (Jmap_core.Error.Parse_error "anchor must be a string")
972 in
973 let anchor_offset = match find_field "anchorOffset" fields with
974 | Some v -> Some (Jmap_core.Primitives.Int53.of_json v)
975 | None -> None
976 in
977 let limit = match find_field "limit" fields with
978 | Some v -> Some (Jmap_core.Primitives.UnsignedInt.of_json v)
979 | None -> None
980 in
981 let calculate_total = match find_field "calculateTotal" fields with
982 | Some (`Bool b) -> Some b
983 | Some `Null | None -> None
984 | Some _ -> raise (Jmap_core.Error.Parse_error "calculateTotal must be a boolean")
985 in
986 let collapse_threads = match find_field "collapseThreads" fields with
987 | Some (`Bool b) -> Some b
988 | Some `Null | None -> None
989 | Some _ -> raise (Jmap_core.Error.Parse_error "collapseThreads must be a boolean")
990 in
991 { account_id; filter; sort; position; anchor; anchor_offset;
992 limit; calculate_total; collapse_threads }
993
994 (** Parse query response from JSON.
995 Test files: test/data/mail/email_query_response.json *)
996 let response_of_json json =
997 Jmap_core.Standard_methods.Query.response_of_json json
998
999 (** Convert query request to JSON *)
1000 let request_to_json req =
1001 let fields = [
1002 ("accountId", Jmap_core.Id.to_json req.account_id);
1003 ] in
1004 let fields = match req.filter with
1005 | Some f -> ("filter", Jmap_core.Filter.to_json Filter.to_json f) :: fields
1006 | None -> fields
1007 in
1008 let fields = match req.sort with
1009 | Some s -> ("sort", `A (List.map Jmap_core.Comparator.to_json s)) :: fields
1010 | None -> fields
1011 in
1012 let fields = match req.position with
1013 | Some p -> ("position", Jmap_core.Primitives.Int53.to_json p) :: fields
1014 | None -> fields
1015 in
1016 let fields = match req.anchor with
1017 | Some a -> ("anchor", Jmap_core.Id.to_json a) :: fields
1018 | None -> fields
1019 in
1020 let fields = match req.anchor_offset with
1021 | Some ao -> ("anchorOffset", Jmap_core.Primitives.Int53.to_json ao) :: fields
1022 | None -> fields
1023 in
1024 let fields = match req.limit with
1025 | Some l -> ("limit", Jmap_core.Primitives.UnsignedInt.to_json l) :: fields
1026 | None -> fields
1027 in
1028 let fields = match req.calculate_total with
1029 | Some ct -> ("calculateTotal", `Bool ct) :: fields
1030 | None -> fields
1031 in
1032 let fields = match req.collapse_threads with
1033 | Some ct -> ("collapseThreads", `Bool ct) :: fields
1034 | None -> fields
1035 in
1036 `O fields
1037end
1038
1039(** Standard /queryChanges method (RFC 8621 Section 4.5) *)
1040module QueryChanges = struct
1041 type request = {
1042 account_id : Jmap_core.Id.t;
1043 filter : Filter.t Jmap_core.Filter.t option;
1044 sort : Jmap_core.Comparator.t list option;
1045 since_query_state : string;
1046 max_changes : Jmap_core.Primitives.UnsignedInt.t option;
1047 up_to_id : Jmap_core.Id.t option;
1048 calculate_total : bool option;
1049 (* Email-specific *)
1050 collapse_threads : bool option;
1051 }
1052
1053 type response = Jmap_core.Standard_methods.QueryChanges.response
1054
1055 (* Accessors for request *)
1056 let account_id req = req.account_id
1057 let filter req = req.filter
1058 let sort req = req.sort
1059 let since_query_state req = req.since_query_state
1060 let max_changes req = req.max_changes
1061 let up_to_id req = req.up_to_id
1062 let calculate_total req = req.calculate_total
1063 let collapse_threads req = req.collapse_threads
1064
1065 (* Constructor for request *)
1066 let request_v ~account_id ?filter ?sort ~since_query_state ?max_changes
1067 ?up_to_id ?calculate_total ?collapse_threads () =
1068 { account_id; filter; sort; since_query_state; max_changes;
1069 up_to_id; calculate_total; collapse_threads }
1070
1071 let request_of_json json =
1072 let open Jmap_core.Parser.Helpers in
1073 let fields = expect_object json in
1074 let account_id = Jmap_core.Id.of_json (require_field "accountId" fields) in
1075 let filter = match find_field "filter" fields with
1076 | Some v -> Some (Jmap_core.Filter.of_json Filter.of_json v)
1077 | None -> None
1078 in
1079 let sort = match find_field "sort" fields with
1080 | Some (`A items) -> Some (List.map Jmap_core.Comparator.of_json items)
1081 | Some `Null | None -> None
1082 | Some _ -> raise (Jmap_core.Error.Parse_error "sort must be an array")
1083 in
1084 let since_query_state = get_string "sinceQueryState" fields in
1085 let max_changes = match find_field "maxChanges" fields with
1086 | Some v -> Some (Jmap_core.Primitives.UnsignedInt.of_json v)
1087 | None -> None
1088 in
1089 let up_to_id = match find_field "upToId" fields with
1090 | Some (`String s) -> Some (Jmap_core.Id.of_string s)
1091 | Some `Null | None -> None
1092 | Some _ -> raise (Jmap_core.Error.Parse_error "upToId must be a string")
1093 in
1094 let calculate_total = match find_field "calculateTotal" fields with
1095 | Some (`Bool b) -> Some b
1096 | Some `Null | None -> None
1097 | Some _ -> raise (Jmap_core.Error.Parse_error "calculateTotal must be a boolean")
1098 in
1099 let collapse_threads = match find_field "collapseThreads" fields with
1100 | Some (`Bool b) -> Some b
1101 | Some `Null | None -> None
1102 | Some _ -> raise (Jmap_core.Error.Parse_error "collapseThreads must be a boolean")
1103 in
1104 { account_id; filter; sort; since_query_state; max_changes;
1105 up_to_id; calculate_total; collapse_threads }
1106
1107 let response_of_json json =
1108 Jmap_core.Standard_methods.QueryChanges.response_of_json json
1109end
1110
1111(** Standard /set method (RFC 8621 Section 4.6) *)
1112module Set = struct
1113 type request = t Jmap_core.Standard_methods.Set.request
1114 type response = t Jmap_core.Standard_methods.Set.response
1115
1116 (** Parse set request from JSON.
1117 Test files: test/data/mail/email_set_request.json *)
1118 let request_of_json json =
1119 Jmap_core.Standard_methods.Set.request_of_json of_json json
1120
1121 (** Parse set response from JSON.
1122 Test files: test/data/mail/email_set_response.json *)
1123 let response_of_json json =
1124 Jmap_core.Standard_methods.Set.response_of_json of_json json
1125end
1126
1127(** Standard /copy method (RFC 8621 Section 4.7) *)
1128module Copy = struct
1129 type request = t Jmap_core.Standard_methods.Copy.request
1130 type response = t Jmap_core.Standard_methods.Copy.response
1131
1132 let request_of_json json =
1133 Jmap_core.Standard_methods.Copy.request_of_json of_json json
1134
1135 let response_of_json json =
1136 Jmap_core.Standard_methods.Copy.response_of_json of_json json
1137end
1138
1139(** Email/import method (RFC 8621 Section 4.8) *)
1140module Import = struct
1141 (** Email import request object *)
1142 type import_email = {
1143 blob_id : Jmap_core.Id.t; (** Blob ID containing raw RFC 5322 message *)
1144 mailbox_ids : (Jmap_core.Id.t * bool) list; (** Mailboxes to add email to *)
1145 keywords : (string * bool) list; (** Keywords to set *)
1146 received_at : Jmap_core.Primitives.UTCDate.t option; (** Override received date *)
1147 }
1148
1149 type request = {
1150 account_id : Jmap_core.Id.t;
1151 if_in_state : string option;
1152 emails : (Jmap_core.Id.t * import_email) list; (** Map of creation id to import object *)
1153 }
1154
1155 type response = {
1156 account_id : Jmap_core.Id.t;
1157 old_state : string option;
1158 new_state : string;
1159 created : (Jmap_core.Id.t * t) list option;
1160 not_created : (Jmap_core.Id.t * Jmap_core.Error.set_error_detail) list option;
1161 }
1162
1163 (* Accessors for import_email *)
1164 let import_blob_id ie = ie.blob_id
1165 let import_mailbox_ids ie = ie.mailbox_ids
1166 let import_keywords ie = ie.keywords
1167 let import_received_at ie = ie.received_at
1168
1169 (* Constructor for import_email *)
1170 let import_email_v ~blob_id ~mailbox_ids ~keywords ?received_at () =
1171 { blob_id; mailbox_ids; keywords; received_at }
1172
1173 (* Accessors for request *)
1174 let account_id (r : request) = r.account_id
1175 let if_in_state (r : request) = r.if_in_state
1176 let emails (r : request) = r.emails
1177
1178 (* Constructor for request *)
1179 let request_v ~account_id ?if_in_state ~emails () =
1180 { account_id; if_in_state; emails }
1181
1182 (* Accessors for response *)
1183 let response_account_id (r : response) = r.account_id
1184 let old_state (r : response) = r.old_state
1185 let new_state (r : response) = r.new_state
1186 let created (r : response) = r.created
1187 let not_created (r : response) = r.not_created
1188
1189 (* Constructor for response *)
1190 let response_v ~account_id ?old_state ~new_state ?created ?not_created () =
1191 { account_id; old_state; new_state; created; not_created }
1192
1193 (** Parse import request from JSON.
1194 Test files: test/data/mail/email_import_request.json *)
1195 let request_of_json json =
1196 let open Jmap_core.Parser.Helpers in
1197 let fields = expect_object json in
1198 let account_id = Jmap_core.Id.of_json (require_field "accountId" fields) in
1199 let if_in_state = get_string_opt "ifInState" fields in
1200 let emails = match require_field "emails" fields with
1201 | `O pairs ->
1202 List.map (fun (k, v) ->
1203 let ie_fields = expect_object v in
1204 let blob_id = Jmap_core.Id.of_json (require_field "blobId" ie_fields) in
1205 let mailbox_ids = match require_field "mailboxIds" ie_fields with
1206 | `O map_fields ->
1207 List.map (fun (mid, b) ->
1208 (Jmap_core.Id.of_string mid, expect_bool b)
1209 ) map_fields
1210 | _ -> raise (Jmap_core.Error.Parse_error "mailboxIds must be an object")
1211 in
1212 let keywords = match require_field "keywords" ie_fields with
1213 | `O map_fields ->
1214 List.map (fun (kw, b) -> (kw, expect_bool b)) map_fields
1215 | _ -> raise (Jmap_core.Error.Parse_error "keywords must be an object")
1216 in
1217 let received_at = match find_field "receivedAt" ie_fields with
1218 | Some (`String s) -> Some (Jmap_core.Primitives.UTCDate.of_string s)
1219 | Some `Null | None -> None
1220 | Some _ -> raise (Jmap_core.Error.Parse_error "receivedAt must be a string")
1221 in
1222 let import_email = { blob_id; mailbox_ids; keywords; received_at } in
1223 (Jmap_core.Id.of_string k, import_email)
1224 ) pairs
1225 | _ -> raise (Jmap_core.Error.Parse_error "emails must be an object")
1226 in
1227 { account_id; if_in_state; emails }
1228
1229 (** Parse import response from JSON.
1230 Test files: test/data/mail/email_import_response.json *)
1231 let response_of_json json =
1232 let open Jmap_core.Parser.Helpers in
1233 let fields = expect_object json in
1234 let account_id = Jmap_core.Id.of_json (require_field "accountId" fields) in
1235 let old_state = get_string_opt "oldState" fields in
1236 let new_state = get_string "newState" fields in
1237 let created = match find_field "created" fields with
1238 | Some `Null | None -> None
1239 | Some (`O pairs) ->
1240 Some (List.map (fun (k, v) ->
1241 (Jmap_core.Id.of_string k, of_json v)
1242 ) pairs)
1243 | Some _ -> raise (Jmap_core.Error.Parse_error "created must be an object")
1244 in
1245 let not_created = match find_field "notCreated" fields with
1246 | Some `Null | None -> None
1247 | Some (`O pairs) ->
1248 Some (List.map (fun (k, v) ->
1249 (Jmap_core.Id.of_string k, Jmap_core.Error.parse_set_error_detail v)
1250 ) pairs)
1251 | Some _ -> raise (Jmap_core.Error.Parse_error "notCreated must be an object")
1252 in
1253 { account_id; old_state; new_state; created; not_created }
1254end
1255
1256(** Email/parse method (RFC 8621 Section 4.9) *)
1257module Parse = struct
1258 type request = {
1259 account_id : Jmap_core.Id.t;
1260 blob_ids : Jmap_core.Id.t list; (** Blob IDs to parse *)
1261 properties : string list option; (** Email properties to return *)
1262 body_properties : string list option; (** BodyPart properties to return *)
1263 fetch_text_body_values : bool option;
1264 fetch_html_body_values : bool option;
1265 fetch_all_body_values : bool option;
1266 max_body_value_bytes : Jmap_core.Primitives.UnsignedInt.t option;
1267 }
1268
1269 type response = {
1270 account_id : Jmap_core.Id.t;
1271 parsed : (Jmap_core.Id.t * t) list option; (** Map of blob ID to parsed email *)
1272 not_parsable : Jmap_core.Id.t list option; (** Blob IDs that couldn't be parsed *)
1273 not_found : Jmap_core.Id.t list option; (** Blob IDs that don't exist *)
1274 }
1275
1276 (* Accessors for request *)
1277 let account_id (r : request) = r.account_id
1278 let blob_ids (r : request) = r.blob_ids
1279 let properties (r : request) = r.properties
1280 let body_properties (r : request) = r.body_properties
1281 let fetch_text_body_values (r : request) = r.fetch_text_body_values
1282 let fetch_html_body_values (r : request) = r.fetch_html_body_values
1283 let fetch_all_body_values (r : request) = r.fetch_all_body_values
1284 let max_body_value_bytes (r : request) = r.max_body_value_bytes
1285
1286 (* Constructor for request *)
1287 let request_v ~account_id ~blob_ids ?properties ?body_properties
1288 ?fetch_text_body_values ?fetch_html_body_values ?fetch_all_body_values
1289 ?max_body_value_bytes () =
1290 { account_id; blob_ids; properties; body_properties; fetch_text_body_values;
1291 fetch_html_body_values; fetch_all_body_values; max_body_value_bytes }
1292
1293 (* Accessors for response *)
1294 let response_account_id (r : response) = r.account_id
1295 let parsed (r : response) = r.parsed
1296 let not_parsable (r : response) = r.not_parsable
1297 let not_found (r : response) = r.not_found
1298
1299 (* Constructor for response *)
1300 let response_v ~account_id ?parsed ?not_parsable ?not_found () =
1301 { account_id; parsed; not_parsable; not_found }
1302
1303 (** Parse parse request from JSON.
1304 Test files: test/data/mail/email_parse_request.json *)
1305 let request_of_json json =
1306 let open Jmap_core.Parser.Helpers in
1307 let fields = expect_object json in
1308 let account_id = Jmap_core.Id.of_json (require_field "accountId" fields) in
1309 let blob_ids = match require_field "blobIds" fields with
1310 | `A items -> List.map Jmap_core.Id.of_json items
1311 | _ -> raise (Jmap_core.Error.Parse_error "blobIds must be an array")
1312 in
1313 let properties = match find_field "properties" fields with
1314 | Some (`A items) -> Some (List.map expect_string items)
1315 | Some `Null | None -> None
1316 | Some _ -> raise (Jmap_core.Error.Parse_error "properties must be an array")
1317 in
1318 let body_properties = match find_field "bodyProperties" fields with
1319 | Some (`A items) -> Some (List.map expect_string items)
1320 | Some `Null | None -> None
1321 | Some _ -> raise (Jmap_core.Error.Parse_error "bodyProperties must be an array")
1322 in
1323 let fetch_text_body_values = match find_field "fetchTextBodyValues" fields with
1324 | Some (`Bool b) -> Some b
1325 | Some `Null | None -> None
1326 | Some _ -> raise (Jmap_core.Error.Parse_error "fetchTextBodyValues must be a boolean")
1327 in
1328 let fetch_html_body_values = match find_field "fetchHTMLBodyValues" fields with
1329 | Some (`Bool b) -> Some b
1330 | Some `Null | None -> None
1331 | Some _ -> raise (Jmap_core.Error.Parse_error "fetchHTMLBodyValues must be a boolean")
1332 in
1333 let fetch_all_body_values = match find_field "fetchAllBodyValues" fields with
1334 | Some (`Bool b) -> Some b
1335 | Some `Null | None -> None
1336 | Some _ -> raise (Jmap_core.Error.Parse_error "fetchAllBodyValues must be a boolean")
1337 in
1338 let max_body_value_bytes = match find_field "maxBodyValueBytes" fields with
1339 | Some v -> Some (Jmap_core.Primitives.UnsignedInt.of_json v)
1340 | None -> None
1341 in
1342 { account_id; blob_ids; properties; body_properties; fetch_text_body_values;
1343 fetch_html_body_values; fetch_all_body_values; max_body_value_bytes }
1344
1345 (** Parse parse response from JSON.
1346 Test files: test/data/mail/email_parse_response.json *)
1347 let response_of_json json =
1348 let open Jmap_core.Parser.Helpers in
1349 let fields = expect_object json in
1350 let account_id = Jmap_core.Id.of_json (require_field "accountId" fields) in
1351 let parsed = match find_field "parsed" fields with
1352 | Some `Null | None -> None
1353 | Some (`O pairs) ->
1354 Some (List.map (fun (k, v) ->
1355 (Jmap_core.Id.of_string k, of_json v)
1356 ) pairs)
1357 | Some _ -> raise (Jmap_core.Error.Parse_error "parsed must be an object")
1358 in
1359 let not_parsable = match find_field "notParsable" fields with
1360 | Some (`A items) -> Some (List.map Jmap_core.Id.of_json items)
1361 | Some `Null | None -> None
1362 | Some _ -> raise (Jmap_core.Error.Parse_error "notParsable must be an array")
1363 in
1364 let not_found = match find_field "notFound" fields with
1365 | Some (`A items) -> Some (List.map Jmap_core.Id.of_json items)
1366 | Some `Null | None -> None
1367 | Some _ -> raise (Jmap_core.Error.Parse_error "notFound must be an array")
1368 in
1369 { account_id; parsed; not_parsable; not_found }
1370end
1371
1372
1373(** Standard email keywords (RFC 8621 Section 4.1.1) *)
1374module Keyword = struct
1375 let seen = "$seen" (* Message has been read *)
1376 let draft = "$draft" (* Message is a draft *)
1377 let flagged = "$flagged" (* Message is flagged for urgent/special attention *)
1378 let answered = "$answered" (* Message has been replied to *)
1379 let forwarded = "$forwarded" (* Message has been forwarded (non-standard but common) *)
1380 let phishing = "$phishing" (* Message is suspected phishing *)
1381 let junk = "$junk" (* Message is junk/spam *)
1382 let notjunk = "$notjunk" (* Message is definitely not junk *)
1383end
1384
1385(** Parser submodule *)
1386module Parser = struct
1387 let of_json = of_json
1388 let to_json = to_json
1389end