This repository has no description
1(*---------------------------------------------------------------------------
2 Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3 SPDX-License-Identifier: ISC
4 ---------------------------------------------------------------------------*)
5
6(** Unified JMAP interface for OCaml
7
8 This module provides a clean, ergonomic API for working with JMAP
9 (RFC 8620/8621), combining the protocol and mail layers with abstract
10 types and polymorphic variants.
11
12 {2 Quick Start}
13
14 {[
15 open Jmap
16
17 (* Keywords use polymorphic variants *)
18 let is_unread email =
19 not (List.mem `Seen (Email.keywords email))
20
21 (* Mailbox roles are also polymorphic *)
22 let find_inbox mailboxes =
23 List.find_opt (fun m -> Mailbox.role m = Some `Inbox) mailboxes
24 ]}
25
26 {2 Module Structure}
27
28 - {!Proto} - Low-level protocol and mail types (RFC 8620/8621)
29 - {!Error}, {!Id}, {!Keyword}, {!Role}, {!Capability} - Core types
30 - {!Session}, {!Email}, {!Mailbox}, etc. - Abstract type accessors
31*)
32
33(** {1 Protocol Layer Re-exports} *)
34
35(** Low-level JMAP protocol types (RFC 8620/8621).
36
37 These are the raw protocol and mail types. For most use cases, prefer the
38 higher-level types in this module. *)
39module Proto = Jmap_proto
40
41(** {1 Core Types} *)
42
43(** Unified error type for JMAP operations.
44
45 All errors from JSON parsing, HTTP, session management, and JMAP method
46 calls are represented as polymorphic variants. *)
47module Error = Jmap_types.Error
48
49(** JMAP identifier type.
50
51 Identifiers are opaque strings assigned by the server. *)
52module Id = Jmap_types.Id
53
54(** Email keyword type.
55
56 Standard keywords are represented as polymorphic variants.
57 Custom keywords use [`Custom of string]. *)
58module Keyword = Jmap_types.Keyword
59
60(** Mailbox role type.
61
62 Standard roles are represented as polymorphic variants.
63 Custom roles use [`Custom of string]. *)
64module Role = Jmap_types.Role
65
66(** JMAP capability type.
67
68 Standard capabilities are represented as polymorphic variants.
69 Custom capabilities use [`Custom of string]. *)
70module Capability = Jmap_types.Capability
71
72(** {1 Session Types} *)
73
74(** JMAP session information.
75
76 The session contains server capabilities, account information,
77 and API endpoint URLs. *)
78module Session = struct
79 (** Account information. *)
80 module Account = struct
81 type t = Jmap_types.account
82
83 let name a = Proto.Session.Account.name a
84 let is_personal a = Proto.Session.Account.is_personal a
85 let is_read_only a = Proto.Session.Account.is_read_only a
86 end
87
88 type t = Jmap_types.session
89
90 let capabilities s = Proto.Session.capabilities s
91 let accounts s = Proto.Session.accounts s
92 let primary_accounts s = Proto.Session.primary_accounts s
93 let username s = Proto.Session.username s
94 let api_url s = Proto.Session.api_url s
95 let download_url s = Proto.Session.download_url s
96 let upload_url s = Proto.Session.upload_url s
97 let event_source_url s = Proto.Session.event_source_url s
98 let state s = Proto.Session.state s
99
100 let get_account id s = Proto.Session.get_account id s
101 let primary_account_for cap s = Proto.Session.primary_account_for cap s
102 let has_capability uri s = Proto.Session.has_capability uri s
103end
104
105(** {1 Mail Types} *)
106
107(** Email address with optional display name. *)
108module Email_address = struct
109 type t = Jmap_types.email_address
110
111 let name a = Proto.Email_address.name a
112 let email a = Proto.Email_address.email a
113
114 let create ?name email =
115 Proto.Email_address.create ?name email
116end
117
118(** Email mailbox. *)
119module Mailbox = struct
120 type t = Jmap_types.mailbox
121
122 let id m = Proto.Mailbox.id m
123 let name m = Proto.Mailbox.name m
124 let parent_id m = Proto.Mailbox.parent_id m
125 let sort_order m = Proto.Mailbox.sort_order m
126 let total_emails m = Proto.Mailbox.total_emails m
127 let unread_emails m = Proto.Mailbox.unread_emails m
128 let total_threads m = Proto.Mailbox.total_threads m
129 let unread_threads m = Proto.Mailbox.unread_threads m
130 let is_subscribed m = Proto.Mailbox.is_subscribed m
131
132 let role m =
133 (* Proto.Mailbox.role now returns polymorphic variants directly *)
134 let convert_role : Proto.Mailbox.role -> Role.t = function
135 | `Inbox -> `Inbox
136 | `Sent -> `Sent
137 | `Drafts -> `Drafts
138 | `Trash -> `Trash
139 | `Junk -> `Junk
140 | `Archive -> `Archive
141 | `Flagged -> `Flagged
142 | `Important -> `Important
143 | `All -> `All
144 | `Subscribed -> `Subscribed
145 | `Snoozed -> `Snoozed
146 | `Scheduled -> `Scheduled
147 | `Memos -> `Memos
148 | `Other s -> `Custom s
149 in
150 Option.map convert_role (Proto.Mailbox.role m)
151
152 (** Mailbox rights. *)
153 module Rights = struct
154 type t = Proto.Mailbox.Rights.t
155
156 let may_read_items r = Proto.Mailbox.Rights.may_read_items r
157 let may_add_items r = Proto.Mailbox.Rights.may_add_items r
158 let may_remove_items r = Proto.Mailbox.Rights.may_remove_items r
159 let may_set_seen r = Proto.Mailbox.Rights.may_set_seen r
160 let may_set_keywords r = Proto.Mailbox.Rights.may_set_keywords r
161 let may_create_child r = Proto.Mailbox.Rights.may_create_child r
162 let may_rename r = Proto.Mailbox.Rights.may_rename r
163 let may_delete r = Proto.Mailbox.Rights.may_delete r
164 let may_submit r = Proto.Mailbox.Rights.may_submit r
165 end
166
167 let my_rights m = Proto.Mailbox.my_rights m
168end
169
170(** Email thread. *)
171module Thread = struct
172 type t = Jmap_types.thread
173
174 let id t = Proto.Thread.id t
175 let email_ids t = Proto.Thread.email_ids t
176end
177
178(** Email message. *)
179module Email = struct
180 (** Email body part. *)
181 module Body = struct
182 type part = Proto.Email_body.Part.t
183 type value = Proto.Email_body.Value.t
184
185 let part_id p = Proto.Email_body.Part.part_id p
186 let blob_id p = Proto.Email_body.Part.blob_id p
187 let size p = Proto.Email_body.Part.size p
188 let name p = Proto.Email_body.Part.name p
189 let type_ p = Proto.Email_body.Part.type_ p
190 let charset p = Proto.Email_body.Part.charset p
191 let disposition p = Proto.Email_body.Part.disposition p
192 let cid p = Proto.Email_body.Part.cid p
193 let language p = Proto.Email_body.Part.language p
194 let location p = Proto.Email_body.Part.location p
195
196 let value_text v = Proto.Email_body.Value.value v
197 let value_is_truncated v = Proto.Email_body.Value.is_truncated v
198 let value_is_encoding_problem v = Proto.Email_body.Value.is_encoding_problem v
199 end
200
201 type t = Jmap_types.email
202
203 let id e = Proto.Email.id e
204 let blob_id e = Proto.Email.blob_id e
205 let thread_id e = Proto.Email.thread_id e
206 let mailbox_ids e = Proto.Email.mailbox_ids e
207 let size e = Proto.Email.size e
208 let received_at e = Proto.Email.received_at e
209 let message_id e = Proto.Email.message_id e
210 let in_reply_to e = Proto.Email.in_reply_to e
211 let references e = Proto.Email.references e
212 let subject e = Proto.Email.subject e
213 let sent_at e = Proto.Email.sent_at e
214 let has_attachment e = Proto.Email.has_attachment e
215 let preview e = Proto.Email.preview e
216
217 (** Get active keywords as polymorphic variants. *)
218 let keywords e =
219 match Proto.Email.keywords e with
220 | None -> []
221 | Some kw_map ->
222 List.filter_map (fun (k, v) ->
223 if v then Some (Keyword.of_string k) else None
224 ) kw_map
225
226 (** Check if email has a specific keyword. *)
227 let has_keyword kw e =
228 let kw_str = Keyword.to_string kw in
229 match Proto.Email.keywords e with
230 | None -> false
231 | Some kw_map -> List.exists (fun (k, v) -> k = kw_str && v) kw_map
232
233 let from e = Proto.Email.from e
234 let to_ e = Proto.Email.to_ e
235 let cc e = Proto.Email.cc e
236 let bcc e = Proto.Email.bcc e
237 let reply_to e = Proto.Email.reply_to e
238 let sender e = Proto.Email.sender e
239
240 let text_body e = Proto.Email.text_body e
241 let html_body e = Proto.Email.html_body e
242 let attachments e = Proto.Email.attachments e
243 let body_values e = Proto.Email.body_values e
244end
245
246(** Email identity for sending. *)
247module Identity = struct
248 type t = Jmap_types.identity
249
250 let id i = Proto.Identity.id i
251 let name i = Proto.Identity.name i
252 let email i = Proto.Identity.email i
253 let reply_to i = Proto.Identity.reply_to i
254 let bcc i = Proto.Identity.bcc i
255 let text_signature i = Proto.Identity.text_signature i
256 let html_signature i = Proto.Identity.html_signature i
257 let may_delete i = Proto.Identity.may_delete i
258end
259
260(** Email submission for outgoing mail. *)
261module Submission = struct
262 type t = Jmap_types.submission
263
264 let id s = Proto.Submission.id s
265 let identity_id s = Proto.Submission.identity_id s
266 let email_id s = Proto.Submission.email_id s
267 let thread_id s = Proto.Submission.thread_id s
268 let send_at s = Proto.Submission.send_at s
269 let undo_status s = Proto.Submission.undo_status s
270 let delivery_status s = Proto.Submission.delivery_status s
271 let dsn_blob_ids s = Proto.Submission.dsn_blob_ids s
272 let mdn_blob_ids s = Proto.Submission.mdn_blob_ids s
273end
274
275(** Vacation auto-response. *)
276module Vacation = struct
277 type t = Jmap_types.vacation
278
279 let id v = Proto.Vacation.id v
280 let is_enabled v = Proto.Vacation.is_enabled v
281 let from_date v = Proto.Vacation.from_date v
282 let to_date v = Proto.Vacation.to_date v
283 let subject v = Proto.Vacation.subject v
284 let text_body v = Proto.Vacation.text_body v
285 let html_body v = Proto.Vacation.html_body v
286end
287
288(** Search snippet with highlighted matches. *)
289module Search_snippet = struct
290 type t = Jmap_types.search_snippet
291
292 let email_id s = Proto.Search_snippet.email_id s
293 let subject s = Proto.Search_snippet.subject s
294 let preview s = Proto.Search_snippet.preview s
295end
296
297(** {1 Filter Types} *)
298
299(** Email filter conditions for queries. *)
300module Email_filter = struct
301 type condition = Proto.Email.Filter_condition.t
302
303 (** Create an email filter condition.
304
305 All parameters are optional. Omitted parameters are not included
306 in the filter. Use [make ()] for an empty filter. *)
307 let make
308 ?in_mailbox
309 ?in_mailbox_other_than
310 ?before
311 ?after
312 ?min_size
313 ?max_size
314 ?(all_in_thread_have_keyword : Keyword.t option)
315 ?(some_in_thread_have_keyword : Keyword.t option)
316 ?(none_in_thread_have_keyword : Keyword.t option)
317 ?(has_keyword : Keyword.t option)
318 ?(not_keyword : Keyword.t option)
319 ?has_attachment
320 ?text
321 ?from
322 ?to_
323 ?cc
324 ?bcc
325 ?subject
326 ?body
327 ?header
328 () : condition =
329 {
330 in_mailbox;
331 in_mailbox_other_than;
332 before;
333 after;
334 min_size;
335 max_size;
336 all_in_thread_have_keyword = Option.map Keyword.to_string all_in_thread_have_keyword;
337 some_in_thread_have_keyword = Option.map Keyword.to_string some_in_thread_have_keyword;
338 none_in_thread_have_keyword = Option.map Keyword.to_string none_in_thread_have_keyword;
339 has_keyword = Option.map Keyword.to_string has_keyword;
340 not_keyword = Option.map Keyword.to_string not_keyword;
341 has_attachment;
342 text;
343 from;
344 to_;
345 cc;
346 bcc;
347 subject;
348 body;
349 header;
350 }
351end
352
353(** Mailbox filter conditions for queries. *)
354module Mailbox_filter = struct
355 type condition = Proto.Mailbox.Filter_condition.t
356
357 let convert_role : Role.t -> Proto.Mailbox.role = function
358 | `Inbox -> `Inbox
359 | `Sent -> `Sent
360 | `Drafts -> `Drafts
361 | `Trash -> `Trash
362 | `Junk -> `Junk
363 | `Archive -> `Archive
364 | `Flagged -> `Flagged
365 | `Important -> `Important
366 | `All -> `All
367 | `Subscribed -> `Subscribed
368 | `Snoozed -> `Snoozed
369 | `Scheduled -> `Scheduled
370 | `Memos -> `Memos
371 | `Custom s -> `Other s
372
373 (** Create a mailbox filter condition.
374
375 All parameters are optional.
376 For [role]: [Some (Some r)] filters by role [r], [Some None] filters for
377 mailboxes with no role, [None] doesn't filter by role. *)
378 let make
379 ?parent_id
380 ?name
381 ?role
382 ?has_any_role
383 ?is_subscribed
384 () : condition =
385 {
386 parent_id;
387 name;
388 role = Option.map (Option.map convert_role) role;
389 has_any_role;
390 is_subscribed;
391 }
392end
393
394(** {1 Response Types} *)
395
396(** Generic /get response wrapper. *)
397module Get_response = struct
398 type 'a t = 'a Proto.Method.get_response
399
400 let account_id (r : 'a t) = r.Proto.Method.account_id
401 let state (r : 'a t) = r.Proto.Method.state
402 let list (r : 'a t) = r.Proto.Method.list
403 let not_found (r : 'a t) = r.Proto.Method.not_found
404end
405
406(** Query response. *)
407module Query_response = struct
408 type t = Proto.Method.query_response
409
410 let account_id (r : t) = r.Proto.Method.account_id
411 let query_state (r : t) = r.Proto.Method.query_state
412 let can_calculate_changes (r : t) = r.Proto.Method.can_calculate_changes
413 let position (r : t) = r.Proto.Method.position
414 let ids (r : t) = r.Proto.Method.ids
415 let total (r : t) = r.Proto.Method.total
416end
417
418(** Changes response. *)
419module Changes_response = struct
420 type t = Proto.Method.changes_response
421
422 let account_id (r : t) = r.Proto.Method.account_id
423 let old_state (r : t) = r.Proto.Method.old_state
424 let new_state (r : t) = r.Proto.Method.new_state
425 let has_more_changes (r : t) = r.Proto.Method.has_more_changes
426 let created (r : t) = r.Proto.Method.created
427 let updated (r : t) = r.Proto.Method.updated
428 let destroyed (r : t) = r.Proto.Method.destroyed
429end
430
431(** {1 JSONABLE Interface} *)
432
433(** Module type for types that can be serialized to/from JSON bytes. *)
434module type JSONABLE = sig
435 type t
436
437 val of_string : string -> (t, Error.t) result
438 val to_string : t -> (string, Error.t) result
439end
440
441(** {1 Request Chaining} *)
442
443(** JMAP method chaining with automatic result references.
444
445 See {!Chain} for the full interface. *)
446module Chain = Chain