My agentic slop goes here. Not intended for anyone else!
anil.recoil.org
1(** JMAP Mailbox Implementation.
2
3 This module implements the JMAP Mailbox data type with all its operations
4 including role and property conversions, mailbox creation and manipulation,
5 and filter construction helpers for common queries.
6
7 @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-2> RFC 8621, Section 2: Mailboxes
8*)
9
10[@@@warning "-32"] (* Suppress unused value warnings for interface-required functions *)
11
12open Jmap.Method_names
13open Jmap.Methods
14
15(* Forward declaration of types *)
16type role =
17 | Inbox
18 | Archive
19 | Drafts
20 | Sent
21 | Trash
22 | Junk
23 | Important
24 | Snoozed
25 | Scheduled
26 | Memos
27 | Other of string
28 | NoRole
29
30type rights = {
31 may_read_items : bool;
32 may_add_items : bool;
33 may_remove_items : bool;
34 may_set_seen : bool;
35 may_set_keywords : bool;
36 may_create_child : bool;
37 may_rename : bool;
38 may_delete : bool;
39 may_submit : bool;
40}
41
42(** Shared mailbox permissions for specific accounts *)
43type sharing_rights = {
44 may_read : bool; (** Permission to read shared mailbox contents *)
45 may_write : bool; (** Permission to add/modify/remove messages *)
46 may_admin : bool; (** Administrative permissions (share, rename, delete) *)
47}
48
49(** JSON serialization for sharing_rights *)
50let sharing_rights_to_json rights =
51 `Assoc [
52 ("mayRead", `Bool rights.may_read);
53 ("mayWrite", `Bool rights.may_write);
54 ("mayAdmin", `Bool rights.may_admin);
55 ]
56
57(** JSON deserialization for sharing_rights *)
58let sharing_rights_of_json json =
59 try
60 let open Yojson.Safe.Util in
61 let may_read = json |> member "mayRead" |> to_bool_option |> Option.value ~default:false in
62 let may_write = json |> member "mayWrite" |> to_bool_option |> Option.value ~default:false in
63 let may_admin = json |> member "mayAdmin" |> to_bool_option |> Option.value ~default:false in
64 Ok { may_read; may_write; may_admin }
65 with
66 | exn -> Error ("Failed to parse sharing rights: " ^ Printexc.to_string exn)
67
68(** Sharing information for a specific account *)
69type sharing_account = {
70 account_id : Jmap.Id.t; (** ID of account this mailbox is shared with *)
71 rights : sharing_rights; (** Permissions granted to the account *)
72}
73
74(** JSON serialization for sharing_account *)
75let sharing_account_to_json account =
76 `Assoc [
77 ("accountId", `String (Jmap.Id.to_string account.account_id));
78 ("rights", sharing_rights_to_json account.rights);
79 ]
80
81(** JSON deserialization for sharing_account *)
82let sharing_account_of_json json =
83 try
84 let open Yojson.Safe.Util in
85 let account_id_str = json |> member "accountId" |> to_string in
86 let rights_json = json |> member "rights" in
87 match Jmap.Id.of_string account_id_str with
88 | Error e -> Error ("Invalid account ID: " ^ e)
89 | Ok account_id ->
90 match sharing_rights_of_json rights_json with
91 | Error e -> Error e
92 | Ok rights -> Ok { account_id; rights }
93 with
94 | exn -> Error ("Failed to parse sharing account: " ^ Printexc.to_string exn)
95
96(* Main mailbox type with all properties *)
97type t = {
98 mailbox_id : Jmap.Id.t;
99 name : string;
100 parent_id : Jmap.Id.t option;
101 role : role option;
102 sort_order : Jmap.UInt.t;
103 total_emails : Jmap.UInt.t;
104 unread_emails : Jmap.UInt.t;
105 total_threads : Jmap.UInt.t;
106 unread_threads : Jmap.UInt.t;
107 my_rights : rights;
108 is_subscribed : bool;
109 shared_with : sharing_account list option; (** Accounts this mailbox is shared with *)
110}
111
112(* Type alias for use in submodules *)
113type mailbox_t = t
114
115(* Property accessors *)
116let id mailbox = Some mailbox.mailbox_id (* JMAP_OBJECT signature requires option *)
117let mailbox_id mailbox = mailbox.mailbox_id (* Direct access when ID is guaranteed *)
118let name mailbox = mailbox.name
119let parent_id mailbox = mailbox.parent_id
120let role mailbox = mailbox.role
121let sort_order mailbox = mailbox.sort_order
122let total_emails mailbox = mailbox.total_emails
123let unread_emails mailbox = mailbox.unread_emails
124let total_threads mailbox = mailbox.total_threads
125let unread_threads mailbox = mailbox.unread_threads
126let my_rights mailbox = mailbox.my_rights
127let is_subscribed mailbox = mailbox.is_subscribed
128let shared_with mailbox = mailbox.shared_with
129
130
131(* JMAP_OBJECT signature implementations *)
132
133(* Create a minimal valid mailbox object with only required fields *)
134let create ?id () =
135 let id = match id with
136 | Some i -> i
137 | None -> "temp_id" (* Temporary ID for unsaved objects *)
138 in
139 let default_rights = {
140 may_read_items = false; may_add_items = false; may_remove_items = false;
141 may_set_seen = false; may_set_keywords = false; may_create_child = false;
142 may_rename = false; may_delete = false; may_submit = false;
143 } in
144 let id_result = match Jmap.Id.of_string id with
145 | Ok id -> id
146 | Error e -> failwith ("Invalid mailbox ID: " ^ e) in
147 let sort_order = match Jmap.UInt.of_int 0 with
148 | Ok n -> n
149 | Error e -> failwith ("Invalid sort_order: " ^ e) in
150 let total_emails = match Jmap.UInt.of_int 0 with
151 | Ok n -> n
152 | Error e -> failwith ("Invalid total_emails: " ^ e) in
153 let unread_emails = match Jmap.UInt.of_int 0 with
154 | Ok n -> n
155 | Error e -> failwith ("Invalid unread_emails: " ^ e) in
156 {
157 mailbox_id = id_result;
158 name = "Untitled";
159 parent_id = None;
160 role = None;
161 sort_order;
162 total_emails;
163 unread_emails;
164 total_threads = (match Jmap.UInt.of_int 0 with Ok n -> n | Error e -> failwith ("Invalid total_threads: " ^ e));
165 unread_threads = (match Jmap.UInt.of_int 0 with Ok n -> n | Error e -> failwith ("Invalid unread_threads: " ^ e));
166 my_rights = default_rights;
167 is_subscribed = true;
168 shared_with = None;
169 }
170
171(* Get list of all valid property names for Mailbox objects *)
172let valid_properties () = [
173 "Jmap.Id.t"; "name"; "parentId"; "role"; "sortOrder";
174 "totalEmails"; "unreadEmails"; "totalThreads"; "unreadThreads";
175 "myRights"; "isSubscribed"; "sharedWith"
176]
177
178
179(* Extended constructor with validation - renamed from create *)
180let create_full ~id ~name ?parent_id ?role ?(sort_order=(match Jmap.UInt.of_int 0 with Ok u -> u | Error _ -> failwith "Invalid default sort_order")) ~total_emails ~unread_emails
181 ~total_threads ~unread_threads ~my_rights ~is_subscribed ?shared_with () =
182 if String.length name = 0 then
183 Error "Mailbox name cannot be empty"
184 else if Jmap.UInt.to_int total_emails < Jmap.UInt.to_int unread_emails then
185 Error "Unread emails cannot exceed total emails"
186 else if Jmap.UInt.to_int total_threads < Jmap.UInt.to_int unread_threads then
187 Error "Unread threads cannot exceed total threads"
188 else
189 let sort_order_uint = sort_order in
190 Ok {
191 mailbox_id = id;
192 name;
193 parent_id;
194 role;
195 sort_order = sort_order_uint;
196 total_emails;
197 unread_emails;
198 total_threads;
199 unread_threads;
200 my_rights;
201 is_subscribed;
202 shared_with;
203 }
204
205module Role = struct
206 type t = role
207
208 let inbox = Inbox
209 let archive = Archive
210 let drafts = Drafts
211 let sent = Sent
212 let trash = Trash
213 let junk = Junk
214 let important = Important
215 let snoozed = Snoozed
216 let scheduled = Scheduled
217 let memos = Memos
218 let none = NoRole
219 let other s = Other s
220
221 let to_string = function
222 | Inbox -> "inbox"
223 | Archive -> "archive"
224 | Drafts -> "drafts"
225 | Sent -> "sent"
226 | Trash -> "trash"
227 | Junk -> "junk"
228 | Important -> "important"
229 | Snoozed -> "snoozed"
230 | Scheduled -> "scheduled"
231 | Memos -> "memos"
232 | Other s -> s
233 | NoRole -> ""
234
235 let of_string = function
236 | "inbox" -> Ok Inbox
237 | "archive" -> Ok Archive
238 | "drafts" -> Ok Drafts
239 | "sent" -> Ok Sent
240 | "trash" -> Ok Trash
241 | "junk" -> Ok Junk
242 | "important" -> Ok Important
243 | "snoozed" -> Ok Snoozed
244 | "scheduled" -> Ok Scheduled
245 | "memos" -> Ok Memos
246 | "" -> Ok NoRole
247 | s -> Ok (Other s)
248
249 let standard_roles = [
250 (inbox, "inbox");
251 (archive, "archive");
252 (drafts, "drafts");
253 (sent, "sent");
254 (trash, "trash");
255 (junk, "junk");
256 (important, "important");
257 (snoozed, "snoozed");
258 (scheduled, "scheduled");
259 (memos, "memos");
260 ]
261
262 let is_standard = function
263 | Inbox | Archive | Drafts | Sent | Trash | Junk | Important
264 | Snoozed | Scheduled | Memos -> true
265 | Other _ | NoRole -> false
266
267 (* JSON serialization *)
268 let to_json role = `String (to_string role)
269
270 let of_json = function
271 | `String s -> of_string s
272 | json ->
273 let json_str = Yojson.Safe.to_string json in
274 Error (Printf.sprintf "Expected JSON string for Role, got: %s" json_str)
275end
276
277(* PRINTABLE interface implementation *)
278let pp ppf t =
279 let role_str = match t.role with
280 | Some r -> Role.to_string r
281 | None -> "none"
282 in
283 Format.fprintf ppf "Mailbox{id=%s; name=%s; role=%s}" (Jmap.Id.to_string t.mailbox_id) t.name role_str
284
285let pp_hum = pp
286
287(* Serialize to JSON with only specified properties *)
288let to_json_with_properties ~properties t =
289 let role_to_json = function
290 | Some r -> `String (Role.to_string r)
291 | None -> `Null
292 in
293 let rights_to_json rights = `Assoc [
294 ("mayReadItems", `Bool rights.may_read_items);
295 ("mayAddItems", `Bool rights.may_add_items);
296 ("mayRemoveItems", `Bool rights.may_remove_items);
297 ("maySetSeen", `Bool rights.may_set_seen);
298 ("maySetKeywords", `Bool rights.may_set_keywords);
299 ("mayCreateChild", `Bool rights.may_create_child);
300 ("mayRename", `Bool rights.may_rename);
301 ("mayDelete", `Bool rights.may_delete);
302 ("maySubmit", `Bool rights.may_submit);
303 ] in
304 let shared_with_to_json = function
305 | None -> `Null
306 | Some accounts -> `List (List.map sharing_account_to_json accounts)
307 in
308 let all_fields = [
309 ("id", `String (Jmap.Id.to_string t.mailbox_id));
310 ("name", `String t.name);
311 ("parentId", (match t.parent_id with Some p -> `String (Jmap.Id.to_string p) | None -> `Null));
312 ("role", role_to_json t.role);
313 ("sortOrder", `Int (Jmap.UInt.to_int t.sort_order));
314 ("totalEmails", `Int (Jmap.UInt.to_int t.total_emails));
315 ("unreadEmails", `Int (Jmap.UInt.to_int t.unread_emails));
316 ("totalThreads", `Int (Jmap.UInt.to_int t.total_threads));
317 ("unreadThreads", `Int (Jmap.UInt.to_int t.unread_threads));
318 ("myRights", rights_to_json t.my_rights);
319 ("isSubscribed", `Bool t.is_subscribed);
320 ("sharedWith", shared_with_to_json t.shared_with);
321 ] in
322 let filtered_fields = List.filter (fun (name, _) ->
323 List.mem name properties
324 ) all_fields in
325 let non_null_fields = List.filter (fun (_, value) ->
326 value <> `Null
327 ) filtered_fields in
328 `Assoc non_null_fields
329
330module Rights = struct
331 type t = rights
332
333 let may_read_items rights = rights.may_read_items
334 let may_add_items rights = rights.may_add_items
335 let may_remove_items rights = rights.may_remove_items
336 let may_set_seen rights = rights.may_set_seen
337 let may_set_keywords rights = rights.may_set_keywords
338 let may_create_child rights = rights.may_create_child
339 let may_rename rights = rights.may_rename
340 let may_delete rights = rights.may_delete
341 let may_submit rights = rights.may_submit
342
343 let create ~may_read_items ~may_add_items ~may_remove_items ~may_set_seen
344 ~may_set_keywords ~may_create_child ~may_rename ~may_delete
345 ~may_submit () = {
346 may_read_items;
347 may_add_items;
348 may_remove_items;
349 may_set_seen;
350 may_set_keywords;
351 may_create_child;
352 may_rename;
353 may_delete;
354 may_submit;
355 }
356
357 let full_access () = {
358 may_read_items = true;
359 may_add_items = true;
360 may_remove_items = true;
361 may_set_seen = true;
362 may_set_keywords = true;
363 may_create_child = true;
364 may_rename = true;
365 may_delete = true;
366 may_submit = true;
367 }
368
369 let read_only () = {
370 may_read_items = true;
371 may_add_items = false;
372 may_remove_items = false;
373 may_set_seen = false;
374 may_set_keywords = false;
375 may_create_child = false;
376 may_rename = false;
377 may_delete = false;
378 may_submit = false;
379 }
380
381 let no_access () = {
382 may_read_items = false;
383 may_add_items = false;
384 may_remove_items = false;
385 may_set_seen = false;
386 may_set_keywords = false;
387 may_create_child = false;
388 may_rename = false;
389 may_delete = false;
390 may_submit = false;
391 }
392
393 (* JSON serialization *)
394 let to_json rights =
395 `Assoc [
396 ("mayReadItems", `Bool rights.may_read_items);
397 ("mayAddItems", `Bool rights.may_add_items);
398 ("mayRemoveItems", `Bool rights.may_remove_items);
399 ("maySetSeen", `Bool rights.may_set_seen);
400 ("maySetKeywords", `Bool rights.may_set_keywords);
401 ("mayCreateChild", `Bool rights.may_create_child);
402 ("mayRename", `Bool rights.may_rename);
403 ("mayDelete", `Bool rights.may_delete);
404 ("maySubmit", `Bool rights.may_submit);
405 ]
406
407 let of_json json =
408 try
409 let open Yojson.Safe.Util in
410 let may_read_items = json |> member "mayReadItems" |> to_bool in
411 let may_add_items = json |> member "mayAddItems" |> to_bool in
412 let may_remove_items = json |> member "mayRemoveItems" |> to_bool in
413 let may_set_seen = json |> member "maySetSeen" |> to_bool in
414 let may_set_keywords = json |> member "maySetKeywords" |> to_bool in
415 let may_create_child = json |> member "mayCreateChild" |> to_bool in
416 let may_rename = json |> member "mayRename" |> to_bool in
417 let may_delete = json |> member "mayDelete" |> to_bool in
418 let may_submit = json |> member "maySubmit" |> to_bool in
419 Ok {
420 may_read_items;
421 may_add_items;
422 may_remove_items;
423 may_set_seen;
424 may_set_keywords;
425 may_create_child;
426 may_rename;
427 may_delete;
428 may_submit;
429 }
430 with
431 | Yojson.Safe.Util.Type_error (msg, _) -> Error ("Rights JSON parse error: " ^ msg)
432 | exn -> Error ("Rights JSON parse error: " ^ Printexc.to_string exn)
433end
434
435module Property = struct
436 type t =
437 | Id
438 | Name
439 | ParentId
440 | Role
441 | SortOrder
442 | TotalEmails
443 | UnreadEmails
444 | TotalThreads
445 | UnreadThreads
446 | MyRights
447 | IsSubscribed
448 | Other of string
449
450 let id = Id
451 let name = Name
452 let parent_id = ParentId
453 let role = Role
454 let sort_order = SortOrder
455 let total_emails = TotalEmails
456 let unread_emails = UnreadEmails
457 let total_threads = TotalThreads
458 let unread_threads = UnreadThreads
459 let my_rights = MyRights
460 let is_subscribed = IsSubscribed
461 let other s = Other s
462
463 let to_string = function
464 | Id -> "Jmap.Id.t"
465 | Name -> "name"
466 | ParentId -> "parentId"
467 | Role -> "role"
468 | SortOrder -> "sortOrder"
469 | TotalEmails -> "totalEmails"
470 | UnreadEmails -> "unreadEmails"
471 | TotalThreads -> "totalThreads"
472 | UnreadThreads -> "unreadThreads"
473 | MyRights -> "myRights"
474 | IsSubscribed -> "isSubscribed"
475 | Other s -> s
476
477 let of_string = function
478 | "Jmap.Id.t" -> Ok Id
479 | "name" -> Ok Name
480 | "parentId" -> Ok ParentId
481 | "role" -> Ok Role
482 | "sortOrder" -> Ok SortOrder
483 | "totalEmails" -> Ok TotalEmails
484 | "unreadEmails" -> Ok UnreadEmails
485 | "totalThreads" -> Ok TotalThreads
486 | "unreadThreads" -> Ok UnreadThreads
487 | "myRights" -> Ok MyRights
488 | "isSubscribed" -> Ok IsSubscribed
489 | s -> Ok (Other s)
490
491 let to_string_list props = List.map to_string props
492
493 let common_properties = [
494 id; name; parent_id; role; sort_order;
495 total_emails; unread_emails; is_subscribed
496 ]
497
498 let all_properties = [
499 id; name; parent_id; role; sort_order;
500 total_emails; unread_emails; total_threads; unread_threads;
501 my_rights; is_subscribed
502 ]
503
504 let is_count_property = function
505 | TotalEmails | UnreadEmails | TotalThreads | UnreadThreads -> true
506 | _ -> false
507
508 (* JSON serialization *)
509 let to_json prop = `String (to_string prop)
510
511 let of_json = function
512 | `String s -> of_string s
513 | json ->
514 let json_str = Yojson.Safe.to_string json in
515 Error (Printf.sprintf "Expected JSON string for Property, got: %s" json_str)
516end
517
518module Create = struct
519 type t = {
520 create_name : string;
521 create_parent_id : Jmap.Id.t option;
522 create_role : role option;
523 create_sort_order : Jmap.UInt.t option;
524 create_is_subscribed : bool option;
525 }
526
527 let create ~name ?parent_id ?role ?sort_order ?is_subscribed () =
528 if String.length name = 0 then
529 Error "Mailbox name cannot be empty"
530 else
531 Ok {
532 create_name = name;
533 create_parent_id = parent_id;
534 create_role = role;
535 create_sort_order = sort_order;
536 create_is_subscribed = is_subscribed;
537 }
538
539 let name create_req = create_req.create_name
540 let parent_id create_req = create_req.create_parent_id
541 let role create_req = create_req.create_role
542 let sort_order create_req = create_req.create_sort_order
543 let is_subscribed create_req = create_req.create_is_subscribed
544
545 (* JSON serialization *)
546 let to_json create_req =
547 let base = [
548 ("name", `String create_req.create_name);
549 ] in
550 let base = match create_req.create_parent_id with
551 | Some pid -> ("parentId", `String (Jmap.Id.to_string pid)) :: base
552 | None -> base
553 in
554 let base = match create_req.create_role with
555 | Some r -> ("role", Role.to_json r) :: base
556 | None -> base
557 in
558 let base = match create_req.create_sort_order with
559 | Some so -> ("sortOrder", `Int (Jmap.UInt.to_int so)) :: base
560 | None -> base
561 in
562 let base = match create_req.create_is_subscribed with
563 | Some sub -> ("isSubscribed", `Bool sub) :: base
564 | None -> base
565 in
566 `Assoc base
567
568 let of_json json =
569 try
570 let open Yojson.Safe.Util in
571 let name = json |> member "name" |> to_string in
572 let parent_id = match json |> member "parentId" |> to_string_option with
573 | None -> None
574 | Some s -> Some (match Jmap.Id.of_string s with
575 | Ok id -> id
576 | Error err -> failwith ("Invalid parentId: " ^ err)) in
577 let role_opt : (role option, string) result = match json |> member "role" with
578 | `Null -> Ok None
579 | role_json ->
580 match Role.of_json role_json with
581 | Ok r -> Ok (Some r)
582 | Error e -> Error e
583 in
584 let sort_order = match json |> member "sortOrder" |> to_int_option with
585 | None -> None
586 | Some i -> Some (match Jmap.UInt.of_int i with
587 | Ok uint -> uint
588 | Error err -> failwith ("Invalid sortOrder: " ^ err)) in
589 let is_subscribed = json |> member "isSubscribed" |> to_bool_option in
590 match role_opt with
591 | Ok role ->
592 Ok {
593 create_name = name;
594 create_parent_id = parent_id;
595 create_role = role;
596 create_sort_order = sort_order;
597 create_is_subscribed = is_subscribed;
598 }
599 | Error e -> Error e
600 with
601 | Yojson.Safe.Util.Type_error (msg, _) -> Error ("Create JSON parse error: " ^ msg)
602 | exn -> Error ("Create JSON parse error: " ^ Printexc.to_string exn)
603
604 module Response = struct
605 type t = {
606 response_id : Jmap.Id.t;
607 response_role : role option;
608 response_sort_order : Jmap.UInt.t;
609 response_total_emails : Jmap.UInt.t;
610 response_unread_emails : Jmap.UInt.t;
611 response_total_threads : Jmap.UInt.t;
612 response_unread_threads : Jmap.UInt.t;
613 response_my_rights : rights;
614 response_is_subscribed : bool;
615 }
616
617 let id response = response.response_id
618 let role response = response.response_role
619 let sort_order response = response.response_sort_order
620 let total_emails response = response.response_total_emails
621 let unread_emails response = response.response_unread_emails
622 let total_threads response = response.response_total_threads
623 let unread_threads response = response.response_unread_threads
624 let my_rights response = response.response_my_rights
625 let is_subscribed response = response.response_is_subscribed
626
627 (* JSON serialization *)
628 let to_json response =
629 let base = [
630 ("Jmap.Id.t", `String (Jmap.Id.to_string response.response_id));
631 ("sortOrder", `Int (Jmap.UInt.to_int response.response_sort_order));
632 ("totalEmails", `Int (Jmap.UInt.to_int response.response_total_emails));
633 ("unreadEmails", `Int (Jmap.UInt.to_int response.response_unread_emails));
634 ("totalThreads", `Int (Jmap.UInt.to_int response.response_total_threads));
635 ("unreadThreads", `Int (Jmap.UInt.to_int response.response_unread_threads));
636 ("myRights", Rights.to_json response.response_my_rights);
637 ("isSubscribed", `Bool response.response_is_subscribed);
638 ] in
639 let base = match response.response_role with
640 | Some r -> ("role", Role.to_json r) :: base
641 | None -> base
642 in
643 `Assoc base
644
645 let of_json json =
646 try
647 let open Yojson.Safe.Util in
648 let id_str = json |> member "id" |> to_string in
649 let id = match Jmap.Id.of_string id_str with
650 | Ok id_val -> id_val
651 | Error e -> failwith ("Invalid mailbox ID: " ^ id_str ^ " - " ^ e)
652 in
653 let role_opt : (role option, string) result = match json |> member "role" with
654 | `Null -> Ok None
655 | role_json ->
656 match Role.of_json role_json with
657 | Ok r -> Ok (Some r)
658 | Error e -> Error e
659 in
660 let sort_order_int = json |> member "sortOrder" |> to_int in
661 let sort_order = match Jmap.UInt.of_int sort_order_int with
662 | Ok uint -> uint
663 | Error _ -> failwith ("Invalid sortOrder: " ^ string_of_int sort_order_int) in
664 let total_emails_int = json |> member "totalEmails" |> to_int in
665 let total_emails = match Jmap.UInt.of_int total_emails_int with
666 | Ok uint -> uint
667 | Error _ -> failwith ("Invalid totalEmails: " ^ string_of_int total_emails_int) in
668 let unread_emails_int = json |> member "unreadEmails" |> to_int in
669 let unread_emails = match Jmap.UInt.of_int unread_emails_int with
670 | Ok uint -> uint
671 | Error _ -> failwith ("Invalid unreadEmails: " ^ string_of_int unread_emails_int) in
672 let total_threads_int = json |> member "totalThreads" |> to_int in
673 let total_threads = match Jmap.UInt.of_int total_threads_int with
674 | Ok uint -> uint
675 | Error _ -> failwith ("Invalid totalThreads: " ^ string_of_int total_threads_int) in
676 let unread_threads_int = json |> member "unreadThreads" |> to_int in
677 let unread_threads = match Jmap.UInt.of_int unread_threads_int with
678 | Ok uint -> uint
679 | Error _ -> failwith ("Invalid unreadThreads: " ^ string_of_int unread_threads_int) in
680 let my_rights_result = json |> member "myRights" |> Rights.of_json in
681 let is_subscribed = json |> member "isSubscribed" |> to_bool in
682 match role_opt, my_rights_result with
683 | Ok role, Ok my_rights ->
684 Ok {
685 response_id = id;
686 response_role = role;
687 response_sort_order = sort_order;
688 response_total_emails = total_emails;
689 response_unread_emails = unread_emails;
690 response_total_threads = total_threads;
691 response_unread_threads = unread_threads;
692 response_my_rights = my_rights;
693 response_is_subscribed = is_subscribed;
694 }
695 | Error e, _ -> Error e
696 | _, Error e -> Error e
697 with
698 | Yojson.Safe.Util.Type_error (msg, _) -> Error ("Create.Response JSON parse error: " ^ msg)
699 | exn -> Error ("Create.Response JSON parse error: " ^ Printexc.to_string exn)
700 end
701end
702
703module Update = struct
704 type t = Jmap.Methods.patch_object
705
706 let create ?name ?parent_id ?role ?sort_order ?is_subscribed () =
707 let patches = [] in
708 let patches = match name with
709 | Some n -> ("/name", `String n) :: patches
710 | None -> patches
711 in
712 let patches = match parent_id with
713 | Some (Some id) -> ("/parentId", `String (Jmap.Id.to_string id)) :: patches
714 | Some None -> ("/parentId", `Null) :: patches
715 | None -> patches
716 in
717 let patches = match role with
718 | Some (Some r) -> ("/role", Role.to_json r) :: patches
719 | Some None -> ("/role", `Null) :: patches
720 | None -> patches
721 in
722 let patches = match sort_order with
723 | Some n -> ("/sortOrder", `Int (Jmap.UInt.to_int n)) :: patches
724 | None -> patches
725 in
726 let patches = match is_subscribed with
727 | Some b -> ("/isSubscribed", `Bool b) :: patches
728 | None -> patches
729 in
730 Ok patches
731
732 let empty () = []
733
734 (* JSON serialization *)
735 let to_json patches = `Assoc patches
736
737 let of_json = function
738 | `Assoc patches -> Ok patches
739 | json ->
740 let json_str = Yojson.Safe.to_string json in
741 Error (Printf.sprintf "Expected JSON object for Update, got: %s" json_str)
742
743 module Response = struct
744 type t = mailbox_t option
745
746 let to_mailbox response = response
747
748 (* JSON serialization *)
749 let to_json t = match t with
750 | Some mailbox ->
751 (* Create complete JSON representation inline *)
752 let base = [
753 ("Jmap.Id.t", `String (Jmap.Id.to_string mailbox.mailbox_id));
754 ("name", `String mailbox.name);
755 ("sortOrder", `Int (Jmap.UInt.to_int mailbox.sort_order));
756 ("totalEmails", `Int (Jmap.UInt.to_int mailbox.total_emails));
757 ("unreadEmails", `Int (Jmap.UInt.to_int mailbox.unread_emails));
758 ("totalThreads", `Int (Jmap.UInt.to_int mailbox.total_threads));
759 ("unreadThreads", `Int (Jmap.UInt.to_int mailbox.unread_threads));
760 ("myRights", Rights.to_json mailbox.my_rights);
761 ("isSubscribed", `Bool mailbox.is_subscribed);
762 ] in
763 let base = match mailbox.parent_id with
764 | Some pid -> ("parentId", `String (Jmap.Id.to_string pid)) :: base
765 | None -> base
766 in
767 let base = match mailbox.role with
768 | Some r -> ("role", Role.to_json r) :: base
769 | None -> base
770 in
771 `Assoc base
772 | None -> `Null
773
774 let of_json (json : Yojson.Safe.t) : (t, string) result =
775 match json with
776 | `Null -> Ok None
777 | _ ->
778 (* Use the main of_json function that's defined later *)
779 Error "Update.Response.of_json: full implementation requires main of_json function"
780 end
781end
782
783(* Stub implementations for method modules - these would be implemented based on actual JMAP method signatures *)
784module Query_args = struct
785 type t = {
786 account_id : Jmap.Id.t;
787 filter : Filter.t option;
788 sort : Comparator.t list option;
789 position : Jmap.UInt.t option;
790 limit : Jmap.UInt.t option;
791 calculate_total : bool option;
792 }
793
794 let create ~account_id ?filter ?sort ?position ?limit ?calculate_total () =
795 Ok { account_id; filter; sort; position; limit; calculate_total }
796
797 let account_id args = args.account_id
798 let filter args = args.filter
799 let sort args = args.sort
800 let position args = args.position
801 let limit args = args.limit
802 let calculate_total args = args.calculate_total
803
804 let to_json args =
805 let fields = [("accountId", `String (Jmap.Id.to_string args.account_id))] in
806 let fields = match args.filter with
807 | None -> fields
808 | Some _filter -> ("filter", `Null) :: fields (* Filter serialization needs implementation *)
809 in
810 let fields = match args.sort with
811 | None -> fields
812 | Some sort_list -> ("sort", `List (List.map Comparator.to_json sort_list)) :: fields
813 in
814 let fields = match args.position with
815 | None -> fields
816 | Some pos -> ("position", `Int (Jmap.UInt.to_int pos)) :: fields
817 in
818 let fields = match args.limit with
819 | None -> fields
820 | Some lim -> ("limit", `Int (Jmap.UInt.to_int lim)) :: fields
821 in
822 let fields = match args.calculate_total with
823 | None -> fields
824 | Some calc -> ("calculateTotal", `Bool calc) :: fields
825 in
826 `Assoc (List.rev fields)
827
828 let of_json json =
829 try
830 match json with
831 | `Assoc fields ->
832 let account_id = match List.assoc "accountId" fields with
833 | `String s -> (match Jmap.Id.of_string s with
834 | Ok id -> id
835 | Error _ -> failwith ("Invalid accountId: " ^ s))
836 | _ -> failwith "Expected string for accountId"
837 in
838 let filter : Filter.t option = match List.assoc_opt "filter" fields with
839 | None -> None
840 | Some filter_json -> Some (Jmap.Methods.Filter.condition filter_json)
841 in
842 let sort : Comparator.t list option = match List.assoc_opt "sort" fields with
843 | None -> None
844 | Some (`List sort_list) ->
845 Some (List.map (fun s ->
846 match Comparator.of_json s with
847 | Ok comp -> comp
848 | Error _ -> failwith "Invalid sort comparator"
849 ) sort_list)
850 | Some _ -> failwith "Expected list for sort"
851 in
852 let position : Jmap.UInt.t option = match List.assoc_opt "position" fields with
853 | None -> None
854 | Some (`Int i) when i >= 0 -> (match Jmap.UInt.of_int i with
855 | Ok uint -> Some uint
856 | Error _ -> failwith ("Invalid position: " ^ string_of_int i))
857 | Some (`Int _) -> failwith "Position must be non-negative"
858 | Some _ -> failwith "Expected int for position"
859 in
860 let limit : Jmap.UInt.t option = match List.assoc_opt "limit" fields with
861 | None -> None
862 | Some (`Int i) when i >= 0 -> (match Jmap.UInt.of_int i with
863 | Ok uint -> Some uint
864 | Error _ -> failwith ("Invalid limit: " ^ string_of_int i))
865 | Some (`Int _) -> failwith "Limit must be non-negative"
866 | Some _ -> failwith "Expected int for limit"
867 in
868 let calculate_total : bool option = match List.assoc_opt "calculateTotal" fields with
869 | None -> None
870 | Some (`Bool b) -> Some b
871 | Some _ -> failwith "Expected bool for calculateTotal"
872 in
873 Ok { account_id; filter; sort; position; limit; calculate_total }
874 | _ -> Error "Expected JSON object for Query_args"
875 with
876 | Not_found -> Error "Missing required field in Query_args"
877 | Failure msg -> Error ("Query_args JSON parsing error: " ^ msg)
878 | exn -> Error ("Query_args JSON parsing exception: " ^ Printexc.to_string exn)
879
880 let pp fmt t =
881 Format.fprintf fmt "Mailbox.Query_args{account=%s}" (Jmap.Id.to_string t.account_id)
882
883 let pp_hum fmt t = pp fmt t
884
885 let validate _t = Ok ()
886
887 let method_name () = method_to_string `Mailbox_query
888end
889
890module Query_response = struct
891 type t = {
892 account_id : Jmap.Id.t;
893 query_state : string;
894 can_calculate_changes : bool;
895 position : Jmap.UInt.t;
896 total : Jmap.UInt.t option;
897 ids : Jmap.Id.t list;
898 }
899
900 let account_id resp = resp.account_id
901 let query_state resp = resp.query_state
902 let can_calculate_changes resp = resp.can_calculate_changes
903 let position resp = resp.position
904 let total resp = resp.total
905 let ids resp = resp.ids
906
907 (** Serialize Mailbox/query response to JSON.
908
909 Follows the standard JMAP query response format from
910 {{:https://www.rfc-editor.org/rfc/rfc8620.html#section-5.5}RFC 8620 Section 5.5}.
911
912 @param resp The query response to serialize
913 @return JSON object with accountId, queryState, canCalculateChanges, position, ids, and optional total *)
914 let to_json resp =
915 let base = [
916 ("accountId", `String (Jmap.Id.to_string resp.account_id));
917 ("queryState", `String resp.query_state);
918 ("canCalculateChanges", `Bool resp.can_calculate_changes);
919 ("position", `Int (Jmap.UInt.to_int resp.position));
920 ("ids", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) resp.ids));
921 ] in
922 let base = match resp.total with
923 | Some total -> ("total", `Int (Jmap.UInt.to_int total)) :: base
924 | None -> base
925 in
926 `Assoc base
927
928 (** Parse Mailbox/query response JSON.
929
930 Extracts standard JMAP query response fields from JSON as defined in
931 {{:https://www.rfc-editor.org/rfc/rfc8620.html#section-5.5}RFC 8620 Section 5.5}.
932
933 @param json JSON object containing query response
934 @return Result with parsed query response or error message *)
935 let of_json json =
936 try
937 let open Yojson.Safe.Util in
938 let account_id_str = json |> member "accountId" |> to_string in
939 let account_id = match Jmap.Id.of_string account_id_str with
940 | Ok id -> id
941 | Error _ -> failwith ("Invalid accountId: " ^ account_id_str) in
942 let query_state = json |> member "queryState" |> to_string in
943 let can_calculate_changes = json |> member "canCalculateChanges" |> to_bool in
944 let position_int = json |> member "position" |> to_int in
945 let position = match Jmap.UInt.of_int position_int with
946 | Ok uint -> uint
947 | Error _ -> failwith ("Invalid position: " ^ string_of_int position_int) in
948 let ids_strings = json |> member "ids" |> to_list |> List.map to_string in
949 let ids = List.filter_map (fun s -> match Jmap.Id.of_string s with
950 | Ok id -> Some id
951 | Error _ -> None) ids_strings in
952 let total_opt = json |> member "total" |> to_int_option in
953 let total = match total_opt with
954 | None -> None
955 | Some total_int -> (match Jmap.UInt.of_int total_int with
956 | Ok uint -> Some uint
957 | Error _ -> None) in
958 Ok {
959 account_id;
960 query_state;
961 can_calculate_changes;
962 position;
963 total;
964 ids;
965 }
966 with
967 | Yojson.Safe.Util.Type_error (msg, _) -> Error ("Query_response JSON parse error: " ^ msg)
968 | exn -> Error ("Query_response JSON parse error: " ^ Printexc.to_string exn)
969
970 let pp fmt t =
971 Format.fprintf fmt "Mailbox.Query_response{account=%s;total=%s}"
972 (Jmap.Id.to_string t.account_id)
973 (match t.total with Some n -> string_of_int (Jmap.UInt.to_int n) | None -> "unknown")
974
975 let pp_hum fmt t = pp fmt t
976
977 let state _t = Some "stub-state"
978
979 let is_error _t = false
980end
981
982module Get_args = struct
983 type t = {
984 account_id : Jmap.Id.t;
985 ids : Jmap.Id.t list option;
986 properties : Property.t list option;
987 }
988
989 let create ~account_id ?ids ?properties () =
990 Ok { account_id; ids; properties }
991
992 let account_id args = args.account_id
993 let ids args = args.ids
994 let properties args = args.properties
995
996 (** Serialize Mailbox/get arguments to JSON.
997
998 Follows the standard JMAP get arguments format from
999 {{:https://www.rfc-editor.org/rfc/rfc8620.html#section-5.1}RFC 8620 Section 5.1}.
1000
1001 @param args The get arguments to serialize
1002 @return JSON object with accountId, and optional ids and properties *)
1003 let to_json args =
1004 let base = [("accountId", `String (Jmap.Id.to_string args.account_id))] in
1005 let base = match args.ids with
1006 | None -> base
1007 | Some ids -> ("ids", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) ids)) :: base
1008 in
1009 let base = match args.properties with
1010 | None -> base
1011 | Some props ->
1012 let prop_strings = List.map Property.to_string props in
1013 ("properties", (`List (List.map (fun s -> `String s) prop_strings) : Yojson.Safe.t)) :: base
1014 in
1015 `Assoc base
1016
1017 (** Parse Mailbox/get arguments from JSON.
1018
1019 Extracts standard JMAP get arguments from JSON as defined in
1020 {{:https://www.rfc-editor.org/rfc/rfc8620.html#section-5.1}RFC 8620 Section 5.1}.
1021
1022 @param json JSON object containing get arguments
1023 @return Result with parsed get arguments or error message *)
1024 let of_json json =
1025 try
1026 let account_id = match Jmap.Id.of_string (Yojson.Safe.Util.(json |> member "accountId" |> to_string)) with
1027 | Ok id -> id
1028 | Error _ -> failwith "Invalid accountId in Get_args JSON" in
1029 let ids = match Yojson.Safe.Util.(json |> member "ids") with
1030 | `Null -> None
1031 | `List id_list -> Some (List.map (fun id_json ->
1032 match Jmap.Id.of_string (Yojson.Safe.Util.to_string id_json) with
1033 | Ok id -> id
1034 | Error _ -> failwith ("Invalid id in Get_args ids list: " ^ Yojson.Safe.Util.to_string id_json)
1035 ) id_list)
1036 | _ -> failwith "Expected array or null for ids"
1037 in
1038 let properties = match Yojson.Safe.Util.(json |> member "properties") with
1039 | `Null -> None
1040 | `List prop_list ->
1041 Some (List.map (fun prop_json ->
1042 let prop_str = Yojson.Safe.Util.to_string prop_json in
1043 match Property.of_string prop_str with
1044 | Ok prop -> prop
1045 | Error _ -> failwith ("Invalid property: " ^ prop_str)
1046 ) prop_list)
1047 | _ -> failwith "Expected array or null for properties"
1048 in
1049 Ok { account_id; ids; properties }
1050 with
1051 | Yojson.Safe.Util.Type_error (msg, _) -> Error ("Get_args JSON parse error: " ^ msg)
1052 | Failure msg -> Error ("Get_args JSON parse error: " ^ msg)
1053 | exn -> Error ("Get_args JSON parse error: " ^ Printexc.to_string exn)
1054
1055 let pp fmt t =
1056 Format.fprintf fmt "Mailbox.Get_args{account=%s}" (Jmap.Id.to_string t.account_id)
1057
1058 let pp_hum fmt t = pp fmt t
1059
1060 let validate _t = Ok ()
1061
1062 let method_name () = method_to_string `Mailbox_get
1063end
1064
1065module Get_response = struct
1066 type t = {
1067 account_id : Jmap.Id.t;
1068 state : string;
1069 list : mailbox_t list;
1070 not_found : Jmap.Id.t list;
1071 }
1072
1073 let account_id resp = resp.account_id
1074 let state resp = resp.state
1075 let list resp = resp.list
1076 let not_found resp = resp.not_found
1077
1078 (** Serialize Mailbox/get response to JSON.
1079
1080 Follows the standard JMAP get response format from
1081 {{:https://www.rfc-editor.org/rfc/rfc8620.html#section-5.1}RFC 8620 Section 5.1}.
1082
1083 @param resp The get response to serialize
1084 @return JSON object with accountId, state, list, and notFound *)
1085 let to_json resp =
1086 (* Helper to serialize a single mailbox - duplicated locally to avoid forward reference *)
1087 let mailbox_to_json mailbox =
1088 let base : (string * Yojson.Safe.t) list = [
1089 ("Jmap.Id.t", `String (Jmap.Id.to_string mailbox.mailbox_id));
1090 ("name", `String mailbox.name);
1091 ("sortOrder", `Int (Jmap.UInt.to_int mailbox.sort_order));
1092 ("totalEmails", `Int (Jmap.UInt.to_int mailbox.total_emails));
1093 ("unreadEmails", `Int (Jmap.UInt.to_int mailbox.unread_emails));
1094 ("totalThreads", `Int (Jmap.UInt.to_int mailbox.total_threads));
1095 ("unreadThreads", `Int (Jmap.UInt.to_int mailbox.unread_threads));
1096 ("myRights", Rights.to_json mailbox.my_rights);
1097 ("isSubscribed", `Bool mailbox.is_subscribed);
1098 ] in
1099 let base = match mailbox.parent_id with
1100 | Some pid -> ("parentId", `String (Jmap.Id.to_string pid)) :: base
1101 | None -> base
1102 in
1103 let base = match mailbox.role with
1104 | Some r -> ("role", Role.to_json r) :: base
1105 | None -> base
1106 in
1107 `Assoc base
1108 in
1109 `Assoc [
1110 ("accountId", `String (Jmap.Id.to_string resp.account_id));
1111 ("state", `String resp.state);
1112 ("list", `List (List.map mailbox_to_json resp.list));
1113 ("notFound", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) resp.not_found));
1114 ]
1115
1116 (** Parse Mailbox/get response from JSON.
1117
1118 Extracts standard JMAP get response fields from JSON as defined in
1119 {{:https://www.rfc-editor.org/rfc/rfc8620.html#section-5.1}RFC 8620 Section 5.1}.
1120
1121 @param json JSON object containing get response
1122 @return Result with parsed get response or error message *)
1123 let of_json json =
1124 try
1125 let open Yojson.Safe.Util in
1126 let account_id_str = json |> member "accountId" |> to_string in
1127 let account_id = match Jmap.Id.of_string account_id_str with Ok id -> id | Error _ -> failwith ("Invalid account_id: " ^ account_id_str) in
1128 let state = json |> member "state" |> to_string in
1129 let list_json = json |> member "list" |> to_list in
1130 (* Helper to parse a single mailbox - duplicated locally to avoid forward reference *)
1131 let mailbox_of_json json =
1132 let id_str = json |> member "Jmap.Id.t" |> to_string in
1133 let id = match Jmap.Id.of_string id_str with Ok id -> id | Error _ -> failwith ("Invalid id: " ^ id_str) in
1134 let name = json |> member "name" |> to_string in
1135 let parent_id = match json |> member "parentId" |> to_string_option with
1136 | Some s -> (match Jmap.Id.of_string s with Ok id -> Some id | Error _ -> failwith ("Invalid parent_id: " ^ s))
1137 | None -> None in
1138 let role_opt : (role option, string) result = match json |> member "role" with
1139 | `Null -> Ok None
1140 | role_json ->
1141 match Role.of_json role_json with
1142 | Ok r -> Ok (Some r)
1143 | Error e -> Error e
1144 in
1145 let sort_order_int = json |> member "sortOrder" |> to_int in
1146 let sort_order = match Jmap.UInt.of_int sort_order_int with
1147 | Ok uint -> uint
1148 | Error _ -> failwith ("Invalid sortOrder: " ^ string_of_int sort_order_int) in
1149 let total_emails_int = json |> member "totalEmails" |> to_int in
1150 let total_emails = match Jmap.UInt.of_int total_emails_int with
1151 | Ok uint -> uint
1152 | Error _ -> failwith ("Invalid totalEmails: " ^ string_of_int total_emails_int) in
1153 let unread_emails_int = json |> member "unreadEmails" |> to_int in
1154 let unread_emails = match Jmap.UInt.of_int unread_emails_int with
1155 | Ok uint -> uint
1156 | Error _ -> failwith ("Invalid unreadEmails: " ^ string_of_int unread_emails_int) in
1157 let total_threads_int = json |> member "totalThreads" |> to_int in
1158 let total_threads = match Jmap.UInt.of_int total_threads_int with
1159 | Ok uint -> uint
1160 | Error _ -> failwith ("Invalid totalThreads: " ^ string_of_int total_threads_int) in
1161 let unread_threads_int = json |> member "unreadThreads" |> to_int in
1162 let unread_threads = match Jmap.UInt.of_int unread_threads_int with
1163 | Ok uint -> uint
1164 | Error _ -> failwith ("Invalid unreadThreads: " ^ string_of_int unread_threads_int) in
1165 let my_rights_result = json |> member "myRights" |> Rights.of_json in
1166 let is_subscribed = json |> member "isSubscribed" |> to_bool in
1167 match role_opt, my_rights_result with
1168 | Ok role, Ok my_rights ->
1169 create_full ~id ~name ?parent_id ?role
1170 ~sort_order
1171 ~total_emails ~unread_emails ~total_threads ~unread_threads
1172 ~my_rights ~is_subscribed ()
1173 | Error e, _ -> Error e
1174 | _, Error e -> Error e
1175 in
1176 let list_result = List.fold_left (fun acc mailbox_json ->
1177 match acc with
1178 | Error e -> Error e
1179 | Ok mailboxes ->
1180 match mailbox_of_json mailbox_json with
1181 | Ok mailbox -> Ok (mailbox :: mailboxes)
1182 | Error e -> Error e
1183 ) (Ok []) list_json in
1184 let not_found = json |> member "notFound" |> to_list |> List.map (fun id_json ->
1185 let id_str = to_string id_json in
1186 match Jmap.Id.of_string id_str with Ok id -> id | Error _ -> failwith ("Invalid not_found id: " ^ id_str)) in
1187 match list_result with
1188 | Ok list ->
1189 Ok {
1190 account_id;
1191 state;
1192 list = List.rev list; (* Reverse to maintain order *)
1193 not_found;
1194 }
1195 | Error e -> Error e
1196 with
1197 | Yojson.Safe.Util.Type_error (msg, _) -> Error ("Get_response JSON parse error: " ^ msg)
1198 | exn -> Error ("Get_response JSON parse error: " ^ Printexc.to_string exn)
1199
1200 let pp fmt t =
1201 Format.fprintf fmt "Mailbox.Get_response{account=%s;mailboxes=%d}"
1202 (Jmap.Id.to_string t.account_id) (List.length t.list)
1203
1204 let pp_hum fmt t = pp fmt t
1205
1206 let is_error _t = false
1207end
1208
1209module Set_args = struct
1210 type t = {
1211 account_id : Jmap.Id.t;
1212 if_in_state : string option;
1213 create : (string * Create.t) list;
1214 update : (Jmap.Id.t * Update.t) list;
1215 destroy : Jmap.Id.t list;
1216 }
1217
1218 let account_id args = args.account_id
1219 let if_in_state args = args.if_in_state
1220 let create args = args.create
1221 let update args = args.update
1222 let destroy args = args.destroy
1223
1224 (** Serialize Mailbox/set arguments to JSON.
1225
1226 Follows the standard JMAP set arguments format from
1227 {{:https://www.rfc-editor.org/rfc/rfc8620.html#section-5.3}RFC 8620 Section 5.3}.
1228
1229 @param args The set arguments to serialize
1230 @return JSON object with accountId, ifInState, create, update, destroy *)
1231 let to_json args =
1232 let base = [("accountId", `String (Jmap.Id.to_string args.account_id))] in
1233 let base = match args.if_in_state with
1234 | None -> base
1235 | Some state -> ("ifInState", `String state) :: base
1236 in
1237 let base =
1238 if List.length args.create = 0 then base
1239 else
1240 let create_map = List.map (fun (creation_id, create_obj) ->
1241 (creation_id, Create.to_json create_obj)
1242 ) args.create in
1243 ("create", `Assoc create_map) :: base
1244 in
1245 let base =
1246 if List.length args.update = 0 then base
1247 else
1248 let update_map = List.map (fun (id, update_obj) ->
1249 (Jmap.Id.to_string id, Update.to_json update_obj)
1250 ) args.update in
1251 ("update", `Assoc update_map) :: base
1252 in
1253 let base =
1254 if List.length args.destroy = 0 then base
1255 else
1256 ("destroy", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) args.destroy)) :: base
1257 in
1258 `Assoc base
1259
1260 (** Parse Mailbox/set arguments from JSON.
1261
1262 Extracts standard JMAP set arguments from JSON as defined in
1263 {{:https://www.rfc-editor.org/rfc/rfc8620.html#section-5.3}RFC 8620 Section 5.3}.
1264
1265 @param json JSON object containing set arguments
1266 @return Result with parsed set arguments or error message *)
1267 let of_json json =
1268 try
1269 let open Yojson.Safe.Util in
1270 let account_id_str = json |> member "accountId" |> to_string in
1271 let account_id = match Jmap.Id.of_string account_id_str with
1272 | Ok id -> id
1273 | Error e -> failwith ("Invalid account ID: " ^ e)
1274 in
1275 let if_in_state = json |> member "ifInState" |> to_string_option in
1276 let create = match json |> member "create" with
1277 | `Null -> []
1278 | `Assoc create_assoc ->
1279 List.fold_left (fun acc (creation_id, create_json) ->
1280 match Create.of_json create_json with
1281 | Ok create_obj -> (creation_id, create_obj) :: acc
1282 | Error _ -> failwith ("Invalid create object for: " ^ creation_id)
1283 ) [] create_assoc
1284 | _ -> failwith "Expected object or null for create"
1285 in
1286 let update = match json |> member "update" with
1287 | `Null -> []
1288 | `Assoc update_assoc ->
1289 List.fold_left (fun acc (id, update_json) ->
1290 match Update.of_json update_json with
1291 | Ok update_obj ->
1292 let id_t = match Jmap.Id.of_string id with
1293 | Ok id_val -> id_val
1294 | Error e -> failwith ("Invalid update ID: " ^ id ^ " - " ^ e)
1295 in
1296 (id_t, update_obj) :: acc
1297 | Error _ -> failwith ("Invalid update object for: " ^ id)
1298 ) [] update_assoc
1299 | _ -> failwith "Expected object or null for update"
1300 in
1301 let destroy = match json |> member "destroy" with
1302 | `Null -> []
1303 | `List destroy_list -> List.map (fun id_json ->
1304 let id_str = to_string id_json in
1305 match Jmap.Id.of_string id_str with
1306 | Ok id -> id
1307 | Error e -> failwith ("Invalid destroy ID: " ^ id_str ^ " - " ^ e)
1308 ) destroy_list
1309 | _ -> failwith "Expected array or null for destroy"
1310 in
1311 Ok {
1312 account_id;
1313 if_in_state;
1314 create = List.rev create; (* Reverse to maintain order *)
1315 update = List.rev update;
1316 destroy;
1317 }
1318 with
1319 | Yojson.Safe.Util.Type_error (msg, _) -> Error ("Set_args JSON parse error: " ^ msg)
1320 | Failure msg -> Error ("Set_args JSON parse error: " ^ msg)
1321 | exn -> Error ("Set_args JSON parse error: " ^ Printexc.to_string exn)
1322
1323 let pp fmt t =
1324 Format.fprintf fmt "Mailbox.Set_args{account=%s}" (Jmap.Id.to_string t.account_id)
1325
1326 let pp_hum fmt t = pp fmt t
1327
1328 let validate _t = Ok ()
1329
1330 let method_name () = method_to_string `Mailbox_set
1331end
1332
1333module Set_response = struct
1334 type t = {
1335 account_id : Jmap.Id.t;
1336 old_state : string option;
1337 new_state : string;
1338 created : (string * Create.Response.t) list;
1339 updated : (Jmap.Id.t * Update.Response.t) list;
1340 destroyed : Jmap.Id.t list;
1341 not_created : (string * Jmap.Error.Set_error.t) list;
1342 not_updated : (Jmap.Id.t * Jmap.Error.Set_error.t) list;
1343 not_destroyed : (Jmap.Id.t * Jmap.Error.Set_error.t) list;
1344 }
1345
1346 let account_id resp = resp.account_id
1347 let old_state resp = resp.old_state
1348 let new_state resp = resp.new_state
1349 let created resp = resp.created
1350 let updated resp = resp.updated
1351 let destroyed resp = resp.destroyed
1352 let not_created resp = resp.not_created
1353 let not_updated resp = resp.not_updated
1354 let not_destroyed resp = resp.not_destroyed
1355
1356 (** Serialize Mailbox/set response to JSON.
1357
1358 Follows the standard JMAP set response format from
1359 {{:https://www.rfc-editor.org/rfc/rfc8620.html#section-5.3}RFC 8620 Section 5.3}.
1360
1361 @param resp The set response to serialize
1362 @return JSON object with accountId, states, created, updated, destroyed, and error maps *)
1363 let to_json resp =
1364 let base = [
1365 ("accountId", `String (Jmap.Id.to_string resp.account_id));
1366 ("newState", `String resp.new_state);
1367 ] in
1368 let base = match resp.old_state with
1369 | None -> base
1370 | Some state -> ("oldState", `String state) :: base
1371 in
1372 let base =
1373 if List.length resp.created = 0 then base
1374 else
1375 let created_map = List.map (fun (creation_id, create_resp) ->
1376 (creation_id, Create.Response.to_json create_resp)
1377 ) resp.created in
1378 ("created", `Assoc created_map) :: base
1379 in
1380 let base =
1381 if List.length resp.updated = 0 then base
1382 else
1383 let updated_map = List.map (fun (id, update_resp) ->
1384 (Jmap.Id.to_string id, Update.Response.to_json update_resp)
1385 ) resp.updated in
1386 ("updated", `Assoc updated_map) :: base
1387 in
1388 let base =
1389 if List.length resp.destroyed = 0 then base
1390 else
1391 ("destroyed", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) resp.destroyed)) :: base
1392 in
1393 let base =
1394 if List.length resp.not_created = 0 then base
1395 else
1396 let not_created_map = List.map (fun (creation_id, error) ->
1397 (creation_id, Jmap.Error.Set_error.to_json error)
1398 ) resp.not_created in
1399 ("notCreated", `Assoc not_created_map) :: base
1400 in
1401 let base =
1402 if List.length resp.not_updated = 0 then base
1403 else
1404 let not_updated_map = List.map (fun (id, error) ->
1405 (Jmap.Id.to_string id, Jmap.Error.Set_error.to_json error)
1406 ) resp.not_updated in
1407 ("notUpdated", `Assoc not_updated_map) :: base
1408 in
1409 let base =
1410 if List.length resp.not_destroyed = 0 then base
1411 else
1412 let not_destroyed_map = List.map (fun (id, error) ->
1413 (Jmap.Id.to_string id, Jmap.Error.Set_error.to_json error)
1414 ) resp.not_destroyed in
1415 ("notDestroyed", `Assoc not_destroyed_map) :: base
1416 in
1417 `Assoc base
1418
1419 (** Parse Mailbox/set response from JSON.
1420
1421 Extracts standard JMAP set response fields from JSON as defined in
1422 {{:https://www.rfc-editor.org/rfc/rfc8620.html#section-5.3}RFC 8620 Section 5.3}.
1423
1424 @param json JSON object containing set response
1425 @return Result with parsed set response or error message *)
1426 let of_json json =
1427 try
1428 let open Yojson.Safe.Util in
1429 let account_id_str = json |> member "accountId" |> to_string in
1430 let account_id = match Jmap.Id.of_string account_id_str with
1431 | Ok id -> id
1432 | Error e -> failwith ("Invalid account ID: " ^ e)
1433 in
1434 let old_state = json |> member "oldState" |> to_string_option in
1435 let new_state = json |> member "newState" |> to_string in
1436 let created = match json |> member "created" with
1437 | `Null -> []
1438 | `Assoc created_assoc ->
1439 List.fold_left (fun acc (creation_id, resp_json) ->
1440 match Create.Response.of_json resp_json with
1441 | Ok resp -> (creation_id, resp) :: acc
1442 | Error _ -> failwith ("Invalid created response for: " ^ creation_id)
1443 ) [] created_assoc
1444 | _ -> failwith "Expected object or null for created"
1445 in
1446 let updated = match json |> member "updated" with
1447 | `Null -> []
1448 | `Assoc updated_assoc ->
1449 List.fold_left (fun acc (id, resp_json) ->
1450 match Update.Response.of_json resp_json with
1451 | Ok resp ->
1452 let id_t = match Jmap.Id.of_string id with
1453 | Ok id_val -> id_val
1454 | Error e -> failwith ("Invalid updated ID: " ^ id ^ " - " ^ e)
1455 in
1456 (id_t, resp) :: acc
1457 | Error _ -> failwith ("Invalid updated response for: " ^ id)
1458 ) [] updated_assoc
1459 | _ -> failwith "Expected object or null for updated"
1460 in
1461 let destroyed = match json |> member "destroyed" with
1462 | `Null -> []
1463 | `List destroyed_list -> List.map (fun id_json ->
1464 let id_str = to_string id_json in
1465 match Jmap.Id.of_string id_str with
1466 | Ok id -> id
1467 | Error e -> failwith ("Invalid destroyed ID: " ^ id_str ^ " - " ^ e)
1468 ) destroyed_list
1469 | _ -> failwith "Expected array or null for destroyed"
1470 in
1471 let not_created = match json |> member "notCreated" with
1472 | `Null -> []
1473 | `Assoc not_created_assoc ->
1474 List.fold_left (fun acc (creation_id, error_json) ->
1475 match Jmap.Error.Set_error.of_json error_json with
1476 | Ok error -> (creation_id, error) :: acc
1477 | Error _ -> failwith ("Invalid notCreated error for: " ^ creation_id)
1478 ) [] not_created_assoc
1479 | _ -> failwith "Expected object or null for notCreated"
1480 in
1481 let not_updated = match json |> member "notUpdated" with
1482 | `Null -> []
1483 | `Assoc not_updated_assoc ->
1484 List.fold_left (fun acc (id, error_json) ->
1485 match Jmap.Error.Set_error.of_json error_json with
1486 | Ok error ->
1487 let id_t = match Jmap.Id.of_string id with
1488 | Ok id_val -> id_val
1489 | Error e -> failwith ("Invalid notUpdated ID: " ^ id ^ " - " ^ e)
1490 in
1491 (id_t, error) :: acc
1492 | Error _ -> failwith ("Invalid notUpdated error for: " ^ id)
1493 ) [] not_updated_assoc
1494 | _ -> failwith "Expected object or null for notUpdated"
1495 in
1496 let not_destroyed = match json |> member "notDestroyed" with
1497 | `Null -> []
1498 | `Assoc not_destroyed_assoc ->
1499 List.fold_left (fun acc (id, error_json) ->
1500 match Jmap.Error.Set_error.of_json error_json with
1501 | Ok error ->
1502 let id_t = match Jmap.Id.of_string id with
1503 | Ok id_val -> id_val
1504 | Error e -> failwith ("Invalid notDestroyed ID: " ^ id ^ " - " ^ e)
1505 in
1506 (id_t, error) :: acc
1507 | Error _ -> failwith ("Invalid notDestroyed error for: " ^ id)
1508 ) [] not_destroyed_assoc
1509 | _ -> failwith "Expected object or null for notDestroyed"
1510 in
1511 Ok {
1512 account_id;
1513 old_state;
1514 new_state;
1515 created = List.rev created;
1516 updated = List.rev updated;
1517 destroyed;
1518 not_created = List.rev not_created;
1519 not_updated = List.rev not_updated;
1520 not_destroyed = List.rev not_destroyed;
1521 }
1522 with
1523 | Yojson.Safe.Util.Type_error (msg, _) -> Error ("Set_response JSON parse error: " ^ msg)
1524 | Failure msg -> Error ("Set_response JSON parse error: " ^ msg)
1525 | exn -> Error ("Set_response JSON parse error: " ^ Printexc.to_string exn)
1526
1527 let pp fmt t =
1528 Format.fprintf fmt "Mailbox.Set_response{account=%s}" (Jmap.Id.to_string t.account_id)
1529
1530 let pp_hum fmt t = pp fmt t
1531
1532 let state _t = Some "stub-state"
1533
1534 let is_error _t = false
1535end
1536
1537module Changes_args = struct
1538 type t = {
1539 account_id : Jmap.Id.t;
1540 since_state : string;
1541 max_changes : Jmap.UInt.t option;
1542 }
1543
1544 let create ~account_id ~since_state ?max_changes () =
1545 Ok { account_id; since_state; max_changes }
1546
1547 let account_id args = args.account_id
1548 let since_state args = args.since_state
1549 let max_changes args = args.max_changes
1550
1551 (** Serialize Mailbox/changes arguments to JSON.
1552
1553 Follows the standard JMAP changes arguments format from
1554 {{:https://www.rfc-editor.org/rfc/rfc8620.html#section-5.2}RFC 8620 Section 5.2}.
1555
1556 @param args The changes arguments to serialize
1557 @return JSON object with accountId, sinceState, and optional maxChanges *)
1558 let to_json args =
1559 let base = [
1560 ("accountId", `String (Jmap.Id.to_string args.account_id));
1561 ("sinceState", `String args.since_state);
1562 ] in
1563 let base = match args.max_changes with
1564 | None -> base
1565 | Some max_changes -> ("maxChanges", `Int (Jmap.UInt.to_int max_changes)) :: base
1566 in
1567 `Assoc base
1568
1569 (** Parse Mailbox/changes arguments from JSON.
1570
1571 Extracts standard JMAP changes arguments from JSON as defined in
1572 {{:https://www.rfc-editor.org/rfc/rfc8620.html#section-5.2}RFC 8620 Section 5.2}.
1573
1574 @param json JSON object containing changes arguments
1575 @return Result with parsed changes arguments or error message *)
1576 let of_json json =
1577 try
1578 let open Yojson.Safe.Util in
1579 let account_id_str = json |> member "accountId" |> to_string in
1580 let account_id = match Jmap.Id.of_string account_id_str with
1581 | Ok id -> id
1582 | Error e -> failwith ("Invalid account ID: " ^ e)
1583 in
1584 let since_state = json |> member "sinceState" |> to_string in
1585 let max_changes = json |> member "maxChanges" |> to_int_option |>
1586 Option.map (fun i -> match Jmap.UInt.of_int i with
1587 | Ok u -> u
1588 | Error e -> failwith ("Invalid maxChanges: " ^ e)) in
1589 Ok { account_id; since_state; max_changes }
1590 with
1591 | Yojson.Safe.Util.Type_error (msg, _) -> Error ("Changes_args JSON parse error: " ^ msg)
1592 | exn -> Error ("Changes_args JSON parse error: " ^ Printexc.to_string exn)
1593
1594 let pp fmt t =
1595 Format.fprintf fmt "Mailbox.Changes_args{account=%s}" (Jmap.Id.to_string t.account_id)
1596
1597 let pp_hum fmt t = pp fmt t
1598
1599 let validate _t = Ok ()
1600
1601 let method_name () = method_to_string `Mailbox_changes
1602end
1603
1604module Changes_response = struct
1605 type t = {
1606 account_id : Jmap.Id.t;
1607 old_state : string;
1608 new_state : string;
1609 has_more_changes : bool;
1610 created : Jmap.Id.t list;
1611 updated : Jmap.Id.t list;
1612 destroyed : Jmap.Id.t list;
1613 }
1614
1615 let account_id resp = resp.account_id
1616 let old_state resp = resp.old_state
1617 let new_state resp = resp.new_state
1618 let has_more_changes resp = resp.has_more_changes
1619 let created resp = resp.created
1620 let updated resp = resp.updated
1621 let destroyed resp = resp.destroyed
1622
1623 (** Serialize Mailbox/changes response to JSON.
1624
1625 Follows the standard JMAP changes response format from
1626 {{:https://www.rfc-editor.org/rfc/rfc8620.html#section-5.2}RFC 8620 Section 5.2}.
1627
1628 @param resp The changes response to serialize
1629 @return JSON object with accountId, states, hasMoreChanges, and change arrays *)
1630 let to_json resp =
1631 `Assoc [
1632 ("accountId", `String (Jmap.Id.to_string resp.account_id));
1633 ("oldState", `String resp.old_state);
1634 ("newState", `String resp.new_state);
1635 ("hasMoreChanges", `Bool resp.has_more_changes);
1636 ("created", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) resp.created));
1637 ("updated", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) resp.updated));
1638 ("destroyed", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) resp.destroyed));
1639 ]
1640
1641 (** Parse Mailbox/changes response from JSON.
1642
1643 Extracts standard JMAP changes response fields from JSON as defined in
1644 {{:https://www.rfc-editor.org/rfc/rfc8620.html#section-5.2}RFC 8620 Section 5.2}.
1645
1646 @param json JSON object containing changes response
1647 @return Result with parsed changes response or error message *)
1648 let of_json json =
1649 try
1650 let open Yojson.Safe.Util in
1651 let account_id_str = json |> member "accountId" |> to_string in
1652 let account_id = match Jmap.Id.of_string account_id_str with
1653 | Ok id -> id
1654 | Error e -> failwith ("Invalid account ID: " ^ e)
1655 in
1656 let old_state = json |> member "oldState" |> to_string in
1657 let new_state = json |> member "newState" |> to_string in
1658 let has_more_changes = json |> member "hasMoreChanges" |> to_bool in
1659 let created = json |> member "created" |> to_list |> List.map (fun id_json ->
1660 let id_str = to_string id_json in
1661 match Jmap.Id.of_string id_str with
1662 | Ok id -> id
1663 | Error e -> failwith ("Invalid created ID: " ^ id_str ^ " - " ^ e)
1664 ) in
1665 let updated = json |> member "updated" |> to_list |> List.map (fun id_json ->
1666 let id_str = to_string id_json in
1667 match Jmap.Id.of_string id_str with
1668 | Ok id -> id
1669 | Error e -> failwith ("Invalid updated ID: " ^ id_str ^ " - " ^ e)
1670 ) in
1671 let destroyed = json |> member "destroyed" |> to_list |> List.map (fun id_json ->
1672 let id_str = to_string id_json in
1673 match Jmap.Id.of_string id_str with
1674 | Ok id -> id
1675 | Error e -> failwith ("Invalid destroyed ID: " ^ id_str ^ " - " ^ e)
1676 ) in
1677 Ok {
1678 account_id;
1679 old_state;
1680 new_state;
1681 has_more_changes;
1682 created;
1683 updated;
1684 destroyed;
1685 }
1686 with
1687 | Yojson.Safe.Util.Type_error (msg, _) -> Error ("Changes_response JSON parse error: " ^ msg)
1688 | exn -> Error ("Changes_response JSON parse error: " ^ Printexc.to_string exn)
1689
1690 let pp fmt t =
1691 Format.fprintf fmt "Mailbox.Changes_response{account=%s}" (Jmap.Id.to_string t.account_id)
1692
1693 let pp_hum fmt t = pp fmt t
1694
1695 let state _t = Some "stub-state"
1696
1697 let is_error _t = false
1698end
1699
1700(* JSON serialization for main mailbox type *)
1701let to_json mailbox =
1702 let base = [
1703 ("id", `String (Jmap.Id.to_string mailbox.mailbox_id));
1704 ("name", `String mailbox.name);
1705 ("sortOrder", `Int (Jmap.UInt.to_int mailbox.sort_order));
1706 ("totalEmails", `Int (Jmap.UInt.to_int mailbox.total_emails));
1707 ("unreadEmails", `Int (Jmap.UInt.to_int mailbox.unread_emails));
1708 ("totalThreads", `Int (Jmap.UInt.to_int mailbox.total_threads));
1709 ("unreadThreads", `Int (Jmap.UInt.to_int mailbox.unread_threads));
1710 ("myRights", Rights.to_json mailbox.my_rights);
1711 ("isSubscribed", `Bool mailbox.is_subscribed);
1712 ] in
1713 let base = match mailbox.parent_id with
1714 | Some pid -> ("parentId", `String (Jmap.Id.to_string pid)) :: base
1715 | None -> base
1716 in
1717 let base = match mailbox.role with
1718 | Some r -> ("role", Role.to_json r) :: base
1719 | None -> base
1720 in
1721 let base = match mailbox.shared_with with
1722 | Some accounts -> ("sharedWith", `List (List.map sharing_account_to_json accounts)) :: base
1723 | None -> base
1724 in
1725 `Assoc base
1726
1727let of_json json =
1728 try
1729 let open Yojson.Safe.Util in
1730 let id_str = json |> member "id" |> to_string in
1731 let id = match Jmap.Id.of_string id_str with
1732 | Ok id_val -> id_val
1733 | Error e -> failwith ("Invalid mailbox ID: " ^ id_str ^ " - " ^ e)
1734 in
1735 let name = json |> member "name" |> to_string in
1736 let parent_id = json |> member "parentId" |> to_string_option |>
1737 Option.map (fun pid_str -> match Jmap.Id.of_string pid_str with
1738 | Ok pid -> pid
1739 | Error e -> failwith ("Invalid parentId: " ^ pid_str ^ " - " ^ e)) in
1740 let role_opt : (role option, string) result = match json |> member "role" with
1741 | `Null -> Ok None
1742 | role_json ->
1743 match Role.of_json role_json with
1744 | Ok r -> Ok (Some r)
1745 | Error e -> Error e
1746 in
1747 let sort_order = json |> member "sortOrder" |> to_int |> (fun i ->
1748 match Jmap.UInt.of_int i with
1749 | Ok u -> u
1750 | Error e -> failwith ("Invalid sortOrder: " ^ e)) in
1751 let total_emails = json |> member "totalEmails" |> to_int |> (fun i ->
1752 match Jmap.UInt.of_int i with
1753 | Ok u -> u
1754 | Error e -> failwith ("Invalid totalEmails: " ^ e)) in
1755 let unread_emails = json |> member "unreadEmails" |> to_int |> (fun i ->
1756 match Jmap.UInt.of_int i with
1757 | Ok u -> u
1758 | Error e -> failwith ("Invalid unreadEmails: " ^ e)) in
1759 let total_threads = json |> member "totalThreads" |> to_int |> (fun i ->
1760 match Jmap.UInt.of_int i with
1761 | Ok u -> u
1762 | Error e -> failwith ("Invalid totalThreads: " ^ e)) in
1763 let unread_threads = json |> member "unreadThreads" |> to_int |> (fun i ->
1764 match Jmap.UInt.of_int i with
1765 | Ok u -> u
1766 | Error e -> failwith ("Invalid unreadThreads: " ^ e)) in
1767 let my_rights_result = json |> member "myRights" |> Rights.of_json in
1768 let is_subscribed = json |> member "isSubscribed" |> to_bool in
1769 let shared_with_result = match json |> member "sharedWith" with
1770 | `Null -> Ok None
1771 | `List json_list ->
1772 let rec parse_accounts acc = function
1773 | [] -> Ok (List.rev acc)
1774 | json :: rest ->
1775 (match sharing_account_of_json json with
1776 | Ok account -> parse_accounts (account :: acc) rest
1777 | Error e -> Error e)
1778 in
1779 parse_accounts [] json_list |> Result.map (fun accounts -> Some accounts)
1780 | _ -> Error "sharedWith must be null or array"
1781 in
1782 match role_opt, my_rights_result, shared_with_result with
1783 | Ok role, Ok my_rights, Ok shared_with ->
1784 create_full ~id ~name ?parent_id ?role ~sort_order ~total_emails
1785 ~unread_emails ~total_threads ~unread_threads ~my_rights ~is_subscribed ?shared_with ()
1786 | Error e, _, _ -> Error e
1787 | _, Error e, _ -> Error e
1788 | _, _, Error e -> Error e
1789 with
1790 | Yojson.Safe.Util.Type_error (msg, _) -> Error ("Mailbox JSON parse error: " ^ msg)
1791 | exn -> Error ("Mailbox JSON parse error: " ^ Printexc.to_string exn)
1792
1793(* PRINTABLE implementation *)
1794let pp fmt mailbox =
1795 let role_str = match mailbox.role with
1796 | Some r -> Role.to_string r
1797 | None -> "none"
1798 in
1799 Format.fprintf fmt "Mailbox{Jmap.Id.t=%s; name=%s; role=%s; total=%d}"
1800 (Jmap.Id.to_string mailbox.mailbox_id)
1801 mailbox.name
1802 role_str
1803 (Jmap.UInt.to_int mailbox.total_emails)
1804
1805let pp_hum fmt mailbox =
1806 let role_str = match mailbox.role with
1807 | Some r -> Role.to_string r
1808 | None -> "none"
1809 in
1810 let parent_str = match mailbox.parent_id with
1811 | Some pid -> Printf.sprintf " (parent: %s)" (Jmap.Id.to_string pid)
1812 | None -> ""
1813 in
1814 Format.fprintf fmt "Mailbox \"%s\" [%s]: %d emails (%d unread), %d threads (%d unread)%s"
1815 mailbox.name
1816 role_str
1817 (Jmap.UInt.to_int mailbox.total_emails)
1818 (Jmap.UInt.to_int mailbox.unread_emails)
1819 (Jmap.UInt.to_int mailbox.total_threads)
1820 (Jmap.UInt.to_int mailbox.unread_threads)
1821 parent_str
1822
1823(* Filter construction helpers *)
1824let filter_has_role role =
1825 Filter.property_equals "role" (Role.to_json role)
1826
1827let filter_has_no_role () =
1828 Filter.property_equals "role" `Null
1829
1830let filter_has_parent parent_id =
1831 Filter.property_equals "parentId" (`String (Jmap.Id.to_string parent_id))
1832
1833let filter_is_root () =
1834 Filter.property_equals "parentId" `Null
1835
1836let filter_is_subscribed () =
1837 Filter.property_equals "isSubscribed" (`Bool true)
1838
1839let filter_is_not_subscribed () =
1840 Filter.property_equals "isSubscribed" (`Bool false)
1841
1842let filter_name_contains name =
1843 Filter.text_contains "name" name