anil.recoil.org
this repo has no description
thx for the vibes claude
+35
jmap-email.opam
+35
jmap-email.opam
···
1
+
opam-version: "2.0"
2
+
name: "jmap-email"
3
+
version: "~dev"
4
+
synopsis: "JMAP Email extensions library (RFC 8621)"
5
+
description: """
6
+
OCaml implementation of the JMAP Mail extensions protocol as defined in RFC 8621.
7
+
Provides type definitions and structures for working with email in JMAP.
8
+
"""
9
+
maintainer: ["user@example.com"]
10
+
authors: ["Example User"]
11
+
license: "MIT"
12
+
homepage: "https://github.com/example/jmap"
13
+
bug-reports: "https://github.com/example/jmap/issues"
14
+
depends: [
15
+
"ocaml" {>= "4.08.0"}
16
+
"dune" {>= "3.0"}
17
+
"jmap"
18
+
"yojson"
19
+
"uri"
20
+
"odoc" {with-doc}
21
+
]
22
+
build: [
23
+
["dune" "subst"] {dev}
24
+
[
25
+
"dune"
26
+
"build"
27
+
"-p"
28
+
name
29
+
"-j"
30
+
jobs
31
+
"@install"
32
+
"@runtest" {with-test}
33
+
"@doc" {with-doc}
34
+
]
35
+
]
+13
jmap-email/dune
+13
jmap-email/dune
+300
jmap-email/jmap_email.ml
+300
jmap-email/jmap_email.ml
···
1
+
(* JMAP Mail Extension Library (RFC 8621). *)
2
+
3
+
(* Core Types *)
4
+
module Types = Jmap_email_types
5
+
6
+
(* Mailbox *)
7
+
module Mailbox = Jmap_mailbox
8
+
9
+
(* Thread *)
10
+
module Thread = Jmap_thread
11
+
12
+
(* Search Snippet *)
13
+
module SearchSnippet = Jmap_search_snippet
14
+
15
+
(* Identity *)
16
+
module Identity = Jmap_identity
17
+
18
+
(* Email Submission *)
19
+
module Submission = Jmap_submission
20
+
21
+
(* Vacation Response *)
22
+
module Vacation = Jmap_vacation
23
+
24
+
(* Capability URI for JMAP Mail. *)
25
+
let capability_mail = "urn:ietf:params:jmap:mail"
26
+
27
+
(* Capability URI for JMAP Submission. *)
28
+
let capability_submission = "urn:ietf:params:jmap:submission"
29
+
30
+
(* Capability URI for JMAP Vacation Response. *)
31
+
let capability_vacationresponse = "urn:ietf:params:jmap:vacationresponse"
32
+
33
+
(* Type name for EmailDelivery push notifications. *)
34
+
let push_event_type_email_delivery = "EmailDelivery"
35
+
36
+
(* JMAP keywords corresponding to IMAP system flags. *)
37
+
let keyword_draft = "$draft"
38
+
let keyword_seen = "$seen"
39
+
let keyword_flagged = "$flagged"
40
+
let keyword_answered = "$answered"
41
+
42
+
(* Common JMAP keywords from RFC 5788. *)
43
+
let keyword_forwarded = "$forwarded"
44
+
let keyword_phishing = "$phishing"
45
+
let keyword_junk = "$junk"
46
+
let keyword_notjunk = "$notjunk"
47
+
48
+
(* Functions to manipulate email flags/keywords *)
49
+
module Keyword_ops = struct
50
+
let add email keyword =
51
+
match Types.Email.keywords email with
52
+
| None ->
53
+
Types.Email.create
54
+
?id:(Types.Email.id email)
55
+
?blob_id:(Types.Email.blob_id email)
56
+
?thread_id:(Types.Email.thread_id email)
57
+
?mailbox_ids:(Types.Email.mailbox_ids email)
58
+
~keywords:(Types.Keywords.of_list [keyword])
59
+
?size:(Types.Email.size email)
60
+
?received_at:(Types.Email.received_at email)
61
+
?subject:(Types.Email.subject email)
62
+
?preview:(Types.Email.preview email)
63
+
?from:(Types.Email.from email)
64
+
?to_:(Types.Email.to_ email)
65
+
?cc:(Types.Email.cc email)
66
+
?message_id:(Types.Email.message_id email)
67
+
?has_attachment:(Types.Email.has_attachment email)
68
+
?text_body:(Types.Email.text_body email)
69
+
?html_body:(Types.Email.html_body email)
70
+
?attachments:(Types.Email.attachments email)
71
+
()
72
+
| Some kws ->
73
+
Types.Email.create
74
+
?id:(Types.Email.id email)
75
+
?blob_id:(Types.Email.blob_id email)
76
+
?thread_id:(Types.Email.thread_id email)
77
+
?mailbox_ids:(Types.Email.mailbox_ids email)
78
+
~keywords:(Types.Keywords.add kws keyword)
79
+
?size:(Types.Email.size email)
80
+
?received_at:(Types.Email.received_at email)
81
+
?subject:(Types.Email.subject email)
82
+
?preview:(Types.Email.preview email)
83
+
?from:(Types.Email.from email)
84
+
?to_:(Types.Email.to_ email)
85
+
?cc:(Types.Email.cc email)
86
+
?message_id:(Types.Email.message_id email)
87
+
?has_attachment:(Types.Email.has_attachment email)
88
+
?text_body:(Types.Email.text_body email)
89
+
?html_body:(Types.Email.html_body email)
90
+
?attachments:(Types.Email.attachments email)
91
+
()
92
+
93
+
let remove email keyword =
94
+
match Types.Email.keywords email with
95
+
| None -> email
96
+
| Some kws ->
97
+
Types.Email.create
98
+
?id:(Types.Email.id email)
99
+
?blob_id:(Types.Email.blob_id email)
100
+
?thread_id:(Types.Email.thread_id email)
101
+
?mailbox_ids:(Types.Email.mailbox_ids email)
102
+
~keywords:(Types.Keywords.remove kws keyword)
103
+
?size:(Types.Email.size email)
104
+
?received_at:(Types.Email.received_at email)
105
+
?subject:(Types.Email.subject email)
106
+
?preview:(Types.Email.preview email)
107
+
?from:(Types.Email.from email)
108
+
?to_:(Types.Email.to_ email)
109
+
?cc:(Types.Email.cc email)
110
+
?message_id:(Types.Email.message_id email)
111
+
?has_attachment:(Types.Email.has_attachment email)
112
+
?text_body:(Types.Email.text_body email)
113
+
?html_body:(Types.Email.html_body email)
114
+
?attachments:(Types.Email.attachments email)
115
+
()
116
+
117
+
let mark_as_seen email = add email Types.Keywords.Seen
118
+
119
+
let mark_as_unseen email = remove email Types.Keywords.Seen
120
+
121
+
let mark_as_flagged email = add email Types.Keywords.Flagged
122
+
123
+
let unmark_flagged email = remove email Types.Keywords.Flagged
124
+
125
+
let mark_as_draft email = add email Types.Keywords.Draft
126
+
127
+
let unmark_draft email = remove email Types.Keywords.Draft
128
+
129
+
let mark_as_answered email = add email Types.Keywords.Answered
130
+
131
+
let unmark_answered email = remove email Types.Keywords.Answered
132
+
133
+
let mark_as_forwarded email = add email Types.Keywords.Forwarded
134
+
135
+
let mark_as_junk email = add email Types.Keywords.Junk
136
+
137
+
let mark_as_not_junk email = add email Types.Keywords.NotJunk
138
+
139
+
let mark_as_phishing email = add email Types.Keywords.Phishing
140
+
141
+
let add_custom email custom_kw =
142
+
add email (Types.Keywords.Custom custom_kw)
143
+
144
+
let remove_custom email custom_kw =
145
+
remove email (Types.Keywords.Custom custom_kw)
146
+
147
+
let add_keyword_patch keyword =
148
+
[("keywords/" ^ Types.Keywords.to_string keyword, `Bool true)]
149
+
150
+
let remove_keyword_patch keyword =
151
+
[("keywords/" ^ Types.Keywords.to_string keyword, `Null)]
152
+
153
+
let mark_seen_patch () =
154
+
add_keyword_patch Types.Keywords.Seen
155
+
156
+
let mark_unseen_patch () =
157
+
remove_keyword_patch Types.Keywords.Seen
158
+
end
159
+
160
+
(* Conversion functions for JMAP/IMAP compatibility *)
161
+
module Conversion = struct
162
+
let keyword_to_imap_flag = function
163
+
| Types.Keywords.Draft -> "\\Draft"
164
+
| Types.Keywords.Seen -> "\\Seen"
165
+
| Types.Keywords.Flagged -> "\\Flagged"
166
+
| Types.Keywords.Answered -> "\\Answered"
167
+
| Types.Keywords.Forwarded -> "$Forwarded"
168
+
| Types.Keywords.Phishing -> "$Phishing"
169
+
| Types.Keywords.Junk -> "$Junk"
170
+
| Types.Keywords.NotJunk -> "$NotJunk"
171
+
| Types.Keywords.Custom c -> c
172
+
173
+
let imap_flag_to_keyword = function
174
+
| "\\Draft" -> Types.Keywords.Draft
175
+
| "\\Seen" -> Types.Keywords.Seen
176
+
| "\\Flagged" -> Types.Keywords.Flagged
177
+
| "\\Answered" -> Types.Keywords.Answered
178
+
| "$Forwarded" -> Types.Keywords.Forwarded
179
+
| "$Phishing" -> Types.Keywords.Phishing
180
+
| "$Junk" -> Types.Keywords.Junk
181
+
| "$NotJunk" -> Types.Keywords.NotJunk
182
+
| c -> Types.Keywords.Custom c
183
+
184
+
let is_valid_custom_keyword s =
185
+
String.length s > 0 && s.[0] <> '$' &&
186
+
String.for_all (fun c ->
187
+
(c >= 'a' && c <= 'z') ||
188
+
(c >= 'A' && c <= 'Z') ||
189
+
(c >= '0' && c <= '9') ||
190
+
c = '-' || c = '_') s
191
+
192
+
let keyword_to_string = Types.Keywords.to_string
193
+
194
+
let string_to_keyword = Types.Keywords.of_string
195
+
end
196
+
197
+
(* Email query filter helpers *)
198
+
module Email_filter = struct
199
+
let in_mailbox mailbox_id =
200
+
let prop_name = "mailboxIds/" ^ mailbox_id in
201
+
Jmap.Methods.Filter.property_equals prop_name (`Bool true)
202
+
203
+
let has_keyword keyword =
204
+
let prop_name = "keywords/" ^ Types.Keywords.to_string keyword in
205
+
Jmap.Methods.Filter.property_equals prop_name (`Bool true)
206
+
207
+
let not_has_keyword keyword =
208
+
let prop_name = "keywords/" ^ Types.Keywords.to_string keyword in
209
+
Jmap.Methods.Filter.property_equals prop_name (`Bool false)
210
+
211
+
let unread () =
212
+
not_has_keyword Types.Keywords.Seen
213
+
214
+
let subject subject_text =
215
+
Jmap.Methods.Filter.text_contains "subject" subject_text
216
+
217
+
let from email =
218
+
Jmap.Methods.Filter.text_contains "from" email
219
+
220
+
let to_ email =
221
+
Jmap.Methods.Filter.text_contains "to" email
222
+
223
+
let has_attachment () =
224
+
Jmap.Methods.Filter.property_equals "hasAttachment" (`Bool true)
225
+
226
+
let before date =
227
+
Jmap.Methods.Filter.property_lt "receivedAt" (`Float date)
228
+
229
+
let after date =
230
+
Jmap.Methods.Filter.property_gt "receivedAt" (`Float date)
231
+
232
+
let larger_than size =
233
+
Jmap.Methods.Filter.property_gt "size" (`Int size)
234
+
235
+
let smaller_than size =
236
+
Jmap.Methods.Filter.property_lt "size" (`Int size)
237
+
end
238
+
239
+
(* Common email sorting comparators *)
240
+
module Email_sort = struct
241
+
let received_newest_first () =
242
+
Jmap.Methods.Comparator.v
243
+
~property:"receivedAt"
244
+
~is_ascending:false
245
+
()
246
+
247
+
let received_oldest_first () =
248
+
Jmap.Methods.Comparator.v
249
+
~property:"receivedAt"
250
+
~is_ascending:true
251
+
()
252
+
253
+
let sent_newest_first () =
254
+
Jmap.Methods.Comparator.v
255
+
~property:"sentAt"
256
+
~is_ascending:false
257
+
()
258
+
259
+
let sent_oldest_first () =
260
+
Jmap.Methods.Comparator.v
261
+
~property:"sentAt"
262
+
~is_ascending:true
263
+
()
264
+
265
+
let subject_asc () =
266
+
Jmap.Methods.Comparator.v
267
+
~property:"subject"
268
+
~is_ascending:true
269
+
()
270
+
271
+
let subject_desc () =
272
+
Jmap.Methods.Comparator.v
273
+
~property:"subject"
274
+
~is_ascending:false
275
+
()
276
+
277
+
let size_largest_first () =
278
+
Jmap.Methods.Comparator.v
279
+
~property:"size"
280
+
~is_ascending:false
281
+
()
282
+
283
+
let size_smallest_first () =
284
+
Jmap.Methods.Comparator.v
285
+
~property:"size"
286
+
~is_ascending:true
287
+
()
288
+
289
+
let from_asc () =
290
+
Jmap.Methods.Comparator.v
291
+
~property:"from"
292
+
~is_ascending:true
293
+
()
294
+
295
+
let from_desc () =
296
+
Jmap.Methods.Comparator.v
297
+
~property:"from"
298
+
~is_ascending:false
299
+
()
300
+
end
+314
jmap-email/jmap_email.mli
+314
jmap-email/jmap_email.mli
···
1
+
(** JMAP Mail Extension Library (RFC 8621).
2
+
3
+
This library extends the core JMAP protocol with email-specific
4
+
functionality as defined in RFC 8621. It provides types and signatures
5
+
for interacting with JMAP Mail data types: Mailbox, Thread, Email,
6
+
SearchSnippet, Identity, EmailSubmission, and VacationResponse.
7
+
8
+
Requires the core Jmap library and Jmap_unix library for network operations.
9
+
10
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html> RFC 8621: JMAP for Mail
11
+
*)
12
+
13
+
open Jmap.Types
14
+
15
+
(** {1 Core Types} *)
16
+
module Types = Jmap_email_types
17
+
18
+
(** {1 Mailbox}
19
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-2> RFC 8621, Section 2 *)
20
+
module Mailbox = Jmap_mailbox
21
+
22
+
(** {1 Thread}
23
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-3> RFC 8621, Section 3 *)
24
+
module Thread = Jmap_thread
25
+
26
+
(** {1 Search Snippet}
27
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-5> RFC 8621, Section 5 *)
28
+
module SearchSnippet = Jmap_search_snippet
29
+
30
+
(** {1 Identity}
31
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-6> RFC 8621, Section 6 *)
32
+
module Identity = Jmap_identity
33
+
34
+
(** {1 Email Submission}
35
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-7> RFC 8621, Section 7 *)
36
+
module Submission = Jmap_submission
37
+
38
+
(** {1 Vacation Response}
39
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-8> RFC 8621, Section 8 *)
40
+
module Vacation = Jmap_vacation
41
+
42
+
(** {1 Example Usage}
43
+
44
+
The following example demonstrates using the JMAP Email library to fetch unread emails
45
+
from a specific sender.
46
+
47
+
{[
48
+
(* OCaml 5.1 required for Lwt let operators *)
49
+
open Lwt.Syntax
50
+
open Jmap
51
+
open Jmap.Types
52
+
open Jmap.Wire
53
+
open Jmap.Methods
54
+
open Jmap_email
55
+
open Jmap.Unix
56
+
57
+
let list_unread_from_sender ctx session sender_email =
58
+
(* Find the primary mail account *)
59
+
let primary_mail_account_id =
60
+
Hashtbl.find session.primary_accounts capability_mail
61
+
in
62
+
(* Construct the filter *)
63
+
let filter : filter =
64
+
Filter_operator (Filter_operator.v
65
+
~operator:`AND
66
+
~conditions:[
67
+
Filter_condition (Yojson.Safe.to_basic (`Assoc [
68
+
("from", `String sender_email);
69
+
]));
70
+
Filter_condition (Yojson.Safe.to_basic (`Assoc [
71
+
("hasKeyword", `String keyword_seen);
72
+
("value", `Bool false);
73
+
]));
74
+
]
75
+
())
76
+
in
77
+
(* Prepare the Email/query invocation *)
78
+
let query_args = Query_args.v
79
+
~account_id:primary_mail_account_id
80
+
~filter
81
+
~sort:[
82
+
Comparator.v
83
+
~property:"receivedAt"
84
+
~is_ascending:false
85
+
()
86
+
]
87
+
~position:0
88
+
~limit:20 (* Get latest 20 *)
89
+
~calculate_total:false
90
+
~collapse_threads:false
91
+
()
92
+
in
93
+
let query_invocation = Invocation.v
94
+
~method_name:"Email/query"
95
+
~arguments:(* Yojson conversion of query_args needed here *)
96
+
~method_call_id:"q1"
97
+
()
98
+
in
99
+
100
+
(* Prepare the Email/get invocation using a back-reference *)
101
+
let get_args = Get_args.v
102
+
~account_id:primary_mail_account_id
103
+
~properties:["id"; "subject"; "receivedAt"; "from"]
104
+
()
105
+
in
106
+
let get_invocation = Invocation.v
107
+
~method_name:"Email/get"
108
+
~arguments:(* Yojson conversion of get_args, with ids replaced by a ResultReference to q1 needed here *)
109
+
~method_call_id:"g1"
110
+
()
111
+
in
112
+
113
+
(* Prepare the JMAP request *)
114
+
let request = Request.v
115
+
~using:[ Jmap.capability_core; capability_mail ]
116
+
~method_calls:[ query_invocation; get_invocation ]
117
+
()
118
+
in
119
+
120
+
(* Send the request *)
121
+
let* response = Jmap.Unix.request ctx request in
122
+
123
+
(* Process the response (extract Email/get results) *)
124
+
(* ... Omitted: find the Email/get response in response.method_responses ... *)
125
+
Lwt.return_unit
126
+
]}
127
+
*)
128
+
129
+
(** Capability URI for JMAP Mail.
130
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-1.3.1> RFC 8621, Section 1.3.1 *)
131
+
val capability_mail : string
132
+
133
+
(** Capability URI for JMAP Submission.
134
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-1.3.2> RFC 8621, Section 1.3.2 *)
135
+
val capability_submission : string
136
+
137
+
(** Capability URI for JMAP Vacation Response.
138
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-1.3.3> RFC 8621, Section 1.3.3 *)
139
+
val capability_vacationresponse : string
140
+
141
+
(** Type name for EmailDelivery push notifications.
142
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-1.5> RFC 8621, Section 1.5 *)
143
+
val push_event_type_email_delivery : string
144
+
145
+
(** JMAP keywords corresponding to IMAP system flags.
146
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1.1> RFC 8621, Section 4.1.1 *)
147
+
val keyword_draft : string
148
+
val keyword_seen : string
149
+
val keyword_flagged : string
150
+
val keyword_answered : string
151
+
152
+
(** Common JMAP keywords from RFC 5788.
153
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1.1> RFC 8621, Section 4.1.1 *)
154
+
val keyword_forwarded : string
155
+
val keyword_phishing : string
156
+
val keyword_junk : string
157
+
val keyword_notjunk : string
158
+
159
+
(** Functions to manipulate email flags/keywords *)
160
+
module Keyword_ops : sig
161
+
(** Add a keyword/flag to an email *)
162
+
val add : Types.Email.t -> Types.Keywords.keyword -> Types.Email.t
163
+
164
+
(** Remove a keyword/flag from an email *)
165
+
val remove : Types.Email.t -> Types.Keywords.keyword -> Types.Email.t
166
+
167
+
(** Mark an email as seen/read *)
168
+
val mark_as_seen : Types.Email.t -> Types.Email.t
169
+
170
+
(** Mark an email as unseen/unread *)
171
+
val mark_as_unseen : Types.Email.t -> Types.Email.t
172
+
173
+
(** Mark an email as flagged/important *)
174
+
val mark_as_flagged : Types.Email.t -> Types.Email.t
175
+
176
+
(** Remove flagged/important marking from an email *)
177
+
val unmark_flagged : Types.Email.t -> Types.Email.t
178
+
179
+
(** Mark an email as a draft *)
180
+
val mark_as_draft : Types.Email.t -> Types.Email.t
181
+
182
+
(** Remove draft marking from an email *)
183
+
val unmark_draft : Types.Email.t -> Types.Email.t
184
+
185
+
(** Mark an email as answered/replied *)
186
+
val mark_as_answered : Types.Email.t -> Types.Email.t
187
+
188
+
(** Remove answered/replied marking from an email *)
189
+
val unmark_answered : Types.Email.t -> Types.Email.t
190
+
191
+
(** Mark an email as forwarded *)
192
+
val mark_as_forwarded : Types.Email.t -> Types.Email.t
193
+
194
+
(** Mark an email as spam/junk *)
195
+
val mark_as_junk : Types.Email.t -> Types.Email.t
196
+
197
+
(** Mark an email as not spam/junk *)
198
+
val mark_as_not_junk : Types.Email.t -> Types.Email.t
199
+
200
+
(** Mark an email as phishing *)
201
+
val mark_as_phishing : Types.Email.t -> Types.Email.t
202
+
203
+
(** Add a custom keyword to an email *)
204
+
val add_custom : Types.Email.t -> string -> Types.Email.t
205
+
206
+
(** Remove a custom keyword from an email *)
207
+
val remove_custom : Types.Email.t -> string -> Types.Email.t
208
+
209
+
(** Create a patch object to add a keyword to emails *)
210
+
val add_keyword_patch : Types.Keywords.keyword -> Jmap.Methods.patch_object
211
+
212
+
(** Create a patch object to remove a keyword from emails *)
213
+
val remove_keyword_patch : Types.Keywords.keyword -> Jmap.Methods.patch_object
214
+
215
+
(** Create a patch object to mark emails as seen/read *)
216
+
val mark_seen_patch : unit -> Jmap.Methods.patch_object
217
+
218
+
(** Create a patch object to mark emails as unseen/unread *)
219
+
val mark_unseen_patch : unit -> Jmap.Methods.patch_object
220
+
end
221
+
222
+
(** Conversion functions for JMAP/IMAP compatibility *)
223
+
module Conversion : sig
224
+
(** Convert a JMAP keyword variant to IMAP flag *)
225
+
val keyword_to_imap_flag : Types.Keywords.keyword -> string
226
+
227
+
(** Convert an IMAP flag to JMAP keyword variant *)
228
+
val imap_flag_to_keyword : string -> Types.Keywords.keyword
229
+
230
+
(** Check if a string is valid for use as a custom keyword according to RFC 8621 *)
231
+
val is_valid_custom_keyword : string -> bool
232
+
233
+
(** Get the JMAP protocol string representation of a keyword *)
234
+
val keyword_to_string : Types.Keywords.keyword -> string
235
+
236
+
(** Parse a JMAP protocol string into a keyword variant *)
237
+
val string_to_keyword : string -> Types.Keywords.keyword
238
+
end
239
+
240
+
(** {1 Helper Functions} *)
241
+
242
+
(** Email query filter helpers *)
243
+
module Email_filter : sig
244
+
(** Create a filter to find messages in a specific mailbox *)
245
+
val in_mailbox : id -> Jmap.Methods.Filter.t
246
+
247
+
(** Create a filter to find messages with a specific keyword/flag *)
248
+
val has_keyword : Types.Keywords.keyword -> Jmap.Methods.Filter.t
249
+
250
+
(** Create a filter to find messages without a specific keyword/flag *)
251
+
val not_has_keyword : Types.Keywords.keyword -> Jmap.Methods.Filter.t
252
+
253
+
(** Create a filter to find unread messages *)
254
+
val unread : unit -> Jmap.Methods.Filter.t
255
+
256
+
(** Create a filter to find messages with a specific subject *)
257
+
val subject : string -> Jmap.Methods.Filter.t
258
+
259
+
(** Create a filter to find messages from a specific sender *)
260
+
val from : string -> Jmap.Methods.Filter.t
261
+
262
+
(** Create a filter to find messages sent to a specific recipient *)
263
+
val to_ : string -> Jmap.Methods.Filter.t
264
+
265
+
(** Create a filter to find messages with attachments *)
266
+
val has_attachment : unit -> Jmap.Methods.Filter.t
267
+
268
+
(** Create a filter to find messages received before a date *)
269
+
val before : date -> Jmap.Methods.Filter.t
270
+
271
+
(** Create a filter to find messages received after a date *)
272
+
val after : date -> Jmap.Methods.Filter.t
273
+
274
+
(** Create a filter to find messages with size larger than the given bytes *)
275
+
val larger_than : uint -> Jmap.Methods.Filter.t
276
+
277
+
(** Create a filter to find messages with size smaller than the given bytes *)
278
+
val smaller_than : uint -> Jmap.Methods.Filter.t
279
+
end
280
+
281
+
(** Common email sorting comparators *)
282
+
module Email_sort : sig
283
+
(** Sort by received date (most recent first) *)
284
+
val received_newest_first : unit -> Jmap.Methods.Comparator.t
285
+
286
+
(** Sort by received date (oldest first) *)
287
+
val received_oldest_first : unit -> Jmap.Methods.Comparator.t
288
+
289
+
(** Sort by sent date (most recent first) *)
290
+
val sent_newest_first : unit -> Jmap.Methods.Comparator.t
291
+
292
+
(** Sort by sent date (oldest first) *)
293
+
val sent_oldest_first : unit -> Jmap.Methods.Comparator.t
294
+
295
+
(** Sort by subject (A-Z) *)
296
+
val subject_asc : unit -> Jmap.Methods.Comparator.t
297
+
298
+
(** Sort by subject (Z-A) *)
299
+
val subject_desc : unit -> Jmap.Methods.Comparator.t
300
+
301
+
(** Sort by size (largest first) *)
302
+
val size_largest_first : unit -> Jmap.Methods.Comparator.t
303
+
304
+
(** Sort by size (smallest first) *)
305
+
val size_smallest_first : unit -> Jmap.Methods.Comparator.t
306
+
307
+
(** Sort by from address (A-Z) *)
308
+
val from_asc : unit -> Jmap.Methods.Comparator.t
309
+
310
+
(** Sort by from address (Z-A) *)
311
+
val from_desc : unit -> Jmap.Methods.Comparator.t
312
+
end
313
+
314
+
(** High-level email operations are implemented in the Jmap.Unix.Email module *)
+405
jmap-email/jmap_email_types.ml
+405
jmap-email/jmap_email_types.ml
···
1
+
(* Common types for JMAP Mail (RFC 8621). *)
2
+
3
+
open Jmap.Types
4
+
5
+
(* Represents an email address with an optional name. *)
6
+
module Email_address = struct
7
+
type t = {
8
+
name: string option;
9
+
email: string;
10
+
}
11
+
12
+
let name t = t.name
13
+
let email t = t.email
14
+
15
+
let v ?name ~email () = { name; email }
16
+
end
17
+
18
+
(* Represents a group of email addresses. *)
19
+
module Email_address_group = struct
20
+
type t = {
21
+
name: string option;
22
+
addresses: Email_address.t list;
23
+
}
24
+
25
+
let name t = t.name
26
+
let addresses t = t.addresses
27
+
28
+
let v ?name ~addresses () = { name; addresses }
29
+
end
30
+
31
+
(* Represents a header field (name and raw value). *)
32
+
module Email_header = struct
33
+
type t = {
34
+
name: string;
35
+
value: string;
36
+
}
37
+
38
+
let name t = t.name
39
+
let value t = t.value
40
+
41
+
let v ~name ~value () = { name; value }
42
+
end
43
+
44
+
(* Represents a body part within an Email's MIME structure. *)
45
+
module Email_body_part = struct
46
+
type t = {
47
+
id: string option;
48
+
blob_id: id option;
49
+
size: uint;
50
+
headers: Email_header.t list;
51
+
name: string option;
52
+
mime_type: string;
53
+
charset: string option;
54
+
disposition: string option;
55
+
cid: string option;
56
+
language: string list option;
57
+
location: string option;
58
+
sub_parts: t list option;
59
+
other_headers: Yojson.Safe.t string_map;
60
+
}
61
+
62
+
let id t = t.id
63
+
let blob_id t = t.blob_id
64
+
let size t = t.size
65
+
let headers t = t.headers
66
+
let name t = t.name
67
+
let mime_type t = t.mime_type
68
+
let charset t = t.charset
69
+
let disposition t = t.disposition
70
+
let cid t = t.cid
71
+
let language t = t.language
72
+
let location t = t.location
73
+
let sub_parts t = t.sub_parts
74
+
let other_headers t = t.other_headers
75
+
76
+
let v ?id ?blob_id ~size ~headers ?name ~mime_type ?charset
77
+
?disposition ?cid ?language ?location ?sub_parts
78
+
?(other_headers=Hashtbl.create 0) () =
79
+
{ id; blob_id; size; headers; name; mime_type; charset;
80
+
disposition; cid; language; location; sub_parts; other_headers }
81
+
end
82
+
83
+
(* Represents the decoded value of a text body part. *)
84
+
module Email_body_value = struct
85
+
type t = {
86
+
value: string;
87
+
has_encoding_problem: bool;
88
+
is_truncated: bool;
89
+
}
90
+
91
+
let value t = t.value
92
+
let has_encoding_problem t = t.has_encoding_problem
93
+
let is_truncated t = t.is_truncated
94
+
95
+
let v ~value ?(encoding_problem=false) ?(truncated=false) () =
96
+
{ value; has_encoding_problem = encoding_problem; is_truncated = truncated }
97
+
end
98
+
99
+
(* Type to represent email message flags/keywords. *)
100
+
module Keywords = struct
101
+
type keyword =
102
+
| Draft (* "$draft": The Email is a draft the user is composing *)
103
+
| Seen (* "$seen": The Email has been read *)
104
+
| Flagged (* "$flagged": The Email has been flagged for urgent/special attention *)
105
+
| Answered (* "$answered": The Email has been replied to *)
106
+
107
+
(* Common extension keywords from RFC 5788 *)
108
+
| Forwarded (* "$forwarded": The Email has been forwarded *)
109
+
| Phishing (* "$phishing": The Email is likely to be phishing *)
110
+
| Junk (* "$junk": The Email is spam/junk *)
111
+
| NotJunk (* "$notjunk": The Email is explicitly marked as not spam/junk *)
112
+
| Custom of string (* Arbitrary user-defined keyword *)
113
+
114
+
type t = keyword list
115
+
116
+
let is_draft keywords =
117
+
List.exists (function Draft -> true | _ -> false) keywords
118
+
119
+
let is_seen keywords =
120
+
List.exists (function Seen -> true | _ -> false) keywords
121
+
122
+
let is_unread keywords =
123
+
not (is_seen keywords || is_draft keywords)
124
+
125
+
let is_flagged keywords =
126
+
List.exists (function Flagged -> true | _ -> false) keywords
127
+
128
+
let is_answered keywords =
129
+
List.exists (function Answered -> true | _ -> false) keywords
130
+
131
+
let is_forwarded keywords =
132
+
List.exists (function Forwarded -> true | _ -> false) keywords
133
+
134
+
let is_phishing keywords =
135
+
List.exists (function Phishing -> true | _ -> false) keywords
136
+
137
+
let is_junk keywords =
138
+
List.exists (function Junk -> true | _ -> false) keywords
139
+
140
+
let is_not_junk keywords =
141
+
List.exists (function NotJunk -> true | _ -> false) keywords
142
+
143
+
let has_keyword keywords custom_keyword =
144
+
List.exists (function Custom k when k = custom_keyword -> true | _ -> false) keywords
145
+
146
+
let custom_keywords keywords =
147
+
List.fold_left (fun acc kw ->
148
+
match kw with
149
+
| Custom k -> k :: acc
150
+
| _ -> acc
151
+
) [] keywords
152
+
153
+
let add keywords keyword =
154
+
if List.exists (fun k -> k = keyword) keywords then
155
+
keywords
156
+
else
157
+
keyword :: keywords
158
+
159
+
let remove keywords keyword =
160
+
List.filter (fun k -> k <> keyword) keywords
161
+
162
+
let empty () = []
163
+
164
+
let of_list keywords = keywords
165
+
166
+
let to_string = function
167
+
| Draft -> "$draft"
168
+
| Seen -> "$seen"
169
+
| Flagged -> "$flagged"
170
+
| Answered -> "$answered"
171
+
| Forwarded -> "$forwarded"
172
+
| Phishing -> "$phishing"
173
+
| Junk -> "$junk"
174
+
| NotJunk -> "$notjunk"
175
+
| Custom k -> k
176
+
177
+
let of_string s =
178
+
match s with
179
+
| "$draft" -> Draft
180
+
| "$seen" -> Seen
181
+
| "$flagged" -> Flagged
182
+
| "$answered" -> Answered
183
+
| "$forwarded" -> Forwarded
184
+
| "$phishing" -> Phishing
185
+
| "$junk" -> Junk
186
+
| "$notjunk" -> NotJunk
187
+
| k -> Custom k
188
+
189
+
let to_map keywords =
190
+
let map = Hashtbl.create (List.length keywords) in
191
+
List.iter (fun kw ->
192
+
Hashtbl.add map (to_string kw) true
193
+
) keywords;
194
+
map
195
+
end
196
+
197
+
(* Email properties enum. *)
198
+
type email_property =
199
+
| Id (* The id of the email *)
200
+
| BlobId (* The id of the blob containing the raw message *)
201
+
| ThreadId (* The id of the thread this email belongs to *)
202
+
| MailboxIds (* The mailboxes this email belongs to *)
203
+
| Keywords (* The keywords/flags for this email *)
204
+
| Size (* Size of the message in bytes *)
205
+
| ReceivedAt (* When the message was received by the server *)
206
+
| MessageId (* Value of the Message-ID header *)
207
+
| InReplyTo (* Value of the In-Reply-To header *)
208
+
| References (* Value of the References header *)
209
+
| Sender (* Value of the Sender header *)
210
+
| From (* Value of the From header *)
211
+
| To (* Value of the To header *)
212
+
| Cc (* Value of the Cc header *)
213
+
| Bcc (* Value of the Bcc header *)
214
+
| ReplyTo (* Value of the Reply-To header *)
215
+
| Subject (* Value of the Subject header *)
216
+
| SentAt (* Value of the Date header *)
217
+
| HasAttachment (* Whether the email has attachments *)
218
+
| Preview (* Preview text of the email *)
219
+
| BodyStructure (* MIME structure of the email *)
220
+
| BodyValues (* Decoded body part values *)
221
+
| TextBody (* Text body parts *)
222
+
| HtmlBody (* HTML body parts *)
223
+
| Attachments (* Attachments *)
224
+
| Header of string (* Specific header *)
225
+
| Other of string (* Extension property *)
226
+
227
+
(* Represents an Email object. *)
228
+
module Email = struct
229
+
type t = {
230
+
id: id option;
231
+
blob_id: id option;
232
+
thread_id: id option;
233
+
mailbox_ids: bool id_map option;
234
+
keywords: Keywords.t option;
235
+
size: uint option;
236
+
received_at: date option;
237
+
subject: string option;
238
+
preview: string option;
239
+
from: Email_address.t list option;
240
+
to_: Email_address.t list option;
241
+
cc: Email_address.t list option;
242
+
message_id: string list option;
243
+
has_attachment: bool option;
244
+
text_body: Email_body_part.t list option;
245
+
html_body: Email_body_part.t list option;
246
+
attachments: Email_body_part.t list option;
247
+
}
248
+
249
+
let id t = t.id
250
+
let blob_id t = t.blob_id
251
+
let thread_id t = t.thread_id
252
+
let mailbox_ids t = t.mailbox_ids
253
+
let keywords t = t.keywords
254
+
let size t = t.size
255
+
let received_at t = t.received_at
256
+
let subject t = t.subject
257
+
let preview t = t.preview
258
+
let from t = t.from
259
+
let to_ t = t.to_
260
+
let cc t = t.cc
261
+
let message_id t = t.message_id
262
+
let has_attachment t = t.has_attachment
263
+
let text_body t = t.text_body
264
+
let html_body t = t.html_body
265
+
let attachments t = t.attachments
266
+
267
+
let create ?id ?blob_id ?thread_id ?mailbox_ids ?keywords ?size
268
+
?received_at ?subject ?preview ?from ?to_ ?cc ?message_id
269
+
?has_attachment ?text_body ?html_body ?attachments () =
270
+
{ id; blob_id; thread_id; mailbox_ids; keywords; size;
271
+
received_at; subject; preview; from; to_; cc; message_id;
272
+
has_attachment; text_body; html_body; attachments }
273
+
274
+
let make_patch ?add_keywords ?remove_keywords ?add_mailboxes ?remove_mailboxes () =
275
+
let patch = [] in
276
+
let patch = match add_keywords with
277
+
| Some kw ->
278
+
("keywords/", `Assoc (List.map (fun k ->
279
+
(Keywords.to_string k, `Bool true)
280
+
) kw)) :: patch
281
+
| None -> patch
282
+
in
283
+
let patch = match remove_keywords with
284
+
| Some kw ->
285
+
List.fold_left (fun p k ->
286
+
("keywords/" ^ Keywords.to_string k, `Null) :: p
287
+
) patch kw
288
+
| None -> patch
289
+
in
290
+
let patch = match add_mailboxes with
291
+
| Some mboxes ->
292
+
List.fold_left (fun p mbx ->
293
+
("mailboxIds/" ^ mbx, `Bool true) :: p
294
+
) patch mboxes
295
+
| None -> patch
296
+
in
297
+
let patch = match remove_mailboxes with
298
+
| Some mboxes ->
299
+
List.fold_left (fun p mbx ->
300
+
("mailboxIds/" ^ mbx, `Null) :: p
301
+
) patch mboxes
302
+
| None -> patch
303
+
in
304
+
patch
305
+
306
+
let get_id t =
307
+
match t.id with
308
+
| Some id -> Ok id
309
+
| None -> Error "Email missing ID"
310
+
311
+
let take_id t =
312
+
match t.id with
313
+
| Some id -> id
314
+
| None -> failwith "Email missing ID"
315
+
end
316
+
317
+
(* Email import options. *)
318
+
type email_import_options = {
319
+
import_to_mailboxes : id list;
320
+
import_keywords : Keywords.t option;
321
+
import_received_at : date option;
322
+
}
323
+
324
+
(* Email copy options. *)
325
+
type email_copy_options = {
326
+
copy_to_account_id : id;
327
+
copy_to_mailboxes : id list;
328
+
copy_on_success_destroy_original : bool option;
329
+
}
330
+
331
+
(* Convert a property variant to its string representation *)
332
+
let email_property_to_string = function
333
+
| Id -> "id"
334
+
| BlobId -> "blobId"
335
+
| ThreadId -> "threadId"
336
+
| MailboxIds -> "mailboxIds"
337
+
| Keywords -> "keywords"
338
+
| Size -> "size"
339
+
| ReceivedAt -> "receivedAt"
340
+
| MessageId -> "messageId"
341
+
| InReplyTo -> "inReplyTo"
342
+
| References -> "references"
343
+
| Sender -> "sender"
344
+
| From -> "from"
345
+
| To -> "to"
346
+
| Cc -> "cc"
347
+
| Bcc -> "bcc"
348
+
| ReplyTo -> "replyTo"
349
+
| Subject -> "subject"
350
+
| SentAt -> "sentAt"
351
+
| HasAttachment -> "hasAttachment"
352
+
| Preview -> "preview"
353
+
| BodyStructure -> "bodyStructure"
354
+
| BodyValues -> "bodyValues"
355
+
| TextBody -> "textBody"
356
+
| HtmlBody -> "htmlBody"
357
+
| Attachments -> "attachments"
358
+
| Header h -> "header:" ^ h
359
+
| Other s -> s
360
+
361
+
(* Parse a string into a property variant *)
362
+
let string_to_email_property s =
363
+
match s with
364
+
| "id" -> Id
365
+
| "blobId" -> BlobId
366
+
| "threadId" -> ThreadId
367
+
| "mailboxIds" -> MailboxIds
368
+
| "keywords" -> Keywords
369
+
| "size" -> Size
370
+
| "receivedAt" -> ReceivedAt
371
+
| "messageId" -> MessageId
372
+
| "inReplyTo" -> InReplyTo
373
+
| "references" -> References
374
+
| "sender" -> Sender
375
+
| "from" -> From
376
+
| "to" -> To
377
+
| "cc" -> Cc
378
+
| "bcc" -> Bcc
379
+
| "replyTo" -> ReplyTo
380
+
| "subject" -> Subject
381
+
| "sentAt" -> SentAt
382
+
| "hasAttachment" -> HasAttachment
383
+
| "preview" -> Preview
384
+
| "bodyStructure" -> BodyStructure
385
+
| "bodyValues" -> BodyValues
386
+
| "textBody" -> TextBody
387
+
| "htmlBody" -> HtmlBody
388
+
| "attachments" -> Attachments
389
+
| s when String.length s > 7 && String.sub s 0 7 = "header:" ->
390
+
Header (String.sub s 7 (String.length s - 7))
391
+
| s -> Other s
392
+
393
+
(* Get a list of common properties useful for displaying email lists *)
394
+
let common_email_properties = [
395
+
Id; ThreadId; MailboxIds; Keywords; Size; ReceivedAt;
396
+
From; Subject; Preview; HasAttachment; SentAt;
397
+
]
398
+
399
+
(* Get a list of common properties for detailed email view *)
400
+
let detailed_email_properties = [
401
+
Id; ThreadId; MailboxIds; Keywords; Size; ReceivedAt;
402
+
MessageId; InReplyTo; References; Sender; From; To; Cc;
403
+
ReplyTo; Subject; SentAt; HasAttachment; Preview;
404
+
TextBody; HtmlBody; Attachments;
405
+
]
+368
jmap-email/jmap_email_types.mli
+368
jmap-email/jmap_email_types.mli
···
1
+
(** Common types for JMAP Mail (RFC 8621). *)
2
+
3
+
open Jmap.Types
4
+
5
+
(** Represents an email address with an optional name.
6
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1.2.3> RFC 8621, Section 4.1.2.3 *)
7
+
module Email_address : sig
8
+
type t
9
+
10
+
(** Get the display name for the address (if any) *)
11
+
val name : t -> string option
12
+
13
+
(** Get the email address *)
14
+
val email : t -> string
15
+
16
+
(** Create a new email address *)
17
+
val v :
18
+
?name:string ->
19
+
email:string ->
20
+
unit -> t
21
+
end
22
+
23
+
(** Represents a group of email addresses.
24
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1.2.4> RFC 8621, Section 4.1.2.4 *)
25
+
module Email_address_group : sig
26
+
type t
27
+
28
+
(** Get the name of the group (if any) *)
29
+
val name : t -> string option
30
+
31
+
(** Get the list of addresses in the group *)
32
+
val addresses : t -> Email_address.t list
33
+
34
+
(** Create a new address group *)
35
+
val v :
36
+
?name:string ->
37
+
addresses:Email_address.t list ->
38
+
unit -> t
39
+
end
40
+
41
+
(** Represents a header field (name and raw value).
42
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1.3> RFC 8621, Section 4.1.3 *)
43
+
module Email_header : sig
44
+
type t
45
+
46
+
(** Get the header field name *)
47
+
val name : t -> string
48
+
49
+
(** Get the raw header field value *)
50
+
val value : t -> string
51
+
52
+
(** Create a new header field *)
53
+
val v :
54
+
name:string ->
55
+
value:string ->
56
+
unit -> t
57
+
end
58
+
59
+
(** Represents a body part within an Email's MIME structure.
60
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1.4> RFC 8621, Section 4.1.4 *)
61
+
module Email_body_part : sig
62
+
type t
63
+
64
+
(** Get the part ID (null only for multipart types) *)
65
+
val id : t -> string option
66
+
67
+
(** Get the blob ID (null only for multipart types) *)
68
+
val blob_id : t -> id option
69
+
70
+
(** Get the size of the part in bytes *)
71
+
val size : t -> uint
72
+
73
+
(** Get the list of headers for this part *)
74
+
val headers : t -> Email_header.t list
75
+
76
+
(** Get the filename (if any) *)
77
+
val name : t -> string option
78
+
79
+
(** Get the MIME type *)
80
+
val mime_type : t -> string
81
+
82
+
(** Get the charset (if any) *)
83
+
val charset : t -> string option
84
+
85
+
(** Get the content disposition (if any) *)
86
+
val disposition : t -> string option
87
+
88
+
(** Get the content ID (if any) *)
89
+
val cid : t -> string option
90
+
91
+
(** Get the list of languages (if any) *)
92
+
val language : t -> string list option
93
+
94
+
(** Get the content location (if any) *)
95
+
val location : t -> string option
96
+
97
+
(** Get the sub-parts (only for multipart types) *)
98
+
val sub_parts : t -> t list option
99
+
100
+
(** Get any other requested headers (header properties) *)
101
+
val other_headers : t -> Yojson.Safe.t string_map
102
+
103
+
(** Create a new body part *)
104
+
val v :
105
+
?id:string ->
106
+
?blob_id:id ->
107
+
size:uint ->
108
+
headers:Email_header.t list ->
109
+
?name:string ->
110
+
mime_type:string ->
111
+
?charset:string ->
112
+
?disposition:string ->
113
+
?cid:string ->
114
+
?language:string list ->
115
+
?location:string ->
116
+
?sub_parts:t list ->
117
+
?other_headers:Yojson.Safe.t string_map ->
118
+
unit -> t
119
+
end
120
+
121
+
(** Represents the decoded value of a text body part.
122
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1.4> RFC 8621, Section 4.1.4 *)
123
+
module Email_body_value : sig
124
+
type t
125
+
126
+
(** Get the decoded text content *)
127
+
val value : t -> string
128
+
129
+
(** Check if there was an encoding problem *)
130
+
val has_encoding_problem : t -> bool
131
+
132
+
(** Check if the content was truncated *)
133
+
val is_truncated : t -> bool
134
+
135
+
(** Create a new body value *)
136
+
val v :
137
+
value:string ->
138
+
?encoding_problem:bool ->
139
+
?truncated:bool ->
140
+
unit -> t
141
+
end
142
+
143
+
(** Type to represent email message flags/keywords.
144
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1.1> RFC 8621, Section 4.1.1 *)
145
+
module Keywords : sig
146
+
(** Represents different types of JMAP keywords *)
147
+
type keyword =
148
+
| Draft (** "$draft": The Email is a draft the user is composing *)
149
+
| Seen (** "$seen": The Email has been read *)
150
+
| Flagged (** "$flagged": The Email has been flagged for urgent/special attention *)
151
+
| Answered (** "$answered": The Email has been replied to *)
152
+
153
+
(* Common extension keywords from RFC 5788 *)
154
+
| Forwarded (** "$forwarded": The Email has been forwarded *)
155
+
| Phishing (** "$phishing": The Email is likely to be phishing *)
156
+
| Junk (** "$junk": The Email is spam/junk *)
157
+
| NotJunk (** "$notjunk": The Email is explicitly marked as not spam/junk *)
158
+
| Custom of string (** Arbitrary user-defined keyword *)
159
+
160
+
(** A set of keywords applied to an email *)
161
+
type t = keyword list
162
+
163
+
(** Check if an email has the draft flag *)
164
+
val is_draft : t -> bool
165
+
166
+
(** Check if an email has been read *)
167
+
val is_seen : t -> bool
168
+
169
+
(** Check if an email has neither been read nor is a draft *)
170
+
val is_unread : t -> bool
171
+
172
+
(** Check if an email has been flagged *)
173
+
val is_flagged : t -> bool
174
+
175
+
(** Check if an email has been replied to *)
176
+
val is_answered : t -> bool
177
+
178
+
(** Check if an email has been forwarded *)
179
+
val is_forwarded : t -> bool
180
+
181
+
(** Check if an email is marked as likely phishing *)
182
+
val is_phishing : t -> bool
183
+
184
+
(** Check if an email is marked as junk/spam *)
185
+
val is_junk : t -> bool
186
+
187
+
(** Check if an email is explicitly marked as not junk/spam *)
188
+
val is_not_junk : t -> bool
189
+
190
+
(** Check if a specific custom keyword is set *)
191
+
val has_keyword : t -> string -> bool
192
+
193
+
(** Get a list of all custom keywords (excluding system keywords) *)
194
+
val custom_keywords : t -> string list
195
+
196
+
(** Add a keyword to the set *)
197
+
val add : t -> keyword -> t
198
+
199
+
(** Remove a keyword from the set *)
200
+
val remove : t -> keyword -> t
201
+
202
+
(** Create an empty keyword set *)
203
+
val empty : unit -> t
204
+
205
+
(** Create a new keyword set with the specified keywords *)
206
+
val of_list : keyword list -> t
207
+
208
+
(** Get the string representation of a keyword as used in the JMAP protocol *)
209
+
val to_string : keyword -> string
210
+
211
+
(** Parse a string into a keyword *)
212
+
val of_string : string -> keyword
213
+
214
+
(** Convert keyword set to string map representation as used in JMAP *)
215
+
val to_map : t -> bool string_map
216
+
end
217
+
218
+
(** Email properties enum.
219
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1> RFC 8621, Section 4.1 *)
220
+
type email_property =
221
+
| Id (** The id of the email *)
222
+
| BlobId (** The id of the blob containing the raw message *)
223
+
| ThreadId (** The id of the thread this email belongs to *)
224
+
| MailboxIds (** The mailboxes this email belongs to *)
225
+
| Keywords (** The keywords/flags for this email *)
226
+
| Size (** Size of the message in bytes *)
227
+
| ReceivedAt (** When the message was received by the server *)
228
+
| MessageId (** Value of the Message-ID header *)
229
+
| InReplyTo (** Value of the In-Reply-To header *)
230
+
| References (** Value of the References header *)
231
+
| Sender (** Value of the Sender header *)
232
+
| From (** Value of the From header *)
233
+
| To (** Value of the To header *)
234
+
| Cc (** Value of the Cc header *)
235
+
| Bcc (** Value of the Bcc header *)
236
+
| ReplyTo (** Value of the Reply-To header *)
237
+
| Subject (** Value of the Subject header *)
238
+
| SentAt (** Value of the Date header *)
239
+
| HasAttachment (** Whether the email has attachments *)
240
+
| Preview (** Preview text of the email *)
241
+
| BodyStructure (** MIME structure of the email *)
242
+
| BodyValues (** Decoded body part values *)
243
+
| TextBody (** Text body parts *)
244
+
| HtmlBody (** HTML body parts *)
245
+
| Attachments (** Attachments *)
246
+
| Header of string (** Specific header *)
247
+
| Other of string (** Extension property *)
248
+
249
+
(** Represents an Email object.
250
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1> RFC 8621, Section 4.1 *)
251
+
module Email : sig
252
+
(** Email type *)
253
+
type t
254
+
255
+
(** ID of the email *)
256
+
val id : t -> id option
257
+
258
+
(** ID of the blob containing the raw message *)
259
+
val blob_id : t -> id option
260
+
261
+
(** ID of the thread this email belongs to *)
262
+
val thread_id : t -> id option
263
+
264
+
(** The set of mailbox IDs this email belongs to *)
265
+
val mailbox_ids : t -> bool id_map option
266
+
267
+
(** The set of keywords/flags for this email *)
268
+
val keywords : t -> Keywords.t option
269
+
270
+
(** Size of the message in bytes *)
271
+
val size : t -> uint option
272
+
273
+
(** When the message was received by the server *)
274
+
val received_at : t -> date option
275
+
276
+
(** Subject of the email (if requested) *)
277
+
val subject : t -> string option
278
+
279
+
(** Preview text of the email (if requested) *)
280
+
val preview : t -> string option
281
+
282
+
(** From addresses (if requested) *)
283
+
val from : t -> Email_address.t list option
284
+
285
+
(** To addresses (if requested) *)
286
+
val to_ : t -> Email_address.t list option
287
+
288
+
(** CC addresses (if requested) *)
289
+
val cc : t -> Email_address.t list option
290
+
291
+
(** Message ID values (if requested) *)
292
+
val message_id : t -> string list option
293
+
294
+
(** Get whether the email has attachments (if requested) *)
295
+
val has_attachment : t -> bool option
296
+
297
+
(** Get text body parts (if requested) *)
298
+
val text_body : t -> Email_body_part.t list option
299
+
300
+
(** Get HTML body parts (if requested) *)
301
+
val html_body : t -> Email_body_part.t list option
302
+
303
+
(** Get attachments (if requested) *)
304
+
val attachments : t -> Email_body_part.t list option
305
+
306
+
(** Create a new Email object from a server response or for a new email *)
307
+
val create :
308
+
?id:id ->
309
+
?blob_id:id ->
310
+
?thread_id:id ->
311
+
?mailbox_ids:bool id_map ->
312
+
?keywords:Keywords.t ->
313
+
?size:uint ->
314
+
?received_at:date ->
315
+
?subject:string ->
316
+
?preview:string ->
317
+
?from:Email_address.t list ->
318
+
?to_:Email_address.t list ->
319
+
?cc:Email_address.t list ->
320
+
?message_id:string list ->
321
+
?has_attachment:bool ->
322
+
?text_body:Email_body_part.t list ->
323
+
?html_body:Email_body_part.t list ->
324
+
?attachments:Email_body_part.t list ->
325
+
unit -> t
326
+
327
+
(** Create a patch object for updating email properties *)
328
+
val make_patch :
329
+
?add_keywords:Keywords.t ->
330
+
?remove_keywords:Keywords.t ->
331
+
?add_mailboxes:id list ->
332
+
?remove_mailboxes:id list ->
333
+
unit -> Jmap.Methods.patch_object
334
+
335
+
(** Extract the ID from an email, returning a Result *)
336
+
val get_id : t -> (id, string) result
337
+
338
+
(** Take the ID from an email (fails with an exception if not present) *)
339
+
val take_id : t -> id
340
+
end
341
+
342
+
(** Email import options.
343
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.5> RFC 8621, Section 4.5 *)
344
+
type email_import_options = {
345
+
import_to_mailboxes : id list;
346
+
import_keywords : Keywords.t option;
347
+
import_received_at : date option;
348
+
}
349
+
350
+
(** Email copy options.
351
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.6> RFC 8621, Section 4.6 *)
352
+
type email_copy_options = {
353
+
copy_to_account_id : id;
354
+
copy_to_mailboxes : id list;
355
+
copy_on_success_destroy_original : bool option;
356
+
}
357
+
358
+
(** Convert a property variant to its string representation *)
359
+
val email_property_to_string : email_property -> string
360
+
361
+
(** Parse a string into a property variant *)
362
+
val string_to_email_property : string -> email_property
363
+
364
+
(** Get a list of common properties useful for displaying email lists *)
365
+
val common_email_properties : email_property list
366
+
367
+
(** Get a list of common properties for detailed email view *)
368
+
val detailed_email_properties : email_property list
+130
jmap-email/jmap_identity.ml
+130
jmap-email/jmap_identity.ml
···
1
+
(* JMAP Identity. *)
2
+
3
+
open Jmap.Types
4
+
open Jmap.Methods
5
+
6
+
(* Identity object. *)
7
+
type t = {
8
+
id_value: id;
9
+
name_value: string;
10
+
email_value: string;
11
+
reply_to_value: Jmap_email_types.Email_address.t list option;
12
+
bcc_value: Jmap_email_types.Email_address.t list option;
13
+
text_signature_value: string;
14
+
html_signature_value: string;
15
+
may_delete_value: bool;
16
+
}
17
+
18
+
(* Get the identity ID (immutable, server-set) *)
19
+
let id t = t.id_value
20
+
21
+
(* Get the display name (defaults to "") *)
22
+
let name t = t.name_value
23
+
24
+
(* Get the email address (immutable) *)
25
+
let email t = t.email_value
26
+
27
+
(* Get the reply-to addresses (if any) *)
28
+
let reply_to t = t.reply_to_value
29
+
30
+
(* Get the bcc addresses (if any) *)
31
+
let bcc t = t.bcc_value
32
+
33
+
(* Get the plain text signature (defaults to "") *)
34
+
let text_signature t = t.text_signature_value
35
+
36
+
(* Get the HTML signature (defaults to "") *)
37
+
let html_signature t = t.html_signature_value
38
+
39
+
(* Check if this identity may be deleted (server-set) *)
40
+
let may_delete t = t.may_delete_value
41
+
42
+
(* Create a new identity object *)
43
+
let v ~id ?(name="") ~email ?reply_to ?bcc ?(text_signature="") ?(html_signature="") ~may_delete () = {
44
+
id_value = id;
45
+
name_value = name;
46
+
email_value = email;
47
+
reply_to_value = reply_to;
48
+
bcc_value = bcc;
49
+
text_signature_value = text_signature;
50
+
html_signature_value = html_signature;
51
+
may_delete_value = may_delete;
52
+
}
53
+
54
+
(* Types and functions for identity creation and updates *)
55
+
module Create = struct
56
+
type t = {
57
+
name_value: string option;
58
+
email_value: string;
59
+
reply_to_value: Jmap_email_types.Email_address.t list option;
60
+
bcc_value: Jmap_email_types.Email_address.t list option;
61
+
text_signature_value: string option;
62
+
html_signature_value: string option;
63
+
}
64
+
65
+
(* Get the name (if specified) *)
66
+
let name t = t.name_value
67
+
68
+
(* Get the email address *)
69
+
let email t = t.email_value
70
+
71
+
(* Get the reply-to addresses (if any) *)
72
+
let reply_to t = t.reply_to_value
73
+
74
+
(* Get the bcc addresses (if any) *)
75
+
let bcc t = t.bcc_value
76
+
77
+
(* Get the plain text signature (if specified) *)
78
+
let text_signature t = t.text_signature_value
79
+
80
+
(* Get the HTML signature (if specified) *)
81
+
let html_signature t = t.html_signature_value
82
+
83
+
(* Create a new identity creation object *)
84
+
let v ?name ~email ?reply_to ?bcc ?text_signature ?html_signature () = {
85
+
name_value = name;
86
+
email_value = email;
87
+
reply_to_value = reply_to;
88
+
bcc_value = bcc;
89
+
text_signature_value = text_signature;
90
+
html_signature_value = html_signature;
91
+
}
92
+
93
+
(* Server response with info about the created identity *)
94
+
module Response = struct
95
+
type t = {
96
+
id_value: id;
97
+
may_delete_value: bool;
98
+
}
99
+
100
+
(* Get the server-assigned ID for the created identity *)
101
+
let id t = t.id_value
102
+
103
+
(* Check if this identity may be deleted *)
104
+
let may_delete t = t.may_delete_value
105
+
106
+
(* Create a new response object *)
107
+
let v ~id ~may_delete () = {
108
+
id_value = id;
109
+
may_delete_value = may_delete;
110
+
}
111
+
end
112
+
end
113
+
114
+
(* Identity object for update.
115
+
Patch object, specific structure not enforced here. *)
116
+
type update = patch_object
117
+
118
+
(* Server-set/computed info for updated identity.
119
+
Contains only changed server-set props. *)
120
+
module Update_response = struct
121
+
(* We use the same type as main identity *)
122
+
type identity_update = t
123
+
type t = identity_update
124
+
125
+
(* Convert to a full Identity object (contains only changed server-set props) *)
126
+
let to_identity t = (t : t :> t)
127
+
128
+
(* Create from a full Identity object *)
129
+
let of_identity t = (t : t :> t)
130
+
end
+114
jmap-email/jmap_identity.mli
+114
jmap-email/jmap_identity.mli
···
1
+
(** JMAP Identity.
2
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-6> RFC 8621, Section 6 *)
3
+
4
+
open Jmap.Types
5
+
open Jmap.Methods
6
+
7
+
(** Identity object.
8
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-6> RFC 8621, Section 6 *)
9
+
type t
10
+
11
+
(** Get the identity ID (immutable, server-set) *)
12
+
val id : t -> id
13
+
14
+
(** Get the display name (defaults to "") *)
15
+
val name : t -> string
16
+
17
+
(** Get the email address (immutable) *)
18
+
val email : t -> string
19
+
20
+
(** Get the reply-to addresses (if any) *)
21
+
val reply_to : t -> Jmap_email_types.Email_address.t list option
22
+
23
+
(** Get the bcc addresses (if any) *)
24
+
val bcc : t -> Jmap_email_types.Email_address.t list option
25
+
26
+
(** Get the plain text signature (defaults to "") *)
27
+
val text_signature : t -> string
28
+
29
+
(** Get the HTML signature (defaults to "") *)
30
+
val html_signature : t -> string
31
+
32
+
(** Check if this identity may be deleted (server-set) *)
33
+
val may_delete : t -> bool
34
+
35
+
(** Create a new identity object *)
36
+
val v :
37
+
id:id ->
38
+
?name:string ->
39
+
email:string ->
40
+
?reply_to:Jmap_email_types.Email_address.t list ->
41
+
?bcc:Jmap_email_types.Email_address.t list ->
42
+
?text_signature:string ->
43
+
?html_signature:string ->
44
+
may_delete:bool ->
45
+
unit -> t
46
+
47
+
(** Types and functions for identity creation and updates *)
48
+
module Create : sig
49
+
type t
50
+
51
+
(** Get the name (if specified) *)
52
+
val name : t -> string option
53
+
54
+
(** Get the email address *)
55
+
val email : t -> string
56
+
57
+
(** Get the reply-to addresses (if any) *)
58
+
val reply_to : t -> Jmap_email_types.Email_address.t list option
59
+
60
+
(** Get the bcc addresses (if any) *)
61
+
val bcc : t -> Jmap_email_types.Email_address.t list option
62
+
63
+
(** Get the plain text signature (if specified) *)
64
+
val text_signature : t -> string option
65
+
66
+
(** Get the HTML signature (if specified) *)
67
+
val html_signature : t -> string option
68
+
69
+
(** Create a new identity creation object *)
70
+
val v :
71
+
?name:string ->
72
+
email:string ->
73
+
?reply_to:Jmap_email_types.Email_address.t list ->
74
+
?bcc:Jmap_email_types.Email_address.t list ->
75
+
?text_signature:string ->
76
+
?html_signature:string ->
77
+
unit -> t
78
+
79
+
(** Server response with info about the created identity *)
80
+
module Response : sig
81
+
type t
82
+
83
+
(** Get the server-assigned ID for the created identity *)
84
+
val id : t -> id
85
+
86
+
(** Check if this identity may be deleted *)
87
+
val may_delete : t -> bool
88
+
89
+
(** Create a new response object *)
90
+
val v :
91
+
id:id ->
92
+
may_delete:bool ->
93
+
unit -> t
94
+
end
95
+
end
96
+
97
+
(** Identity object for update.
98
+
Patch object, specific structure not enforced here.
99
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-6.3> RFC 8621, Section 6.3 *)
100
+
type update = patch_object
101
+
102
+
(** Server-set/computed info for updated identity.
103
+
Contains only changed server-set props.
104
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-6.3> RFC 8621, Section 6.3 *)
105
+
module Update_response : sig
106
+
type t
107
+
108
+
(** Convert to a full Identity object (contains only changed server-set props) *)
109
+
val to_identity : t -> t
110
+
111
+
(** Create from a full Identity object *)
112
+
val of_identity : t -> t
113
+
end
114
+
+282
jmap-email/jmap_mailbox.ml
+282
jmap-email/jmap_mailbox.ml
···
1
+
(* JMAP Mailbox. *)
2
+
3
+
open Jmap.Types
4
+
open Jmap.Methods
5
+
6
+
(* Standard mailbox roles as defined in RFC 8621. *)
7
+
type role =
8
+
| Inbox (* Messages in the primary inbox *)
9
+
| Archive (* Archived messages *)
10
+
| Drafts (* Draft messages being composed *)
11
+
| Sent (* Messages that have been sent *)
12
+
| Trash (* Messages that have been deleted *)
13
+
| Junk (* Messages determined to be spam *)
14
+
| Important (* Messages deemed important *)
15
+
| Other of string (* Custom or non-standard role *)
16
+
| None (* No specific role assigned *)
17
+
18
+
(* Mailbox property identifiers. *)
19
+
type property =
20
+
| Id (* The id of the mailbox *)
21
+
| Name (* The name of the mailbox *)
22
+
| ParentId (* The id of the parent mailbox *)
23
+
| Role (* The role of the mailbox *)
24
+
| SortOrder (* The sort order of the mailbox *)
25
+
| TotalEmails (* The total number of emails in the mailbox *)
26
+
| UnreadEmails (* The number of unread emails in the mailbox *)
27
+
| TotalThreads (* The total number of threads in the mailbox *)
28
+
| UnreadThreads (* The number of unread threads in the mailbox *)
29
+
| MyRights (* The rights the user has for the mailbox *)
30
+
| IsSubscribed (* Whether the mailbox is subscribed to *)
31
+
| Other of string (* Any server-specific extension properties *)
32
+
33
+
(* Mailbox access rights. *)
34
+
type mailbox_rights = {
35
+
may_read_items : bool;
36
+
may_add_items : bool;
37
+
may_remove_items : bool;
38
+
may_set_seen : bool;
39
+
may_set_keywords : bool;
40
+
may_create_child : bool;
41
+
may_rename : bool;
42
+
may_delete : bool;
43
+
may_submit : bool;
44
+
}
45
+
46
+
(* Mailbox object. *)
47
+
type mailbox = {
48
+
mailbox_id : id; (* immutable, server-set *)
49
+
name : string;
50
+
parent_id : id option;
51
+
role : role option;
52
+
sort_order : uint; (* default: 0 *)
53
+
total_emails : uint; (* server-set *)
54
+
unread_emails : uint; (* server-set *)
55
+
total_threads : uint; (* server-set *)
56
+
unread_threads : uint; (* server-set *)
57
+
my_rights : mailbox_rights; (* server-set *)
58
+
is_subscribed : bool;
59
+
}
60
+
61
+
(* Mailbox object for creation.
62
+
Excludes server-set fields. *)
63
+
type mailbox_create = {
64
+
mailbox_create_name : string;
65
+
mailbox_create_parent_id : id option;
66
+
mailbox_create_role : role option;
67
+
mailbox_create_sort_order : uint option;
68
+
mailbox_create_is_subscribed : bool option;
69
+
}
70
+
71
+
(* Mailbox object for update.
72
+
Patch object, specific structure not enforced here. *)
73
+
type mailbox_update = patch_object
74
+
75
+
(* Server-set info for created mailbox. *)
76
+
type mailbox_created_info = {
77
+
mailbox_created_id : id;
78
+
mailbox_created_role : role option; (* If default used *)
79
+
mailbox_created_sort_order : uint; (* If default used *)
80
+
mailbox_created_total_emails : uint;
81
+
mailbox_created_unread_emails : uint;
82
+
mailbox_created_total_threads : uint;
83
+
mailbox_created_unread_threads : uint;
84
+
mailbox_created_my_rights : mailbox_rights;
85
+
mailbox_created_is_subscribed : bool; (* If default used *)
86
+
}
87
+
88
+
(* Server-set/computed info for updated mailbox. *)
89
+
type mailbox_updated_info = mailbox (* Contains only changed server-set props *)
90
+
91
+
(* FilterCondition for Mailbox/query. *)
92
+
type mailbox_filter_condition = {
93
+
filter_parent_id : id option option; (* Use option option for explicit null *)
94
+
filter_name : string option;
95
+
filter_role : role option option; (* Use option option for explicit null *)
96
+
filter_has_any_role : bool option;
97
+
filter_is_subscribed : bool option;
98
+
}
99
+
100
+
(* Role and Property Conversion Functions *)
101
+
102
+
(* Role conversion utilities *)
103
+
let role_to_string = function
104
+
| Inbox -> "inbox"
105
+
| Archive -> "archive"
106
+
| Drafts -> "drafts"
107
+
| Sent -> "sent"
108
+
| Trash -> "trash"
109
+
| Junk -> "junk"
110
+
| Important -> "important"
111
+
| Other s -> s
112
+
| None -> ""
113
+
114
+
let string_to_role = function
115
+
| "inbox" -> Inbox
116
+
| "archive" -> Archive
117
+
| "drafts" -> Drafts
118
+
| "sent" -> Sent
119
+
| "trash" -> Trash
120
+
| "junk" -> Junk
121
+
| "important" -> Important
122
+
| "" -> None
123
+
| s -> Other s
124
+
125
+
(* Property conversion utilities *)
126
+
let property_to_string = function
127
+
| Id -> "id"
128
+
| Name -> "name"
129
+
| ParentId -> "parentId"
130
+
| Role -> "role"
131
+
| SortOrder -> "sortOrder"
132
+
| TotalEmails -> "totalEmails"
133
+
| UnreadEmails -> "unreadEmails"
134
+
| TotalThreads -> "totalThreads"
135
+
| UnreadThreads -> "unreadThreads"
136
+
| MyRights -> "myRights"
137
+
| IsSubscribed -> "isSubscribed"
138
+
| Other s -> s
139
+
140
+
let string_to_property = function
141
+
| "id" -> Id
142
+
| "name" -> Name
143
+
| "parentId" -> ParentId
144
+
| "role" -> Role
145
+
| "sortOrder" -> SortOrder
146
+
| "totalEmails" -> TotalEmails
147
+
| "unreadEmails" -> UnreadEmails
148
+
| "totalThreads" -> TotalThreads
149
+
| "unreadThreads" -> UnreadThreads
150
+
| "myRights" -> MyRights
151
+
| "isSubscribed" -> IsSubscribed
152
+
| s -> Other s
153
+
154
+
(* Get a list of common properties useful for displaying mailboxes *)
155
+
let common_properties = [
156
+
Id; Name; ParentId; Role;
157
+
TotalEmails; UnreadEmails;
158
+
IsSubscribed
159
+
]
160
+
161
+
(* Get a list of all standard properties *)
162
+
let all_properties = [
163
+
Id; Name; ParentId; Role; SortOrder;
164
+
TotalEmails; UnreadEmails; TotalThreads; UnreadThreads;
165
+
MyRights; IsSubscribed
166
+
]
167
+
168
+
(* Check if a property is a count property (TotalEmails, UnreadEmails, etc.) *)
169
+
let is_count_property = function
170
+
| TotalEmails | UnreadEmails | TotalThreads | UnreadThreads -> true
171
+
| _ -> false
172
+
173
+
(* Mailbox Creation and Manipulation *)
174
+
175
+
(* Create a set of default rights with all permissions *)
176
+
let default_rights () = {
177
+
may_read_items = true;
178
+
may_add_items = true;
179
+
may_remove_items = true;
180
+
may_set_seen = true;
181
+
may_set_keywords = true;
182
+
may_create_child = true;
183
+
may_rename = true;
184
+
may_delete = true;
185
+
may_submit = true;
186
+
}
187
+
188
+
(* Create a set of read-only rights *)
189
+
let readonly_rights () = {
190
+
may_read_items = true;
191
+
may_add_items = false;
192
+
may_remove_items = false;
193
+
may_set_seen = false;
194
+
may_set_keywords = false;
195
+
may_create_child = false;
196
+
may_rename = false;
197
+
may_delete = false;
198
+
may_submit = false;
199
+
}
200
+
201
+
(* Create a new mailbox object with minimal required fields *)
202
+
let create ~name ?parent_id ?role ?sort_order ?is_subscribed () = {
203
+
mailbox_create_name = name;
204
+
mailbox_create_parent_id = parent_id;
205
+
mailbox_create_role = role;
206
+
mailbox_create_sort_order = sort_order;
207
+
mailbox_create_is_subscribed = is_subscribed;
208
+
}
209
+
210
+
(* Build a patch object for updating mailbox properties *)
211
+
let update ?name ?parent_id ?role ?sort_order ?is_subscribed () =
212
+
let patches = [] in
213
+
let patches =
214
+
match name with
215
+
| Some new_name -> ("name", `String new_name) :: patches
216
+
| None -> patches
217
+
in
218
+
let patches =
219
+
match parent_id with
220
+
| Some (Some pid) -> ("parentId", `String pid) :: patches
221
+
| Some None -> ("parentId", `Null) :: patches
222
+
| None -> patches
223
+
in
224
+
let patches =
225
+
match role with
226
+
| Some (Some r) -> ("role", `String (role_to_string r)) :: patches
227
+
| Some None -> ("role", `Null) :: patches
228
+
| None -> patches
229
+
in
230
+
let patches =
231
+
match sort_order with
232
+
| Some order -> ("sortOrder", `Int order) :: patches
233
+
| None -> patches
234
+
in
235
+
let patches =
236
+
match is_subscribed with
237
+
| Some subscribed -> ("isSubscribed", `Bool subscribed) :: patches
238
+
| None -> patches
239
+
in
240
+
patches
241
+
242
+
(* Get the list of standard role names and their string representations *)
243
+
let standard_role_names = [
244
+
(Inbox, "inbox");
245
+
(Archive, "archive");
246
+
(Drafts, "drafts");
247
+
(Sent, "sent");
248
+
(Trash, "trash");
249
+
(Junk, "junk");
250
+
(Important, "important");
251
+
(None, "");
252
+
]
253
+
254
+
(* Filter Construction *)
255
+
256
+
(* Create a filter to match mailboxes with a specific role *)
257
+
let filter_has_role role =
258
+
Filter.property_equals "role" (`String (role_to_string role))
259
+
260
+
(* Create a filter to match mailboxes with no role *)
261
+
let filter_has_no_role () =
262
+
Filter.property_equals "role" `Null
263
+
264
+
(* Create a filter to match mailboxes that are child of a given parent *)
265
+
let filter_has_parent parent_id =
266
+
Filter.property_equals "parentId" (`String parent_id)
267
+
268
+
(* Create a filter to match mailboxes at the root level (no parent) *)
269
+
let filter_is_root () =
270
+
Filter.property_equals "parentId" `Null
271
+
272
+
(* Create a filter to match subscribed mailboxes *)
273
+
let filter_is_subscribed () =
274
+
Filter.property_equals "isSubscribed" (`Bool true)
275
+
276
+
(* Create a filter to match unsubscribed mailboxes *)
277
+
let filter_is_not_subscribed () =
278
+
Filter.property_equals "isSubscribed" (`Bool false)
279
+
280
+
(* Create a filter to match mailboxes by name (using case-insensitive substring matching) *)
281
+
let filter_name_contains name =
282
+
Filter.text_contains "name" name
+183
jmap-email/jmap_mailbox.mli
+183
jmap-email/jmap_mailbox.mli
···
1
+
(** JMAP Mailbox.
2
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-2> RFC 8621, Section 2 *)
3
+
4
+
open Jmap.Types
5
+
open Jmap.Methods
6
+
7
+
(** Standard mailbox roles as defined in RFC 8621.
8
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-2> RFC 8621, Section 2 *)
9
+
type role =
10
+
| Inbox (** Messages in the primary inbox *)
11
+
| Archive (** Archived messages *)
12
+
| Drafts (** Draft messages being composed *)
13
+
| Sent (** Messages that have been sent *)
14
+
| Trash (** Messages that have been deleted *)
15
+
| Junk (** Messages determined to be spam *)
16
+
| Important (** Messages deemed important *)
17
+
| Other of string (** Custom or non-standard role *)
18
+
| None (** No specific role assigned *)
19
+
20
+
(** Mailbox property identifiers.
21
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-2> RFC 8621, Section 2 *)
22
+
type property =
23
+
| Id (** The id of the mailbox *)
24
+
| Name (** The name of the mailbox *)
25
+
| ParentId (** The id of the parent mailbox *)
26
+
| Role (** The role of the mailbox *)
27
+
| SortOrder (** The sort order of the mailbox *)
28
+
| TotalEmails (** The total number of emails in the mailbox *)
29
+
| UnreadEmails (** The number of unread emails in the mailbox *)
30
+
| TotalThreads (** The total number of threads in the mailbox *)
31
+
| UnreadThreads (** The number of unread threads in the mailbox *)
32
+
| MyRights (** The rights the user has for the mailbox *)
33
+
| IsSubscribed (** Whether the mailbox is subscribed to *)
34
+
| Other of string (** Any server-specific extension properties *)
35
+
36
+
(** Mailbox access rights.
37
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-2> RFC 8621, Section 2 *)
38
+
type mailbox_rights = {
39
+
may_read_items : bool;
40
+
may_add_items : bool;
41
+
may_remove_items : bool;
42
+
may_set_seen : bool;
43
+
may_set_keywords : bool;
44
+
may_create_child : bool;
45
+
may_rename : bool;
46
+
may_delete : bool;
47
+
may_submit : bool;
48
+
}
49
+
50
+
(** Mailbox object.
51
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-2> RFC 8621, Section 2 *)
52
+
type mailbox = {
53
+
mailbox_id : id; (** immutable, server-set *)
54
+
name : string;
55
+
parent_id : id option;
56
+
role : role option;
57
+
sort_order : uint; (* default: 0 *)
58
+
total_emails : uint; (** server-set *)
59
+
unread_emails : uint; (** server-set *)
60
+
total_threads : uint; (** server-set *)
61
+
unread_threads : uint; (** server-set *)
62
+
my_rights : mailbox_rights; (** server-set *)
63
+
is_subscribed : bool;
64
+
}
65
+
66
+
(** Mailbox object for creation.
67
+
Excludes server-set fields.
68
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-2> RFC 8621, Section 2 *)
69
+
type mailbox_create = {
70
+
mailbox_create_name : string;
71
+
mailbox_create_parent_id : id option;
72
+
mailbox_create_role : role option;
73
+
mailbox_create_sort_order : uint option;
74
+
mailbox_create_is_subscribed : bool option;
75
+
}
76
+
77
+
(** Mailbox object for update.
78
+
Patch object, specific structure not enforced here.
79
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-2.5> RFC 8621, Section 2.5 *)
80
+
type mailbox_update = patch_object
81
+
82
+
(** Server-set info for created mailbox.
83
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-2.5> RFC 8621, Section 2.5 *)
84
+
type mailbox_created_info = {
85
+
mailbox_created_id : id;
86
+
mailbox_created_role : role option; (** If default used *)
87
+
mailbox_created_sort_order : uint; (** If default used *)
88
+
mailbox_created_total_emails : uint;
89
+
mailbox_created_unread_emails : uint;
90
+
mailbox_created_total_threads : uint;
91
+
mailbox_created_unread_threads : uint;
92
+
mailbox_created_my_rights : mailbox_rights;
93
+
mailbox_created_is_subscribed : bool; (** If default used *)
94
+
}
95
+
96
+
(** Server-set/computed info for updated mailbox.
97
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-2.5> RFC 8621, Section 2.5 *)
98
+
type mailbox_updated_info = mailbox (* Contains only changed server-set props *)
99
+
100
+
(** FilterCondition for Mailbox/query.
101
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-2.3> RFC 8621, Section 2.3 *)
102
+
type mailbox_filter_condition = {
103
+
filter_parent_id : id option option; (* Use option option for explicit null *)
104
+
filter_name : string option;
105
+
filter_role : role option option; (* Use option option for explicit null *)
106
+
filter_has_any_role : bool option;
107
+
filter_is_subscribed : bool option;
108
+
}
109
+
110
+
(** {2 Role and Property Conversion Functions} *)
111
+
112
+
(** Convert a role variant to its string representation *)
113
+
val role_to_string : role -> string
114
+
115
+
(** Parse a string into a role variant *)
116
+
val string_to_role : string -> role
117
+
118
+
(** Convert a property variant to its string representation *)
119
+
val property_to_string : property -> string
120
+
121
+
(** Parse a string into a property variant *)
122
+
val string_to_property : string -> property
123
+
124
+
(** Get a list of common properties useful for displaying mailboxes *)
125
+
val common_properties : property list
126
+
127
+
(** Get a list of all standard properties *)
128
+
val all_properties : property list
129
+
130
+
(** Check if a property is a count property (TotalEmails, UnreadEmails, etc.) *)
131
+
val is_count_property : property -> bool
132
+
133
+
(** {2 Mailbox Creation and Manipulation} *)
134
+
135
+
(** Create a set of default rights with all permissions *)
136
+
val default_rights : unit -> mailbox_rights
137
+
138
+
(** Create a set of read-only rights *)
139
+
val readonly_rights : unit -> mailbox_rights
140
+
141
+
(** Create a new mailbox object with minimal required fields *)
142
+
val create :
143
+
name:string ->
144
+
?parent_id:id ->
145
+
?role:role ->
146
+
?sort_order:uint ->
147
+
?is_subscribed:bool ->
148
+
unit -> mailbox_create
149
+
150
+
(** Build a patch object for updating mailbox properties *)
151
+
val update :
152
+
?name:string ->
153
+
?parent_id:id option ->
154
+
?role:role option ->
155
+
?sort_order:uint ->
156
+
?is_subscribed:bool ->
157
+
unit -> mailbox_update
158
+
159
+
(** Get the list of standard role names and their string representations *)
160
+
val standard_role_names : (role * string) list
161
+
162
+
(** {2 Filter Construction} *)
163
+
164
+
(** Create a filter to match mailboxes with a specific role *)
165
+
val filter_has_role : role -> Jmap.Methods.Filter.t
166
+
167
+
(** Create a filter to match mailboxes with no role *)
168
+
val filter_has_no_role : unit -> Jmap.Methods.Filter.t
169
+
170
+
(** Create a filter to match mailboxes that are child of a given parent *)
171
+
val filter_has_parent : id -> Jmap.Methods.Filter.t
172
+
173
+
(** Create a filter to match mailboxes at the root level (no parent) *)
174
+
val filter_is_root : unit -> Jmap.Methods.Filter.t
175
+
176
+
(** Create a filter to match subscribed mailboxes *)
177
+
val filter_is_subscribed : unit -> Jmap.Methods.Filter.t
178
+
179
+
(** Create a filter to match unsubscribed mailboxes *)
180
+
val filter_is_not_subscribed : unit -> Jmap.Methods.Filter.t
181
+
182
+
(** Create a filter to match mailboxes by name (using case-insensitive substring matching) *)
183
+
val filter_name_contains : string -> Jmap.Methods.Filter.t
+9
jmap-email/jmap_search_snippet.ml
+9
jmap-email/jmap_search_snippet.ml
+11
jmap-email/jmap_search_snippet.mli
+11
jmap-email/jmap_search_snippet.mli
···
1
+
(** JMAP Search Snippet.
2
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-5> RFC 8621, Section 5 *)
3
+
4
+
(** SearchSnippet object.
5
+
Note: Does not have an 'id' property.
6
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-5> RFC 8621, Section 5 *)
7
+
type t = {
8
+
email_id : Jmap.Types.id;
9
+
subject : string option;
10
+
preview : string option;
11
+
}
+125
jmap-email/jmap_submission.ml
+125
jmap-email/jmap_submission.ml
···
1
+
(* JMAP Email Submission. *)
2
+
3
+
open Jmap.Types
4
+
open Jmap.Methods
5
+
6
+
(* Address object for Envelope. *)
7
+
type envelope_address = {
8
+
env_addr_email : string;
9
+
env_addr_parameters : Yojson.Safe.t string_map option;
10
+
}
11
+
12
+
(* Envelope object. *)
13
+
type envelope = {
14
+
env_mail_from : envelope_address;
15
+
env_rcpt_to : envelope_address list;
16
+
}
17
+
18
+
(* Delivery status for a recipient. *)
19
+
type delivery_status = {
20
+
delivery_smtp_reply : string;
21
+
delivery_delivered : [ `Queued | `Yes | `No | `Unknown ];
22
+
delivery_displayed : [ `Yes | `Unknown ];
23
+
}
24
+
25
+
(* EmailSubmission object. *)
26
+
type email_submission = {
27
+
email_sub_id : id; (* immutable, server-set *)
28
+
identity_id : id; (* immutable *)
29
+
email_id : id; (* immutable *)
30
+
thread_id : id; (* immutable, server-set *)
31
+
envelope : envelope option; (* immutable *)
32
+
send_at : utc_date; (* immutable, server-set *)
33
+
undo_status : [ `Pending | `Final | `Canceled ];
34
+
delivery_status : delivery_status string_map option; (* server-set *)
35
+
dsn_blob_ids : id list; (* server-set *)
36
+
mdn_blob_ids : id list; (* server-set *)
37
+
}
38
+
39
+
(* EmailSubmission object for creation.
40
+
Excludes server-set fields. *)
41
+
type email_submission_create = {
42
+
email_sub_create_identity_id : id;
43
+
email_sub_create_email_id : id;
44
+
email_sub_create_envelope : envelope option;
45
+
}
46
+
47
+
(* EmailSubmission object for update.
48
+
Only undoStatus can be updated (to 'canceled'). *)
49
+
type email_submission_update = patch_object
50
+
51
+
(* Server-set info for created email submission. *)
52
+
type email_submission_created_info = {
53
+
email_sub_created_id : id;
54
+
email_sub_created_thread_id : id;
55
+
email_sub_created_send_at : utc_date;
56
+
}
57
+
58
+
(* Server-set/computed info for updated email submission. *)
59
+
type email_submission_updated_info = email_submission (* Contains only changed server-set props *)
60
+
61
+
(* FilterCondition for EmailSubmission/query. *)
62
+
type email_submission_filter_condition = {
63
+
filter_identity_ids : id list option;
64
+
filter_email_ids : id list option;
65
+
filter_thread_ids : id list option;
66
+
filter_undo_status : [ `Pending | `Final | `Canceled ] option;
67
+
filter_before : utc_date option;
68
+
filter_after : utc_date option;
69
+
}
70
+
71
+
(* EmailSubmission/get: Args type (specialized from ['record Get_args.t]). *)
72
+
module Email_submission_get_args = struct
73
+
type t = email_submission Get_args.t
74
+
end
75
+
76
+
(* EmailSubmission/get: Response type (specialized from ['record Get_response.t]). *)
77
+
module Email_submission_get_response = struct
78
+
type t = email_submission Get_response.t
79
+
end
80
+
81
+
(* EmailSubmission/changes: Args type (specialized from [Changes_args.t]). *)
82
+
module Email_submission_changes_args = struct
83
+
type t = Changes_args.t
84
+
end
85
+
86
+
(* EmailSubmission/changes: Response type (specialized from [Changes_response.t]). *)
87
+
module Email_submission_changes_response = struct
88
+
type t = Changes_response.t
89
+
end
90
+
91
+
(* EmailSubmission/query: Args type (specialized from [Query_args.t]). *)
92
+
module Email_submission_query_args = struct
93
+
type t = Query_args.t
94
+
end
95
+
96
+
(* EmailSubmission/query: Response type (specialized from [Query_response.t]). *)
97
+
module Email_submission_query_response = struct
98
+
type t = Query_response.t
99
+
end
100
+
101
+
(* EmailSubmission/queryChanges: Args type (specialized from [Query_changes_args.t]). *)
102
+
module Email_submission_query_changes_args = struct
103
+
type t = Query_changes_args.t
104
+
end
105
+
106
+
(* EmailSubmission/queryChanges: Response type (specialized from [Query_changes_response.t]). *)
107
+
module Email_submission_query_changes_response = struct
108
+
type t = Query_changes_response.t
109
+
end
110
+
111
+
(* EmailSubmission/set: Args type (specialized from [('c, 'u) set_args]).
112
+
Includes onSuccess arguments. *)
113
+
type email_submission_set_args = {
114
+
set_account_id : id;
115
+
set_if_in_state : string option;
116
+
set_create : email_submission_create id_map option;
117
+
set_update : email_submission_update id_map option;
118
+
set_destroy : id list option;
119
+
set_on_success_destroy_email : id list option;
120
+
}
121
+
122
+
(* EmailSubmission/set: Response type (specialized from [('c, 'u) Set_response.t]). *)
123
+
module Email_submission_set_response = struct
124
+
type t = (email_submission_created_info, email_submission_updated_info) Set_response.t
125
+
end
+136
jmap-email/jmap_submission.mli
+136
jmap-email/jmap_submission.mli
···
1
+
(** JMAP Email Submission.
2
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-7> RFC 8621, Section 7 *)
3
+
4
+
open Jmap.Types
5
+
open Jmap.Methods
6
+
7
+
(** Address object for Envelope.
8
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-7> RFC 8621, Section 7 *)
9
+
type envelope_address = {
10
+
env_addr_email : string;
11
+
env_addr_parameters : Yojson.Safe.t string_map option;
12
+
}
13
+
14
+
(** Envelope object.
15
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-7> RFC 8621, Section 7 *)
16
+
type envelope = {
17
+
env_mail_from : envelope_address;
18
+
env_rcpt_to : envelope_address list;
19
+
}
20
+
21
+
(** Delivery status for a recipient.
22
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-7> RFC 8621, Section 7 *)
23
+
type delivery_status = {
24
+
delivery_smtp_reply : string;
25
+
delivery_delivered : [ `Queued | `Yes | `No | `Unknown ];
26
+
delivery_displayed : [ `Yes | `Unknown ];
27
+
}
28
+
29
+
(** EmailSubmission object.
30
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-7> RFC 8621, Section 7 *)
31
+
type email_submission = {
32
+
email_sub_id : id; (** immutable, server-set *)
33
+
identity_id : id; (** immutable *)
34
+
email_id : id; (** immutable *)
35
+
thread_id : id; (** immutable, server-set *)
36
+
envelope : envelope option; (** immutable *)
37
+
send_at : utc_date; (** immutable, server-set *)
38
+
undo_status : [ `Pending | `Final | `Canceled ];
39
+
delivery_status : delivery_status string_map option; (** server-set *)
40
+
dsn_blob_ids : id list; (** server-set *)
41
+
mdn_blob_ids : id list; (** server-set *)
42
+
}
43
+
44
+
(** EmailSubmission object for creation.
45
+
Excludes server-set fields.
46
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-7> RFC 8621, Section 7 *)
47
+
type email_submission_create = {
48
+
email_sub_create_identity_id : id;
49
+
email_sub_create_email_id : id;
50
+
email_sub_create_envelope : envelope option;
51
+
}
52
+
53
+
(** EmailSubmission object for update.
54
+
Only undoStatus can be updated (to 'canceled').
55
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-7> RFC 8621, Section 7 *)
56
+
type email_submission_update = patch_object
57
+
58
+
(** Server-set info for created email submission.
59
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-7.5> RFC 8621, Section 7.5 *)
60
+
type email_submission_created_info = {
61
+
email_sub_created_id : id;
62
+
email_sub_created_thread_id : id;
63
+
email_sub_created_send_at : utc_date;
64
+
}
65
+
66
+
(** Server-set/computed info for updated email submission.
67
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-7.5> RFC 8621, Section 7.5 *)
68
+
type email_submission_updated_info = email_submission (* Contains only changed server-set props *)
69
+
70
+
(** FilterCondition for EmailSubmission/query.
71
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-7.3> RFC 8621, Section 7.3 *)
72
+
type email_submission_filter_condition = {
73
+
filter_identity_ids : id list option;
74
+
filter_email_ids : id list option;
75
+
filter_thread_ids : id list option;
76
+
filter_undo_status : [ `Pending | `Final | `Canceled ] option;
77
+
filter_before : utc_date option;
78
+
filter_after : utc_date option;
79
+
}
80
+
81
+
(** EmailSubmission/get: Args type (specialized from ['record Get_args.t]). *)
82
+
module Email_submission_get_args : sig
83
+
type t = email_submission Get_args.t
84
+
end
85
+
86
+
(** EmailSubmission/get: Response type (specialized from ['record Get_response.t]). *)
87
+
module Email_submission_get_response : sig
88
+
type t = email_submission Get_response.t
89
+
end
90
+
91
+
(** EmailSubmission/changes: Args type (specialized from [Changes_args.t]). *)
92
+
module Email_submission_changes_args : sig
93
+
type t = Changes_args.t
94
+
end
95
+
96
+
(** EmailSubmission/changes: Response type (specialized from [Changes_response.t]). *)
97
+
module Email_submission_changes_response : sig
98
+
type t = Changes_response.t
99
+
end
100
+
101
+
(** EmailSubmission/query: Args type (specialized from [Query_args.t]). *)
102
+
module Email_submission_query_args : sig
103
+
type t = Query_args.t
104
+
end
105
+
106
+
(** EmailSubmission/query: Response type (specialized from [Query_response.t]). *)
107
+
module Email_submission_query_response : sig
108
+
type t = Query_response.t
109
+
end
110
+
111
+
(** EmailSubmission/queryChanges: Args type (specialized from [Query_changes_args.t]). *)
112
+
module Email_submission_query_changes_args : sig
113
+
type t = Query_changes_args.t
114
+
end
115
+
116
+
(** EmailSubmission/queryChanges: Response type (specialized from [Query_changes_response.t]). *)
117
+
module Email_submission_query_changes_response : sig
118
+
type t = Query_changes_response.t
119
+
end
120
+
121
+
(** EmailSubmission/set: Args type (specialized from [('c, 'u) set_args]).
122
+
Includes onSuccess arguments.
123
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-7.5> RFC 8621, Section 7.5 *)
124
+
type email_submission_set_args = {
125
+
set_account_id : id;
126
+
set_if_in_state : string option;
127
+
set_create : email_submission_create id_map option;
128
+
set_update : email_submission_update id_map option;
129
+
set_destroy : id list option;
130
+
set_on_success_destroy_email : id list option;
131
+
}
132
+
133
+
(** EmailSubmission/set: Response type (specialized from [('c, 'u) Set_response.t]). *)
134
+
module Email_submission_set_response : sig
135
+
type t = (email_submission_created_info, email_submission_updated_info) Set_response.t
136
+
end
+19
jmap-email/jmap_thread.ml
+19
jmap-email/jmap_thread.ml
···
1
+
(* JMAP Thread. *)
2
+
3
+
open Jmap.Types
4
+
5
+
(* Thread object. *)
6
+
module Thread = struct
7
+
type t = {
8
+
id_value: id;
9
+
email_ids_value: id list;
10
+
}
11
+
12
+
let id t = t.id_value
13
+
let email_ids t = t.email_ids_value
14
+
15
+
let v ~id ~email_ids = {
16
+
id_value = id;
17
+
email_ids_value = email_ids;
18
+
}
19
+
end
+15
jmap-email/jmap_thread.mli
+15
jmap-email/jmap_thread.mli
···
1
+
(** JMAP Thread.
2
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-3> RFC 8621, Section 3 *)
3
+
4
+
open Jmap.Types
5
+
6
+
(** Thread object.
7
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-3> RFC 8621, Section 3 *)
8
+
module Thread : sig
9
+
type t
10
+
11
+
val id : t -> id
12
+
val email_ids : t -> id list
13
+
14
+
val v : id:id -> email_ids:id list -> t
15
+
end
+103
jmap-email/jmap_vacation.ml
+103
jmap-email/jmap_vacation.ml
···
1
+
(* JMAP Vacation Response. *)
2
+
3
+
open Jmap.Types
4
+
open Jmap.Methods
5
+
open Jmap.Error
6
+
7
+
(* VacationResponse object.
8
+
Note: id is always "singleton". *)
9
+
module Vacation_response = struct
10
+
type t = {
11
+
id_value: id;
12
+
is_enabled_value: bool;
13
+
from_date_value: utc_date option;
14
+
to_date_value: utc_date option;
15
+
subject_value: string option;
16
+
text_body_value: string option;
17
+
html_body_value: string option;
18
+
}
19
+
20
+
(* Id of the vacation response (immutable, server-set, MUST be "singleton") *)
21
+
let id t = t.id_value
22
+
let is_enabled t = t.is_enabled_value
23
+
let from_date t = t.from_date_value
24
+
let to_date t = t.to_date_value
25
+
let subject t = t.subject_value
26
+
let text_body t = t.text_body_value
27
+
let html_body t = t.html_body_value
28
+
29
+
let v ~id ~is_enabled ?from_date ?to_date ?subject ?text_body ?html_body () = {
30
+
id_value = id;
31
+
is_enabled_value = is_enabled;
32
+
from_date_value = from_date;
33
+
to_date_value = to_date;
34
+
subject_value = subject;
35
+
text_body_value = text_body;
36
+
html_body_value = html_body;
37
+
}
38
+
end
39
+
40
+
(* VacationResponse object for update.
41
+
Patch object, specific structure not enforced here. *)
42
+
type vacation_response_update = patch_object
43
+
44
+
(* VacationResponse/get: Args type (specialized from ['record get_args]). *)
45
+
module Vacation_response_get_args = struct
46
+
type t = Vacation_response.t Get_args.t
47
+
48
+
let v ~account_id ?ids ?properties () =
49
+
Get_args.v ~account_id ?ids ?properties ()
50
+
end
51
+
52
+
(* VacationResponse/get: Response type (specialized from ['record get_response]). *)
53
+
module Vacation_response_get_response = struct
54
+
type t = Vacation_response.t Get_response.t
55
+
56
+
let v ~account_id ~state ~list ~not_found () =
57
+
Get_response.v ~account_id ~state ~list ~not_found ()
58
+
end
59
+
60
+
(* VacationResponse/set: Args type.
61
+
Only allows update, id must be "singleton". *)
62
+
module Vacation_response_set_args = struct
63
+
type t = {
64
+
account_id_value: id;
65
+
if_in_state_value: string option;
66
+
update_value: vacation_response_update id_map option;
67
+
}
68
+
69
+
let account_id t = t.account_id_value
70
+
let if_in_state t = t.if_in_state_value
71
+
let update t = t.update_value
72
+
73
+
let v ~account_id ?if_in_state ?update () = {
74
+
account_id_value = account_id;
75
+
if_in_state_value = if_in_state;
76
+
update_value = update;
77
+
}
78
+
end
79
+
80
+
(* VacationResponse/set: Response type. *)
81
+
module Vacation_response_set_response = struct
82
+
type t = {
83
+
account_id_value: id;
84
+
old_state_value: string option;
85
+
new_state_value: string;
86
+
updated_value: Vacation_response.t option id_map option;
87
+
not_updated_value: Set_error.t id_map option;
88
+
}
89
+
90
+
let account_id t = t.account_id_value
91
+
let old_state t = t.old_state_value
92
+
let new_state t = t.new_state_value
93
+
let updated t = t.updated_value
94
+
let not_updated t = t.not_updated_value
95
+
96
+
let v ~account_id ?old_state ~new_state ?updated ?not_updated () = {
97
+
account_id_value = account_id;
98
+
old_state_value = old_state;
99
+
new_state_value = new_state;
100
+
updated_value = updated;
101
+
not_updated_value = not_updated;
102
+
}
103
+
end
+102
jmap-email/jmap_vacation.mli
+102
jmap-email/jmap_vacation.mli
···
1
+
(** JMAP Vacation Response.
2
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-8> RFC 8621, Section 8 *)
3
+
4
+
open Jmap.Types
5
+
open Jmap.Methods
6
+
open Jmap.Error
7
+
8
+
(** VacationResponse object.
9
+
Note: id is always "singleton".
10
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-8> RFC 8621, Section 8 *)
11
+
module Vacation_response : sig
12
+
type t
13
+
14
+
(** Id of the vacation response (immutable, server-set, MUST be "singleton") *)
15
+
val id : t -> id
16
+
val is_enabled : t -> bool
17
+
val from_date : t -> utc_date option
18
+
val to_date : t -> utc_date option
19
+
val subject : t -> string option
20
+
val text_body : t -> string option
21
+
val html_body : t -> string option
22
+
23
+
val v :
24
+
id:id ->
25
+
is_enabled:bool ->
26
+
?from_date:utc_date ->
27
+
?to_date:utc_date ->
28
+
?subject:string ->
29
+
?text_body:string ->
30
+
?html_body:string ->
31
+
unit ->
32
+
t
33
+
end
34
+
35
+
(** VacationResponse object for update.
36
+
Patch object, specific structure not enforced here.
37
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-8.2> RFC 8621, Section 8.2 *)
38
+
type vacation_response_update = patch_object
39
+
40
+
(** VacationResponse/get: Args type (specialized from ['record get_args]). *)
41
+
module Vacation_response_get_args : sig
42
+
type t = Vacation_response.t Get_args.t
43
+
44
+
val v :
45
+
account_id:id ->
46
+
?ids:id list ->
47
+
?properties:string list ->
48
+
unit ->
49
+
t
50
+
end
51
+
52
+
(** VacationResponse/get: Response type (specialized from ['record get_response]). *)
53
+
module Vacation_response_get_response : sig
54
+
type t = Vacation_response.t Get_response.t
55
+
56
+
val v :
57
+
account_id:id ->
58
+
state:string ->
59
+
list:Vacation_response.t list ->
60
+
not_found:id list ->
61
+
unit ->
62
+
t
63
+
end
64
+
65
+
(** VacationResponse/set: Args type.
66
+
Only allows update, id must be "singleton".
67
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-8.2> RFC 8621, Section 8.2 *)
68
+
module Vacation_response_set_args : sig
69
+
type t
70
+
71
+
val account_id : t -> id
72
+
val if_in_state : t -> string option
73
+
val update : t -> vacation_response_update id_map option
74
+
75
+
val v :
76
+
account_id:id ->
77
+
?if_in_state:string ->
78
+
?update:vacation_response_update id_map ->
79
+
unit ->
80
+
t
81
+
end
82
+
83
+
(** VacationResponse/set: Response type.
84
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-8.2> RFC 8621, Section 8.2 *)
85
+
module Vacation_response_set_response : sig
86
+
type t
87
+
88
+
val account_id : t -> id
89
+
val old_state : t -> string option
90
+
val new_state : t -> string
91
+
val updated : t -> Vacation_response.t option id_map option
92
+
val not_updated : t -> Set_error.t id_map option
93
+
94
+
val v :
95
+
account_id:id ->
96
+
?old_state:string ->
97
+
new_state:string ->
98
+
?updated:Vacation_response.t option id_map ->
99
+
?not_updated:Set_error.t id_map ->
100
+
unit ->
101
+
t
102
+
end
+21
jmap-unix.opam
+21
jmap-unix.opam
···
1
+
opam-version: "2.0"
2
+
name: "jmap-unix"
3
+
version: "~dev"
4
+
synopsis: "JMAP Unix implementation"
5
+
description: "Unix-specific implementation of the JMAP protocol (RFC8620)"
6
+
maintainer: ["maintainer@example.com"]
7
+
authors: ["JMAP OCaml Team"]
8
+
license: "MIT"
9
+
homepage: "https://github.com/example/jmap-ocaml"
10
+
bug-reports: "https://github.com/example/jmap-ocaml/issues"
11
+
depends: [
12
+
"ocaml" {>= "4.08.0"}
13
+
"dune" {>= "2.0.0"}
14
+
"jmap"
15
+
"yojson" {>= "1.7.0"}
16
+
"uri" {>= "4.0.0"}
17
+
"unix"
18
+
]
19
+
build: [
20
+
["dune" "build" "-p" name "-j" jobs]
21
+
]
+62
jmap-unix/README.md
+62
jmap-unix/README.md
···
1
+
# JMAP Unix Implementation
2
+
3
+
This library provides Unix-specific implementation for the core JMAP protocol.
4
+
5
+
## Overview
6
+
7
+
Jmap_unix provides the implementation needed to make actual connections to JMAP servers
8
+
using OCaml's Unix module. It handles:
9
+
10
+
- HTTP connections to JMAP endpoints
11
+
- Authentication
12
+
- Session discovery
13
+
- Request/response handling
14
+
- Blob upload/download
15
+
- High-level email operations (Jmap_unix.Email)
16
+
17
+
## Usage
18
+
19
+
```ocaml
20
+
open Jmap
21
+
open Jmap_unix
22
+
23
+
(* Create a connection to a JMAP server *)
24
+
let credentials = Basic("username", "password") in
25
+
let (ctx, session) = Jmap_unix.connect ~host:"jmap.example.com" ~credentials in
26
+
27
+
(* Use the connection for JMAP requests *)
28
+
let response = Jmap_unix.request ctx request in
29
+
30
+
(* Close the connection when done *)
31
+
Jmap_unix.close ctx
32
+
```
33
+
34
+
## Email Operations
35
+
36
+
The Email module provides high-level operations for working with emails:
37
+
38
+
```ocaml
39
+
open Jmap
40
+
open Jmap.Unix
41
+
42
+
(* Get an email *)
43
+
let email = Email.get_email ctx ~account_id ~email_id ()
44
+
45
+
(* Search for unread emails *)
46
+
let filter = Jmap_email.Email_filter.unread ()
47
+
let (ids, emails) = Email.search_emails ctx ~account_id ~filter ()
48
+
49
+
(* Mark emails as read *)
50
+
Email.mark_as_seen ctx ~account_id ~email_ids:["email1"; "email2"] ()
51
+
52
+
(* Move emails to another mailbox *)
53
+
Email.move_emails ctx ~account_id ~email_ids ~mailbox_id ()
54
+
```
55
+
56
+
## Dependencies
57
+
58
+
- jmap (core library)
59
+
- jmap-email (email types and helpers)
60
+
- yojson
61
+
- uri
62
+
- unix
+5
jmap-unix/dune
+5
jmap-unix/dune
+672
jmap-unix/jmap_unix.ml
+672
jmap-unix/jmap_unix.ml
···
1
+
(* Unix-specific JMAP client implementation interface. *)
2
+
3
+
open Jmap
4
+
open Jmap.Types
5
+
open Jmap.Error
6
+
open Jmap.Session
7
+
open Jmap.Wire
8
+
9
+
(* Configuration options for a JMAP client context *)
10
+
type client_config = {
11
+
connect_timeout : float option; (* Connection timeout in seconds *)
12
+
request_timeout : float option; (* Request timeout in seconds *)
13
+
max_concurrent_requests : int option; (* Maximum concurrent requests *)
14
+
max_request_size : int option; (* Maximum request size in bytes *)
15
+
user_agent : string option; (* User-Agent header value *)
16
+
authentication_header : string option; (* Custom Authentication header name *)
17
+
}
18
+
19
+
(* Authentication method options *)
20
+
type auth_method =
21
+
| Basic of string * string (* Basic auth with username and password *)
22
+
| Bearer of string (* Bearer token auth *)
23
+
| Custom of (string * string) (* Custom header name and value *)
24
+
| Session_cookie of (string * string) (* Session cookie name and value *)
25
+
| No_auth (* No authentication *)
26
+
27
+
(* The internal state of a JMAP client connection *)
28
+
type context = {
29
+
config: client_config;
30
+
mutable session_url: Uri.t option;
31
+
mutable session: Session.t option;
32
+
mutable auth: auth_method;
33
+
}
34
+
35
+
(* Represents an active EventSource connection *)
36
+
type event_source_connection = {
37
+
event_url: Uri.t;
38
+
mutable is_connected: bool;
39
+
}
40
+
41
+
(* A request builder for constructing and sending JMAP requests *)
42
+
type request_builder = {
43
+
ctx: context;
44
+
mutable using: string list;
45
+
mutable method_calls: Invocation.t list;
46
+
}
47
+
48
+
(* Create default configuration options *)
49
+
let default_config () = {
50
+
connect_timeout = Some 30.0;
51
+
request_timeout = Some 300.0;
52
+
max_concurrent_requests = Some 4;
53
+
max_request_size = Some (1024 * 1024 * 10); (* 10 MB *)
54
+
user_agent = Some "OCaml JMAP Unix Client/1.0";
55
+
authentication_header = None;
56
+
}
57
+
58
+
(* Create a client context with the specified configuration *)
59
+
let create_client ?(config = default_config ()) () = {
60
+
config;
61
+
session_url = None;
62
+
session = None;
63
+
auth = No_auth;
64
+
}
65
+
66
+
(* Mock implementation for the Unix connection *)
67
+
let connect ctx ?session_url ?username ~host ?port ?auth_method () =
68
+
(* In a real implementation, this would use Unix HTTP functions *)
69
+
let auth = match auth_method with
70
+
| Some auth -> auth
71
+
| None -> No_auth
72
+
in
73
+
74
+
(* Store the auth method for future requests *)
75
+
ctx.auth <- auth;
76
+
77
+
(* Set session URL, either directly or after discovery *)
78
+
let session_url = match session_url with
79
+
| Some url -> url
80
+
| None ->
81
+
(* In a real implementation, this would perform RFC 8620 discovery *)
82
+
let proto = "https" in
83
+
let host_with_port = match port with
84
+
| Some p -> host ^ ":" ^ string_of_int p
85
+
| None -> host
86
+
in
87
+
Uri.of_string (proto ^ "://" ^ host_with_port ^ "/.well-known/jmap")
88
+
in
89
+
ctx.session_url <- Some session_url;
90
+
91
+
(* Create a mock session object for this example *)
92
+
let caps = Hashtbl.create 4 in
93
+
Hashtbl.add caps Jmap.capability_core (`Assoc []);
94
+
95
+
let accounts = Hashtbl.create 1 in
96
+
let acct = Account.v
97
+
~name:"user@example.com"
98
+
~is_personal:true
99
+
~is_read_only:false
100
+
()
101
+
in
102
+
Hashtbl.add accounts "u1" acct;
103
+
104
+
let primary = Hashtbl.create 1 in
105
+
Hashtbl.add primary Jmap.capability_core "u1";
106
+
107
+
let api_url =
108
+
Uri.of_string ("https://" ^ host ^ "/api/jmap")
109
+
in
110
+
111
+
let session = Session.v
112
+
~capabilities:caps
113
+
~accounts
114
+
~primary_accounts:primary
115
+
~username:"user@example.com"
116
+
~api_url
117
+
~download_url:(Uri.of_string ("https://" ^ host ^ "/download/{accountId}/{blobId}"))
118
+
~upload_url:(Uri.of_string ("https://" ^ host ^ "/upload/{accountId}"))
119
+
~event_source_url:(Uri.of_string ("https://" ^ host ^ "/eventsource"))
120
+
~state:"1"
121
+
()
122
+
in
123
+
124
+
ctx.session <- Some session;
125
+
Ok (ctx, session)
126
+
127
+
(* Create a request builder for constructing a JMAP request *)
128
+
let build ctx = {
129
+
ctx;
130
+
using = [Jmap.capability_core]; (* Default to core capability *)
131
+
method_calls = [];
132
+
}
133
+
134
+
(* Set the using capabilities for a request *)
135
+
let using builder capabilities =
136
+
{ builder with using = capabilities }
137
+
138
+
(* Add a method call to a request builder *)
139
+
let add_method_call builder name args id =
140
+
let call = Invocation.v
141
+
~method_name:name
142
+
~arguments:args
143
+
~method_call_id:id
144
+
()
145
+
in
146
+
{ builder with method_calls = builder.method_calls @ [call] }
147
+
148
+
(* Create a reference to a previous method call result *)
149
+
let create_reference result_of name =
150
+
Jmap.Wire.Result_reference.v
151
+
~result_of
152
+
~name
153
+
~path:"" (* In a real implementation, this would include a JSON pointer *)
154
+
()
155
+
156
+
(* Execute a request and return the response *)
157
+
let execute builder =
158
+
match builder.ctx.session with
159
+
| None -> Error (protocol_error "No active session")
160
+
| Some session ->
161
+
(* In a real implementation, this would create and send an HTTP request *)
162
+
163
+
(* Create a mock response for this implementation *)
164
+
let results = List.map (fun call ->
165
+
let method_name = Invocation.method_name call in
166
+
let call_id = Invocation.method_call_id call in
167
+
if method_name = "Core/echo" then
168
+
(* Echo method implementation *)
169
+
Ok call
170
+
else
171
+
(* For other methods, return a method error *)
172
+
Error (
173
+
Method_error.v
174
+
~description:(Method_error_description.v
175
+
~description:"Method not implemented in mock"
176
+
())
177
+
`ServerUnavailable,
178
+
"Mock implementation"
179
+
)
180
+
) builder.method_calls in
181
+
182
+
let resp = Response.v
183
+
~method_responses:results
184
+
~session_state:(session |> Session.state)
185
+
()
186
+
in
187
+
Ok resp
188
+
189
+
(* Perform a JMAP API request *)
190
+
let request ctx req =
191
+
match ctx.session_url, ctx.session with
192
+
| None, _ -> Error (protocol_error "No session URL configured")
193
+
| _, None -> Error (protocol_error "No active session")
194
+
| Some url, Some session ->
195
+
(* In a real implementation, this would serialize the request and send it *)
196
+
197
+
(* Mock response implementation *)
198
+
let method_calls = Request.method_calls req in
199
+
let results = List.map (fun call ->
200
+
let method_name = Invocation.method_name call in
201
+
let call_id = Invocation.method_call_id call in
202
+
if method_name = "Core/echo" then
203
+
(* Echo method implementation *)
204
+
Ok call
205
+
else
206
+
(* For other methods, return a method error *)
207
+
Error (
208
+
Method_error.v
209
+
~description:(Method_error_description.v
210
+
~description:"Method not implemented in mock"
211
+
())
212
+
`ServerUnavailable,
213
+
"Mock implementation"
214
+
)
215
+
) method_calls in
216
+
217
+
let resp = Response.v
218
+
~method_responses:results
219
+
~session_state:(session |> Session.state)
220
+
()
221
+
in
222
+
Ok resp
223
+
224
+
(* Upload binary data *)
225
+
let upload ctx ~account_id ~content_type ~data_stream =
226
+
match ctx.session with
227
+
| None -> Error (protocol_error "No active session")
228
+
| Some session ->
229
+
(* In a real implementation, would upload the data stream *)
230
+
231
+
(* Mock success response *)
232
+
let response = Jmap.Binary.Upload_response.v
233
+
~account_id
234
+
~blob_id:"b123456"
235
+
~type_:content_type
236
+
~size:1024 (* Mock size *)
237
+
()
238
+
in
239
+
Ok response
240
+
241
+
(* Download binary data *)
242
+
let download ctx ~account_id ~blob_id ?content_type ?name =
243
+
match ctx.session with
244
+
| None -> Error (protocol_error "No active session")
245
+
| Some session ->
246
+
(* In a real implementation, would download the data and return a stream *)
247
+
248
+
(* Mock data stream - in real code, this would be read from the HTTP response *)
249
+
let mock_data = "This is mock downloaded data for blob " ^ blob_id in
250
+
let seq = Seq.cons mock_data Seq.empty in
251
+
Ok seq
252
+
253
+
(* Copy blobs between accounts *)
254
+
let copy_blobs ctx ~from_account_id ~account_id ~blob_ids =
255
+
match ctx.session with
256
+
| None -> Error (protocol_error "No active session")
257
+
| Some session ->
258
+
(* In a real implementation, would perform server-side copy *)
259
+
260
+
(* Mock success response with first blob copied and second failed *)
261
+
let copied = Hashtbl.create 1 in
262
+
Hashtbl.add copied (List.hd blob_ids) "b999999";
263
+
264
+
let response = Jmap.Binary.Blob_copy_response.v
265
+
~from_account_id
266
+
~account_id
267
+
~copied
268
+
()
269
+
in
270
+
Ok response
271
+
272
+
(* Connect to the EventSource for push notifications *)
273
+
let connect_event_source ctx ?types ?close_after ?ping =
274
+
match ctx.session with
275
+
| None -> Error (protocol_error "No active session")
276
+
| Some session ->
277
+
(* In a real implementation, would connect to EventSource URL *)
278
+
279
+
(* Create mock connection *)
280
+
let event_url = Session.event_source_url session in
281
+
let conn = { event_url; is_connected = true } in
282
+
283
+
(* Create a mock event sequence *)
284
+
let mock_state_change =
285
+
let changed = Hashtbl.create 1 in
286
+
let account_id = "u1" in
287
+
let state_map = Hashtbl.create 2 in
288
+
Hashtbl.add state_map "Email" "s123";
289
+
Hashtbl.add state_map "Mailbox" "s456";
290
+
Hashtbl.add changed account_id state_map;
291
+
292
+
Push.State_change.v ~changed ()
293
+
in
294
+
295
+
let ping_data =
296
+
Push.Event_source_ping_data.v ~interval:30 ()
297
+
in
298
+
299
+
(* Create a sequence with one state event and one ping event *)
300
+
let events = Seq.cons (`State mock_state_change)
301
+
(Seq.cons (`Ping ping_data) Seq.empty) in
302
+
303
+
Ok (conn, events)
304
+
305
+
(* Create a websocket connection for JMAP over WebSocket *)
306
+
let connect_websocket ctx =
307
+
match ctx.session with
308
+
| None -> Error (protocol_error "No active session")
309
+
| Some session ->
310
+
(* In a real implementation, would connect via WebSocket *)
311
+
312
+
(* Mock connection *)
313
+
let event_url = Session.api_url session in
314
+
let conn = { event_url; is_connected = true } in
315
+
Ok conn
316
+
317
+
(* Send a message over a websocket connection *)
318
+
let websocket_send conn req =
319
+
if not conn.is_connected then
320
+
Error (protocol_error "WebSocket not connected")
321
+
else
322
+
(* In a real implementation, would send over WebSocket *)
323
+
324
+
(* Mock response (same as request function) *)
325
+
let method_calls = Request.method_calls req in
326
+
let results = List.map (fun call ->
327
+
let method_name = Invocation.method_name call in
328
+
let call_id = Invocation.method_call_id call in
329
+
if method_name = "Core/echo" then
330
+
Ok call
331
+
else
332
+
Error (
333
+
Method_error.v
334
+
~description:(Method_error_description.v
335
+
~description:"Method not implemented in mock"
336
+
())
337
+
`ServerUnavailable,
338
+
"Mock implementation"
339
+
)
340
+
) method_calls in
341
+
342
+
let resp = Response.v
343
+
~method_responses:results
344
+
~session_state:"1"
345
+
()
346
+
in
347
+
Ok resp
348
+
349
+
(* Close an EventSource or WebSocket connection *)
350
+
let close_connection conn =
351
+
if not conn.is_connected then
352
+
Error (protocol_error "Connection already closed")
353
+
else begin
354
+
conn.is_connected <- false;
355
+
Ok ()
356
+
end
357
+
358
+
(* Close the JMAP connection context *)
359
+
let close ctx =
360
+
ctx.session <- None;
361
+
ctx.session_url <- None;
362
+
Ok ()
363
+
364
+
(* Helper functions for common tasks *)
365
+
366
+
(* Helper to get a single object by ID *)
367
+
let get_object ctx ~method_name ~account_id ~object_id ?properties =
368
+
let properties_param = match properties with
369
+
| Some props -> `List (List.map (fun p -> `String p) props)
370
+
| None -> `Null
371
+
in
372
+
373
+
let args = `Assoc [
374
+
("accountId", `String account_id);
375
+
("ids", `List [`String object_id]);
376
+
("properties", properties_param);
377
+
] in
378
+
379
+
let request_builder = build ctx
380
+
|> add_method_call method_name args "r1"
381
+
in
382
+
383
+
match execute request_builder with
384
+
| Error e -> Error e
385
+
| Ok response ->
386
+
(* Find the method response and extract the list with the object *)
387
+
match response |> Response.method_responses with
388
+
| [Ok invocation] when Invocation.method_name invocation = method_name ^ "/get" ->
389
+
let args = Invocation.arguments invocation in
390
+
begin match Yojson.Safe.Util.member "list" args with
391
+
| `List [obj] -> Ok obj
392
+
| _ -> Error (protocol_error "Object not found or invalid response")
393
+
end
394
+
| _ ->
395
+
Error (protocol_error "Method response not found")
396
+
397
+
(* Helper to set up the connection with minimal options *)
398
+
let quick_connect ~host ~username ~password =
399
+
let ctx = create_client () in
400
+
connect ctx ~host ~auth_method:(Basic(username, password)) ()
401
+
402
+
(* Perform a Core/echo request to test connectivity *)
403
+
let echo ctx ?data () =
404
+
let data = match data with
405
+
| Some d -> d
406
+
| None -> `Assoc [("hello", `String "world")]
407
+
in
408
+
409
+
let request_builder = build ctx
410
+
|> add_method_call "Core/echo" data "echo1"
411
+
in
412
+
413
+
match execute request_builder with
414
+
| Error e -> Error e
415
+
| Ok response ->
416
+
(* Find the Core/echo response and extract the echoed data *)
417
+
match response |> Response.method_responses with
418
+
| [Ok invocation] when Invocation.method_name invocation = "Core/echo" ->
419
+
Ok (Invocation.arguments invocation)
420
+
| _ ->
421
+
Error (protocol_error "Echo response not found")
422
+
423
+
(* High-level email operations *)
424
+
module Email = struct
425
+
open Jmap_email.Types
426
+
427
+
(* Get an email by ID *)
428
+
let get_email ctx ~account_id ~email_id ?properties () =
429
+
let props = match properties with
430
+
| Some p -> p
431
+
| None -> List.map email_property_to_string detailed_email_properties
432
+
in
433
+
434
+
match get_object ctx ~method_name:"Email/get" ~account_id ~object_id:email_id ~properties:props with
435
+
| Error e -> Error e
436
+
| Ok json ->
437
+
(* In a real implementation, would parse the JSON into an Email.t structure *)
438
+
let mock_email = Email.create
439
+
~id:email_id
440
+
~thread_id:"t12345"
441
+
~mailbox_ids:(let h = Hashtbl.create 1 in Hashtbl.add h "inbox" true; h)
442
+
~keywords:(Keywords.of_list [Keywords.Seen])
443
+
~subject:"Mock Email Subject"
444
+
~preview:"This is a mock email..."
445
+
~from:[Email_address.v ~name:"Sender Name" ~email:"sender@example.com" ()]
446
+
~to_:[Email_address.v ~email:"recipient@example.com" ()]
447
+
()
448
+
in
449
+
Ok mock_email
450
+
451
+
(* Search for emails using a filter *)
452
+
let search_emails ctx ~account_id ~filter ?sort ?limit ?position ?properties () =
453
+
(* Create the query args *)
454
+
let args = `Assoc [
455
+
("accountId", `String account_id);
456
+
("filter", Jmap.Methods.Filter.to_json filter);
457
+
("sort", match sort with
458
+
| Some s -> `List [] (* Would convert sort params *)
459
+
| None -> `List [`Assoc [("property", `String "receivedAt"); ("isAscending", `Bool false)]]);
460
+
("limit", match limit with
461
+
| Some l -> `Int l
462
+
| None -> `Int 20);
463
+
("position", match position with
464
+
| Some p -> `Int p
465
+
| None -> `Int 0);
466
+
] in
467
+
468
+
let request_builder = build ctx
469
+
|> add_method_call "Email/query" args "q1"
470
+
in
471
+
472
+
(* If properties were provided, add a Email/get method call as well *)
473
+
let request_builder = match properties with
474
+
| Some _ ->
475
+
let get_args = `Assoc [
476
+
("accountId", `String account_id);
477
+
("#ids", `Assoc [
478
+
("resultOf", `String "q1");
479
+
("name", `String "Email/query");
480
+
("path", `String "/ids")
481
+
]);
482
+
("properties", match properties with
483
+
| Some p -> `List (List.map (fun prop -> `String prop) p)
484
+
| None -> `Null);
485
+
] in
486
+
add_method_call request_builder "Email/get" get_args "g1"
487
+
| None -> request_builder
488
+
in
489
+
490
+
match execute request_builder with
491
+
| Error e -> Error e
492
+
| Ok response ->
493
+
(* Find the query response and extract the IDs *)
494
+
match Response.method_responses response with
495
+
| [Ok q_inv; Ok g_inv]
496
+
when Invocation.method_name q_inv = "Email/query"
497
+
&& Invocation.method_name g_inv = "Email/get" ->
498
+
499
+
(* Extract IDs from query response *)
500
+
let q_args = Invocation.arguments q_inv in
501
+
let ids = match Yojson.Safe.Util.member "ids" q_args with
502
+
| `List l -> List.map Yojson.Safe.Util.to_string l
503
+
| _ -> []
504
+
in
505
+
506
+
(* Extract emails from get response *)
507
+
let g_args = Invocation.arguments g_inv in
508
+
(* In a real implementation, would parse each email in the list *)
509
+
let emails = List.map (fun id ->
510
+
Email.create
511
+
~id
512
+
~thread_id:("t" ^ id)
513
+
~subject:(Printf.sprintf "Mock Email %s" id)
514
+
()
515
+
) ids in
516
+
517
+
Ok (ids, Some emails)
518
+
519
+
| [Ok q_inv] when Invocation.method_name q_inv = "Email/query" ->
520
+
(* If only query was performed (no properties requested) *)
521
+
let q_args = Invocation.arguments q_inv in
522
+
let ids = match Yojson.Safe.Util.member "ids" q_args with
523
+
| `List l -> List.map Yojson.Safe.Util.to_string l
524
+
| _ -> []
525
+
in
526
+
527
+
Ok (ids, None)
528
+
529
+
| _ ->
530
+
Error (protocol_error "Query response not found")
531
+
532
+
(* Mark multiple emails with a keyword *)
533
+
let mark_emails ctx ~account_id ~email_ids ~keyword () =
534
+
(* Create the set args with a patch to add the keyword *)
535
+
let keyword_patch = Jmap_email.Keyword_ops.add_keyword_patch keyword in
536
+
537
+
(* Create patches map for each email *)
538
+
let update = Hashtbl.create (List.length email_ids) in
539
+
List.iter (fun id ->
540
+
Hashtbl.add update id keyword_patch
541
+
) email_ids;
542
+
543
+
let args = `Assoc [
544
+
("accountId", `String account_id);
545
+
("update", `Assoc (
546
+
List.map (fun id ->
547
+
(id, `Assoc (List.map (fun (path, value) ->
548
+
(path, value)
549
+
) keyword_patch))
550
+
) email_ids
551
+
));
552
+
] in
553
+
554
+
let request_builder = build ctx
555
+
|> add_method_call "Email/set" args "s1"
556
+
in
557
+
558
+
match execute request_builder with
559
+
| Error e -> Error e
560
+
| Ok response ->
561
+
(* In a real implementation, would check for errors *)
562
+
Ok ()
563
+
564
+
(* Mark emails as seen/read *)
565
+
let mark_as_seen ctx ~account_id ~email_ids () =
566
+
mark_emails ctx ~account_id ~email_ids ~keyword:Keywords.Seen ()
567
+
568
+
(* Mark emails as unseen/unread *)
569
+
let mark_as_unseen ctx ~account_id ~email_ids () =
570
+
let keyword_patch = Jmap_email.Keyword_ops.mark_unseen_patch () in
571
+
572
+
(* Create patches map for each email *)
573
+
let update = Hashtbl.create (List.length email_ids) in
574
+
List.iter (fun id ->
575
+
Hashtbl.add update id keyword_patch
576
+
) email_ids;
577
+
578
+
let args = `Assoc [
579
+
("accountId", `String account_id);
580
+
("update", `Assoc (
581
+
List.map (fun id ->
582
+
(id, `Assoc (List.map (fun (path, value) ->
583
+
(path, value)
584
+
) keyword_patch))
585
+
) email_ids
586
+
));
587
+
] in
588
+
589
+
let request_builder = build ctx
590
+
|> add_method_call "Email/set" args "s1"
591
+
in
592
+
593
+
match execute request_builder with
594
+
| Error e -> Error e
595
+
| Ok _response -> Ok ()
596
+
597
+
(* Move emails to a different mailbox *)
598
+
let move_emails ctx ~account_id ~email_ids ~mailbox_id ?remove_from_mailboxes () =
599
+
(* Create patch to add to destination mailbox *)
600
+
let add_patch = [("mailboxIds/" ^ mailbox_id, `Bool true)] in
601
+
602
+
(* If remove_from_mailboxes is specified, add patches to remove *)
603
+
let remove_patch = match remove_from_mailboxes with
604
+
| Some mailboxes ->
605
+
List.map (fun mbx -> ("mailboxIds/" ^ mbx, `Null)) mailboxes
606
+
| None -> []
607
+
in
608
+
609
+
(* Combine patches *)
610
+
let patches = add_patch @ remove_patch in
611
+
612
+
(* Create patches map for each email *)
613
+
let update = Hashtbl.create (List.length email_ids) in
614
+
List.iter (fun id ->
615
+
Hashtbl.add update id patches
616
+
) email_ids;
617
+
618
+
let args = `Assoc [
619
+
("accountId", `String account_id);
620
+
("update", `Assoc (
621
+
List.map (fun id ->
622
+
(id, `Assoc (List.map (fun (path, value) ->
623
+
(path, value)
624
+
) patches))
625
+
) email_ids
626
+
));
627
+
] in
628
+
629
+
let request_builder = build ctx
630
+
|> add_method_call "Email/set" args "s1"
631
+
in
632
+
633
+
match execute request_builder with
634
+
| Error e -> Error e
635
+
| Ok _response -> Ok ()
636
+
637
+
(* Import an RFC822 message *)
638
+
let import_email ctx ~account_id ~rfc822 ~mailbox_ids ?keywords ?received_at () =
639
+
(* In a real implementation, would first upload the message as a blob *)
640
+
let mock_blob_id = "b9876" in
641
+
642
+
(* Create the Email/import call *)
643
+
let args = `Assoc [
644
+
("accountId", `String account_id);
645
+
("emails", `Assoc [
646
+
("msg1", `Assoc [
647
+
("blobId", `String mock_blob_id);
648
+
("mailboxIds", `Assoc (
649
+
List.map (fun id -> (id, `Bool true)) mailbox_ids
650
+
));
651
+
("keywords", match keywords with
652
+
| Some kws ->
653
+
`Assoc (List.map (fun k ->
654
+
(Types.Keywords.to_string k, `Bool true)) kws)
655
+
| None -> `Null);
656
+
("receivedAt", match received_at with
657
+
| Some d -> `String (string_of_float d) (* Would format as RFC3339 *)
658
+
| None -> `Null);
659
+
])
660
+
]);
661
+
] in
662
+
663
+
let request_builder = build ctx
664
+
|> add_method_call "Email/import" args "i1"
665
+
in
666
+
667
+
match execute request_builder with
668
+
| Error e -> Error e
669
+
| Ok response ->
670
+
(* In a real implementation, would extract the created ID *)
671
+
Ok "e12345"
672
+
end
+359
jmap-unix/jmap_unix.mli
+359
jmap-unix/jmap_unix.mli
···
1
+
(** Unix-specific JMAP client implementation interface.
2
+
3
+
This module provides functions to interact with a JMAP server using
4
+
Unix sockets for network communication.
5
+
6
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-4> RFC 8620, Section 4
7
+
*)
8
+
9
+
(** Configuration options for a JMAP client context *)
10
+
type client_config = {
11
+
connect_timeout : float option; (** Connection timeout in seconds *)
12
+
request_timeout : float option; (** Request timeout in seconds *)
13
+
max_concurrent_requests : int option; (** Maximum concurrent requests *)
14
+
max_request_size : int option; (** Maximum request size in bytes *)
15
+
user_agent : string option; (** User-Agent header value *)
16
+
authentication_header : string option; (** Custom Authentication header name *)
17
+
}
18
+
19
+
(** Authentication method options *)
20
+
type auth_method =
21
+
| Basic of string * string (** Basic auth with username and password *)
22
+
| Bearer of string (** Bearer token auth *)
23
+
| Custom of (string * string) (** Custom header name and value *)
24
+
| Session_cookie of (string * string) (** Session cookie name and value *)
25
+
| No_auth (** No authentication *)
26
+
27
+
(** Represents an active JMAP connection context. Opaque type. *)
28
+
type context
29
+
30
+
(** Represents an active EventSource connection. Opaque type. *)
31
+
type event_source_connection
32
+
33
+
(** A request builder for constructing and sending JMAP requests *)
34
+
type request_builder
35
+
36
+
(** Create default configuration options *)
37
+
val default_config : unit -> client_config
38
+
39
+
(** Create a client context with the specified configuration
40
+
@return The context object used for JMAP API calls
41
+
*)
42
+
val create_client :
43
+
?config:client_config ->
44
+
unit ->
45
+
context
46
+
47
+
(** Connect to a JMAP server and retrieve the session.
48
+
This handles discovery (if needed) and authentication.
49
+
@param ctx The client context.
50
+
@param ?session_url Optional direct URL to the Session resource.
51
+
@param ?username Optional username (e.g., email address) for discovery.
52
+
@param ?auth_method Authentication method to use (default Basic).
53
+
@param credentials Authentication credentials.
54
+
@return A result with either (context, session) or an error.
55
+
*)
56
+
val connect :
57
+
context ->
58
+
?session_url:Uri.t ->
59
+
?username:string ->
60
+
host:string ->
61
+
?port:int ->
62
+
?auth_method:auth_method ->
63
+
unit ->
64
+
(context * Jmap.Session.Session.t) Jmap.Error.result
65
+
66
+
(** Create a request builder for constructing a JMAP request.
67
+
@param ctx The client context.
68
+
@return A request builder object.
69
+
*)
70
+
val build : context -> request_builder
71
+
72
+
(** Set the using capabilities for a request.
73
+
@param builder The request builder.
74
+
@param capabilities List of capability URIs to use.
75
+
@return The updated request builder.
76
+
*)
77
+
val using : request_builder -> string list -> request_builder
78
+
79
+
(** Add a method call to a request builder.
80
+
@param builder The request builder.
81
+
@param name Method name (e.g., "Email/get").
82
+
@param args Method arguments.
83
+
@param id Method call ID.
84
+
@return The updated request builder.
85
+
*)
86
+
val add_method_call :
87
+
request_builder ->
88
+
string ->
89
+
Yojson.Safe.t ->
90
+
string ->
91
+
request_builder
92
+
93
+
(** Create a reference to a previous method call result.
94
+
@param result_of Method call ID to reference.
95
+
@param name Path in the response.
96
+
@return A ResultReference to use in another method call.
97
+
*)
98
+
val create_reference : string -> string -> Jmap.Wire.Result_reference.t
99
+
100
+
(** Execute a request and return the response.
101
+
@param builder The request builder to execute.
102
+
@return The JMAP response from the server.
103
+
*)
104
+
val execute : request_builder -> Jmap.Wire.Response.t Jmap.Error.result
105
+
106
+
(** Perform a JMAP API request.
107
+
@param ctx The connection context.
108
+
@param request The JMAP request object.
109
+
@return The JMAP response from the server.
110
+
*)
111
+
val request : context -> Jmap.Wire.Request.t -> Jmap.Wire.Response.t Jmap.Error.result
112
+
113
+
(** Upload binary data.
114
+
@param ctx The connection context.
115
+
@param account_id The target account ID.
116
+
@param content_type The MIME type of the data.
117
+
@param data_stream A stream providing the binary data chunks.
118
+
@return A result with either an upload response or an error.
119
+
*)
120
+
val upload :
121
+
context ->
122
+
account_id:Jmap.Types.id ->
123
+
content_type:string ->
124
+
data_stream:string Seq.t ->
125
+
Jmap.Binary.Upload_response.t Jmap.Error.result
126
+
127
+
(** Download binary data.
128
+
@param ctx The connection context.
129
+
@param account_id The account ID.
130
+
@param blob_id The blob ID to download.
131
+
@param ?content_type The desired Content-Type for the download response.
132
+
@param ?name The desired filename for the download response.
133
+
@return A result with either a stream of data chunks or an error.
134
+
*)
135
+
val download :
136
+
context ->
137
+
account_id:Jmap.Types.id ->
138
+
blob_id:Jmap.Types.id ->
139
+
?content_type:string ->
140
+
?name:string ->
141
+
(string Seq.t) Jmap.Error.result
142
+
143
+
(** Copy blobs between accounts.
144
+
@param ctx The connection context.
145
+
@param from_account_id Source account ID.
146
+
@param account_id Destination account ID.
147
+
@param blob_ids List of blob IDs to copy.
148
+
@return A result with either the copy response or an error.
149
+
*)
150
+
val copy_blobs :
151
+
context ->
152
+
from_account_id:Jmap.Types.id ->
153
+
account_id:Jmap.Types.id ->
154
+
blob_ids:Jmap.Types.id list ->
155
+
Jmap.Binary.Blob_copy_response.t Jmap.Error.result
156
+
157
+
(** Connect to the EventSource for push notifications.
158
+
@param ctx The connection context.
159
+
@param ?types List of types to subscribe to (default "*").
160
+
@param ?close_after Request server to close after first state event.
161
+
@param ?ping Request ping interval in seconds (default 0).
162
+
@return A result with either a tuple of connection handle and event stream, or an error.
163
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.3> RFC 8620, Section 7.3 *)
164
+
val connect_event_source :
165
+
context ->
166
+
?types:string list ->
167
+
?close_after:[`State | `No] ->
168
+
?ping:Jmap.Types.uint ->
169
+
(event_source_connection *
170
+
([`State of Jmap.Push.State_change.t | `Ping of Jmap.Push.Event_source_ping_data.t ] Seq.t)) Jmap.Error.result
171
+
172
+
(** Create a websocket connection for JMAP over WebSocket.
173
+
@param ctx The connection context.
174
+
@return A result with either a websocket connection or an error.
175
+
@see <https://www.rfc-editor.org/rfc/rfc8887.html> RFC 8887 *)
176
+
val connect_websocket :
177
+
context ->
178
+
event_source_connection Jmap.Error.result
179
+
180
+
(** Send a message over a websocket connection.
181
+
@param conn The websocket connection.
182
+
@param request The JMAP request to send.
183
+
@return A result with either the response or an error.
184
+
*)
185
+
val websocket_send :
186
+
event_source_connection ->
187
+
Jmap.Wire.Request.t ->
188
+
Jmap.Wire.Response.t Jmap.Error.result
189
+
190
+
(** Close an EventSource or WebSocket connection.
191
+
@param conn The connection handle.
192
+
@return A result with either unit or an error.
193
+
*)
194
+
val close_connection : event_source_connection -> unit Jmap.Error.result
195
+
196
+
(** Close the JMAP connection context.
197
+
@return A result with either unit or an error.
198
+
*)
199
+
val close : context -> unit Jmap.Error.result
200
+
201
+
(** {2 Helper Methods for Common Tasks} *)
202
+
203
+
(** Helper to get a single object by ID.
204
+
@param ctx The context.
205
+
@param method_name The get method (e.g., "Email/get").
206
+
@param account_id The account ID.
207
+
@param object_id The ID of the object to get.
208
+
@param ?properties Optional list of properties to fetch.
209
+
@return A result with either the object as JSON or an error.
210
+
*)
211
+
val get_object :
212
+
context ->
213
+
method_name:string ->
214
+
account_id:Jmap.Types.id ->
215
+
object_id:Jmap.Types.id ->
216
+
?properties:string list ->
217
+
Yojson.Safe.t Jmap.Error.result
218
+
219
+
(** Helper to set up the connection with minimal options.
220
+
@param host The JMAP server hostname.
221
+
@param username Username for basic auth.
222
+
@param password Password for basic auth.
223
+
@return A result with either (context, session) or an error.
224
+
*)
225
+
val quick_connect :
226
+
host:string ->
227
+
username:string ->
228
+
password:string ->
229
+
(context * Jmap.Session.Session.t) Jmap.Error.result
230
+
231
+
(** Perform a Core/echo request to test connectivity.
232
+
@param ctx The JMAP connection context.
233
+
@param ?data Optional data to echo back.
234
+
@return A result with either the response or an error.
235
+
*)
236
+
val echo :
237
+
context ->
238
+
?data:Yojson.Safe.t ->
239
+
unit ->
240
+
Yojson.Safe.t Jmap.Error.result
241
+
242
+
(** {2 Email Operations} *)
243
+
244
+
(** High-level email operations that map to JMAP email methods *)
245
+
module Email : sig
246
+
open Jmap_email.Types
247
+
248
+
(** Get an email by ID
249
+
@param ctx The JMAP client context
250
+
@param account_id The account ID
251
+
@param email_id The email ID to fetch
252
+
@param ?properties Optional list of properties to fetch
253
+
@return The email object or an error
254
+
*)
255
+
val get_email :
256
+
context ->
257
+
account_id:Jmap.Types.id ->
258
+
email_id:Jmap.Types.id ->
259
+
?properties:string list ->
260
+
unit ->
261
+
Email.t Jmap.Error.result
262
+
263
+
(** Search for emails using a filter
264
+
@param ctx The JMAP client context
265
+
@param account_id The account ID
266
+
@param filter The search filter
267
+
@param ?sort Optional sort criteria (default received date newest first)
268
+
@param ?limit Optional maximum number of results
269
+
@param ?properties Optional properties to fetch for the matching emails
270
+
@return The list of matching email IDs and optionally the email objects
271
+
*)
272
+
val search_emails :
273
+
context ->
274
+
account_id:Jmap.Types.id ->
275
+
filter:Jmap.Methods.Filter.t ->
276
+
?sort:Jmap.Methods.Comparator.t list ->
277
+
?limit:Jmap.Types.uint ->
278
+
?position:int ->
279
+
?properties:string list ->
280
+
unit ->
281
+
(Jmap.Types.id list * Email.t list option) Jmap.Error.result
282
+
283
+
(** Mark multiple emails with a keyword
284
+
@param ctx The JMAP client context
285
+
@param account_id The account ID
286
+
@param email_ids List of email IDs to update
287
+
@param keyword The keyword to add
288
+
@return The result of the operation
289
+
*)
290
+
val mark_emails :
291
+
context ->
292
+
account_id:Jmap.Types.id ->
293
+
email_ids:Jmap.Types.id list ->
294
+
keyword:Keywords.keyword ->
295
+
unit ->
296
+
unit Jmap.Error.result
297
+
298
+
(** Mark emails as seen/read
299
+
@param ctx The JMAP client context
300
+
@param account_id The account ID
301
+
@param email_ids List of email IDs to mark
302
+
@return The result of the operation
303
+
*)
304
+
val mark_as_seen :
305
+
context ->
306
+
account_id:Jmap.Types.id ->
307
+
email_ids:Jmap.Types.id list ->
308
+
unit ->
309
+
unit Jmap.Error.result
310
+
311
+
(** Mark emails as unseen/unread
312
+
@param ctx The JMAP client context
313
+
@param account_id The account ID
314
+
@param email_ids List of email IDs to mark
315
+
@return The result of the operation
316
+
*)
317
+
val mark_as_unseen :
318
+
context ->
319
+
account_id:Jmap.Types.id ->
320
+
email_ids:Jmap.Types.id list ->
321
+
unit ->
322
+
unit Jmap.Error.result
323
+
324
+
(** Move emails to a different mailbox
325
+
@param ctx The JMAP client context
326
+
@param account_id The account ID
327
+
@param email_ids List of email IDs to move
328
+
@param mailbox_id Destination mailbox ID
329
+
@param ?remove_from_mailboxes Optional list of source mailbox IDs to remove from
330
+
@return The result of the operation
331
+
*)
332
+
val move_emails :
333
+
context ->
334
+
account_id:Jmap.Types.id ->
335
+
email_ids:Jmap.Types.id list ->
336
+
mailbox_id:Jmap.Types.id ->
337
+
?remove_from_mailboxes:Jmap.Types.id list ->
338
+
unit ->
339
+
unit Jmap.Error.result
340
+
341
+
(** Import an RFC822 message
342
+
@param ctx The JMAP client context
343
+
@param account_id The account ID
344
+
@param rfc822 Raw message content
345
+
@param mailbox_ids Mailboxes to add the message to
346
+
@param ?keywords Optional keywords to set
347
+
@param ?received_at Optional received timestamp
348
+
@return The ID of the imported email
349
+
*)
350
+
val import_email :
351
+
context ->
352
+
account_id:Jmap.Types.id ->
353
+
rfc822:string ->
354
+
mailbox_ids:Jmap.Types.id list ->
355
+
?keywords:Keywords.t ->
356
+
?received_at:Jmap.Types.date ->
357
+
unit ->
358
+
Jmap.Types.id Jmap.Error.result
359
+
end
+13
jmap/dune
+13
jmap/dune
+45
jmap/jmap.ml
+45
jmap/jmap.ml
···
1
+
(* JMAP Core Protocol Library Interface (RFC 8620) *)
2
+
3
+
module Types = Jmap_types
4
+
module Error = Jmap_error
5
+
module Wire = Jmap_wire
6
+
module Session = Jmap_session
7
+
module Methods = Jmap_methods
8
+
module Binary = Jmap_binary
9
+
module Push = Jmap_push
10
+
11
+
(* Capability URI for JMAP Core. *)
12
+
let capability_core = "urn:ietf:params:jmap:core"
13
+
14
+
(* Check if a session supports a given capability. *)
15
+
let supports_capability session capability =
16
+
let caps = Session.Session.capabilities session in
17
+
Hashtbl.mem caps capability
18
+
19
+
(* Get the primary account ID for a given capability. *)
20
+
let get_primary_account session capability =
21
+
let primary_accounts = Session.Session.primary_accounts session in
22
+
match Hashtbl.find_opt primary_accounts capability with
23
+
| Some account_id -> Ok account_id
24
+
| None -> Error (Error.protocol_error ("No primary account for capability: " ^ capability))
25
+
26
+
(* Get the download URL for a blob. *)
27
+
let get_download_url session ~account_id ~blob_id ?name ?content_type () =
28
+
let base_url = Session.Session.download_url session in
29
+
let url_str = Uri.to_string base_url in
30
+
let url_str = url_str ^ "/accounts/" ^ account_id ^ "/blobs/" ^ blob_id in
31
+
let url = Uri.of_string url_str in
32
+
let url = match name with
33
+
| Some name -> Uri.add_query_param url ("name", [name])
34
+
| None -> url
35
+
in
36
+
match content_type with
37
+
| Some ct -> Uri.add_query_param url ("type", [ct])
38
+
| None -> url
39
+
40
+
(* Get the upload URL for a blob. *)
41
+
let get_upload_url session ~account_id =
42
+
let base_url = Session.Session.upload_url session in
43
+
let url_str = Uri.to_string base_url in
44
+
let url_str = url_str ^ "/accounts/" ^ account_id in
45
+
Uri.of_string url_str
+136
jmap/jmap.mli
+136
jmap/jmap.mli
···
1
+
(** JMAP Core Protocol Library Interface (RFC 8620)
2
+
3
+
This library provides OCaml types and function signatures for interacting
4
+
with a JMAP server according to the core protocol specification in RFC 8620.
5
+
6
+
Modules:
7
+
- {!Jmap.Types}: Basic data types (Id, Date, etc.).
8
+
- {!Jmap.Error}: Error types (ProblemDetails, MethodError, SetError).
9
+
- {!Jmap.Wire}: Request and Response structures.
10
+
- {!Jmap.Session}: Session object and discovery.
11
+
- {!Jmap.Methods}: Standard method patterns (/get, /set, etc.) and Core/echo.
12
+
- {!Jmap.Binary}: Binary data upload/download types.
13
+
- {!Jmap.Push}: Push notification types (StateChange, PushSubscription).
14
+
15
+
For email-specific extensions (RFC 8621), see the Jmap_email library.
16
+
For Unix-specific implementation, see the Jmap_unix library.
17
+
18
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html> RFC 8620: Core JMAP
19
+
*)
20
+
21
+
(** {1 Core JMAP Types and Modules} *)
22
+
23
+
module Types = Jmap_types
24
+
module Error = Jmap_error
25
+
module Wire = Jmap_wire
26
+
module Session = Jmap_session
27
+
module Methods = Jmap_methods
28
+
module Binary = Jmap_binary
29
+
module Push = Jmap_push
30
+
31
+
(** {1 Example Usage}
32
+
33
+
The following example demonstrates using the Core JMAP library with the Unix implementation
34
+
to make a simple echo request.
35
+
36
+
{[
37
+
(* OCaml 5.1 required for Lwt let operators *)
38
+
open Lwt.Syntax
39
+
open Jmap
40
+
open Jmap.Types
41
+
open Jmap.Wire
42
+
open Jmap.Methods
43
+
open Jmap.Unix
44
+
45
+
let simple_echo_request ctx session =
46
+
(* Prepare an echo invocation *)
47
+
let echo_args = Yojson.Safe.to_basic (`Assoc [
48
+
("hello", `String "world");
49
+
("array", `List [`Int 1; `Int 2; `Int 3]);
50
+
]) in
51
+
52
+
let echo_invocation = Invocation.v
53
+
~method_name:"Core/echo"
54
+
~arguments:echo_args
55
+
~method_call_id:"echo1"
56
+
()
57
+
in
58
+
59
+
(* Prepare the JMAP request *)
60
+
let request = Request.v
61
+
~using:[capability_core]
62
+
~method_calls:[echo_invocation]
63
+
()
64
+
in
65
+
66
+
(* Send the request *)
67
+
let* response = Jmap.Unix.request ctx request in
68
+
69
+
(* Process the response *)
70
+
match Wire.find_method_response response "echo1" with
71
+
| Some (method_name, args, _) when method_name = "Core/echo" ->
72
+
(* Echo response should contain the same arguments we sent *)
73
+
let hello_value = match Yojson.Safe.Util.member "hello" args with
74
+
| `String s -> s
75
+
| _ -> "not found"
76
+
in
77
+
Printf.printf "Echo response received: hello=%s\n" hello_value;
78
+
Lwt.return_unit
79
+
| _ ->
80
+
Printf.eprintf "Echo response not found or unexpected format\n";
81
+
Lwt.return_unit
82
+
83
+
let main () =
84
+
(* Authentication details are placeholder *)
85
+
let credentials = "my_auth_token" in
86
+
let* (ctx, session) = Jmap.Unix.connect ~host:"jmap.example.com" ~credentials in
87
+
let* () = simple_echo_request ctx session in
88
+
Jmap.Unix.close ctx
89
+
90
+
(* Lwt_main.run (main ()) *)
91
+
]}
92
+
*)
93
+
94
+
(** Capability URI for JMAP Core.
95
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-2> RFC 8620, Section 2 *)
96
+
val capability_core : string
97
+
98
+
(** {1 Convenience Functions} *)
99
+
100
+
(** Check if a session supports a given capability.
101
+
@param session The session object.
102
+
@param capability The capability URI to check.
103
+
@return True if supported, false otherwise.
104
+
*)
105
+
val supports_capability : Jmap_session.Session.t -> string -> bool
106
+
107
+
(** Get the primary account ID for a given capability.
108
+
@param session The session object.
109
+
@param capability The capability URI.
110
+
@return The account ID or an error if not found.
111
+
*)
112
+
val get_primary_account : Jmap_session.Session.t -> string -> (Jmap_types.id, Error.error) result
113
+
114
+
(** Get the download URL for a blob.
115
+
@param session The session object.
116
+
@param account_id The account ID.
117
+
@param blob_id The blob ID.
118
+
@param ?name Optional filename for the download.
119
+
@param ?content_type Optional content type for the download.
120
+
@return The download URL.
121
+
*)
122
+
val get_download_url :
123
+
Jmap_session.Session.t ->
124
+
account_id:Jmap_types.id ->
125
+
blob_id:Jmap_types.id ->
126
+
?name:string ->
127
+
?content_type:string ->
128
+
unit ->
129
+
Uri.t
130
+
131
+
(** Get the upload URL for a blob.
132
+
@param session The session object.
133
+
@param account_id The account ID.
134
+
@return The upload URL.
135
+
*)
136
+
val get_upload_url : Jmap_session.Session.t -> account_id:Jmap_types.id -> Uri.t
+56
jmap/jmap_binary.ml
+56
jmap/jmap_binary.ml
···
1
+
(* JMAP Binary Data Handling. *)
2
+
3
+
open Jmap_types
4
+
open Jmap_error
5
+
6
+
(* Response from uploading binary data. *)
7
+
module Upload_response = struct
8
+
type t = {
9
+
account_id: id;
10
+
blob_id: id;
11
+
type_: string;
12
+
size: uint;
13
+
}
14
+
15
+
let account_id t = t.account_id
16
+
let blob_id t = t.blob_id
17
+
let type_ t = t.type_
18
+
let size t = t.size
19
+
20
+
let v ~account_id ~blob_id ~type_ ~size () =
21
+
{ account_id; blob_id; type_; size }
22
+
end
23
+
24
+
(* Arguments for Blob/copy. *)
25
+
module Blob_copy_args = struct
26
+
type t = {
27
+
from_account_id: id;
28
+
account_id: id;
29
+
blob_ids: id list;
30
+
}
31
+
32
+
let from_account_id t = t.from_account_id
33
+
let account_id t = t.account_id
34
+
let blob_ids t = t.blob_ids
35
+
36
+
let v ~from_account_id ~account_id ~blob_ids () =
37
+
{ from_account_id; account_id; blob_ids }
38
+
end
39
+
40
+
(* Response for Blob/copy. *)
41
+
module Blob_copy_response = struct
42
+
type t = {
43
+
from_account_id: id;
44
+
account_id: id;
45
+
copied: id id_map option;
46
+
not_copied: Set_error.t id_map option;
47
+
}
48
+
49
+
let from_account_id t = t.from_account_id
50
+
let account_id t = t.account_id
51
+
let copied t = t.copied
52
+
let not_copied t = t.not_copied
53
+
54
+
let v ~from_account_id ~account_id ?copied ?not_copied () =
55
+
{ from_account_id; account_id; copied; not_copied }
56
+
end
+60
jmap/jmap_binary.mli
+60
jmap/jmap_binary.mli
···
1
+
(** JMAP Binary Data Handling.
2
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-6> RFC 8620, Section 6 *)
3
+
4
+
open Jmap_types
5
+
open Jmap_error
6
+
7
+
(** Response from uploading binary data.
8
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-6.1> RFC 8620, Section 6.1 *)
9
+
module Upload_response : sig
10
+
type t
11
+
12
+
val account_id : t -> id
13
+
val blob_id : t -> id
14
+
val type_ : t -> string
15
+
val size : t -> uint
16
+
17
+
val v :
18
+
account_id:id ->
19
+
blob_id:id ->
20
+
type_:string ->
21
+
size:uint ->
22
+
unit ->
23
+
t
24
+
end
25
+
26
+
(** Arguments for Blob/copy.
27
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-6.3> RFC 8620, Section 6.3 *)
28
+
module Blob_copy_args : sig
29
+
type t
30
+
31
+
val from_account_id : t -> id
32
+
val account_id : t -> id
33
+
val blob_ids : t -> id list
34
+
35
+
val v :
36
+
from_account_id:id ->
37
+
account_id:id ->
38
+
blob_ids:id list ->
39
+
unit ->
40
+
t
41
+
end
42
+
43
+
(** Response for Blob/copy.
44
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-6.3> RFC 8620, Section 6.3 *)
45
+
module Blob_copy_response : sig
46
+
type t
47
+
48
+
val from_account_id : t -> id
49
+
val account_id : t -> id
50
+
val copied : t -> id id_map option
51
+
val not_copied : t -> Set_error.t id_map option
52
+
53
+
val v :
54
+
from_account_id:id ->
55
+
account_id:id ->
56
+
?copied:id id_map ->
57
+
?not_copied:Set_error.t id_map ->
58
+
unit ->
59
+
t
60
+
end
+266
jmap/jmap_error.ml
+266
jmap/jmap_error.ml
···
1
+
(* JMAP Error Types. *)
2
+
3
+
open Jmap_types
4
+
5
+
(* Standard Method-level error types. *)
6
+
type method_error_type = [
7
+
| `ServerUnavailable
8
+
| `ServerFail
9
+
| `ServerPartialFail
10
+
| `UnknownMethod
11
+
| `InvalidArguments
12
+
| `InvalidResultReference
13
+
| `Forbidden
14
+
| `AccountNotFound
15
+
| `AccountNotSupportedByMethod
16
+
| `AccountReadOnly
17
+
| `RequestTooLarge
18
+
| `CannotCalculateChanges
19
+
| `StateMismatch
20
+
| `AnchorNotFound
21
+
| `UnsupportedSort
22
+
| `UnsupportedFilter
23
+
| `TooManyChanges
24
+
| `FromAccountNotFound
25
+
| `FromAccountNotSupportedByMethod
26
+
| `Other_method_error of string
27
+
]
28
+
29
+
(* Standard SetError types. *)
30
+
type set_error_type = [
31
+
| `Forbidden
32
+
| `OverQuota
33
+
| `TooLarge
34
+
| `RateLimit
35
+
| `NotFound
36
+
| `InvalidPatch
37
+
| `WillDestroy
38
+
| `InvalidProperties
39
+
| `Singleton
40
+
| `AlreadyExists (* From /copy *)
41
+
| `MailboxHasChild (* RFC 8621 *)
42
+
| `MailboxHasEmail (* RFC 8621 *)
43
+
| `BlobNotFound (* RFC 8621 *)
44
+
| `TooManyKeywords (* RFC 8621 *)
45
+
| `TooManyMailboxes (* RFC 8621 *)
46
+
| `InvalidEmail (* RFC 8621 *)
47
+
| `TooManyRecipients (* RFC 8621 *)
48
+
| `NoRecipients (* RFC 8621 *)
49
+
| `InvalidRecipients (* RFC 8621 *)
50
+
| `ForbiddenMailFrom (* RFC 8621 *)
51
+
| `ForbiddenFrom (* RFC 8621 *)
52
+
| `ForbiddenToSend (* RFC 8621 *)
53
+
| `CannotUnsend (* RFC 8621 *)
54
+
| `Other_set_error of string (* For future or custom errors *)
55
+
]
56
+
57
+
(* Primary error type that can represent all JMAP errors *)
58
+
type error =
59
+
| Transport of string (* Network/HTTP-level error *)
60
+
| Parse of string (* JSON parsing error *)
61
+
| Protocol of string (* JMAP protocol error *)
62
+
| Problem of string (* Problem Details object error *)
63
+
| Method of method_error_type * string option (* Method error with optional description *)
64
+
| SetItem of id * set_error_type * string option (* Error for a specific item in a /set operation *)
65
+
| Auth of string (* Authentication error *)
66
+
| ServerError of string (* Server reported an error *)
67
+
68
+
(* Standard Result type for JMAP operations *)
69
+
type 'a result = ('a, error) Result.t
70
+
71
+
(* Problem details object for HTTP-level errors. *)
72
+
module Problem_details = struct
73
+
type t = {
74
+
problem_type: string;
75
+
status: int option;
76
+
detail: string option;
77
+
limit: string option;
78
+
other_fields: Yojson.Safe.t string_map;
79
+
}
80
+
81
+
let problem_type t = t.problem_type
82
+
let status t = t.status
83
+
let detail t = t.detail
84
+
let limit t = t.limit
85
+
let other_fields t = t.other_fields
86
+
87
+
let v ?status ?detail ?limit ?(other_fields=Hashtbl.create 0) problem_type =
88
+
{ problem_type; status; detail; limit; other_fields }
89
+
end
90
+
91
+
(* Description for method errors. May contain additional details. *)
92
+
module Method_error_description = struct
93
+
type t = {
94
+
description: string option;
95
+
}
96
+
97
+
let description t = t.description
98
+
99
+
let v ?description () = { description }
100
+
end
101
+
102
+
(* Represents a method-level error response invocation part. *)
103
+
module Method_error = struct
104
+
type t = {
105
+
type_: method_error_type;
106
+
description: Method_error_description.t option;
107
+
}
108
+
109
+
let type_ t = t.type_
110
+
let description t = t.description
111
+
112
+
let v ?description type_ = { type_; description }
113
+
end
114
+
115
+
(* SetError object. *)
116
+
module Set_error = struct
117
+
type t = {
118
+
type_: set_error_type;
119
+
description: string option;
120
+
properties: string list option;
121
+
existing_id: id option;
122
+
max_recipients: uint option;
123
+
invalid_recipients: string list option;
124
+
max_size: uint option;
125
+
not_found_blob_ids: id list option;
126
+
}
127
+
128
+
let type_ t = t.type_
129
+
let description t = t.description
130
+
let properties t = t.properties
131
+
let existing_id t = t.existing_id
132
+
let max_recipients t = t.max_recipients
133
+
let invalid_recipients t = t.invalid_recipients
134
+
let max_size t = t.max_size
135
+
let not_found_blob_ids t = t.not_found_blob_ids
136
+
137
+
let v ?description ?properties ?existing_id ?max_recipients
138
+
?invalid_recipients ?max_size ?not_found_blob_ids type_ =
139
+
{ type_; description; properties; existing_id; max_recipients;
140
+
invalid_recipients; max_size; not_found_blob_ids }
141
+
end
142
+
143
+
(* Error Handling Functions *)
144
+
145
+
let transport_error msg = Transport msg
146
+
147
+
let parse_error msg = Parse msg
148
+
149
+
let protocol_error msg = Protocol msg
150
+
151
+
let problem_error problem =
152
+
Problem (Problem_details.problem_type problem)
153
+
154
+
let method_error ?description type_ =
155
+
Method (type_, description)
156
+
157
+
let set_item_error id ?description type_ =
158
+
SetItem (id, type_, description)
159
+
160
+
let auth_error msg = Auth msg
161
+
162
+
let server_error msg = ServerError msg
163
+
164
+
let of_method_error method_error =
165
+
let description = match Method_error.description method_error with
166
+
| Some desc -> Method_error_description.description desc
167
+
| None -> None
168
+
in
169
+
Method (Method_error.type_ method_error, description)
170
+
171
+
let of_set_error id set_error =
172
+
SetItem (id, Set_error.type_ set_error, Set_error.description set_error)
173
+
174
+
let error_to_string = function
175
+
| Transport msg -> "Transport error: " ^ msg
176
+
| Parse msg -> "Parse error: " ^ msg
177
+
| Protocol msg -> "Protocol error: " ^ msg
178
+
| Problem problem -> "Problem: " ^ problem
179
+
| Method (type_, desc) ->
180
+
let type_str = match type_ with
181
+
| `ServerUnavailable -> "serverUnavailable"
182
+
| `ServerFail -> "serverFail"
183
+
| `ServerPartialFail -> "serverPartialFail"
184
+
| `UnknownMethod -> "unknownMethod"
185
+
| `InvalidArguments -> "invalidArguments"
186
+
| `InvalidResultReference -> "invalidResultReference"
187
+
| `Forbidden -> "forbidden"
188
+
| `AccountNotFound -> "accountNotFound"
189
+
| `AccountNotSupportedByMethod -> "accountNotSupportedByMethod"
190
+
| `AccountReadOnly -> "accountReadOnly"
191
+
| `RequestTooLarge -> "requestTooLarge"
192
+
| `CannotCalculateChanges -> "cannotCalculateChanges"
193
+
| `StateMismatch -> "stateMismatch"
194
+
| `AnchorNotFound -> "anchorNotFound"
195
+
| `UnsupportedSort -> "unsupportedSort"
196
+
| `UnsupportedFilter -> "unsupportedFilter"
197
+
| `TooManyChanges -> "tooManyChanges"
198
+
| `FromAccountNotFound -> "fromAccountNotFound"
199
+
| `FromAccountNotSupportedByMethod -> "fromAccountNotSupportedByMethod"
200
+
| `Other_method_error s -> s
201
+
in
202
+
let desc_str = match desc with
203
+
| Some d -> ": " ^ d
204
+
| None -> ""
205
+
in
206
+
"Method error: " ^ type_str ^ desc_str
207
+
| SetItem (id, type_, desc) ->
208
+
let type_str = match type_ with
209
+
| `Forbidden -> "forbidden"
210
+
| `OverQuota -> "overQuota"
211
+
| `TooLarge -> "tooLarge"
212
+
| `RateLimit -> "rateLimit"
213
+
| `NotFound -> "notFound"
214
+
| `InvalidPatch -> "invalidPatch"
215
+
| `WillDestroy -> "willDestroy"
216
+
| `InvalidProperties -> "invalidProperties"
217
+
| `Singleton -> "singleton"
218
+
| `AlreadyExists -> "alreadyExists"
219
+
| `MailboxHasChild -> "mailboxHasChild"
220
+
| `MailboxHasEmail -> "mailboxHasEmail"
221
+
| `BlobNotFound -> "blobNotFound"
222
+
| `TooManyKeywords -> "tooManyKeywords"
223
+
| `TooManyMailboxes -> "tooManyMailboxes"
224
+
| `InvalidEmail -> "invalidEmail"
225
+
| `TooManyRecipients -> "tooManyRecipients"
226
+
| `NoRecipients -> "noRecipients"
227
+
| `InvalidRecipients -> "invalidRecipients"
228
+
| `ForbiddenMailFrom -> "forbiddenMailFrom"
229
+
| `ForbiddenFrom -> "forbiddenFrom"
230
+
| `ForbiddenToSend -> "forbiddenToSend"
231
+
| `CannotUnsend -> "cannotUnsend"
232
+
| `Other_set_error s -> s
233
+
in
234
+
let desc_str = match desc with
235
+
| Some d -> ": " ^ d
236
+
| None -> ""
237
+
in
238
+
"SetItem error for " ^ id ^ ": " ^ type_str ^ desc_str
239
+
| Auth msg -> "Authentication error: " ^ msg
240
+
| ServerError msg -> "Server error: " ^ msg
241
+
242
+
(* Result Handling *)
243
+
244
+
let map_error result f =
245
+
match result with
246
+
| Ok v -> Ok v
247
+
| Error e -> Error (f e)
248
+
249
+
let with_context result context =
250
+
map_error result (function
251
+
| Transport msg -> Transport (context ^ ": " ^ msg)
252
+
| Parse msg -> Parse (context ^ ": " ^ msg)
253
+
| Protocol msg -> Protocol (context ^ ": " ^ msg)
254
+
| Problem p -> Problem (context ^ ": " ^ p)
255
+
| Method (t, Some d) -> Method (t, Some (context ^ ": " ^ d))
256
+
| Method (t, None) -> Method (t, Some context)
257
+
| SetItem (id, t, Some d) -> SetItem (id, t, Some (context ^ ": " ^ d))
258
+
| SetItem (id, t, None) -> SetItem (id, t, Some context)
259
+
| Auth msg -> Auth (context ^ ": " ^ msg)
260
+
| ServerError msg -> ServerError (context ^ ": " ^ msg)
261
+
)
262
+
263
+
let of_option opt error =
264
+
match opt with
265
+
| Some v -> Ok v
266
+
| None -> Error error
+189
jmap/jmap_error.mli
+189
jmap/jmap_error.mli
···
1
+
(** JMAP Error Types.
2
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.6> RFC 8620, Section 3.6 *)
3
+
4
+
open Jmap_types
5
+
6
+
(** Standard Method-level error types.
7
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.6.2> RFC 8620, Section 3.6.2 *)
8
+
type method_error_type = [
9
+
| `ServerUnavailable
10
+
| `ServerFail
11
+
| `ServerPartialFail
12
+
| `UnknownMethod
13
+
| `InvalidArguments
14
+
| `InvalidResultReference
15
+
| `Forbidden
16
+
| `AccountNotFound
17
+
| `AccountNotSupportedByMethod
18
+
| `AccountReadOnly
19
+
| `RequestTooLarge
20
+
| `CannotCalculateChanges
21
+
| `StateMismatch
22
+
| `AnchorNotFound
23
+
| `UnsupportedSort
24
+
| `UnsupportedFilter
25
+
| `TooManyChanges
26
+
| `FromAccountNotFound
27
+
| `FromAccountNotSupportedByMethod
28
+
| `Other_method_error of string
29
+
]
30
+
31
+
(** Standard SetError types.
32
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.3> RFC 8620, Section 5.3 *)
33
+
type set_error_type = [
34
+
| `Forbidden
35
+
| `OverQuota
36
+
| `TooLarge
37
+
| `RateLimit
38
+
| `NotFound
39
+
| `InvalidPatch
40
+
| `WillDestroy
41
+
| `InvalidProperties
42
+
| `Singleton
43
+
| `AlreadyExists (* From /copy *)
44
+
| `MailboxHasChild (* RFC 8621 *)
45
+
| `MailboxHasEmail (* RFC 8621 *)
46
+
| `BlobNotFound (* RFC 8621 *)
47
+
| `TooManyKeywords (* RFC 8621 *)
48
+
| `TooManyMailboxes (* RFC 8621 *)
49
+
| `InvalidEmail (* RFC 8621 *)
50
+
| `TooManyRecipients (* RFC 8621 *)
51
+
| `NoRecipients (* RFC 8621 *)
52
+
| `InvalidRecipients (* RFC 8621 *)
53
+
| `ForbiddenMailFrom (* RFC 8621 *)
54
+
| `ForbiddenFrom (* RFC 8621 *)
55
+
| `ForbiddenToSend (* RFC 8621 *)
56
+
| `CannotUnsend (* RFC 8621 *)
57
+
| `Other_set_error of string (* For future or custom errors *)
58
+
]
59
+
60
+
(** Primary error type that can represent all JMAP errors *)
61
+
type error =
62
+
| Transport of string (** Network/HTTP-level error *)
63
+
| Parse of string (** JSON parsing error *)
64
+
| Protocol of string (** JMAP protocol error *)
65
+
| Problem of string (** Problem Details object error *)
66
+
| Method of method_error_type * string option (** Method error with optional description *)
67
+
| SetItem of id * set_error_type * string option (** Error for a specific item in a /set operation *)
68
+
| Auth of string (** Authentication error *)
69
+
| ServerError of string (** Server reported an error *)
70
+
71
+
(** Standard Result type for JMAP operations *)
72
+
type 'a result = ('a, error) Result.t
73
+
74
+
(** Problem details object for HTTP-level errors.
75
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.6.1> RFC 8620, Section 3.6.1
76
+
@see <https://www.rfc-editor.org/rfc/rfc7807.html> RFC 7807 *)
77
+
module Problem_details : sig
78
+
type t
79
+
80
+
val problem_type : t -> string
81
+
val status : t -> int option
82
+
val detail : t -> string option
83
+
val limit : t -> string option
84
+
val other_fields : t -> Yojson.Safe.t string_map
85
+
86
+
val v :
87
+
?status:int ->
88
+
?detail:string ->
89
+
?limit:string ->
90
+
?other_fields:Yojson.Safe.t string_map ->
91
+
string ->
92
+
t
93
+
end
94
+
95
+
(** Description for method errors. May contain additional details.
96
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.6.2> RFC 8620, Section 3.6.2 *)
97
+
module Method_error_description : sig
98
+
type t
99
+
100
+
val description : t -> string option
101
+
102
+
val v : ?description:string -> unit -> t
103
+
end
104
+
105
+
(** Represents a method-level error response invocation part.
106
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.6.2> RFC 8620, Section 3.6.2 *)
107
+
module Method_error : sig
108
+
type t
109
+
110
+
val type_ : t -> method_error_type
111
+
val description : t -> Method_error_description.t option
112
+
113
+
val v :
114
+
?description:Method_error_description.t ->
115
+
method_error_type ->
116
+
t
117
+
end
118
+
119
+
(** SetError object.
120
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.3> RFC 8620, Section 5.3 *)
121
+
module Set_error : sig
122
+
type t
123
+
124
+
val type_ : t -> set_error_type
125
+
val description : t -> string option
126
+
val properties : t -> string list option
127
+
val existing_id : t -> id option
128
+
val max_recipients : t -> uint option
129
+
val invalid_recipients : t -> string list option
130
+
val max_size : t -> uint option
131
+
val not_found_blob_ids : t -> id list option
132
+
133
+
val v :
134
+
?description:string ->
135
+
?properties:string list ->
136
+
?existing_id:id ->
137
+
?max_recipients:uint ->
138
+
?invalid_recipients:string list ->
139
+
?max_size:uint ->
140
+
?not_found_blob_ids:id list ->
141
+
set_error_type ->
142
+
t
143
+
end
144
+
145
+
(** {2 Error Handling Functions} *)
146
+
147
+
(** Create a transport error *)
148
+
val transport_error : string -> error
149
+
150
+
(** Create a parse error *)
151
+
val parse_error : string -> error
152
+
153
+
(** Create a protocol error *)
154
+
val protocol_error : string -> error
155
+
156
+
(** Create a problem details error *)
157
+
val problem_error : Problem_details.t -> error
158
+
159
+
(** Create a method error *)
160
+
val method_error : ?description:string -> method_error_type -> error
161
+
162
+
(** Create a SetItem error *)
163
+
val set_item_error : id -> ?description:string -> set_error_type -> error
164
+
165
+
(** Create an auth error *)
166
+
val auth_error : string -> error
167
+
168
+
(** Create a server error *)
169
+
val server_error : string -> error
170
+
171
+
(** Convert a Method_error.t to error *)
172
+
val of_method_error : Method_error.t -> error
173
+
174
+
(** Convert a Set_error.t to error for a specific ID *)
175
+
val of_set_error : id -> Set_error.t -> error
176
+
177
+
(** Get a human-readable description of an error *)
178
+
val error_to_string : error -> string
179
+
180
+
(** {2 Result Handling} *)
181
+
182
+
(** Map an error with additional context *)
183
+
val map_error : 'a result -> (error -> error) -> 'a result
184
+
185
+
(** Add context to an error *)
186
+
val with_context : 'a result -> string -> 'a result
187
+
188
+
(** Convert an option to a result with an error for None *)
189
+
val of_option : 'a option -> error -> 'a result
+436
jmap/jmap_methods.ml
+436
jmap/jmap_methods.ml
···
1
+
(* Standard JMAP Methods and Core/echo. *)
2
+
3
+
open Jmap_types
4
+
open Jmap_error
5
+
6
+
(* Generic representation of a record type. Actual types defined elsewhere. *)
7
+
type generic_record = Yojson.Safe.t
8
+
9
+
(* Arguments for /get methods. *)
10
+
module Get_args = struct
11
+
type 'record t = {
12
+
account_id: id;
13
+
ids: id list option;
14
+
properties: string list option;
15
+
}
16
+
17
+
let account_id t = t.account_id
18
+
let ids t = t.ids
19
+
let properties t = t.properties
20
+
21
+
let v ~account_id ?ids ?properties () =
22
+
{ account_id; ids; properties }
23
+
end
24
+
25
+
(* Response for /get methods. *)
26
+
module Get_response = struct
27
+
type 'record t = {
28
+
account_id: id;
29
+
state: string;
30
+
list: 'record list;
31
+
not_found: id list;
32
+
}
33
+
34
+
let account_id t = t.account_id
35
+
let state t = t.state
36
+
let list t = t.list
37
+
let not_found t = t.not_found
38
+
39
+
let v ~account_id ~state ~list ~not_found () =
40
+
{ account_id; state; list; not_found }
41
+
end
42
+
43
+
(* Arguments for /changes methods. *)
44
+
module Changes_args = struct
45
+
type t = {
46
+
account_id: id;
47
+
since_state: string;
48
+
max_changes: uint option;
49
+
}
50
+
51
+
let account_id t = t.account_id
52
+
let since_state t = t.since_state
53
+
let max_changes t = t.max_changes
54
+
55
+
let v ~account_id ~since_state ?max_changes () =
56
+
{ account_id; since_state; max_changes }
57
+
end
58
+
59
+
(* Response for /changes methods. *)
60
+
module Changes_response = struct
61
+
type t = {
62
+
account_id: id;
63
+
old_state: string;
64
+
new_state: string;
65
+
has_more_changes: bool;
66
+
created: id list;
67
+
updated: id list;
68
+
destroyed: id list;
69
+
updated_properties: string list option;
70
+
}
71
+
72
+
let account_id t = t.account_id
73
+
let old_state t = t.old_state
74
+
let new_state t = t.new_state
75
+
let has_more_changes t = t.has_more_changes
76
+
let created t = t.created
77
+
let updated t = t.updated
78
+
let destroyed t = t.destroyed
79
+
let updated_properties t = t.updated_properties
80
+
81
+
let v ~account_id ~old_state ~new_state ~has_more_changes
82
+
~created ~updated ~destroyed ?updated_properties () =
83
+
{ account_id; old_state; new_state; has_more_changes;
84
+
created; updated; destroyed; updated_properties }
85
+
end
86
+
87
+
(* Patch object for /set update.
88
+
A list of (JSON Pointer path, value) pairs. *)
89
+
type patch_object = (json_pointer * Yojson.Safe.t) list
90
+
91
+
(* Arguments for /set methods. *)
92
+
module Set_args = struct
93
+
type ('create_record, 'update_record) t = {
94
+
account_id: id;
95
+
if_in_state: string option;
96
+
create: 'create_record id_map option;
97
+
update: 'update_record id_map option;
98
+
destroy: id list option;
99
+
on_success_destroy_original: bool option;
100
+
destroy_from_if_in_state: string option;
101
+
on_destroy_remove_emails: bool option;
102
+
}
103
+
104
+
let account_id t = t.account_id
105
+
let if_in_state t = t.if_in_state
106
+
let create t = t.create
107
+
let update t = t.update
108
+
let destroy t = t.destroy
109
+
let on_success_destroy_original t = t.on_success_destroy_original
110
+
let destroy_from_if_in_state t = t.destroy_from_if_in_state
111
+
let on_destroy_remove_emails t = t.on_destroy_remove_emails
112
+
113
+
let v ~account_id ?if_in_state ?create ?update ?destroy
114
+
?on_success_destroy_original ?destroy_from_if_in_state
115
+
?on_destroy_remove_emails () =
116
+
{ account_id; if_in_state; create; update; destroy;
117
+
on_success_destroy_original; destroy_from_if_in_state;
118
+
on_destroy_remove_emails }
119
+
end
120
+
121
+
(* Response for /set methods. *)
122
+
module Set_response = struct
123
+
type ('created_record_info, 'updated_record_info) t = {
124
+
account_id: id;
125
+
old_state: string option;
126
+
new_state: string;
127
+
created: 'created_record_info id_map option;
128
+
updated: 'updated_record_info option id_map option;
129
+
destroyed: id list option;
130
+
not_created: Set_error.t id_map option;
131
+
not_updated: Set_error.t id_map option;
132
+
not_destroyed: Set_error.t id_map option;
133
+
}
134
+
135
+
let account_id t = t.account_id
136
+
let old_state t = t.old_state
137
+
let new_state t = t.new_state
138
+
let created t = t.created
139
+
let updated t = t.updated
140
+
let destroyed t = t.destroyed
141
+
let not_created t = t.not_created
142
+
let not_updated t = t.not_updated
143
+
let not_destroyed t = t.not_destroyed
144
+
145
+
let v ~account_id ?old_state ~new_state ?created ?updated ?destroyed
146
+
?not_created ?not_updated ?not_destroyed () =
147
+
{ account_id; old_state; new_state; created; updated; destroyed;
148
+
not_created; not_updated; not_destroyed }
149
+
end
150
+
151
+
(* Arguments for /copy methods. *)
152
+
module Copy_args = struct
153
+
type 'copy_record_override t = {
154
+
from_account_id: id;
155
+
if_from_in_state: string option;
156
+
account_id: id;
157
+
if_in_state: string option;
158
+
create: 'copy_record_override id_map;
159
+
on_success_destroy_original: bool;
160
+
destroy_from_if_in_state: string option;
161
+
}
162
+
163
+
let from_account_id t = t.from_account_id
164
+
let if_from_in_state t = t.if_from_in_state
165
+
let account_id t = t.account_id
166
+
let if_in_state t = t.if_in_state
167
+
let create t = t.create
168
+
let on_success_destroy_original t = t.on_success_destroy_original
169
+
let destroy_from_if_in_state t = t.destroy_from_if_in_state
170
+
171
+
let v ~from_account_id ?if_from_in_state ~account_id ?if_in_state
172
+
~create ?(on_success_destroy_original=false) ?destroy_from_if_in_state () =
173
+
{ from_account_id; if_from_in_state; account_id; if_in_state;
174
+
create; on_success_destroy_original; destroy_from_if_in_state }
175
+
end
176
+
177
+
(* Response for /copy methods. *)
178
+
module Copy_response = struct
179
+
type 'created_record_info t = {
180
+
from_account_id: id;
181
+
account_id: id;
182
+
old_state: string option;
183
+
new_state: string;
184
+
created: 'created_record_info id_map option;
185
+
not_created: Set_error.t id_map option;
186
+
}
187
+
188
+
let from_account_id t = t.from_account_id
189
+
let account_id t = t.account_id
190
+
let old_state t = t.old_state
191
+
let new_state t = t.new_state
192
+
let created t = t.created
193
+
let not_created t = t.not_created
194
+
195
+
let v ~from_account_id ~account_id ?old_state ~new_state
196
+
?created ?not_created () =
197
+
{ from_account_id; account_id; old_state; new_state;
198
+
created; not_created }
199
+
end
200
+
201
+
(* Module for generic filter representation. *)
202
+
module Filter = struct
203
+
type t =
204
+
| Condition of Yojson.Safe.t
205
+
| Operator of [ `AND | `OR | `NOT ] * t list
206
+
207
+
let condition json = Condition json
208
+
209
+
let operator op filters = Operator (op, filters)
210
+
211
+
let and_ filters = operator `AND filters
212
+
213
+
let or_ filters = operator `OR filters
214
+
215
+
let not_ filter = operator `NOT [filter]
216
+
217
+
let rec to_json = function
218
+
| Condition json -> json
219
+
| Operator (op, filters) ->
220
+
let key = match op with
221
+
| `AND -> "AND"
222
+
| `OR -> "OR"
223
+
| `NOT -> "NOT"
224
+
in
225
+
`Assoc [(key, `List (List.map to_json filters))]
226
+
227
+
(* Helper functions for common filter conditions *)
228
+
229
+
let text_contains property value =
230
+
condition (`Assoc [
231
+
(property, `Assoc [("contains", `String value)])
232
+
])
233
+
234
+
let property_equals property value =
235
+
condition (`Assoc [(property, value)])
236
+
237
+
let property_not_equals property value =
238
+
condition (`Assoc [
239
+
(property, `Assoc [("!",value)])
240
+
])
241
+
242
+
let property_gt property value =
243
+
condition (`Assoc [
244
+
(property, `Assoc [("gt", value)])
245
+
])
246
+
247
+
let property_ge property value =
248
+
condition (`Assoc [
249
+
(property, `Assoc [("ge", value)])
250
+
])
251
+
252
+
let property_lt property value =
253
+
condition (`Assoc [
254
+
(property, `Assoc [("lt", value)])
255
+
])
256
+
257
+
let property_le property value =
258
+
condition (`Assoc [
259
+
(property, `Assoc [("le", value)])
260
+
])
261
+
262
+
let property_in property values =
263
+
condition (`Assoc [
264
+
(property, `Assoc [("in", `List values)])
265
+
])
266
+
267
+
let property_not_in property values =
268
+
condition (`Assoc [
269
+
(property, `Assoc [("!in", `List values)])
270
+
])
271
+
272
+
let property_exists property =
273
+
condition (`Assoc [
274
+
(property, `Null) (* Using just the property name means "property exists" *)
275
+
])
276
+
277
+
let string_starts_with property prefix =
278
+
condition (`Assoc [
279
+
(property, `Assoc [("startsWith", `String prefix)])
280
+
])
281
+
282
+
let string_ends_with property suffix =
283
+
condition (`Assoc [
284
+
(property, `Assoc [("endsWith", `String suffix)])
285
+
])
286
+
end
287
+
288
+
(* Comparator for sorting. *)
289
+
module Comparator = struct
290
+
type t = {
291
+
property: string;
292
+
is_ascending: bool option;
293
+
collation: string option;
294
+
keyword: string option;
295
+
other_fields: Yojson.Safe.t string_map;
296
+
}
297
+
298
+
let property t = t.property
299
+
let is_ascending t = t.is_ascending
300
+
let collation t = t.collation
301
+
let keyword t = t.keyword
302
+
let other_fields t = t.other_fields
303
+
304
+
let v ~property ?is_ascending ?collation ?keyword
305
+
?(other_fields=Hashtbl.create 0) () =
306
+
{ property; is_ascending; collation; keyword; other_fields }
307
+
end
308
+
309
+
(* Arguments for /query methods. *)
310
+
module Query_args = struct
311
+
type t = {
312
+
account_id: id;
313
+
filter: Filter.t option;
314
+
sort: Comparator.t list option;
315
+
position: jint option;
316
+
anchor: id option;
317
+
anchor_offset: jint option;
318
+
limit: uint option;
319
+
calculate_total: bool option;
320
+
collapse_threads: bool option;
321
+
sort_as_tree: bool option;
322
+
filter_as_tree: bool option;
323
+
}
324
+
325
+
let account_id t = t.account_id
326
+
let filter t = t.filter
327
+
let sort t = t.sort
328
+
let position t = t.position
329
+
let anchor t = t.anchor
330
+
let anchor_offset t = t.anchor_offset
331
+
let limit t = t.limit
332
+
let calculate_total t = t.calculate_total
333
+
let collapse_threads t = t.collapse_threads
334
+
let sort_as_tree t = t.sort_as_tree
335
+
let filter_as_tree t = t.filter_as_tree
336
+
337
+
let v ~account_id ?filter ?sort ?position ?anchor ?anchor_offset
338
+
?limit ?calculate_total ?collapse_threads ?sort_as_tree ?filter_as_tree () =
339
+
{ account_id; filter; sort; position; anchor; anchor_offset;
340
+
limit; calculate_total; collapse_threads; sort_as_tree; filter_as_tree }
341
+
end
342
+
343
+
(* Response for /query methods. *)
344
+
module Query_response = struct
345
+
type t = {
346
+
account_id: id;
347
+
query_state: string;
348
+
can_calculate_changes: bool;
349
+
position: uint;
350
+
ids: id list;
351
+
total: uint option;
352
+
limit: uint option;
353
+
}
354
+
355
+
let account_id t = t.account_id
356
+
let query_state t = t.query_state
357
+
let can_calculate_changes t = t.can_calculate_changes
358
+
let position t = t.position
359
+
let ids t = t.ids
360
+
let total t = t.total
361
+
let limit t = t.limit
362
+
363
+
let v ~account_id ~query_state ~can_calculate_changes ~position ~ids
364
+
?total ?limit () =
365
+
{ account_id; query_state; can_calculate_changes; position; ids;
366
+
total; limit }
367
+
end
368
+
369
+
(* Item indicating an added record in /queryChanges. *)
370
+
module Added_item = struct
371
+
type t = {
372
+
id: id;
373
+
index: uint;
374
+
}
375
+
376
+
let id t = t.id
377
+
let index t = t.index
378
+
379
+
let v ~id ~index () = { id; index }
380
+
end
381
+
382
+
(* Arguments for /queryChanges methods. *)
383
+
module Query_changes_args = struct
384
+
type t = {
385
+
account_id: id;
386
+
filter: Filter.t option;
387
+
sort: Comparator.t list option;
388
+
since_query_state: string;
389
+
max_changes: uint option;
390
+
up_to_id: id option;
391
+
calculate_total: bool option;
392
+
collapse_threads: bool option;
393
+
}
394
+
395
+
let account_id t = t.account_id
396
+
let filter t = t.filter
397
+
let sort t = t.sort
398
+
let since_query_state t = t.since_query_state
399
+
let max_changes t = t.max_changes
400
+
let up_to_id t = t.up_to_id
401
+
let calculate_total t = t.calculate_total
402
+
let collapse_threads t = t.collapse_threads
403
+
404
+
let v ~account_id ?filter ?sort ~since_query_state ?max_changes
405
+
?up_to_id ?calculate_total ?collapse_threads () =
406
+
{ account_id; filter; sort; since_query_state; max_changes;
407
+
up_to_id; calculate_total; collapse_threads }
408
+
end
409
+
410
+
(* Response for /queryChanges methods. *)
411
+
module Query_changes_response = struct
412
+
type t = {
413
+
account_id: id;
414
+
old_query_state: string;
415
+
new_query_state: string;
416
+
total: uint option;
417
+
removed: id list;
418
+
added: Added_item.t list;
419
+
}
420
+
421
+
let account_id t = t.account_id
422
+
let old_query_state t = t.old_query_state
423
+
let new_query_state t = t.new_query_state
424
+
let total t = t.total
425
+
let removed t = t.removed
426
+
let added t = t.added
427
+
428
+
let v ~account_id ~old_query_state ~new_query_state ?total
429
+
~removed ~added () =
430
+
{ account_id; old_query_state; new_query_state; total;
431
+
removed; added }
432
+
end
433
+
434
+
(* Core/echo method: Arguments are mirrored in the response. *)
435
+
type core_echo_args = Yojson.Safe.t
436
+
type core_echo_response = Yojson.Safe.t
+417
jmap/jmap_methods.mli
+417
jmap/jmap_methods.mli
···
1
+
(** Standard JMAP Methods and Core/echo.
2
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-4> RFC 8620, Section 4
3
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5> RFC 8620, Section 5 *)
4
+
5
+
open Jmap_types
6
+
open Jmap_error
7
+
8
+
(** Generic representation of a record type. Actual types defined elsewhere. *)
9
+
type generic_record
10
+
11
+
(** Arguments for /get methods.
12
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.1> RFC 8620, Section 5.1 *)
13
+
module Get_args : sig
14
+
type 'record t
15
+
16
+
val account_id : 'record t -> id
17
+
val ids : 'record t -> id list option
18
+
val properties : 'record t -> string list option
19
+
20
+
val v :
21
+
account_id:id ->
22
+
?ids:id list ->
23
+
?properties:string list ->
24
+
unit ->
25
+
'record t
26
+
end
27
+
28
+
(** Response for /get methods.
29
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.1> RFC 8620, Section 5.1 *)
30
+
module Get_response : sig
31
+
type 'record t
32
+
33
+
val account_id : 'record t -> id
34
+
val state : 'record t -> string
35
+
val list : 'record t -> 'record list
36
+
val not_found : 'record t -> id list
37
+
38
+
val v :
39
+
account_id:id ->
40
+
state:string ->
41
+
list:'record list ->
42
+
not_found:id list ->
43
+
unit ->
44
+
'record t
45
+
end
46
+
47
+
(** Arguments for /changes methods.
48
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.2> RFC 8620, Section 5.2 *)
49
+
module Changes_args : sig
50
+
type t
51
+
52
+
val account_id : t -> id
53
+
val since_state : t -> string
54
+
val max_changes : t -> uint option
55
+
56
+
val v :
57
+
account_id:id ->
58
+
since_state:string ->
59
+
?max_changes:uint ->
60
+
unit ->
61
+
t
62
+
end
63
+
64
+
(** Response for /changes methods.
65
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.2> RFC 8620, Section 5.2 *)
66
+
module Changes_response : sig
67
+
type t
68
+
69
+
val account_id : t -> id
70
+
val old_state : t -> string
71
+
val new_state : t -> string
72
+
val has_more_changes : t -> bool
73
+
val created : t -> id list
74
+
val updated : t -> id list
75
+
val destroyed : t -> id list
76
+
val updated_properties : t -> string list option
77
+
78
+
val v :
79
+
account_id:id ->
80
+
old_state:string ->
81
+
new_state:string ->
82
+
has_more_changes:bool ->
83
+
created:id list ->
84
+
updated:id list ->
85
+
destroyed:id list ->
86
+
?updated_properties:string list ->
87
+
unit ->
88
+
t
89
+
end
90
+
91
+
(** Patch object for /set update.
92
+
A list of (JSON Pointer path, value) pairs.
93
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.3> RFC 8620, Section 5.3 *)
94
+
type patch_object = (json_pointer * Yojson.Safe.t) list
95
+
96
+
(** Arguments for /set methods.
97
+
['create_record] is the record type without server-set/immutable fields.
98
+
['update_record] is the patch object type (usually [patch_object]).
99
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.3> RFC 8620, Section 5.3 *)
100
+
module Set_args : sig
101
+
type ('create_record, 'update_record) t
102
+
103
+
val account_id : ('a, 'b) t -> id
104
+
val if_in_state : ('a, 'b) t -> string option
105
+
val create : ('a, 'b) t -> 'a id_map option
106
+
val update : ('a, 'b) t -> 'b id_map option
107
+
val destroy : ('a, 'b) t -> id list option
108
+
val on_success_destroy_original : ('a, 'b) t -> bool option
109
+
val destroy_from_if_in_state : ('a, 'b) t -> string option
110
+
val on_destroy_remove_emails : ('a, 'b) t -> bool option
111
+
112
+
val v :
113
+
account_id:id ->
114
+
?if_in_state:string ->
115
+
?create:'a id_map ->
116
+
?update:'b id_map ->
117
+
?destroy:id list ->
118
+
?on_success_destroy_original:bool ->
119
+
?destroy_from_if_in_state:string ->
120
+
?on_destroy_remove_emails:bool ->
121
+
unit ->
122
+
('a, 'b) t
123
+
end
124
+
125
+
(** Response for /set methods.
126
+
['created_record_info] is the server-set info for created records.
127
+
['updated_record_info] is the server-set/computed info for updated records.
128
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.3> RFC 8620, Section 5.3 *)
129
+
module Set_response : sig
130
+
type ('created_record_info, 'updated_record_info) t
131
+
132
+
val account_id : ('a, 'b) t -> id
133
+
val old_state : ('a, 'b) t -> string option
134
+
val new_state : ('a, 'b) t -> string
135
+
val created : ('a, 'b) t -> 'a id_map option
136
+
val updated : ('a, 'b) t -> 'b option id_map option
137
+
val destroyed : ('a, 'b) t -> id list option
138
+
val not_created : ('a, 'b) t -> Set_error.t id_map option
139
+
val not_updated : ('a, 'b) t -> Set_error.t id_map option
140
+
val not_destroyed : ('a, 'b) t -> Set_error.t id_map option
141
+
142
+
val v :
143
+
account_id:id ->
144
+
?old_state:string ->
145
+
new_state:string ->
146
+
?created:'a id_map ->
147
+
?updated:'b option id_map ->
148
+
?destroyed:id list ->
149
+
?not_created:Set_error.t id_map ->
150
+
?not_updated:Set_error.t id_map ->
151
+
?not_destroyed:Set_error.t id_map ->
152
+
unit ->
153
+
('a, 'b) t
154
+
end
155
+
156
+
(** Arguments for /copy methods.
157
+
['copy_record_override] contains the record id and override properties.
158
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.4> RFC 8620, Section 5.4 *)
159
+
module Copy_args : sig
160
+
type 'copy_record_override t
161
+
162
+
val from_account_id : 'a t -> id
163
+
val if_from_in_state : 'a t -> string option
164
+
val account_id : 'a t -> id
165
+
val if_in_state : 'a t -> string option
166
+
val create : 'a t -> 'a id_map
167
+
val on_success_destroy_original : 'a t -> bool
168
+
val destroy_from_if_in_state : 'a t -> string option
169
+
170
+
val v :
171
+
from_account_id:id ->
172
+
?if_from_in_state:string ->
173
+
account_id:id ->
174
+
?if_in_state:string ->
175
+
create:'a id_map ->
176
+
?on_success_destroy_original:bool ->
177
+
?destroy_from_if_in_state:string ->
178
+
unit ->
179
+
'a t
180
+
end
181
+
182
+
(** Response for /copy methods.
183
+
['created_record_info] is the server-set info for the created copy.
184
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.4> RFC 8620, Section 5.4 *)
185
+
module Copy_response : sig
186
+
type 'created_record_info t
187
+
188
+
val from_account_id : 'a t -> id
189
+
val account_id : 'a t -> id
190
+
val old_state : 'a t -> string option
191
+
val new_state : 'a t -> string
192
+
val created : 'a t -> 'a id_map option
193
+
val not_created : 'a t -> Set_error.t id_map option
194
+
195
+
val v :
196
+
from_account_id:id ->
197
+
account_id:id ->
198
+
?old_state:string ->
199
+
new_state:string ->
200
+
?created:'a id_map ->
201
+
?not_created:Set_error.t id_map ->
202
+
unit ->
203
+
'a t
204
+
end
205
+
206
+
(** Module for generic filter representation.
207
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.5> RFC 8620, Section 5.5 *)
208
+
module Filter : sig
209
+
type t
210
+
211
+
(** Create a filter from a raw JSON condition *)
212
+
val condition : Yojson.Safe.t -> t
213
+
214
+
(** Create a filter with a logical operator (AND, OR, NOT) *)
215
+
val operator : [ `AND | `OR | `NOT ] -> t list -> t
216
+
217
+
(** Combine filters with AND *)
218
+
val and_ : t list -> t
219
+
220
+
(** Combine filters with OR *)
221
+
val or_ : t list -> t
222
+
223
+
(** Negate a filter with NOT *)
224
+
val not_ : t -> t
225
+
226
+
(** Convert a filter to JSON *)
227
+
val to_json : t -> Yojson.Safe.t
228
+
229
+
(** Predefined filter helpers *)
230
+
231
+
(** Create a filter for a text property containing a string *)
232
+
val text_contains : string -> string -> t
233
+
234
+
(** Create a filter for a property being equal to a value *)
235
+
val property_equals : string -> Yojson.Safe.t -> t
236
+
237
+
(** Create a filter for a property being not equal to a value *)
238
+
val property_not_equals : string -> Yojson.Safe.t -> t
239
+
240
+
(** Create a filter for a property being greater than a value *)
241
+
val property_gt : string -> Yojson.Safe.t -> t
242
+
243
+
(** Create a filter for a property being greater than or equal to a value *)
244
+
val property_ge : string -> Yojson.Safe.t -> t
245
+
246
+
(** Create a filter for a property being less than a value *)
247
+
val property_lt : string -> Yojson.Safe.t -> t
248
+
249
+
(** Create a filter for a property being less than or equal to a value *)
250
+
val property_le : string -> Yojson.Safe.t -> t
251
+
252
+
(** Create a filter for a property value being in a list *)
253
+
val property_in : string -> Yojson.Safe.t list -> t
254
+
255
+
(** Create a filter for a property value not being in a list *)
256
+
val property_not_in : string -> Yojson.Safe.t list -> t
257
+
258
+
(** Create a filter for a property being present (not null) *)
259
+
val property_exists : string -> t
260
+
261
+
(** Create a filter for a string property starting with a prefix *)
262
+
val string_starts_with : string -> string -> t
263
+
264
+
(** Create a filter for a string property ending with a suffix *)
265
+
val string_ends_with : string -> string -> t
266
+
end
267
+
268
+
269
+
270
+
(** Comparator for sorting.
271
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.5> RFC 8620, Section 5.5 *)
272
+
module Comparator : sig
273
+
type t
274
+
275
+
val property : t -> string
276
+
val is_ascending : t -> bool option
277
+
val collation : t -> string option
278
+
val keyword : t -> string option
279
+
val other_fields : t -> Yojson.Safe.t string_map
280
+
281
+
val v :
282
+
property:string ->
283
+
?is_ascending:bool ->
284
+
?collation:string ->
285
+
?keyword:string ->
286
+
?other_fields:Yojson.Safe.t string_map ->
287
+
unit ->
288
+
t
289
+
end
290
+
291
+
(** Arguments for /query methods.
292
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.5> RFC 8620, Section 5.5 *)
293
+
module Query_args : sig
294
+
type t
295
+
296
+
val account_id : t -> id
297
+
val filter : t -> Filter.t option
298
+
val sort : t -> Comparator.t list option
299
+
val position : t -> jint option
300
+
val anchor : t -> id option
301
+
val anchor_offset : t -> jint option
302
+
val limit : t -> uint option
303
+
val calculate_total : t -> bool option
304
+
val collapse_threads : t -> bool option
305
+
val sort_as_tree : t -> bool option
306
+
val filter_as_tree : t -> bool option
307
+
308
+
val v :
309
+
account_id:id ->
310
+
?filter:Filter.t ->
311
+
?sort:Comparator.t list ->
312
+
?position:jint ->
313
+
?anchor:id ->
314
+
?anchor_offset:jint ->
315
+
?limit:uint ->
316
+
?calculate_total:bool ->
317
+
?collapse_threads:bool ->
318
+
?sort_as_tree:bool ->
319
+
?filter_as_tree:bool ->
320
+
unit ->
321
+
t
322
+
end
323
+
324
+
(** Response for /query methods.
325
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.5> RFC 8620, Section 5.5 *)
326
+
module Query_response : sig
327
+
type t
328
+
329
+
val account_id : t -> id
330
+
val query_state : t -> string
331
+
val can_calculate_changes : t -> bool
332
+
val position : t -> uint
333
+
val ids : t -> id list
334
+
val total : t -> uint option
335
+
val limit : t -> uint option
336
+
337
+
val v :
338
+
account_id:id ->
339
+
query_state:string ->
340
+
can_calculate_changes:bool ->
341
+
position:uint ->
342
+
ids:id list ->
343
+
?total:uint ->
344
+
?limit:uint ->
345
+
unit ->
346
+
t
347
+
end
348
+
349
+
(** Item indicating an added record in /queryChanges.
350
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.6> RFC 8620, Section 5.6 *)
351
+
module Added_item : sig
352
+
type t
353
+
354
+
val id : t -> id
355
+
val index : t -> uint
356
+
357
+
val v :
358
+
id:id ->
359
+
index:uint ->
360
+
unit ->
361
+
t
362
+
end
363
+
364
+
(** Arguments for /queryChanges methods.
365
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.6> RFC 8620, Section 5.6 *)
366
+
module Query_changes_args : sig
367
+
type t
368
+
369
+
val account_id : t -> id
370
+
val filter : t -> Filter.t option
371
+
val sort : t -> Comparator.t list option
372
+
val since_query_state : t -> string
373
+
val max_changes : t -> uint option
374
+
val up_to_id : t -> id option
375
+
val calculate_total : t -> bool option
376
+
val collapse_threads : t -> bool option
377
+
378
+
val v :
379
+
account_id:id ->
380
+
?filter:Filter.t ->
381
+
?sort:Comparator.t list ->
382
+
since_query_state:string ->
383
+
?max_changes:uint ->
384
+
?up_to_id:id ->
385
+
?calculate_total:bool ->
386
+
?collapse_threads:bool ->
387
+
unit ->
388
+
t
389
+
end
390
+
391
+
(** Response for /queryChanges methods.
392
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.6> RFC 8620, Section 5.6 *)
393
+
module Query_changes_response : sig
394
+
type t
395
+
396
+
val account_id : t -> id
397
+
val old_query_state : t -> string
398
+
val new_query_state : t -> string
399
+
val total : t -> uint option
400
+
val removed : t -> id list
401
+
val added : t -> Added_item.t list
402
+
403
+
val v :
404
+
account_id:id ->
405
+
old_query_state:string ->
406
+
new_query_state:string ->
407
+
?total:uint ->
408
+
removed:id list ->
409
+
added:Added_item.t list ->
410
+
unit ->
411
+
t
412
+
end
413
+
414
+
(** Core/echo method: Arguments are mirrored in the response.
415
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-4> RFC 8620, Section 4 *)
416
+
type core_echo_args = Yojson.Safe.t
417
+
type core_echo_response = Yojson.Safe.t
+192
jmap/jmap_push.ml
+192
jmap/jmap_push.ml
···
1
+
(* JMAP Push Notifications. *)
2
+
3
+
open Jmap_types
4
+
open Jmap_methods
5
+
open Jmap_error
6
+
7
+
(* TypeState object map (TypeName -> StateString). *)
8
+
type type_state = string string_map
9
+
10
+
(* StateChange object. *)
11
+
module State_change = struct
12
+
type t = {
13
+
changed: type_state id_map;
14
+
}
15
+
16
+
let changed t = t.changed
17
+
18
+
let v ~changed () = { changed }
19
+
end
20
+
21
+
(* PushSubscription encryption keys. *)
22
+
module Push_encryption_keys = struct
23
+
type t = {
24
+
p256dh: string;
25
+
auth: string;
26
+
}
27
+
28
+
let p256dh t = t.p256dh
29
+
let auth t = t.auth
30
+
31
+
let v ~p256dh ~auth () = { p256dh; auth }
32
+
end
33
+
34
+
(* PushSubscription object. *)
35
+
module Push_subscription = struct
36
+
type t = {
37
+
id: id;
38
+
device_client_id: string;
39
+
url: Uri.t;
40
+
keys: Push_encryption_keys.t option;
41
+
verification_code: string option;
42
+
expires: utc_date option;
43
+
types: string list option;
44
+
}
45
+
46
+
let id t = t.id
47
+
let device_client_id t = t.device_client_id
48
+
let url t = t.url
49
+
let keys t = t.keys
50
+
let verification_code t = t.verification_code
51
+
let expires t = t.expires
52
+
let types t = t.types
53
+
54
+
let v ~id ~device_client_id ~url ?keys ?verification_code ?expires ?types () =
55
+
{ id; device_client_id; url; keys; verification_code; expires; types }
56
+
end
57
+
58
+
(* PushSubscription object for creation (omits server-set fields). *)
59
+
module Push_subscription_create = struct
60
+
type t = {
61
+
device_client_id: string;
62
+
url: Uri.t;
63
+
keys: Push_encryption_keys.t option;
64
+
expires: utc_date option;
65
+
types: string list option;
66
+
}
67
+
68
+
let device_client_id t = t.device_client_id
69
+
let url t = t.url
70
+
let keys t = t.keys
71
+
let expires t = t.expires
72
+
let types t = t.types
73
+
74
+
let v ~device_client_id ~url ?keys ?expires ?types () =
75
+
{ device_client_id; url; keys; expires; types }
76
+
end
77
+
78
+
(* PushSubscription object for update patch.
79
+
Only verification_code and expires can be updated. *)
80
+
type push_subscription_update = patch_object
81
+
82
+
(* Arguments for PushSubscription/get. *)
83
+
module Push_subscription_get_args = struct
84
+
type t = {
85
+
ids: id list option;
86
+
properties: string list option;
87
+
}
88
+
89
+
let ids t = t.ids
90
+
let properties t = t.properties
91
+
92
+
let v ?ids ?properties () = { ids; properties }
93
+
end
94
+
95
+
(* Response for PushSubscription/get. *)
96
+
module Push_subscription_get_response = struct
97
+
type t = {
98
+
list: Push_subscription.t list;
99
+
not_found: id list;
100
+
}
101
+
102
+
let list t = t.list
103
+
let not_found t = t.not_found
104
+
105
+
let v ~list ~not_found () = { list; not_found }
106
+
end
107
+
108
+
(* Arguments for PushSubscription/set. *)
109
+
module Push_subscription_set_args = struct
110
+
type t = {
111
+
create: Push_subscription_create.t id_map option;
112
+
update: push_subscription_update id_map option;
113
+
destroy: id list option;
114
+
}
115
+
116
+
let create t = t.create
117
+
let update t = t.update
118
+
let destroy t = t.destroy
119
+
120
+
let v ?create ?update ?destroy () = { create; update; destroy }
121
+
end
122
+
123
+
(* Server-set information for created PushSubscription. *)
124
+
module Push_subscription_created_info = struct
125
+
type t = {
126
+
id: id;
127
+
expires: utc_date option;
128
+
}
129
+
130
+
let id t = t.id
131
+
let expires t = t.expires
132
+
133
+
let v ~id ?expires () = { id; expires }
134
+
end
135
+
136
+
(* Server-set information for updated PushSubscription. *)
137
+
module Push_subscription_updated_info = struct
138
+
type t = {
139
+
expires: utc_date option;
140
+
}
141
+
142
+
let expires t = t.expires
143
+
144
+
let v ?expires () = { expires }
145
+
end
146
+
147
+
(* Response for PushSubscription/set. *)
148
+
module Push_subscription_set_response = struct
149
+
type t = {
150
+
created: Push_subscription_created_info.t id_map option;
151
+
updated: Push_subscription_updated_info.t option id_map option;
152
+
destroyed: id list option;
153
+
not_created: Set_error.t id_map option;
154
+
not_updated: Set_error.t id_map option;
155
+
not_destroyed: Set_error.t id_map option;
156
+
}
157
+
158
+
let created t = t.created
159
+
let updated t = t.updated
160
+
let destroyed t = t.destroyed
161
+
let not_created t = t.not_created
162
+
let not_updated t = t.not_updated
163
+
let not_destroyed t = t.not_destroyed
164
+
165
+
let v ?created ?updated ?destroyed ?not_created ?not_updated ?not_destroyed () =
166
+
{ created; updated; destroyed; not_created; not_updated; not_destroyed }
167
+
end
168
+
169
+
(* PushVerification object. *)
170
+
module Push_verification = struct
171
+
type t = {
172
+
push_subscription_id: id;
173
+
verification_code: string;
174
+
}
175
+
176
+
let push_subscription_id t = t.push_subscription_id
177
+
let verification_code t = t.verification_code
178
+
179
+
let v ~push_subscription_id ~verification_code () =
180
+
{ push_subscription_id; verification_code }
181
+
end
182
+
183
+
(* Data for EventSource ping event. *)
184
+
module Event_source_ping_data = struct
185
+
type t = {
186
+
interval: uint;
187
+
}
188
+
189
+
let interval t = t.interval
190
+
191
+
let v ~interval () = { interval }
192
+
end
+230
jmap/jmap_push.mli
+230
jmap/jmap_push.mli
···
1
+
(** JMAP Push Notifications.
2
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7> RFC 8620, Section 7 *)
3
+
4
+
open Jmap_types
5
+
open Jmap_methods
6
+
open Jmap_error
7
+
8
+
(** TypeState object map (TypeName -> StateString).
9
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.1> RFC 8620, Section 7.1 *)
10
+
type type_state = string string_map
11
+
12
+
(** StateChange object.
13
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.1> RFC 8620, Section 7.1 *)
14
+
module State_change : sig
15
+
type t
16
+
17
+
val changed : t -> type_state id_map
18
+
19
+
val v :
20
+
changed:type_state id_map ->
21
+
unit ->
22
+
t
23
+
end
24
+
25
+
(** PushSubscription encryption keys.
26
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.2> RFC 8620, Section 7.2 *)
27
+
module Push_encryption_keys : sig
28
+
type t
29
+
30
+
(** P-256 ECDH public key (URL-safe base64) *)
31
+
val p256dh : t -> string
32
+
33
+
(** Authentication secret (URL-safe base64) *)
34
+
val auth : t -> string
35
+
36
+
val v :
37
+
p256dh:string ->
38
+
auth:string ->
39
+
unit ->
40
+
t
41
+
end
42
+
43
+
(** PushSubscription object.
44
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.2> RFC 8620, Section 7.2 *)
45
+
module Push_subscription : sig
46
+
type t
47
+
48
+
(** Id of the subscription (server-set, immutable) *)
49
+
val id : t -> id
50
+
51
+
(** Device client id (immutable) *)
52
+
val device_client_id : t -> string
53
+
54
+
(** Notification URL (immutable) *)
55
+
val url : t -> Uri.t
56
+
57
+
(** Encryption keys (immutable) *)
58
+
val keys : t -> Push_encryption_keys.t option
59
+
val verification_code : t -> string option
60
+
val expires : t -> utc_date option
61
+
val types : t -> string list option
62
+
63
+
val v :
64
+
id:id ->
65
+
device_client_id:string ->
66
+
url:Uri.t ->
67
+
?keys:Push_encryption_keys.t ->
68
+
?verification_code:string ->
69
+
?expires:utc_date ->
70
+
?types:string list ->
71
+
unit ->
72
+
t
73
+
end
74
+
75
+
(** PushSubscription object for creation (omits server-set fields).
76
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.2> RFC 8620, Section 7.2 *)
77
+
module Push_subscription_create : sig
78
+
type t
79
+
80
+
val device_client_id : t -> string
81
+
val url : t -> Uri.t
82
+
val keys : t -> Push_encryption_keys.t option
83
+
val expires : t -> utc_date option
84
+
val types : t -> string list option
85
+
86
+
val v :
87
+
device_client_id:string ->
88
+
url:Uri.t ->
89
+
?keys:Push_encryption_keys.t ->
90
+
?expires:utc_date ->
91
+
?types:string list ->
92
+
unit ->
93
+
t
94
+
end
95
+
96
+
(** PushSubscription object for update patch.
97
+
Only verification_code and expires can be updated.
98
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.2> RFC 8620, Section 7.2
99
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.2.2> RFC 8620, Section 7.2.2 *)
100
+
type push_subscription_update = patch_object
101
+
102
+
(** Arguments for PushSubscription/get.
103
+
Extends standard /get args.
104
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.2.1> RFC 8620, Section 7.2.1 *)
105
+
module Push_subscription_get_args : sig
106
+
type t
107
+
108
+
val ids : t -> id list option
109
+
val properties : t -> string list option
110
+
111
+
val v :
112
+
?ids:id list ->
113
+
?properties:string list ->
114
+
unit ->
115
+
t
116
+
end
117
+
118
+
(** Response for PushSubscription/get.
119
+
Extends standard /get response.
120
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.2.1> RFC 8620, Section 7.2.1 *)
121
+
module Push_subscription_get_response : sig
122
+
type t
123
+
124
+
val list : t -> Push_subscription.t list
125
+
val not_found : t -> id list
126
+
127
+
val v :
128
+
list:Push_subscription.t list ->
129
+
not_found:id list ->
130
+
unit ->
131
+
t
132
+
end
133
+
134
+
(** Arguments for PushSubscription/set.
135
+
Extends standard /set args.
136
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.2.2> RFC 8620, Section 7.2.2 *)
137
+
module Push_subscription_set_args : sig
138
+
type t
139
+
140
+
val create : t -> Push_subscription_create.t id_map option
141
+
val update : t -> push_subscription_update id_map option
142
+
val destroy : t -> id list option
143
+
144
+
val v :
145
+
?create:Push_subscription_create.t id_map ->
146
+
?update:push_subscription_update id_map ->
147
+
?destroy:id list ->
148
+
unit ->
149
+
t
150
+
end
151
+
152
+
(** Server-set information for created PushSubscription.
153
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.2.2> RFC 8620, Section 7.2.2 *)
154
+
module Push_subscription_created_info : sig
155
+
type t
156
+
157
+
val id : t -> id
158
+
val expires : t -> utc_date option
159
+
160
+
val v :
161
+
id:id ->
162
+
?expires:utc_date ->
163
+
unit ->
164
+
t
165
+
end
166
+
167
+
(** Server-set information for updated PushSubscription.
168
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.2.2> RFC 8620, Section 7.2.2 *)
169
+
module Push_subscription_updated_info : sig
170
+
type t
171
+
172
+
val expires : t -> utc_date option
173
+
174
+
val v :
175
+
?expires:utc_date ->
176
+
unit ->
177
+
t
178
+
end
179
+
180
+
(** Response for PushSubscription/set.
181
+
Extends standard /set response.
182
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.2.2> RFC 8620, Section 7.2.2 *)
183
+
module Push_subscription_set_response : sig
184
+
type t
185
+
186
+
val created : t -> Push_subscription_created_info.t id_map option
187
+
val updated : t -> Push_subscription_updated_info.t option id_map option
188
+
val destroyed : t -> id list option
189
+
val not_created : t -> Set_error.t id_map option
190
+
val not_updated : t -> Set_error.t id_map option
191
+
val not_destroyed : t -> Set_error.t id_map option
192
+
193
+
val v :
194
+
?created:Push_subscription_created_info.t id_map ->
195
+
?updated:Push_subscription_updated_info.t option id_map ->
196
+
?destroyed:id list ->
197
+
?not_created:Set_error.t id_map ->
198
+
?not_updated:Set_error.t id_map ->
199
+
?not_destroyed:Set_error.t id_map ->
200
+
unit ->
201
+
t
202
+
end
203
+
204
+
(** PushVerification object.
205
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.2.2> RFC 8620, Section 7.2.2 *)
206
+
module Push_verification : sig
207
+
type t
208
+
209
+
val push_subscription_id : t -> id
210
+
val verification_code : t -> string
211
+
212
+
val v :
213
+
push_subscription_id:id ->
214
+
verification_code:string ->
215
+
unit ->
216
+
t
217
+
end
218
+
219
+
(** Data for EventSource ping event.
220
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.3> RFC 8620, Section 7.3 *)
221
+
module Event_source_ping_data : sig
222
+
type t
223
+
224
+
val interval : t -> uint
225
+
226
+
val v :
227
+
interval:uint ->
228
+
unit ->
229
+
t
230
+
end
+114
jmap/jmap_session.ml
+114
jmap/jmap_session.ml
···
1
+
(* JMAP Session Resource. *)
2
+
3
+
open Jmap_types
4
+
5
+
(* Account capability information.
6
+
The value is capability-specific. *)
7
+
type account_capability_value = Yojson.Safe.t
8
+
9
+
(* Server capability information.
10
+
The value is capability-specific. *)
11
+
type server_capability_value = Yojson.Safe.t
12
+
13
+
(* Core capability information. *)
14
+
module Core_capability = struct
15
+
type t = {
16
+
max_size_upload: uint;
17
+
max_concurrent_upload: uint;
18
+
max_size_request: uint;
19
+
max_concurrent_requests: uint;
20
+
max_calls_in_request: uint;
21
+
max_objects_in_get: uint;
22
+
max_objects_in_set: uint;
23
+
collation_algorithms: string list;
24
+
}
25
+
26
+
let max_size_upload t = t.max_size_upload
27
+
let max_concurrent_upload t = t.max_concurrent_upload
28
+
let max_size_request t = t.max_size_request
29
+
let max_concurrent_requests t = t.max_concurrent_requests
30
+
let max_calls_in_request t = t.max_calls_in_request
31
+
let max_objects_in_get t = t.max_objects_in_get
32
+
let max_objects_in_set t = t.max_objects_in_set
33
+
let collation_algorithms t = t.collation_algorithms
34
+
35
+
let v ~max_size_upload ~max_concurrent_upload ~max_size_request
36
+
~max_concurrent_requests ~max_calls_in_request ~max_objects_in_get
37
+
~max_objects_in_set ~collation_algorithms () =
38
+
{ max_size_upload; max_concurrent_upload; max_size_request;
39
+
max_concurrent_requests; max_calls_in_request; max_objects_in_get;
40
+
max_objects_in_set; collation_algorithms }
41
+
end
42
+
43
+
(* An Account object. *)
44
+
module Account = struct
45
+
type t = {
46
+
name: string;
47
+
is_personal: bool;
48
+
is_read_only: bool;
49
+
account_capabilities: account_capability_value string_map;
50
+
}
51
+
52
+
let name t = t.name
53
+
let is_personal t = t.is_personal
54
+
let is_read_only t = t.is_read_only
55
+
let account_capabilities t = t.account_capabilities
56
+
57
+
let v ~name ?(is_personal=true) ?(is_read_only=false)
58
+
?(account_capabilities=Hashtbl.create 0) () =
59
+
{ name; is_personal; is_read_only; account_capabilities }
60
+
end
61
+
62
+
(* The Session object. *)
63
+
module Session = struct
64
+
type t = {
65
+
capabilities: server_capability_value string_map;
66
+
accounts: Account.t id_map;
67
+
primary_accounts: id string_map;
68
+
username: string;
69
+
api_url: Uri.t;
70
+
download_url: Uri.t;
71
+
upload_url: Uri.t;
72
+
event_source_url: Uri.t;
73
+
state: string;
74
+
}
75
+
76
+
let capabilities t = t.capabilities
77
+
let accounts t = t.accounts
78
+
let primary_accounts t = t.primary_accounts
79
+
let username t = t.username
80
+
let api_url t = t.api_url
81
+
let download_url t = t.download_url
82
+
let upload_url t = t.upload_url
83
+
let event_source_url t = t.event_source_url
84
+
let state t = t.state
85
+
86
+
let v ~capabilities ~accounts ~primary_accounts ~username
87
+
~api_url ~download_url ~upload_url ~event_source_url ~state () =
88
+
{ capabilities; accounts; primary_accounts; username;
89
+
api_url; download_url; upload_url; event_source_url; state }
90
+
end
91
+
92
+
(* Function to perform service autodiscovery.
93
+
Returns the session URL if found. *)
94
+
let discover ~domain =
95
+
(* This is a placeholder implementation - would need to be completed in Unix implementation *)
96
+
let well_known_url = Uri.of_string ("https://" ^ domain ^ "/.well-known/jmap") in
97
+
Some well_known_url
98
+
99
+
(* Function to fetch the session object from a given URL.
100
+
Requires authentication handling (details TBD/outside this signature). *)
101
+
let get_session ~url =
102
+
(* This is a placeholder implementation - would need to be completed in Unix implementation *)
103
+
let empty_map () = Hashtbl.create 0 in
104
+
Session.v
105
+
~capabilities:(empty_map ())
106
+
~accounts:(empty_map ())
107
+
~primary_accounts:(empty_map ())
108
+
~username:"placeholder"
109
+
~api_url:url
110
+
~download_url:url
111
+
~upload_url:url
112
+
~event_source_url:url
113
+
~state:"placeholder"
114
+
()
+98
jmap/jmap_session.mli
+98
jmap/jmap_session.mli
···
1
+
(** JMAP Session Resource.
2
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-2> RFC 8620, Section 2 *)
3
+
4
+
open Jmap_types
5
+
6
+
(** Account capability information.
7
+
The value is capability-specific.
8
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-2> RFC 8620, Section 2 *)
9
+
type account_capability_value = Yojson.Safe.t
10
+
11
+
(** Server capability information.
12
+
The value is capability-specific.
13
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-2> RFC 8620, Section 2 *)
14
+
type server_capability_value = Yojson.Safe.t
15
+
16
+
(** Core capability information.
17
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-2> RFC 8620, Section 2 *)
18
+
module Core_capability : sig
19
+
type t
20
+
21
+
val max_size_upload : t -> uint
22
+
val max_concurrent_upload : t -> uint
23
+
val max_size_request : t -> uint
24
+
val max_concurrent_requests : t -> uint
25
+
val max_calls_in_request : t -> uint
26
+
val max_objects_in_get : t -> uint
27
+
val max_objects_in_set : t -> uint
28
+
val collation_algorithms : t -> string list
29
+
30
+
val v :
31
+
max_size_upload:uint ->
32
+
max_concurrent_upload:uint ->
33
+
max_size_request:uint ->
34
+
max_concurrent_requests:uint ->
35
+
max_calls_in_request:uint ->
36
+
max_objects_in_get:uint ->
37
+
max_objects_in_set:uint ->
38
+
collation_algorithms:string list ->
39
+
unit ->
40
+
t
41
+
end
42
+
43
+
(** An Account object.
44
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-2> RFC 8620, Section 2 *)
45
+
module Account : sig
46
+
type t
47
+
48
+
val name : t -> string
49
+
val is_personal : t -> bool
50
+
val is_read_only : t -> bool
51
+
val account_capabilities : t -> account_capability_value string_map
52
+
53
+
val v :
54
+
name:string ->
55
+
?is_personal:bool ->
56
+
?is_read_only:bool ->
57
+
?account_capabilities:account_capability_value string_map ->
58
+
unit ->
59
+
t
60
+
end
61
+
62
+
(** The Session object.
63
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-2> RFC 8620, Section 2 *)
64
+
module Session : sig
65
+
type t
66
+
67
+
val capabilities : t -> server_capability_value string_map
68
+
val accounts : t -> Account.t id_map
69
+
val primary_accounts : t -> id string_map
70
+
val username : t -> string
71
+
val api_url : t -> Uri.t
72
+
val download_url : t -> Uri.t
73
+
val upload_url : t -> Uri.t
74
+
val event_source_url : t -> Uri.t
75
+
val state : t -> string
76
+
77
+
val v :
78
+
capabilities:server_capability_value string_map ->
79
+
accounts:Account.t id_map ->
80
+
primary_accounts:id string_map ->
81
+
username:string ->
82
+
api_url:Uri.t ->
83
+
download_url:Uri.t ->
84
+
upload_url:Uri.t ->
85
+
event_source_url:Uri.t ->
86
+
state:string ->
87
+
unit ->
88
+
t
89
+
end
90
+
91
+
(** Function to perform service autodiscovery.
92
+
Returns the session URL if found.
93
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-2.2> RFC 8620, Section 2.2 *)
94
+
val discover : domain:string -> Uri.t option
95
+
96
+
(** Function to fetch the session object from a given URL.
97
+
Requires authentication handling (details TBD/outside this signature). *)
98
+
val get_session : url:Uri.t -> Session.t
+32
jmap/jmap_types.ml
+32
jmap/jmap_types.ml
···
1
+
(* Basic JMAP types as defined in RFC 8620. *)
2
+
3
+
(* The Id data type.
4
+
A string of 1 to 255 octets, using URL-safe base64 characters. *)
5
+
type id = string
6
+
7
+
(* The Int data type.
8
+
An integer in the range [-2^53+1, 2^53-1]. Represented as OCaml's standard [int]. *)
9
+
type jint = int
10
+
11
+
(* The UnsignedInt data type.
12
+
An integer in the range [0, 2^53-1]. Represented as OCaml's standard [int]. *)
13
+
type uint = int
14
+
15
+
(* The Date data type.
16
+
A string in RFC 3339 "date-time" format.
17
+
Represented as a float using Unix time. *)
18
+
type date = float
19
+
20
+
(* The UTCDate data type.
21
+
A string in RFC 3339 "date-time" format, restricted to UTC (Z timezone).
22
+
Represented as a float using Unix time. *)
23
+
type utc_date = float
24
+
25
+
(* Represents a JSON object used as a map String -> V. *)
26
+
type 'v string_map = (string, 'v) Hashtbl.t
27
+
28
+
(* Represents a JSON object used as a map Id -> V. *)
29
+
type 'v id_map = (id, 'v) Hashtbl.t
30
+
31
+
(* Represents a JSON Pointer path with JMAP extensions. *)
32
+
type json_pointer = string
+38
jmap/jmap_types.mli
+38
jmap/jmap_types.mli
···
1
+
(** Basic JMAP types as defined in RFC 8620. *)
2
+
3
+
(** The Id data type.
4
+
A string of 1 to 255 octets, using URL-safe base64 characters.
5
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.2> RFC 8620, Section 1.2 *)
6
+
type id = string
7
+
8
+
(** The Int data type.
9
+
An integer in the range [-2^53+1, 2^53-1]. Represented as OCaml's standard [int].
10
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.3> RFC 8620, Section 1.3 *)
11
+
type jint = int
12
+
13
+
(** The UnsignedInt data type.
14
+
An integer in the range [0, 2^53-1]. Represented as OCaml's standard [int].
15
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.3> RFC 8620, Section 1.3 *)
16
+
type uint = int
17
+
18
+
(** The Date data type.
19
+
A string in RFC 3339 "date-time" format.
20
+
Represented as a float using Unix time.
21
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.4> RFC 8620, Section 1.4 *)
22
+
type date = float
23
+
24
+
(** The UTCDate data type.
25
+
A string in RFC 3339 "date-time" format, restricted to UTC (Z timezone).
26
+
Represented as a float using Unix time.
27
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.4> RFC 8620, Section 1.4 *)
28
+
type utc_date = float
29
+
30
+
(** Represents a JSON object used as a map String -> V. *)
31
+
type 'v string_map = (string, 'v) Hashtbl.t
32
+
33
+
(** Represents a JSON object used as a map Id -> V. *)
34
+
type 'v id_map = (id, 'v) Hashtbl.t
35
+
36
+
(** Represents a JSON Pointer path with JMAP extensions.
37
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.7> RFC 8620, Section 3.7 *)
38
+
type json_pointer = string
+73
jmap/jmap_wire.ml
+73
jmap/jmap_wire.ml
···
1
+
(* JMAP Wire Protocol Structures (Request/Response). *)
2
+
3
+
open Jmap_types
4
+
5
+
(* An invocation tuple within a request or response. *)
6
+
module Invocation = struct
7
+
type t = {
8
+
method_name: string;
9
+
arguments: Yojson.Safe.t;
10
+
method_call_id: string;
11
+
}
12
+
13
+
let method_name t = t.method_name
14
+
let arguments t = t.arguments
15
+
let method_call_id t = t.method_call_id
16
+
17
+
let v ?(arguments=`Assoc []) ~method_name ~method_call_id () =
18
+
{ method_name; arguments; method_call_id }
19
+
end
20
+
21
+
(* Method error type with context. *)
22
+
type method_error = Jmap_error.Method_error.t * string
23
+
24
+
(* A response invocation part, which can be a standard response or an error. *)
25
+
type response_invocation = (Invocation.t, method_error) result
26
+
27
+
(* A reference to a previous method call's result. *)
28
+
module Result_reference = struct
29
+
type t = {
30
+
result_of: string;
31
+
name: string;
32
+
path: json_pointer;
33
+
}
34
+
35
+
let result_of t = t.result_of
36
+
let name t = t.name
37
+
let path t = t.path
38
+
39
+
let v ~result_of ~name ~path () =
40
+
{ result_of; name; path }
41
+
end
42
+
43
+
(* The Request object. *)
44
+
module Request = struct
45
+
type t = {
46
+
using: string list;
47
+
method_calls: Invocation.t list;
48
+
created_ids: id id_map option;
49
+
}
50
+
51
+
let using t = t.using
52
+
let method_calls t = t.method_calls
53
+
let created_ids t = t.created_ids
54
+
55
+
let v ~using ~method_calls ?created_ids () =
56
+
{ using; method_calls; created_ids }
57
+
end
58
+
59
+
(* The Response object. *)
60
+
module Response = struct
61
+
type t = {
62
+
method_responses: response_invocation list;
63
+
created_ids: id id_map option;
64
+
session_state: string;
65
+
}
66
+
67
+
let method_responses t = t.method_responses
68
+
let created_ids t = t.created_ids
69
+
let session_state t = t.session_state
70
+
71
+
let v ~method_responses ?created_ids ~session_state () =
72
+
{ method_responses; created_ids; session_state }
73
+
end
+80
jmap/jmap_wire.mli
+80
jmap/jmap_wire.mli
···
1
+
(** JMAP Wire Protocol Structures (Request/Response). *)
2
+
3
+
open Jmap_types
4
+
5
+
(** An invocation tuple within a request or response.
6
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.2> RFC 8620, Section 3.2 *)
7
+
module Invocation : sig
8
+
type t
9
+
10
+
val method_name : t -> string
11
+
val arguments : t -> Yojson.Safe.t
12
+
val method_call_id : t -> string
13
+
14
+
val v :
15
+
?arguments:Yojson.Safe.t ->
16
+
method_name:string ->
17
+
method_call_id:string ->
18
+
unit ->
19
+
t
20
+
end
21
+
22
+
(** Method error type with context.
23
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.6.2> RFC 8620, Section 3.6.2 *)
24
+
type method_error = Jmap_error.Method_error.t * string
25
+
26
+
(** A response invocation part, which can be a standard response or an error.
27
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.4> RFC 8620, Section 3.4
28
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.6.2> RFC 8620, Section 3.6.2 *)
29
+
type response_invocation = (Invocation.t, method_error) result
30
+
31
+
(** A reference to a previous method call's result.
32
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.7> RFC 8620, Section 3.7 *)
33
+
module Result_reference : sig
34
+
type t
35
+
36
+
val result_of : t -> string
37
+
val name : t -> string
38
+
val path : t -> json_pointer
39
+
40
+
val v :
41
+
result_of:string ->
42
+
name:string ->
43
+
path:json_pointer ->
44
+
unit ->
45
+
t
46
+
end
47
+
48
+
(** The Request object.
49
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.3> RFC 8620, Section 3.3 *)
50
+
module Request : sig
51
+
type t
52
+
53
+
val using : t -> string list
54
+
val method_calls : t -> Invocation.t list
55
+
val created_ids : t -> id id_map option
56
+
57
+
val v :
58
+
using:string list ->
59
+
method_calls:Invocation.t list ->
60
+
?created_ids:id id_map ->
61
+
unit ->
62
+
t
63
+
end
64
+
65
+
(** The Response object.
66
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.4> RFC 8620, Section 3.4 *)
67
+
module Response : sig
68
+
type t
69
+
70
+
val method_responses : t -> response_invocation list
71
+
val created_ids : t -> id id_map option
72
+
val session_state : t -> string
73
+
74
+
val v :
75
+
method_responses:response_invocation list ->
76
+
?created_ids:id id_map ->
77
+
session_state:string ->
78
+
unit ->
79
+
t
80
+
end