jon.recoil.org
forked from
anil.recoil.org/ocaml-jmap
this repo has no description
1(*---------------------------------------------------------------------------
2 Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3 SPDX-License-Identifier: ISC
4 ---------------------------------------------------------------------------*)
5
6(* Mailbox properties *)
7
8type property = [
9 | `Id
10 | `Name
11 | `Parent_id
12 | `Role
13 | `Sort_order
14 | `Total_emails
15 | `Unread_emails
16 | `Total_threads
17 | `Unread_threads
18 | `My_rights
19 | `Is_subscribed
20]
21
22let property_to_string : [< property ] -> string = function
23 | `Id -> "id"
24 | `Name -> "name"
25 | `Parent_id -> "parentId"
26 | `Role -> "role"
27 | `Sort_order -> "sortOrder"
28 | `Total_emails -> "totalEmails"
29 | `Unread_emails -> "unreadEmails"
30 | `Total_threads -> "totalThreads"
31 | `Unread_threads -> "unreadThreads"
32 | `My_rights -> "myRights"
33 | `Is_subscribed -> "isSubscribed"
34
35let property_of_string s : property option =
36 match s with
37 | "id" -> Some `Id
38 | "name" -> Some `Name
39 | "parentId" -> Some `Parent_id
40 | "role" -> Some `Role
41 | "sortOrder" -> Some `Sort_order
42 | "totalEmails" -> Some `Total_emails
43 | "unreadEmails" -> Some `Unread_emails
44 | "totalThreads" -> Some `Total_threads
45 | "unreadThreads" -> Some `Unread_threads
46 | "myRights" -> Some `My_rights
47 | "isSubscribed" -> Some `Is_subscribed
48 | _ -> None
49
50module Rights = struct
51 type t = {
52 may_read_items : bool;
53 may_add_items : bool;
54 may_remove_items : bool;
55 may_set_seen : bool;
56 may_set_keywords : bool;
57 may_create_child : bool;
58 may_rename : bool;
59 may_delete : bool;
60 may_submit : bool;
61 }
62
63 let may_read_items t = t.may_read_items
64 let may_add_items t = t.may_add_items
65 let may_remove_items t = t.may_remove_items
66 let may_set_seen t = t.may_set_seen
67 let may_set_keywords t = t.may_set_keywords
68 let may_create_child t = t.may_create_child
69 let may_rename t = t.may_rename
70 let may_delete t = t.may_delete
71 let may_submit t = t.may_submit
72
73 let make may_read_items may_add_items may_remove_items may_set_seen
74 may_set_keywords may_create_child may_rename may_delete may_submit =
75 { may_read_items; may_add_items; may_remove_items; may_set_seen;
76 may_set_keywords; may_create_child; may_rename; may_delete; may_submit }
77
78 let jsont =
79 let kind = "MailboxRights" in
80 Jsont.Object.map ~kind make
81 |> Jsont.Object.mem "mayReadItems" Jsont.bool ~enc:may_read_items
82 |> Jsont.Object.mem "mayAddItems" Jsont.bool ~enc:may_add_items
83 |> Jsont.Object.mem "mayRemoveItems" Jsont.bool ~enc:may_remove_items
84 |> Jsont.Object.mem "maySetSeen" Jsont.bool ~enc:may_set_seen
85 |> Jsont.Object.mem "maySetKeywords" Jsont.bool ~enc:may_set_keywords
86 |> Jsont.Object.mem "mayCreateChild" Jsont.bool ~enc:may_create_child
87 |> Jsont.Object.mem "mayRename" Jsont.bool ~enc:may_rename
88 |> Jsont.Object.mem "mayDelete" Jsont.bool ~enc:may_delete
89 |> Jsont.Object.mem "maySubmit" Jsont.bool ~enc:may_submit
90 |> Jsont.Object.finish
91end
92
93type role = [
94 | `All
95 | `Archive
96 | `Drafts
97 | `Flagged
98 | `Important
99 | `Inbox
100 | `Junk
101 | `Sent
102 | `Subscribed
103 | `Trash
104 | `Snoozed
105 | `Scheduled
106 | `Memos
107 | `Other of string
108]
109
110let role_to_string = function
111 | `All -> "all"
112 | `Archive -> "archive"
113 | `Drafts -> "drafts"
114 | `Flagged -> "flagged"
115 | `Important -> "important"
116 | `Inbox -> "inbox"
117 | `Junk -> "junk"
118 | `Sent -> "sent"
119 | `Subscribed -> "subscribed"
120 | `Trash -> "trash"
121 | `Snoozed -> "snoozed"
122 | `Scheduled -> "scheduled"
123 | `Memos -> "memos"
124 | `Other s -> s
125
126let role_of_string = function
127 | "all" -> `All
128 | "archive" -> `Archive
129 | "drafts" -> `Drafts
130 | "flagged" -> `Flagged
131 | "important" -> `Important
132 | "inbox" -> `Inbox
133 | "junk" -> `Junk
134 | "sent" -> `Sent
135 | "subscribed" -> `Subscribed
136 | "trash" -> `Trash
137 | "snoozed" -> `Snoozed
138 | "scheduled" -> `Scheduled
139 | "memos" -> `Memos
140 | s -> `Other s
141
142let role_jsont =
143 Jsont.map ~kind:"MailboxRole"
144 ~dec:(fun s -> role_of_string s)
145 ~enc:role_to_string
146 Jsont.string
147
148(** {1 Conversion to/from mail-flag} *)
149
150let role_of_special_use : Mail_flag.Mailbox_attr.special_use -> role = function
151 | `All -> `All
152 | `Archive -> `Archive
153 | `Drafts -> `Drafts
154 | `Flagged -> `Flagged
155 | `Important -> `Important
156 | `Inbox -> `Inbox
157 | `Junk -> `Junk
158 | `Sent -> `Sent
159 | `Subscribed -> `Subscribed
160 | `Trash -> `Trash
161 | `Snoozed -> `Snoozed
162 | `Scheduled -> `Scheduled
163 | `Memos -> `Memos
164
165let special_use_of_role : role -> Mail_flag.Mailbox_attr.special_use option = function
166 | `All -> Some `All
167 | `Archive -> Some `Archive
168 | `Drafts -> Some `Drafts
169 | `Flagged -> Some `Flagged
170 | `Important -> Some `Important
171 | `Inbox -> Some `Inbox
172 | `Junk -> Some `Junk
173 | `Sent -> Some `Sent
174 | `Subscribed -> Some `Subscribed
175 | `Trash -> Some `Trash
176 | `Snoozed -> Some `Snoozed
177 | `Scheduled -> Some `Scheduled
178 | `Memos -> Some `Memos
179 | `Other _ -> None
180
181type t = {
182 id : Proto_id.t option;
183 name : string option;
184 parent_id : Proto_id.t option;
185 role : role option;
186 sort_order : int64 option;
187 total_emails : int64 option;
188 unread_emails : int64 option;
189 total_threads : int64 option;
190 unread_threads : int64 option;
191 my_rights : Rights.t option;
192 is_subscribed : bool option;
193}
194
195let id t = t.id
196let name t = t.name
197let parent_id t = t.parent_id
198let role t = t.role
199let sort_order t = t.sort_order
200let total_emails t = t.total_emails
201let unread_emails t = t.unread_emails
202let total_threads t = t.total_threads
203let unread_threads t = t.unread_threads
204let my_rights t = t.my_rights
205let is_subscribed t = t.is_subscribed
206
207let make id name parent_id role sort_order total_emails unread_emails
208 total_threads unread_threads my_rights is_subscribed =
209 { id; name; parent_id; role; sort_order; total_emails; unread_emails;
210 total_threads; unread_threads; my_rights; is_subscribed }
211
212let jsont =
213 let kind = "Mailbox" in
214 Jsont.Object.map ~kind make
215 |> Jsont.Object.opt_mem "id" Proto_id.jsont ~enc:id
216 |> Jsont.Object.opt_mem "name" Jsont.string ~enc:name
217 (* parentId can be null meaning top-level, or absent if not requested *)
218 |> Jsont.Object.opt_mem "parentId" Proto_id.jsont ~enc:parent_id
219 (* role can be null meaning no role, or absent if not requested *)
220 |> Jsont.Object.opt_mem "role" role_jsont ~enc:role
221 |> Jsont.Object.opt_mem "sortOrder" Proto_int53.Unsigned.jsont ~enc:sort_order
222 |> Jsont.Object.opt_mem "totalEmails" Proto_int53.Unsigned.jsont ~enc:total_emails
223 |> Jsont.Object.opt_mem "unreadEmails" Proto_int53.Unsigned.jsont ~enc:unread_emails
224 |> Jsont.Object.opt_mem "totalThreads" Proto_int53.Unsigned.jsont ~enc:total_threads
225 |> Jsont.Object.opt_mem "unreadThreads" Proto_int53.Unsigned.jsont ~enc:unread_threads
226 |> Jsont.Object.opt_mem "myRights" Rights.jsont ~enc:my_rights
227 |> Jsont.Object.opt_mem "isSubscribed" Jsont.bool ~enc:is_subscribed
228 |> Jsont.Object.finish
229
230module Filter_condition = struct
231 type t = {
232 parent_id : Proto_id.t option option;
233 name : string option;
234 role : role option option;
235 has_any_role : bool option;
236 is_subscribed : bool option;
237 }
238
239 let make parent_id name role has_any_role is_subscribed =
240 { parent_id; name; role; has_any_role; is_subscribed }
241
242 let jsont =
243 let kind = "MailboxFilterCondition" in
244 (* parentId and role can be absent, null, or have a value - RFC 8621 Section 2.1 *)
245 (* Use opt_mem with Jsont.option to get option option type:
246 - None = field absent (don't filter)
247 - Some None = field present with null (filter for no parent/role)
248 - Some (Some x) = field present with value (filter for specific value) *)
249 let nullable_id = Jsont.(option Proto_id.jsont) in
250 let nullable_role = Jsont.(option role_jsont) in
251 Jsont.Object.map ~kind make
252 |> Jsont.Object.opt_mem "parentId" nullable_id ~enc:(fun f -> f.parent_id)
253 |> Jsont.Object.opt_mem "name" Jsont.string ~enc:(fun f -> f.name)
254 |> Jsont.Object.opt_mem "role" nullable_role ~enc:(fun f -> f.role)
255 |> Jsont.Object.opt_mem "hasAnyRole" Jsont.bool ~enc:(fun f -> f.has_any_role)
256 |> Jsont.Object.opt_mem "isSubscribed" Jsont.bool ~enc:(fun f -> f.is_subscribed)
257 |> Jsont.Object.finish
258end