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 URI *)
6 let mail_uri = "urn:ietf:params:jmap:mail"
7
8 (** Submission capability URI *)
9 let submission_uri = "urn:ietf:params:jmap:submission"
10
11 (** Vacation response capability URI *)
12 let vacation_response_uri = "urn:ietf:params:jmap:vacationresponse"
13
14 (** All mail extension capability types *)
15 type t =
16 | Mail (** Mail capability *)
17 | Submission (** Submission capability *)
18 | VacationResponse (** Vacation response capability *)
19 | Extension of string (** Custom extension *)
20
21 (** Convert capability to URI string *)
22 let to_string = function
23 | Mail -> mail_uri
24 | Submission -> submission_uri
25 | VacationResponse -> vacation_response_uri
26 | Extension s -> s
27
28 (** Parse a string to a capability *)
29 let of_string s =
30 if s = mail_uri then Mail
31 else if s = submission_uri then Submission
32 else if s = vacation_response_uri then VacationResponse
33 else Extension s
34
35 (** Check if a capability is a standard mail capability *)
36 let is_standard = function
37 | Mail | Submission | VacationResponse -> true
38 | Extension _ -> false
39
40 (** Check if a capability string is a standard mail capability *)
41 let is_standard_string s =
42 s = mail_uri || s = submission_uri || s = vacation_response_uri
43
44 (** Create a list of capability strings *)
45 let strings_of_capabilities capabilities =
46 List.map to_string capabilities
47end
48
49module Types = struct
50 open Jmap.Types
51
52 (** {1 Mail capabilities} *)
53
54 (** Capability URI for JMAP Mail*)
55 let capability_mail = Capability.mail_uri
56
57 (** Capability URI for JMAP Submission *)
58 let capability_submission = Capability.submission_uri
59
60 (** Capability URI for JMAP Vacation Response *)
61 let capability_vacation_response = Capability.vacation_response_uri
62
63 (** {1:mailbox Mailbox objects} *)
64
65 (** A role for a mailbox. See RFC8621 Section 2. *)
66 type mailbox_role =
67 | All (** All mail *)
68 | Archive (** Archived mail *)
69 | Drafts (** Draft messages *)
70 | Flagged (** Starred/flagged mail *)
71 | Important (** Important mail *)
72 | Inbox (** Inbox *)
73 | Junk (** Spam/Junk mail *)
74 | Sent (** Sent mail *)
75 | Trash (** Deleted/Trash mail *)
76 | Unknown of string (** Server-specific roles *)
77
78 (** A mailbox (folder) in a mail account. See RFC8621 Section 2. *)
79 type mailbox = {
80 id : id;
81 name : string;
82 parent_id : id option;
83 role : mailbox_role option;
84 sort_order : unsigned_int;
85 total_emails : unsigned_int;
86 unread_emails : unsigned_int;
87 total_threads : unsigned_int;
88 unread_threads : unsigned_int;
89 is_subscribed : bool;
90 my_rights : mailbox_rights;
91 }
92
93 (** Rights for a mailbox. See RFC8621 Section 2. *)
94 and mailbox_rights = {
95 may_read_items : bool;
96 may_add_items : bool;
97 may_remove_items : bool;
98 may_set_seen : bool;
99 may_set_keywords : bool;
100 may_create_child : bool;
101 may_rename : bool;
102 may_delete : bool;
103 may_submit : bool;
104 }
105
106 (** Filter condition for mailbox queries. See RFC8621 Section 2.3. *)
107 type mailbox_filter_condition = {
108 parent_id : id option;
109 name : string option;
110 role : string option;
111 has_any_role : bool option;
112 is_subscribed : bool option;
113 }
114
115 type mailbox_query_filter = [
116 | `And of mailbox_query_filter list
117 | `Or of mailbox_query_filter list
118 | `Not of mailbox_query_filter
119 | `Condition of mailbox_filter_condition
120 ]
121
122 (** Mailbox/get request arguments. See RFC8621 Section 2.1. *)
123 type mailbox_get_arguments = {
124 account_id : id;
125 ids : id list option;
126 properties : string list option;
127 }
128
129 (** Mailbox/get response. See RFC8621 Section 2.1. *)
130 type mailbox_get_response = {
131 account_id : id;
132 state : string;
133 list : mailbox list;
134 not_found : id list;
135 }
136
137 (** Mailbox/changes request arguments. See RFC8621 Section 2.2. *)
138 type mailbox_changes_arguments = {
139 account_id : id;
140 since_state : string;
141 max_changes : unsigned_int option;
142 }
143
144 (** Mailbox/changes response. See RFC8621 Section 2.2. *)
145 type mailbox_changes_response = {
146 account_id : id;
147 old_state : string;
148 new_state : string;
149 has_more_changes : bool;
150 created : id list;
151 updated : id list;
152 destroyed : id list;
153 }
154
155 (** Mailbox/query request arguments. See RFC8621 Section 2.3. *)
156 type mailbox_query_arguments = {
157 account_id : id;
158 filter : mailbox_query_filter option;
159 sort : [ `name | `role | `sort_order ] list option;
160 limit : unsigned_int option;
161 }
162
163 (** Mailbox/query response. See RFC8621 Section 2.3. *)
164 type mailbox_query_response = {
165 account_id : id;
166 query_state : string;
167 can_calculate_changes : bool;
168 position : unsigned_int;
169 ids : id list;
170 total : unsigned_int option;
171 }
172
173 (** Mailbox/queryChanges request arguments. See RFC8621 Section 2.4. *)
174 type mailbox_query_changes_arguments = {
175 account_id : id;
176 filter : mailbox_query_filter option;
177 sort : [ `name | `role | `sort_order ] list option;
178 since_query_state : string;
179 max_changes : unsigned_int option;
180 up_to_id : id option;
181 }
182
183 (** Mailbox/queryChanges response. See RFC8621 Section 2.4. *)
184 type mailbox_query_changes_response = {
185 account_id : id;
186 old_query_state : string;
187 new_query_state : string;
188 total : unsigned_int option;
189 removed : id list;
190 added : mailbox_query_changes_added list;
191 }
192
193 and mailbox_query_changes_added = {
194 id : id;
195 index : unsigned_int;
196 }
197
198 (** Mailbox/set request arguments. See RFC8621 Section 2.5. *)
199 type mailbox_set_arguments = {
200 account_id : id;
201 if_in_state : string option;
202 create : (id * mailbox_creation) list option;
203 update : (id * mailbox_update) list option;
204 destroy : id list option;
205 }
206
207 and mailbox_creation = {
208 name : string;
209 parent_id : id option;
210 role : string option;
211 sort_order : unsigned_int option;
212 is_subscribed : bool option;
213 }
214
215 and mailbox_update = {
216 name : string option;
217 parent_id : id option;
218 role : string option;
219 sort_order : unsigned_int option;
220 is_subscribed : bool option;
221 }
222
223 (** Mailbox/set response. See RFC8621 Section 2.5. *)
224 type mailbox_set_response = {
225 account_id : id;
226 old_state : string option;
227 new_state : string;
228 created : (id * mailbox) list option;
229 updated : id list option;
230 destroyed : id list option;
231 not_created : (id * set_error) list option;
232 not_updated : (id * set_error) list option;
233 not_destroyed : (id * set_error) list option;
234 }
235
236 (** {1:thread Thread objects} *)
237
238 (** A thread in a mail account. See RFC8621 Section 3. *)
239 type thread = {
240 id : id;
241 email_ids : id list;
242 }
243
244 (** Thread/get request arguments. See RFC8621 Section 3.1. *)
245 type thread_get_arguments = {
246 account_id : id;
247 ids : id list option;
248 properties : string list option;
249 }
250
251 (** Thread/get response. See RFC8621 Section 3.1. *)
252 type thread_get_response = {
253 account_id : id;
254 state : string;
255 list : thread list;
256 not_found : id list;
257 }
258
259 (** Thread/changes request arguments. See RFC8621 Section 3.2. *)
260 type thread_changes_arguments = {
261 account_id : id;
262 since_state : string;
263 max_changes : unsigned_int option;
264 }
265
266 (** Thread/changes response. See RFC8621 Section 3.2. *)
267 type thread_changes_response = {
268 account_id : id;
269 old_state : string;
270 new_state : string;
271 has_more_changes : bool;
272 created : id list;
273 updated : id list;
274 destroyed : id list;
275 }
276
277 (** {1:email Email objects} *)
278
279 (** Addressing (mailbox) information. See RFC8621 Section 4.1.1. *)
280 type email_address = {
281 name : string option;
282 email : string;
283 parameters : (string * string) list;
284 }
285
286 (** Message header field. See RFC8621 Section 4.1.2. *)
287 type header = {
288 name : string;
289 value : string;
290 }
291
292 (** Email keyword (flag). See RFC8621 Section 4.3. *)
293 type keyword =
294 | Flagged
295 | Answered
296 | Draft
297 | Forwarded
298 | Phishing
299 | Junk
300 | NotJunk
301 | Seen
302 | Unread
303 | Custom of string
304
305 (** Email message. See RFC8621 Section 4. *)
306 type email = {
307 id : id;
308 blob_id : id;
309 thread_id : id;
310 mailbox_ids : (id * bool) list;
311 keywords : (keyword * bool) list;
312 size : unsigned_int;
313 received_at : utc_date;
314 message_id : string list;
315 in_reply_to : string list option;
316 references : string list option;
317 sender : email_address list option;
318 from : email_address list option;
319 to_ : email_address list option;
320 cc : email_address list option;
321 bcc : email_address list option;
322 reply_to : email_address list option;
323 subject : string option;
324 sent_at : utc_date option;
325 has_attachment : bool option;
326 preview : string option;
327 body_values : (string * string) list option;
328 text_body : email_body_part list option;
329 html_body : email_body_part list option;
330 attachments : email_body_part list option;
331 headers : header list option;
332 }
333
334 (** Email body part. See RFC8621 Section 4.1.4. *)
335 and email_body_part = {
336 part_id : string option;
337 blob_id : id option;
338 size : unsigned_int option;
339 headers : header list option;
340 name : string option;
341 type_ : string option;
342 charset : string option;
343 disposition : string option;
344 cid : string option;
345 language : string list option;
346 location : string option;
347 sub_parts : email_body_part list option;
348 header_parameter_name : string option;
349 header_parameter_value : string option;
350 }
351
352 (** Email query filter condition. See RFC8621 Section 4.4. *)
353 type email_filter_condition = {
354 in_mailbox : id option;
355 in_mailbox_other_than : id list option;
356 min_size : unsigned_int option;
357 max_size : unsigned_int option;
358 before : utc_date option;
359 after : utc_date option;
360 header : (string * string) option;
361 from : string option;
362 to_ : string option;
363 cc : string option;
364 bcc : string option;
365 subject : string option;
366 body : string option;
367 has_keyword : string option;
368 not_keyword : string option;
369 has_attachment : bool option;
370 text : string option;
371 }
372
373 type email_query_filter = [
374 | `And of email_query_filter list
375 | `Or of email_query_filter list
376 | `Not of email_query_filter
377 | `Condition of email_filter_condition
378 ]
379
380 (** Email/get request arguments. See RFC8621 Section 4.5. *)
381 type email_get_arguments = {
382 account_id : id;
383 ids : id list option;
384 properties : string list option;
385 body_properties : string list option;
386 fetch_text_body_values : bool option;
387 fetch_html_body_values : bool option;
388 fetch_all_body_values : bool option;
389 max_body_value_bytes : unsigned_int option;
390 }
391
392 (** Email/get response. See RFC8621 Section 4.5. *)
393 type email_get_response = {
394 account_id : id;
395 state : string;
396 list : email list;
397 not_found : id list;
398 }
399
400 (** Email/changes request arguments. See RFC8621 Section 4.6. *)
401 type email_changes_arguments = {
402 account_id : id;
403 since_state : string;
404 max_changes : unsigned_int option;
405 }
406
407 (** Email/changes response. See RFC8621 Section 4.6. *)
408 type email_changes_response = {
409 account_id : id;
410 old_state : string;
411 new_state : string;
412 has_more_changes : bool;
413 created : id list;
414 updated : id list;
415 destroyed : id list;
416 }
417
418 (** Email/query request arguments. See RFC8621 Section 4.4. *)
419 type email_query_arguments = {
420 account_id : id;
421 filter : email_query_filter option;
422 sort : comparator list option;
423 collapse_threads : bool option;
424 position : unsigned_int option;
425 anchor : id option;
426 anchor_offset : int_t option;
427 limit : unsigned_int option;
428 calculate_total : bool option;
429 }
430
431 (** Email/query response. See RFC8621 Section 4.4. *)
432 type email_query_response = {
433 account_id : id;
434 query_state : string;
435 can_calculate_changes : bool;
436 position : unsigned_int;
437 ids : id list;
438 total : unsigned_int option;
439 thread_ids : id list option;
440 }
441
442 (** Email/queryChanges request arguments. See RFC8621 Section 4.7. *)
443 type email_query_changes_arguments = {
444 account_id : id;
445 filter : email_query_filter option;
446 sort : comparator list option;
447 collapse_threads : bool option;
448 since_query_state : string;
449 max_changes : unsigned_int option;
450 up_to_id : id option;
451 }
452
453 (** Email/queryChanges response. See RFC8621 Section 4.7. *)
454 type email_query_changes_response = {
455 account_id : id;
456 old_query_state : string;
457 new_query_state : string;
458 total : unsigned_int option;
459 removed : id list;
460 added : email_query_changes_added list;
461 }
462
463 and email_query_changes_added = {
464 id : id;
465 index : unsigned_int;
466 }
467
468 (** Email/set request arguments. See RFC8621 Section 4.8. *)
469 type email_set_arguments = {
470 account_id : id;
471 if_in_state : string option;
472 create : (id * email_creation) list option;
473 update : (id * email_update) list option;
474 destroy : id list option;
475 }
476
477 and email_creation = {
478 mailbox_ids : (id * bool) list;
479 keywords : (keyword * bool) list option;
480 received_at : utc_date option;
481 message_id : string list option;
482 in_reply_to : string list option;
483 references : string list option;
484 sender : email_address list option;
485 from : email_address list option;
486 to_ : email_address list option;
487 cc : email_address list option;
488 bcc : email_address list option;
489 reply_to : email_address list option;
490 subject : string option;
491 body_values : (string * string) list option;
492 text_body : email_body_part list option;
493 html_body : email_body_part list option;
494 attachments : email_body_part list option;
495 headers : header list option;
496 }
497
498 and email_update = {
499 keywords : (keyword * bool) list option;
500 mailbox_ids : (id * bool) list option;
501 }
502
503 (** Email/set response. See RFC8621 Section 4.8. *)
504 type email_set_response = {
505 account_id : id;
506 old_state : string option;
507 new_state : string;
508 created : (id * email) list option;
509 updated : id list option;
510 destroyed : id list option;
511 not_created : (id * set_error) list option;
512 not_updated : (id * set_error) list option;
513 not_destroyed : (id * set_error) list option;
514 }
515
516 (** Email/copy request arguments. See RFC8621 Section 4.9. *)
517 type email_copy_arguments = {
518 from_account_id : id;
519 account_id : id;
520 create : (id * email_creation) list;
521 on_success_destroy_original : bool option;
522 }
523
524 (** Email/copy response. See RFC8621 Section 4.9. *)
525 type email_copy_response = {
526 from_account_id : id;
527 account_id : id;
528 created : (id * email) list option;
529 not_created : (id * set_error) list option;
530 }
531
532 (** Email/import request arguments. See RFC8621 Section 4.10. *)
533 type email_import_arguments = {
534 account_id : id;
535 emails : (id * email_import) list;
536 }
537
538 and email_import = {
539 blob_id : id;
540 mailbox_ids : (id * bool) list;
541 keywords : (keyword * bool) list option;
542 received_at : utc_date option;
543 }
544
545 (** Email/import response. See RFC8621 Section 4.10. *)
546 type email_import_response = {
547 account_id : id;
548 created : (id * email) list option;
549 not_created : (id * set_error) list option;
550 }
551
552 (** {1:search_snippet Search snippets} *)
553
554 (** SearchSnippet/get request arguments. See RFC8621 Section 4.11. *)
555 type search_snippet_get_arguments = {
556 account_id : id;
557 email_ids : id list;
558 filter : email_filter_condition;
559 }
560
561 (** SearchSnippet/get response. See RFC8621 Section 4.11. *)
562 type search_snippet_get_response = {
563 account_id : id;
564 list : (id * search_snippet) list;
565 not_found : id list;
566 }
567
568 and search_snippet = {
569 subject : string option;
570 preview : string option;
571 }
572
573 (** {1:submission EmailSubmission objects} *)
574
575 (** EmailSubmission address. See RFC8621 Section 5.1. *)
576 type submission_address = {
577 email : string;
578 parameters : (string * string) list option;
579 }
580
581 (** Email submission object. See RFC8621 Section 5.1. *)
582 type email_submission = {
583 id : id;
584 identity_id : id;
585 email_id : id;
586 thread_id : id;
587 envelope : envelope option;
588 send_at : utc_date option;
589 undo_status : [
590 | `pending
591 | `final
592 | `canceled
593 ] option;
594 delivery_status : (string * submission_status) list option;
595 dsn_blob_ids : (string * id) list option;
596 mdn_blob_ids : (string * id) list option;
597 }
598
599 (** Envelope for mail submission. See RFC8621 Section 5.1. *)
600 and envelope = {
601 mail_from : submission_address;
602 rcpt_to : submission_address list;
603 }
604
605 (** Delivery status for submitted email. See RFC8621 Section 5.1. *)
606 and submission_status = {
607 smtp_reply : string;
608 delivered : string option;
609 }
610
611 (** EmailSubmission/get request arguments. See RFC8621 Section 5.3. *)
612 type email_submission_get_arguments = {
613 account_id : id;
614 ids : id list option;
615 properties : string list option;
616 }
617
618 (** EmailSubmission/get response. See RFC8621 Section 5.3. *)
619 type email_submission_get_response = {
620 account_id : id;
621 state : string;
622 list : email_submission list;
623 not_found : id list;
624 }
625
626 (** EmailSubmission/changes request arguments. See RFC8621 Section 5.4. *)
627 type email_submission_changes_arguments = {
628 account_id : id;
629 since_state : string;
630 max_changes : unsigned_int option;
631 }
632
633 (** EmailSubmission/changes response. See RFC8621 Section 5.4. *)
634 type email_submission_changes_response = {
635 account_id : id;
636 old_state : string;
637 new_state : string;
638 has_more_changes : bool;
639 created : id list;
640 updated : id list;
641 destroyed : id list;
642 }
643
644 (** EmailSubmission/query filter condition. See RFC8621 Section 5.5. *)
645 type email_submission_filter_condition = {
646 identity_id : id option;
647 email_id : id option;
648 thread_id : id option;
649 before : utc_date option;
650 after : utc_date option;
651 subject : string option;
652 }
653
654 type email_submission_query_filter = [
655 | `And of email_submission_query_filter list
656 | `Or of email_submission_query_filter list
657 | `Not of email_submission_query_filter
658 | `Condition of email_submission_filter_condition
659 ]
660
661 (** EmailSubmission/query request arguments. See RFC8621 Section 5.5. *)
662 type email_submission_query_arguments = {
663 account_id : id;
664 filter : email_submission_query_filter option;
665 sort : comparator list option;
666 position : unsigned_int option;
667 anchor : id option;
668 anchor_offset : int_t option;
669 limit : unsigned_int option;
670 calculate_total : bool option;
671 }
672
673 (** EmailSubmission/query response. See RFC8621 Section 5.5. *)
674 type email_submission_query_response = {
675 account_id : id;
676 query_state : string;
677 can_calculate_changes : bool;
678 position : unsigned_int;
679 ids : id list;
680 total : unsigned_int option;
681 }
682
683 (** EmailSubmission/set request arguments. See RFC8621 Section 5.6. *)
684 type email_submission_set_arguments = {
685 account_id : id;
686 if_in_state : string option;
687 create : (id * email_submission_creation) list option;
688 update : (id * email_submission_update) list option;
689 destroy : id list option;
690 on_success_update_email : (id * email_update) list option;
691 }
692
693 and email_submission_creation = {
694 email_id : id;
695 identity_id : id;
696 envelope : envelope option;
697 send_at : utc_date option;
698 }
699
700 and email_submission_update = {
701 email_id : id option;
702 identity_id : id option;
703 envelope : envelope option;
704 undo_status : [`canceled] option;
705 }
706
707 (** EmailSubmission/set response. See RFC8621 Section 5.6. *)
708 type email_submission_set_response = {
709 account_id : id;
710 old_state : string option;
711 new_state : string;
712 created : (id * email_submission) list option;
713 updated : id list option;
714 destroyed : id list option;
715 not_created : (id * set_error) list option;
716 not_updated : (id * set_error) list option;
717 not_destroyed : (id * set_error) list option;
718 }
719
720 (** {1:identity Identity objects} *)
721
722 (** Identity for sending mail. See RFC8621 Section 6. *)
723 type identity = {
724 id : id;
725 name : string;
726 email : string;
727 reply_to : email_address list option;
728 bcc : email_address list option;
729 text_signature : string option;
730 html_signature : string option;
731 may_delete : bool;
732 }
733
734 (** Identity/get request arguments. See RFC8621 Section 6.1. *)
735 type identity_get_arguments = {
736 account_id : id;
737 ids : id list option;
738 properties : string list option;
739 }
740
741 (** Identity/get response. See RFC8621 Section 6.1. *)
742 type identity_get_response = {
743 account_id : id;
744 state : string;
745 list : identity list;
746 not_found : id list;
747 }
748
749 (** Identity/changes request arguments. See RFC8621 Section 6.2. *)
750 type identity_changes_arguments = {
751 account_id : id;
752 since_state : string;
753 max_changes : unsigned_int option;
754 }
755
756 (** Identity/changes response. See RFC8621 Section 6.2. *)
757 type identity_changes_response = {
758 account_id : id;
759 old_state : string;
760 new_state : string;
761 has_more_changes : bool;
762 created : id list;
763 updated : id list;
764 destroyed : id list;
765 }
766
767 (** Identity/set request arguments. See RFC8621 Section 6.3. *)
768 type identity_set_arguments = {
769 account_id : id;
770 if_in_state : string option;
771 create : (id * identity_creation) list option;
772 update : (id * identity_update) list option;
773 destroy : id list option;
774 }
775
776 and identity_creation = {
777 name : string;
778 email : string;
779 reply_to : email_address list option;
780 bcc : email_address list option;
781 text_signature : string option;
782 html_signature : string option;
783 }
784
785 and identity_update = {
786 name : string option;
787 email : string option;
788 reply_to : email_address list option;
789 bcc : email_address list option;
790 text_signature : string option;
791 html_signature : string option;
792 }
793
794 (** Identity/set response. See RFC8621 Section 6.3. *)
795 type identity_set_response = {
796 account_id : id;
797 old_state : string option;
798 new_state : string;
799 created : (id * identity) list option;
800 updated : id list option;
801 destroyed : id list option;
802 not_created : (id * set_error) list option;
803 not_updated : (id * set_error) list option;
804 not_destroyed : (id * set_error) list option;
805 }
806
807 (** {1:vacation_response VacationResponse objects} *)
808
809 (** Vacation auto-reply setting. See RFC8621 Section 7. *)
810 type vacation_response = {
811 id : id;
812 is_enabled : bool;
813 from_date : utc_date option;
814 to_date : utc_date option;
815 subject : string option;
816 text_body : string option;
817 html_body : string option;
818 }
819
820 (** VacationResponse/get request arguments. See RFC8621 Section 7.2. *)
821 type vacation_response_get_arguments = {
822 account_id : id;
823 ids : id list option;
824 properties : string list option;
825 }
826
827 (** VacationResponse/get response. See RFC8621 Section 7.2. *)
828 type vacation_response_get_response = {
829 account_id : id;
830 state : string;
831 list : vacation_response list;
832 not_found : id list;
833 }
834
835 (** VacationResponse/set request arguments. See RFC8621 Section 7.3. *)
836 type vacation_response_set_arguments = {
837 account_id : id;
838 if_in_state : string option;
839 update : (id * vacation_response_update) list;
840 }
841
842 and vacation_response_update = {
843 is_enabled : bool option;
844 from_date : utc_date option;
845 to_date : utc_date option;
846 subject : string option;
847 text_body : string option;
848 html_body : string option;
849 }
850
851 (** VacationResponse/set response. See RFC8621 Section 7.3. *)
852 type vacation_response_set_response = {
853 account_id : id;
854 old_state : string option;
855 new_state : string;
856 updated : id list option;
857 not_updated : (id * set_error) list option;
858 }
859
860 (** {1:message_flags Message Flags and Mailbox Attributes} *)
861
862 (** Flag color defined by the combination of MailFlagBit0, MailFlagBit1, and MailFlagBit2 keywords *)
863 type flag_color =
864 | Red (** Bit pattern 000 *)
865 | Orange (** Bit pattern 100 *)
866 | Yellow (** Bit pattern 010 *)
867 | Green (** Bit pattern 111 *)
868 | Blue (** Bit pattern 001 *)
869 | Purple (** Bit pattern 101 *)
870 | Gray (** Bit pattern 011 *)
871
872 (** Standard message keywords as defined in draft-ietf-mailmaint-messageflag-mailboxattribute-02 *)
873 type message_keyword =
874 | Notify (** Indicate a notification should be shown for this message *)
875 | Muted (** User is not interested in future replies to this thread *)
876 | Followed (** User is particularly interested in future replies to this thread *)
877 | Memo (** Message is a note-to-self about another message in the same thread *)
878 | HasMemo (** Message has an associated memo with the $memo keyword *)
879 | HasAttachment (** Message has an attachment *)
880 | HasNoAttachment (** Message does not have an attachment *)
881 | AutoSent (** Message was sent automatically as a response due to a user rule *)
882 | Unsubscribed (** User has unsubscribed from the thread this message is in *)
883 | CanUnsubscribe (** Message has an RFC8058-compliant List-Unsubscribe header *)
884 | Imported (** Message was imported from another mailbox *)
885 | IsTrusted (** Server has verified authenticity of the from name and email *)
886 | MaskedEmail (** Message was received via an alias created for an individual sender *)
887 | New (** Message should be made more prominent due to a recent action *)
888 | MailFlagBit0 (** Bit 0 of the 3-bit flag color pattern *)
889 | MailFlagBit1 (** Bit 1 of the 3-bit flag color pattern *)
890 | MailFlagBit2 (** Bit 2 of the 3-bit flag color pattern *)
891 | OtherKeyword of string (** Other non-standard keywords *)
892
893 (** Special mailbox attribute names as defined in draft-ietf-mailmaint-messageflag-mailboxattribute-02 *)
894 type mailbox_attribute =
895 | Snoozed (** Mailbox containing messages that have been snoozed *)
896 | Scheduled (** Mailbox containing messages scheduled to be sent later *)
897 | Memos (** Mailbox containing messages with the $memo keyword *)
898 | OtherAttribute of string (** Other non-standard mailbox attributes *)
899
900 (** Functions for working with flag colors based on the specification in
901 draft-ietf-mailmaint-messageflag-mailboxattribute-02, section 3.1. *)
902
903 (** Convert bit pattern to flag color *)
904 let flag_color_of_bits bit0 bit1 bit2 =
905 match (bit0, bit1, bit2) with
906 | (false, false, false) -> Red (* 000 *)
907 | (true, false, false) -> Orange (* 100 *)
908 | (false, true, false) -> Yellow (* 010 *)
909 | (true, true, true) -> Green (* 111 *)
910 | (false, false, true) -> Blue (* 001 *)
911 | (true, false, true) -> Purple (* 101 *)
912 | (false, true, true) -> Gray (* 011 *)
913 | (true, true, false) -> Green (* 110 - not in spec, defaulting to green *)
914
915 (** Get bits for a flag color *)
916 let bits_of_flag_color = function
917 | Red -> (false, false, false)
918 | Orange -> (true, false, false)
919 | Yellow -> (false, true, false)
920 | Green -> (true, true, true)
921 | Blue -> (false, false, true)
922 | Purple -> (true, false, true)
923 | Gray -> (false, true, true)
924
925 (** Check if a keyword list contains a flag color *)
926 let has_flag_color keywords =
927 let has_bit0 = List.exists (function
928 | (Custom s, true) when s = "$MailFlagBit0" -> true
929 | _ -> false
930 ) keywords in
931
932 let has_bit1 = List.exists (function
933 | (Custom s, true) when s = "$MailFlagBit1" -> true
934 | _ -> false
935 ) keywords in
936
937 let has_bit2 = List.exists (function
938 | (Custom s, true) when s = "$MailFlagBit2" -> true
939 | _ -> false
940 ) keywords in
941
942 has_bit0 || has_bit1 || has_bit2
943
944 (** Extract flag color from keywords if present *)
945 let get_flag_color keywords =
946 (* First check if the message has the \Flagged system flag *)
947 let is_flagged = List.exists (function
948 | (Flagged, true) -> true
949 | _ -> false
950 ) keywords in
951
952 if not is_flagged then
953 None
954 else
955 (* Get values of each bit flag *)
956 let bit0 = List.exists (function
957 | (Custom s, true) when s = "$MailFlagBit0" -> true
958 | _ -> false
959 ) keywords in
960
961 let bit1 = List.exists (function
962 | (Custom s, true) when s = "$MailFlagBit1" -> true
963 | _ -> false
964 ) keywords in
965
966 let bit2 = List.exists (function
967 | (Custom s, true) when s = "$MailFlagBit2" -> true
968 | _ -> false
969 ) keywords in
970
971 Some (flag_color_of_bits bit0 bit1 bit2)
972
973 (** Convert a message keyword to its string representation *)
974 let string_of_message_keyword = function
975 | Notify -> "$notify"
976 | Muted -> "$muted"
977 | Followed -> "$followed"
978 | Memo -> "$memo"
979 | HasMemo -> "$hasmemo"
980 | HasAttachment -> "$hasattachment"
981 | HasNoAttachment -> "$hasnoattachment"
982 | AutoSent -> "$autosent"
983 | Unsubscribed -> "$unsubscribed"
984 | CanUnsubscribe -> "$canunsubscribe"
985 | Imported -> "$imported"
986 | IsTrusted -> "$istrusted"
987 | MaskedEmail -> "$maskedemail"
988 | New -> "$new"
989 | MailFlagBit0 -> "$MailFlagBit0"
990 | MailFlagBit1 -> "$MailFlagBit1"
991 | MailFlagBit2 -> "$MailFlagBit2"
992 | OtherKeyword s -> s
993
994 (** Parse a string into a message keyword *)
995 let message_keyword_of_string = function
996 | "$notify" -> Notify
997 | "$muted" -> Muted
998 | "$followed" -> Followed
999 | "$memo" -> Memo
1000 | "$hasmemo" -> HasMemo
1001 | "$hasattachment" -> HasAttachment
1002 | "$hasnoattachment" -> HasNoAttachment
1003 | "$autosent" -> AutoSent
1004 | "$unsubscribed" -> Unsubscribed
1005 | "$canunsubscribe" -> CanUnsubscribe
1006 | "$imported" -> Imported
1007 | "$istrusted" -> IsTrusted
1008 | "$maskedemail" -> MaskedEmail
1009 | "$new" -> New
1010 | "$MailFlagBit0" -> MailFlagBit0
1011 | "$MailFlagBit1" -> MailFlagBit1
1012 | "$MailFlagBit2" -> MailFlagBit2
1013 | s -> OtherKeyword s
1014
1015 (** Convert a mailbox attribute to its string representation *)
1016 let string_of_mailbox_attribute = function
1017 | Snoozed -> "Snoozed"
1018 | Scheduled -> "Scheduled"
1019 | Memos -> "Memos"
1020 | OtherAttribute s -> s
1021
1022 (** Parse a string into a mailbox attribute *)
1023 let mailbox_attribute_of_string = function
1024 | "Snoozed" -> Snoozed
1025 | "Scheduled" -> Scheduled
1026 | "Memos" -> Memos
1027 | s -> OtherAttribute s
1028end
1029
1030(** {1 JSON serialization} *)
1031
1032module Json = struct
1033 open Types
1034
1035 (** {2 Helper functions for serialization} *)
1036
1037 let string_of_mailbox_role = function
1038 | All -> "all"
1039 | Archive -> "archive"
1040 | Drafts -> "drafts"
1041 | Flagged -> "flagged"
1042 | Important -> "important"
1043 | Inbox -> "inbox"
1044 | Junk -> "junk"
1045 | Sent -> "sent"
1046 | Trash -> "trash"
1047 | Unknown s -> s
1048
1049 let mailbox_role_of_string = function
1050 | "all" -> All
1051 | "archive" -> Archive
1052 | "drafts" -> Drafts
1053 | "flagged" -> Flagged
1054 | "important" -> Important
1055 | "inbox" -> Inbox
1056 | "junk" -> Junk
1057 | "sent" -> Sent
1058 | "trash" -> Trash
1059 | s -> Unknown s
1060
1061 let string_of_keyword = function
1062 | Flagged -> "$flagged"
1063 | Answered -> "$answered"
1064 | Draft -> "$draft"
1065 | Forwarded -> "$forwarded"
1066 | Phishing -> "$phishing"
1067 | Junk -> "$junk"
1068 | NotJunk -> "$notjunk"
1069 | Seen -> "$seen"
1070 | Unread -> "$unread"
1071 | Custom s -> s
1072
1073 let keyword_of_string = function
1074 | "$flagged" -> Flagged
1075 | "$answered" -> Answered
1076 | "$draft" -> Draft
1077 | "$forwarded" -> Forwarded
1078 | "$phishing" -> Phishing
1079 | "$junk" -> Junk
1080 | "$notjunk" -> NotJunk
1081 | "$seen" -> Seen
1082 | "$unread" -> Unread
1083 | s -> Custom s
1084
1085 (** {2 Mailbox serialization} *)
1086
1087 (** TODO:claude - Need to implement all JSON serialization functions
1088 for each type we've defined. This would be a substantial amount of
1089 code and likely require additional understanding of the ezjsonm API.
1090
1091 For a full implementation, we would need functions to convert between
1092 OCaml types and JSON for each of:
1093 - mailbox, mailbox_rights, mailbox query/update operations
1094 - thread operations
1095 - email, email_address, header, email_body_part
1096 - email query/update operations
1097 - submission operations
1098 - identity operations
1099 - vacation response operations
1100 *)
1101end
1102
1103(** {1 API functions} *)
1104
1105open Lwt.Syntax
1106open Jmap.Api
1107open Jmap.Types
1108
1109(** Authentication credentials for a JMAP server *)
1110type credentials = {
1111 username: string;
1112 password: string;
1113}
1114
1115(** Connection to a JMAP mail server *)
1116type connection = {
1117 session: Jmap.Types.session;
1118 config: Jmap.Api.config;
1119}
1120
1121(** Convert JSON mail object to OCaml type *)
1122let mailbox_of_json json =
1123 try
1124 let open Ezjsonm in
1125 Printf.printf "Parsing mailbox JSON\n";
1126
1127 let id = get_string (find json ["id"]) in
1128 Printf.printf "Got id: %s\n" id;
1129
1130 let name = get_string (find json ["name"]) in
1131 Printf.printf "Got name: %s\n" name;
1132
1133 (* Handle parentId which can be null *)
1134 let parent_id =
1135 match find_opt json ["parentId"] with
1136 | Some (`Null) -> None
1137 | Some (`String s) -> Some s
1138 | None -> None
1139 | _ -> None
1140 in
1141 Printf.printf "Got parent_id: %s\n" (match parent_id with Some p -> p | None -> "None");
1142
1143 (* Handle role which might be null *)
1144 let role =
1145 match find_opt json ["role"] with
1146 | Some (`Null) -> None
1147 | Some (`String s) -> Some (Json.mailbox_role_of_string s)
1148 | None -> None
1149 | _ -> None
1150 in
1151 Printf.printf "Got role\n";
1152
1153 let sort_order = get_int (find json ["sortOrder"]) in
1154 Printf.printf "Got sort_order: %d\n" sort_order;
1155
1156 let total_emails = get_int (find json ["totalEmails"]) in
1157 Printf.printf "Got total_emails: %d\n" total_emails;
1158
1159 let unread_emails = get_int (find json ["unreadEmails"]) in
1160 Printf.printf "Got unread_emails: %d\n" unread_emails;
1161
1162 let total_threads = get_int (find json ["totalThreads"]) in
1163 Printf.printf "Got total_threads: %d\n" total_threads;
1164
1165 let unread_threads = get_int (find json ["unreadThreads"]) in
1166 Printf.printf "Got unread_threads: %d\n" unread_threads;
1167
1168 let is_subscribed = get_bool (find json ["isSubscribed"]) in
1169 Printf.printf "Got is_subscribed: %b\n" is_subscribed;
1170
1171 let rights_json = find json ["myRights"] in
1172 Printf.printf "Got rights_json\n";
1173
1174 let my_rights = {
1175 Types.may_read_items = get_bool (find rights_json ["mayReadItems"]);
1176 may_add_items = get_bool (find rights_json ["mayAddItems"]);
1177 may_remove_items = get_bool (find rights_json ["mayRemoveItems"]);
1178 may_set_seen = get_bool (find rights_json ["maySetSeen"]);
1179 may_set_keywords = get_bool (find rights_json ["maySetKeywords"]);
1180 may_create_child = get_bool (find rights_json ["mayCreateChild"]);
1181 may_rename = get_bool (find rights_json ["mayRename"]);
1182 may_delete = get_bool (find rights_json ["mayDelete"]);
1183 may_submit = get_bool (find rights_json ["maySubmit"]);
1184 } in
1185 Printf.printf "Constructed my_rights\n";
1186
1187 let result = {
1188 Types.id;
1189 name;
1190 parent_id;
1191 role;
1192 sort_order;
1193 total_emails;
1194 unread_emails;
1195 total_threads;
1196 unread_threads;
1197 is_subscribed;
1198 my_rights;
1199 } in
1200 Printf.printf "Constructed mailbox result\n";
1201
1202 Ok (result)
1203 with
1204 | Not_found as e ->
1205 Printf.printf "Not_found error: %s\n" (Printexc.to_string e);
1206 Printexc.print_backtrace stdout;
1207 Error (Parse_error "Required field not found in mailbox object")
1208 | Invalid_argument msg ->
1209 Printf.printf "Invalid_argument error: %s\n" msg;
1210 Error (Parse_error msg)
1211 | e ->
1212 Printf.printf "Unknown error: %s\n" (Printexc.to_string e);
1213 Error (Parse_error (Printexc.to_string e))
1214
1215(** Convert JSON email object to OCaml type *)
1216let email_of_json json =
1217 try
1218 let open Ezjsonm in
1219 Printf.printf "Parsing email JSON\n";
1220
1221 let id = get_string (find json ["id"]) in
1222 Printf.printf "Got email id: %s\n" id;
1223
1224 let blob_id = get_string (find json ["blobId"]) in
1225 let thread_id = get_string (find json ["threadId"]) in
1226
1227 (* Process mailboxIds map *)
1228 let mailbox_ids_json = find json ["mailboxIds"] in
1229 let mailbox_ids = match mailbox_ids_json with
1230 | `O items -> List.map (fun (id, v) -> (id, get_bool v)) items
1231 | _ -> raise (Invalid_argument "mailboxIds is not an object")
1232 in
1233
1234 (* Process keywords map *)
1235 let keywords_json = find json ["keywords"] in
1236 let keywords = match keywords_json with
1237 | `O items -> List.map (fun (k, v) ->
1238 (Json.keyword_of_string k, get_bool v)) items
1239 | _ -> raise (Invalid_argument "keywords is not an object")
1240 in
1241
1242 let size = get_int (find json ["size"]) in
1243 let received_at = get_string (find json ["receivedAt"]) in
1244
1245 (* Handle messageId which might be an array or missing *)
1246 let message_id =
1247 match find_opt json ["messageId"] with
1248 | Some (`A ids) -> List.map (fun id ->
1249 match id with
1250 | `String s -> s
1251 | _ -> raise (Invalid_argument "messageId item is not a string")
1252 ) ids
1253 | Some (`String s) -> [s] (* Handle single string case *)
1254 | None -> [] (* Handle missing case *)
1255 | _ -> raise (Invalid_argument "messageId has unexpected type")
1256 in
1257
1258 (* Parse optional fields *)
1259 let parse_email_addresses opt_json =
1260 match opt_json with
1261 | Some (`A items) ->
1262 Some (List.map (fun addr_json ->
1263 let name =
1264 match find_opt addr_json ["name"] with
1265 | Some (`String s) -> Some s
1266 | Some (`Null) -> None
1267 | None -> None
1268 | _ -> None
1269 in
1270 let email = get_string (find addr_json ["email"]) in
1271 let parameters =
1272 match find_opt addr_json ["parameters"] with
1273 | Some (`O items) -> List.map (fun (k, v) ->
1274 match v with
1275 | `String s -> (k, s)
1276 | _ -> (k, "")
1277 ) items
1278 | _ -> []
1279 in
1280 { Types.name; email; parameters }
1281 ) items)
1282 | _ -> None
1283 in
1284
1285 (* Handle optional string arrays with null handling *)
1286 let parse_string_array_opt field_name =
1287 match find_opt json [field_name] with
1288 | Some (`A ids) ->
1289 Some (List.filter_map (function
1290 | `String s -> Some s
1291 | _ -> None
1292 ) ids)
1293 | Some (`Null) -> None
1294 | None -> None
1295 | _ -> None
1296 in
1297
1298 let in_reply_to = parse_string_array_opt "inReplyTo" in
1299 let references = parse_string_array_opt "references" in
1300
1301 let sender = parse_email_addresses (find_opt json ["sender"]) in
1302 let from = parse_email_addresses (find_opt json ["from"]) in
1303 let to_ = parse_email_addresses (find_opt json ["to"]) in
1304 let cc = parse_email_addresses (find_opt json ["cc"]) in
1305 let bcc = parse_email_addresses (find_opt json ["bcc"]) in
1306 let reply_to = parse_email_addresses (find_opt json ["replyTo"]) in
1307
1308 (* Handle optional string fields with null handling *)
1309 let parse_string_opt field_name =
1310 match find_opt json [field_name] with
1311 | Some (`String s) -> Some s
1312 | Some (`Null) -> None
1313 | None -> None
1314 | _ -> None
1315 in
1316
1317 let subject = parse_string_opt "subject" in
1318 let sent_at = parse_string_opt "sentAt" in
1319
1320 (* Handle optional boolean fields with null handling *)
1321 let parse_bool_opt field_name =
1322 match find_opt json [field_name] with
1323 | Some (`Bool b) -> Some b
1324 | Some (`Null) -> None
1325 | None -> None
1326 | _ -> None
1327 in
1328
1329 let has_attachment = parse_bool_opt "hasAttachment" in
1330 let preview = parse_string_opt "preview" in
1331
1332 (* Body parts parsing would go here - omitting for brevity *)
1333 Printf.printf "Email parsed successfully\n";
1334
1335 Ok ({
1336 Types.id;
1337 blob_id;
1338 thread_id;
1339 mailbox_ids;
1340 keywords;
1341 size;
1342 received_at;
1343 message_id;
1344 in_reply_to;
1345 references;
1346 sender;
1347 from;
1348 to_;
1349 cc;
1350 bcc;
1351 reply_to;
1352 subject;
1353 sent_at;
1354 has_attachment;
1355 preview;
1356 body_values = None;
1357 text_body = None;
1358 html_body = None;
1359 attachments = None;
1360 headers = None;
1361 })
1362 with
1363 | Not_found as e ->
1364 Printf.printf "Email parse error - Not_found: %s\n" (Printexc.to_string e);
1365 Printexc.print_backtrace stdout;
1366 Error (Parse_error "Required field not found in email object")
1367 | Invalid_argument msg ->
1368 Printf.printf "Email parse error - Invalid_argument: %s\n" msg;
1369 Error (Parse_error msg)
1370 | e ->
1371 Printf.printf "Email parse error - Unknown: %s\n" (Printexc.to_string e);
1372 Error (Parse_error (Printexc.to_string e))
1373
1374(** Login to a JMAP server and establish a connection
1375 @param uri The URI of the JMAP server
1376 @param credentials Authentication credentials
1377 @return A connection object if successful
1378
1379 TODO:claude *)
1380let login ~uri ~credentials =
1381 let* session_result = get_session (Uri.of_string uri)
1382 ~username:credentials.username
1383 ~authentication_token:credentials.password
1384 () in
1385 match session_result with
1386 | Ok session ->
1387 let api_uri = Uri.of_string session.api_url in
1388 let config = {
1389 api_uri;
1390 username = credentials.username;
1391 authentication_token = credentials.password;
1392 } in
1393 Lwt.return (Ok { session; config })
1394 | Error e -> Lwt.return (Error e)
1395
1396(** Login to a JMAP server using an API token
1397 @param uri The URI of the JMAP server
1398 @param api_token The API token for authentication
1399 @return A connection object if successful
1400
1401 TODO:claude *)
1402let login_with_token ~uri ~api_token =
1403 let* session_result = get_session (Uri.of_string uri)
1404 ~api_token
1405 () in
1406 match session_result with
1407 | Ok session ->
1408 let api_uri = Uri.of_string session.api_url in
1409 let config = {
1410 api_uri;
1411 username = ""; (* Empty username indicates we're using token auth *)
1412 authentication_token = api_token;
1413 } in
1414 Lwt.return (Ok { session; config })
1415 | Error e -> Lwt.return (Error e)
1416
1417(** Get all mailboxes for an account
1418 @param conn The JMAP connection
1419 @param account_id The account ID to get mailboxes for
1420 @return A list of mailboxes if successful
1421
1422 TODO:claude *)
1423let get_mailboxes conn ~account_id =
1424 let request = {
1425 using = [
1426 Jmap.Capability.to_string Jmap.Capability.Core;
1427 Capability.to_string Capability.Mail
1428 ];
1429 method_calls = [
1430 {
1431 name = "Mailbox/get";
1432 arguments = `O [
1433 ("accountId", `String account_id);
1434 ];
1435 method_call_id = "m1";
1436 }
1437 ];
1438 created_ids = None;
1439 } in
1440
1441 let* response_result = make_request conn.config request in
1442 match response_result with
1443 | Ok response ->
1444 let result =
1445 try
1446 let method_response = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) ->
1447 inv.name = "Mailbox/get") response.method_responses in
1448 let args = method_response.arguments in
1449 match Ezjsonm.find_opt args ["list"] with
1450 | Some (`A mailbox_list) ->
1451 let parse_results = List.map mailbox_of_json mailbox_list in
1452 let (successes, failures) = List.partition Result.is_ok parse_results in
1453 if List.length failures > 0 then
1454 Error (Parse_error "Failed to parse some mailboxes")
1455 else
1456 Ok (List.map Result.get_ok successes)
1457 | _ -> Error (Parse_error "Mailbox list not found in response")
1458 with
1459 | Not_found -> Error (Parse_error "Mailbox/get method response not found")
1460 | e -> Error (Parse_error (Printexc.to_string e))
1461 in
1462 Lwt.return result
1463 | Error e -> Lwt.return (Error e)
1464
1465(** Get a specific mailbox by ID
1466 @param conn The JMAP connection
1467 @param account_id The account ID
1468 @param mailbox_id The mailbox ID to retrieve
1469 @return The mailbox if found
1470
1471 TODO:claude *)
1472let get_mailbox conn ~account_id ~mailbox_id =
1473 let request = {
1474 using = [
1475 Jmap.Capability.to_string Jmap.Capability.Core;
1476 Capability.to_string Capability.Mail
1477 ];
1478 method_calls = [
1479 {
1480 name = "Mailbox/get";
1481 arguments = `O [
1482 ("accountId", `String account_id);
1483 ("ids", `A [`String mailbox_id]);
1484 ];
1485 method_call_id = "m1";
1486 }
1487 ];
1488 created_ids = None;
1489 } in
1490
1491 let* response_result = make_request conn.config request in
1492 match response_result with
1493 | Ok response ->
1494 let result =
1495 try
1496 let method_response = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) ->
1497 inv.name = "Mailbox/get") response.method_responses in
1498 let args = method_response.arguments in
1499 match Ezjsonm.find_opt args ["list"] with
1500 | Some (`A [mailbox]) -> mailbox_of_json mailbox
1501 | Some (`A []) -> Error (Parse_error ("Mailbox not found: " ^ mailbox_id))
1502 | _ -> Error (Parse_error "Expected single mailbox in response")
1503 with
1504 | Not_found -> Error (Parse_error "Mailbox/get method response not found")
1505 | e -> Error (Parse_error (Printexc.to_string e))
1506 in
1507 Lwt.return result
1508 | Error e -> Lwt.return (Error e)
1509
1510(** Get messages in a mailbox
1511 @param conn The JMAP connection
1512 @param account_id The account ID
1513 @param mailbox_id The mailbox ID to get messages from
1514 @param limit Optional limit on number of messages to return
1515 @return The list of email messages if successful
1516
1517 TODO:claude *)
1518let get_messages_in_mailbox conn ~account_id ~mailbox_id ?limit () =
1519 (* First query the emails in the mailbox *)
1520 let query_request = {
1521 using = [
1522 Jmap.Capability.to_string Jmap.Capability.Core;
1523 Capability.to_string Capability.Mail
1524 ];
1525 method_calls = [
1526 {
1527 name = "Email/query";
1528 arguments = `O ([
1529 ("accountId", `String account_id);
1530 ("filter", `O [("inMailbox", `String mailbox_id)]);
1531 ("sort", `A [`O [("property", `String "receivedAt"); ("isAscending", `Bool false)]]);
1532 ] @ (match limit with
1533 | Some l -> [("limit", `Float (float_of_int l))]
1534 | None -> []
1535 ));
1536 method_call_id = "q1";
1537 }
1538 ];
1539 created_ids = None;
1540 } in
1541
1542 let* query_result = make_request conn.config query_request in
1543 match query_result with
1544 | Ok query_response ->
1545 (try
1546 let query_method = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) ->
1547 inv.name = "Email/query") query_response.method_responses in
1548 let args = query_method.arguments in
1549 match Ezjsonm.find_opt args ["ids"] with
1550 | Some (`A ids) ->
1551 let email_ids = List.map (function
1552 | `String id -> id
1553 | _ -> raise (Invalid_argument "Email ID is not a string")
1554 ) ids in
1555
1556 (* If we have IDs, fetch the actual email objects *)
1557 if List.length email_ids > 0 then
1558 let get_request = {
1559 using = [
1560 Jmap.Capability.to_string Jmap.Capability.Core;
1561 Capability.to_string Capability.Mail
1562 ];
1563 method_calls = [
1564 {
1565 name = "Email/get";
1566 arguments = `O [
1567 ("accountId", `String account_id);
1568 ("ids", `A (List.map (fun id -> `String id) email_ids));
1569 ];
1570 method_call_id = "g1";
1571 }
1572 ];
1573 created_ids = None;
1574 } in
1575
1576 let* get_result = make_request conn.config get_request in
1577 match get_result with
1578 | Ok get_response ->
1579 (try
1580 let get_method = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) ->
1581 inv.name = "Email/get") get_response.method_responses in
1582 let args = get_method.arguments in
1583 match Ezjsonm.find_opt args ["list"] with
1584 | Some (`A email_list) ->
1585 let parse_results = List.map email_of_json email_list in
1586 let (successes, failures) = List.partition Result.is_ok parse_results in
1587 if List.length failures > 0 then
1588 Lwt.return (Error (Parse_error "Failed to parse some emails"))
1589 else
1590 Lwt.return (Ok (List.map Result.get_ok successes))
1591 | _ -> Lwt.return (Error (Parse_error "Email list not found in response"))
1592 with
1593 | Not_found -> Lwt.return (Error (Parse_error "Email/get method response not found"))
1594 | e -> Lwt.return (Error (Parse_error (Printexc.to_string e))))
1595 | Error e -> Lwt.return (Error e)
1596 else
1597 (* No emails in mailbox *)
1598 Lwt.return (Ok [])
1599
1600 | _ -> Lwt.return (Error (Parse_error "Email IDs not found in query response"))
1601 with
1602 | Not_found -> Lwt.return (Error (Parse_error "Email/query method response not found"))
1603 | Invalid_argument msg -> Lwt.return (Error (Parse_error msg))
1604 | e -> Lwt.return (Error (Parse_error (Printexc.to_string e))))
1605 | Error e -> Lwt.return (Error e)
1606
1607(** Get a single email message by ID
1608 @param conn The JMAP connection
1609 @param account_id The account ID
1610 @param email_id The email ID to retrieve
1611 @return The email message if found
1612
1613 TODO:claude *)
1614let get_email conn ~account_id ~email_id =
1615 let request = {
1616 using = [
1617 Jmap.Capability.to_string Jmap.Capability.Core;
1618 Capability.to_string Capability.Mail
1619 ];
1620 method_calls = [
1621 {
1622 name = "Email/get";
1623 arguments = `O [
1624 ("accountId", `String account_id);
1625 ("ids", `A [`String email_id]);
1626 ];
1627 method_call_id = "m1";
1628 }
1629 ];
1630 created_ids = None;
1631 } in
1632
1633 let* response_result = make_request conn.config request in
1634 match response_result with
1635 | Ok response ->
1636 let result =
1637 try
1638 let method_response = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) ->
1639 inv.name = "Email/get") response.method_responses in
1640 let args = method_response.arguments in
1641 match Ezjsonm.find_opt args ["list"] with
1642 | Some (`A [email]) -> email_of_json email
1643 | Some (`A []) -> Error (Parse_error ("Email not found: " ^ email_id))
1644 | _ -> Error (Parse_error "Expected single email in response")
1645 with
1646 | Not_found -> Error (Parse_error "Email/get method response not found")
1647 | e -> Error (Parse_error (Printexc.to_string e))
1648 in
1649 Lwt.return result
1650 | Error e -> Lwt.return (Error e)
1651
1652(** Helper functions for working with message flags and mailbox attributes *)
1653
1654(** Check if an email has a specific message keyword
1655 @param email The email to check
1656 @param keyword The message keyword to look for
1657 @return true if the email has the keyword, false otherwise
1658
1659 TODO:claude *)
1660let has_message_keyword (email:Types.email) keyword =
1661 let open Types in
1662 let keyword_string = string_of_message_keyword keyword in
1663 List.exists (function
1664 | (Custom s, true) when s = keyword_string -> true
1665 | _ -> false
1666 ) email.keywords
1667
1668(** Add a message keyword to an email
1669 @param conn The JMAP connection
1670 @param account_id The account ID
1671 @param email_id The email ID
1672 @param keyword The message keyword to add
1673 @return Success or error
1674
1675 TODO:claude *)
1676let add_message_keyword conn ~account_id ~email_id ~keyword =
1677 let keyword_string = Types.string_of_message_keyword keyword in
1678
1679 let request = {
1680 using = [
1681 Jmap.Capability.to_string Jmap.Capability.Core;
1682 Capability.to_string Capability.Mail
1683 ];
1684 method_calls = [
1685 {
1686 name = "Email/set";
1687 arguments = `O [
1688 ("accountId", `String account_id);
1689 ("update", `O [
1690 (email_id, `O [
1691 ("keywords", `O [
1692 (keyword_string, `Bool true)
1693 ])
1694 ])
1695 ]);
1696 ];
1697 method_call_id = "m1";
1698 }
1699 ];
1700 created_ids = None;
1701 } in
1702
1703 let* response_result = make_request conn.config request in
1704 match response_result with
1705 | Ok response ->
1706 let result =
1707 try
1708 let method_response = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) ->
1709 inv.name = "Email/set") response.method_responses in
1710 let args = method_response.arguments in
1711 match Ezjsonm.find_opt args ["updated"] with
1712 | Some (`A _ids) -> Ok ()
1713 | _ ->
1714 match Ezjsonm.find_opt args ["notUpdated"] with
1715 | Some (`O _errors) ->
1716 Error (Parse_error ("Failed to update email: " ^ email_id))
1717 | _ -> Error (Parse_error "Unexpected response format")
1718 with
1719 | Not_found -> Error (Parse_error "Email/set method response not found")
1720 | e -> Error (Parse_error (Printexc.to_string e))
1721 in
1722 Lwt.return result
1723 | Error e -> Lwt.return (Error e)
1724
1725(** Set a flag color for an email
1726 @param conn The JMAP connection
1727 @param account_id The account ID
1728 @param email_id The email ID
1729 @param color The flag color to set
1730 @return Success or error
1731
1732 TODO:claude *)
1733let set_flag_color conn ~account_id ~email_id ~color =
1734 (* Get the bit pattern for the color *)
1735 let (bit0, bit1, bit2) = Types.bits_of_flag_color color in
1736
1737 (* Build the keywords update object *)
1738 let keywords = [
1739 ("$flagged", `Bool true);
1740 ("$MailFlagBit0", `Bool bit0);
1741 ("$MailFlagBit1", `Bool bit1);
1742 ("$MailFlagBit2", `Bool bit2);
1743 ] in
1744
1745 let request = {
1746 using = [
1747 Jmap.Capability.to_string Jmap.Capability.Core;
1748 Capability.to_string Capability.Mail
1749 ];
1750 method_calls = [
1751 {
1752 name = "Email/set";
1753 arguments = `O [
1754 ("accountId", `String account_id);
1755 ("update", `O [
1756 (email_id, `O [
1757 ("keywords", `O keywords)
1758 ])
1759 ]);
1760 ];
1761 method_call_id = "m1";
1762 }
1763 ];
1764 created_ids = None;
1765 } in
1766
1767 let* response_result = make_request conn.config request in
1768 match response_result with
1769 | Ok response ->
1770 let result =
1771 try
1772 let method_response = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) ->
1773 inv.name = "Email/set") response.method_responses in
1774 let args = method_response.arguments in
1775 match Ezjsonm.find_opt args ["updated"] with
1776 | Some (`A _ids) -> Ok ()
1777 | _ ->
1778 match Ezjsonm.find_opt args ["notUpdated"] with
1779 | Some (`O _errors) ->
1780 Error (Parse_error ("Failed to update email: " ^ email_id))
1781 | _ -> Error (Parse_error "Unexpected response format")
1782 with
1783 | Not_found -> Error (Parse_error "Email/set method response not found")
1784 | e -> Error (Parse_error (Printexc.to_string e))
1785 in
1786 Lwt.return result
1787 | Error e -> Lwt.return (Error e)
1788
1789(** Convert an email's keywords to typed message_keyword list
1790 @param email The email to analyze
1791 @return List of message keywords
1792
1793 TODO:claude *)
1794let get_message_keywords (email:Types.email) =
1795 let open Types in
1796 List.filter_map (function
1797 | (Custom s, true) -> Some (message_keyword_of_string s)
1798 | _ -> None
1799 ) email.keywords
1800
1801(** Get emails with a specific message keyword
1802 @param conn The JMAP connection
1803 @param account_id The account ID
1804 @param keyword The message keyword to search for
1805 @param limit Optional limit on number of emails to return
1806 @return List of emails with the keyword if successful
1807
1808 TODO:claude *)
1809let get_emails_with_keyword conn ~account_id ~keyword ?limit () =
1810 let keyword_string = Types.string_of_message_keyword keyword in
1811
1812 (* Query for emails with the specified keyword *)
1813 let query_request = {
1814 using = [
1815 Jmap.Capability.to_string Jmap.Capability.Core;
1816 Capability.to_string Capability.Mail
1817 ];
1818 method_calls = [
1819 {
1820 name = "Email/query";
1821 arguments = `O ([
1822 ("accountId", `String account_id);
1823 ("filter", `O [("hasKeyword", `String keyword_string)]);
1824 ("sort", `A [`O [("property", `String "receivedAt"); ("isAscending", `Bool false)]]);
1825 ] @ (match limit with
1826 | Some l -> [("limit", `Float (float_of_int l))]
1827 | None -> []
1828 ));
1829 method_call_id = "q1";
1830 }
1831 ];
1832 created_ids = None;
1833 } in
1834
1835 let* query_result = make_request conn.config query_request in
1836 match query_result with
1837 | Ok query_response ->
1838 (try
1839 let query_method = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) ->
1840 inv.name = "Email/query") query_response.method_responses in
1841 let args = query_method.arguments in
1842 match Ezjsonm.find_opt args ["ids"] with
1843 | Some (`A ids) ->
1844 let email_ids = List.map (function
1845 | `String id -> id
1846 | _ -> raise (Invalid_argument "Email ID is not a string")
1847 ) ids in
1848
1849 (* If we have IDs, fetch the actual email objects *)
1850 if List.length email_ids > 0 then
1851 let get_request = {
1852 using = [
1853 Jmap.Capability.to_string Jmap.Capability.Core;
1854 Capability.to_string Capability.Mail
1855 ];
1856 method_calls = [
1857 {
1858 name = "Email/get";
1859 arguments = `O [
1860 ("accountId", `String account_id);
1861 ("ids", `A (List.map (fun id -> `String id) email_ids));
1862 ];
1863 method_call_id = "g1";
1864 }
1865 ];
1866 created_ids = None;
1867 } in
1868
1869 let* get_result = make_request conn.config get_request in
1870 match get_result with
1871 | Ok get_response ->
1872 (try
1873 let get_method = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) ->
1874 inv.name = "Email/get") get_response.method_responses in
1875 let args = get_method.arguments in
1876 match Ezjsonm.find_opt args ["list"] with
1877 | Some (`A email_list) ->
1878 let parse_results = List.map email_of_json email_list in
1879 let (successes, failures) = List.partition Result.is_ok parse_results in
1880 if List.length failures > 0 then
1881 Lwt.return (Error (Parse_error "Failed to parse some emails"))
1882 else
1883 Lwt.return (Ok (List.map Result.get_ok successes))
1884 | _ -> Lwt.return (Error (Parse_error "Email list not found in response"))
1885 with
1886 | Not_found -> Lwt.return (Error (Parse_error "Email/get method response not found"))
1887 | e -> Lwt.return (Error (Parse_error (Printexc.to_string e))))
1888 | Error e -> Lwt.return (Error e)
1889 else
1890 (* No emails with the keyword *)
1891 Lwt.return (Ok [])
1892
1893 | _ -> Lwt.return (Error (Parse_error "Email IDs not found in query response"))
1894 with
1895 | Not_found -> Lwt.return (Error (Parse_error "Email/query method response not found"))
1896 | Invalid_argument msg -> Lwt.return (Error (Parse_error msg))
1897 | e -> Lwt.return (Error (Parse_error (Printexc.to_string e))))
1898 | Error e -> Lwt.return (Error e)