this repo has no description
anil.recoil.org
1(** Implementation of the JMAP Mail extension, as defined in RFC8621 *)
2
3(** Module for managing JMAP Mail-specific capability URIs *)
4module Capability = struct
5 (** Mail capability types *)
6 type mail = Mail
7
8 (** Mail capability URI *)
9 let mail_uri = "urn:ietf:params:jmap:mail"
10
11 (** Convert mail capability to URI string *)
12 let string_of_mail = function
13 | Mail -> mail_uri
14
15 (** Parse a string to mail capability *)
16 let mail_of_string = function
17 | s when s = mail_uri -> Some Mail
18 | _ -> None
19
20 (** Submission capability types *)
21 type submission = Submission
22
23 (** Submission capability URI *)
24 let submission_uri = "urn:ietf:params:jmap:submission"
25
26 (** Convert submission capability to URI string *)
27 let string_of_submission = function
28 | Submission -> submission_uri
29
30 (** Parse a string to submission capability *)
31 let submission_of_string = function
32 | s when s = submission_uri -> Some Submission
33 | _ -> None
34
35 (** Vacation response capability types *)
36 type vacation_response = VacationResponse
37
38 (** Vacation response capability URI *)
39 let vacation_response_uri = "urn:ietf:params:jmap:vacationresponse"
40
41 (** Convert vacation response capability to URI string *)
42 let string_of_vacation_response = function
43 | VacationResponse -> vacation_response_uri
44
45 (** Parse a string to vacation response capability *)
46 let vacation_response_of_string = function
47 | s when s = vacation_response_uri -> Some VacationResponse
48 | _ -> None
49
50 (** All mail extension capability types *)
51 type t =
52 | Mail of mail
53 | Submission of submission
54 | VacationResponse of vacation_response
55 | Extension of string
56
57 (** Convert capability to URI string *)
58 let to_string = function
59 | Mail m -> string_of_mail m
60 | Submission s -> string_of_submission s
61 | VacationResponse v -> string_of_vacation_response v
62 | Extension s -> s
63
64 (** Parse a string to a capability *)
65 let of_string s =
66 match mail_of_string s with
67 | Some m -> Mail m
68 | None ->
69 match submission_of_string s with
70 | Some s -> Submission s
71 | None ->
72 match vacation_response_of_string s with
73 | Some v -> VacationResponse v
74 | None -> Extension s
75
76 (** Check if a capability is a standard mail capability *)
77 let is_standard = function
78 | Mail _ | Submission _ | VacationResponse _ -> true
79 | Extension _ -> false
80
81 (** Check if a capability string is a standard mail capability *)
82 let is_standard_string s =
83 match of_string s with
84 | Extension _ -> false
85 | _ -> true
86
87 (** Create a list of capability strings *)
88 let strings_of_capabilities capabilities =
89 List.map to_string capabilities
90end
91
92module Types = struct
93 open Jmap.Types
94
95 (** {1 Mail capabilities} *)
96
97 (** Capability URI for JMAP Mail*)
98 let capability_mail = Capability.mail_uri
99
100 (** Capability URI for JMAP Submission *)
101 let capability_submission = Capability.submission_uri
102
103 (** Capability URI for JMAP Vacation Response *)
104 let capability_vacation_response = Capability.vacation_response_uri
105
106 (** {1:mailbox Mailbox objects} *)
107
108 (** A role for a mailbox. See RFC8621 Section 2. *)
109 type mailbox_role =
110 | All (** All mail *)
111 | Archive (** Archived mail *)
112 | Drafts (** Draft messages *)
113 | Flagged (** Starred/flagged mail *)
114 | Important (** Important mail *)
115 | Inbox (** Inbox *)
116 | Junk (** Spam/Junk mail *)
117 | Sent (** Sent mail *)
118 | Trash (** Deleted/Trash mail *)
119 | Unknown of string (** Server-specific roles *)
120
121 (** A mailbox (folder) in a mail account. See RFC8621 Section 2. *)
122 type mailbox = {
123 id : id;
124 name : string;
125 parent_id : id option;
126 role : mailbox_role option;
127 sort_order : unsigned_int;
128 total_emails : unsigned_int;
129 unread_emails : unsigned_int;
130 total_threads : unsigned_int;
131 unread_threads : unsigned_int;
132 is_subscribed : bool;
133 my_rights : mailbox_rights;
134 }
135
136 (** Rights for a mailbox. See RFC8621 Section 2. *)
137 and mailbox_rights = {
138 may_read_items : bool;
139 may_add_items : bool;
140 may_remove_items : bool;
141 may_set_seen : bool;
142 may_set_keywords : bool;
143 may_create_child : bool;
144 may_rename : bool;
145 may_delete : bool;
146 may_submit : bool;
147 }
148
149 (** Filter condition for mailbox queries. See RFC8621 Section 2.3. *)
150 type mailbox_filter_condition = {
151 parent_id : id option;
152 name : string option;
153 role : string option;
154 has_any_role : bool option;
155 is_subscribed : bool option;
156 }
157
158 type mailbox_query_filter = [
159 | `And of mailbox_query_filter list
160 | `Or of mailbox_query_filter list
161 | `Not of mailbox_query_filter
162 | `Condition of mailbox_filter_condition
163 ]
164
165 (** Mailbox/get request arguments. See RFC8621 Section 2.1. *)
166 type mailbox_get_arguments = {
167 account_id : id;
168 ids : id list option;
169 properties : string list option;
170 }
171
172 (** Mailbox/get response. See RFC8621 Section 2.1. *)
173 type mailbox_get_response = {
174 account_id : id;
175 state : string;
176 list : mailbox list;
177 not_found : id list;
178 }
179
180 (** Mailbox/changes request arguments. See RFC8621 Section 2.2. *)
181 type mailbox_changes_arguments = {
182 account_id : id;
183 since_state : string;
184 max_changes : unsigned_int option;
185 }
186
187 (** Mailbox/changes response. See RFC8621 Section 2.2. *)
188 type mailbox_changes_response = {
189 account_id : id;
190 old_state : string;
191 new_state : string;
192 has_more_changes : bool;
193 created : id list;
194 updated : id list;
195 destroyed : id list;
196 }
197
198 (** Mailbox/query request arguments. See RFC8621 Section 2.3. *)
199 type mailbox_query_arguments = {
200 account_id : id;
201 filter : mailbox_query_filter option;
202 sort : [ `name | `role | `sort_order ] list option;
203 limit : unsigned_int option;
204 }
205
206 (** Mailbox/query response. See RFC8621 Section 2.3. *)
207 type mailbox_query_response = {
208 account_id : id;
209 query_state : string;
210 can_calculate_changes : bool;
211 position : unsigned_int;
212 ids : id list;
213 total : unsigned_int option;
214 }
215
216 (** Mailbox/queryChanges request arguments. See RFC8621 Section 2.4. *)
217 type mailbox_query_changes_arguments = {
218 account_id : id;
219 filter : mailbox_query_filter option;
220 sort : [ `name | `role | `sort_order ] list option;
221 since_query_state : string;
222 max_changes : unsigned_int option;
223 up_to_id : id option;
224 }
225
226 (** Mailbox/queryChanges response. See RFC8621 Section 2.4. *)
227 type mailbox_query_changes_response = {
228 account_id : id;
229 old_query_state : string;
230 new_query_state : string;
231 total : unsigned_int option;
232 removed : id list;
233 added : mailbox_query_changes_added list;
234 }
235
236 and mailbox_query_changes_added = {
237 id : id;
238 index : unsigned_int;
239 }
240
241 (** Mailbox/set request arguments. See RFC8621 Section 2.5. *)
242 type mailbox_set_arguments = {
243 account_id : id;
244 if_in_state : string option;
245 create : (id * mailbox_creation) list option;
246 update : (id * mailbox_update) list option;
247 destroy : id list option;
248 }
249
250 and mailbox_creation = {
251 name : string;
252 parent_id : id option;
253 role : string option;
254 sort_order : unsigned_int option;
255 is_subscribed : bool option;
256 }
257
258 and mailbox_update = {
259 name : string option;
260 parent_id : id option;
261 role : string option;
262 sort_order : unsigned_int option;
263 is_subscribed : bool option;
264 }
265
266 (** Mailbox/set response. See RFC8621 Section 2.5. *)
267 type mailbox_set_response = {
268 account_id : id;
269 old_state : string option;
270 new_state : string;
271 created : (id * mailbox) list option;
272 updated : id list option;
273 destroyed : id list option;
274 not_created : (id * set_error) list option;
275 not_updated : (id * set_error) list option;
276 not_destroyed : (id * set_error) list option;
277 }
278
279 (** {1:thread Thread objects} *)
280
281 (** A thread in a mail account. See RFC8621 Section 3. *)
282 type thread = {
283 id : id;
284 email_ids : id list;
285 }
286
287 (** Thread/get request arguments. See RFC8621 Section 3.1. *)
288 type thread_get_arguments = {
289 account_id : id;
290 ids : id list option;
291 properties : string list option;
292 }
293
294 (** Thread/get response. See RFC8621 Section 3.1. *)
295 type thread_get_response = {
296 account_id : id;
297 state : string;
298 list : thread list;
299 not_found : id list;
300 }
301
302 (** Thread/changes request arguments. See RFC8621 Section 3.2. *)
303 type thread_changes_arguments = {
304 account_id : id;
305 since_state : string;
306 max_changes : unsigned_int option;
307 }
308
309 (** Thread/changes response. See RFC8621 Section 3.2. *)
310 type thread_changes_response = {
311 account_id : id;
312 old_state : string;
313 new_state : string;
314 has_more_changes : bool;
315 created : id list;
316 updated : id list;
317 destroyed : id list;
318 }
319
320 (** {1:email Email objects} *)
321
322 (** Addressing (mailbox) information. See RFC8621 Section 4.1.1. *)
323 type email_address = {
324 name : string option;
325 email : string;
326 parameters : (string * string) list;
327 }
328
329 (** Message header field. See RFC8621 Section 4.1.2. *)
330 type header = {
331 name : string;
332 value : string;
333 }
334
335 (** Email keyword (flag). See RFC8621 Section 4.3. *)
336 type keyword =
337 | Flagged
338 | Answered
339 | Draft
340 | Forwarded
341 | Phishing
342 | Junk
343 | NotJunk
344 | Seen
345 | Unread
346 | Custom of string
347
348 (** Email message. See RFC8621 Section 4. *)
349 type email = {
350 id : id;
351 blob_id : id;
352 thread_id : id;
353 mailbox_ids : (id * bool) list;
354 keywords : (keyword * bool) list;
355 size : unsigned_int;
356 received_at : utc_date;
357 message_id : string list;
358 in_reply_to : string list option;
359 references : string list option;
360 sender : email_address list option;
361 from : email_address list option;
362 to_ : email_address list option;
363 cc : email_address list option;
364 bcc : email_address list option;
365 reply_to : email_address list option;
366 subject : string option;
367 sent_at : utc_date option;
368 has_attachment : bool option;
369 preview : string option;
370 body_values : (string * string) list option;
371 text_body : email_body_part list option;
372 html_body : email_body_part list option;
373 attachments : email_body_part list option;
374 headers : header list option;
375 }
376
377 (** Email body part. See RFC8621 Section 4.1.4. *)
378 and email_body_part = {
379 part_id : string option;
380 blob_id : id option;
381 size : unsigned_int option;
382 headers : header list option;
383 name : string option;
384 type_ : string option;
385 charset : string option;
386 disposition : string option;
387 cid : string option;
388 language : string list option;
389 location : string option;
390 sub_parts : email_body_part list option;
391 header_parameter_name : string option;
392 header_parameter_value : string option;
393 }
394
395 (** Email query filter condition. See RFC8621 Section 4.4. *)
396 type email_filter_condition = {
397 in_mailbox : id option;
398 in_mailbox_other_than : id list option;
399 min_size : unsigned_int option;
400 max_size : unsigned_int option;
401 before : utc_date option;
402 after : utc_date option;
403 header : (string * string) option;
404 from : string option;
405 to_ : string option;
406 cc : string option;
407 bcc : string option;
408 subject : string option;
409 body : string option;
410 has_keyword : string option;
411 not_keyword : string option;
412 has_attachment : bool option;
413 text : string option;
414 }
415
416 type email_query_filter = [
417 | `And of email_query_filter list
418 | `Or of email_query_filter list
419 | `Not of email_query_filter
420 | `Condition of email_filter_condition
421 ]
422
423 (** Email/get request arguments. See RFC8621 Section 4.5. *)
424 type email_get_arguments = {
425 account_id : id;
426 ids : id list option;
427 properties : string list option;
428 body_properties : string list option;
429 fetch_text_body_values : bool option;
430 fetch_html_body_values : bool option;
431 fetch_all_body_values : bool option;
432 max_body_value_bytes : unsigned_int option;
433 }
434
435 (** Email/get response. See RFC8621 Section 4.5. *)
436 type email_get_response = {
437 account_id : id;
438 state : string;
439 list : email list;
440 not_found : id list;
441 }
442
443 (** Email/changes request arguments. See RFC8621 Section 4.6. *)
444 type email_changes_arguments = {
445 account_id : id;
446 since_state : string;
447 max_changes : unsigned_int option;
448 }
449
450 (** Email/changes response. See RFC8621 Section 4.6. *)
451 type email_changes_response = {
452 account_id : id;
453 old_state : string;
454 new_state : string;
455 has_more_changes : bool;
456 created : id list;
457 updated : id list;
458 destroyed : id list;
459 }
460
461 (** Email/query request arguments. See RFC8621 Section 4.4. *)
462 type email_query_arguments = {
463 account_id : id;
464 filter : email_query_filter option;
465 sort : comparator list option;
466 collapse_threads : bool option;
467 position : unsigned_int option;
468 anchor : id option;
469 anchor_offset : int_t option;
470 limit : unsigned_int option;
471 calculate_total : bool option;
472 }
473
474 (** Email/query response. See RFC8621 Section 4.4. *)
475 type email_query_response = {
476 account_id : id;
477 query_state : string;
478 can_calculate_changes : bool;
479 position : unsigned_int;
480 ids : id list;
481 total : unsigned_int option;
482 thread_ids : id list option;
483 }
484
485 (** Email/queryChanges request arguments. See RFC8621 Section 4.7. *)
486 type email_query_changes_arguments = {
487 account_id : id;
488 filter : email_query_filter option;
489 sort : comparator list option;
490 collapse_threads : bool option;
491 since_query_state : string;
492 max_changes : unsigned_int option;
493 up_to_id : id option;
494 }
495
496 (** Email/queryChanges response. See RFC8621 Section 4.7. *)
497 type email_query_changes_response = {
498 account_id : id;
499 old_query_state : string;
500 new_query_state : string;
501 total : unsigned_int option;
502 removed : id list;
503 added : email_query_changes_added list;
504 }
505
506 and email_query_changes_added = {
507 id : id;
508 index : unsigned_int;
509 }
510
511 (** Email/set request arguments. See RFC8621 Section 4.8. *)
512 type email_set_arguments = {
513 account_id : id;
514 if_in_state : string option;
515 create : (id * email_creation) list option;
516 update : (id * email_update) list option;
517 destroy : id list option;
518 }
519
520 and email_creation = {
521 mailbox_ids : (id * bool) list;
522 keywords : (keyword * bool) list option;
523 received_at : utc_date option;
524 message_id : string list option;
525 in_reply_to : string list option;
526 references : string list option;
527 sender : email_address list option;
528 from : email_address list option;
529 to_ : email_address list option;
530 cc : email_address list option;
531 bcc : email_address list option;
532 reply_to : email_address list option;
533 subject : string option;
534 body_values : (string * string) list option;
535 text_body : email_body_part list option;
536 html_body : email_body_part list option;
537 attachments : email_body_part list option;
538 headers : header list option;
539 }
540
541 and email_update = {
542 keywords : (keyword * bool) list option;
543 mailbox_ids : (id * bool) list option;
544 }
545
546 (** Email/set response. See RFC8621 Section 4.8. *)
547 type email_set_response = {
548 account_id : id;
549 old_state : string option;
550 new_state : string;
551 created : (id * email) list option;
552 updated : id list option;
553 destroyed : id list option;
554 not_created : (id * set_error) list option;
555 not_updated : (id * set_error) list option;
556 not_destroyed : (id * set_error) list option;
557 }
558
559 (** Email/copy request arguments. See RFC8621 Section 4.9. *)
560 type email_copy_arguments = {
561 from_account_id : id;
562 account_id : id;
563 create : (id * email_creation) list;
564 on_success_destroy_original : bool option;
565 }
566
567 (** Email/copy response. See RFC8621 Section 4.9. *)
568 type email_copy_response = {
569 from_account_id : id;
570 account_id : id;
571 created : (id * email) list option;
572 not_created : (id * set_error) list option;
573 }
574
575 (** Email/import request arguments. See RFC8621 Section 4.10. *)
576 type email_import_arguments = {
577 account_id : id;
578 emails : (id * email_import) list;
579 }
580
581 and email_import = {
582 blob_id : id;
583 mailbox_ids : (id * bool) list;
584 keywords : (keyword * bool) list option;
585 received_at : utc_date option;
586 }
587
588 (** Email/import response. See RFC8621 Section 4.10. *)
589 type email_import_response = {
590 account_id : id;
591 created : (id * email) list option;
592 not_created : (id * set_error) list option;
593 }
594
595 (** {1:search_snippet Search snippets} *)
596
597 (** SearchSnippet/get request arguments. See RFC8621 Section 4.11. *)
598 type search_snippet_get_arguments = {
599 account_id : id;
600 email_ids : id list;
601 filter : email_filter_condition;
602 }
603
604 (** SearchSnippet/get response. See RFC8621 Section 4.11. *)
605 type search_snippet_get_response = {
606 account_id : id;
607 list : (id * search_snippet) list;
608 not_found : id list;
609 }
610
611 and search_snippet = {
612 subject : string option;
613 preview : string option;
614 }
615
616 (** {1:submission EmailSubmission objects} *)
617
618 (** EmailSubmission address. See RFC8621 Section 5.1. *)
619 type submission_address = {
620 email : string;
621 parameters : (string * string) list option;
622 }
623
624 (** Email submission object. See RFC8621 Section 5.1. *)
625 type email_submission = {
626 id : id;
627 identity_id : id;
628 email_id : id;
629 thread_id : id;
630 envelope : envelope option;
631 send_at : utc_date option;
632 undo_status : [
633 | `pending
634 | `final
635 | `canceled
636 ] option;
637 delivery_status : (string * submission_status) list option;
638 dsn_blob_ids : (string * id) list option;
639 mdn_blob_ids : (string * id) list option;
640 }
641
642 (** Envelope for mail submission. See RFC8621 Section 5.1. *)
643 and envelope = {
644 mail_from : submission_address;
645 rcpt_to : submission_address list;
646 }
647
648 (** Delivery status for submitted email. See RFC8621 Section 5.1. *)
649 and submission_status = {
650 smtp_reply : string;
651 delivered : string option;
652 }
653
654 (** EmailSubmission/get request arguments. See RFC8621 Section 5.3. *)
655 type email_submission_get_arguments = {
656 account_id : id;
657 ids : id list option;
658 properties : string list option;
659 }
660
661 (** EmailSubmission/get response. See RFC8621 Section 5.3. *)
662 type email_submission_get_response = {
663 account_id : id;
664 state : string;
665 list : email_submission list;
666 not_found : id list;
667 }
668
669 (** EmailSubmission/changes request arguments. See RFC8621 Section 5.4. *)
670 type email_submission_changes_arguments = {
671 account_id : id;
672 since_state : string;
673 max_changes : unsigned_int option;
674 }
675
676 (** EmailSubmission/changes response. See RFC8621 Section 5.4. *)
677 type email_submission_changes_response = {
678 account_id : id;
679 old_state : string;
680 new_state : string;
681 has_more_changes : bool;
682 created : id list;
683 updated : id list;
684 destroyed : id list;
685 }
686
687 (** EmailSubmission/query filter condition. See RFC8621 Section 5.5. *)
688 type email_submission_filter_condition = {
689 identity_id : id option;
690 email_id : id option;
691 thread_id : id option;
692 before : utc_date option;
693 after : utc_date option;
694 subject : string option;
695 }
696
697 type email_submission_query_filter = [
698 | `And of email_submission_query_filter list
699 | `Or of email_submission_query_filter list
700 | `Not of email_submission_query_filter
701 | `Condition of email_submission_filter_condition
702 ]
703
704 (** EmailSubmission/query request arguments. See RFC8621 Section 5.5. *)
705 type email_submission_query_arguments = {
706 account_id : id;
707 filter : email_submission_query_filter option;
708 sort : comparator list option;
709 position : unsigned_int option;
710 anchor : id option;
711 anchor_offset : int_t option;
712 limit : unsigned_int option;
713 calculate_total : bool option;
714 }
715
716 (** EmailSubmission/query response. See RFC8621 Section 5.5. *)
717 type email_submission_query_response = {
718 account_id : id;
719 query_state : string;
720 can_calculate_changes : bool;
721 position : unsigned_int;
722 ids : id list;
723 total : unsigned_int option;
724 }
725
726 (** EmailSubmission/set request arguments. See RFC8621 Section 5.6. *)
727 type email_submission_set_arguments = {
728 account_id : id;
729 if_in_state : string option;
730 create : (id * email_submission_creation) list option;
731 update : (id * email_submission_update) list option;
732 destroy : id list option;
733 on_success_update_email : (id * email_update) list option;
734 }
735
736 and email_submission_creation = {
737 email_id : id;
738 identity_id : id;
739 envelope : envelope option;
740 send_at : utc_date option;
741 }
742
743 and email_submission_update = {
744 email_id : id option;
745 identity_id : id option;
746 envelope : envelope option;
747 undo_status : [`canceled] option;
748 }
749
750 (** EmailSubmission/set response. See RFC8621 Section 5.6. *)
751 type email_submission_set_response = {
752 account_id : id;
753 old_state : string option;
754 new_state : string;
755 created : (id * email_submission) list option;
756 updated : id list option;
757 destroyed : id list option;
758 not_created : (id * set_error) list option;
759 not_updated : (id * set_error) list option;
760 not_destroyed : (id * set_error) list option;
761 }
762
763 (** {1:identity Identity objects} *)
764
765 (** Identity for sending mail. See RFC8621 Section 6. *)
766 type identity = {
767 id : id;
768 name : string;
769 email : string;
770 reply_to : email_address list option;
771 bcc : email_address list option;
772 text_signature : string option;
773 html_signature : string option;
774 may_delete : bool;
775 }
776
777 (** Identity/get request arguments. See RFC8621 Section 6.1. *)
778 type identity_get_arguments = {
779 account_id : id;
780 ids : id list option;
781 properties : string list option;
782 }
783
784 (** Identity/get response. See RFC8621 Section 6.1. *)
785 type identity_get_response = {
786 account_id : id;
787 state : string;
788 list : identity list;
789 not_found : id list;
790 }
791
792 (** Identity/changes request arguments. See RFC8621 Section 6.2. *)
793 type identity_changes_arguments = {
794 account_id : id;
795 since_state : string;
796 max_changes : unsigned_int option;
797 }
798
799 (** Identity/changes response. See RFC8621 Section 6.2. *)
800 type identity_changes_response = {
801 account_id : id;
802 old_state : string;
803 new_state : string;
804 has_more_changes : bool;
805 created : id list;
806 updated : id list;
807 destroyed : id list;
808 }
809
810 (** Identity/set request arguments. See RFC8621 Section 6.3. *)
811 type identity_set_arguments = {
812 account_id : id;
813 if_in_state : string option;
814 create : (id * identity_creation) list option;
815 update : (id * identity_update) list option;
816 destroy : id list option;
817 }
818
819 and identity_creation = {
820 name : string;
821 email : string;
822 reply_to : email_address list option;
823 bcc : email_address list option;
824 text_signature : string option;
825 html_signature : string option;
826 }
827
828 and identity_update = {
829 name : string option;
830 email : string option;
831 reply_to : email_address list option;
832 bcc : email_address list option;
833 text_signature : string option;
834 html_signature : string option;
835 }
836
837 (** Identity/set response. See RFC8621 Section 6.3. *)
838 type identity_set_response = {
839 account_id : id;
840 old_state : string option;
841 new_state : string;
842 created : (id * identity) list option;
843 updated : id list option;
844 destroyed : id list option;
845 not_created : (id * set_error) list option;
846 not_updated : (id * set_error) list option;
847 not_destroyed : (id * set_error) list option;
848 }
849
850 (** {1:vacation_response VacationResponse objects} *)
851
852 (** Vacation auto-reply setting. See RFC8621 Section 7. *)
853 type vacation_response = {
854 id : id;
855 is_enabled : bool;
856 from_date : utc_date option;
857 to_date : utc_date option;
858 subject : string option;
859 text_body : string option;
860 html_body : string option;
861 }
862
863 (** VacationResponse/get request arguments. See RFC8621 Section 7.2. *)
864 type vacation_response_get_arguments = {
865 account_id : id;
866 ids : id list option;
867 properties : string list option;
868 }
869
870 (** VacationResponse/get response. See RFC8621 Section 7.2. *)
871 type vacation_response_get_response = {
872 account_id : id;
873 state : string;
874 list : vacation_response list;
875 not_found : id list;
876 }
877
878 (** VacationResponse/set request arguments. See RFC8621 Section 7.3. *)
879 type vacation_response_set_arguments = {
880 account_id : id;
881 if_in_state : string option;
882 update : (id * vacation_response_update) list;
883 }
884
885 and vacation_response_update = {
886 is_enabled : bool option;
887 from_date : utc_date option;
888 to_date : utc_date option;
889 subject : string option;
890 text_body : string option;
891 html_body : string option;
892 }
893
894 (** VacationResponse/set response. See RFC8621 Section 7.3. *)
895 type vacation_response_set_response = {
896 account_id : id;
897 old_state : string option;
898 new_state : string;
899 updated : id list option;
900 not_updated : (id * set_error) list option;
901 }
902end
903
904(** {1 JSON serialization} *)
905
906module Json = struct
907 open Types
908
909 (** {2 Helper functions for serialization} *)
910
911 let string_of_mailbox_role = function
912 | All -> "all"
913 | Archive -> "archive"
914 | Drafts -> "drafts"
915 | Flagged -> "flagged"
916 | Important -> "important"
917 | Inbox -> "inbox"
918 | Junk -> "junk"
919 | Sent -> "sent"
920 | Trash -> "trash"
921 | Unknown s -> s
922
923 let mailbox_role_of_string = function
924 | "all" -> All
925 | "archive" -> Archive
926 | "drafts" -> Drafts
927 | "flagged" -> Flagged
928 | "important" -> Important
929 | "inbox" -> Inbox
930 | "junk" -> Junk
931 | "sent" -> Sent
932 | "trash" -> Trash
933 | s -> Unknown s
934
935 let string_of_keyword = function
936 | Flagged -> "$flagged"
937 | Answered -> "$answered"
938 | Draft -> "$draft"
939 | Forwarded -> "$forwarded"
940 | Phishing -> "$phishing"
941 | Junk -> "$junk"
942 | NotJunk -> "$notjunk"
943 | Seen -> "$seen"
944 | Unread -> "$unread"
945 | Custom s -> s
946
947 let keyword_of_string = function
948 | "$flagged" -> Flagged
949 | "$answered" -> Answered
950 | "$draft" -> Draft
951 | "$forwarded" -> Forwarded
952 | "$phishing" -> Phishing
953 | "$junk" -> Junk
954 | "$notjunk" -> NotJunk
955 | "$seen" -> Seen
956 | "$unread" -> Unread
957 | s -> Custom s
958
959 (** {2 Mailbox serialization} *)
960
961 (** TODO:claude - Need to implement all JSON serialization functions
962 for each type we've defined. This would be a substantial amount of
963 code and likely require additional understanding of the ezjsonm API.
964
965 For a full implementation, we would need functions to convert between
966 OCaml types and JSON for each of:
967 - mailbox, mailbox_rights, mailbox query/update operations
968 - thread operations
969 - email, email_address, header, email_body_part
970 - email query/update operations
971 - submission operations
972 - identity operations
973 - vacation response operations
974 *)
975end
976
977(** {1 API functions} *)
978
979open Lwt.Syntax
980open Jmap.Api
981open Jmap.Types
982
983(** Authentication credentials for a JMAP server *)
984type credentials = {
985 username: string;
986 password: string;
987}
988
989(** Connection to a JMAP mail server *)
990type connection = {
991 session: Jmap.Types.session;
992 config: Jmap.Api.config;
993}
994
995(** Convert JSON mail object to OCaml type *)
996let mailbox_of_json json =
997 try
998 let open Ezjsonm in
999 Printf.printf "Parsing mailbox JSON\n";
1000
1001 let id = get_string (find json ["id"]) in
1002 Printf.printf "Got id: %s\n" id;
1003
1004 let name = get_string (find json ["name"]) in
1005 Printf.printf "Got name: %s\n" name;
1006
1007 (* Handle parentId which can be null *)
1008 let parent_id =
1009 match find_opt json ["parentId"] with
1010 | Some (`Null) -> None
1011 | Some (`String s) -> Some s
1012 | None -> None
1013 | _ -> None
1014 in
1015 Printf.printf "Got parent_id: %s\n" (match parent_id with Some p -> p | None -> "None");
1016
1017 (* Handle role which might be null *)
1018 let role =
1019 match find_opt json ["role"] with
1020 | Some (`Null) -> None
1021 | Some (`String s) -> Some (Json.mailbox_role_of_string s)
1022 | None -> None
1023 | _ -> None
1024 in
1025 Printf.printf "Got role\n";
1026
1027 let sort_order = get_int (find json ["sortOrder"]) in
1028 Printf.printf "Got sort_order: %d\n" sort_order;
1029
1030 let total_emails = get_int (find json ["totalEmails"]) in
1031 Printf.printf "Got total_emails: %d\n" total_emails;
1032
1033 let unread_emails = get_int (find json ["unreadEmails"]) in
1034 Printf.printf "Got unread_emails: %d\n" unread_emails;
1035
1036 let total_threads = get_int (find json ["totalThreads"]) in
1037 Printf.printf "Got total_threads: %d\n" total_threads;
1038
1039 let unread_threads = get_int (find json ["unreadThreads"]) in
1040 Printf.printf "Got unread_threads: %d\n" unread_threads;
1041
1042 let is_subscribed = get_bool (find json ["isSubscribed"]) in
1043 Printf.printf "Got is_subscribed: %b\n" is_subscribed;
1044
1045 let rights_json = find json ["myRights"] in
1046 Printf.printf "Got rights_json\n";
1047
1048 let my_rights = {
1049 Types.may_read_items = get_bool (find rights_json ["mayReadItems"]);
1050 may_add_items = get_bool (find rights_json ["mayAddItems"]);
1051 may_remove_items = get_bool (find rights_json ["mayRemoveItems"]);
1052 may_set_seen = get_bool (find rights_json ["maySetSeen"]);
1053 may_set_keywords = get_bool (find rights_json ["maySetKeywords"]);
1054 may_create_child = get_bool (find rights_json ["mayCreateChild"]);
1055 may_rename = get_bool (find rights_json ["mayRename"]);
1056 may_delete = get_bool (find rights_json ["mayDelete"]);
1057 may_submit = get_bool (find rights_json ["maySubmit"]);
1058 } in
1059 Printf.printf "Constructed my_rights\n";
1060
1061 let result = {
1062 Types.id;
1063 name;
1064 parent_id;
1065 role;
1066 sort_order;
1067 total_emails;
1068 unread_emails;
1069 total_threads;
1070 unread_threads;
1071 is_subscribed;
1072 my_rights;
1073 } in
1074 Printf.printf "Constructed mailbox result\n";
1075
1076 Ok (result)
1077 with
1078 | Not_found as e ->
1079 Printf.printf "Not_found error: %s\n" (Printexc.to_string e);
1080 Printexc.print_backtrace stdout;
1081 Error (Parse_error "Required field not found in mailbox object")
1082 | Invalid_argument msg ->
1083 Printf.printf "Invalid_argument error: %s\n" msg;
1084 Error (Parse_error msg)
1085 | e ->
1086 Printf.printf "Unknown error: %s\n" (Printexc.to_string e);
1087 Error (Parse_error (Printexc.to_string e))
1088
1089(** Convert JSON email object to OCaml type *)
1090let email_of_json json =
1091 try
1092 let open Ezjsonm in
1093 Printf.printf "Parsing email JSON\n";
1094
1095 let id = get_string (find json ["id"]) in
1096 Printf.printf "Got email id: %s\n" id;
1097
1098 let blob_id = get_string (find json ["blobId"]) in
1099 let thread_id = get_string (find json ["threadId"]) in
1100
1101 (* Process mailboxIds map *)
1102 let mailbox_ids_json = find json ["mailboxIds"] in
1103 let mailbox_ids = match mailbox_ids_json with
1104 | `O items -> List.map (fun (id, v) -> (id, get_bool v)) items
1105 | _ -> raise (Invalid_argument "mailboxIds is not an object")
1106 in
1107
1108 (* Process keywords map *)
1109 let keywords_json = find json ["keywords"] in
1110 let keywords = match keywords_json with
1111 | `O items -> List.map (fun (k, v) ->
1112 (Json.keyword_of_string k, get_bool v)) items
1113 | _ -> raise (Invalid_argument "keywords is not an object")
1114 in
1115
1116 let size = get_int (find json ["size"]) in
1117 let received_at = get_string (find json ["receivedAt"]) in
1118
1119 (* Handle messageId which might be an array or missing *)
1120 let message_id =
1121 match find_opt json ["messageId"] with
1122 | Some (`A ids) -> List.map (fun id ->
1123 match id with
1124 | `String s -> s
1125 | _ -> raise (Invalid_argument "messageId item is not a string")
1126 ) ids
1127 | Some (`String s) -> [s] (* Handle single string case *)
1128 | None -> [] (* Handle missing case *)
1129 | _ -> raise (Invalid_argument "messageId has unexpected type")
1130 in
1131
1132 (* Parse optional fields *)
1133 let parse_email_addresses opt_json =
1134 match opt_json with
1135 | Some (`A items) ->
1136 Some (List.map (fun addr_json ->
1137 let name =
1138 match find_opt addr_json ["name"] with
1139 | Some (`String s) -> Some s
1140 | Some (`Null) -> None
1141 | None -> None
1142 | _ -> None
1143 in
1144 let email = get_string (find addr_json ["email"]) in
1145 let parameters =
1146 match find_opt addr_json ["parameters"] with
1147 | Some (`O items) -> List.map (fun (k, v) ->
1148 match v with
1149 | `String s -> (k, s)
1150 | _ -> (k, "")
1151 ) items
1152 | _ -> []
1153 in
1154 { Types.name; email; parameters }
1155 ) items)
1156 | _ -> None
1157 in
1158
1159 (* Handle optional string arrays with null handling *)
1160 let parse_string_array_opt field_name =
1161 match find_opt json [field_name] with
1162 | Some (`A ids) ->
1163 Some (List.filter_map (function
1164 | `String s -> Some s
1165 | _ -> None
1166 ) ids)
1167 | Some (`Null) -> None
1168 | None -> None
1169 | _ -> None
1170 in
1171
1172 let in_reply_to = parse_string_array_opt "inReplyTo" in
1173 let references = parse_string_array_opt "references" in
1174
1175 let sender = parse_email_addresses (find_opt json ["sender"]) in
1176 let from = parse_email_addresses (find_opt json ["from"]) in
1177 let to_ = parse_email_addresses (find_opt json ["to"]) in
1178 let cc = parse_email_addresses (find_opt json ["cc"]) in
1179 let bcc = parse_email_addresses (find_opt json ["bcc"]) in
1180 let reply_to = parse_email_addresses (find_opt json ["replyTo"]) in
1181
1182 (* Handle optional string fields with null handling *)
1183 let parse_string_opt field_name =
1184 match find_opt json [field_name] with
1185 | Some (`String s) -> Some s
1186 | Some (`Null) -> None
1187 | None -> None
1188 | _ -> None
1189 in
1190
1191 let subject = parse_string_opt "subject" in
1192 let sent_at = parse_string_opt "sentAt" in
1193
1194 (* Handle optional boolean fields with null handling *)
1195 let parse_bool_opt field_name =
1196 match find_opt json [field_name] with
1197 | Some (`Bool b) -> Some b
1198 | Some (`Null) -> None
1199 | None -> None
1200 | _ -> None
1201 in
1202
1203 let has_attachment = parse_bool_opt "hasAttachment" in
1204 let preview = parse_string_opt "preview" in
1205
1206 (* Body parts parsing would go here - omitting for brevity *)
1207 Printf.printf "Email parsed successfully\n";
1208
1209 Ok ({
1210 Types.id;
1211 blob_id;
1212 thread_id;
1213 mailbox_ids;
1214 keywords;
1215 size;
1216 received_at;
1217 message_id;
1218 in_reply_to;
1219 references;
1220 sender;
1221 from;
1222 to_;
1223 cc;
1224 bcc;
1225 reply_to;
1226 subject;
1227 sent_at;
1228 has_attachment;
1229 preview;
1230 body_values = None;
1231 text_body = None;
1232 html_body = None;
1233 attachments = None;
1234 headers = None;
1235 })
1236 with
1237 | Not_found as e ->
1238 Printf.printf "Email parse error - Not_found: %s\n" (Printexc.to_string e);
1239 Printexc.print_backtrace stdout;
1240 Error (Parse_error "Required field not found in email object")
1241 | Invalid_argument msg ->
1242 Printf.printf "Email parse error - Invalid_argument: %s\n" msg;
1243 Error (Parse_error msg)
1244 | e ->
1245 Printf.printf "Email parse error - Unknown: %s\n" (Printexc.to_string e);
1246 Error (Parse_error (Printexc.to_string e))
1247
1248(** Login to a JMAP server and establish a connection
1249 @param uri The URI of the JMAP server
1250 @param credentials Authentication credentials
1251 @return A connection object if successful
1252
1253 TODO:claude *)
1254let login ~uri ~credentials =
1255 let* session_result = get_session (Uri.of_string uri)
1256 ~username:credentials.username
1257 ~authentication_token:credentials.password
1258 () in
1259 match session_result with
1260 | Ok session ->
1261 let api_uri = Uri.of_string session.api_url in
1262 let config = {
1263 api_uri;
1264 username = credentials.username;
1265 authentication_token = credentials.password;
1266 } in
1267 Lwt.return (Ok { session; config })
1268 | Error e -> Lwt.return (Error e)
1269
1270(** Login to a JMAP server using an API token
1271 @param uri The URI of the JMAP server
1272 @param api_token The API token for authentication
1273 @return A connection object if successful
1274
1275 TODO:claude *)
1276let login_with_token ~uri ~api_token =
1277 let* session_result = get_session (Uri.of_string uri)
1278 ~api_token
1279 () in
1280 match session_result with
1281 | Ok session ->
1282 let api_uri = Uri.of_string session.api_url in
1283 let config = {
1284 api_uri;
1285 username = ""; (* Empty username indicates we're using token auth *)
1286 authentication_token = api_token;
1287 } in
1288 Lwt.return (Ok { session; config })
1289 | Error e -> Lwt.return (Error e)
1290
1291(** Get all mailboxes for an account
1292 @param conn The JMAP connection
1293 @param account_id The account ID to get mailboxes for
1294 @return A list of mailboxes if successful
1295
1296 TODO:claude *)
1297let get_mailboxes conn ~account_id =
1298 let request = {
1299 using = [
1300 Jmap.Capability.to_string (Jmap.Capability.Core Core);
1301 Capability.to_string (Capability.Mail Mail)
1302 ];
1303 method_calls = [
1304 {
1305 name = "Mailbox/get";
1306 arguments = `O [
1307 ("accountId", `String account_id);
1308 ];
1309 method_call_id = "m1";
1310 }
1311 ];
1312 created_ids = None;
1313 } in
1314
1315 let* response_result = make_request conn.config request in
1316 match response_result with
1317 | Ok response ->
1318 let result =
1319 try
1320 let method_response = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) ->
1321 inv.name = "Mailbox/get") response.method_responses in
1322 let args = method_response.arguments in
1323 match Ezjsonm.find_opt args ["list"] with
1324 | Some (`A mailbox_list) ->
1325 let parse_results = List.map mailbox_of_json mailbox_list in
1326 let (successes, failures) = List.partition Result.is_ok parse_results in
1327 if List.length failures > 0 then
1328 Error (Parse_error "Failed to parse some mailboxes")
1329 else
1330 Ok (List.map Result.get_ok successes)
1331 | _ -> Error (Parse_error "Mailbox list not found in response")
1332 with
1333 | Not_found -> Error (Parse_error "Mailbox/get method response not found")
1334 | e -> Error (Parse_error (Printexc.to_string e))
1335 in
1336 Lwt.return result
1337 | Error e -> Lwt.return (Error e)
1338
1339(** Get a specific mailbox by ID
1340 @param conn The JMAP connection
1341 @param account_id The account ID
1342 @param mailbox_id The mailbox ID to retrieve
1343 @return The mailbox if found
1344
1345 TODO:claude *)
1346let get_mailbox conn ~account_id ~mailbox_id =
1347 let request = {
1348 using = [
1349 Jmap.Capability.to_string (Jmap.Capability.Core Core);
1350 Capability.to_string (Capability.Mail Mail)
1351 ];
1352 method_calls = [
1353 {
1354 name = "Mailbox/get";
1355 arguments = `O [
1356 ("accountId", `String account_id);
1357 ("ids", `A [`String mailbox_id]);
1358 ];
1359 method_call_id = "m1";
1360 }
1361 ];
1362 created_ids = None;
1363 } in
1364
1365 let* response_result = make_request conn.config request in
1366 match response_result with
1367 | Ok response ->
1368 let result =
1369 try
1370 let method_response = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) ->
1371 inv.name = "Mailbox/get") response.method_responses in
1372 let args = method_response.arguments in
1373 match Ezjsonm.find_opt args ["list"] with
1374 | Some (`A [mailbox]) -> mailbox_of_json mailbox
1375 | Some (`A []) -> Error (Parse_error ("Mailbox not found: " ^ mailbox_id))
1376 | _ -> Error (Parse_error "Expected single mailbox in response")
1377 with
1378 | Not_found -> Error (Parse_error "Mailbox/get method response not found")
1379 | e -> Error (Parse_error (Printexc.to_string e))
1380 in
1381 Lwt.return result
1382 | Error e -> Lwt.return (Error e)
1383
1384(** Get messages in a mailbox
1385 @param conn The JMAP connection
1386 @param account_id The account ID
1387 @param mailbox_id The mailbox ID to get messages from
1388 @param limit Optional limit on number of messages to return
1389 @return The list of email messages if successful
1390
1391 TODO:claude *)
1392let get_messages_in_mailbox conn ~account_id ~mailbox_id ?limit () =
1393 (* First query the emails in the mailbox *)
1394 let query_request = {
1395 using = [
1396 Jmap.Capability.to_string (Jmap.Capability.Core Core);
1397 Capability.to_string (Capability.Mail Mail)
1398 ];
1399 method_calls = [
1400 {
1401 name = "Email/query";
1402 arguments = `O ([
1403 ("accountId", `String account_id);
1404 ("filter", `O [("inMailbox", `String mailbox_id)]);
1405 ("sort", `A [`O [("property", `String "receivedAt"); ("isAscending", `Bool false)]]);
1406 ] @ (match limit with
1407 | Some l -> [("limit", `Float (float_of_int l))]
1408 | None -> []
1409 ));
1410 method_call_id = "q1";
1411 }
1412 ];
1413 created_ids = None;
1414 } in
1415
1416 let* query_result = make_request conn.config query_request in
1417 match query_result with
1418 | Ok query_response ->
1419 (try
1420 let query_method = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) ->
1421 inv.name = "Email/query") query_response.method_responses in
1422 let args = query_method.arguments in
1423 match Ezjsonm.find_opt args ["ids"] with
1424 | Some (`A ids) ->
1425 let email_ids = List.map (function
1426 | `String id -> id
1427 | _ -> raise (Invalid_argument "Email ID is not a string")
1428 ) ids in
1429
1430 (* If we have IDs, fetch the actual email objects *)
1431 if List.length email_ids > 0 then
1432 let get_request = {
1433 using = [
1434 Jmap.Capability.to_string (Jmap.Capability.Core Core);
1435 Capability.to_string (Capability.Mail Mail)
1436 ];
1437 method_calls = [
1438 {
1439 name = "Email/get";
1440 arguments = `O [
1441 ("accountId", `String account_id);
1442 ("ids", `A (List.map (fun id -> `String id) email_ids));
1443 ];
1444 method_call_id = "g1";
1445 }
1446 ];
1447 created_ids = None;
1448 } in
1449
1450 let* get_result = make_request conn.config get_request in
1451 match get_result with
1452 | Ok get_response ->
1453 (try
1454 let get_method = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) ->
1455 inv.name = "Email/get") get_response.method_responses in
1456 let args = get_method.arguments in
1457 match Ezjsonm.find_opt args ["list"] with
1458 | Some (`A email_list) ->
1459 let parse_results = List.map email_of_json email_list in
1460 let (successes, failures) = List.partition Result.is_ok parse_results in
1461 if List.length failures > 0 then
1462 Lwt.return (Error (Parse_error "Failed to parse some emails"))
1463 else
1464 Lwt.return (Ok (List.map Result.get_ok successes))
1465 | _ -> Lwt.return (Error (Parse_error "Email list not found in response"))
1466 with
1467 | Not_found -> Lwt.return (Error (Parse_error "Email/get method response not found"))
1468 | e -> Lwt.return (Error (Parse_error (Printexc.to_string e))))
1469 | Error e -> Lwt.return (Error e)
1470 else
1471 (* No emails in mailbox *)
1472 Lwt.return (Ok [])
1473
1474 | _ -> Lwt.return (Error (Parse_error "Email IDs not found in query response"))
1475 with
1476 | Not_found -> Lwt.return (Error (Parse_error "Email/query method response not found"))
1477 | Invalid_argument msg -> Lwt.return (Error (Parse_error msg))
1478 | e -> Lwt.return (Error (Parse_error (Printexc.to_string e))))
1479 | Error e -> Lwt.return (Error e)
1480
1481(** Get a single email message by ID
1482 @param conn The JMAP connection
1483 @param account_id The account ID
1484 @param email_id The email ID to retrieve
1485 @return The email message if found
1486
1487 TODO:claude *)
1488let get_email conn ~account_id ~email_id =
1489 let request = {
1490 using = [
1491 Jmap.Capability.to_string (Jmap.Capability.Core Core);
1492 Capability.to_string (Capability.Mail Mail)
1493 ];
1494 method_calls = [
1495 {
1496 name = "Email/get";
1497 arguments = `O [
1498 ("accountId", `String account_id);
1499 ("ids", `A [`String email_id]);
1500 ];
1501 method_call_id = "m1";
1502 }
1503 ];
1504 created_ids = None;
1505 } in
1506
1507 let* response_result = make_request conn.config request in
1508 match response_result with
1509 | Ok response ->
1510 let result =
1511 try
1512 let method_response = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) ->
1513 inv.name = "Email/get") response.method_responses in
1514 let args = method_response.arguments in
1515 match Ezjsonm.find_opt args ["list"] with
1516 | Some (`A [email]) -> email_of_json email
1517 | Some (`A []) -> Error (Parse_error ("Email not found: " ^ email_id))
1518 | _ -> Error (Parse_error "Expected single email in response")
1519 with
1520 | Not_found -> Error (Parse_error "Email/get method response not found")
1521 | e -> Error (Parse_error (Printexc.to_string e))
1522 in
1523 Lwt.return result
1524 | Error e -> Lwt.return (Error e)