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