My agentic slop goes here. Not intended for anyone else!
anil.recoil.org
1(** JMAP Mailbox Type
2
3 A Mailbox represents a named set of emails. Mailboxes can be hierarchical,
4 with a tree structure defined by the parentId property.
5
6open Jmap_core
7
8 Reference: RFC 8621 Section 2 (Mailboxes)
9 Test files:
10 - test/data/mail/mailbox_get_request.json
11 - test/data/mail/mailbox_get_response.json
12 - test/data/mail/mailbox_query_request.json
13 - test/data/mail/mailbox_query_response.json
14 - test/data/mail/mailbox_set_request.json
15 - test/data/mail/mailbox_set_response.json
16*)
17
18(** Mailbox access rights (RFC 8621 Section 2.1) *)
19module Rights = struct
20 type t = {
21 may_read_items : bool; (** User may fetch and read emails in this mailbox *)
22 may_add_items : bool; (** User may add mailboxIds for emails to this mailbox *)
23 may_remove_items : bool; (** User may remove mailboxIds for emails from this mailbox *)
24 may_set_seen : bool; (** User may modify $seen keyword on emails in this mailbox *)
25 may_set_keywords : bool; (** User may modify keywords (except $seen) on emails in this mailbox *)
26 may_create_child : bool; (** User may create a mailbox with this mailbox as parent *)
27 may_rename : bool; (** User may rename this mailbox *)
28 may_delete : bool; (** User may delete this mailbox *)
29 may_submit : bool; (** User may use this mailbox as source for EmailSubmission *)
30 }
31
32 (** Parse Rights from JSON.
33 Test files: test/data/mail/mailbox_get_response.json (myRights field)
34
35 Expected JSON structure:
36 {
37 "mayReadItems": true,
38 "mayAddItems": true,
39 "mayRemoveItems": true,
40 "maySetSeen": true,
41 "maySetKeywords": true,
42 "mayCreateChild": true,
43 "mayRename": false,
44 "mayDelete": false,
45 "maySubmit": true
46 }
47 *)
48 let of_json json =
49 let open Jmap_core.Parser.Helpers in
50 let fields = expect_object json in
51 {
52 may_read_items = get_bool "mayReadItems" fields;
53 may_add_items = get_bool "mayAddItems" fields;
54 may_remove_items = get_bool "mayRemoveItems" fields;
55 may_set_seen = get_bool "maySetSeen" fields;
56 may_set_keywords = get_bool "maySetKeywords" fields;
57 may_create_child = get_bool "mayCreateChild" fields;
58 may_rename = get_bool "mayRename" fields;
59 may_delete = get_bool "mayDelete" fields;
60 may_submit = get_bool "maySubmit" fields;
61 }
62
63 let to_json t =
64 `O [
65 ("mayReadItems", `Bool t.may_read_items);
66 ("mayAddItems", `Bool t.may_add_items);
67 ("mayRemoveItems", `Bool t.may_remove_items);
68 ("maySetSeen", `Bool t.may_set_seen);
69 ("maySetKeywords", `Bool t.may_set_keywords);
70 ("mayCreateChild", `Bool t.may_create_child);
71 ("mayRename", `Bool t.may_rename);
72 ("mayDelete", `Bool t.may_delete);
73 ("maySubmit", `Bool t.may_submit);
74 ]
75
76 (* Accessors *)
77 let may_read_items t = t.may_read_items
78 let may_add_items t = t.may_add_items
79 let may_remove_items t = t.may_remove_items
80 let may_set_seen t = t.may_set_seen
81 let may_set_keywords t = t.may_set_keywords
82 let may_create_child t = t.may_create_child
83 let may_rename t = t.may_rename
84 let may_delete t = t.may_delete
85 let may_submit t = t.may_submit
86
87 (* Constructor *)
88 let v ~may_read_items ~may_add_items ~may_remove_items ~may_set_seen
89 ~may_set_keywords ~may_create_child ~may_rename ~may_delete ~may_submit =
90 { may_read_items; may_add_items; may_remove_items; may_set_seen;
91 may_set_keywords; may_create_child; may_rename; may_delete; may_submit }
92end
93
94(** Mailbox object type *)
95type t = {
96 id : Jmap_core.Id.t; (** Immutable server-assigned id *)
97 name : string; (** User-visible mailbox name *)
98 parent_id : Jmap_core.Id.t option; (** Parent mailbox id (null for top-level) *)
99 role : string option; (** Standard role (inbox, trash, sent, etc.) *)
100 sort_order : Jmap_core.Primitives.UnsignedInt.t; (** Sort order for display *)
101 total_emails : Jmap_core.Primitives.UnsignedInt.t; (** Total number of emails in mailbox *)
102 unread_emails : Jmap_core.Primitives.UnsignedInt.t; (** Number of emails without $seen keyword *)
103 total_threads : Jmap_core.Primitives.UnsignedInt.t; (** Total number of threads with emails in mailbox *)
104 unread_threads : Jmap_core.Primitives.UnsignedInt.t; (** Number of threads with unread emails in mailbox *)
105 my_rights : Rights.t; (** Current user's access rights *)
106 is_subscribed : bool; (** Whether user is subscribed to this mailbox *)
107}
108
109(** Accessors *)
110let id t = t.id
111let name t = t.name
112let parent_id t = t.parent_id
113let role t = t.role
114let sort_order t = t.sort_order
115let total_emails t = t.total_emails
116let unread_emails t = t.unread_emails
117let total_threads t = t.total_threads
118let unread_threads t = t.unread_threads
119let my_rights t = t.my_rights
120let is_subscribed t = t.is_subscribed
121
122(** Constructor *)
123let v ~id ~name ?parent_id ?role ~sort_order ~total_emails ~unread_emails
124 ~total_threads ~unread_threads ~my_rights ~is_subscribed () =
125 { id; name; parent_id; role; sort_order; total_emails; unread_emails;
126 total_threads; unread_threads; my_rights; is_subscribed }
127
128(** Parser submodule *)
129module Parser = struct
130 (** Parse Mailbox from JSON.
131 Test files: test/data/mail/mailbox_get_response.json (list field)
132
133 Expected structure:
134 {
135 "id": "mb001",
136 "name": "INBOX",
137 "parentId": null,
138 "role": "inbox",
139 "sortOrder": 10,
140 "totalEmails": 1523,
141 "unreadEmails": 42,
142 "totalThreads": 987,
143 "unreadThreads": 35,
144 "myRights": { ... },
145 "isSubscribed": true
146 }
147 *)
148 let of_json json =
149 let open Jmap_core.Parser.Helpers in
150 let fields = expect_object json in
151 let id = Jmap_core.Id.of_json (require_field "id" fields) in
152 let name = get_string "name" fields in
153 let parent_id = match find_field "parentId" fields with
154 | Some `Null | None -> None
155 | Some v -> Some (Jmap_core.Id.of_json v)
156 in
157 let role = match find_field "role" fields with
158 | Some `Null | None -> None
159 | Some (`String s) -> Some s
160 | Some _ -> raise (Jmap_core.Error.Parse_error "role must be a string or null")
161 in
162 let sort_order = Jmap_core.Primitives.UnsignedInt.of_json (require_field "sortOrder" fields) in
163 let total_emails = Jmap_core.Primitives.UnsignedInt.of_json (require_field "totalEmails" fields) in
164 let unread_emails = Jmap_core.Primitives.UnsignedInt.of_json (require_field "unreadEmails" fields) in
165 let total_threads = Jmap_core.Primitives.UnsignedInt.of_json (require_field "totalThreads" fields) in
166 let unread_threads = Jmap_core.Primitives.UnsignedInt.of_json (require_field "unreadThreads" fields) in
167 let my_rights = Rights.of_json (require_field "myRights" fields) in
168 let is_subscribed = get_bool "isSubscribed" fields in
169 { id; name; parent_id; role; sort_order; total_emails; unread_emails;
170 total_threads; unread_threads; my_rights; is_subscribed }
171
172 let to_json t =
173 let fields = [
174 ("id", Jmap_core.Id.to_json t.id);
175 ("name", `String t.name);
176 ("sortOrder", Jmap_core.Primitives.UnsignedInt.to_json t.sort_order);
177 ("totalEmails", Jmap_core.Primitives.UnsignedInt.to_json t.total_emails);
178 ("unreadEmails", Jmap_core.Primitives.UnsignedInt.to_json t.unread_emails);
179 ("totalThreads", Jmap_core.Primitives.UnsignedInt.to_json t.total_threads);
180 ("unreadThreads", Jmap_core.Primitives.UnsignedInt.to_json t.unread_threads);
181 ("myRights", Rights.to_json t.my_rights);
182 ("isSubscribed", `Bool t.is_subscribed);
183 ] in
184 let fields = match t.parent_id with
185 | Some pid -> ("parentId", Jmap_core.Id.to_json pid) :: fields
186 | None -> ("parentId", `Null) :: fields
187 in
188 let fields = match t.role with
189 | Some r -> ("role", `String r) :: fields
190 | None -> ("role", `Null) :: fields
191 in
192 `O fields
193end
194
195(** Standard /get method (RFC 8621 Section 2.2) *)
196module Get = struct
197 type request = t Jmap_core.Standard_methods.Get.request
198 type response = t Jmap_core.Standard_methods.Get.response
199
200 (** Constructor for request *)
201 let request_v = Jmap_core.Standard_methods.Get.v
202
203 (** Convert request to JSON *)
204 let request_to_json = Jmap_core.Standard_methods.Get.request_to_json
205
206 (** Parse get request from JSON *)
207 let request_of_json json =
208 Jmap_core.Standard_methods.Get.request_of_json Parser.of_json json
209
210 (** Parse get response from JSON *)
211 let response_of_json json =
212 Jmap_core.Standard_methods.Get.response_of_json Parser.of_json json
213end
214
215(** Standard /changes method (RFC 8621 Section 2.3) *)
216module Changes = struct
217 type request = Jmap_core.Standard_methods.Changes.request
218 type response = Jmap_core.Standard_methods.Changes.response
219
220 let request_of_json json =
221 Jmap_core.Standard_methods.Changes.request_of_json json
222
223 let response_of_json json =
224 Jmap_core.Standard_methods.Changes.response_of_json json
225end
226
227(** Mailbox-specific filter for /query (RFC 8621 Section 2.5) *)
228module Filter = struct
229 type t = {
230 parent_id : Jmap_core.Id.t option; (** Mailbox parentId equals this value *)
231 name : string option; (** Name contains this string (case-insensitive) *)
232 role : string option; (** Role equals this value *)
233 has_any_role : bool option; (** Has any role assigned (true) or no role (false) *)
234 is_subscribed : bool option; (** isSubscribed equals this value *)
235 }
236
237 let of_json json =
238 let open Jmap_core.Parser.Helpers in
239 let fields = expect_object json in
240 let parent_id = match find_field "parentId" fields with
241 | Some `Null -> Some None (* Explicitly filter for null parent *)
242 | Some v -> Some (Some (Jmap_core.Id.of_json v))
243 | None -> None (* Don't filter on parentId *)
244 in
245 let name = get_string_opt "name" fields in
246 let role = get_string_opt "role" fields in
247 let has_any_role = match find_field "hasAnyRole" fields with
248 | Some (`Bool b) -> Some b
249 | Some _ -> raise (Jmap_core.Error.Parse_error "hasAnyRole must be a boolean")
250 | None -> None
251 in
252 let is_subscribed = match find_field "isSubscribed" fields with
253 | Some (`Bool b) -> Some b
254 | Some _ -> raise (Jmap_core.Error.Parse_error "isSubscribed must be a boolean")
255 | None -> None
256 in
257 (* Note: parent_id has special handling - None means don't filter,
258 Some None means filter for null, Some (Some id) means filter for that id *)
259 let parent_id_simple = match parent_id with
260 | Some (Some id) -> Some id
261 | _ -> None (* We'll need to handle the "null" case specially in actual filtering *)
262 in
263 { parent_id = parent_id_simple; name; role; has_any_role; is_subscribed }
264
265 (* Accessors *)
266 let parent_id t = t.parent_id
267 let name t = t.name
268 let role t = t.role
269 let has_any_role t = t.has_any_role
270 let is_subscribed t = t.is_subscribed
271
272 (* Constructor *)
273 let v ?parent_id ?name ?role ?has_any_role ?is_subscribed () =
274 { parent_id; name; role; has_any_role; is_subscribed }
275
276 (* Convert to JSON *)
277 let to_json t =
278 let fields = [] in
279 let fields = match t.parent_id with
280 | Some id -> ("parentId", Jmap_core.Id.to_json id) :: fields
281 | None -> fields
282 in
283 let fields = match t.name with
284 | Some n -> ("name", `String n) :: fields
285 | None -> fields
286 in
287 let fields = match t.role with
288 | Some r -> ("role", `String r) :: fields
289 | None -> fields
290 in
291 let fields = match t.has_any_role with
292 | Some har -> ("hasAnyRole", `Bool har) :: fields
293 | None -> fields
294 in
295 let fields = match t.is_subscribed with
296 | Some is -> ("isSubscribed", `Bool is) :: fields
297 | None -> fields
298 in
299 `O fields
300end
301
302(** Standard /query method with Mailbox-specific extensions (RFC 8621 Section 2.5) *)
303module Query = struct
304 type request = {
305 account_id : Jmap_core.Id.t;
306 filter : Filter.t Jmap_core.Filter.t option;
307 sort : Jmap_core.Comparator.t list option;
308 position : Jmap_core.Primitives.Int53.t option;
309 anchor : Jmap_core.Id.t option;
310 anchor_offset : Jmap_core.Primitives.Int53.t option;
311 limit : Jmap_core.Primitives.UnsignedInt.t option;
312 calculate_total : bool option;
313 (* Mailbox-specific query arguments *)
314 sort_as_tree : bool option; (** Return results in tree order *)
315 filter_as_tree : bool option; (** If true, apply filter to tree roots and return descendants *)
316 }
317
318 type response = Jmap_core.Standard_methods.Query.response
319
320 (* Accessors for request *)
321 let account_id req = req.account_id
322 let filter req = req.filter
323 let sort req = req.sort
324 let position req = req.position
325 let anchor req = req.anchor
326 let anchor_offset req = req.anchor_offset
327 let limit req = req.limit
328 let calculate_total req = req.calculate_total
329 let sort_as_tree req = req.sort_as_tree
330 let filter_as_tree req = req.filter_as_tree
331
332 (* Constructor for request *)
333 let request_v ~account_id ?filter ?sort ?position ?anchor ?anchor_offset
334 ?limit ?calculate_total ?sort_as_tree ?filter_as_tree () =
335 { account_id; filter; sort; position; anchor; anchor_offset;
336 limit; calculate_total; sort_as_tree; filter_as_tree }
337
338 (** Parse query request from JSON.
339 Test files: test/data/mail/mailbox_query_request.json *)
340 let request_of_json json =
341 let open Jmap_core.Parser.Helpers in
342 let fields = expect_object json in
343 let account_id = Jmap_core.Id.of_json (require_field "accountId" fields) in
344 let filter = match find_field "filter" fields with
345 | Some v -> Some (Jmap_core.Filter.of_json Filter.of_json v)
346 | None -> None
347 in
348 let sort = match find_field "sort" fields with
349 | Some v -> Some (parse_array Jmap_core.Comparator.of_json v)
350 | None -> None
351 in
352 let position = match find_field "position" fields with
353 | Some v -> Some (Jmap_core.Primitives.Int53.of_json v)
354 | None -> None
355 in
356 let anchor = match find_field "anchor" fields with
357 | Some v -> Some (Jmap_core.Id.of_json v)
358 | None -> None
359 in
360 let anchor_offset = match find_field "anchorOffset" fields with
361 | Some v -> Some (Jmap_core.Primitives.Int53.of_json v)
362 | None -> None
363 in
364 let limit = match find_field "limit" fields with
365 | Some v -> Some (Jmap_core.Primitives.UnsignedInt.of_json v)
366 | None -> None
367 in
368 let calculate_total = match find_field "calculateTotal" fields with
369 | Some (`Bool b) -> Some b
370 | Some _ -> raise (Jmap_core.Error.Parse_error "calculateTotal must be a boolean")
371 | None -> None
372 in
373 let sort_as_tree = match find_field "sortAsTree" fields with
374 | Some (`Bool b) -> Some b
375 | Some _ -> raise (Jmap_core.Error.Parse_error "sortAsTree must be a boolean")
376 | None -> None
377 in
378 let filter_as_tree = match find_field "filterAsTree" fields with
379 | Some (`Bool b) -> Some b
380 | Some _ -> raise (Jmap_core.Error.Parse_error "filterAsTree must be a boolean")
381 | None -> None
382 in
383 { account_id; filter; sort; position; anchor; anchor_offset; limit;
384 calculate_total; sort_as_tree; filter_as_tree }
385
386 (** Convert query request to JSON *)
387 let request_to_json req =
388 let fields = [
389 ("accountId", Jmap_core.Id.to_json req.account_id);
390 ] in
391 let fields = match req.filter with
392 | Some f -> ("filter", Jmap_core.Filter.to_json Filter.to_json f) :: fields
393 | None -> fields
394 in
395 let fields = match req.sort with
396 | Some s -> ("sort", `A (List.map Jmap_core.Comparator.to_json s)) :: fields
397 | None -> fields
398 in
399 let fields = match req.position with
400 | Some p -> ("position", Jmap_core.Primitives.Int53.to_json p) :: fields
401 | None -> fields
402 in
403 let fields = match req.anchor with
404 | Some a -> ("anchor", Jmap_core.Id.to_json a) :: fields
405 | None -> fields
406 in
407 let fields = match req.anchor_offset with
408 | Some ao -> ("anchorOffset", Jmap_core.Primitives.Int53.to_json ao) :: fields
409 | None -> fields
410 in
411 let fields = match req.limit with
412 | Some l -> ("limit", Jmap_core.Primitives.UnsignedInt.to_json l) :: fields
413 | None -> fields
414 in
415 let fields = match req.calculate_total with
416 | Some ct -> ("calculateTotal", `Bool ct) :: fields
417 | None -> fields
418 in
419 let fields = match req.sort_as_tree with
420 | Some sat -> ("sortAsTree", `Bool sat) :: fields
421 | None -> fields
422 in
423 let fields = match req.filter_as_tree with
424 | Some fat -> ("filterAsTree", `Bool fat) :: fields
425 | None -> fields
426 in
427 `O fields
428
429 (** Parse query response from JSON.
430 Test files: test/data/mail/mailbox_query_response.json *)
431 let response_of_json json =
432 Jmap_core.Standard_methods.Query.response_of_json json
433end
434
435(** Standard /queryChanges method (RFC 8621 Section 2.6) *)
436module QueryChanges = struct
437 type request = Filter.t Jmap_core.Standard_methods.QueryChanges.request
438 type response = Jmap_core.Standard_methods.QueryChanges.response
439
440 let request_of_json json =
441 Jmap_core.Standard_methods.QueryChanges.request_of_json Filter.of_json json
442
443 let response_of_json json =
444 Jmap_core.Standard_methods.QueryChanges.response_of_json json
445end
446
447(** Standard /set method (RFC 8621 Section 2.4) *)
448module Set = struct
449 type request = t Jmap_core.Standard_methods.Set.request
450 type response = t Jmap_core.Standard_methods.Set.response
451
452 (** Parse set request from JSON.
453 Test files: test/data/mail/mailbox_set_request.json *)
454 let request_of_json json =
455 Jmap_core.Standard_methods.Set.request_of_json Parser.of_json json
456
457 (** Parse set response from JSON.
458 Test files: test/data/mail/mailbox_set_response.json *)
459 let response_of_json json =
460 Jmap_core.Standard_methods.Set.response_of_json Parser.of_json json
461end
462
463(** Standard mailbox role values (RFC 8621 Section 2.1) *)
464module Role = struct
465 let inbox = "inbox" (* Messages delivered to this account by default *)
466 let archive = "archive" (* Messages the user has archived *)
467 let drafts = "drafts" (* Messages the user is composing *)
468 let sent = "sent" (* Messages the user has sent *)
469 let trash = "trash" (* Messages the user has deleted *)
470 let junk = "junk" (* Spam/junk messages *)
471 let important = "important" (* Messages deemed important by the user *)
472 let all = "all" (* All messages (virtual mailbox) *)
473end