anil.recoil.org
this repo has no description
import
+7816
-26
+4
-26
bin/dune
+4
-26
bin/dune
···
1
1
(executable
2
-
(name fastmail_list)
3
-
(public_name fastmail-list)
4
-
(package jmap)
5
-
(modules fastmail_list)
6
-
(libraries jmap jmap_mail lwt.unix logs logs.fmt cmdliner))
7
-
8
-
(executable
9
-
(name flag_color_test)
10
-
(public_name flag-color-test)
11
-
(package jmap)
12
-
(modules flag_color_test)
13
-
(libraries jmap jmap_mail))
14
-
15
-
(executable
16
-
(name tutorial_examples)
17
-
(public_name jmap-tutorial-examples)
18
-
(package jmap)
19
-
(modules tutorial_examples)
20
-
(libraries jmap jmap_mail))
21
-
22
-
(executable
23
-
(name fastmail_send)
24
-
(public_name fastmail-send)
25
-
(package jmap)
26
-
(modules fastmail_send)
27
-
(libraries jmap jmap_mail lwt.unix cmdliner fmt))
2
+
(name jmap_test)
3
+
(public_name jmap-test)
4
+
(package jmap-eio)
5
+
(libraries jmap-eio eio_main))
+141
bin/jmap_test.ml
+141
bin/jmap_test.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** JMAP test client - connects to a JMAP server and queries recent emails *)
7
+
8
+
let () =
9
+
(* Parse command line arguments *)
10
+
let usage = "Usage: jmap-test <session-url> <api-key>" in
11
+
let args = ref [] in
12
+
Arg.parse [] (fun arg -> args := arg :: !args) usage;
13
+
let session_url, api_key =
14
+
match List.rev !args with
15
+
| [url; key] -> (url, key)
16
+
| _ ->
17
+
prerr_endline usage;
18
+
exit 1
19
+
in
20
+
21
+
(* Run with Eio *)
22
+
Eio_main.run @@ fun env ->
23
+
Eio.Switch.run @@ fun sw ->
24
+
25
+
(* Create HTTP client with Bearer token auth *)
26
+
let requests = Requests.create ~sw env in
27
+
let auth = Requests.Auth.bearer ~token:api_key in
28
+
29
+
Printf.printf "Connecting to %s...\n%!" session_url;
30
+
31
+
(* Create JMAP client from session URL *)
32
+
match Jmap_eio.Client.create_from_url ~auth requests session_url with
33
+
| Error e ->
34
+
Printf.eprintf "Failed to connect: %s\n" (Jmap_eio.Client.error_to_string e);
35
+
exit 1
36
+
| Ok client ->
37
+
let session = Jmap_eio.Client.session client in
38
+
Printf.printf "Connected! Username: %s\n%!" (Jmap_proto.Session.username session);
39
+
40
+
(* Get primary mail account *)
41
+
let primary_account_id =
42
+
match Jmap_proto.Session.primary_account_for Jmap_proto.Capability.mail session with
43
+
| Some id -> id
44
+
| None ->
45
+
prerr_endline "No primary mail account found";
46
+
exit 1
47
+
in
48
+
Printf.printf "Primary mail account: %s\n%!" (Jmap_proto.Id.to_string primary_account_id);
49
+
50
+
(* Query for recent emails - get the 10 most recent *)
51
+
let sort = [Jmap_proto.Filter.comparator ~is_ascending:false "receivedAt"] in
52
+
let query_inv = Jmap_eio.Client.Build.email_query
53
+
~call_id:"q1"
54
+
~account_id:primary_account_id
55
+
~sort
56
+
~limit:10L
57
+
()
58
+
in
59
+
60
+
(* Build request with mail capability *)
61
+
let req = Jmap_eio.Client.Build.make_request
62
+
~capabilities:[Jmap_proto.Capability.core; Jmap_proto.Capability.mail]
63
+
[query_inv]
64
+
in
65
+
66
+
Printf.printf "Querying recent emails...\n%!";
67
+
68
+
match Jmap_eio.Client.request client req with
69
+
| Error e ->
70
+
Printf.eprintf "Query failed: %s\n" (Jmap_eio.Client.error_to_string e);
71
+
exit 1
72
+
| Ok response ->
73
+
(* Parse the query response *)
74
+
match Jmap_eio.Client.Parse.parse_email_query ~call_id:"q1" response with
75
+
| Error e ->
76
+
Printf.eprintf "Failed to parse query response: %s\n" (Jsont.Error.to_string e);
77
+
exit 1
78
+
| Ok query_result ->
79
+
let email_ids = query_result.ids in
80
+
Printf.printf "Found %d emails\n%!" (List.length email_ids);
81
+
82
+
if List.length email_ids = 0 then (
83
+
Printf.printf "No emails found.\n%!";
84
+
) else (
85
+
(* Fetch the email details *)
86
+
let get_inv = Jmap_eio.Client.Build.email_get
87
+
~call_id:"g1"
88
+
~account_id:primary_account_id
89
+
~ids:email_ids
90
+
~properties:["id"; "subject"; "from"; "receivedAt"; "preview"]
91
+
()
92
+
in
93
+
94
+
let req2 = Jmap_eio.Client.Build.make_request
95
+
~capabilities:[Jmap_proto.Capability.core; Jmap_proto.Capability.mail]
96
+
[get_inv]
97
+
in
98
+
99
+
Printf.printf "Fetching email details...\n%!";
100
+
101
+
match Jmap_eio.Client.request client req2 with
102
+
| Error e ->
103
+
Printf.eprintf "Get failed: %s\n" (Jmap_eio.Client.error_to_string e);
104
+
exit 1
105
+
| Ok response2 ->
106
+
match Jmap_eio.Client.Parse.parse_email_get ~call_id:"g1" response2 with
107
+
| Error e ->
108
+
Printf.eprintf "Failed to parse get response: %s\n" (Jsont.Error.to_string e);
109
+
exit 1
110
+
| Ok get_result ->
111
+
Printf.printf "\n=== Recent Emails ===\n\n%!";
112
+
List.iter (fun email ->
113
+
let id = Jmap_proto.Id.to_string (Jmap_mail.Email.id email) in
114
+
let subject = Option.value (Jmap_mail.Email.subject email) ~default:"(no subject)" in
115
+
let from_addrs = Option.value (Jmap_mail.Email.from email) ~default:[] in
116
+
let from_str = match from_addrs with
117
+
| [] -> "(unknown sender)"
118
+
| addr :: _ ->
119
+
let name = Option.value (Jmap_mail.Email_address.name addr) ~default:"" in
120
+
let email_addr = Jmap_mail.Email_address.email addr in
121
+
if name = "" then email_addr
122
+
else Printf.sprintf "%s <%s>" name email_addr
123
+
in
124
+
let received =
125
+
Jmap_proto.Date.Utc.to_string (Jmap_mail.Email.received_at email)
126
+
in
127
+
let preview = Jmap_mail.Email.preview email in
128
+
let preview_short =
129
+
if String.length preview > 80 then
130
+
String.sub preview 0 77 ^ "..."
131
+
else preview
132
+
in
133
+
Printf.printf "ID: %s\n" id;
134
+
Printf.printf "From: %s\n" from_str;
135
+
Printf.printf "Date: %s\n" received;
136
+
Printf.printf "Subject: %s\n" subject;
137
+
Printf.printf "Preview: %s\n" preview_short;
138
+
Printf.printf "\n%!";
139
+
) get_result.list;
140
+
Printf.printf "=== End of emails ===\n%!"
141
+
)
+37
dune-project
+37
dune-project
···
1
+
(lang dune 3.0)
2
+
3
+
(name jmap)
4
+
5
+
(generate_opam_files true)
6
+
7
+
(source
8
+
(github avsm/ocaml-jmap))
9
+
10
+
(authors "Anil Madhavapeddy <anil@recoil.org>")
11
+
12
+
(maintainers "Anil Madhavapeddy <anil@recoil.org>")
13
+
14
+
(license ISC)
15
+
16
+
(documentation https://avsm.github.io/ocaml-jmap)
17
+
18
+
(package
19
+
(name jmap)
20
+
(synopsis "JMAP protocol implementation for OCaml")
21
+
(description
22
+
"A complete implementation of the JSON Meta Application Protocol (JMAP) as specified in RFC 8620 (core) and RFC 8621 (mail).")
23
+
(depends
24
+
(ocaml (>= 4.14.0))
25
+
(jsont (>= 0.2.0))
26
+
(ptime (>= 1.0.0))))
27
+
28
+
(package
29
+
(name jmap-eio)
30
+
(synopsis "JMAP client for Eio")
31
+
(description "High-level JMAP client using Eio for async I/O and the Requests HTTP library.")
32
+
(depends
33
+
(ocaml (>= 4.14.0))
34
+
(jmap (= :version))
35
+
(jsont (>= 0.2.0))
36
+
eio
37
+
requests))
+514
eio/client.ml
+514
eio/client.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
type error =
7
+
| Http_error of int * string
8
+
| Jmap_error of Jmap_proto.Error.Request_error.t
9
+
| Json_error of Jsont.Error.t
10
+
| Session_error of string
11
+
| Connection_error of string
12
+
13
+
let pp_error fmt = function
14
+
| Http_error (code, msg) ->
15
+
Format.fprintf fmt "HTTP error %d: %s" code msg
16
+
| Jmap_error err ->
17
+
Format.fprintf fmt "JMAP error: %s"
18
+
(Jmap_proto.Error.Request_error.urn_to_string err.type_)
19
+
| Json_error err ->
20
+
Format.fprintf fmt "JSON error: %s" (Jsont.Error.to_string err)
21
+
| Session_error msg ->
22
+
Format.fprintf fmt "Session error: %s" msg
23
+
| Connection_error msg ->
24
+
Format.fprintf fmt "Connection error: %s" msg
25
+
26
+
let error_to_string err =
27
+
Format.asprintf "%a" pp_error err
28
+
29
+
exception Jmap_client_error of error
30
+
31
+
type t = {
32
+
mutable session : Jmap_proto.Session.t;
33
+
requests : Requests.t;
34
+
auth : Requests.Auth.t option;
35
+
session_url : string;
36
+
}
37
+
38
+
let session t = t.session
39
+
let api_url t = Jmap_proto.Session.api_url t.session
40
+
let upload_url t = Jmap_proto.Session.upload_url t.session
41
+
let download_url t = Jmap_proto.Session.download_url t.session
42
+
43
+
let create ?auth ~session requests =
44
+
let session_url = Jmap_proto.Session.api_url session in
45
+
{ session; requests; auth; session_url }
46
+
47
+
let fetch_session ?auth requests url =
48
+
try
49
+
let response =
50
+
match auth with
51
+
| Some a -> Requests.get requests ~auth:a url
52
+
| None -> Requests.get requests url
53
+
in
54
+
if not (Requests.Response.ok response) then
55
+
Error (Http_error (Requests.Response.status_code response,
56
+
"Failed to fetch session"))
57
+
else
58
+
let body = Requests.Response.text response in
59
+
match Codec.decode_session body with
60
+
| Ok session -> Ok session
61
+
| Error e -> Error (Json_error e)
62
+
with
63
+
| Eio.Io (Requests.Error.E err, _) ->
64
+
Error (Connection_error (Requests.Error.to_string err))
65
+
| exn -> Error (Session_error (Printexc.to_string exn))
66
+
67
+
let create_from_url ?auth requests url =
68
+
match fetch_session ?auth requests url with
69
+
| Ok session ->
70
+
Ok { session; requests; auth; session_url = url }
71
+
| Error e -> Error e
72
+
73
+
let create_from_url_exn ?auth requests url =
74
+
match create_from_url ?auth requests url with
75
+
| Ok t -> t
76
+
| Error e -> raise (Jmap_client_error e)
77
+
78
+
let refresh_session t =
79
+
match fetch_session ?auth:t.auth t.requests t.session_url with
80
+
| Ok session ->
81
+
t.session <- session;
82
+
Ok ()
83
+
| Error e -> Error e
84
+
85
+
let refresh_session_exn t =
86
+
match refresh_session t with
87
+
| Ok () -> ()
88
+
| Error e -> raise (Jmap_client_error e)
89
+
90
+
let request t req =
91
+
try
92
+
match Codec.encode_request req with
93
+
| Error e -> Error (Json_error e)
94
+
| Ok body_str ->
95
+
let body = Requests.Body.of_string Requests.Mime.json body_str in
96
+
let url = api_url t in
97
+
let response =
98
+
match t.auth with
99
+
| Some auth -> Requests.post t.requests ~auth ~body url
100
+
| None -> Requests.post t.requests ~body url
101
+
in
102
+
if not (Requests.Response.ok response) then
103
+
Error (Http_error (Requests.Response.status_code response,
104
+
Requests.Response.text response))
105
+
else
106
+
let response_body = Requests.Response.text response in
107
+
match Codec.decode_response response_body with
108
+
| Ok resp -> Ok resp
109
+
| Error e -> Error (Json_error e)
110
+
with
111
+
| Eio.Io (Requests.Error.E err, _) ->
112
+
Error (Connection_error (Requests.Error.to_string err))
113
+
| exn -> Error (Connection_error (Printexc.to_string exn))
114
+
115
+
let request_exn t req =
116
+
match request t req with
117
+
| Ok resp -> resp
118
+
| Error e -> raise (Jmap_client_error e)
119
+
120
+
let expand_upload_url t ~account_id =
121
+
let template = upload_url t in
122
+
let account_id_str = Jmap_proto.Id.to_string account_id in
123
+
(* Simple template expansion for {accountId} *)
124
+
let re = Str.regexp "{accountId}" in
125
+
Str.global_replace re account_id_str template
126
+
127
+
let upload t ~account_id ~content_type ~data =
128
+
try
129
+
let url = expand_upload_url t ~account_id in
130
+
let mime = Requests.Mime.of_string content_type in
131
+
let body = Requests.Body.of_string mime data in
132
+
let response =
133
+
match t.auth with
134
+
| Some auth -> Requests.post t.requests ~auth ~body url
135
+
| None -> Requests.post t.requests ~body url
136
+
in
137
+
if not (Requests.Response.ok response) then
138
+
Error (Http_error (Requests.Response.status_code response,
139
+
Requests.Response.text response))
140
+
else
141
+
let response_body = Requests.Response.text response in
142
+
match Codec.decode_upload_response response_body with
143
+
| Ok upload_resp -> Ok upload_resp
144
+
| Error e -> Error (Json_error e)
145
+
with
146
+
| Eio.Io (Requests.Error.E err, _) ->
147
+
Error (Connection_error (Requests.Error.to_string err))
148
+
| exn -> Error (Connection_error (Printexc.to_string exn))
149
+
150
+
let upload_exn t ~account_id ~content_type ~data =
151
+
match upload t ~account_id ~content_type ~data with
152
+
| Ok resp -> resp
153
+
| Error e -> raise (Jmap_client_error e)
154
+
155
+
let expand_download_url t ~account_id ~blob_id ?name ?accept () =
156
+
let template = download_url t in
157
+
let account_id_str = Jmap_proto.Id.to_string account_id in
158
+
let blob_id_str = Jmap_proto.Id.to_string blob_id in
159
+
let name_str = Option.value name ~default:"download" in
160
+
let type_str = Option.value accept ~default:"application/octet-stream" in
161
+
(* Simple template expansion *)
162
+
template
163
+
|> Str.global_replace (Str.regexp "{accountId}") account_id_str
164
+
|> Str.global_replace (Str.regexp "{blobId}") blob_id_str
165
+
|> Str.global_replace (Str.regexp "{name}") (Uri.pct_encode name_str)
166
+
|> Str.global_replace (Str.regexp "{type}") (Uri.pct_encode type_str)
167
+
168
+
let download t ~account_id ~blob_id ?name ?accept () =
169
+
try
170
+
let url = expand_download_url t ~account_id ~blob_id ?name ?accept () in
171
+
let response =
172
+
match t.auth with
173
+
| Some auth -> Requests.get t.requests ~auth url
174
+
| None -> Requests.get t.requests url
175
+
in
176
+
if not (Requests.Response.ok response) then
177
+
Error (Http_error (Requests.Response.status_code response,
178
+
Requests.Response.text response))
179
+
else
180
+
Ok (Requests.Response.text response)
181
+
with
182
+
| Eio.Io (Requests.Error.E err, _) ->
183
+
Error (Connection_error (Requests.Error.to_string err))
184
+
| exn -> Error (Connection_error (Printexc.to_string exn))
185
+
186
+
let download_exn t ~account_id ~blob_id ?name ?accept () =
187
+
match download t ~account_id ~blob_id ?name ?accept () with
188
+
| Ok data -> data
189
+
| Error e -> raise (Jmap_client_error e)
190
+
191
+
(* Convenience builders *)
192
+
module Build = struct
193
+
open Jmap_proto
194
+
195
+
let json_of_id id =
196
+
Jsont.String (Id.to_string id, Jsont.Meta.none)
197
+
198
+
let json_of_id_list ids =
199
+
let items = List.map json_of_id ids in
200
+
Jsont.Array (items, Jsont.Meta.none)
201
+
202
+
let json_of_string_list strs =
203
+
let items = List.map (fun s -> Jsont.String (s, Jsont.Meta.none)) strs in
204
+
Jsont.Array (items, Jsont.Meta.none)
205
+
206
+
let json_of_int64 n =
207
+
Jsont.Number (Int64.to_float n, Jsont.Meta.none)
208
+
209
+
let json_of_bool b =
210
+
Jsont.Bool (b, Jsont.Meta.none)
211
+
212
+
let json_name s = (s, Jsont.Meta.none)
213
+
214
+
let json_obj fields =
215
+
let fields' = List.map (fun (k, v) -> (json_name k, v)) fields in
216
+
Jsont.Object (fields', Jsont.Meta.none)
217
+
218
+
let make_invocation ~name ~call_id args =
219
+
Invocation.create ~name ~arguments:(json_obj args) ~method_call_id:call_id
220
+
221
+
let echo ~call_id data =
222
+
make_invocation ~name:"Core/echo" ~call_id
223
+
[ ("data", data) ]
224
+
225
+
let mailbox_get ~call_id ~account_id ?ids ?properties () =
226
+
let args = [
227
+
("accountId", json_of_id account_id);
228
+
] in
229
+
let args = match ids with
230
+
| None -> args
231
+
| Some ids -> ("ids", json_of_id_list ids) :: args
232
+
in
233
+
let args = match properties with
234
+
| None -> args
235
+
| Some props -> ("properties", json_of_string_list props) :: args
236
+
in
237
+
make_invocation ~name:"Mailbox/get" ~call_id args
238
+
239
+
let mailbox_changes ~call_id ~account_id ~since_state ?max_changes () =
240
+
let args = [
241
+
("accountId", json_of_id account_id);
242
+
("sinceState", Jsont.String (since_state, Jsont.Meta.none));
243
+
] in
244
+
let args = match max_changes with
245
+
| None -> args
246
+
| Some n -> ("maxChanges", json_of_int64 n) :: args
247
+
in
248
+
make_invocation ~name:"Mailbox/changes" ~call_id args
249
+
250
+
let encode_to_json jsont value =
251
+
match Jsont.Json.encode' jsont value with
252
+
| Ok j -> j
253
+
| Error _ -> json_obj []
254
+
255
+
let encode_list_to_json jsont values =
256
+
match Jsont.Json.encode' (Jsont.list jsont) values with
257
+
| Ok j -> j
258
+
| Error _ -> Jsont.Array ([], Jsont.Meta.none)
259
+
260
+
let mailbox_query ~call_id ~account_id ?filter ?sort ?position ?limit () =
261
+
let args = [
262
+
("accountId", json_of_id account_id);
263
+
] in
264
+
let args = match filter with
265
+
| None -> args
266
+
| Some f ->
267
+
("filter", encode_to_json Jmap_mail.Mail_filter.mailbox_filter_jsont f) :: args
268
+
in
269
+
let args = match sort with
270
+
| None -> args
271
+
| Some comparators ->
272
+
("sort", encode_list_to_json Filter.comparator_jsont comparators) :: args
273
+
in
274
+
let args = match position with
275
+
| None -> args
276
+
| Some n -> ("position", json_of_int64 n) :: args
277
+
in
278
+
let args = match limit with
279
+
| None -> args
280
+
| Some n -> ("limit", json_of_int64 n) :: args
281
+
in
282
+
make_invocation ~name:"Mailbox/query" ~call_id args
283
+
284
+
let email_get ~call_id ~account_id ?ids ?properties ?body_properties
285
+
?fetch_text_body_values ?fetch_html_body_values ?fetch_all_body_values
286
+
?max_body_value_bytes () =
287
+
let args = [
288
+
("accountId", json_of_id account_id);
289
+
] in
290
+
let args = match ids with
291
+
| None -> args
292
+
| Some ids -> ("ids", json_of_id_list ids) :: args
293
+
in
294
+
let args = match properties with
295
+
| None -> args
296
+
| Some props -> ("properties", json_of_string_list props) :: args
297
+
in
298
+
let args = match body_properties with
299
+
| None -> args
300
+
| Some props -> ("bodyProperties", json_of_string_list props) :: args
301
+
in
302
+
let args = match fetch_text_body_values with
303
+
| None -> args
304
+
| Some b -> ("fetchTextBodyValues", json_of_bool b) :: args
305
+
in
306
+
let args = match fetch_html_body_values with
307
+
| None -> args
308
+
| Some b -> ("fetchHTMLBodyValues", json_of_bool b) :: args
309
+
in
310
+
let args = match fetch_all_body_values with
311
+
| None -> args
312
+
| Some b -> ("fetchAllBodyValues", json_of_bool b) :: args
313
+
in
314
+
let args = match max_body_value_bytes with
315
+
| None -> args
316
+
| Some n -> ("maxBodyValueBytes", json_of_int64 n) :: args
317
+
in
318
+
make_invocation ~name:"Email/get" ~call_id args
319
+
320
+
let email_changes ~call_id ~account_id ~since_state ?max_changes () =
321
+
let args = [
322
+
("accountId", json_of_id account_id);
323
+
("sinceState", Jsont.String (since_state, Jsont.Meta.none));
324
+
] in
325
+
let args = match max_changes with
326
+
| None -> args
327
+
| Some n -> ("maxChanges", json_of_int64 n) :: args
328
+
in
329
+
make_invocation ~name:"Email/changes" ~call_id args
330
+
331
+
let email_query ~call_id ~account_id ?filter ?sort ?position ?limit
332
+
?collapse_threads () =
333
+
let args = [
334
+
("accountId", json_of_id account_id);
335
+
] in
336
+
let args = match filter with
337
+
| None -> args
338
+
| Some f ->
339
+
("filter", encode_to_json Jmap_mail.Mail_filter.email_filter_jsont f) :: args
340
+
in
341
+
let args = match sort with
342
+
| None -> args
343
+
| Some comparators ->
344
+
("sort", encode_list_to_json Filter.comparator_jsont comparators) :: args
345
+
in
346
+
let args = match position with
347
+
| None -> args
348
+
| Some n -> ("position", json_of_int64 n) :: args
349
+
in
350
+
let args = match limit with
351
+
| None -> args
352
+
| Some n -> ("limit", json_of_int64 n) :: args
353
+
in
354
+
let args = match collapse_threads with
355
+
| None -> args
356
+
| Some b -> ("collapseThreads", json_of_bool b) :: args
357
+
in
358
+
make_invocation ~name:"Email/query" ~call_id args
359
+
360
+
let thread_get ~call_id ~account_id ?ids () =
361
+
let args = [
362
+
("accountId", json_of_id account_id);
363
+
] in
364
+
let args = match ids with
365
+
| None -> args
366
+
| Some ids -> ("ids", json_of_id_list ids) :: args
367
+
in
368
+
make_invocation ~name:"Thread/get" ~call_id args
369
+
370
+
let thread_changes ~call_id ~account_id ~since_state ?max_changes () =
371
+
let args = [
372
+
("accountId", json_of_id account_id);
373
+
("sinceState", Jsont.String (since_state, Jsont.Meta.none));
374
+
] in
375
+
let args = match max_changes with
376
+
| None -> args
377
+
| Some n -> ("maxChanges", json_of_int64 n) :: args
378
+
in
379
+
make_invocation ~name:"Thread/changes" ~call_id args
380
+
381
+
let identity_get ~call_id ~account_id ?ids ?properties () =
382
+
let args = [
383
+
("accountId", json_of_id account_id);
384
+
] in
385
+
let args = match ids with
386
+
| None -> args
387
+
| Some ids -> ("ids", json_of_id_list ids) :: args
388
+
in
389
+
let args = match properties with
390
+
| None -> args
391
+
| Some props -> ("properties", json_of_string_list props) :: args
392
+
in
393
+
make_invocation ~name:"Identity/get" ~call_id args
394
+
395
+
let email_submission_get ~call_id ~account_id ?ids ?properties () =
396
+
let args = [
397
+
("accountId", json_of_id account_id);
398
+
] in
399
+
let args = match ids with
400
+
| None -> args
401
+
| Some ids -> ("ids", json_of_id_list ids) :: args
402
+
in
403
+
let args = match properties with
404
+
| None -> args
405
+
| Some props -> ("properties", json_of_string_list props) :: args
406
+
in
407
+
make_invocation ~name:"EmailSubmission/get" ~call_id args
408
+
409
+
let email_submission_query ~call_id ~account_id ?filter ?sort ?position ?limit () =
410
+
let args = [
411
+
("accountId", json_of_id account_id);
412
+
] in
413
+
let args = match filter with
414
+
| None -> args
415
+
| Some f ->
416
+
("filter", encode_to_json Jmap_mail.Mail_filter.submission_filter_jsont f) :: args
417
+
in
418
+
let args = match sort with
419
+
| None -> args
420
+
| Some comparators ->
421
+
("sort", encode_list_to_json Filter.comparator_jsont comparators) :: args
422
+
in
423
+
let args = match position with
424
+
| None -> args
425
+
| Some n -> ("position", json_of_int64 n) :: args
426
+
in
427
+
let args = match limit with
428
+
| None -> args
429
+
| Some n -> ("limit", json_of_int64 n) :: args
430
+
in
431
+
make_invocation ~name:"EmailSubmission/query" ~call_id args
432
+
433
+
let vacation_response_get ~call_id ~account_id () =
434
+
let args = [
435
+
("accountId", json_of_id account_id);
436
+
("ids", json_of_id_list [Jmap_mail.Vacation.singleton_id]);
437
+
] in
438
+
make_invocation ~name:"VacationResponse/get" ~call_id args
439
+
440
+
let make_request ?created_ids ~capabilities invocations =
441
+
Request.create
442
+
~using:capabilities
443
+
~method_calls:invocations
444
+
?created_ids
445
+
()
446
+
end
447
+
448
+
(* Response parsing helpers *)
449
+
module Parse = struct
450
+
open Jmap_proto
451
+
452
+
let decode_from_json jsont json =
453
+
Jsont.Json.decode' jsont json
454
+
455
+
let find_invocation ~call_id response =
456
+
List.find_opt
457
+
(fun inv -> Invocation.method_call_id inv = call_id)
458
+
(Response.method_responses response)
459
+
460
+
let get_invocation_exn ~call_id response =
461
+
match find_invocation ~call_id response with
462
+
| Some inv -> inv
463
+
| None -> failwith ("No invocation found with call_id: " ^ call_id)
464
+
465
+
let parse_invocation jsont inv =
466
+
decode_from_json jsont (Invocation.arguments inv)
467
+
468
+
let parse_response ~call_id jsont response =
469
+
let inv = get_invocation_exn ~call_id response in
470
+
parse_invocation jsont inv
471
+
472
+
(* Typed response parsers *)
473
+
474
+
let get_response obj_jsont =
475
+
Method.get_response_jsont obj_jsont
476
+
477
+
let query_response = Method.query_response_jsont
478
+
479
+
let changes_response = Method.changes_response_jsont
480
+
481
+
let set_response obj_jsont =
482
+
Method.set_response_jsont obj_jsont
483
+
484
+
(* Mail-specific parsers *)
485
+
486
+
let mailbox_get_response =
487
+
get_response Jmap_mail.Mailbox.jsont
488
+
489
+
let email_get_response =
490
+
get_response Jmap_mail.Email.jsont
491
+
492
+
let thread_get_response =
493
+
get_response Jmap_mail.Thread.jsont
494
+
495
+
let identity_get_response =
496
+
get_response Jmap_mail.Identity.jsont
497
+
498
+
(* Convenience functions *)
499
+
500
+
let parse_mailbox_get ~call_id response =
501
+
parse_response ~call_id mailbox_get_response response
502
+
503
+
let parse_email_get ~call_id response =
504
+
parse_response ~call_id email_get_response response
505
+
506
+
let parse_email_query ~call_id response =
507
+
parse_response ~call_id query_response response
508
+
509
+
let parse_thread_get ~call_id response =
510
+
parse_response ~call_id thread_get_response response
511
+
512
+
let parse_changes ~call_id response =
513
+
parse_response ~call_id changes_response response
514
+
end
+404
eio/client.mli
+404
eio/client.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** High-level JMAP client using Requests
7
+
8
+
This module provides a full-featured JMAP client with session management,
9
+
request execution, and blob upload/download capabilities. *)
10
+
11
+
(** {1 Types} *)
12
+
13
+
type t
14
+
(** A JMAP client with session state and HTTP connection management. *)
15
+
16
+
type error =
17
+
| Http_error of int * string
18
+
(** HTTP error with status code and message. *)
19
+
| Jmap_error of Jmap_proto.Error.Request_error.t
20
+
(** JMAP protocol error at request level. *)
21
+
| Json_error of Jsont.Error.t
22
+
(** JSON encoding/decoding error. *)
23
+
| Session_error of string
24
+
(** Session fetch or parse error. *)
25
+
| Connection_error of string
26
+
(** Network connection error. *)
27
+
(** Error types that can occur during JMAP operations. *)
28
+
29
+
val pp_error : Format.formatter -> error -> unit
30
+
(** Pretty-print an error. *)
31
+
32
+
val error_to_string : error -> string
33
+
(** Convert an error to a string. *)
34
+
35
+
exception Jmap_client_error of error
36
+
(** Exception wrapper for JMAP client errors. *)
37
+
38
+
(** {1 Client Creation} *)
39
+
40
+
val create :
41
+
?auth:Requests.Auth.t ->
42
+
session:Jmap_proto.Session.t ->
43
+
Requests.t ->
44
+
t
45
+
(** [create ?auth ~session requests] creates a JMAP client from an existing
46
+
session and Requests instance.
47
+
48
+
@param auth Authentication to use for requests.
49
+
@param session A pre-fetched JMAP session.
50
+
@param requests The Requests instance for HTTP operations. *)
51
+
52
+
val create_from_url :
53
+
?auth:Requests.Auth.t ->
54
+
Requests.t ->
55
+
string ->
56
+
(t, error) result
57
+
(** [create_from_url ?auth requests url] creates a JMAP client by fetching
58
+
the session from the given JMAP API URL or well-known URL.
59
+
60
+
The URL can be either:
61
+
- A direct JMAP API URL (e.g., "https://api.example.com/jmap/")
62
+
- A well-known URL (e.g., "https://example.com/.well-known/jmap")
63
+
64
+
@param auth Authentication to use for the session request and subsequent requests.
65
+
@param requests The Requests instance for HTTP operations.
66
+
@param url The JMAP API or well-known URL. *)
67
+
68
+
val create_from_url_exn :
69
+
?auth:Requests.Auth.t ->
70
+
Requests.t ->
71
+
string ->
72
+
t
73
+
(** [create_from_url_exn ?auth requests url] is like {!create_from_url} but
74
+
raises {!Jmap_client_error} on failure. *)
75
+
76
+
(** {1 Session Access} *)
77
+
78
+
val session : t -> Jmap_proto.Session.t
79
+
(** [session client] returns the current JMAP session. *)
80
+
81
+
val refresh_session : t -> (unit, error) result
82
+
(** [refresh_session client] fetches a fresh session from the server and
83
+
updates the client's session state. *)
84
+
85
+
val refresh_session_exn : t -> unit
86
+
(** [refresh_session_exn client] is like {!refresh_session} but raises on error. *)
87
+
88
+
val api_url : t -> string
89
+
(** [api_url client] returns the JMAP API URL for this client. *)
90
+
91
+
val upload_url : t -> string
92
+
(** [upload_url client] returns the blob upload URL template. *)
93
+
94
+
val download_url : t -> string
95
+
(** [download_url client] returns the blob download URL template. *)
96
+
97
+
(** {1 Request Execution} *)
98
+
99
+
val request :
100
+
t ->
101
+
Jmap_proto.Request.t ->
102
+
(Jmap_proto.Response.t, error) result
103
+
(** [request client req] executes a JMAP request and returns the response. *)
104
+
105
+
val request_exn :
106
+
t ->
107
+
Jmap_proto.Request.t ->
108
+
Jmap_proto.Response.t
109
+
(** [request_exn client req] is like {!request} but raises on error. *)
110
+
111
+
(** {1 Blob Operations} *)
112
+
113
+
val upload :
114
+
t ->
115
+
account_id:Jmap_proto.Id.t ->
116
+
content_type:string ->
117
+
data:string ->
118
+
(Jmap_proto.Blob.upload_response, error) result
119
+
(** [upload client ~account_id ~content_type ~data] uploads a blob.
120
+
121
+
@param account_id The account to upload to.
122
+
@param content_type MIME type of the blob.
123
+
@param data The blob data as a string. *)
124
+
125
+
val upload_exn :
126
+
t ->
127
+
account_id:Jmap_proto.Id.t ->
128
+
content_type:string ->
129
+
data:string ->
130
+
Jmap_proto.Blob.upload_response
131
+
(** [upload_exn client ~account_id ~content_type ~data] is like {!upload}
132
+
but raises on error. *)
133
+
134
+
val download :
135
+
t ->
136
+
account_id:Jmap_proto.Id.t ->
137
+
blob_id:Jmap_proto.Id.t ->
138
+
?name:string ->
139
+
?accept:string ->
140
+
unit ->
141
+
(string, error) result
142
+
(** [download client ~account_id ~blob_id ?name ?accept ()] downloads a blob.
143
+
144
+
@param account_id The account containing the blob.
145
+
@param blob_id The blob ID to download.
146
+
@param name Optional filename hint for Content-Disposition.
147
+
@param accept Optional Accept header value. *)
148
+
149
+
val download_exn :
150
+
t ->
151
+
account_id:Jmap_proto.Id.t ->
152
+
blob_id:Jmap_proto.Id.t ->
153
+
?name:string ->
154
+
?accept:string ->
155
+
unit ->
156
+
string
157
+
(** [download_exn] is like {!download} but raises on error. *)
158
+
159
+
(** {1 Convenience Builders}
160
+
161
+
Helper functions for building common JMAP method invocations. *)
162
+
163
+
module Build : sig
164
+
(** {2 Core Methods} *)
165
+
166
+
val echo :
167
+
call_id:string ->
168
+
Jsont.json ->
169
+
Jmap_proto.Invocation.t
170
+
(** [echo ~call_id data] builds a Core/echo invocation. *)
171
+
172
+
(** {2 Mailbox Methods} *)
173
+
174
+
val mailbox_get :
175
+
call_id:string ->
176
+
account_id:Jmap_proto.Id.t ->
177
+
?ids:Jmap_proto.Id.t list ->
178
+
?properties:string list ->
179
+
unit ->
180
+
Jmap_proto.Invocation.t
181
+
(** [mailbox_get ~call_id ~account_id ?ids ?properties ()] builds a
182
+
Mailbox/get invocation. *)
183
+
184
+
val mailbox_changes :
185
+
call_id:string ->
186
+
account_id:Jmap_proto.Id.t ->
187
+
since_state:string ->
188
+
?max_changes:int64 ->
189
+
unit ->
190
+
Jmap_proto.Invocation.t
191
+
(** [mailbox_changes ~call_id ~account_id ~since_state ?max_changes ()]
192
+
builds a Mailbox/changes invocation. *)
193
+
194
+
val mailbox_query :
195
+
call_id:string ->
196
+
account_id:Jmap_proto.Id.t ->
197
+
?filter:Jmap_mail.Mail_filter.mailbox_filter ->
198
+
?sort:Jmap_proto.Filter.comparator list ->
199
+
?position:int64 ->
200
+
?limit:int64 ->
201
+
unit ->
202
+
Jmap_proto.Invocation.t
203
+
(** [mailbox_query ~call_id ~account_id ?filter ?sort ?position ?limit ()]
204
+
builds a Mailbox/query invocation. *)
205
+
206
+
(** {2 Email Methods} *)
207
+
208
+
val email_get :
209
+
call_id:string ->
210
+
account_id:Jmap_proto.Id.t ->
211
+
?ids:Jmap_proto.Id.t list ->
212
+
?properties:string list ->
213
+
?body_properties:string list ->
214
+
?fetch_text_body_values:bool ->
215
+
?fetch_html_body_values:bool ->
216
+
?fetch_all_body_values:bool ->
217
+
?max_body_value_bytes:int64 ->
218
+
unit ->
219
+
Jmap_proto.Invocation.t
220
+
(** [email_get ~call_id ~account_id ?ids ?properties ...] builds an
221
+
Email/get invocation. *)
222
+
223
+
val email_changes :
224
+
call_id:string ->
225
+
account_id:Jmap_proto.Id.t ->
226
+
since_state:string ->
227
+
?max_changes:int64 ->
228
+
unit ->
229
+
Jmap_proto.Invocation.t
230
+
(** [email_changes ~call_id ~account_id ~since_state ?max_changes ()]
231
+
builds an Email/changes invocation. *)
232
+
233
+
val email_query :
234
+
call_id:string ->
235
+
account_id:Jmap_proto.Id.t ->
236
+
?filter:Jmap_mail.Mail_filter.email_filter ->
237
+
?sort:Jmap_proto.Filter.comparator list ->
238
+
?position:int64 ->
239
+
?limit:int64 ->
240
+
?collapse_threads:bool ->
241
+
unit ->
242
+
Jmap_proto.Invocation.t
243
+
(** [email_query ~call_id ~account_id ?filter ?sort ?position ?limit
244
+
?collapse_threads ()] builds an Email/query invocation. *)
245
+
246
+
(** {2 Thread Methods} *)
247
+
248
+
val thread_get :
249
+
call_id:string ->
250
+
account_id:Jmap_proto.Id.t ->
251
+
?ids:Jmap_proto.Id.t list ->
252
+
unit ->
253
+
Jmap_proto.Invocation.t
254
+
(** [thread_get ~call_id ~account_id ?ids ()] builds a Thread/get invocation. *)
255
+
256
+
val thread_changes :
257
+
call_id:string ->
258
+
account_id:Jmap_proto.Id.t ->
259
+
since_state:string ->
260
+
?max_changes:int64 ->
261
+
unit ->
262
+
Jmap_proto.Invocation.t
263
+
(** [thread_changes ~call_id ~account_id ~since_state ?max_changes ()]
264
+
builds a Thread/changes invocation. *)
265
+
266
+
(** {2 Identity Methods} *)
267
+
268
+
val identity_get :
269
+
call_id:string ->
270
+
account_id:Jmap_proto.Id.t ->
271
+
?ids:Jmap_proto.Id.t list ->
272
+
?properties:string list ->
273
+
unit ->
274
+
Jmap_proto.Invocation.t
275
+
(** [identity_get ~call_id ~account_id ?ids ?properties ()] builds an
276
+
Identity/get invocation. *)
277
+
278
+
(** {2 Submission Methods} *)
279
+
280
+
val email_submission_get :
281
+
call_id:string ->
282
+
account_id:Jmap_proto.Id.t ->
283
+
?ids:Jmap_proto.Id.t list ->
284
+
?properties:string list ->
285
+
unit ->
286
+
Jmap_proto.Invocation.t
287
+
(** [email_submission_get ~call_id ~account_id ?ids ?properties ()]
288
+
builds an EmailSubmission/get invocation. *)
289
+
290
+
val email_submission_query :
291
+
call_id:string ->
292
+
account_id:Jmap_proto.Id.t ->
293
+
?filter:Jmap_mail.Mail_filter.submission_filter ->
294
+
?sort:Jmap_proto.Filter.comparator list ->
295
+
?position:int64 ->
296
+
?limit:int64 ->
297
+
unit ->
298
+
Jmap_proto.Invocation.t
299
+
(** [email_submission_query ~call_id ~account_id ?filter ?sort ?position
300
+
?limit ()] builds an EmailSubmission/query invocation. *)
301
+
302
+
(** {2 Vacation Response Methods} *)
303
+
304
+
val vacation_response_get :
305
+
call_id:string ->
306
+
account_id:Jmap_proto.Id.t ->
307
+
unit ->
308
+
Jmap_proto.Invocation.t
309
+
(** [vacation_response_get ~call_id ~account_id ()] builds a
310
+
VacationResponse/get invocation. The singleton ID is automatically used. *)
311
+
312
+
(** {2 Request Building} *)
313
+
314
+
val make_request :
315
+
?created_ids:(Jmap_proto.Id.t * Jmap_proto.Id.t) list ->
316
+
capabilities:string list ->
317
+
Jmap_proto.Invocation.t list ->
318
+
Jmap_proto.Request.t
319
+
(** [make_request ?created_ids ~capabilities invocations] builds a JMAP request.
320
+
321
+
@param created_ids Optional client-created ID mappings.
322
+
@param capabilities List of capability URIs to use.
323
+
@param invocations List of method invocations. *)
324
+
end
325
+
326
+
(** {1 Response Parsing}
327
+
328
+
Helper functions for parsing typed responses from JMAP invocations. *)
329
+
330
+
module Parse : sig
331
+
val find_invocation :
332
+
call_id:string ->
333
+
Jmap_proto.Response.t ->
334
+
Jmap_proto.Invocation.t option
335
+
(** [find_invocation ~call_id response] finds an invocation by call ID. *)
336
+
337
+
val get_invocation_exn :
338
+
call_id:string ->
339
+
Jmap_proto.Response.t ->
340
+
Jmap_proto.Invocation.t
341
+
(** [get_invocation_exn ~call_id response] finds an invocation by call ID.
342
+
@raise Failure if not found. *)
343
+
344
+
val parse_invocation :
345
+
'a Jsont.t ->
346
+
Jmap_proto.Invocation.t ->
347
+
('a, Jsont.Error.t) result
348
+
(** [parse_invocation jsont inv] decodes the invocation's arguments. *)
349
+
350
+
val parse_response :
351
+
call_id:string ->
352
+
'a Jsont.t ->
353
+
Jmap_proto.Response.t ->
354
+
('a, Jsont.Error.t) result
355
+
(** [parse_response ~call_id jsont response] finds and parses an invocation. *)
356
+
357
+
(** {2 Typed Response Codecs} *)
358
+
359
+
val get_response : 'a Jsont.t -> 'a Jmap_proto.Method.get_response Jsont.t
360
+
(** [get_response obj_jsont] creates a Foo/get response codec. *)
361
+
362
+
val query_response : Jmap_proto.Method.query_response Jsont.t
363
+
(** Codec for Foo/query responses. *)
364
+
365
+
val changes_response : Jmap_proto.Method.changes_response Jsont.t
366
+
(** Codec for Foo/changes responses. *)
367
+
368
+
val set_response : 'a Jsont.t -> 'a Jmap_proto.Method.set_response Jsont.t
369
+
(** [set_response obj_jsont] creates a Foo/set response codec. *)
370
+
371
+
(** {2 Mail-specific Codecs} *)
372
+
373
+
val mailbox_get_response : Jmap_mail.Mailbox.t Jmap_proto.Method.get_response Jsont.t
374
+
val email_get_response : Jmap_mail.Email.t Jmap_proto.Method.get_response Jsont.t
375
+
val thread_get_response : Jmap_mail.Thread.t Jmap_proto.Method.get_response Jsont.t
376
+
val identity_get_response : Jmap_mail.Identity.t Jmap_proto.Method.get_response Jsont.t
377
+
378
+
(** {2 Convenience Parsers} *)
379
+
380
+
val parse_mailbox_get :
381
+
call_id:string ->
382
+
Jmap_proto.Response.t ->
383
+
(Jmap_mail.Mailbox.t Jmap_proto.Method.get_response, Jsont.Error.t) result
384
+
385
+
val parse_email_get :
386
+
call_id:string ->
387
+
Jmap_proto.Response.t ->
388
+
(Jmap_mail.Email.t Jmap_proto.Method.get_response, Jsont.Error.t) result
389
+
390
+
val parse_email_query :
391
+
call_id:string ->
392
+
Jmap_proto.Response.t ->
393
+
(Jmap_proto.Method.query_response, Jsont.Error.t) result
394
+
395
+
val parse_thread_get :
396
+
call_id:string ->
397
+
Jmap_proto.Response.t ->
398
+
(Jmap_mail.Thread.t Jmap_proto.Method.get_response, Jsont.Error.t) result
399
+
400
+
val parse_changes :
401
+
call_id:string ->
402
+
Jmap_proto.Response.t ->
403
+
(Jmap_proto.Method.changes_response, Jsont.Error.t) result
404
+
end
+42
eio/codec.ml
+42
eio/codec.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
let encode ?format jsont value =
7
+
Jsont_bytesrw.encode_string' ?format jsont value
8
+
9
+
let decode ?locs jsont json =
10
+
Jsont_bytesrw.decode_string' ?locs jsont json
11
+
12
+
let encode_request ?format request =
13
+
encode ?format Jmap_proto.Request.jsont request
14
+
15
+
let encode_request_exn ?format request =
16
+
match encode_request ?format request with
17
+
| Ok s -> s
18
+
| Error e -> failwith (Jsont.Error.to_string e)
19
+
20
+
let decode_response ?locs json =
21
+
decode ?locs Jmap_proto.Response.jsont json
22
+
23
+
let decode_response_exn ?locs json =
24
+
match decode_response ?locs json with
25
+
| Ok r -> r
26
+
| Error e -> failwith (Jsont.Error.to_string e)
27
+
28
+
let decode_session ?locs json =
29
+
decode ?locs Jmap_proto.Session.jsont json
30
+
31
+
let decode_session_exn ?locs json =
32
+
match decode_session ?locs json with
33
+
| Ok s -> s
34
+
| Error e -> failwith (Jsont.Error.to_string e)
35
+
36
+
let decode_upload_response ?locs json =
37
+
decode ?locs Jmap_proto.Blob.upload_response_jsont json
38
+
39
+
let decode_upload_response_exn ?locs json =
40
+
match decode_upload_response ?locs json with
41
+
| Ok r -> r
42
+
| Error e -> failwith (Jsont.Error.to_string e)
+92
eio/codec.mli
+92
eio/codec.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** JMAP JSON codec for Eio
7
+
8
+
Low-level encoding and decoding of JMAP messages using jsont and bytesrw. *)
9
+
10
+
(** {1 Request Encoding} *)
11
+
12
+
val encode_request :
13
+
?format:Jsont.format ->
14
+
Jmap_proto.Request.t ->
15
+
(string, Jsont.Error.t) result
16
+
(** [encode_request ?format request] encodes a JMAP request to a JSON string.
17
+
18
+
@param format The JSON formatting style. Defaults to {!Jsont.Minify}. *)
19
+
20
+
val encode_request_exn :
21
+
?format:Jsont.format ->
22
+
Jmap_proto.Request.t ->
23
+
string
24
+
(** [encode_request_exn ?format request] is like {!encode_request} but raises
25
+
on encoding errors. *)
26
+
27
+
(** {1 Response Decoding} *)
28
+
29
+
val decode_response :
30
+
?locs:bool ->
31
+
string ->
32
+
(Jmap_proto.Response.t, Jsont.Error.t) result
33
+
(** [decode_response ?locs json] decodes a JMAP response from a JSON string.
34
+
35
+
@param locs If [true], location information is preserved for error messages.
36
+
Defaults to [false]. *)
37
+
38
+
val decode_response_exn :
39
+
?locs:bool ->
40
+
string ->
41
+
Jmap_proto.Response.t
42
+
(** [decode_response_exn ?locs json] is like {!decode_response} but raises
43
+
on decoding errors. *)
44
+
45
+
(** {1 Session Decoding} *)
46
+
47
+
val decode_session :
48
+
?locs:bool ->
49
+
string ->
50
+
(Jmap_proto.Session.t, Jsont.Error.t) result
51
+
(** [decode_session ?locs json] decodes a JMAP session from a JSON string.
52
+
53
+
@param locs If [true], location information is preserved for error messages.
54
+
Defaults to [false]. *)
55
+
56
+
val decode_session_exn :
57
+
?locs:bool ->
58
+
string ->
59
+
Jmap_proto.Session.t
60
+
(** [decode_session_exn ?locs json] is like {!decode_session} but raises
61
+
on decoding errors. *)
62
+
63
+
(** {1 Blob Upload Response Decoding} *)
64
+
65
+
val decode_upload_response :
66
+
?locs:bool ->
67
+
string ->
68
+
(Jmap_proto.Blob.upload_response, Jsont.Error.t) result
69
+
(** [decode_upload_response ?locs json] decodes a blob upload response. *)
70
+
71
+
val decode_upload_response_exn :
72
+
?locs:bool ->
73
+
string ->
74
+
Jmap_proto.Blob.upload_response
75
+
(** [decode_upload_response_exn ?locs json] is like {!decode_upload_response}
76
+
but raises on decoding errors. *)
77
+
78
+
(** {1 Generic Encoding/Decoding} *)
79
+
80
+
val encode :
81
+
?format:Jsont.format ->
82
+
'a Jsont.t ->
83
+
'a ->
84
+
(string, Jsont.Error.t) result
85
+
(** [encode ?format jsont value] encodes any value using its jsont codec. *)
86
+
87
+
val decode :
88
+
?locs:bool ->
89
+
'a Jsont.t ->
90
+
string ->
91
+
('a, Jsont.Error.t) result
92
+
(** [decode ?locs jsont json] decodes any value using its jsont codec. *)
+5
eio/dune
+5
eio/dune
+7
eio/jmap_eio.ml
+7
eio/jmap_eio.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
module Codec = Codec
7
+
module Client = Client
+73
eio/jmap_eio.mli
+73
eio/jmap_eio.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** JMAP client library for Eio
7
+
8
+
This library provides a complete JMAP (RFC 8620/8621) client implementation
9
+
for OCaml using Eio for effects-based concurrency and Requests for HTTP.
10
+
11
+
{2 Overview}
12
+
13
+
The library consists of two layers:
14
+
15
+
- {!Codec}: Low-level JSON encoding/decoding for JMAP messages
16
+
- {!Client}: High-level JMAP client with session management
17
+
18
+
{2 Quick Start}
19
+
20
+
{[
21
+
open Eio_main
22
+
23
+
let () = run @@ fun env ->
24
+
Eio.Switch.run @@ fun sw ->
25
+
26
+
(* Create HTTP client *)
27
+
let requests = Requests.create ~sw env in
28
+
29
+
(* Create JMAP client from well-known URL *)
30
+
let client = Jmap_eio.Client.create_from_url_exn
31
+
~auth:(Requests.Auth.bearer "your-token")
32
+
requests
33
+
"https://api.example.com/.well-known/jmap" in
34
+
35
+
(* Get session info *)
36
+
let session = Jmap_eio.Client.session client in
37
+
Printf.printf "API URL: %s\n" (Jmap_proto.Session.api_url session);
38
+
39
+
(* Build and execute a request *)
40
+
let account_id = (* get from session *) ... in
41
+
let req = Jmap_eio.Client.Build.(
42
+
make_request
43
+
~capabilities:[Jmap_proto.Capability.core_uri;
44
+
Jmap_proto.Capability.mail_uri]
45
+
[mailbox_get ~call_id:"0" ~account_id ()]
46
+
) in
47
+
let response = Jmap_eio.Client.request_exn client req in
48
+
49
+
(* Process response *)
50
+
List.iter (fun inv ->
51
+
Printf.printf "Method: %s, CallId: %s\n"
52
+
(Jmap_proto.Invocation.name inv)
53
+
(Jmap_proto.Invocation.method_call_id inv)
54
+
) (Jmap_proto.Response.method_responses response)
55
+
]}
56
+
57
+
{2 Capabilities}
58
+
59
+
JMAP uses capability URIs to indicate supported features:
60
+
61
+
- [urn:ietf:params:jmap:core] - Core JMAP
62
+
- [urn:ietf:params:jmap:mail] - Email, Mailbox, Thread
63
+
- [urn:ietf:params:jmap:submission] - EmailSubmission
64
+
- [urn:ietf:params:jmap:vacationresponse] - VacationResponse
65
+
66
+
These are available as constants in {!Jmap_proto.Capability}.
67
+
*)
68
+
69
+
(** Low-level JSON codec for JMAP messages. *)
70
+
module Codec = Codec
71
+
72
+
(** High-level JMAP client with session management. *)
73
+
module Client = Client
+35
jmap-eio.opam
+35
jmap-eio.opam
···
1
+
# This file is generated by dune, edit dune-project instead
2
+
opam-version: "2.0"
3
+
synopsis: "JMAP client for Eio"
4
+
description:
5
+
"High-level JMAP client using Eio for async I/O and the Requests HTTP library."
6
+
maintainer: ["Anil Madhavapeddy <anil@recoil.org>"]
7
+
authors: ["Anil Madhavapeddy <anil@recoil.org>"]
8
+
license: "ISC"
9
+
homepage: "https://github.com/avsm/ocaml-jmap"
10
+
doc: "https://avsm.github.io/ocaml-jmap"
11
+
bug-reports: "https://github.com/avsm/ocaml-jmap/issues"
12
+
depends: [
13
+
"dune" {>= "3.0"}
14
+
"ocaml" {>= "4.14.0"}
15
+
"jmap" {= version}
16
+
"jsont" {>= "0.2.0"}
17
+
"eio"
18
+
"requests"
19
+
"odoc" {with-doc}
20
+
]
21
+
build: [
22
+
["dune" "subst"] {dev}
23
+
[
24
+
"dune"
25
+
"build"
26
+
"-p"
27
+
name
28
+
"-j"
29
+
jobs
30
+
"@install"
31
+
"@runtest" {with-test}
32
+
"@doc" {with-doc}
33
+
]
34
+
]
35
+
dev-repo: "git+https://github.com/avsm/ocaml-jmap.git"
+33
jmap.opam
+33
jmap.opam
···
1
+
# This file is generated by dune, edit dune-project instead
2
+
opam-version: "2.0"
3
+
synopsis: "JMAP protocol implementation for OCaml"
4
+
description:
5
+
"A complete implementation of the JSON Meta Application Protocol (JMAP) as specified in RFC 8620 (core) and RFC 8621 (mail)."
6
+
maintainer: ["Anil Madhavapeddy <anil@recoil.org>"]
7
+
authors: ["Anil Madhavapeddy <anil@recoil.org>"]
8
+
license: "ISC"
9
+
homepage: "https://github.com/avsm/ocaml-jmap"
10
+
doc: "https://avsm.github.io/ocaml-jmap"
11
+
bug-reports: "https://github.com/avsm/ocaml-jmap/issues"
12
+
depends: [
13
+
"dune" {>= "3.0"}
14
+
"ocaml" {>= "4.14.0"}
15
+
"jsont" {>= "0.2.0"}
16
+
"ptime" {>= "1.0.0"}
17
+
"odoc" {with-doc}
18
+
]
19
+
build: [
20
+
["dune" "subst"] {dev}
21
+
[
22
+
"dune"
23
+
"build"
24
+
"-p"
25
+
name
26
+
"-j"
27
+
jobs
28
+
"@install"
29
+
"@runtest" {with-test}
30
+
"@doc" {with-doc}
31
+
]
32
+
]
33
+
dev-repo: "git+https://github.com/avsm/ocaml-jmap.git"
+105
proto/blob.ml
+105
proto/blob.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
type upload_response = {
7
+
account_id : Id.t;
8
+
blob_id : Id.t;
9
+
type_ : string;
10
+
size : int64;
11
+
}
12
+
13
+
let upload_response_account_id t = t.account_id
14
+
let upload_response_blob_id t = t.blob_id
15
+
let upload_response_type t = t.type_
16
+
let upload_response_size t = t.size
17
+
18
+
let upload_response_make account_id blob_id type_ size =
19
+
{ account_id; blob_id; type_; size }
20
+
21
+
let upload_response_jsont =
22
+
let kind = "Upload response" in
23
+
Jsont.Object.map ~kind upload_response_make
24
+
|> Jsont.Object.mem "accountId" Id.jsont ~enc:upload_response_account_id
25
+
|> Jsont.Object.mem "blobId" Id.jsont ~enc:upload_response_blob_id
26
+
|> Jsont.Object.mem "type" Jsont.string ~enc:upload_response_type
27
+
|> Jsont.Object.mem "size" Int53.Unsigned.jsont ~enc:upload_response_size
28
+
|> Jsont.Object.finish
29
+
30
+
type download_vars = {
31
+
account_id : Id.t;
32
+
blob_id : Id.t;
33
+
type_ : string;
34
+
name : string;
35
+
}
36
+
37
+
let expand_download_url ~template vars =
38
+
let url_encode s =
39
+
(* Simple URL encoding *)
40
+
let buf = Buffer.create (String.length s * 3) in
41
+
String.iter (fun c ->
42
+
match c with
43
+
| 'A'..'Z' | 'a'..'z' | '0'..'9' | '-' | '_' | '.' | '~' ->
44
+
Buffer.add_char buf c
45
+
| _ ->
46
+
Buffer.add_string buf (Printf.sprintf "%%%02X" (Char.code c))
47
+
) s;
48
+
Buffer.contents buf
49
+
in
50
+
template
51
+
|> String.split_on_char '{'
52
+
|> List.mapi (fun i part ->
53
+
if i = 0 then part
54
+
else
55
+
match String.index_opt part '}' with
56
+
| None -> "{" ^ part
57
+
| Some j ->
58
+
let var = String.sub part 0 j in
59
+
let rest = String.sub part (j + 1) (String.length part - j - 1) in
60
+
let value = match var with
61
+
| "accountId" -> url_encode (Id.to_string vars.account_id)
62
+
| "blobId" -> url_encode (Id.to_string vars.blob_id)
63
+
| "type" -> url_encode vars.type_
64
+
| "name" -> url_encode vars.name
65
+
| _ -> "{" ^ var ^ "}"
66
+
in
67
+
value ^ rest
68
+
)
69
+
|> String.concat ""
70
+
71
+
type copy_args = {
72
+
from_account_id : Id.t;
73
+
account_id : Id.t;
74
+
blob_ids : Id.t list;
75
+
}
76
+
77
+
let copy_args_make from_account_id account_id blob_ids =
78
+
{ from_account_id; account_id; blob_ids }
79
+
80
+
let copy_args_jsont =
81
+
let kind = "Blob/copy args" in
82
+
Jsont.Object.map ~kind copy_args_make
83
+
|> Jsont.Object.mem "fromAccountId" Id.jsont ~enc:(fun a -> a.from_account_id)
84
+
|> Jsont.Object.mem "accountId" Id.jsont ~enc:(fun a -> a.account_id)
85
+
|> Jsont.Object.mem "blobIds" (Jsont.list Id.jsont) ~enc:(fun a -> a.blob_ids)
86
+
|> Jsont.Object.finish
87
+
88
+
type copy_response = {
89
+
from_account_id : Id.t;
90
+
account_id : Id.t;
91
+
copied : (Id.t * Id.t) list option;
92
+
not_copied : (Id.t * Error.set_error) list option;
93
+
}
94
+
95
+
let copy_response_make from_account_id account_id copied not_copied =
96
+
{ from_account_id; account_id; copied; not_copied }
97
+
98
+
let copy_response_jsont =
99
+
let kind = "Blob/copy response" in
100
+
Jsont.Object.map ~kind copy_response_make
101
+
|> Jsont.Object.mem "fromAccountId" Id.jsont ~enc:(fun r -> r.from_account_id)
102
+
|> Jsont.Object.mem "accountId" Id.jsont ~enc:(fun r -> r.account_id)
103
+
|> Jsont.Object.opt_mem "copied" (Json_map.of_id Id.jsont) ~enc:(fun r -> r.copied)
104
+
|> Jsont.Object.opt_mem "notCopied" (Json_map.of_id Error.set_error_jsont) ~enc:(fun r -> r.not_copied)
105
+
|> Jsont.Object.finish
+65
proto/blob.mli
+65
proto/blob.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** JMAP blob upload/download types as defined in RFC 8620 Section 6 *)
7
+
8
+
(** {1 Upload Response} *)
9
+
10
+
(** Response from a blob upload. *)
11
+
type upload_response = {
12
+
account_id : Id.t;
13
+
(** The account the blob was uploaded to. *)
14
+
blob_id : Id.t;
15
+
(** The server-assigned blob id. *)
16
+
type_ : string;
17
+
(** The media type of the uploaded blob. *)
18
+
size : int64;
19
+
(** The size in octets. *)
20
+
}
21
+
22
+
val upload_response_account_id : upload_response -> Id.t
23
+
val upload_response_blob_id : upload_response -> Id.t
24
+
val upload_response_type : upload_response -> string
25
+
val upload_response_size : upload_response -> int64
26
+
27
+
val upload_response_jsont : upload_response Jsont.t
28
+
29
+
(** {1 Download URL Template} *)
30
+
31
+
(** Variables for the download URL template. *)
32
+
type download_vars = {
33
+
account_id : Id.t;
34
+
blob_id : Id.t;
35
+
type_ : string;
36
+
name : string;
37
+
}
38
+
39
+
val expand_download_url : template:string -> download_vars -> string
40
+
(** [expand_download_url ~template vars] expands the download URL template
41
+
with the given variables. Template uses {accountId}, {blobId},
42
+
{type}, and {name} placeholders. *)
43
+
44
+
(** {1 Blob/copy} *)
45
+
46
+
(** Arguments for Blob/copy. *)
47
+
type copy_args = {
48
+
from_account_id : Id.t;
49
+
account_id : Id.t;
50
+
blob_ids : Id.t list;
51
+
}
52
+
53
+
val copy_args_jsont : copy_args Jsont.t
54
+
55
+
(** Response for Blob/copy. *)
56
+
type copy_response = {
57
+
from_account_id : Id.t;
58
+
account_id : Id.t;
59
+
copied : (Id.t * Id.t) list option;
60
+
(** Map of old blob id to new blob id. *)
61
+
not_copied : (Id.t * Error.set_error) list option;
62
+
(** Blobs that could not be copied. *)
63
+
}
64
+
65
+
val copy_response_jsont : copy_response Jsont.t
+171
proto/capability.ml
+171
proto/capability.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
let core = "urn:ietf:params:jmap:core"
7
+
let mail = "urn:ietf:params:jmap:mail"
8
+
let submission = "urn:ietf:params:jmap:submission"
9
+
let vacation_response = "urn:ietf:params:jmap:vacationresponse"
10
+
11
+
module Core = struct
12
+
type t = {
13
+
max_size_upload : int64;
14
+
max_concurrent_upload : int;
15
+
max_size_request : int64;
16
+
max_concurrent_requests : int;
17
+
max_calls_in_request : int;
18
+
max_objects_in_get : int;
19
+
max_objects_in_set : int;
20
+
collation_algorithms : string list;
21
+
}
22
+
23
+
let create ~max_size_upload ~max_concurrent_upload ~max_size_request
24
+
~max_concurrent_requests ~max_calls_in_request ~max_objects_in_get
25
+
~max_objects_in_set ~collation_algorithms =
26
+
{ max_size_upload; max_concurrent_upload; max_size_request;
27
+
max_concurrent_requests; max_calls_in_request; max_objects_in_get;
28
+
max_objects_in_set; collation_algorithms }
29
+
30
+
let max_size_upload t = t.max_size_upload
31
+
let max_concurrent_upload t = t.max_concurrent_upload
32
+
let max_size_request t = t.max_size_request
33
+
let max_concurrent_requests t = t.max_concurrent_requests
34
+
let max_calls_in_request t = t.max_calls_in_request
35
+
let max_objects_in_get t = t.max_objects_in_get
36
+
let max_objects_in_set t = t.max_objects_in_set
37
+
let collation_algorithms t = t.collation_algorithms
38
+
39
+
let make max_size_upload max_concurrent_upload max_size_request
40
+
max_concurrent_requests max_calls_in_request max_objects_in_get
41
+
max_objects_in_set collation_algorithms =
42
+
{ max_size_upload; max_concurrent_upload; max_size_request;
43
+
max_concurrent_requests; max_calls_in_request; max_objects_in_get;
44
+
max_objects_in_set; collation_algorithms }
45
+
46
+
let jsont =
47
+
let kind = "Core capability" in
48
+
Jsont.Object.map ~kind make
49
+
|> Jsont.Object.mem "maxSizeUpload" Int53.Unsigned.jsont ~enc:max_size_upload
50
+
|> Jsont.Object.mem "maxConcurrentUpload" Jsont.int ~enc:max_concurrent_upload
51
+
|> Jsont.Object.mem "maxSizeRequest" Int53.Unsigned.jsont ~enc:max_size_request
52
+
|> Jsont.Object.mem "maxConcurrentRequests" Jsont.int ~enc:max_concurrent_requests
53
+
|> Jsont.Object.mem "maxCallsInRequest" Jsont.int ~enc:max_calls_in_request
54
+
|> Jsont.Object.mem "maxObjectsInGet" Jsont.int ~enc:max_objects_in_get
55
+
|> Jsont.Object.mem "maxObjectsInSet" Jsont.int ~enc:max_objects_in_set
56
+
|> Jsont.Object.mem "collationAlgorithms" (Jsont.list Jsont.string) ~enc:collation_algorithms
57
+
|> Jsont.Object.finish
58
+
end
59
+
60
+
module Mail = struct
61
+
type t = {
62
+
max_mailboxes_per_email : int64 option;
63
+
max_mailbox_depth : int64 option;
64
+
max_size_mailbox_name : int64;
65
+
max_size_attachments_per_email : int64;
66
+
email_query_sort_options : string list;
67
+
may_create_top_level_mailbox : bool;
68
+
}
69
+
70
+
let create ?max_mailboxes_per_email ?max_mailbox_depth ~max_size_mailbox_name
71
+
~max_size_attachments_per_email ~email_query_sort_options
72
+
~may_create_top_level_mailbox () =
73
+
{ max_mailboxes_per_email; max_mailbox_depth; max_size_mailbox_name;
74
+
max_size_attachments_per_email; email_query_sort_options;
75
+
may_create_top_level_mailbox }
76
+
77
+
let max_mailboxes_per_email t = t.max_mailboxes_per_email
78
+
let max_mailbox_depth t = t.max_mailbox_depth
79
+
let max_size_mailbox_name t = t.max_size_mailbox_name
80
+
let max_size_attachments_per_email t = t.max_size_attachments_per_email
81
+
let email_query_sort_options t = t.email_query_sort_options
82
+
let may_create_top_level_mailbox t = t.may_create_top_level_mailbox
83
+
84
+
let make max_mailboxes_per_email max_mailbox_depth max_size_mailbox_name
85
+
max_size_attachments_per_email email_query_sort_options
86
+
may_create_top_level_mailbox =
87
+
{ max_mailboxes_per_email; max_mailbox_depth; max_size_mailbox_name;
88
+
max_size_attachments_per_email; email_query_sort_options;
89
+
may_create_top_level_mailbox }
90
+
91
+
let jsont =
92
+
let kind = "Mail capability" in
93
+
Jsont.Object.map ~kind make
94
+
|> Jsont.Object.opt_mem "maxMailboxesPerEmail" Int53.Unsigned.jsont ~enc:max_mailboxes_per_email
95
+
|> Jsont.Object.opt_mem "maxMailboxDepth" Int53.Unsigned.jsont ~enc:max_mailbox_depth
96
+
|> Jsont.Object.mem "maxSizeMailboxName" Int53.Unsigned.jsont ~enc:max_size_mailbox_name
97
+
|> Jsont.Object.mem "maxSizeAttachmentsPerEmail" Int53.Unsigned.jsont ~enc:max_size_attachments_per_email
98
+
|> Jsont.Object.mem "emailQuerySortOptions" (Jsont.list Jsont.string) ~enc:email_query_sort_options
99
+
|> Jsont.Object.mem "mayCreateTopLevelMailbox" Jsont.bool ~enc:may_create_top_level_mailbox
100
+
|> Jsont.Object.finish
101
+
end
102
+
103
+
module Submission = struct
104
+
type t = {
105
+
max_delayed_send : int64;
106
+
submission_extensions : (string * string list) list;
107
+
}
108
+
109
+
let create ~max_delayed_send ~submission_extensions =
110
+
{ max_delayed_send; submission_extensions }
111
+
112
+
let max_delayed_send t = t.max_delayed_send
113
+
let submission_extensions t = t.submission_extensions
114
+
115
+
let make max_delayed_send submission_extensions =
116
+
{ max_delayed_send; submission_extensions }
117
+
118
+
let submission_extensions_jsont =
119
+
Json_map.of_string (Jsont.list Jsont.string)
120
+
121
+
let jsont =
122
+
let kind = "Submission capability" in
123
+
Jsont.Object.map ~kind make
124
+
|> Jsont.Object.mem "maxDelayedSend" Int53.Unsigned.jsont ~enc:max_delayed_send
125
+
|> Jsont.Object.mem "submissionExtensions" submission_extensions_jsont ~enc:submission_extensions
126
+
|> Jsont.Object.finish
127
+
end
128
+
129
+
type capability =
130
+
| Core of Core.t
131
+
| Mail of Mail.t
132
+
| Submission of Submission.t
133
+
| Vacation_response
134
+
| Unknown of Jsont.json
135
+
136
+
let capability_of_json uri json =
137
+
match uri with
138
+
| u when u = core ->
139
+
(match Jsont.Json.decode' Core.jsont json with
140
+
| Ok c -> Core c
141
+
| Error _ -> Unknown json)
142
+
| u when u = mail ->
143
+
(match Jsont.Json.decode' Mail.jsont json with
144
+
| Ok m -> Mail m
145
+
| Error _ -> Unknown json)
146
+
| u when u = submission ->
147
+
(match Jsont.Json.decode' Submission.jsont json with
148
+
| Ok s -> Submission s
149
+
| Error _ -> Unknown json)
150
+
| u when u = vacation_response ->
151
+
Vacation_response
152
+
| _ ->
153
+
Unknown json
154
+
155
+
let capability_to_json (uri, cap) =
156
+
let encode jsont v =
157
+
match Jsont.Json.encode' jsont v with
158
+
| Ok json -> json
159
+
| Error _ -> Jsont.Object ([], Jsont.Meta.none)
160
+
in
161
+
match cap with
162
+
| Core c ->
163
+
(uri, encode Core.jsont c)
164
+
| Mail m ->
165
+
(uri, encode Mail.jsont m)
166
+
| Submission s ->
167
+
(uri, encode Submission.jsont s)
168
+
| Vacation_response ->
169
+
(uri, Jsont.Object ([], Jsont.Meta.none))
170
+
| Unknown json ->
171
+
(uri, json)
+143
proto/capability.mli
+143
proto/capability.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** JMAP capability types as defined in RFC 8620 Section 2 *)
7
+
8
+
(** {1 Standard Capability URIs} *)
9
+
10
+
val core : string
11
+
(** [urn:ietf:params:jmap:core] - Core JMAP capability (RFC 8620) *)
12
+
13
+
val mail : string
14
+
(** [urn:ietf:params:jmap:mail] - Mail capability (RFC 8621) *)
15
+
16
+
val submission : string
17
+
(** [urn:ietf:params:jmap:submission] - Email submission capability (RFC 8621) *)
18
+
19
+
val vacation_response : string
20
+
(** [urn:ietf:params:jmap:vacationresponse] - Vacation response capability (RFC 8621) *)
21
+
22
+
(** {1 Core Capability Object} *)
23
+
24
+
(** Core capability limits and configuration per RFC 8620 Section 2. *)
25
+
module Core : sig
26
+
type t = {
27
+
max_size_upload : int64;
28
+
(** Maximum size in octets for a single blob upload. *)
29
+
max_concurrent_upload : int;
30
+
(** Maximum number of concurrent upload requests. *)
31
+
max_size_request : int64;
32
+
(** Maximum size in octets of a single request. *)
33
+
max_concurrent_requests : int;
34
+
(** Maximum number of concurrent requests. *)
35
+
max_calls_in_request : int;
36
+
(** Maximum number of method calls in a single request. *)
37
+
max_objects_in_get : int;
38
+
(** Maximum number of objects in a single /get request. *)
39
+
max_objects_in_set : int;
40
+
(** Maximum number of objects in a single /set request. *)
41
+
collation_algorithms : string list;
42
+
(** Supported collation algorithms for sorting. *)
43
+
}
44
+
45
+
val create :
46
+
max_size_upload:int64 ->
47
+
max_concurrent_upload:int ->
48
+
max_size_request:int64 ->
49
+
max_concurrent_requests:int ->
50
+
max_calls_in_request:int ->
51
+
max_objects_in_get:int ->
52
+
max_objects_in_set:int ->
53
+
collation_algorithms:string list ->
54
+
t
55
+
56
+
val max_size_upload : t -> int64
57
+
val max_concurrent_upload : t -> int
58
+
val max_size_request : t -> int64
59
+
val max_concurrent_requests : t -> int
60
+
val max_calls_in_request : t -> int
61
+
val max_objects_in_get : t -> int
62
+
val max_objects_in_set : t -> int
63
+
val collation_algorithms : t -> string list
64
+
65
+
val jsont : t Jsont.t
66
+
(** JSON codec for core capability. *)
67
+
end
68
+
69
+
(** {1 Mail Capability Object} *)
70
+
71
+
(** Mail capability configuration per RFC 8621. *)
72
+
module Mail : sig
73
+
type t = {
74
+
max_mailboxes_per_email : int64 option;
75
+
(** Maximum number of mailboxes an email can belong to. *)
76
+
max_mailbox_depth : int64 option;
77
+
(** Maximum depth of mailbox hierarchy. *)
78
+
max_size_mailbox_name : int64;
79
+
(** Maximum size of a mailbox name in octets. *)
80
+
max_size_attachments_per_email : int64;
81
+
(** Maximum total size of attachments per email. *)
82
+
email_query_sort_options : string list;
83
+
(** Supported sort options for Email/query. *)
84
+
may_create_top_level_mailbox : bool;
85
+
(** Whether the user may create top-level mailboxes. *)
86
+
}
87
+
88
+
val create :
89
+
?max_mailboxes_per_email:int64 ->
90
+
?max_mailbox_depth:int64 ->
91
+
max_size_mailbox_name:int64 ->
92
+
max_size_attachments_per_email:int64 ->
93
+
email_query_sort_options:string list ->
94
+
may_create_top_level_mailbox:bool ->
95
+
unit ->
96
+
t
97
+
98
+
val max_mailboxes_per_email : t -> int64 option
99
+
val max_mailbox_depth : t -> int64 option
100
+
val max_size_mailbox_name : t -> int64
101
+
val max_size_attachments_per_email : t -> int64
102
+
val email_query_sort_options : t -> string list
103
+
val may_create_top_level_mailbox : t -> bool
104
+
105
+
val jsont : t Jsont.t
106
+
end
107
+
108
+
(** {1 Submission Capability Object} *)
109
+
110
+
module Submission : sig
111
+
type t = {
112
+
max_delayed_send : int64;
113
+
(** Maximum delay in seconds for delayed sending (0 = not supported). *)
114
+
submission_extensions : (string * string list) list;
115
+
(** SMTP extensions supported. *)
116
+
}
117
+
118
+
val create :
119
+
max_delayed_send:int64 ->
120
+
submission_extensions:(string * string list) list ->
121
+
t
122
+
123
+
val max_delayed_send : t -> int64
124
+
val submission_extensions : t -> (string * string list) list
125
+
126
+
val jsont : t Jsont.t
127
+
end
128
+
129
+
(** {1 Generic Capability Handling} *)
130
+
131
+
(** A capability value that can be either a known type or unknown JSON. *)
132
+
type capability =
133
+
| Core of Core.t
134
+
| Mail of Mail.t
135
+
| Submission of Submission.t
136
+
| Vacation_response (* No configuration *)
137
+
| Unknown of Jsont.json
138
+
139
+
val capability_of_json : string -> Jsont.json -> capability
140
+
(** [capability_of_json uri json] parses a capability from its URI and JSON value. *)
141
+
142
+
val capability_to_json : string * capability -> string * Jsont.json
143
+
(** [capability_to_json (uri, cap)] encodes a capability to URI and JSON. *)
+64
proto/date.ml
+64
proto/date.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Date and time types for JMAP.
7
+
8
+
JMAP uses RFC 3339 formatted date-time strings. *)
9
+
10
+
(** RFC 3339 date-time with any timezone offset *)
11
+
module Rfc3339 = struct
12
+
type t = Ptime.t
13
+
14
+
let of_string s =
15
+
match Ptime.of_rfc3339 s with
16
+
| Ok (t, _, _) -> Ok t
17
+
| Error _ -> Error (Printf.sprintf "Invalid RFC 3339 date: %s" s)
18
+
19
+
let to_string t =
20
+
(* Format with 'T' separator and timezone offset *)
21
+
Ptime.to_rfc3339 ~tz_offset_s:0 t
22
+
23
+
let jsont =
24
+
let kind = "Date" in
25
+
let dec s =
26
+
match of_string s with
27
+
| Ok t -> t
28
+
| Error msg -> Jsont.Error.msgf Jsont.Meta.none "%s: %s" kind msg
29
+
in
30
+
let enc = to_string in
31
+
Jsont.map ~kind ~dec ~enc Jsont.string
32
+
end
33
+
34
+
(** UTC date-time (must use 'Z' timezone suffix) *)
35
+
module Utc = struct
36
+
type t = Ptime.t
37
+
38
+
let of_string s =
39
+
(* Must end with 'Z' for UTC *)
40
+
let len = String.length s in
41
+
if len > 0 && s.[len - 1] <> 'Z' then
42
+
Error "UTCDate must use 'Z' timezone suffix"
43
+
else
44
+
match Ptime.of_rfc3339 s with
45
+
| Ok (t, _, _) -> Ok t
46
+
| Error _ -> Error (Printf.sprintf "Invalid RFC 3339 UTC date: %s" s)
47
+
48
+
let to_string t =
49
+
(* Always format with 'Z' suffix *)
50
+
Ptime.to_rfc3339 ~tz_offset_s:0 t
51
+
52
+
let of_ptime t = t
53
+
let to_ptime t = t
54
+
55
+
let jsont =
56
+
let kind = "UTCDate" in
57
+
let dec s =
58
+
match of_string s with
59
+
| Ok t -> t
60
+
| Error msg -> Jsont.Error.msgf Jsont.Meta.none "%s: %s" kind msg
61
+
in
62
+
let enc = to_string in
63
+
Jsont.map ~kind ~dec ~enc Jsont.string
64
+
end
+51
proto/date.mli
+51
proto/date.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Date and time types for JMAP.
7
+
8
+
JMAP uses RFC 3339 formatted date-time strings.
9
+
10
+
See {{:https://datatracker.ietf.org/doc/html/rfc8620#section-1.4} RFC 8620 Section 1.4}. *)
11
+
12
+
(** RFC 3339 date-time.
13
+
14
+
A date-time string with uppercase 'T' separator. May have any timezone. *)
15
+
module Rfc3339 : sig
16
+
type t = Ptime.t
17
+
(** The type of dates. *)
18
+
19
+
val of_string : string -> (t, string) result
20
+
(** [of_string s] parses an RFC 3339 date-time string. *)
21
+
22
+
val to_string : t -> string
23
+
(** [to_string d] formats [d] as an RFC 3339 string. *)
24
+
25
+
val jsont : t Jsont.t
26
+
(** JSON codec for RFC 3339 dates. *)
27
+
end
28
+
29
+
(** UTC date-time.
30
+
31
+
A date-time string that MUST have 'Z' as the timezone (UTC only). *)
32
+
module Utc : sig
33
+
type t = Ptime.t
34
+
(** The type of UTC dates. *)
35
+
36
+
val of_string : string -> (t, string) result
37
+
(** [of_string s] parses an RFC 3339 UTC date-time string.
38
+
Returns error if timezone is not 'Z'. *)
39
+
40
+
val to_string : t -> string
41
+
(** [to_string d] formats [d] as an RFC 3339 UTC string with 'Z'. *)
42
+
43
+
val of_ptime : Ptime.t -> t
44
+
(** [of_ptime p] creates a UTC date from a Ptime value. *)
45
+
46
+
val to_ptime : t -> Ptime.t
47
+
(** [to_ptime d] returns the underlying Ptime value. *)
48
+
49
+
val jsont : t Jsont.t
50
+
(** JSON codec for UTC dates. *)
51
+
end
+21
proto/dune
+21
proto/dune
···
1
+
(library
2
+
(name jmap_proto)
3
+
(public_name jmap)
4
+
(libraries jsont ptime)
5
+
(modules
6
+
jmap_proto
7
+
id
8
+
int53
9
+
date
10
+
json_map
11
+
unknown
12
+
error
13
+
capability
14
+
filter
15
+
method_
16
+
invocation
17
+
request
18
+
response
19
+
session
20
+
push
21
+
blob))
+190
proto/error.ml
+190
proto/error.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
module Request_error = struct
7
+
type urn =
8
+
| Unknown_capability
9
+
| Not_json
10
+
| Not_request
11
+
| Limit
12
+
| Other of string
13
+
14
+
let urn_to_string = function
15
+
| Unknown_capability -> "urn:ietf:params:jmap:error:unknownCapability"
16
+
| Not_json -> "urn:ietf:params:jmap:error:notJSON"
17
+
| Not_request -> "urn:ietf:params:jmap:error:notRequest"
18
+
| Limit -> "urn:ietf:params:jmap:error:limit"
19
+
| Other s -> s
20
+
21
+
let urn_of_string = function
22
+
| "urn:ietf:params:jmap:error:unknownCapability" -> Unknown_capability
23
+
| "urn:ietf:params:jmap:error:notJSON" -> Not_json
24
+
| "urn:ietf:params:jmap:error:notRequest" -> Not_request
25
+
| "urn:ietf:params:jmap:error:limit" -> Limit
26
+
| s -> Other s
27
+
28
+
let urn_jsont =
29
+
let kind = "Request error URN" in
30
+
Jsont.map ~kind
31
+
~dec:(fun s -> urn_of_string s)
32
+
~enc:urn_to_string
33
+
Jsont.string
34
+
35
+
type t = {
36
+
type_ : urn;
37
+
status : int;
38
+
title : string option;
39
+
detail : string option;
40
+
limit : string option;
41
+
}
42
+
43
+
let make type_ status title detail limit =
44
+
{ type_; status; title; detail; limit }
45
+
46
+
let type_ t = t.type_
47
+
let status t = t.status
48
+
let title t = t.title
49
+
let detail t = t.detail
50
+
let limit t = t.limit
51
+
52
+
let jsont =
53
+
let kind = "Request error" in
54
+
Jsont.Object.map ~kind make
55
+
|> Jsont.Object.mem "type" urn_jsont ~enc:type_
56
+
|> Jsont.Object.mem "status" Jsont.int ~enc:status
57
+
|> Jsont.Object.opt_mem "title" Jsont.string ~enc:title
58
+
|> Jsont.Object.opt_mem "detail" Jsont.string ~enc:detail
59
+
|> Jsont.Object.opt_mem "limit" Jsont.string ~enc:limit
60
+
|> Jsont.Object.finish
61
+
end
62
+
63
+
type method_error_type =
64
+
| Server_unavailable
65
+
| Server_fail
66
+
| Server_partial_fail
67
+
| Unknown_method
68
+
| Invalid_arguments
69
+
| Invalid_result_reference
70
+
| Forbidden
71
+
| Account_not_found
72
+
| Account_not_supported_by_method
73
+
| Account_read_only
74
+
| Other of string
75
+
76
+
let method_error_type_to_string = function
77
+
| Server_unavailable -> "serverUnavailable"
78
+
| Server_fail -> "serverFail"
79
+
| Server_partial_fail -> "serverPartialFail"
80
+
| Unknown_method -> "unknownMethod"
81
+
| Invalid_arguments -> "invalidArguments"
82
+
| Invalid_result_reference -> "invalidResultReference"
83
+
| Forbidden -> "forbidden"
84
+
| Account_not_found -> "accountNotFound"
85
+
| Account_not_supported_by_method -> "accountNotSupportedByMethod"
86
+
| Account_read_only -> "accountReadOnly"
87
+
| Other s -> s
88
+
89
+
let method_error_type_of_string = function
90
+
| "serverUnavailable" -> Server_unavailable
91
+
| "serverFail" -> Server_fail
92
+
| "serverPartialFail" -> Server_partial_fail
93
+
| "unknownMethod" -> Unknown_method
94
+
| "invalidArguments" -> Invalid_arguments
95
+
| "invalidResultReference" -> Invalid_result_reference
96
+
| "forbidden" -> Forbidden
97
+
| "accountNotFound" -> Account_not_found
98
+
| "accountNotSupportedByMethod" -> Account_not_supported_by_method
99
+
| "accountReadOnly" -> Account_read_only
100
+
| s -> Other s
101
+
102
+
let method_error_type_jsont =
103
+
let kind = "Method error type" in
104
+
Jsont.map ~kind
105
+
~dec:(fun s -> method_error_type_of_string s)
106
+
~enc:method_error_type_to_string
107
+
Jsont.string
108
+
109
+
type method_error = {
110
+
type_ : method_error_type;
111
+
description : string option;
112
+
}
113
+
114
+
let method_error_make type_ description = { type_; description }
115
+
let method_error_type_ t = t.type_
116
+
let method_error_description t = t.description
117
+
118
+
let method_error_jsont =
119
+
let kind = "Method error" in
120
+
Jsont.Object.map ~kind method_error_make
121
+
|> Jsont.Object.mem "type" method_error_type_jsont ~enc:method_error_type_
122
+
|> Jsont.Object.opt_mem "description" Jsont.string ~enc:method_error_description
123
+
|> Jsont.Object.finish
124
+
125
+
type set_error_type =
126
+
| Forbidden
127
+
| Over_quota
128
+
| Too_large
129
+
| Rate_limit
130
+
| Not_found
131
+
| Invalid_patch
132
+
| Will_destroy
133
+
| Invalid_properties
134
+
| Singleton
135
+
| Other of string
136
+
137
+
let set_error_type_to_string = function
138
+
| Forbidden -> "forbidden"
139
+
| Over_quota -> "overQuota"
140
+
| Too_large -> "tooLarge"
141
+
| Rate_limit -> "rateLimit"
142
+
| Not_found -> "notFound"
143
+
| Invalid_patch -> "invalidPatch"
144
+
| Will_destroy -> "willDestroy"
145
+
| Invalid_properties -> "invalidProperties"
146
+
| Singleton -> "singleton"
147
+
| Other s -> s
148
+
149
+
let set_error_type_of_string = function
150
+
| "forbidden" -> Forbidden
151
+
| "overQuota" -> Over_quota
152
+
| "tooLarge" -> Too_large
153
+
| "rateLimit" -> Rate_limit
154
+
| "notFound" -> Not_found
155
+
| "invalidPatch" -> Invalid_patch
156
+
| "willDestroy" -> Will_destroy
157
+
| "invalidProperties" -> Invalid_properties
158
+
| "singleton" -> Singleton
159
+
| s -> Other s
160
+
161
+
let set_error_type_jsont =
162
+
let kind = "SetError type" in
163
+
Jsont.map ~kind
164
+
~dec:(fun s -> set_error_type_of_string s)
165
+
~enc:set_error_type_to_string
166
+
Jsont.string
167
+
168
+
type set_error = {
169
+
type_ : set_error_type;
170
+
description : string option;
171
+
properties : string list option;
172
+
}
173
+
174
+
let set_error ?description ?properties type_ =
175
+
{ type_; description; properties }
176
+
177
+
let set_error_make type_ description properties =
178
+
{ type_; description; properties }
179
+
180
+
let set_error_type_ t = t.type_
181
+
let set_error_description t = t.description
182
+
let set_error_properties t = t.properties
183
+
184
+
let set_error_jsont =
185
+
let kind = "SetError" in
186
+
Jsont.Object.map ~kind set_error_make
187
+
|> Jsont.Object.mem "type" set_error_type_jsont ~enc:set_error_type_
188
+
|> Jsont.Object.opt_mem "description" Jsont.string ~enc:set_error_description
189
+
|> Jsont.Object.opt_mem "properties" (Jsont.list Jsont.string) ~enc:set_error_properties
190
+
|> Jsont.Object.finish
+146
proto/error.mli
+146
proto/error.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** JMAP error types as defined in RFC 8620 Section 3.6.1-3.6.2 *)
7
+
8
+
(** {1 Request-Level Errors}
9
+
10
+
These errors are returned with an HTTP error status code and a JSON
11
+
Problem Details body (RFC 7807). *)
12
+
13
+
(** Request-level error URNs *)
14
+
module Request_error : sig
15
+
type urn =
16
+
| Unknown_capability
17
+
(** urn:ietf:params:jmap:error:unknownCapability
18
+
The client included a capability in "using" that the server does not support. *)
19
+
| Not_json
20
+
(** urn:ietf:params:jmap:error:notJSON
21
+
The content type was not application/json or the request was not valid JSON. *)
22
+
| Not_request
23
+
(** urn:ietf:params:jmap:error:notRequest
24
+
The request was valid JSON but not a valid JMAP Request object. *)
25
+
| Limit
26
+
(** urn:ietf:params:jmap:error:limit
27
+
A server-defined limit was reached. *)
28
+
| Other of string
29
+
(** Other URN not in the standard set. *)
30
+
31
+
val urn_to_string : urn -> string
32
+
(** [urn_to_string urn] returns the URN string. *)
33
+
34
+
val urn_of_string : string -> urn
35
+
(** [urn_of_string s] parses a URN string. *)
36
+
37
+
type t = {
38
+
type_ : urn;
39
+
(** The error type URN. *)
40
+
status : int;
41
+
(** HTTP status code. *)
42
+
title : string option;
43
+
(** Short human-readable summary. *)
44
+
detail : string option;
45
+
(** Longer human-readable explanation. *)
46
+
limit : string option;
47
+
(** For "limit" errors, the name of the limit that was exceeded. *)
48
+
}
49
+
(** A request-level error per RFC 7807 Problem Details. *)
50
+
51
+
val jsont : t Jsont.t
52
+
(** JSON codec for request-level errors. *)
53
+
end
54
+
55
+
(** {1 Method-Level Errors}
56
+
57
+
These are returned as the second element of an Invocation tuple
58
+
when a method call fails. *)
59
+
60
+
(** Standard method error types per RFC 8620 Section 3.6.2 *)
61
+
type method_error_type =
62
+
| Server_unavailable
63
+
(** The server is temporarily unavailable. *)
64
+
| Server_fail
65
+
(** An unexpected error occurred. *)
66
+
| Server_partial_fail
67
+
(** Some, but not all, changes were successfully made. *)
68
+
| Unknown_method
69
+
(** The method name is not recognized. *)
70
+
| Invalid_arguments
71
+
(** One or more arguments are invalid. *)
72
+
| Invalid_result_reference
73
+
(** A result reference could not be resolved. *)
74
+
| Forbidden
75
+
(** The method/arguments are valid but forbidden. *)
76
+
| Account_not_found
77
+
(** The accountId does not correspond to a valid account. *)
78
+
| Account_not_supported_by_method
79
+
(** The account does not support this method. *)
80
+
| Account_read_only
81
+
(** The account is read-only. *)
82
+
| Other of string
83
+
(** Other error type not in the standard set. *)
84
+
85
+
val method_error_type_to_string : method_error_type -> string
86
+
(** [method_error_type_to_string t] returns the type string. *)
87
+
88
+
val method_error_type_of_string : string -> method_error_type
89
+
(** [method_error_type_of_string s] parses a type string. *)
90
+
91
+
(** A method-level error response. *)
92
+
type method_error = {
93
+
type_ : method_error_type;
94
+
(** The error type. *)
95
+
description : string option;
96
+
(** Human-readable description of the error. *)
97
+
}
98
+
99
+
val method_error_jsont : method_error Jsont.t
100
+
(** JSON codec for method errors. *)
101
+
102
+
(** {1 SetError}
103
+
104
+
Errors returned in notCreated/notUpdated/notDestroyed responses. *)
105
+
106
+
(** Standard SetError types per RFC 8620 Section 5.3 *)
107
+
type set_error_type =
108
+
| Forbidden
109
+
(** The operation is not permitted. *)
110
+
| Over_quota
111
+
(** The maximum server quota has been reached. *)
112
+
| Too_large
113
+
(** The object is too large. *)
114
+
| Rate_limit
115
+
(** Too many objects of this type have been created recently. *)
116
+
| Not_found
117
+
(** The id does not exist (for update/destroy). *)
118
+
| Invalid_patch
119
+
(** The PatchObject is invalid. *)
120
+
| Will_destroy
121
+
(** The object will be destroyed by another operation in the request. *)
122
+
| Invalid_properties
123
+
(** Some properties were invalid. *)
124
+
| Singleton
125
+
(** Only one object of this type can exist (for create). *)
126
+
| Other of string
127
+
(** Other error type. *)
128
+
129
+
val set_error_type_to_string : set_error_type -> string
130
+
val set_error_type_of_string : string -> set_error_type
131
+
132
+
(** A SetError object. *)
133
+
type set_error = {
134
+
type_ : set_error_type;
135
+
(** The error type. *)
136
+
description : string option;
137
+
(** Human-readable description. *)
138
+
properties : string list option;
139
+
(** For invalidProperties errors, the list of invalid property names. *)
140
+
}
141
+
142
+
val set_error : ?description:string -> ?properties:string list -> set_error_type -> set_error
143
+
(** [set_error ?description ?properties type_] creates a SetError. *)
144
+
145
+
val set_error_jsont : set_error Jsont.t
146
+
(** JSON codec for SetError. *)
+123
proto/filter.ml
+123
proto/filter.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
type operator = And | Or | Not
7
+
8
+
let operator_to_string = function
9
+
| And -> "AND"
10
+
| Or -> "OR"
11
+
| Not -> "NOT"
12
+
13
+
let operator_of_string = function
14
+
| "AND" -> And
15
+
| "OR" -> Or
16
+
| "NOT" -> Not
17
+
| s -> Jsont.Error.msgf Jsont.Meta.none "Unknown filter operator: %s" s
18
+
19
+
let operator_jsont =
20
+
let kind = "Filter operator" in
21
+
Jsont.map ~kind
22
+
~dec:(fun s -> operator_of_string s)
23
+
~enc:operator_to_string
24
+
Jsont.string
25
+
26
+
type 'condition filter_operator = {
27
+
operator : operator;
28
+
conditions : 'condition filter list;
29
+
}
30
+
31
+
and 'condition filter =
32
+
| Operator of 'condition filter_operator
33
+
| Condition of 'condition
34
+
35
+
let filter_jsont (type c) (condition_jsont : c Jsont.t) : c filter Jsont.t =
36
+
let kind = "Filter" in
37
+
(* Create a recursive codec using Jsont.rec' *)
38
+
let rec make_filter_jsont () =
39
+
let lazy_self = lazy (make_filter_jsont ()) in
40
+
(* Filter operator codec *)
41
+
let filter_operator_jsont =
42
+
let make operator conditions = { operator; conditions } in
43
+
Jsont.Object.map ~kind:"FilterOperator" make
44
+
|> Jsont.Object.mem "operator" operator_jsont ~enc:(fun o -> o.operator)
45
+
|> Jsont.Object.mem "conditions"
46
+
(Jsont.list (Jsont.rec' lazy_self))
47
+
~enc:(fun o -> o.conditions)
48
+
|> Jsont.Object.finish
49
+
in
50
+
(* Decode function: check for "operator" field to determine type *)
51
+
let dec json =
52
+
match json with
53
+
| Jsont.Object (members, _) ->
54
+
(* members has type (name * json) list where name = string * Meta.t *)
55
+
if List.exists (fun ((k, _), _) -> k = "operator") members then begin
56
+
(* It's an operator *)
57
+
match Jsont.Json.decode' filter_operator_jsont json with
58
+
| Ok op -> Operator op
59
+
| Error e -> raise (Jsont.Error e)
60
+
end else begin
61
+
(* It's a condition *)
62
+
match Jsont.Json.decode' condition_jsont json with
63
+
| Ok c -> Condition c
64
+
| Error e -> raise (Jsont.Error e)
65
+
end
66
+
| Jsont.Null _ | Jsont.Bool _ | Jsont.Number _ | Jsont.String _ | Jsont.Array _ ->
67
+
Jsont.Error.msg Jsont.Meta.none "Filter must be an object"
68
+
in
69
+
(* Encode function *)
70
+
let enc = function
71
+
| Operator op ->
72
+
(match Jsont.Json.encode' filter_operator_jsont op with
73
+
| Ok j -> j
74
+
| Error e -> raise (Jsont.Error e))
75
+
| Condition c ->
76
+
(match Jsont.Json.encode' condition_jsont c with
77
+
| Ok j -> j
78
+
| Error e -> raise (Jsont.Error e))
79
+
in
80
+
Jsont.map ~kind ~dec ~enc Jsont.json
81
+
in
82
+
make_filter_jsont ()
83
+
84
+
type comparator = {
85
+
property : string;
86
+
is_ascending : bool;
87
+
collation : string option;
88
+
}
89
+
90
+
let comparator ?(is_ascending = true) ?collation property =
91
+
{ property; is_ascending; collation }
92
+
93
+
let comparator_property c = c.property
94
+
let comparator_is_ascending c = c.is_ascending
95
+
let comparator_collation c = c.collation
96
+
97
+
let comparator_make property is_ascending collation =
98
+
{ property; is_ascending; collation }
99
+
100
+
let comparator_jsont =
101
+
let kind = "Comparator" in
102
+
Jsont.Object.map ~kind comparator_make
103
+
|> Jsont.Object.mem "property" Jsont.string ~enc:comparator_property
104
+
|> Jsont.Object.mem "isAscending" Jsont.bool ~dec_absent:true ~enc:comparator_is_ascending
105
+
~enc_omit:(fun b -> b = true)
106
+
|> Jsont.Object.opt_mem "collation" Jsont.string ~enc:comparator_collation
107
+
|> Jsont.Object.finish
108
+
109
+
type added_item = {
110
+
id : Id.t;
111
+
index : int64;
112
+
}
113
+
114
+
let added_item_make id index = { id; index }
115
+
let added_item_id a = a.id
116
+
let added_item_index a = a.index
117
+
118
+
let added_item_jsont =
119
+
let kind = "AddedItem" in
120
+
Jsont.Object.map ~kind added_item_make
121
+
|> Jsont.Object.mem "id" Id.jsont ~enc:added_item_id
122
+
|> Jsont.Object.mem "index" Int53.Unsigned.jsont ~enc:added_item_index
123
+
|> Jsont.Object.finish
+73
proto/filter.mli
+73
proto/filter.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** JMAP filter and sort types as defined in RFC 8620 Section 5.5 *)
7
+
8
+
(** {1 Filter Operators} *)
9
+
10
+
(** Filter operator types. *)
11
+
type operator =
12
+
| And (** All conditions must match *)
13
+
| Or (** At least one condition must match *)
14
+
| Not (** Inverts a single condition *)
15
+
16
+
val operator_jsont : operator Jsont.t
17
+
(** JSON codec for filter operators. *)
18
+
19
+
(** A filter operator that combines conditions.
20
+
21
+
When decoding, the filter determines whether a JSON object is an
22
+
operator (has "operator" field) or a condition. *)
23
+
type 'condition filter_operator = {
24
+
operator : operator;
25
+
conditions : 'condition filter list;
26
+
}
27
+
28
+
(** A filter is either an operator combining filters, or a leaf condition. *)
29
+
and 'condition filter =
30
+
| Operator of 'condition filter_operator
31
+
| Condition of 'condition
32
+
33
+
val filter_jsont : 'c Jsont.t -> 'c filter Jsont.t
34
+
(** [filter_jsont condition_jsont] creates a codec for filters with the
35
+
given condition type. The codec automatically distinguishes operators
36
+
from conditions by the presence of the "operator" field. *)
37
+
38
+
(** {1 Comparators} *)
39
+
40
+
(** A comparator for sorting query results. *)
41
+
type comparator = {
42
+
property : string;
43
+
(** The property to sort by. *)
44
+
is_ascending : bool;
45
+
(** [true] for ascending order (default), [false] for descending. *)
46
+
collation : string option;
47
+
(** Optional collation algorithm for string comparison. *)
48
+
}
49
+
50
+
val comparator :
51
+
?is_ascending:bool ->
52
+
?collation:string ->
53
+
string ->
54
+
comparator
55
+
(** [comparator ?is_ascending ?collation property] creates a comparator.
56
+
[is_ascending] defaults to [true]. *)
57
+
58
+
val comparator_property : comparator -> string
59
+
val comparator_is_ascending : comparator -> bool
60
+
val comparator_collation : comparator -> string option
61
+
62
+
val comparator_jsont : comparator Jsont.t
63
+
(** JSON codec for comparators. *)
64
+
65
+
(** {1 Position Information} *)
66
+
67
+
(** Added entry position in query change results. *)
68
+
type added_item = {
69
+
id : Id.t;
70
+
index : int64;
71
+
}
72
+
73
+
val added_item_jsont : added_item Jsont.t
+51
proto/id.ml
+51
proto/id.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** JMAP identifier type as defined in RFC 8620 Section 1.2.
7
+
8
+
An Id is a string of 1-255 octets from the URL-safe base64 alphabet. *)
9
+
10
+
type t = string
11
+
12
+
(* Valid characters: A-Za-z0-9_- (URL-safe base64 alphabet) *)
13
+
let is_valid_char c =
14
+
(c >= 'A' && c <= 'Z') ||
15
+
(c >= 'a' && c <= 'z') ||
16
+
(c >= '0' && c <= '9') ||
17
+
c = '_' || c = '-'
18
+
19
+
let validate s =
20
+
let len = String.length s in
21
+
if len = 0 then Error "Id cannot be empty"
22
+
else if len > 255 then Error "Id cannot exceed 255 characters"
23
+
else
24
+
let rec check i =
25
+
if i >= len then Ok s
26
+
else if is_valid_char s.[i] then check (i + 1)
27
+
else Error (Printf.sprintf "Invalid character '%c' in Id at position %d" s.[i] i)
28
+
in
29
+
check 0
30
+
31
+
let of_string = validate
32
+
33
+
let of_string_exn s =
34
+
match validate s with
35
+
| Ok id -> id
36
+
| Error msg -> invalid_arg msg
37
+
38
+
let to_string t = t
39
+
let equal = String.equal
40
+
let compare = String.compare
41
+
let pp ppf t = Format.pp_print_string ppf t
42
+
43
+
let jsont =
44
+
let kind = "Id" in
45
+
let dec s =
46
+
match validate s with
47
+
| Ok id -> id
48
+
| Error msg -> Jsont.Error.msgf Jsont.Meta.none "%s: %s" kind msg
49
+
in
50
+
let enc t = t in
51
+
Jsont.map ~kind ~dec ~enc Jsont.string
+38
proto/id.mli
+38
proto/id.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** JMAP identifier type.
7
+
8
+
An Id is a string of 1-255 octets from the URL-safe base64 alphabet
9
+
(A-Za-z0-9_-), plus the ASCII alphanumeric characters.
10
+
11
+
See {{:https://datatracker.ietf.org/doc/html/rfc8620#section-1.2} RFC 8620 Section 1.2}. *)
12
+
13
+
type t
14
+
(** The type of JMAP identifiers. *)
15
+
16
+
val of_string : string -> (t, string) result
17
+
(** [of_string s] creates an Id from string [s].
18
+
Returns [Error msg] if [s] is empty, longer than 255 characters,
19
+
or contains invalid characters. *)
20
+
21
+
val of_string_exn : string -> t
22
+
(** [of_string_exn s] creates an Id from string [s].
23
+
@raise Invalid_argument if the string is invalid. *)
24
+
25
+
val to_string : t -> string
26
+
(** [to_string id] returns the string representation of [id]. *)
27
+
28
+
val equal : t -> t -> bool
29
+
(** [equal a b] tests equality of identifiers. *)
30
+
31
+
val compare : t -> t -> int
32
+
(** [compare a b] compares two identifiers. *)
33
+
34
+
val pp : Format.formatter -> t -> unit
35
+
(** [pp ppf id] pretty-prints [id] to [ppf]. *)
36
+
37
+
val jsont : t Jsont.t
38
+
(** JSON codec for JMAP identifiers. *)
+67
proto/int53.ml
+67
proto/int53.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** JavaScript-safe integer types for JSON.
7
+
8
+
These types represent integers that can be safely represented in JavaScript's
9
+
IEEE 754 double-precision floating point format without loss of precision. *)
10
+
11
+
(** 53-bit signed integer with range -2^53+1 to 2^53-1 *)
12
+
module Signed = struct
13
+
type t = int64
14
+
15
+
(* 2^53 - 1 *)
16
+
let max_value = 9007199254740991L
17
+
(* -(2^53 - 1) *)
18
+
let min_value = -9007199254740991L
19
+
20
+
let of_int n = Int64.of_int n
21
+
22
+
let to_int n =
23
+
if n >= Int64.of_int min_int && n <= Int64.of_int max_int then
24
+
Some (Int64.to_int n)
25
+
else
26
+
None
27
+
28
+
let of_int64 n =
29
+
if n >= min_value && n <= max_value then Ok n
30
+
else Error (Printf.sprintf "Int53 out of range: %Ld" n)
31
+
32
+
let jsont =
33
+
let kind = "Int53" in
34
+
let dec f =
35
+
let n = Int64.of_float f in
36
+
if n >= min_value && n <= max_value then n
37
+
else Jsont.Error.msgf Jsont.Meta.none "%s: value %Ld out of safe integer range" kind n
38
+
in
39
+
let enc n = Int64.to_float n in
40
+
Jsont.map ~kind ~dec ~enc Jsont.number
41
+
end
42
+
43
+
(** 53-bit unsigned integer with range 0 to 2^53-1 *)
44
+
module Unsigned = struct
45
+
type t = int64
46
+
47
+
let min_value = 0L
48
+
let max_value = 9007199254740991L
49
+
50
+
let of_int n =
51
+
if n >= 0 then Ok (Int64.of_int n)
52
+
else Error "UnsignedInt53 cannot be negative"
53
+
54
+
let of_int64 n =
55
+
if n >= min_value && n <= max_value then Ok n
56
+
else Error (Printf.sprintf "UnsignedInt53 out of range: %Ld" n)
57
+
58
+
let jsont =
59
+
let kind = "UnsignedInt53" in
60
+
let dec f =
61
+
let n = Int64.of_float f in
62
+
if n >= min_value && n <= max_value then n
63
+
else Jsont.Error.msgf Jsont.Meta.none "%s: value %Ld out of range [0, 2^53-1]" kind n
64
+
in
65
+
let enc n = Int64.to_float n in
66
+
Jsont.map ~kind ~dec ~enc Jsont.number
67
+
end
+62
proto/int53.mli
+62
proto/int53.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** JavaScript-safe integer types for JSON.
7
+
8
+
These types represent integers that can be safely represented in JavaScript's
9
+
IEEE 754 double-precision floating point format without loss of precision.
10
+
The safe range is -2^53+1 to 2^53-1.
11
+
12
+
See {{:https://datatracker.ietf.org/doc/html/rfc8620#section-1.3} RFC 8620 Section 1.3}. *)
13
+
14
+
(** 53-bit signed integer.
15
+
16
+
The range is -2^53+1 to 2^53-1, which is the safe integer range
17
+
for JavaScript/JSON numbers. *)
18
+
module Signed : sig
19
+
type t = int64
20
+
(** The type of 53-bit signed integers. *)
21
+
22
+
val min_value : t
23
+
(** Minimum value: -9007199254740991 (-2^53+1) *)
24
+
25
+
val max_value : t
26
+
(** Maximum value: 9007199254740991 (2^53-1) *)
27
+
28
+
val of_int : int -> t
29
+
(** [of_int n] converts an OCaml int to Int53. *)
30
+
31
+
val to_int : t -> int option
32
+
(** [to_int n] converts to OCaml int if it fits. *)
33
+
34
+
val of_int64 : int64 -> (t, string) result
35
+
(** [of_int64 n] validates that [n] is in the safe range. *)
36
+
37
+
val jsont : t Jsont.t
38
+
(** JSON codec for 53-bit integers. Encoded as JSON number. *)
39
+
end
40
+
41
+
(** 53-bit unsigned integer.
42
+
43
+
The range is 0 to 2^53-1. *)
44
+
module Unsigned : sig
45
+
type t = int64
46
+
(** The type of 53-bit unsigned integers. *)
47
+
48
+
val min_value : t
49
+
(** Minimum value: 0 *)
50
+
51
+
val max_value : t
52
+
(** Maximum value: 9007199254740991 (2^53-1) *)
53
+
54
+
val of_int : int -> (t, string) result
55
+
(** [of_int n] converts an OCaml int to UnsignedInt53. *)
56
+
57
+
val of_int64 : int64 -> (t, string) result
58
+
(** [of_int64 n] validates that [n] is in the valid range. *)
59
+
60
+
val jsont : t Jsont.t
61
+
(** JSON codec for 53-bit unsigned integers. *)
62
+
end
+86
proto/invocation.ml
+86
proto/invocation.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
type result_reference = {
7
+
result_of : string;
8
+
name : string;
9
+
path : string;
10
+
}
11
+
12
+
let result_reference ~result_of ~name ~path =
13
+
{ result_of; name; path }
14
+
15
+
let result_reference_make result_of name path =
16
+
{ result_of; name; path }
17
+
18
+
let result_reference_jsont =
19
+
let kind = "ResultReference" in
20
+
Jsont.Object.map ~kind result_reference_make
21
+
|> Jsont.Object.mem "resultOf" Jsont.string ~enc:(fun r -> r.result_of)
22
+
|> Jsont.Object.mem "name" Jsont.string ~enc:(fun r -> r.name)
23
+
|> Jsont.Object.mem "path" Jsont.string ~enc:(fun r -> r.path)
24
+
|> Jsont.Object.finish
25
+
26
+
type t = {
27
+
name : string;
28
+
arguments : Jsont.json;
29
+
method_call_id : string;
30
+
}
31
+
32
+
let create ~name ~arguments ~method_call_id =
33
+
{ name; arguments; method_call_id }
34
+
35
+
let name t = t.name
36
+
let arguments t = t.arguments
37
+
let method_call_id t = t.method_call_id
38
+
39
+
(* Helper to encode a typed value back to Jsont.json *)
40
+
let encode_json_value jsont value =
41
+
match Jsont.Json.encode' jsont value with
42
+
| Ok json -> json
43
+
| Error _ -> Jsont.Object ([], Jsont.Meta.none)
44
+
45
+
let jsont =
46
+
let kind = "Invocation" in
47
+
(* Invocation is [name, args, callId] - a 3-element heterogeneous array *)
48
+
(* We need to handle this as a json array since elements have different types *)
49
+
let dec json =
50
+
match json with
51
+
| Jsont.Array ([name_json; arguments; call_id_json], _) ->
52
+
let name = match name_json with
53
+
| Jsont.String (s, _) -> s
54
+
| _ -> Jsont.Error.msg Jsont.Meta.none "Invocation[0] must be a string"
55
+
in
56
+
let method_call_id = match call_id_json with
57
+
| Jsont.String (s, _) -> s
58
+
| _ -> Jsont.Error.msg Jsont.Meta.none "Invocation[2] must be a string"
59
+
in
60
+
{ name; arguments; method_call_id }
61
+
| Jsont.Array _ ->
62
+
Jsont.Error.msg Jsont.Meta.none "Invocation must be a 3-element array"
63
+
| _ ->
64
+
Jsont.Error.msg Jsont.Meta.none "Invocation must be an array"
65
+
in
66
+
let enc t =
67
+
Jsont.Array ([
68
+
Jsont.String (t.name, Jsont.Meta.none);
69
+
t.arguments;
70
+
Jsont.String (t.method_call_id, Jsont.Meta.none);
71
+
], Jsont.Meta.none)
72
+
in
73
+
Jsont.map ~kind ~dec ~enc Jsont.json
74
+
75
+
let make_get ~method_call_id ~method_name args =
76
+
let arguments = encode_json_value Method_.get_args_jsont args in
77
+
{ name = method_name; arguments; method_call_id }
78
+
79
+
let make_changes ~method_call_id ~method_name args =
80
+
let arguments = encode_json_value Method_.changes_args_jsont args in
81
+
{ name = method_name; arguments; method_call_id }
82
+
83
+
let make_query (type f) ~method_call_id ~method_name
84
+
~(filter_cond_jsont : f Jsont.t) (args : f Method_.query_args) =
85
+
let arguments = encode_json_value (Method_.query_args_jsont filter_cond_jsont) args in
86
+
{ name = method_name; arguments; method_call_id }
+81
proto/invocation.mli
+81
proto/invocation.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** JMAP method invocation as defined in RFC 8620 Section 3.2 *)
7
+
8
+
(** {1 Result References} *)
9
+
10
+
(** A reference to a result from a previous method call.
11
+
12
+
Used for back-referencing values within a single request. *)
13
+
type result_reference = {
14
+
result_of : string;
15
+
(** The method call id to reference. *)
16
+
name : string;
17
+
(** The method name that was called. *)
18
+
path : string;
19
+
(** A JSON Pointer to the value within the result. *)
20
+
}
21
+
22
+
val result_reference :
23
+
result_of:string ->
24
+
name:string ->
25
+
path:string ->
26
+
result_reference
27
+
28
+
val result_reference_jsont : result_reference Jsont.t
29
+
30
+
(** {1 Invocations} *)
31
+
32
+
(** A method invocation.
33
+
34
+
In JSON, this is represented as a 3-element array:
35
+
["methodName", {args}, "methodCallId"] *)
36
+
type t = {
37
+
name : string;
38
+
(** The method name, e.g., "Email/get". *)
39
+
arguments : Jsont.json;
40
+
(** The method arguments as a JSON object. *)
41
+
method_call_id : string;
42
+
(** Client-specified identifier for this call. *)
43
+
}
44
+
45
+
val create :
46
+
name:string ->
47
+
arguments:Jsont.json ->
48
+
method_call_id:string ->
49
+
t
50
+
(** [create ~name ~arguments ~method_call_id] creates an invocation. *)
51
+
52
+
val name : t -> string
53
+
val arguments : t -> Jsont.json
54
+
val method_call_id : t -> string
55
+
56
+
val jsont : t Jsont.t
57
+
(** JSON codec for invocations (as 3-element array). *)
58
+
59
+
(** {1 Typed Invocation Helpers} *)
60
+
61
+
val make_get :
62
+
method_call_id:string ->
63
+
method_name:string ->
64
+
Method_.get_args ->
65
+
t
66
+
(** [make_get ~method_call_id ~method_name args] creates a /get invocation. *)
67
+
68
+
val make_changes :
69
+
method_call_id:string ->
70
+
method_name:string ->
71
+
Method_.changes_args ->
72
+
t
73
+
(** [make_changes ~method_call_id ~method_name args] creates a /changes invocation. *)
74
+
75
+
val make_query :
76
+
method_call_id:string ->
77
+
method_name:string ->
78
+
filter_cond_jsont:'f Jsont.t ->
79
+
'f Method_.query_args ->
80
+
t
81
+
(** [make_query ~method_call_id ~method_name ~filter_cond_jsont args] creates a /query invocation. *)
+24
proto/jmap_proto.ml
+24
proto/jmap_proto.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** JMAP Protocol Types (RFC 8620)
7
+
8
+
This module re-exports all JMAP core protocol types. *)
9
+
10
+
module Id = Id
11
+
module Int53 = Int53
12
+
module Date = Date
13
+
module Json_map = Json_map
14
+
module Unknown = Unknown
15
+
module Error = Error
16
+
module Capability = Capability
17
+
module Filter = Filter
18
+
module Method = Method_
19
+
module Invocation = Invocation
20
+
module Request = Request
21
+
module Response = Response
22
+
module Session = Session
23
+
module Push = Push
24
+
module Blob = Blob
+40
proto/json_map.ml
+40
proto/json_map.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** JSON object-as-map codec utilities.
7
+
8
+
JMAP frequently uses JSON objects as maps with string or Id keys.
9
+
These codecs convert between JSON objects and OCaml association lists. *)
10
+
11
+
module String_map = Map.Make(String)
12
+
13
+
let of_string value_jsont =
14
+
let kind = "String map" in
15
+
Jsont.Object.map ~kind Fun.id
16
+
|> Jsont.Object.keep_unknown (Jsont.Object.Mems.string_map value_jsont) ~enc:Fun.id
17
+
|> Jsont.Object.finish
18
+
|> Jsont.map
19
+
~dec:(fun m -> List.of_seq (String_map.to_seq m))
20
+
~enc:(fun l -> String_map.of_list l)
21
+
22
+
let of_id value_jsont =
23
+
let kind = "Id map" in
24
+
(* Use string map internally, then convert keys to Ids *)
25
+
let string_codec = of_string value_jsont in
26
+
let dec pairs =
27
+
List.map (fun (k, v) ->
28
+
match Id.of_string k with
29
+
| Ok id -> (id, v)
30
+
| Error msg -> Jsont.Error.msgf Jsont.Meta.none "%s: invalid key %s - %s" kind k msg
31
+
) pairs
32
+
in
33
+
let enc pairs =
34
+
List.map (fun (id, v) -> (Id.to_string id, v)) pairs
35
+
in
36
+
Jsont.map ~kind ~dec ~enc string_codec
37
+
38
+
let id_to_bool = of_id Jsont.bool
39
+
40
+
let string_to_bool = of_string Jsont.bool
+23
proto/json_map.mli
+23
proto/json_map.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** JSON object-as-map codec utilities.
7
+
8
+
JMAP frequently uses JSON objects as maps with string or Id keys.
9
+
These codecs convert between JSON objects and OCaml association lists. *)
10
+
11
+
val of_string : 'a Jsont.t -> (string * 'a) list Jsont.t
12
+
(** [of_string value_jsont] creates a codec for JSON objects
13
+
used as string-keyed maps. Returns an association list. *)
14
+
15
+
val of_id : 'a Jsont.t -> (Id.t * 'a) list Jsont.t
16
+
(** [of_id value_jsont] creates a codec for JSON objects
17
+
keyed by JMAP identifiers. *)
18
+
19
+
val id_to_bool : (Id.t * bool) list Jsont.t
20
+
(** Codec for Id[Boolean] maps, common in JMAP (e.g., mailboxIds, keywords). *)
21
+
22
+
val string_to_bool : (string * bool) list Jsont.t
23
+
(** Codec for String[Boolean] maps. *)
+17
proto/mail/dune
+17
proto/mail/dune
+216
proto/mail/email.ml
+216
proto/mail/email.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
module Keyword = struct
7
+
let draft = "$draft"
8
+
let seen = "$seen"
9
+
let flagged = "$flagged"
10
+
let answered = "$answered"
11
+
let forwarded = "$forwarded"
12
+
let phishing = "$phishing"
13
+
let junk = "$junk"
14
+
let not_junk = "$notjunk"
15
+
end
16
+
17
+
type t = {
18
+
id : Jmap_proto.Id.t;
19
+
blob_id : Jmap_proto.Id.t;
20
+
thread_id : Jmap_proto.Id.t;
21
+
size : int64;
22
+
received_at : Ptime.t;
23
+
mailbox_ids : (Jmap_proto.Id.t * bool) list;
24
+
keywords : (string * bool) list;
25
+
message_id : string list option;
26
+
in_reply_to : string list option;
27
+
references : string list option;
28
+
sender : Email_address.t list option;
29
+
from : Email_address.t list option;
30
+
to_ : Email_address.t list option;
31
+
cc : Email_address.t list option;
32
+
bcc : Email_address.t list option;
33
+
reply_to : Email_address.t list option;
34
+
subject : string option;
35
+
sent_at : Ptime.t option;
36
+
headers : Email_header.t list option;
37
+
body_structure : Email_body.Part.t option;
38
+
body_values : (string * Email_body.Value.t) list option;
39
+
text_body : Email_body.Part.t list option;
40
+
html_body : Email_body.Part.t list option;
41
+
attachments : Email_body.Part.t list option;
42
+
has_attachment : bool;
43
+
preview : string;
44
+
}
45
+
46
+
let id t = t.id
47
+
let blob_id t = t.blob_id
48
+
let thread_id t = t.thread_id
49
+
let size t = t.size
50
+
let received_at t = t.received_at
51
+
let mailbox_ids t = t.mailbox_ids
52
+
let keywords t = t.keywords
53
+
let message_id t = t.message_id
54
+
let in_reply_to t = t.in_reply_to
55
+
let references t = t.references
56
+
let sender t = t.sender
57
+
let from t = t.from
58
+
let to_ t = t.to_
59
+
let cc t = t.cc
60
+
let bcc t = t.bcc
61
+
let reply_to t = t.reply_to
62
+
let subject t = t.subject
63
+
let sent_at t = t.sent_at
64
+
let headers t = t.headers
65
+
let body_structure t = t.body_structure
66
+
let body_values t = t.body_values
67
+
let text_body t = t.text_body
68
+
let html_body t = t.html_body
69
+
let attachments t = t.attachments
70
+
let has_attachment t = t.has_attachment
71
+
let preview t = t.preview
72
+
73
+
let make id blob_id thread_id size received_at mailbox_ids keywords
74
+
message_id in_reply_to references sender from to_ cc bcc reply_to
75
+
subject sent_at headers body_structure body_values text_body html_body
76
+
attachments has_attachment preview =
77
+
{ id; blob_id; thread_id; size; received_at; mailbox_ids; keywords;
78
+
message_id; in_reply_to; references; sender; from; to_; cc; bcc;
79
+
reply_to; subject; sent_at; headers; body_structure; body_values;
80
+
text_body; html_body; attachments; has_attachment; preview }
81
+
82
+
let jsont =
83
+
let kind = "Email" in
84
+
let body_values_jsont = Jmap_proto.Json_map.of_string Email_body.Value.jsont in
85
+
Jsont.Object.map ~kind make
86
+
|> Jsont.Object.mem "id" Jmap_proto.Id.jsont ~enc:id
87
+
|> Jsont.Object.mem "blobId" Jmap_proto.Id.jsont ~enc:blob_id
88
+
|> Jsont.Object.mem "threadId" Jmap_proto.Id.jsont ~enc:thread_id
89
+
|> Jsont.Object.mem "size" Jmap_proto.Int53.Unsigned.jsont ~enc:size
90
+
|> Jsont.Object.mem "receivedAt" Jmap_proto.Date.Utc.jsont ~enc:received_at
91
+
|> Jsont.Object.mem "mailboxIds" Jmap_proto.Json_map.id_to_bool ~enc:mailbox_ids
92
+
|> Jsont.Object.mem "keywords" Jmap_proto.Json_map.string_to_bool ~dec_absent:[] ~enc:keywords
93
+
|> Jsont.Object.opt_mem "messageId" (Jsont.list Jsont.string) ~enc:message_id
94
+
|> Jsont.Object.opt_mem "inReplyTo" (Jsont.list Jsont.string) ~enc:in_reply_to
95
+
|> Jsont.Object.opt_mem "references" (Jsont.list Jsont.string) ~enc:references
96
+
|> Jsont.Object.opt_mem "sender" (Jsont.list Email_address.jsont) ~enc:sender
97
+
|> Jsont.Object.opt_mem "from" (Jsont.list Email_address.jsont) ~enc:from
98
+
|> Jsont.Object.opt_mem "to" (Jsont.list Email_address.jsont) ~enc:to_
99
+
|> Jsont.Object.opt_mem "cc" (Jsont.list Email_address.jsont) ~enc:cc
100
+
|> Jsont.Object.opt_mem "bcc" (Jsont.list Email_address.jsont) ~enc:bcc
101
+
|> Jsont.Object.opt_mem "replyTo" (Jsont.list Email_address.jsont) ~enc:reply_to
102
+
|> Jsont.Object.opt_mem "subject" Jsont.string ~enc:subject
103
+
|> Jsont.Object.opt_mem "sentAt" Jmap_proto.Date.Rfc3339.jsont ~enc:sent_at
104
+
|> Jsont.Object.opt_mem "headers" (Jsont.list Email_header.jsont) ~enc:headers
105
+
|> Jsont.Object.opt_mem "bodyStructure" Email_body.Part.jsont ~enc:body_structure
106
+
|> Jsont.Object.opt_mem "bodyValues" body_values_jsont ~enc:body_values
107
+
|> Jsont.Object.opt_mem "textBody" (Jsont.list Email_body.Part.jsont) ~enc:text_body
108
+
|> Jsont.Object.opt_mem "htmlBody" (Jsont.list Email_body.Part.jsont) ~enc:html_body
109
+
|> Jsont.Object.opt_mem "attachments" (Jsont.list Email_body.Part.jsont) ~enc:attachments
110
+
|> Jsont.Object.mem "hasAttachment" Jsont.bool ~dec_absent:false ~enc:has_attachment
111
+
|> Jsont.Object.mem "preview" Jsont.string ~dec_absent:"" ~enc:preview
112
+
|> Jsont.Object.finish
113
+
114
+
module Filter_condition = struct
115
+
type t = {
116
+
in_mailbox : Jmap_proto.Id.t option;
117
+
in_mailbox_other_than : Jmap_proto.Id.t list option;
118
+
before : Ptime.t option;
119
+
after : Ptime.t option;
120
+
min_size : int64 option;
121
+
max_size : int64 option;
122
+
all_in_thread_have_keyword : string option;
123
+
some_in_thread_have_keyword : string option;
124
+
none_in_thread_have_keyword : string option;
125
+
has_keyword : string option;
126
+
not_keyword : string option;
127
+
has_attachment : bool option;
128
+
text : string option;
129
+
from : string option;
130
+
to_ : string option;
131
+
cc : string option;
132
+
bcc : string option;
133
+
subject : string option;
134
+
body : string option;
135
+
header : (string * string option) option;
136
+
}
137
+
138
+
let make in_mailbox in_mailbox_other_than before after min_size max_size
139
+
all_in_thread_have_keyword some_in_thread_have_keyword
140
+
none_in_thread_have_keyword has_keyword not_keyword has_attachment
141
+
text from to_ cc bcc subject body header =
142
+
{ in_mailbox; in_mailbox_other_than; before; after; min_size; max_size;
143
+
all_in_thread_have_keyword; some_in_thread_have_keyword;
144
+
none_in_thread_have_keyword; has_keyword; not_keyword; has_attachment;
145
+
text; from; to_; cc; bcc; subject; body; header }
146
+
147
+
(* Header filter is encoded as [name] or [name, value] array *)
148
+
let header_jsont =
149
+
let kind = "HeaderFilter" in
150
+
let dec json =
151
+
match json with
152
+
| Jsont.Array ([Jsont.String (name, _)], _) ->
153
+
(name, None)
154
+
| Jsont.Array ([Jsont.String (name, _); Jsont.String (value, _)], _) ->
155
+
(name, Some value)
156
+
| _ ->
157
+
Jsont.Error.msgf Jsont.Meta.none "%s: expected [name] or [name, value]" kind
158
+
in
159
+
let enc (name, value) =
160
+
match value with
161
+
| None -> Jsont.Array ([Jsont.String (name, Jsont.Meta.none)], Jsont.Meta.none)
162
+
| Some v -> Jsont.Array ([Jsont.String (name, Jsont.Meta.none); Jsont.String (v, Jsont.Meta.none)], Jsont.Meta.none)
163
+
in
164
+
Jsont.map ~kind ~dec ~enc Jsont.json
165
+
166
+
let jsont =
167
+
let kind = "EmailFilterCondition" in
168
+
Jsont.Object.map ~kind make
169
+
|> Jsont.Object.opt_mem "inMailbox" Jmap_proto.Id.jsont ~enc:(fun f -> f.in_mailbox)
170
+
|> Jsont.Object.opt_mem "inMailboxOtherThan" (Jsont.list Jmap_proto.Id.jsont) ~enc:(fun f -> f.in_mailbox_other_than)
171
+
|> Jsont.Object.opt_mem "before" Jmap_proto.Date.Utc.jsont ~enc:(fun f -> f.before)
172
+
|> Jsont.Object.opt_mem "after" Jmap_proto.Date.Utc.jsont ~enc:(fun f -> f.after)
173
+
|> Jsont.Object.opt_mem "minSize" Jmap_proto.Int53.Unsigned.jsont ~enc:(fun f -> f.min_size)
174
+
|> Jsont.Object.opt_mem "maxSize" Jmap_proto.Int53.Unsigned.jsont ~enc:(fun f -> f.max_size)
175
+
|> Jsont.Object.opt_mem "allInThreadHaveKeyword" Jsont.string ~enc:(fun f -> f.all_in_thread_have_keyword)
176
+
|> Jsont.Object.opt_mem "someInThreadHaveKeyword" Jsont.string ~enc:(fun f -> f.some_in_thread_have_keyword)
177
+
|> Jsont.Object.opt_mem "noneInThreadHaveKeyword" Jsont.string ~enc:(fun f -> f.none_in_thread_have_keyword)
178
+
|> Jsont.Object.opt_mem "hasKeyword" Jsont.string ~enc:(fun f -> f.has_keyword)
179
+
|> Jsont.Object.opt_mem "notKeyword" Jsont.string ~enc:(fun f -> f.not_keyword)
180
+
|> Jsont.Object.opt_mem "hasAttachment" Jsont.bool ~enc:(fun f -> f.has_attachment)
181
+
|> Jsont.Object.opt_mem "text" Jsont.string ~enc:(fun f -> f.text)
182
+
|> Jsont.Object.opt_mem "from" Jsont.string ~enc:(fun f -> f.from)
183
+
|> Jsont.Object.opt_mem "to" Jsont.string ~enc:(fun f -> f.to_)
184
+
|> Jsont.Object.opt_mem "cc" Jsont.string ~enc:(fun f -> f.cc)
185
+
|> Jsont.Object.opt_mem "bcc" Jsont.string ~enc:(fun f -> f.bcc)
186
+
|> Jsont.Object.opt_mem "subject" Jsont.string ~enc:(fun f -> f.subject)
187
+
|> Jsont.Object.opt_mem "body" Jsont.string ~enc:(fun f -> f.body)
188
+
|> Jsont.Object.opt_mem "header" header_jsont ~enc:(fun f -> f.header)
189
+
|> Jsont.Object.finish
190
+
end
191
+
192
+
type get_args_extra = {
193
+
body_properties : string list option;
194
+
fetch_text_body_values : bool;
195
+
fetch_html_body_values : bool;
196
+
fetch_all_body_values : bool;
197
+
max_body_value_bytes : int64 option;
198
+
}
199
+
200
+
let get_args_extra_make body_properties fetch_text_body_values
201
+
fetch_html_body_values fetch_all_body_values max_body_value_bytes =
202
+
{ body_properties; fetch_text_body_values; fetch_html_body_values;
203
+
fetch_all_body_values; max_body_value_bytes }
204
+
205
+
let get_args_extra_jsont =
206
+
let kind = "Email/get extra args" in
207
+
Jsont.Object.map ~kind get_args_extra_make
208
+
|> Jsont.Object.opt_mem "bodyProperties" (Jsont.list Jsont.string) ~enc:(fun a -> a.body_properties)
209
+
|> Jsont.Object.mem "fetchTextBodyValues" Jsont.bool ~dec_absent:false
210
+
~enc:(fun a -> a.fetch_text_body_values) ~enc_omit:(fun b -> not b)
211
+
|> Jsont.Object.mem "fetchHTMLBodyValues" Jsont.bool ~dec_absent:false
212
+
~enc:(fun a -> a.fetch_html_body_values) ~enc_omit:(fun b -> not b)
213
+
|> Jsont.Object.mem "fetchAllBodyValues" Jsont.bool ~dec_absent:false
214
+
~enc:(fun a -> a.fetch_all_body_values) ~enc_omit:(fun b -> not b)
215
+
|> Jsont.Object.opt_mem "maxBodyValueBytes" Jmap_proto.Int53.Unsigned.jsont ~enc:(fun a -> a.max_body_value_bytes)
216
+
|> Jsont.Object.finish
+146
proto/mail/email.mli
+146
proto/mail/email.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Email type as defined in RFC 8621 Section 4 *)
7
+
8
+
(** {1 Standard Keywords} *)
9
+
10
+
(** Standard email keywords per RFC 8621. *)
11
+
module Keyword : sig
12
+
val draft : string
13
+
(** ["$draft"] *)
14
+
15
+
val seen : string
16
+
(** ["$seen"] *)
17
+
18
+
val flagged : string
19
+
(** ["$flagged"] *)
20
+
21
+
val answered : string
22
+
(** ["$answered"] *)
23
+
24
+
val forwarded : string
25
+
(** ["$forwarded"] *)
26
+
27
+
val phishing : string
28
+
(** ["$phishing"] *)
29
+
30
+
val junk : string
31
+
(** ["$junk"] *)
32
+
33
+
val not_junk : string
34
+
(** ["$notjunk"] *)
35
+
end
36
+
37
+
(** {1 Email Object} *)
38
+
39
+
type t = {
40
+
(* Metadata - server-set, immutable *)
41
+
id : Jmap_proto.Id.t;
42
+
blob_id : Jmap_proto.Id.t;
43
+
thread_id : Jmap_proto.Id.t;
44
+
size : int64;
45
+
received_at : Ptime.t;
46
+
47
+
(* Metadata - mutable *)
48
+
mailbox_ids : (Jmap_proto.Id.t * bool) list;
49
+
keywords : (string * bool) list;
50
+
51
+
(* Parsed headers *)
52
+
message_id : string list option;
53
+
in_reply_to : string list option;
54
+
references : string list option;
55
+
sender : Email_address.t list option;
56
+
from : Email_address.t list option;
57
+
to_ : Email_address.t list option;
58
+
cc : Email_address.t list option;
59
+
bcc : Email_address.t list option;
60
+
reply_to : Email_address.t list option;
61
+
subject : string option;
62
+
sent_at : Ptime.t option;
63
+
64
+
(* Raw headers *)
65
+
headers : Email_header.t list option;
66
+
67
+
(* Body structure *)
68
+
body_structure : Email_body.Part.t option;
69
+
body_values : (string * Email_body.Value.t) list option;
70
+
text_body : Email_body.Part.t list option;
71
+
html_body : Email_body.Part.t list option;
72
+
attachments : Email_body.Part.t list option;
73
+
has_attachment : bool;
74
+
preview : string;
75
+
}
76
+
77
+
val id : t -> Jmap_proto.Id.t
78
+
val blob_id : t -> Jmap_proto.Id.t
79
+
val thread_id : t -> Jmap_proto.Id.t
80
+
val size : t -> int64
81
+
val received_at : t -> Ptime.t
82
+
val mailbox_ids : t -> (Jmap_proto.Id.t * bool) list
83
+
val keywords : t -> (string * bool) list
84
+
val message_id : t -> string list option
85
+
val in_reply_to : t -> string list option
86
+
val references : t -> string list option
87
+
val sender : t -> Email_address.t list option
88
+
val from : t -> Email_address.t list option
89
+
val to_ : t -> Email_address.t list option
90
+
val cc : t -> Email_address.t list option
91
+
val bcc : t -> Email_address.t list option
92
+
val reply_to : t -> Email_address.t list option
93
+
val subject : t -> string option
94
+
val sent_at : t -> Ptime.t option
95
+
val headers : t -> Email_header.t list option
96
+
val body_structure : t -> Email_body.Part.t option
97
+
val body_values : t -> (string * Email_body.Value.t) list option
98
+
val text_body : t -> Email_body.Part.t list option
99
+
val html_body : t -> Email_body.Part.t list option
100
+
val attachments : t -> Email_body.Part.t list option
101
+
val has_attachment : t -> bool
102
+
val preview : t -> string
103
+
104
+
val jsont : t Jsont.t
105
+
106
+
(** {1 Email Filter Conditions} *)
107
+
108
+
module Filter_condition : sig
109
+
type t = {
110
+
in_mailbox : Jmap_proto.Id.t option;
111
+
in_mailbox_other_than : Jmap_proto.Id.t list option;
112
+
before : Ptime.t option;
113
+
after : Ptime.t option;
114
+
min_size : int64 option;
115
+
max_size : int64 option;
116
+
all_in_thread_have_keyword : string option;
117
+
some_in_thread_have_keyword : string option;
118
+
none_in_thread_have_keyword : string option;
119
+
has_keyword : string option;
120
+
not_keyword : string option;
121
+
has_attachment : bool option;
122
+
text : string option;
123
+
from : string option;
124
+
to_ : string option;
125
+
cc : string option;
126
+
bcc : string option;
127
+
subject : string option;
128
+
body : string option;
129
+
header : (string * string option) option;
130
+
}
131
+
132
+
val jsont : t Jsont.t
133
+
end
134
+
135
+
(** {1 Email/get Arguments} *)
136
+
137
+
(** Extra arguments for Email/get beyond standard /get. *)
138
+
type get_args_extra = {
139
+
body_properties : string list option;
140
+
fetch_text_body_values : bool;
141
+
fetch_html_body_values : bool;
142
+
fetch_all_body_values : bool;
143
+
max_body_value_bytes : int64 option;
144
+
}
145
+
146
+
val get_args_extra_jsont : get_args_extra Jsont.t
+53
proto/mail/email_address.ml
+53
proto/mail/email_address.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
type t = {
7
+
name : string option;
8
+
email : string;
9
+
}
10
+
11
+
let create ?name email = { name; email }
12
+
13
+
let name t = t.name
14
+
let email t = t.email
15
+
16
+
let equal a b = a.email = b.email
17
+
18
+
let pp ppf t =
19
+
match t.name with
20
+
| Some name -> Format.fprintf ppf "%s <%s>" name t.email
21
+
| None -> Format.pp_print_string ppf t.email
22
+
23
+
let make name email = { name; email }
24
+
25
+
let jsont =
26
+
let kind = "EmailAddress" in
27
+
Jsont.Object.map ~kind make
28
+
|> Jsont.Object.opt_mem "name" Jsont.string ~enc:name
29
+
|> Jsont.Object.mem "email" Jsont.string ~enc:email
30
+
|> Jsont.Object.finish
31
+
32
+
module Group = struct
33
+
type address = t
34
+
35
+
type t = {
36
+
name : string option;
37
+
addresses : address list;
38
+
}
39
+
40
+
let create ?name addresses = { name; addresses }
41
+
42
+
let name t = t.name
43
+
let addresses t = t.addresses
44
+
45
+
let make name addresses = { name; addresses }
46
+
47
+
let jsont =
48
+
let kind = "EmailAddressGroup" in
49
+
Jsont.Object.map ~kind make
50
+
|> Jsont.Object.opt_mem "name" Jsont.string ~enc:name
51
+
|> Jsont.Object.mem "addresses" (Jsont.list jsont) ~enc:addresses
52
+
|> Jsont.Object.finish
53
+
end
+49
proto/mail/email_address.mli
+49
proto/mail/email_address.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Email address types as defined in RFC 8621 Section 4.1.2.3 *)
7
+
8
+
(** {1 Email Address} *)
9
+
10
+
(** An email address with optional display name. *)
11
+
type t = {
12
+
name : string option;
13
+
(** The display name (from the phrase in RFC 5322). *)
14
+
email : string;
15
+
(** The email address (addr-spec in RFC 5322). *)
16
+
}
17
+
18
+
val create : ?name:string -> string -> t
19
+
(** [create ?name email] creates an email address. *)
20
+
21
+
val name : t -> string option
22
+
val email : t -> string
23
+
24
+
val equal : t -> t -> bool
25
+
val pp : Format.formatter -> t -> unit
26
+
27
+
val jsont : t Jsont.t
28
+
(** JSON codec for email addresses. *)
29
+
30
+
(** {1 Address Groups} *)
31
+
32
+
(** A group of email addresses with an optional group name. *)
33
+
module Group : sig
34
+
type address = t
35
+
36
+
type t = {
37
+
name : string option;
38
+
(** The group name, or [None] for ungrouped addresses. *)
39
+
addresses : address list;
40
+
(** The addresses in this group. *)
41
+
}
42
+
43
+
val create : ?name:string -> address list -> t
44
+
45
+
val name : t -> string option
46
+
val addresses : t -> address list
47
+
48
+
val jsont : t Jsont.t
49
+
end
+85
proto/mail/email_body.ml
+85
proto/mail/email_body.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
module Value = struct
7
+
type t = {
8
+
value : string;
9
+
is_encoding_problem : bool;
10
+
is_truncated : bool;
11
+
}
12
+
13
+
let value t = t.value
14
+
let is_encoding_problem t = t.is_encoding_problem
15
+
let is_truncated t = t.is_truncated
16
+
17
+
let make value is_encoding_problem is_truncated =
18
+
{ value; is_encoding_problem; is_truncated }
19
+
20
+
let jsont =
21
+
let kind = "EmailBodyValue" in
22
+
Jsont.Object.map ~kind make
23
+
|> Jsont.Object.mem "value" Jsont.string ~enc:value
24
+
|> Jsont.Object.mem "isEncodingProblem" Jsont.bool ~dec_absent:false
25
+
~enc:is_encoding_problem ~enc_omit:(fun b -> not b)
26
+
|> Jsont.Object.mem "isTruncated" Jsont.bool ~dec_absent:false
27
+
~enc:is_truncated ~enc_omit:(fun b -> not b)
28
+
|> Jsont.Object.finish
29
+
end
30
+
31
+
module Part = struct
32
+
type t = {
33
+
part_id : string option;
34
+
blob_id : Jmap_proto.Id.t option;
35
+
size : int64 option;
36
+
headers : Email_header.t list option;
37
+
name : string option;
38
+
type_ : string;
39
+
charset : string option;
40
+
disposition : string option;
41
+
cid : string option;
42
+
language : string list option;
43
+
location : string option;
44
+
sub_parts : t list option;
45
+
}
46
+
47
+
let part_id t = t.part_id
48
+
let blob_id t = t.blob_id
49
+
let size t = t.size
50
+
let headers t = t.headers
51
+
let name t = t.name
52
+
let type_ t = t.type_
53
+
let charset t = t.charset
54
+
let disposition t = t.disposition
55
+
let cid t = t.cid
56
+
let language t = t.language
57
+
let location t = t.location
58
+
let sub_parts t = t.sub_parts
59
+
60
+
let rec jsont =
61
+
let kind = "EmailBodyPart" in
62
+
let make part_id blob_id size headers name type_ charset disposition
63
+
cid language location sub_parts =
64
+
{ part_id; blob_id; size; headers; name; type_; charset; disposition;
65
+
cid; language; location; sub_parts }
66
+
in
67
+
lazy (
68
+
Jsont.Object.map ~kind make
69
+
|> Jsont.Object.opt_mem "partId" Jsont.string ~enc:part_id
70
+
|> Jsont.Object.opt_mem "blobId" Jmap_proto.Id.jsont ~enc:blob_id
71
+
|> Jsont.Object.opt_mem "size" Jmap_proto.Int53.Unsigned.jsont ~enc:size
72
+
|> Jsont.Object.opt_mem "headers" (Jsont.list Email_header.jsont) ~enc:headers
73
+
|> Jsont.Object.opt_mem "name" Jsont.string ~enc:name
74
+
|> Jsont.Object.mem "type" Jsont.string ~enc:type_
75
+
|> Jsont.Object.opt_mem "charset" Jsont.string ~enc:charset
76
+
|> Jsont.Object.opt_mem "disposition" Jsont.string ~enc:disposition
77
+
|> Jsont.Object.opt_mem "cid" Jsont.string ~enc:cid
78
+
|> Jsont.Object.opt_mem "language" (Jsont.list Jsont.string) ~enc:language
79
+
|> Jsont.Object.opt_mem "location" Jsont.string ~enc:location
80
+
|> Jsont.Object.opt_mem "subParts" (Jsont.list (Jsont.rec' jsont)) ~enc:sub_parts
81
+
|> Jsont.Object.finish
82
+
)
83
+
84
+
let jsont = Lazy.force jsont
85
+
end
+73
proto/mail/email_body.mli
+73
proto/mail/email_body.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Email body types as defined in RFC 8621 Section 4.1.4 *)
7
+
8
+
(** {1 Body Value} *)
9
+
10
+
(** Fetched body part content. *)
11
+
module Value : sig
12
+
type t = {
13
+
value : string;
14
+
(** The body part content. *)
15
+
is_encoding_problem : bool;
16
+
(** True if there was a problem decoding the content transfer encoding. *)
17
+
is_truncated : bool;
18
+
(** True if the value was truncated. *)
19
+
}
20
+
21
+
val value : t -> string
22
+
val is_encoding_problem : t -> bool
23
+
val is_truncated : t -> bool
24
+
25
+
val jsont : t Jsont.t
26
+
end
27
+
28
+
(** {1 Body Part} *)
29
+
30
+
(** An email body part structure. *)
31
+
module Part : sig
32
+
type t = {
33
+
part_id : string option;
34
+
(** Identifier for this part, used to fetch content. *)
35
+
blob_id : Jmap_proto.Id.t option;
36
+
(** Blob id if the part can be fetched as a blob. *)
37
+
size : int64 option;
38
+
(** Size in octets. *)
39
+
headers : Email_header.t list option;
40
+
(** Headers specific to this part. *)
41
+
name : string option;
42
+
(** Suggested filename from Content-Disposition. *)
43
+
type_ : string;
44
+
(** MIME type (e.g., "text/plain"). *)
45
+
charset : string option;
46
+
(** Character set parameter. *)
47
+
disposition : string option;
48
+
(** Content-Disposition value. *)
49
+
cid : string option;
50
+
(** Content-ID value. *)
51
+
language : string list option;
52
+
(** Content-Language values. *)
53
+
location : string option;
54
+
(** Content-Location value. *)
55
+
sub_parts : t list option;
56
+
(** Nested parts for multipart types. *)
57
+
}
58
+
59
+
val part_id : t -> string option
60
+
val blob_id : t -> Jmap_proto.Id.t option
61
+
val size : t -> int64 option
62
+
val headers : t -> Email_header.t list option
63
+
val name : t -> string option
64
+
val type_ : t -> string
65
+
val charset : t -> string option
66
+
val disposition : t -> string option
67
+
val cid : t -> string option
68
+
val language : t -> string list option
69
+
val location : t -> string option
70
+
val sub_parts : t -> t list option
71
+
72
+
val jsont : t Jsont.t
73
+
end
+39
proto/mail/email_header.ml
+39
proto/mail/email_header.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
type t = {
7
+
name : string;
8
+
value : string;
9
+
}
10
+
11
+
let create ~name ~value = { name; value }
12
+
13
+
let name t = t.name
14
+
let value t = t.value
15
+
16
+
let make name value = { name; value }
17
+
18
+
let jsont =
19
+
let kind = "EmailHeader" in
20
+
Jsont.Object.map ~kind make
21
+
|> Jsont.Object.mem "name" Jsont.string ~enc:name
22
+
|> Jsont.Object.mem "value" Jsont.string ~enc:value
23
+
|> Jsont.Object.finish
24
+
25
+
(* Header parsed forms - these are used with header:Name:form properties *)
26
+
27
+
let raw_jsont = Jsont.string
28
+
29
+
let text_jsont = Jsont.string
30
+
31
+
let addresses_jsont = Jsont.list Email_address.jsont
32
+
33
+
let grouped_addresses_jsont = Jsont.list Email_address.Group.jsont
34
+
35
+
let message_ids_jsont = Jsont.list Jsont.string
36
+
37
+
let date_jsont = Jmap_proto.Date.Rfc3339.jsont
38
+
39
+
let urls_jsont = Jsont.list Jsont.string
+49
proto/mail/email_header.mli
+49
proto/mail/email_header.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Email header types as defined in RFC 8621 Section 4.1.2 *)
7
+
8
+
(** {1 Raw Headers} *)
9
+
10
+
(** A raw email header name-value pair. *)
11
+
type t = {
12
+
name : string;
13
+
(** The header field name. *)
14
+
value : string;
15
+
(** The raw header field value. *)
16
+
}
17
+
18
+
val create : name:string -> value:string -> t
19
+
20
+
val name : t -> string
21
+
val value : t -> string
22
+
23
+
val jsont : t Jsont.t
24
+
25
+
(** {1 Header Parsed Forms}
26
+
27
+
RFC 8621 defines several parsed forms for headers.
28
+
These can be requested via the header:Name:form properties. *)
29
+
30
+
(** The raw form - header value as-is. *)
31
+
val raw_jsont : string Jsont.t
32
+
33
+
(** The text form - decoded and unfolded value. *)
34
+
val text_jsont : string Jsont.t
35
+
36
+
(** The addresses form - list of email addresses. *)
37
+
val addresses_jsont : Email_address.t list Jsont.t
38
+
39
+
(** The grouped addresses form - addresses with group info. *)
40
+
val grouped_addresses_jsont : Email_address.Group.t list Jsont.t
41
+
42
+
(** The message IDs form - list of message-id strings. *)
43
+
val message_ids_jsont : string list Jsont.t
44
+
45
+
(** The date form - parsed RFC 3339 date. *)
46
+
val date_jsont : Ptime.t Jsont.t
47
+
48
+
(** The URLs form - list of URL strings. *)
49
+
val urls_jsont : string list Jsont.t
+40
proto/mail/identity.ml
+40
proto/mail/identity.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
type t = {
7
+
id : Jmap_proto.Id.t;
8
+
name : string;
9
+
email : string;
10
+
reply_to : Email_address.t list option;
11
+
bcc : Email_address.t list option;
12
+
text_signature : string;
13
+
html_signature : string;
14
+
may_delete : bool;
15
+
}
16
+
17
+
let id t = t.id
18
+
let name t = t.name
19
+
let email t = t.email
20
+
let reply_to t = t.reply_to
21
+
let bcc t = t.bcc
22
+
let text_signature t = t.text_signature
23
+
let html_signature t = t.html_signature
24
+
let may_delete t = t.may_delete
25
+
26
+
let make id name email reply_to bcc text_signature html_signature may_delete =
27
+
{ id; name; email; reply_to; bcc; text_signature; html_signature; may_delete }
28
+
29
+
let jsont =
30
+
let kind = "Identity" in
31
+
Jsont.Object.map ~kind make
32
+
|> Jsont.Object.mem "id" Jmap_proto.Id.jsont ~enc:id
33
+
|> Jsont.Object.mem "name" Jsont.string ~dec_absent:"" ~enc:name
34
+
|> Jsont.Object.mem "email" Jsont.string ~enc:email
35
+
|> Jsont.Object.opt_mem "replyTo" (Jsont.list Email_address.jsont) ~enc:reply_to
36
+
|> Jsont.Object.opt_mem "bcc" (Jsont.list Email_address.jsont) ~enc:bcc
37
+
|> Jsont.Object.mem "textSignature" Jsont.string ~dec_absent:"" ~enc:text_signature
38
+
|> Jsont.Object.mem "htmlSignature" Jsont.string ~dec_absent:"" ~enc:html_signature
39
+
|> Jsont.Object.mem "mayDelete" Jsont.bool ~enc:may_delete
40
+
|> Jsont.Object.finish
+36
proto/mail/identity.mli
+36
proto/mail/identity.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Identity type as defined in RFC 8621 Section 6 *)
7
+
8
+
type t = {
9
+
id : Jmap_proto.Id.t;
10
+
(** Server-assigned identity id. *)
11
+
name : string;
12
+
(** Display name for sent emails. *)
13
+
email : string;
14
+
(** The email address to use. *)
15
+
reply_to : Email_address.t list option;
16
+
(** Default Reply-To addresses. *)
17
+
bcc : Email_address.t list option;
18
+
(** Default BCC addresses. *)
19
+
text_signature : string;
20
+
(** Plain text signature. *)
21
+
html_signature : string;
22
+
(** HTML signature. *)
23
+
may_delete : bool;
24
+
(** Whether the user may delete this identity. *)
25
+
}
26
+
27
+
val id : t -> Jmap_proto.Id.t
28
+
val name : t -> string
29
+
val email : t -> string
30
+
val reply_to : t -> Email_address.t list option
31
+
val bcc : t -> Email_address.t list option
32
+
val text_signature : t -> string
33
+
val html_signature : t -> string
34
+
val may_delete : t -> bool
35
+
36
+
val jsont : t Jsont.t
+20
proto/mail/jmap_mail.ml
+20
proto/mail/jmap_mail.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** JMAP Mail Types (RFC 8621)
7
+
8
+
This module re-exports all JMAP mail protocol types. *)
9
+
10
+
module Email_address = Email_address
11
+
module Email_header = Email_header
12
+
module Email_body = Email_body
13
+
module Mailbox = Mailbox
14
+
module Thread = Thread
15
+
module Email = Email
16
+
module Search_snippet = Search_snippet
17
+
module Identity = Identity
18
+
module Submission = Submission
19
+
module Vacation = Vacation
20
+
module Mail_filter = Mail_filter
+16
proto/mail/mail_filter.ml
+16
proto/mail/mail_filter.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
type email_filter = Email.Filter_condition.t Jmap_proto.Filter.filter
7
+
8
+
let email_filter_jsont = Jmap_proto.Filter.filter_jsont Email.Filter_condition.jsont
9
+
10
+
type mailbox_filter = Mailbox.Filter_condition.t Jmap_proto.Filter.filter
11
+
12
+
let mailbox_filter_jsont = Jmap_proto.Filter.filter_jsont Mailbox.Filter_condition.jsont
13
+
14
+
type submission_filter = Submission.Filter_condition.t Jmap_proto.Filter.filter
15
+
16
+
let submission_filter_jsont = Jmap_proto.Filter.filter_jsont Submission.Filter_condition.jsont
+21
proto/mail/mail_filter.mli
+21
proto/mail/mail_filter.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Mail-specific filter types *)
7
+
8
+
(** Email filter with Email-specific conditions. *)
9
+
type email_filter = Email.Filter_condition.t Jmap_proto.Filter.filter
10
+
11
+
val email_filter_jsont : email_filter Jsont.t
12
+
13
+
(** Mailbox filter with Mailbox-specific conditions. *)
14
+
type mailbox_filter = Mailbox.Filter_condition.t Jmap_proto.Filter.filter
15
+
16
+
val mailbox_filter_jsont : mailbox_filter Jsont.t
17
+
18
+
(** EmailSubmission filter with Submission-specific conditions. *)
19
+
type submission_filter = Submission.Filter_condition.t Jmap_proto.Filter.filter
20
+
21
+
val submission_filter_jsont : submission_filter Jsont.t
+165
proto/mail/mailbox.ml
+165
proto/mail/mailbox.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
module Rights = struct
7
+
type t = {
8
+
may_read_items : bool;
9
+
may_add_items : bool;
10
+
may_remove_items : bool;
11
+
may_set_seen : bool;
12
+
may_set_keywords : bool;
13
+
may_create_child : bool;
14
+
may_rename : bool;
15
+
may_delete : bool;
16
+
may_submit : bool;
17
+
}
18
+
19
+
let may_read_items t = t.may_read_items
20
+
let may_add_items t = t.may_add_items
21
+
let may_remove_items t = t.may_remove_items
22
+
let may_set_seen t = t.may_set_seen
23
+
let may_set_keywords t = t.may_set_keywords
24
+
let may_create_child t = t.may_create_child
25
+
let may_rename t = t.may_rename
26
+
let may_delete t = t.may_delete
27
+
let may_submit t = t.may_submit
28
+
29
+
let make may_read_items may_add_items may_remove_items may_set_seen
30
+
may_set_keywords may_create_child may_rename may_delete may_submit =
31
+
{ may_read_items; may_add_items; may_remove_items; may_set_seen;
32
+
may_set_keywords; may_create_child; may_rename; may_delete; may_submit }
33
+
34
+
let jsont =
35
+
let kind = "MailboxRights" in
36
+
Jsont.Object.map ~kind make
37
+
|> Jsont.Object.mem "mayReadItems" Jsont.bool ~enc:may_read_items
38
+
|> Jsont.Object.mem "mayAddItems" Jsont.bool ~enc:may_add_items
39
+
|> Jsont.Object.mem "mayRemoveItems" Jsont.bool ~enc:may_remove_items
40
+
|> Jsont.Object.mem "maySetSeen" Jsont.bool ~enc:may_set_seen
41
+
|> Jsont.Object.mem "maySetKeywords" Jsont.bool ~enc:may_set_keywords
42
+
|> Jsont.Object.mem "mayCreateChild" Jsont.bool ~enc:may_create_child
43
+
|> Jsont.Object.mem "mayRename" Jsont.bool ~enc:may_rename
44
+
|> Jsont.Object.mem "mayDelete" Jsont.bool ~enc:may_delete
45
+
|> Jsont.Object.mem "maySubmit" Jsont.bool ~enc:may_submit
46
+
|> Jsont.Object.finish
47
+
end
48
+
49
+
type role =
50
+
| All
51
+
| Archive
52
+
| Drafts
53
+
| Flagged
54
+
| Important
55
+
| Inbox
56
+
| Junk
57
+
| Sent
58
+
| Subscribed
59
+
| Trash
60
+
| Other of string
61
+
62
+
let role_to_string = function
63
+
| All -> "all"
64
+
| Archive -> "archive"
65
+
| Drafts -> "drafts"
66
+
| Flagged -> "flagged"
67
+
| Important -> "important"
68
+
| Inbox -> "inbox"
69
+
| Junk -> "junk"
70
+
| Sent -> "sent"
71
+
| Subscribed -> "subscribed"
72
+
| Trash -> "trash"
73
+
| Other s -> s
74
+
75
+
let role_of_string = function
76
+
| "all" -> All
77
+
| "archive" -> Archive
78
+
| "drafts" -> Drafts
79
+
| "flagged" -> Flagged
80
+
| "important" -> Important
81
+
| "inbox" -> Inbox
82
+
| "junk" -> Junk
83
+
| "sent" -> Sent
84
+
| "subscribed" -> Subscribed
85
+
| "trash" -> Trash
86
+
| s -> Other s
87
+
88
+
let role_jsont =
89
+
Jsont.map ~kind:"MailboxRole"
90
+
~dec:(fun s -> role_of_string s)
91
+
~enc:role_to_string
92
+
Jsont.string
93
+
94
+
type t = {
95
+
id : Jmap_proto.Id.t;
96
+
name : string;
97
+
parent_id : Jmap_proto.Id.t option;
98
+
role : role option;
99
+
sort_order : int64;
100
+
total_emails : int64;
101
+
unread_emails : int64;
102
+
total_threads : int64;
103
+
unread_threads : int64;
104
+
my_rights : Rights.t;
105
+
is_subscribed : bool;
106
+
}
107
+
108
+
let id t = t.id
109
+
let name t = t.name
110
+
let parent_id t = t.parent_id
111
+
let role t = t.role
112
+
let sort_order t = t.sort_order
113
+
let total_emails t = t.total_emails
114
+
let unread_emails t = t.unread_emails
115
+
let total_threads t = t.total_threads
116
+
let unread_threads t = t.unread_threads
117
+
let my_rights t = t.my_rights
118
+
let is_subscribed t = t.is_subscribed
119
+
120
+
let make id name parent_id role sort_order total_emails unread_emails
121
+
total_threads unread_threads my_rights is_subscribed =
122
+
{ id; name; parent_id; role; sort_order; total_emails; unread_emails;
123
+
total_threads; unread_threads; my_rights; is_subscribed }
124
+
125
+
let jsont =
126
+
let kind = "Mailbox" in
127
+
Jsont.Object.map ~kind make
128
+
|> Jsont.Object.mem "id" Jmap_proto.Id.jsont ~enc:id
129
+
|> Jsont.Object.mem "name" Jsont.string ~enc:name
130
+
|> Jsont.Object.opt_mem "parentId" Jmap_proto.Id.jsont ~enc:parent_id
131
+
|> Jsont.Object.opt_mem "role" role_jsont ~enc:role
132
+
|> Jsont.Object.mem "sortOrder" Jmap_proto.Int53.Unsigned.jsont ~dec_absent:0L ~enc:sort_order
133
+
|> Jsont.Object.mem "totalEmails" Jmap_proto.Int53.Unsigned.jsont ~enc:total_emails
134
+
|> Jsont.Object.mem "unreadEmails" Jmap_proto.Int53.Unsigned.jsont ~enc:unread_emails
135
+
|> Jsont.Object.mem "totalThreads" Jmap_proto.Int53.Unsigned.jsont ~enc:total_threads
136
+
|> Jsont.Object.mem "unreadThreads" Jmap_proto.Int53.Unsigned.jsont ~enc:unread_threads
137
+
|> Jsont.Object.mem "myRights" Rights.jsont ~enc:my_rights
138
+
|> Jsont.Object.mem "isSubscribed" Jsont.bool ~enc:is_subscribed
139
+
|> Jsont.Object.finish
140
+
141
+
module Filter_condition = struct
142
+
type t = {
143
+
parent_id : Jmap_proto.Id.t option option;
144
+
name : string option;
145
+
role : role option option;
146
+
has_any_role : bool option;
147
+
is_subscribed : bool option;
148
+
}
149
+
150
+
let make parent_id name role has_any_role is_subscribed =
151
+
{ parent_id; name; role; has_any_role; is_subscribed }
152
+
153
+
let jsont =
154
+
let kind = "MailboxFilterCondition" in
155
+
(* parentId can be null (meaning top-level) or an id *)
156
+
let nullable_id = Jsont.(some Jmap_proto.Id.jsont) in
157
+
let nullable_role = Jsont.(some role_jsont) in
158
+
Jsont.Object.map ~kind make
159
+
|> Jsont.Object.opt_mem "parentId" nullable_id ~enc:(fun f -> f.parent_id)
160
+
|> Jsont.Object.opt_mem "name" Jsont.string ~enc:(fun f -> f.name)
161
+
|> Jsont.Object.opt_mem "role" nullable_role ~enc:(fun f -> f.role)
162
+
|> Jsont.Object.opt_mem "hasAnyRole" Jsont.bool ~enc:(fun f -> f.has_any_role)
163
+
|> Jsont.Object.opt_mem "isSubscribed" Jsont.bool ~enc:(fun f -> f.is_subscribed)
164
+
|> Jsont.Object.finish
165
+
end
+116
proto/mail/mailbox.mli
+116
proto/mail/mailbox.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Mailbox type as defined in RFC 8621 Section 2 *)
7
+
8
+
(** {1 Mailbox Rights} *)
9
+
10
+
(** Rights the user has on a mailbox. *)
11
+
module Rights : sig
12
+
type t = {
13
+
may_read_items : bool;
14
+
may_add_items : bool;
15
+
may_remove_items : bool;
16
+
may_set_seen : bool;
17
+
may_set_keywords : bool;
18
+
may_create_child : bool;
19
+
may_rename : bool;
20
+
may_delete : bool;
21
+
may_submit : bool;
22
+
}
23
+
24
+
val may_read_items : t -> bool
25
+
val may_add_items : t -> bool
26
+
val may_remove_items : t -> bool
27
+
val may_set_seen : t -> bool
28
+
val may_set_keywords : t -> bool
29
+
val may_create_child : t -> bool
30
+
val may_rename : t -> bool
31
+
val may_delete : t -> bool
32
+
val may_submit : t -> bool
33
+
34
+
val jsont : t Jsont.t
35
+
end
36
+
37
+
(** {1 Standard Roles} *)
38
+
39
+
(** Standard mailbox roles per RFC 8621 Section 2. *)
40
+
type role =
41
+
| All
42
+
| Archive
43
+
| Drafts
44
+
| Flagged
45
+
| Important
46
+
| Inbox
47
+
| Junk
48
+
| Sent
49
+
| Subscribed
50
+
| Trash
51
+
| Other of string
52
+
53
+
val role_to_string : role -> string
54
+
val role_of_string : string -> role
55
+
val role_jsont : role Jsont.t
56
+
57
+
(** {1 Mailbox} *)
58
+
59
+
type t = {
60
+
id : Jmap_proto.Id.t;
61
+
(** Server-assigned mailbox id. *)
62
+
name : string;
63
+
(** User-visible name (UTF-8). *)
64
+
parent_id : Jmap_proto.Id.t option;
65
+
(** Id of parent mailbox, or [None] for root. *)
66
+
role : role option;
67
+
(** Standard role, if any. *)
68
+
sort_order : int64;
69
+
(** Sort order hint (lower = displayed first). *)
70
+
total_emails : int64;
71
+
(** Total number of emails in mailbox. *)
72
+
unread_emails : int64;
73
+
(** Number of unread emails. *)
74
+
total_threads : int64;
75
+
(** Total number of threads. *)
76
+
unread_threads : int64;
77
+
(** Number of threads with unread emails. *)
78
+
my_rights : Rights.t;
79
+
(** User's rights on this mailbox. *)
80
+
is_subscribed : bool;
81
+
(** Whether user is subscribed to this mailbox. *)
82
+
}
83
+
84
+
val id : t -> Jmap_proto.Id.t
85
+
val name : t -> string
86
+
val parent_id : t -> Jmap_proto.Id.t option
87
+
val role : t -> role option
88
+
val sort_order : t -> int64
89
+
val total_emails : t -> int64
90
+
val unread_emails : t -> int64
91
+
val total_threads : t -> int64
92
+
val unread_threads : t -> int64
93
+
val my_rights : t -> Rights.t
94
+
val is_subscribed : t -> bool
95
+
96
+
val jsont : t Jsont.t
97
+
98
+
(** {1 Mailbox Filter Conditions} *)
99
+
100
+
(** Filter conditions for Mailbox/query. *)
101
+
module Filter_condition : sig
102
+
type t = {
103
+
parent_id : Jmap_proto.Id.t option option;
104
+
(** Filter by parent. [Some None] = top-level only. *)
105
+
name : string option;
106
+
(** Filter by exact name match. *)
107
+
role : role option option;
108
+
(** Filter by role. [Some None] = no role. *)
109
+
has_any_role : bool option;
110
+
(** Filter by whether mailbox has any role. *)
111
+
is_subscribed : bool option;
112
+
(** Filter by subscription status. *)
113
+
}
114
+
115
+
val jsont : t Jsont.t
116
+
end
+24
proto/mail/search_snippet.ml
+24
proto/mail/search_snippet.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
type t = {
7
+
email_id : Jmap_proto.Id.t;
8
+
subject : string option;
9
+
preview : string option;
10
+
}
11
+
12
+
let email_id t = t.email_id
13
+
let subject t = t.subject
14
+
let preview t = t.preview
15
+
16
+
let make email_id subject preview = { email_id; subject; preview }
17
+
18
+
let jsont =
19
+
let kind = "SearchSnippet" in
20
+
Jsont.Object.map ~kind make
21
+
|> Jsont.Object.mem "emailId" Jmap_proto.Id.jsont ~enc:email_id
22
+
|> Jsont.Object.opt_mem "subject" Jsont.string ~enc:subject
23
+
|> Jsont.Object.opt_mem "preview" Jsont.string ~enc:preview
24
+
|> Jsont.Object.finish
+21
proto/mail/search_snippet.mli
+21
proto/mail/search_snippet.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** SearchSnippet type as defined in RFC 8621 Section 5 *)
7
+
8
+
type t = {
9
+
email_id : Jmap_proto.Id.t;
10
+
(** The email this snippet is for. *)
11
+
subject : string option;
12
+
(** HTML snippet of matching subject text. *)
13
+
preview : string option;
14
+
(** HTML snippet of matching body text. *)
15
+
}
16
+
17
+
val email_id : t -> Jmap_proto.Id.t
18
+
val subject : t -> string option
19
+
val preview : t -> string option
20
+
21
+
val jsont : t Jsont.t
+183
proto/mail/submission.ml
+183
proto/mail/submission.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
module Address = struct
7
+
type t = {
8
+
email : string;
9
+
parameters : (string * string) list option;
10
+
}
11
+
12
+
let email t = t.email
13
+
let parameters t = t.parameters
14
+
15
+
let make email parameters = { email; parameters }
16
+
17
+
let jsont =
18
+
let kind = "EmailSubmission Address" in
19
+
Jsont.Object.map ~kind make
20
+
|> Jsont.Object.mem "email" Jsont.string ~enc:email
21
+
|> Jsont.Object.opt_mem "parameters" (Jmap_proto.Json_map.of_string Jsont.string) ~enc:parameters
22
+
|> Jsont.Object.finish
23
+
end
24
+
25
+
module Envelope = struct
26
+
type t = {
27
+
mail_from : Address.t;
28
+
rcpt_to : Address.t list;
29
+
}
30
+
31
+
let mail_from t = t.mail_from
32
+
let rcpt_to t = t.rcpt_to
33
+
34
+
let make mail_from rcpt_to = { mail_from; rcpt_to }
35
+
36
+
let jsont =
37
+
let kind = "Envelope" in
38
+
Jsont.Object.map ~kind make
39
+
|> Jsont.Object.mem "mailFrom" Address.jsont ~enc:mail_from
40
+
|> Jsont.Object.mem "rcptTo" (Jsont.list Address.jsont) ~enc:rcpt_to
41
+
|> Jsont.Object.finish
42
+
end
43
+
44
+
module Delivery_status = struct
45
+
type delivered = Queued | Yes | No | Unknown
46
+
47
+
let delivered_to_string = function
48
+
| Queued -> "queued"
49
+
| Yes -> "yes"
50
+
| No -> "no"
51
+
| Unknown -> "unknown"
52
+
53
+
let delivered_of_string = function
54
+
| "queued" -> Queued
55
+
| "yes" -> Yes
56
+
| "no" -> No
57
+
| _ -> Unknown
58
+
59
+
let delivered_jsont =
60
+
Jsont.map ~kind:"DeliveryStatus.delivered"
61
+
~dec:delivered_of_string ~enc:delivered_to_string Jsont.string
62
+
63
+
type displayed = Unknown | Yes
64
+
65
+
let displayed_to_string = function
66
+
| Unknown -> "unknown"
67
+
| Yes -> "yes"
68
+
69
+
let displayed_of_string = function
70
+
| "yes" -> Yes
71
+
| _ -> Unknown
72
+
73
+
let displayed_jsont =
74
+
Jsont.map ~kind:"DeliveryStatus.displayed"
75
+
~dec:displayed_of_string ~enc:displayed_to_string Jsont.string
76
+
77
+
type t = {
78
+
smtp_reply : string;
79
+
delivered : delivered;
80
+
displayed : displayed;
81
+
}
82
+
83
+
let smtp_reply t = t.smtp_reply
84
+
let delivered t = t.delivered
85
+
let displayed t = t.displayed
86
+
87
+
let make smtp_reply delivered displayed =
88
+
{ smtp_reply; delivered; displayed }
89
+
90
+
let jsont =
91
+
let kind = "DeliveryStatus" in
92
+
Jsont.Object.map ~kind make
93
+
|> Jsont.Object.mem "smtpReply" Jsont.string ~enc:smtp_reply
94
+
|> Jsont.Object.mem "delivered" delivered_jsont ~enc:delivered
95
+
|> Jsont.Object.mem "displayed" displayed_jsont ~enc:displayed
96
+
|> Jsont.Object.finish
97
+
end
98
+
99
+
type undo_status = Pending | Final | Canceled
100
+
101
+
let undo_status_to_string = function
102
+
| Pending -> "pending"
103
+
| Final -> "final"
104
+
| Canceled -> "canceled"
105
+
106
+
let undo_status_of_string = function
107
+
| "pending" -> Pending
108
+
| "final" -> Final
109
+
| "canceled" -> Canceled
110
+
| s -> Jsont.Error.msgf Jsont.Meta.none "Unknown undo status: %s" s
111
+
112
+
let undo_status_jsont =
113
+
Jsont.map ~kind:"UndoStatus"
114
+
~dec:undo_status_of_string ~enc:undo_status_to_string Jsont.string
115
+
116
+
type t = {
117
+
id : Jmap_proto.Id.t;
118
+
identity_id : Jmap_proto.Id.t;
119
+
email_id : Jmap_proto.Id.t;
120
+
thread_id : Jmap_proto.Id.t;
121
+
envelope : Envelope.t option;
122
+
send_at : Ptime.t;
123
+
undo_status : undo_status;
124
+
delivery_status : (string * Delivery_status.t) list option;
125
+
dsn_blob_ids : Jmap_proto.Id.t list;
126
+
mdn_blob_ids : Jmap_proto.Id.t list;
127
+
}
128
+
129
+
let id t = t.id
130
+
let identity_id t = t.identity_id
131
+
let email_id t = t.email_id
132
+
let thread_id t = t.thread_id
133
+
let envelope t = t.envelope
134
+
let send_at t = t.send_at
135
+
let undo_status t = t.undo_status
136
+
let delivery_status t = t.delivery_status
137
+
let dsn_blob_ids t = t.dsn_blob_ids
138
+
let mdn_blob_ids t = t.mdn_blob_ids
139
+
140
+
let make id identity_id email_id thread_id envelope send_at undo_status
141
+
delivery_status dsn_blob_ids mdn_blob_ids =
142
+
{ id; identity_id; email_id; thread_id; envelope; send_at; undo_status;
143
+
delivery_status; dsn_blob_ids; mdn_blob_ids }
144
+
145
+
let jsont =
146
+
let kind = "EmailSubmission" in
147
+
Jsont.Object.map ~kind make
148
+
|> Jsont.Object.mem "id" Jmap_proto.Id.jsont ~enc:id
149
+
|> Jsont.Object.mem "identityId" Jmap_proto.Id.jsont ~enc:identity_id
150
+
|> Jsont.Object.mem "emailId" Jmap_proto.Id.jsont ~enc:email_id
151
+
|> Jsont.Object.mem "threadId" Jmap_proto.Id.jsont ~enc:thread_id
152
+
|> Jsont.Object.opt_mem "envelope" Envelope.jsont ~enc:envelope
153
+
|> Jsont.Object.mem "sendAt" Jmap_proto.Date.Utc.jsont ~enc:send_at
154
+
|> Jsont.Object.mem "undoStatus" undo_status_jsont ~enc:undo_status
155
+
|> Jsont.Object.opt_mem "deliveryStatus" (Jmap_proto.Json_map.of_string Delivery_status.jsont) ~enc:delivery_status
156
+
|> Jsont.Object.mem "dsnBlobIds" (Jsont.list Jmap_proto.Id.jsont) ~dec_absent:[] ~enc:dsn_blob_ids
157
+
|> Jsont.Object.mem "mdnBlobIds" (Jsont.list Jmap_proto.Id.jsont) ~dec_absent:[] ~enc:mdn_blob_ids
158
+
|> Jsont.Object.finish
159
+
160
+
module Filter_condition = struct
161
+
type t = {
162
+
identity_ids : Jmap_proto.Id.t list option;
163
+
email_ids : Jmap_proto.Id.t list option;
164
+
thread_ids : Jmap_proto.Id.t list option;
165
+
undo_status : undo_status option;
166
+
before : Ptime.t option;
167
+
after : Ptime.t option;
168
+
}
169
+
170
+
let make identity_ids email_ids thread_ids undo_status before after =
171
+
{ identity_ids; email_ids; thread_ids; undo_status; before; after }
172
+
173
+
let jsont =
174
+
let kind = "EmailSubmissionFilterCondition" in
175
+
Jsont.Object.map ~kind make
176
+
|> Jsont.Object.opt_mem "identityIds" (Jsont.list Jmap_proto.Id.jsont) ~enc:(fun f -> f.identity_ids)
177
+
|> Jsont.Object.opt_mem "emailIds" (Jsont.list Jmap_proto.Id.jsont) ~enc:(fun f -> f.email_ids)
178
+
|> Jsont.Object.opt_mem "threadIds" (Jsont.list Jmap_proto.Id.jsont) ~enc:(fun f -> f.thread_ids)
179
+
|> Jsont.Object.opt_mem "undoStatus" undo_status_jsont ~enc:(fun f -> f.undo_status)
180
+
|> Jsont.Object.opt_mem "before" Jmap_proto.Date.Utc.jsont ~enc:(fun f -> f.before)
181
+
|> Jsont.Object.opt_mem "after" Jmap_proto.Date.Utc.jsont ~enc:(fun f -> f.after)
182
+
|> Jsont.Object.finish
183
+
end
+132
proto/mail/submission.mli
+132
proto/mail/submission.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** EmailSubmission type as defined in RFC 8621 Section 7 *)
7
+
8
+
(** {1 Address} *)
9
+
10
+
(** An address with optional SMTP parameters. *)
11
+
module Address : sig
12
+
type t = {
13
+
email : string;
14
+
(** The email address. *)
15
+
parameters : (string * string) list option;
16
+
(** Optional SMTP parameters. *)
17
+
}
18
+
19
+
val email : t -> string
20
+
val parameters : t -> (string * string) list option
21
+
22
+
val jsont : t Jsont.t
23
+
end
24
+
25
+
(** {1 Envelope} *)
26
+
27
+
(** SMTP envelope. *)
28
+
module Envelope : sig
29
+
type t = {
30
+
mail_from : Address.t;
31
+
(** MAIL FROM address. *)
32
+
rcpt_to : Address.t list;
33
+
(** RCPT TO addresses. *)
34
+
}
35
+
36
+
val mail_from : t -> Address.t
37
+
val rcpt_to : t -> Address.t list
38
+
39
+
val jsont : t Jsont.t
40
+
end
41
+
42
+
(** {1 Delivery Status} *)
43
+
44
+
(** Status of delivery to a recipient. *)
45
+
module Delivery_status : sig
46
+
type delivered =
47
+
| Queued
48
+
| Yes
49
+
| No
50
+
| Unknown
51
+
52
+
type displayed =
53
+
| Unknown
54
+
| Yes
55
+
56
+
type t = {
57
+
smtp_reply : string;
58
+
(** The SMTP reply string. *)
59
+
delivered : delivered;
60
+
(** Delivery status. *)
61
+
displayed : displayed;
62
+
(** MDN display status. *)
63
+
}
64
+
65
+
val smtp_reply : t -> string
66
+
val delivered : t -> delivered
67
+
val displayed : t -> displayed
68
+
69
+
val jsont : t Jsont.t
70
+
end
71
+
72
+
(** {1 Undo Status} *)
73
+
74
+
type undo_status =
75
+
| Pending
76
+
| Final
77
+
| Canceled
78
+
79
+
val undo_status_jsont : undo_status Jsont.t
80
+
81
+
(** {1 EmailSubmission} *)
82
+
83
+
type t = {
84
+
id : Jmap_proto.Id.t;
85
+
(** Server-assigned submission id. *)
86
+
identity_id : Jmap_proto.Id.t;
87
+
(** The identity used to send. *)
88
+
email_id : Jmap_proto.Id.t;
89
+
(** The email that was submitted. *)
90
+
thread_id : Jmap_proto.Id.t;
91
+
(** The thread of the submitted email. *)
92
+
envelope : Envelope.t option;
93
+
(** The envelope used, if different from email headers. *)
94
+
send_at : Ptime.t;
95
+
(** When the email was/will be sent. *)
96
+
undo_status : undo_status;
97
+
(** Whether sending can be undone. *)
98
+
delivery_status : (string * Delivery_status.t) list option;
99
+
(** Delivery status per recipient. *)
100
+
dsn_blob_ids : Jmap_proto.Id.t list;
101
+
(** Blob ids of received DSN messages. *)
102
+
mdn_blob_ids : Jmap_proto.Id.t list;
103
+
(** Blob ids of received MDN messages. *)
104
+
}
105
+
106
+
val id : t -> Jmap_proto.Id.t
107
+
val identity_id : t -> Jmap_proto.Id.t
108
+
val email_id : t -> Jmap_proto.Id.t
109
+
val thread_id : t -> Jmap_proto.Id.t
110
+
val envelope : t -> Envelope.t option
111
+
val send_at : t -> Ptime.t
112
+
val undo_status : t -> undo_status
113
+
val delivery_status : t -> (string * Delivery_status.t) list option
114
+
val dsn_blob_ids : t -> Jmap_proto.Id.t list
115
+
val mdn_blob_ids : t -> Jmap_proto.Id.t list
116
+
117
+
val jsont : t Jsont.t
118
+
119
+
(** {1 Filter Conditions} *)
120
+
121
+
module Filter_condition : sig
122
+
type t = {
123
+
identity_ids : Jmap_proto.Id.t list option;
124
+
email_ids : Jmap_proto.Id.t list option;
125
+
thread_ids : Jmap_proto.Id.t list option;
126
+
undo_status : undo_status option;
127
+
before : Ptime.t option;
128
+
after : Ptime.t option;
129
+
}
130
+
131
+
val jsont : t Jsont.t
132
+
end
+21
proto/mail/thread.ml
+21
proto/mail/thread.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
type t = {
7
+
id : Jmap_proto.Id.t;
8
+
email_ids : Jmap_proto.Id.t list;
9
+
}
10
+
11
+
let id t = t.id
12
+
let email_ids t = t.email_ids
13
+
14
+
let make id email_ids = { id; email_ids }
15
+
16
+
let jsont =
17
+
let kind = "Thread" in
18
+
Jsont.Object.map ~kind make
19
+
|> Jsont.Object.mem "id" Jmap_proto.Id.jsont ~enc:id
20
+
|> Jsont.Object.mem "emailIds" (Jsont.list Jmap_proto.Id.jsont) ~enc:email_ids
21
+
|> Jsont.Object.finish
+18
proto/mail/thread.mli
+18
proto/mail/thread.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Thread type as defined in RFC 8621 Section 3 *)
7
+
8
+
type t = {
9
+
id : Jmap_proto.Id.t;
10
+
(** Server-assigned thread id. *)
11
+
email_ids : Jmap_proto.Id.t list;
12
+
(** Ids of emails in this thread, in date order. *)
13
+
}
14
+
15
+
val id : t -> Jmap_proto.Id.t
16
+
val email_ids : t -> Jmap_proto.Id.t list
17
+
18
+
val jsont : t Jsont.t
+39
proto/mail/vacation.ml
+39
proto/mail/vacation.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
type t = {
7
+
id : Jmap_proto.Id.t;
8
+
is_enabled : bool;
9
+
from_date : Ptime.t option;
10
+
to_date : Ptime.t option;
11
+
subject : string option;
12
+
text_body : string option;
13
+
html_body : string option;
14
+
}
15
+
16
+
let id t = t.id
17
+
let is_enabled t = t.is_enabled
18
+
let from_date t = t.from_date
19
+
let to_date t = t.to_date
20
+
let subject t = t.subject
21
+
let text_body t = t.text_body
22
+
let html_body t = t.html_body
23
+
24
+
let singleton_id = Jmap_proto.Id.of_string_exn "singleton"
25
+
26
+
let make id is_enabled from_date to_date subject text_body html_body =
27
+
{ id; is_enabled; from_date; to_date; subject; text_body; html_body }
28
+
29
+
let jsont =
30
+
let kind = "VacationResponse" in
31
+
Jsont.Object.map ~kind make
32
+
|> Jsont.Object.mem "id" Jmap_proto.Id.jsont ~enc:id
33
+
|> Jsont.Object.mem "isEnabled" Jsont.bool ~enc:is_enabled
34
+
|> Jsont.Object.opt_mem "fromDate" Jmap_proto.Date.Utc.jsont ~enc:from_date
35
+
|> Jsont.Object.opt_mem "toDate" Jmap_proto.Date.Utc.jsont ~enc:to_date
36
+
|> Jsont.Object.opt_mem "subject" Jsont.string ~enc:subject
37
+
|> Jsont.Object.opt_mem "textBody" Jsont.string ~enc:text_body
38
+
|> Jsont.Object.opt_mem "htmlBody" Jsont.string ~enc:html_body
39
+
|> Jsont.Object.finish
+36
proto/mail/vacation.mli
+36
proto/mail/vacation.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** VacationResponse type as defined in RFC 8621 Section 8 *)
7
+
8
+
type t = {
9
+
id : Jmap_proto.Id.t;
10
+
(** Always "singleton" - there is only one vacation response. *)
11
+
is_enabled : bool;
12
+
(** Whether the vacation response is active. *)
13
+
from_date : Ptime.t option;
14
+
(** When to start sending responses. *)
15
+
to_date : Ptime.t option;
16
+
(** When to stop sending responses. *)
17
+
subject : string option;
18
+
(** Subject for the auto-reply. *)
19
+
text_body : string option;
20
+
(** Plain text body. *)
21
+
html_body : string option;
22
+
(** HTML body. *)
23
+
}
24
+
25
+
val id : t -> Jmap_proto.Id.t
26
+
val is_enabled : t -> bool
27
+
val from_date : t -> Ptime.t option
28
+
val to_date : t -> Ptime.t option
29
+
val subject : t -> string option
30
+
val text_body : t -> string option
31
+
val html_body : t -> string option
32
+
33
+
val jsont : t Jsont.t
34
+
35
+
(** The singleton id for VacationResponse. *)
36
+
val singleton_id : Jmap_proto.Id.t
+316
proto/method_.ml
+316
proto/method_.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(* Foo/get *)
7
+
8
+
type get_args = {
9
+
account_id : Id.t;
10
+
ids : Id.t list option;
11
+
properties : string list option;
12
+
}
13
+
14
+
let get_args ~account_id ?ids ?properties () =
15
+
{ account_id; ids; properties }
16
+
17
+
let get_args_make account_id ids properties =
18
+
{ account_id; ids; properties }
19
+
20
+
let get_args_jsont =
21
+
let kind = "GetArgs" in
22
+
Jsont.Object.map ~kind get_args_make
23
+
|> Jsont.Object.mem "accountId" Id.jsont ~enc:(fun a -> a.account_id)
24
+
|> Jsont.Object.opt_mem "ids" (Jsont.list Id.jsont) ~enc:(fun a -> a.ids)
25
+
|> Jsont.Object.opt_mem "properties" (Jsont.list Jsont.string) ~enc:(fun a -> a.properties)
26
+
|> Jsont.Object.finish
27
+
28
+
type 'a get_response = {
29
+
account_id : Id.t;
30
+
state : string;
31
+
list : 'a list;
32
+
not_found : Id.t list;
33
+
}
34
+
35
+
let get_response_jsont (type a) (obj_jsont : a Jsont.t) : a get_response Jsont.t =
36
+
let kind = "GetResponse" in
37
+
let make account_id state list not_found =
38
+
{ account_id; state; list; not_found }
39
+
in
40
+
Jsont.Object.map ~kind make
41
+
|> Jsont.Object.mem "accountId" Id.jsont ~enc:(fun r -> r.account_id)
42
+
|> Jsont.Object.mem "state" Jsont.string ~enc:(fun r -> r.state)
43
+
|> Jsont.Object.mem "list" (Jsont.list obj_jsont) ~enc:(fun r -> r.list)
44
+
|> Jsont.Object.mem "notFound" (Jsont.list Id.jsont) ~enc:(fun r -> r.not_found)
45
+
|> Jsont.Object.finish
46
+
47
+
(* Foo/changes *)
48
+
49
+
type changes_args = {
50
+
account_id : Id.t;
51
+
since_state : string;
52
+
max_changes : int64 option;
53
+
}
54
+
55
+
let changes_args ~account_id ~since_state ?max_changes () =
56
+
{ account_id; since_state; max_changes }
57
+
58
+
let changes_args_make account_id since_state max_changes =
59
+
{ account_id; since_state; max_changes }
60
+
61
+
let changes_args_jsont =
62
+
let kind = "ChangesArgs" in
63
+
Jsont.Object.map ~kind changes_args_make
64
+
|> Jsont.Object.mem "accountId" Id.jsont ~enc:(fun a -> a.account_id)
65
+
|> Jsont.Object.mem "sinceState" Jsont.string ~enc:(fun a -> a.since_state)
66
+
|> Jsont.Object.opt_mem "maxChanges" Int53.Unsigned.jsont ~enc:(fun a -> a.max_changes)
67
+
|> Jsont.Object.finish
68
+
69
+
type changes_response = {
70
+
account_id : Id.t;
71
+
old_state : string;
72
+
new_state : string;
73
+
has_more_changes : bool;
74
+
created : Id.t list;
75
+
updated : Id.t list;
76
+
destroyed : Id.t list;
77
+
}
78
+
79
+
let changes_response_make account_id old_state new_state has_more_changes
80
+
created updated destroyed =
81
+
{ account_id; old_state; new_state; has_more_changes; created; updated; destroyed }
82
+
83
+
let changes_response_jsont =
84
+
let kind = "ChangesResponse" in
85
+
Jsont.Object.map ~kind changes_response_make
86
+
|> Jsont.Object.mem "accountId" Id.jsont ~enc:(fun r -> r.account_id)
87
+
|> Jsont.Object.mem "oldState" Jsont.string ~enc:(fun r -> r.old_state)
88
+
|> Jsont.Object.mem "newState" Jsont.string ~enc:(fun r -> r.new_state)
89
+
|> Jsont.Object.mem "hasMoreChanges" Jsont.bool ~enc:(fun r -> r.has_more_changes)
90
+
|> Jsont.Object.mem "created" (Jsont.list Id.jsont) ~enc:(fun r -> r.created)
91
+
|> Jsont.Object.mem "updated" (Jsont.list Id.jsont) ~enc:(fun r -> r.updated)
92
+
|> Jsont.Object.mem "destroyed" (Jsont.list Id.jsont) ~enc:(fun r -> r.destroyed)
93
+
|> Jsont.Object.finish
94
+
95
+
(* Foo/set *)
96
+
97
+
type 'a set_args = {
98
+
account_id : Id.t;
99
+
if_in_state : string option;
100
+
create : (Id.t * 'a) list option;
101
+
update : (Id.t * Jsont.json) list option;
102
+
destroy : Id.t list option;
103
+
}
104
+
105
+
let set_args ~account_id ?if_in_state ?create ?update ?destroy () =
106
+
{ account_id; if_in_state; create; update; destroy }
107
+
108
+
let set_args_jsont (type a) (obj_jsont : a Jsont.t) : a set_args Jsont.t =
109
+
let kind = "SetArgs" in
110
+
let make account_id if_in_state create update destroy =
111
+
{ account_id; if_in_state; create; update; destroy }
112
+
in
113
+
Jsont.Object.map ~kind make
114
+
|> Jsont.Object.mem "accountId" Id.jsont ~enc:(fun a -> a.account_id)
115
+
|> Jsont.Object.opt_mem "ifInState" Jsont.string ~enc:(fun a -> a.if_in_state)
116
+
|> Jsont.Object.opt_mem "create" (Json_map.of_id obj_jsont) ~enc:(fun a -> a.create)
117
+
|> Jsont.Object.opt_mem "update" (Json_map.of_id Jsont.json) ~enc:(fun a -> a.update)
118
+
|> Jsont.Object.opt_mem "destroy" (Jsont.list Id.jsont) ~enc:(fun a -> a.destroy)
119
+
|> Jsont.Object.finish
120
+
121
+
type 'a set_response = {
122
+
account_id : Id.t;
123
+
old_state : string option;
124
+
new_state : string;
125
+
created : (Id.t * 'a) list option;
126
+
updated : (Id.t * 'a option) list option;
127
+
destroyed : Id.t list option;
128
+
not_created : (Id.t * Error.set_error) list option;
129
+
not_updated : (Id.t * Error.set_error) list option;
130
+
not_destroyed : (Id.t * Error.set_error) list option;
131
+
}
132
+
133
+
let set_response_jsont (type a) (obj_jsont : a Jsont.t) : a set_response Jsont.t =
134
+
let kind = "SetResponse" in
135
+
let make account_id old_state new_state created updated destroyed
136
+
not_created not_updated not_destroyed =
137
+
{ account_id; old_state; new_state; created; updated; destroyed;
138
+
not_created; not_updated; not_destroyed }
139
+
in
140
+
(* For updated values, the server may return null or an object *)
141
+
let nullable_obj = Jsont.(some obj_jsont) in
142
+
Jsont.Object.map ~kind make
143
+
|> Jsont.Object.mem "accountId" Id.jsont ~enc:(fun r -> r.account_id)
144
+
|> Jsont.Object.opt_mem "oldState" Jsont.string ~enc:(fun r -> r.old_state)
145
+
|> Jsont.Object.mem "newState" Jsont.string ~enc:(fun r -> r.new_state)
146
+
|> Jsont.Object.opt_mem "created" (Json_map.of_id obj_jsont) ~enc:(fun r -> r.created)
147
+
|> Jsont.Object.opt_mem "updated" (Json_map.of_id nullable_obj) ~enc:(fun r -> r.updated)
148
+
|> Jsont.Object.opt_mem "destroyed" (Jsont.list Id.jsont) ~enc:(fun r -> r.destroyed)
149
+
|> Jsont.Object.opt_mem "notCreated" (Json_map.of_id Error.set_error_jsont) ~enc:(fun r -> r.not_created)
150
+
|> Jsont.Object.opt_mem "notUpdated" (Json_map.of_id Error.set_error_jsont) ~enc:(fun r -> r.not_updated)
151
+
|> Jsont.Object.opt_mem "notDestroyed" (Json_map.of_id Error.set_error_jsont) ~enc:(fun r -> r.not_destroyed)
152
+
|> Jsont.Object.finish
153
+
154
+
(* Foo/copy *)
155
+
156
+
type 'a copy_args = {
157
+
from_account_id : Id.t;
158
+
if_from_in_state : string option;
159
+
account_id : Id.t;
160
+
if_in_state : string option;
161
+
create : (Id.t * 'a) list;
162
+
on_success_destroy_original : bool;
163
+
destroy_from_if_in_state : string option;
164
+
}
165
+
166
+
let copy_args_jsont (type a) (obj_jsont : a Jsont.t) : a copy_args Jsont.t =
167
+
let kind = "CopyArgs" in
168
+
let make from_account_id if_from_in_state account_id if_in_state create
169
+
on_success_destroy_original destroy_from_if_in_state =
170
+
{ from_account_id; if_from_in_state; account_id; if_in_state; create;
171
+
on_success_destroy_original; destroy_from_if_in_state }
172
+
in
173
+
Jsont.Object.map ~kind make
174
+
|> Jsont.Object.mem "fromAccountId" Id.jsont ~enc:(fun a -> a.from_account_id)
175
+
|> Jsont.Object.opt_mem "ifFromInState" Jsont.string ~enc:(fun a -> a.if_from_in_state)
176
+
|> Jsont.Object.mem "accountId" Id.jsont ~enc:(fun a -> a.account_id)
177
+
|> Jsont.Object.opt_mem "ifInState" Jsont.string ~enc:(fun a -> a.if_in_state)
178
+
|> Jsont.Object.mem "create" (Json_map.of_id obj_jsont) ~enc:(fun a -> a.create)
179
+
|> Jsont.Object.mem "onSuccessDestroyOriginal" Jsont.bool ~dec_absent:false
180
+
~enc:(fun a -> a.on_success_destroy_original)
181
+
~enc_omit:(fun b -> not b)
182
+
|> Jsont.Object.opt_mem "destroyFromIfInState" Jsont.string ~enc:(fun a -> a.destroy_from_if_in_state)
183
+
|> Jsont.Object.finish
184
+
185
+
type 'a copy_response = {
186
+
from_account_id : Id.t;
187
+
account_id : Id.t;
188
+
old_state : string option;
189
+
new_state : string;
190
+
created : (Id.t * 'a) list option;
191
+
not_created : (Id.t * Error.set_error) list option;
192
+
}
193
+
194
+
let copy_response_jsont (type a) (obj_jsont : a Jsont.t) : a copy_response Jsont.t =
195
+
let kind = "CopyResponse" in
196
+
let make from_account_id account_id old_state new_state created not_created =
197
+
{ from_account_id; account_id; old_state; new_state; created; not_created }
198
+
in
199
+
Jsont.Object.map ~kind make
200
+
|> Jsont.Object.mem "fromAccountId" Id.jsont ~enc:(fun r -> r.from_account_id)
201
+
|> Jsont.Object.mem "accountId" Id.jsont ~enc:(fun r -> r.account_id)
202
+
|> Jsont.Object.opt_mem "oldState" Jsont.string ~enc:(fun r -> r.old_state)
203
+
|> Jsont.Object.mem "newState" Jsont.string ~enc:(fun r -> r.new_state)
204
+
|> Jsont.Object.opt_mem "created" (Json_map.of_id obj_jsont) ~enc:(fun r -> r.created)
205
+
|> Jsont.Object.opt_mem "notCreated" (Json_map.of_id Error.set_error_jsont) ~enc:(fun r -> r.not_created)
206
+
|> Jsont.Object.finish
207
+
208
+
(* Foo/query *)
209
+
210
+
type 'filter query_args = {
211
+
account_id : Id.t;
212
+
filter : 'filter Filter.filter option;
213
+
sort : Filter.comparator list option;
214
+
position : int64;
215
+
anchor : Id.t option;
216
+
anchor_offset : int64;
217
+
limit : int64 option;
218
+
calculate_total : bool;
219
+
}
220
+
221
+
let query_args ~account_id ?filter ?sort ?(position = 0L) ?anchor
222
+
?(anchor_offset = 0L) ?limit ?(calculate_total = false) () =
223
+
{ account_id; filter; sort; position; anchor; anchor_offset; limit; calculate_total }
224
+
225
+
let query_args_jsont (type f) (filter_cond_jsont : f Jsont.t) : f query_args Jsont.t =
226
+
let kind = "QueryArgs" in
227
+
let make account_id filter sort position anchor anchor_offset limit calculate_total =
228
+
{ account_id; filter; sort; position; anchor; anchor_offset; limit; calculate_total }
229
+
in
230
+
Jsont.Object.map ~kind make
231
+
|> Jsont.Object.mem "accountId" Id.jsont ~enc:(fun a -> a.account_id)
232
+
|> Jsont.Object.opt_mem "filter" (Filter.filter_jsont filter_cond_jsont) ~enc:(fun a -> a.filter)
233
+
|> Jsont.Object.opt_mem "sort" (Jsont.list Filter.comparator_jsont) ~enc:(fun a -> a.sort)
234
+
|> Jsont.Object.mem "position" Int53.Signed.jsont ~dec_absent:0L ~enc:(fun a -> a.position)
235
+
~enc_omit:(fun p -> p = 0L)
236
+
|> Jsont.Object.opt_mem "anchor" Id.jsont ~enc:(fun a -> a.anchor)
237
+
|> Jsont.Object.mem "anchorOffset" Int53.Signed.jsont ~dec_absent:0L ~enc:(fun a -> a.anchor_offset)
238
+
~enc_omit:(fun o -> o = 0L)
239
+
|> Jsont.Object.opt_mem "limit" Int53.Unsigned.jsont ~enc:(fun a -> a.limit)
240
+
|> Jsont.Object.mem "calculateTotal" Jsont.bool ~dec_absent:false ~enc:(fun a -> a.calculate_total)
241
+
~enc_omit:(fun b -> not b)
242
+
|> Jsont.Object.finish
243
+
244
+
type query_response = {
245
+
account_id : Id.t;
246
+
query_state : string;
247
+
can_calculate_changes : bool;
248
+
position : int64;
249
+
ids : Id.t list;
250
+
total : int64 option;
251
+
}
252
+
253
+
let query_response_make account_id query_state can_calculate_changes position ids total =
254
+
{ account_id; query_state; can_calculate_changes; position; ids; total }
255
+
256
+
let query_response_jsont =
257
+
let kind = "QueryResponse" in
258
+
Jsont.Object.map ~kind query_response_make
259
+
|> Jsont.Object.mem "accountId" Id.jsont ~enc:(fun r -> r.account_id)
260
+
|> Jsont.Object.mem "queryState" Jsont.string ~enc:(fun r -> r.query_state)
261
+
|> Jsont.Object.mem "canCalculateChanges" Jsont.bool ~enc:(fun r -> r.can_calculate_changes)
262
+
|> Jsont.Object.mem "position" Int53.Unsigned.jsont ~enc:(fun r -> r.position)
263
+
|> Jsont.Object.mem "ids" (Jsont.list Id.jsont) ~enc:(fun r -> r.ids)
264
+
|> Jsont.Object.opt_mem "total" Int53.Unsigned.jsont ~enc:(fun r -> r.total)
265
+
|> Jsont.Object.finish
266
+
267
+
(* Foo/queryChanges *)
268
+
269
+
type 'filter query_changes_args = {
270
+
account_id : Id.t;
271
+
filter : 'filter Filter.filter option;
272
+
sort : Filter.comparator list option;
273
+
since_query_state : string;
274
+
max_changes : int64 option;
275
+
up_to_id : Id.t option;
276
+
calculate_total : bool;
277
+
}
278
+
279
+
let query_changes_args_jsont (type f) (filter_cond_jsont : f Jsont.t) : f query_changes_args Jsont.t =
280
+
let kind = "QueryChangesArgs" in
281
+
let make account_id filter sort since_query_state max_changes up_to_id calculate_total =
282
+
{ account_id; filter; sort; since_query_state; max_changes; up_to_id; calculate_total }
283
+
in
284
+
Jsont.Object.map ~kind make
285
+
|> Jsont.Object.mem "accountId" Id.jsont ~enc:(fun a -> a.account_id)
286
+
|> Jsont.Object.opt_mem "filter" (Filter.filter_jsont filter_cond_jsont) ~enc:(fun a -> a.filter)
287
+
|> Jsont.Object.opt_mem "sort" (Jsont.list Filter.comparator_jsont) ~enc:(fun a -> a.sort)
288
+
|> Jsont.Object.mem "sinceQueryState" Jsont.string ~enc:(fun a -> a.since_query_state)
289
+
|> Jsont.Object.opt_mem "maxChanges" Int53.Unsigned.jsont ~enc:(fun a -> a.max_changes)
290
+
|> Jsont.Object.opt_mem "upToId" Id.jsont ~enc:(fun a -> a.up_to_id)
291
+
|> Jsont.Object.mem "calculateTotal" Jsont.bool ~dec_absent:false ~enc:(fun a -> a.calculate_total)
292
+
~enc_omit:(fun b -> not b)
293
+
|> Jsont.Object.finish
294
+
295
+
type query_changes_response = {
296
+
account_id : Id.t;
297
+
old_query_state : string;
298
+
new_query_state : string;
299
+
total : int64 option;
300
+
removed : Id.t list;
301
+
added : Filter.added_item list;
302
+
}
303
+
304
+
let query_changes_response_make account_id old_query_state new_query_state total removed added =
305
+
{ account_id; old_query_state; new_query_state; total; removed; added }
306
+
307
+
let query_changes_response_jsont =
308
+
let kind = "QueryChangesResponse" in
309
+
Jsont.Object.map ~kind query_changes_response_make
310
+
|> Jsont.Object.mem "accountId" Id.jsont ~enc:(fun r -> r.account_id)
311
+
|> Jsont.Object.mem "oldQueryState" Jsont.string ~enc:(fun r -> r.old_query_state)
312
+
|> Jsont.Object.mem "newQueryState" Jsont.string ~enc:(fun r -> r.new_query_state)
313
+
|> Jsont.Object.opt_mem "total" Int53.Unsigned.jsont ~enc:(fun r -> r.total)
314
+
|> Jsont.Object.mem "removed" (Jsont.list Id.jsont) ~enc:(fun r -> r.removed)
315
+
|> Jsont.Object.mem "added" (Jsont.list Filter.added_item_jsont) ~enc:(fun r -> r.added)
316
+
|> Jsont.Object.finish
+215
proto/method_.mli
+215
proto/method_.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** JMAP standard method types as defined in RFC 8620 Section 5 *)
7
+
8
+
(** {1 Foo/get} *)
9
+
10
+
(** Arguments for /get methods. *)
11
+
type get_args = {
12
+
account_id : Id.t;
13
+
(** The account to fetch from. *)
14
+
ids : Id.t list option;
15
+
(** The ids to fetch. [None] means fetch all. *)
16
+
properties : string list option;
17
+
(** Properties to include. [None] means all. *)
18
+
}
19
+
20
+
val get_args :
21
+
account_id:Id.t ->
22
+
?ids:Id.t list ->
23
+
?properties:string list ->
24
+
unit ->
25
+
get_args
26
+
27
+
val get_args_jsont : get_args Jsont.t
28
+
29
+
(** Response for /get methods. *)
30
+
type 'a get_response = {
31
+
account_id : Id.t;
32
+
(** The account fetched from. *)
33
+
state : string;
34
+
(** Current state string. *)
35
+
list : 'a list;
36
+
(** The objects fetched. *)
37
+
not_found : Id.t list;
38
+
(** Ids that were not found. *)
39
+
}
40
+
41
+
val get_response_jsont : 'a Jsont.t -> 'a get_response Jsont.t
42
+
43
+
(** {1 Foo/changes} *)
44
+
45
+
(** Arguments for /changes methods. *)
46
+
type changes_args = {
47
+
account_id : Id.t;
48
+
since_state : string;
49
+
max_changes : int64 option;
50
+
}
51
+
52
+
val changes_args :
53
+
account_id:Id.t ->
54
+
since_state:string ->
55
+
?max_changes:int64 ->
56
+
unit ->
57
+
changes_args
58
+
59
+
val changes_args_jsont : changes_args Jsont.t
60
+
61
+
(** Response for /changes methods. *)
62
+
type changes_response = {
63
+
account_id : Id.t;
64
+
old_state : string;
65
+
new_state : string;
66
+
has_more_changes : bool;
67
+
created : Id.t list;
68
+
updated : Id.t list;
69
+
destroyed : Id.t list;
70
+
}
71
+
72
+
val changes_response_jsont : changes_response Jsont.t
73
+
74
+
(** {1 Foo/set} *)
75
+
76
+
(** Arguments for /set methods.
77
+
78
+
The ['a] type parameter is the object type being created/updated. *)
79
+
type 'a set_args = {
80
+
account_id : Id.t;
81
+
if_in_state : string option;
82
+
(** If set, only apply if current state matches. *)
83
+
create : (Id.t * 'a) list option;
84
+
(** Objects to create, keyed by temporary id. *)
85
+
update : (Id.t * Jsont.json) list option;
86
+
(** Objects to update. Value is a PatchObject. *)
87
+
destroy : Id.t list option;
88
+
(** Ids to destroy. *)
89
+
}
90
+
91
+
val set_args :
92
+
account_id:Id.t ->
93
+
?if_in_state:string ->
94
+
?create:(Id.t * 'a) list ->
95
+
?update:(Id.t * Jsont.json) list ->
96
+
?destroy:Id.t list ->
97
+
unit ->
98
+
'a set_args
99
+
100
+
val set_args_jsont : 'a Jsont.t -> 'a set_args Jsont.t
101
+
102
+
(** Response for /set methods. *)
103
+
type 'a set_response = {
104
+
account_id : Id.t;
105
+
old_state : string option;
106
+
new_state : string;
107
+
created : (Id.t * 'a) list option;
108
+
(** Successfully created objects, keyed by temporary id. *)
109
+
updated : (Id.t * 'a option) list option;
110
+
(** Successfully updated objects. Value may include server-set properties. *)
111
+
destroyed : Id.t list option;
112
+
(** Successfully destroyed ids. *)
113
+
not_created : (Id.t * Error.set_error) list option;
114
+
(** Failed creates. *)
115
+
not_updated : (Id.t * Error.set_error) list option;
116
+
(** Failed updates. *)
117
+
not_destroyed : (Id.t * Error.set_error) list option;
118
+
(** Failed destroys. *)
119
+
}
120
+
121
+
val set_response_jsont : 'a Jsont.t -> 'a set_response Jsont.t
122
+
123
+
(** {1 Foo/copy} *)
124
+
125
+
(** Arguments for /copy methods. *)
126
+
type 'a copy_args = {
127
+
from_account_id : Id.t;
128
+
if_from_in_state : string option;
129
+
account_id : Id.t;
130
+
if_in_state : string option;
131
+
create : (Id.t * 'a) list;
132
+
on_success_destroy_original : bool;
133
+
destroy_from_if_in_state : string option;
134
+
}
135
+
136
+
val copy_args_jsont : 'a Jsont.t -> 'a copy_args Jsont.t
137
+
138
+
(** Response for /copy methods. *)
139
+
type 'a copy_response = {
140
+
from_account_id : Id.t;
141
+
account_id : Id.t;
142
+
old_state : string option;
143
+
new_state : string;
144
+
created : (Id.t * 'a) list option;
145
+
not_created : (Id.t * Error.set_error) list option;
146
+
}
147
+
148
+
val copy_response_jsont : 'a Jsont.t -> 'a copy_response Jsont.t
149
+
150
+
(** {1 Foo/query} *)
151
+
152
+
(** Arguments for /query methods. *)
153
+
type 'filter query_args = {
154
+
account_id : Id.t;
155
+
filter : 'filter Filter.filter option;
156
+
sort : Filter.comparator list option;
157
+
position : int64;
158
+
anchor : Id.t option;
159
+
anchor_offset : int64;
160
+
limit : int64 option;
161
+
calculate_total : bool;
162
+
}
163
+
164
+
val query_args :
165
+
account_id:Id.t ->
166
+
?filter:'filter Filter.filter ->
167
+
?sort:Filter.comparator list ->
168
+
?position:int64 ->
169
+
?anchor:Id.t ->
170
+
?anchor_offset:int64 ->
171
+
?limit:int64 ->
172
+
?calculate_total:bool ->
173
+
unit ->
174
+
'filter query_args
175
+
176
+
val query_args_jsont : 'filter Jsont.t -> 'filter query_args Jsont.t
177
+
178
+
(** Response for /query methods. *)
179
+
type query_response = {
180
+
account_id : Id.t;
181
+
query_state : string;
182
+
can_calculate_changes : bool;
183
+
position : int64;
184
+
ids : Id.t list;
185
+
total : int64 option;
186
+
}
187
+
188
+
val query_response_jsont : query_response Jsont.t
189
+
190
+
(** {1 Foo/queryChanges} *)
191
+
192
+
(** Arguments for /queryChanges methods. *)
193
+
type 'filter query_changes_args = {
194
+
account_id : Id.t;
195
+
filter : 'filter Filter.filter option;
196
+
sort : Filter.comparator list option;
197
+
since_query_state : string;
198
+
max_changes : int64 option;
199
+
up_to_id : Id.t option;
200
+
calculate_total : bool;
201
+
}
202
+
203
+
val query_changes_args_jsont : 'filter Jsont.t -> 'filter query_changes_args Jsont.t
204
+
205
+
(** Response for /queryChanges methods. *)
206
+
type query_changes_response = {
207
+
account_id : Id.t;
208
+
old_query_state : string;
209
+
new_query_state : string;
210
+
total : int64 option;
211
+
removed : Id.t list;
212
+
added : Filter.added_item list;
213
+
}
214
+
215
+
val query_changes_response_jsont : query_changes_response Jsont.t
+132
proto/push.ml
+132
proto/push.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
module State_change = struct
7
+
type type_state = {
8
+
type_name : string;
9
+
state : string;
10
+
}
11
+
12
+
type t = {
13
+
type_ : string;
14
+
changed : (Id.t * type_state list) list;
15
+
}
16
+
17
+
(* The changed object is account_id -> { typeName: state } *)
18
+
let changed_jsont =
19
+
let kind = "Changed" in
20
+
(* Inner is type -> state string map *)
21
+
let type_states_jsont = Json_map.of_string Jsont.string in
22
+
(* Convert list of (string * string) to type_state list *)
23
+
let decode_type_states pairs =
24
+
List.map (fun (type_name, state) -> { type_name; state }) pairs
25
+
in
26
+
let encode_type_states states =
27
+
List.map (fun ts -> (ts.type_name, ts.state)) states
28
+
in
29
+
Json_map.of_id
30
+
(Jsont.map ~kind ~dec:decode_type_states ~enc:encode_type_states type_states_jsont)
31
+
32
+
let make type_ changed = { type_; changed }
33
+
34
+
let jsont =
35
+
let kind = "StateChange" in
36
+
Jsont.Object.map ~kind make
37
+
|> Jsont.Object.mem "@type" Jsont.string ~enc:(fun t -> t.type_)
38
+
|> Jsont.Object.mem "changed" changed_jsont ~enc:(fun t -> t.changed)
39
+
|> Jsont.Object.finish
40
+
end
41
+
42
+
type push_keys = {
43
+
p256dh : string;
44
+
auth : string;
45
+
}
46
+
47
+
let push_keys_make p256dh auth = { p256dh; auth }
48
+
49
+
let push_keys_jsont =
50
+
let kind = "PushKeys" in
51
+
Jsont.Object.map ~kind push_keys_make
52
+
|> Jsont.Object.mem "p256dh" Jsont.string ~enc:(fun k -> k.p256dh)
53
+
|> Jsont.Object.mem "auth" Jsont.string ~enc:(fun k -> k.auth)
54
+
|> Jsont.Object.finish
55
+
56
+
type t = {
57
+
id : Id.t;
58
+
device_client_id : string;
59
+
url : string;
60
+
keys : push_keys option;
61
+
verification_code : string option;
62
+
expires : Ptime.t option;
63
+
types : string list option;
64
+
}
65
+
66
+
let id t = t.id
67
+
let device_client_id t = t.device_client_id
68
+
let url t = t.url
69
+
let keys t = t.keys
70
+
let verification_code t = t.verification_code
71
+
let expires t = t.expires
72
+
let types t = t.types
73
+
74
+
let make id device_client_id url keys verification_code expires types =
75
+
{ id; device_client_id; url; keys; verification_code; expires; types }
76
+
77
+
let jsont =
78
+
let kind = "PushSubscription" in
79
+
Jsont.Object.map ~kind make
80
+
|> Jsont.Object.mem "id" Id.jsont ~enc:id
81
+
|> Jsont.Object.mem "deviceClientId" Jsont.string ~enc:device_client_id
82
+
|> Jsont.Object.mem "url" Jsont.string ~enc:url
83
+
|> Jsont.Object.opt_mem "keys" push_keys_jsont ~enc:keys
84
+
|> Jsont.Object.opt_mem "verificationCode" Jsont.string ~enc:verification_code
85
+
|> Jsont.Object.opt_mem "expires" Date.Utc.jsont ~enc:expires
86
+
|> Jsont.Object.opt_mem "types" (Jsont.list Jsont.string) ~enc:types
87
+
|> Jsont.Object.finish
88
+
89
+
let get_args_jsont = Method_.get_args_jsont
90
+
let get_response_jsont = Method_.get_response_jsont jsont
91
+
92
+
type create_args = {
93
+
device_client_id : string;
94
+
url : string;
95
+
keys : push_keys option;
96
+
verification_code : string option;
97
+
types : string list option;
98
+
}
99
+
100
+
let create_args_make device_client_id url keys verification_code types =
101
+
{ device_client_id; url; keys; verification_code; types }
102
+
103
+
let create_args_jsont =
104
+
let kind = "PushSubscription create" in
105
+
Jsont.Object.map ~kind create_args_make
106
+
|> Jsont.Object.mem "deviceClientId" Jsont.string ~enc:(fun a -> a.device_client_id)
107
+
|> Jsont.Object.mem "url" Jsont.string ~enc:(fun a -> a.url)
108
+
|> Jsont.Object.opt_mem "keys" push_keys_jsont ~enc:(fun a -> a.keys)
109
+
|> Jsont.Object.opt_mem "verificationCode" Jsont.string ~enc:(fun a -> a.verification_code)
110
+
|> Jsont.Object.opt_mem "types" (Jsont.list Jsont.string) ~enc:(fun a -> a.types)
111
+
|> Jsont.Object.finish
112
+
113
+
type set_args = {
114
+
account_id : Id.t option;
115
+
if_in_state : string option;
116
+
create : (Id.t * create_args) list option;
117
+
update : (Id.t * Jsont.json) list option;
118
+
destroy : Id.t list option;
119
+
}
120
+
121
+
let set_args_make account_id if_in_state create update destroy =
122
+
{ account_id; if_in_state; create; update; destroy }
123
+
124
+
let set_args_jsont =
125
+
let kind = "PushSubscription/set args" in
126
+
Jsont.Object.map ~kind set_args_make
127
+
|> Jsont.Object.opt_mem "accountId" Id.jsont ~enc:(fun a -> a.account_id)
128
+
|> Jsont.Object.opt_mem "ifInState" Jsont.string ~enc:(fun a -> a.if_in_state)
129
+
|> Jsont.Object.opt_mem "create" (Json_map.of_id create_args_jsont) ~enc:(fun a -> a.create)
130
+
|> Jsont.Object.opt_mem "update" (Json_map.of_id Jsont.json) ~enc:(fun a -> a.update)
131
+
|> Jsont.Object.opt_mem "destroy" (Jsont.list Id.jsont) ~enc:(fun a -> a.destroy)
132
+
|> Jsont.Object.finish
+96
proto/push.mli
+96
proto/push.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** JMAP push types as defined in RFC 8620 Section 7 *)
7
+
8
+
(** {1 StateChange} *)
9
+
10
+
(** A state change notification for push. *)
11
+
module State_change : sig
12
+
type type_state = {
13
+
type_name : string;
14
+
(** The data type that changed (e.g., "Email", "Mailbox"). *)
15
+
state : string;
16
+
(** The new state string for this type. *)
17
+
}
18
+
19
+
type t = {
20
+
type_ : string;
21
+
(** Always "StateChange". *)
22
+
changed : (Id.t * type_state list) list;
23
+
(** Map of account id to list of type state changes. *)
24
+
}
25
+
26
+
val jsont : t Jsont.t
27
+
end
28
+
29
+
(** {1 PushSubscription} *)
30
+
31
+
(** Web push subscription keys. *)
32
+
type push_keys = {
33
+
p256dh : string;
34
+
(** P-256 ECDH public key as URL-safe base64. *)
35
+
auth : string;
36
+
(** Authentication secret as URL-safe base64. *)
37
+
}
38
+
39
+
val push_keys_jsont : push_keys Jsont.t
40
+
41
+
(** A push subscription object. *)
42
+
type t = {
43
+
id : Id.t;
44
+
(** Server-assigned subscription id. *)
45
+
device_client_id : string;
46
+
(** Client-provided device identifier. *)
47
+
url : string;
48
+
(** The push endpoint URL. *)
49
+
keys : push_keys option;
50
+
(** Optional encryption keys for Web Push. *)
51
+
verification_code : string option;
52
+
(** Code for verifying subscription ownership. *)
53
+
expires : Ptime.t option;
54
+
(** When the subscription expires. *)
55
+
types : string list option;
56
+
(** Data types to receive notifications for. [None] means all. *)
57
+
}
58
+
59
+
val id : t -> Id.t
60
+
val device_client_id : t -> string
61
+
val url : t -> string
62
+
val keys : t -> push_keys option
63
+
val verification_code : t -> string option
64
+
val expires : t -> Ptime.t option
65
+
val types : t -> string list option
66
+
67
+
val jsont : t Jsont.t
68
+
(** JSON codec for PushSubscription. *)
69
+
70
+
(** {1 PushSubscription Methods} *)
71
+
72
+
(** Arguments for PushSubscription/get. *)
73
+
val get_args_jsont : Method_.get_args Jsont.t
74
+
75
+
(** Response for PushSubscription/get. *)
76
+
val get_response_jsont : t Method_.get_response Jsont.t
77
+
78
+
(** Arguments for PushSubscription/set. *)
79
+
type set_args = {
80
+
account_id : Id.t option;
81
+
(** Not used for PushSubscription. *)
82
+
if_in_state : string option;
83
+
create : (Id.t * create_args) list option;
84
+
update : (Id.t * Jsont.json) list option;
85
+
destroy : Id.t list option;
86
+
}
87
+
88
+
and create_args = {
89
+
device_client_id : string;
90
+
url : string;
91
+
keys : push_keys option;
92
+
verification_code : string option;
93
+
types : string list option;
94
+
}
95
+
96
+
val set_args_jsont : set_args Jsont.t
+34
proto/request.ml
+34
proto/request.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
type t = {
7
+
using : string list;
8
+
method_calls : Invocation.t list;
9
+
created_ids : (Id.t * Id.t) list option;
10
+
}
11
+
12
+
let create ~using ~method_calls ?created_ids () =
13
+
{ using; method_calls; created_ids }
14
+
15
+
let using t = t.using
16
+
let method_calls t = t.method_calls
17
+
let created_ids t = t.created_ids
18
+
19
+
let make using method_calls created_ids =
20
+
{ using; method_calls; created_ids }
21
+
22
+
let jsont =
23
+
let kind = "Request" in
24
+
Jsont.Object.map ~kind make
25
+
|> Jsont.Object.mem "using" (Jsont.list Jsont.string) ~enc:using
26
+
|> Jsont.Object.mem "methodCalls" (Jsont.list Invocation.jsont) ~enc:method_calls
27
+
|> Jsont.Object.opt_mem "createdIds" (Json_map.of_id Id.jsont) ~enc:created_ids
28
+
|> Jsont.Object.finish
29
+
30
+
let single ~using invocation =
31
+
{ using; method_calls = [invocation]; created_ids = None }
32
+
33
+
let batch ~using invocations =
34
+
{ using; method_calls = invocations; created_ids = None }
+45
proto/request.mli
+45
proto/request.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** JMAP request object as defined in RFC 8620 Section 3.3 *)
7
+
8
+
type t = {
9
+
using : string list;
10
+
(** Capability URIs required for this request. *)
11
+
method_calls : Invocation.t list;
12
+
(** The method calls to execute. *)
13
+
created_ids : (Id.t * Id.t) list option;
14
+
(** Map of client-created temporary ids to server-assigned ids.
15
+
Used for result references in batch operations. *)
16
+
}
17
+
18
+
val create :
19
+
using:string list ->
20
+
method_calls:Invocation.t list ->
21
+
?created_ids:(Id.t * Id.t) list ->
22
+
unit ->
23
+
t
24
+
(** [create ~using ~method_calls ?created_ids ()] creates a JMAP request. *)
25
+
26
+
val using : t -> string list
27
+
val method_calls : t -> Invocation.t list
28
+
val created_ids : t -> (Id.t * Id.t) list option
29
+
30
+
val jsont : t Jsont.t
31
+
(** JSON codec for JMAP requests. *)
32
+
33
+
(** {1 Request Builders} *)
34
+
35
+
val single :
36
+
using:string list ->
37
+
Invocation.t ->
38
+
t
39
+
(** [single ~using invocation] creates a request with a single method call. *)
40
+
41
+
val batch :
42
+
using:string list ->
43
+
Invocation.t list ->
44
+
t
45
+
(** [batch ~using invocations] creates a request with multiple method calls. *)
+46
proto/response.ml
+46
proto/response.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
type t = {
7
+
method_responses : Invocation.t list;
8
+
created_ids : (Id.t * Id.t) list option;
9
+
session_state : string;
10
+
}
11
+
12
+
let method_responses t = t.method_responses
13
+
let created_ids t = t.created_ids
14
+
let session_state t = t.session_state
15
+
16
+
let make method_responses created_ids session_state =
17
+
{ method_responses; created_ids; session_state }
18
+
19
+
let jsont =
20
+
let kind = "Response" in
21
+
Jsont.Object.map ~kind make
22
+
|> Jsont.Object.mem "methodResponses" (Jsont.list Invocation.jsont) ~enc:method_responses
23
+
|> Jsont.Object.opt_mem "createdIds" (Json_map.of_id Id.jsont) ~enc:created_ids
24
+
|> Jsont.Object.mem "sessionState" Jsont.string ~enc:session_state
25
+
|> Jsont.Object.finish
26
+
27
+
let find_response method_call_id response =
28
+
List.find_opt
29
+
(fun inv -> Invocation.method_call_id inv = method_call_id)
30
+
response.method_responses
31
+
32
+
let get_response method_call_id response =
33
+
match find_response method_call_id response with
34
+
| Some inv -> inv
35
+
| None -> raise Not_found
36
+
37
+
let is_error invocation =
38
+
String.equal (Invocation.name invocation) "error"
39
+
40
+
let get_error invocation =
41
+
if is_error invocation then
42
+
match Jsont.Json.decode' Error.method_error_jsont (Invocation.arguments invocation) with
43
+
| Ok v -> Some v
44
+
| Error _ -> None
45
+
else
46
+
None
+37
proto/response.mli
+37
proto/response.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** JMAP response object as defined in RFC 8620 Section 3.4 *)
7
+
8
+
type t = {
9
+
method_responses : Invocation.t list;
10
+
(** The method responses. Each is [methodName, responseArgs, methodCallId]. *)
11
+
created_ids : (Id.t * Id.t) list option;
12
+
(** Map of client-created temporary ids to server-assigned ids. *)
13
+
session_state : string;
14
+
(** Current session state. Changes indicate session data has changed. *)
15
+
}
16
+
17
+
val method_responses : t -> Invocation.t list
18
+
val created_ids : t -> (Id.t * Id.t) list option
19
+
val session_state : t -> string
20
+
21
+
val jsont : t Jsont.t
22
+
(** JSON codec for JMAP responses. *)
23
+
24
+
(** {1 Response Inspection} *)
25
+
26
+
val find_response : string -> t -> Invocation.t option
27
+
(** [find_response method_call_id response] finds the response for a method call. *)
28
+
29
+
val get_response : string -> t -> Invocation.t
30
+
(** [get_response method_call_id response] gets the response for a method call.
31
+
@raise Not_found if not found. *)
32
+
33
+
val is_error : Invocation.t -> bool
34
+
(** [is_error invocation] returns [true] if the invocation is an error response. *)
35
+
36
+
val get_error : Invocation.t -> Error.method_error option
37
+
(** [get_error invocation] returns the error if this is an error response. *)
+96
proto/session.ml
+96
proto/session.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
module Account = struct
7
+
type t = {
8
+
name : string;
9
+
is_personal : bool;
10
+
is_read_only : bool;
11
+
account_capabilities : (string * Jsont.json) list;
12
+
}
13
+
14
+
let name t = t.name
15
+
let is_personal t = t.is_personal
16
+
let is_read_only t = t.is_read_only
17
+
let account_capabilities t = t.account_capabilities
18
+
19
+
let make name is_personal is_read_only account_capabilities =
20
+
{ name; is_personal; is_read_only; account_capabilities }
21
+
22
+
let jsont =
23
+
let kind = "Account" in
24
+
Jsont.Object.map ~kind make
25
+
|> Jsont.Object.mem "name" Jsont.string ~enc:name
26
+
|> Jsont.Object.mem "isPersonal" Jsont.bool ~enc:is_personal
27
+
|> Jsont.Object.mem "isReadOnly" Jsont.bool ~enc:is_read_only
28
+
|> Jsont.Object.mem "accountCapabilities" (Json_map.of_string Jsont.json) ~enc:account_capabilities
29
+
|> Jsont.Object.finish
30
+
end
31
+
32
+
type t = {
33
+
capabilities : (string * Jsont.json) list;
34
+
accounts : (Id.t * Account.t) list;
35
+
primary_accounts : (string * Id.t) list;
36
+
username : string;
37
+
api_url : string;
38
+
download_url : string;
39
+
upload_url : string;
40
+
event_source_url : string;
41
+
state : string;
42
+
}
43
+
44
+
let capabilities t = t.capabilities
45
+
let accounts t = t.accounts
46
+
let primary_accounts t = t.primary_accounts
47
+
let username t = t.username
48
+
let api_url t = t.api_url
49
+
let download_url t = t.download_url
50
+
let upload_url t = t.upload_url
51
+
let event_source_url t = t.event_source_url
52
+
let state t = t.state
53
+
54
+
let make capabilities accounts primary_accounts username api_url
55
+
download_url upload_url event_source_url state =
56
+
{ capabilities; accounts; primary_accounts; username; api_url;
57
+
download_url; upload_url; event_source_url; state }
58
+
59
+
let jsont =
60
+
let kind = "Session" in
61
+
Jsont.Object.map ~kind make
62
+
|> Jsont.Object.mem "capabilities" (Json_map.of_string Jsont.json) ~enc:capabilities
63
+
|> Jsont.Object.mem "accounts" (Json_map.of_id Account.jsont) ~enc:accounts
64
+
|> Jsont.Object.mem "primaryAccounts" (Json_map.of_string Id.jsont) ~enc:primary_accounts
65
+
|> Jsont.Object.mem "username" Jsont.string ~enc:username
66
+
|> Jsont.Object.mem "apiUrl" Jsont.string ~enc:api_url
67
+
|> Jsont.Object.mem "downloadUrl" Jsont.string ~enc:download_url
68
+
|> Jsont.Object.mem "uploadUrl" Jsont.string ~enc:upload_url
69
+
|> Jsont.Object.mem "eventSourceUrl" Jsont.string ~enc:event_source_url
70
+
|> Jsont.Object.mem "state" Jsont.string ~enc:state
71
+
|> Jsont.Object.finish
72
+
73
+
let get_account id session =
74
+
List.assoc_opt id session.accounts
75
+
76
+
let primary_account_for capability session =
77
+
List.assoc_opt capability session.primary_accounts
78
+
79
+
let has_capability uri session =
80
+
List.exists (fun (k, _) -> k = uri) session.capabilities
81
+
82
+
let get_core_capability session =
83
+
match List.assoc_opt Capability.core session.capabilities with
84
+
| None -> None
85
+
| Some json ->
86
+
(match Jsont.Json.decode' Capability.Core.jsont json with
87
+
| Ok v -> Some v
88
+
| Error _ -> None)
89
+
90
+
let get_mail_capability session =
91
+
match List.assoc_opt Capability.mail session.capabilities with
92
+
| None -> None
93
+
| Some json ->
94
+
(match Jsont.Json.decode' Capability.Mail.jsont json with
95
+
| Ok v -> Some v
96
+
| Error _ -> None)
+84
proto/session.mli
+84
proto/session.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** JMAP session object as defined in RFC 8620 Section 2 *)
7
+
8
+
(** {1 Account} *)
9
+
10
+
(** An account available to the user. *)
11
+
module Account : sig
12
+
type t = {
13
+
name : string;
14
+
(** Human-readable name for the account. *)
15
+
is_personal : bool;
16
+
(** Whether this is a personal account. *)
17
+
is_read_only : bool;
18
+
(** Whether the account is read-only. *)
19
+
account_capabilities : (string * Jsont.json) list;
20
+
(** Capabilities available for this account. *)
21
+
}
22
+
23
+
val name : t -> string
24
+
val is_personal : t -> bool
25
+
val is_read_only : t -> bool
26
+
val account_capabilities : t -> (string * Jsont.json) list
27
+
28
+
val jsont : t Jsont.t
29
+
end
30
+
31
+
(** {1 Session} *)
32
+
33
+
(** The JMAP session resource. *)
34
+
type t = {
35
+
capabilities : (string * Jsont.json) list;
36
+
(** Server capabilities. Keys are capability URIs. *)
37
+
accounts : (Id.t * Account.t) list;
38
+
(** Available accounts keyed by account id. *)
39
+
primary_accounts : (string * Id.t) list;
40
+
(** Map of capability URI to the primary account id for that capability. *)
41
+
username : string;
42
+
(** The username associated with the credentials. *)
43
+
api_url : string;
44
+
(** URL to POST JMAP requests to. *)
45
+
download_url : string;
46
+
(** URL template for downloading blobs. *)
47
+
upload_url : string;
48
+
(** URL template for uploading blobs. *)
49
+
event_source_url : string;
50
+
(** URL for push event source. *)
51
+
state : string;
52
+
(** Opaque session state string. *)
53
+
}
54
+
55
+
val capabilities : t -> (string * Jsont.json) list
56
+
val accounts : t -> (Id.t * Account.t) list
57
+
val primary_accounts : t -> (string * Id.t) list
58
+
val username : t -> string
59
+
val api_url : t -> string
60
+
val download_url : t -> string
61
+
val upload_url : t -> string
62
+
val event_source_url : t -> string
63
+
val state : t -> string
64
+
65
+
val jsont : t Jsont.t
66
+
(** JSON codec for session objects. *)
67
+
68
+
(** {1 Session Helpers} *)
69
+
70
+
val get_account : Id.t -> t -> Account.t option
71
+
(** [get_account id session] returns the account with the given id. *)
72
+
73
+
val primary_account_for : string -> t -> Id.t option
74
+
(** [primary_account_for capability session] returns the primary account
75
+
for the given capability URI. *)
76
+
77
+
val has_capability : string -> t -> bool
78
+
(** [has_capability uri session] returns [true] if the server supports the capability. *)
79
+
80
+
val get_core_capability : t -> Capability.Core.t option
81
+
(** [get_core_capability session] returns the parsed core capability. *)
82
+
83
+
val get_mail_capability : t -> Capability.Mail.t option
84
+
(** [get_mail_capability session] returns the parsed mail capability. *)
+14
proto/unknown.ml
+14
proto/unknown.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
type t = Jsont.json
7
+
8
+
let empty = Jsont.Object ([], Jsont.Meta.none)
9
+
10
+
let is_empty = function
11
+
| Jsont.Object ([], _) -> true
12
+
| _ -> false
13
+
14
+
let mems = Jsont.json_mems
+23
proto/unknown.mli
+23
proto/unknown.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Unknown field preservation for forward compatibility.
7
+
8
+
All JMAP objects preserve unknown fields to support future spec versions
9
+
and custom extensions. *)
10
+
11
+
type t = Jsont.json
12
+
(** Unknown or unrecognized JSON object members as a generic JSON value.
13
+
This is always an object containing the unknown fields. *)
14
+
15
+
val empty : t
16
+
(** [empty] is the empty set of unknown fields (an empty JSON object). *)
17
+
18
+
val is_empty : t -> bool
19
+
(** [is_empty u] returns [true] if there are no unknown fields. *)
20
+
21
+
val mems : (t, t, Jsont.mem list) Jsont.Object.Mems.map
22
+
(** [mems] is the jsont member map for preserving unknown fields.
23
+
Use with [Jsont.Object.keep_unknown]. *)
+10
test/proto/capability/valid/core.json
+10
test/proto/capability/valid/core.json
+6
test/proto/capability/valid/mail.json
+6
test/proto/capability/valid/mail.json
+7
test/proto/capability/valid/submission.json
+7
test/proto/capability/valid/submission.json
+1
test/proto/date/edge/microseconds.json
+1
test/proto/date/edge/microseconds.json
···
1
+
2024-01-15T10:30:00.123456Z
+1
test/proto/date/edge/negative_offset.json
+1
test/proto/date/edge/negative_offset.json
···
1
+
2024-01-15T10:30:00-08:00
+1
test/proto/date/invalid/bad_format.json
+1
test/proto/date/invalid/bad_format.json
···
1
+
January 15, 2024
+1
test/proto/date/invalid/invalid_date.json
+1
test/proto/date/invalid/invalid_date.json
···
1
+
2024-02-30T10:30:00Z
+1
test/proto/date/invalid/lowercase_t.json
+1
test/proto/date/invalid/lowercase_t.json
···
1
+
2024-01-15t10:30:00Z
+1
test/proto/date/invalid/lowercase_z.json
+1
test/proto/date/invalid/lowercase_z.json
···
1
+
2024-01-15T10:30:00z
+1
test/proto/date/invalid/missing_seconds.json
+1
test/proto/date/invalid/missing_seconds.json
···
1
+
2024-01-15T10:30Z
+1
test/proto/date/invalid/no_timezone.json
+1
test/proto/date/invalid/no_timezone.json
···
1
+
2024-01-15T10:30:00
+1
test/proto/date/invalid/not_string.json
+1
test/proto/date/invalid/not_string.json
···
1
+
1705315800
+1
test/proto/date/valid/negative_offset.json
+1
test/proto/date/valid/negative_offset.json
···
1
+
2024-01-15T10:30:00-08:00
+1
test/proto/date/valid/utc_z.json
+1
test/proto/date/valid/utc_z.json
···
1
+
2024-01-15T10:30:00Z
+1
test/proto/date/valid/with_milliseconds.json
+1
test/proto/date/valid/with_milliseconds.json
···
1
+
2024-01-15T10:30:00.123Z
+1
test/proto/date/valid/with_offset.json
+1
test/proto/date/valid/with_offset.json
···
1
+
2024-01-15T10:30:00+05:30
+17
test/proto/dune
+17
test/proto/dune
···
1
+
(test
2
+
(name test_proto)
3
+
(package jmap)
4
+
(libraries jmap jmap.mail alcotest jsont.bytesrw)
5
+
(deps
6
+
(source_tree id)
7
+
(source_tree int53)
8
+
(source_tree date)
9
+
(source_tree session)
10
+
(source_tree request)
11
+
(source_tree response)
12
+
(source_tree invocation)
13
+
(source_tree capability)
14
+
(source_tree filter)
15
+
(source_tree method)
16
+
(source_tree error)
17
+
(source_tree mail)))
+4
test/proto/error/valid/method_error.json
+4
test/proto/error/valid/method_error.json
+4
test/proto/error/valid/method_error_account_not_found.json
+4
test/proto/error/valid/method_error_account_not_found.json
+4
test/proto/error/valid/method_error_account_read_only.json
+4
test/proto/error/valid/method_error_account_read_only.json
+4
test/proto/error/valid/method_error_forbidden.json
+4
test/proto/error/valid/method_error_forbidden.json
+4
test/proto/error/valid/method_error_invalid_arguments.json
+4
test/proto/error/valid/method_error_invalid_arguments.json
+4
test/proto/error/valid/method_error_server_fail.json
+4
test/proto/error/valid/method_error_server_fail.json
+5
test/proto/error/valid/request_error.json
+5
test/proto/error/valid/request_error.json
+6
test/proto/error/valid/request_error_limit.json
+6
test/proto/error/valid/request_error_limit.json
+5
test/proto/error/valid/request_error_not_json.json
+5
test/proto/error/valid/request_error_not_json.json
+5
test/proto/error/valid/set_error.json
+5
test/proto/error/valid/set_error.json
+4
test/proto/error/valid/set_error_forbidden.json
+4
test/proto/error/valid/set_error_forbidden.json
+5
test/proto/error/valid/set_error_invalid_properties.json
+5
test/proto/error/valid/set_error_invalid_properties.json
+4
test/proto/error/valid/set_error_not_found.json
+4
test/proto/error/valid/set_error_not_found.json
+4
test/proto/error/valid/set_error_over_quota.json
+4
test/proto/error/valid/set_error_over_quota.json
+4
test/proto/error/valid/set_error_singleton.json
+4
test/proto/error/valid/set_error_singleton.json
+4
test/proto/filter/edge/empty_conditions.json
+4
test/proto/filter/edge/empty_conditions.json
+7
test/proto/filter/valid/and_operator.json
+7
test/proto/filter/valid/and_operator.json
+4
test/proto/filter/valid/comparator_descending.json
+4
test/proto/filter/valid/comparator_descending.json
+5
test/proto/filter/valid/comparator_with_collation.json
+5
test/proto/filter/valid/comparator_with_collation.json
+18
test/proto/filter/valid/deeply_nested.json
+18
test/proto/filter/valid/deeply_nested.json
+19
test/proto/filter/valid/nested.json
+19
test/proto/filter/valid/nested.json
···
1
+
{
2
+
"operator": "AND",
3
+
"conditions": [
4
+
{"inMailbox": "inbox"},
5
+
{
6
+
"operator": "OR",
7
+
"conditions": [
8
+
{"from": "boss@company.com"},
9
+
{"hasKeyword": "$important"}
10
+
]
11
+
},
12
+
{
13
+
"operator": "NOT",
14
+
"conditions": [
15
+
{"hasKeyword": "$seen"}
16
+
]
17
+
}
18
+
]
19
+
}
+13
test/proto/filter/valid/nested_and_or.json
+13
test/proto/filter/valid/nested_and_or.json
+6
test/proto/filter/valid/not_operator.json
+6
test/proto/filter/valid/not_operator.json
+7
test/proto/filter/valid/or_operator.json
+7
test/proto/filter/valid/or_operator.json
+1
test/proto/id/edge/creation_ref.json
+1
test/proto/id/edge/creation_ref.json
···
1
+
#newEmail1
+1
test/proto/id/edge/digits_only.json
+1
test/proto/id/edge/digits_only.json
···
1
+
123456789
+1
test/proto/id/edge/max_length_255.json
+1
test/proto/id/edge/max_length_255.json
···
1
+
aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
+1
test/proto/id/edge/nil_literal.json
+1
test/proto/id/edge/nil_literal.json
···
1
+
NIL
+1
test/proto/id/edge/over_max_length_256.json
+1
test/proto/id/edge/over_max_length_256.json
···
1
+
aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
+1
test/proto/id/edge/starts_with_dash.json
+1
test/proto/id/edge/starts_with_dash.json
···
1
+
-abc123
+1
test/proto/id/edge/starts_with_digit.json
+1
test/proto/id/edge/starts_with_digit.json
···
1
+
1abc
test/proto/id/invalid/empty.json
test/proto/id/invalid/empty.json
This is a binary file and will not be displayed.
+1
test/proto/id/invalid/not_string.json
+1
test/proto/id/invalid/not_string.json
···
1
+
12345
+1
test/proto/id/invalid/null.json
+1
test/proto/id/invalid/null.json
···
1
+
null
+1
test/proto/id/invalid/with_slash.json
+1
test/proto/id/invalid/with_slash.json
···
1
+
abc/def
+1
test/proto/id/invalid/with_space.json
+1
test/proto/id/invalid/with_space.json
···
1
+
hello world
+1
test/proto/id/invalid/with_special.json
+1
test/proto/id/invalid/with_special.json
···
1
+
abc@def
+1
test/proto/id/valid/alphanumeric.json
+1
test/proto/id/valid/alphanumeric.json
···
1
+
ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789
+1
test/proto/id/valid/base64_like.json
+1
test/proto/id/valid/base64_like.json
···
1
+
dXNlcl8xMjM0NTY3ODkw
+1
test/proto/id/valid/simple.json
+1
test/proto/id/valid/simple.json
···
1
+
abc123
+1
test/proto/id/valid/single_char.json
+1
test/proto/id/valid/single_char.json
···
1
+
a
+1
test/proto/id/valid/uuid_style.json
+1
test/proto/id/valid/uuid_style.json
···
1
+
550e8400-e29b-41d4-a716-446655440000
+1
test/proto/id/valid/with_hyphen.json
+1
test/proto/id/valid/with_hyphen.json
···
1
+
msg-2024-01-15-abcdef
+1
test/proto/id/valid/with_underscore.json
+1
test/proto/id/valid/with_underscore.json
···
1
+
user_123_abc
+1
test/proto/int53/edge/over_max_safe.json
+1
test/proto/int53/edge/over_max_safe.json
···
1
+
9007199254740992
+1
test/proto/int53/edge/under_min_safe.json
+1
test/proto/int53/edge/under_min_safe.json
···
1
+
-9007199254740992
+1
test/proto/int53/invalid/float.json
+1
test/proto/int53/invalid/float.json
···
1
+
123.456
+1
test/proto/int53/invalid/leading_zero.json
+1
test/proto/int53/invalid/leading_zero.json
···
1
+
0123
+1
test/proto/int53/invalid/null.json
+1
test/proto/int53/invalid/null.json
···
1
+
null
+1
test/proto/int53/invalid/scientific.json
+1
test/proto/int53/invalid/scientific.json
···
1
+
1e5
+1
test/proto/int53/invalid/string.json
+1
test/proto/int53/invalid/string.json
···
1
+
12345
+1
test/proto/int53/valid/max_safe.json
+1
test/proto/int53/valid/max_safe.json
···
1
+
9007199254740991
+1
test/proto/int53/valid/min_safe.json
+1
test/proto/int53/valid/min_safe.json
···
1
+
-9007199254740991
+1
test/proto/int53/valid/negative.json
+1
test/proto/int53/valid/negative.json
···
1
+
-12345
+1
test/proto/int53/valid/positive.json
+1
test/proto/int53/valid/positive.json
···
1
+
12345
+1
test/proto/int53/valid/zero.json
+1
test/proto/int53/valid/zero.json
···
1
+
0
+1
test/proto/invocation/invalid/not_array.json
+1
test/proto/invocation/invalid/not_array.json
···
1
+
{"method": "Email/get", "args": {}, "callId": "c1"}
+1
test/proto/invocation/invalid/wrong_length.json
+1
test/proto/invocation/invalid/wrong_length.json
···
1
+
["Email/get", {"accountId": "acc1"}]
+1
test/proto/invocation/valid/get.json
+1
test/proto/invocation/valid/get.json
···
1
+
["Email/get", {"accountId": "acc1", "ids": ["e1", "e2"]}, "call-001"]
+1
test/proto/invocation/valid/query.json
+1
test/proto/invocation/valid/query.json
···
1
+
["Email/query", {"accountId": "acc1", "filter": {"inMailbox": "inbox"}, "sort": [{"property": "receivedAt", "isAscending": false}], "limit": 50}, "call-003"]
+1
test/proto/invocation/valid/set.json
+1
test/proto/invocation/valid/set.json
···
1
+
["Mailbox/set", {"accountId": "acc1", "create": {"temp1": {"name": "Drafts"}}}, "call-002"]
+11
test/proto/mail/email/edge/empty_keywords.json
+11
test/proto/mail/email/edge/empty_keywords.json
+14
test/proto/mail/email/valid/draft_email.json
+14
test/proto/mail/email/valid/draft_email.json
···
1
+
{
2
+
"id": "e3",
3
+
"blobId": "blob3",
4
+
"threadId": "t3",
5
+
"size": 512,
6
+
"receivedAt": "2024-01-17T14:00:00Z",
7
+
"mailboxIds": {"drafts": true},
8
+
"keywords": {"$draft": true},
9
+
"from": [{"name": "Me", "email": "me@example.com"}],
10
+
"to": [{"name": "You", "email": "you@example.com"}],
11
+
"subject": "Draft: Meeting notes",
12
+
"hasAttachment": false,
13
+
"preview": "This is a draft email"
14
+
}
+30
test/proto/mail/email/valid/full.json
+30
test/proto/mail/email/valid/full.json
···
1
+
{
2
+
"id": "e2",
3
+
"blobId": "blob2",
4
+
"threadId": "t2",
5
+
"mailboxIds": {"inbox": true, "important": true},
6
+
"keywords": {"$seen": true, "$flagged": true, "$answered": true},
7
+
"size": 5000,
8
+
"receivedAt": "2024-01-15T14:30:00Z",
9
+
"messageId": ["msg123@example.com"],
10
+
"inReplyTo": ["msg100@example.com"],
11
+
"references": ["msg100@example.com", "msg99@example.com"],
12
+
"sender": [{"name": "Alice Smith", "email": "alice@example.com"}],
13
+
"from": [{"name": "Alice Smith", "email": "alice@example.com"}],
14
+
"to": [{"name": "Bob Jones", "email": "bob@example.com"}],
15
+
"cc": [{"name": "Carol White", "email": "carol@example.com"}],
16
+
"bcc": [],
17
+
"replyTo": [{"email": "alice-reply@example.com"}],
18
+
"subject": "Re: Important meeting",
19
+
"sentAt": "2024-01-15T14:29:00Z",
20
+
"hasAttachment": true,
21
+
"preview": "Thanks for the update. I'll review the documents and get back to you by...",
22
+
"bodyValues": {
23
+
"1": {"value": "Thanks for the update.\n\nI'll review the documents.", "isEncodingProblem": false, "isTruncated": false}
24
+
},
25
+
"textBody": [{"partId": "1", "type": "text/plain"}],
26
+
"htmlBody": [],
27
+
"attachments": [
28
+
{"partId": "2", "blobId": "attach1", "type": "application/pdf", "name": "document.pdf", "size": 12345}
29
+
]
30
+
}
+9
test/proto/mail/email/valid/minimal.json
+9
test/proto/mail/email/valid/minimal.json
+15
test/proto/mail/email/valid/multiple_mailboxes.json
+15
test/proto/mail/email/valid/multiple_mailboxes.json
···
1
+
{
2
+
"id": "e2",
3
+
"blobId": "blob2",
4
+
"threadId": "t2",
5
+
"size": 4096,
6
+
"receivedAt": "2024-01-16T08:00:00Z",
7
+
"mailboxIds": {
8
+
"inbox": true,
9
+
"important": true,
10
+
"work": true
11
+
},
12
+
"keywords": {"$seen": true},
13
+
"hasAttachment": false,
14
+
"preview": "Email in multiple mailboxes"
15
+
}
+18
test/proto/mail/email/valid/with_all_system_keywords.json
+18
test/proto/mail/email/valid/with_all_system_keywords.json
···
1
+
{
2
+
"id": "e4",
3
+
"blobId": "blob4",
4
+
"threadId": "t4",
5
+
"size": 8192,
6
+
"receivedAt": "2024-01-18T09:00:00Z",
7
+
"mailboxIds": {"mb1": true},
8
+
"keywords": {
9
+
"$draft": true,
10
+
"$seen": true,
11
+
"$flagged": true,
12
+
"$answered": true,
13
+
"$forwarded": true,
14
+
"custom-keyword": true
15
+
},
16
+
"hasAttachment": false,
17
+
"preview": "Email with all system keywords"
18
+
}
+16
test/proto/mail/email/valid/with_headers.json
+16
test/proto/mail/email/valid/with_headers.json
···
1
+
{
2
+
"id": "e3",
3
+
"blobId": "blob3",
4
+
"threadId": "t3",
5
+
"mailboxIds": {"inbox": true},
6
+
"keywords": {},
7
+
"size": 2048,
8
+
"receivedAt": "2024-01-16T09:00:00Z",
9
+
"headers": [
10
+
{"name": "X-Priority", "value": "1"},
11
+
{"name": "X-Mailer", "value": "Test Client 1.0"},
12
+
{"name": "List-Unsubscribe", "value": "<mailto:unsubscribe@example.com>"}
13
+
],
14
+
"header:X-Priority:asText": "1",
15
+
"header:X-Mailer:asText": "Test Client 1.0"
16
+
}
+15
test/proto/mail/email/valid/with_keywords.json
+15
test/proto/mail/email/valid/with_keywords.json
···
1
+
{
2
+
"id": "e1",
3
+
"blobId": "blob1",
4
+
"threadId": "t1",
5
+
"size": 2048,
6
+
"receivedAt": "2024-01-15T10:30:00Z",
7
+
"mailboxIds": {"mb1": true},
8
+
"keywords": {
9
+
"$seen": true,
10
+
"$flagged": true,
11
+
"$answered": true
12
+
},
13
+
"hasAttachment": false,
14
+
"preview": "This is a flagged and answered email"
15
+
}
+15
test/proto/mail/email/valid/with_message_ids.json
+15
test/proto/mail/email/valid/with_message_ids.json
···
1
+
{
2
+
"id": "e6",
3
+
"blobId": "blob6",
4
+
"threadId": "t6",
5
+
"size": 4096,
6
+
"receivedAt": "2024-01-20T16:00:00Z",
7
+
"mailboxIds": {"inbox": true},
8
+
"keywords": {"$seen": true},
9
+
"messageId": ["unique-123@example.com"],
10
+
"inReplyTo": ["parent-456@example.com"],
11
+
"references": ["root-001@example.com", "parent-456@example.com"],
12
+
"subject": "Re: Original thread",
13
+
"hasAttachment": false,
14
+
"preview": "Reply in thread"
15
+
}
+3
test/proto/mail/email_address/valid/email_only.json
+3
test/proto/mail/email_address/valid/email_only.json
+4
test/proto/mail/email_address/valid/full.json
+4
test/proto/mail/email_address/valid/full.json
+28
test/proto/mail/email_body/edge/deep_nesting.json
+28
test/proto/mail/email_body/edge/deep_nesting.json
···
1
+
{
2
+
"partId": "0",
3
+
"size": 20000,
4
+
"type": "multipart/mixed",
5
+
"subParts": [
6
+
{
7
+
"partId": "1",
8
+
"size": 15000,
9
+
"type": "multipart/mixed",
10
+
"subParts": [
11
+
{
12
+
"partId": "1.1",
13
+
"size": 10000,
14
+
"type": "multipart/alternative",
15
+
"subParts": [
16
+
{
17
+
"partId": "1.1.1",
18
+
"blobId": "b1",
19
+
"size": 500,
20
+
"type": "text/plain",
21
+
"charset": "utf-8"
22
+
}
23
+
]
24
+
}
25
+
]
26
+
}
27
+
]
28
+
}
+21
test/proto/mail/email_body/valid/multipart.json
+21
test/proto/mail/email_body/valid/multipart.json
···
1
+
{
2
+
"partId": "0",
3
+
"size": 5000,
4
+
"type": "multipart/alternative",
5
+
"subParts": [
6
+
{
7
+
"partId": "1",
8
+
"blobId": "b1",
9
+
"size": 200,
10
+
"type": "text/plain",
11
+
"charset": "utf-8"
12
+
},
13
+
{
14
+
"partId": "2",
15
+
"blobId": "b2",
16
+
"size": 4800,
17
+
"type": "text/html",
18
+
"charset": "utf-8"
19
+
}
20
+
]
21
+
}
+36
test/proto/mail/email_body/valid/multipart_mixed.json
+36
test/proto/mail/email_body/valid/multipart_mixed.json
···
1
+
{
2
+
"partId": "0",
3
+
"size": 10000,
4
+
"type": "multipart/mixed",
5
+
"subParts": [
6
+
{
7
+
"partId": "1",
8
+
"size": 5000,
9
+
"type": "multipart/alternative",
10
+
"subParts": [
11
+
{
12
+
"partId": "1.1",
13
+
"blobId": "b1",
14
+
"size": 500,
15
+
"type": "text/plain",
16
+
"charset": "utf-8"
17
+
},
18
+
{
19
+
"partId": "1.2",
20
+
"blobId": "b2",
21
+
"size": 4500,
22
+
"type": "text/html",
23
+
"charset": "utf-8"
24
+
}
25
+
]
26
+
},
27
+
{
28
+
"partId": "2",
29
+
"blobId": "b3",
30
+
"size": 5000,
31
+
"type": "application/pdf",
32
+
"name": "document.pdf",
33
+
"disposition": "attachment"
34
+
}
35
+
]
36
+
}
+9
test/proto/mail/email_body/valid/text_part.json
+9
test/proto/mail/email_body/valid/text_part.json
+23
test/proto/mail/email_body/valid/with_inline_image.json
+23
test/proto/mail/email_body/valid/with_inline_image.json
···
1
+
{
2
+
"partId": "0",
3
+
"size": 50000,
4
+
"type": "multipart/related",
5
+
"subParts": [
6
+
{
7
+
"partId": "1",
8
+
"blobId": "b1",
9
+
"size": 2000,
10
+
"type": "text/html",
11
+
"charset": "utf-8"
12
+
},
13
+
{
14
+
"partId": "2",
15
+
"blobId": "b2",
16
+
"size": 48000,
17
+
"type": "image/png",
18
+
"name": "logo.png",
19
+
"disposition": "inline",
20
+
"cid": "logo@example.com"
21
+
}
22
+
]
23
+
}
+9
test/proto/mail/email_body/valid/with_language.json
+9
test/proto/mail/email_body/valid/with_language.json
+9
test/proto/mail/identity/valid/simple.json
+9
test/proto/mail/identity/valid/simple.json
···
1
+
{
2
+
"id": "ident1",
3
+
"name": "Work Identity",
4
+
"email": "john.doe@company.com",
5
+
"replyTo": [{"email": "john.doe@company.com"}],
6
+
"textSignature": "-- \nJohn Doe\nSenior Engineer",
7
+
"htmlSignature": "<p>-- </p><p><b>John Doe</b><br/>Senior Engineer</p>",
8
+
"mayDelete": true
9
+
}
+21
test/proto/mail/mailbox/edge/all_rights_false.json
+21
test/proto/mail/mailbox/edge/all_rights_false.json
···
1
+
{
2
+
"id": "mbReadOnly",
3
+
"name": "Read Only Folder",
4
+
"sortOrder": 99,
5
+
"totalEmails": 50,
6
+
"unreadEmails": 10,
7
+
"totalThreads": 40,
8
+
"unreadThreads": 8,
9
+
"myRights": {
10
+
"mayReadItems": true,
11
+
"mayAddItems": false,
12
+
"mayRemoveItems": false,
13
+
"maySetSeen": false,
14
+
"maySetKeywords": false,
15
+
"mayCreateChild": false,
16
+
"mayRename": false,
17
+
"mayDelete": false,
18
+
"maySubmit": false
19
+
},
20
+
"isSubscribed": false
21
+
}
+12
test/proto/mail/mailbox/valid/all_roles.json
+12
test/proto/mail/mailbox/valid/all_roles.json
···
1
+
[
2
+
{"id": "r1", "name": "Inbox", "role": "inbox", "sortOrder": 1},
3
+
{"id": "r2", "name": "Drafts", "role": "drafts", "sortOrder": 2},
4
+
{"id": "r3", "name": "Sent", "role": "sent", "sortOrder": 3},
5
+
{"id": "r4", "name": "Junk", "role": "junk", "sortOrder": 4},
6
+
{"id": "r5", "name": "Trash", "role": "trash", "sortOrder": 5},
7
+
{"id": "r6", "name": "Archive", "role": "archive", "sortOrder": 6},
8
+
{"id": "r7", "name": "All", "role": "all", "sortOrder": 7},
9
+
{"id": "r8", "name": "Important", "role": "important", "sortOrder": 8},
10
+
{"id": "r9", "name": "Scheduled", "role": "scheduled", "sortOrder": 9},
11
+
{"id": "r10", "name": "Subscribed", "role": "subscribed", "sortOrder": 10}
12
+
]
+22
test/proto/mail/mailbox/valid/nested.json
+22
test/proto/mail/mailbox/valid/nested.json
···
1
+
{
2
+
"id": "mb2",
3
+
"name": "Work",
4
+
"parentId": "mb1",
5
+
"sortOrder": 10,
6
+
"totalEmails": 0,
7
+
"unreadEmails": 0,
8
+
"totalThreads": 0,
9
+
"unreadThreads": 0,
10
+
"myRights": {
11
+
"mayReadItems": true,
12
+
"mayAddItems": true,
13
+
"mayRemoveItems": true,
14
+
"maySetSeen": true,
15
+
"maySetKeywords": true,
16
+
"mayCreateChild": true,
17
+
"mayRename": true,
18
+
"mayDelete": true,
19
+
"maySubmit": false
20
+
},
21
+
"isSubscribed": false
22
+
}
+22
test/proto/mail/mailbox/valid/simple.json
+22
test/proto/mail/mailbox/valid/simple.json
···
1
+
{
2
+
"id": "mb1",
3
+
"name": "Inbox",
4
+
"role": "inbox",
5
+
"sortOrder": 1,
6
+
"totalEmails": 150,
7
+
"unreadEmails": 5,
8
+
"totalThreads": 100,
9
+
"unreadThreads": 3,
10
+
"myRights": {
11
+
"mayReadItems": true,
12
+
"mayAddItems": true,
13
+
"mayRemoveItems": true,
14
+
"maySetSeen": true,
15
+
"maySetKeywords": true,
16
+
"mayCreateChild": true,
17
+
"mayRename": false,
18
+
"mayDelete": false,
19
+
"maySubmit": true
20
+
},
21
+
"isSubscribed": true
22
+
}
+22
test/proto/mail/mailbox/valid/with_all_roles.json
+22
test/proto/mail/mailbox/valid/with_all_roles.json
···
1
+
{
2
+
"id": "mbArchive",
3
+
"name": "Archive",
4
+
"role": "archive",
5
+
"sortOrder": 5,
6
+
"totalEmails": 1000,
7
+
"unreadEmails": 0,
8
+
"totalThreads": 800,
9
+
"unreadThreads": 0,
10
+
"myRights": {
11
+
"mayReadItems": true,
12
+
"mayAddItems": true,
13
+
"mayRemoveItems": true,
14
+
"maySetSeen": true,
15
+
"maySetKeywords": true,
16
+
"mayCreateChild": true,
17
+
"mayRename": true,
18
+
"mayDelete": true,
19
+
"maySubmit": false
20
+
},
21
+
"isSubscribed": true
22
+
}
+21
test/proto/mail/submission/valid/final_status.json
+21
test/proto/mail/submission/valid/final_status.json
···
1
+
{
2
+
"id": "sub3",
3
+
"identityId": "ident1",
4
+
"emailId": "e2",
5
+
"threadId": "t2",
6
+
"envelope": {
7
+
"mailFrom": {"email": "sender@example.com"},
8
+
"rcptTo": [{"email": "recipient@example.com"}]
9
+
},
10
+
"sendAt": "2024-01-15T12:00:00Z",
11
+
"undoStatus": "final",
12
+
"deliveryStatus": {
13
+
"recipient@example.com": {
14
+
"smtpReply": "250 2.0.0 OK",
15
+
"delivered": "yes",
16
+
"displayed": "unknown"
17
+
}
18
+
},
19
+
"dsnBlobIds": [],
20
+
"mdnBlobIds": []
21
+
}
+14
test/proto/mail/submission/valid/simple.json
+14
test/proto/mail/submission/valid/simple.json
···
1
+
{
2
+
"id": "sub1",
3
+
"identityId": "ident1",
4
+
"emailId": "e1",
5
+
"threadId": "t1",
6
+
"envelope": {
7
+
"mailFrom": {"email": "sender@example.com"},
8
+
"rcptTo": [{"email": "recipient@example.com"}]
9
+
},
10
+
"sendAt": "2024-01-15T15:00:00Z",
11
+
"undoStatus": "pending",
12
+
"dsnBlobIds": [],
13
+
"mdnBlobIds": []
14
+
}
+20
test/proto/mail/submission/valid/with_envelope.json
+20
test/proto/mail/submission/valid/with_envelope.json
···
1
+
{
2
+
"id": "sub2",
3
+
"identityId": "ident1",
4
+
"emailId": "e1",
5
+
"threadId": "t1",
6
+
"envelope": {
7
+
"mailFrom": {
8
+
"email": "sender@example.com",
9
+
"parameters": {"SIZE": "1024", "BODY": "8BITMIME"}
10
+
},
11
+
"rcptTo": [
12
+
{"email": "recipient1@example.com"},
13
+
{"email": "recipient2@example.com", "parameters": {"NOTIFY": "SUCCESS,FAILURE"}}
14
+
]
15
+
},
16
+
"sendAt": "2024-01-15T15:00:00Z",
17
+
"undoStatus": "pending",
18
+
"dsnBlobIds": [],
19
+
"mdnBlobIds": []
20
+
}
+4
test/proto/mail/thread/valid/conversation.json
+4
test/proto/mail/thread/valid/conversation.json
+4
test/proto/mail/vacation/valid/disabled.json
+4
test/proto/mail/vacation/valid/disabled.json
+9
test/proto/mail/vacation/valid/enabled.json
+9
test/proto/mail/vacation/valid/enabled.json
···
1
+
{
2
+
"id": "singleton",
3
+
"isEnabled": true,
4
+
"fromDate": "2024-01-20T00:00:00Z",
5
+
"toDate": "2024-01-27T23:59:59Z",
6
+
"subject": "Out of Office",
7
+
"textBody": "I am currently out of the office and will return on January 27th.",
8
+
"htmlBody": "<p>I am currently out of the office and will return on January 27th.</p>"
9
+
}
+9
test/proto/method/valid/changes_response.json
+9
test/proto/method/valid/changes_response.json
+5
test/proto/method/valid/get_args.json
+5
test/proto/method/valid/get_args.json
+16
test/proto/method/valid/query_args.json
+16
test/proto/method/valid/query_args.json
···
1
+
{
2
+
"accountId": "acc1",
3
+
"filter": {
4
+
"operator": "AND",
5
+
"conditions": [
6
+
{"inMailbox": "inbox"},
7
+
{"hasKeyword": "$seen"}
8
+
]
9
+
},
10
+
"sort": [
11
+
{"property": "receivedAt", "isAscending": false}
12
+
],
13
+
"position": 0,
14
+
"limit": 100,
15
+
"calculateTotal": true
16
+
}
+8
test/proto/method/valid/query_response.json
+8
test/proto/method/valid/query_response.json
+12
test/proto/method/valid/set_args.json
+12
test/proto/method/valid/set_args.json
+16
test/proto/method/valid/set_response.json
+16
test/proto/method/valid/set_response.json
···
1
+
{
2
+
"accountId": "acc1",
3
+
"oldState": "state123",
4
+
"newState": "state456",
5
+
"created": {
6
+
"new1": {"id": "mb123", "name": "Folder 1"},
7
+
"new2": {"id": "mb456", "name": "Folder 2"}
8
+
},
9
+
"updated": {
10
+
"existing1": null
11
+
},
12
+
"destroyed": ["old1", "old2"],
13
+
"notCreated": {},
14
+
"notUpdated": {},
15
+
"notDestroyed": {}
16
+
}
+19
test/proto/method/valid/set_response_with_errors.json
+19
test/proto/method/valid/set_response_with_errors.json
···
1
+
{
2
+
"accountId": "acc1",
3
+
"oldState": "state123",
4
+
"newState": "state124",
5
+
"created": {
6
+
"new1": {"id": "mb789", "name": "Success Folder"}
7
+
},
8
+
"updated": {},
9
+
"destroyed": [],
10
+
"notCreated": {
11
+
"new2": {"type": "invalidProperties", "properties": ["name"]}
12
+
},
13
+
"notUpdated": {
14
+
"existing1": {"type": "notFound"}
15
+
},
16
+
"notDestroyed": {
17
+
"old1": {"type": "forbidden", "description": "Cannot delete inbox"}
18
+
}
19
+
}
+5
test/proto/request/invalid/missing_using.json
+5
test/proto/request/invalid/missing_using.json
+1
test/proto/request/invalid/not_object.json
+1
test/proto/request/invalid/not_object.json
···
1
+
["urn:ietf:params:jmap:core"]
+4
test/proto/request/valid/empty_methods.json
+4
test/proto/request/valid/empty_methods.json
+8
test/proto/request/valid/multiple_methods.json
+8
test/proto/request/valid/multiple_methods.json
···
1
+
{
2
+
"using": ["urn:ietf:params:jmap:core", "urn:ietf:params:jmap:mail"],
3
+
"methodCalls": [
4
+
["Mailbox/get", {"accountId": "acc1"}, "c1"],
5
+
["Email/query", {"accountId": "acc1", "filter": {"inMailbox": "inbox1"}}, "c2"],
6
+
["Email/get", {"accountId": "acc1", "#ids": {"resultOf": "c2", "name": "Email/query", "path": "/ids"}}, "c3"]
7
+
]
8
+
}
+6
test/proto/request/valid/single_method.json
+6
test/proto/request/valid/single_method.json
+9
test/proto/request/valid/with_created_ids.json
+9
test/proto/request/valid/with_created_ids.json
+20
test/proto/request/valid/with_creation_refs.json
+20
test/proto/request/valid/with_creation_refs.json
···
1
+
{
2
+
"using": ["urn:ietf:params:jmap:core", "urn:ietf:params:jmap:mail"],
3
+
"methodCalls": [
4
+
["Mailbox/set", {
5
+
"accountId": "acc1",
6
+
"create": {
7
+
"newBox": {"name": "New Folder", "parentId": null}
8
+
}
9
+
}, "c1"],
10
+
["Email/set", {
11
+
"accountId": "acc1",
12
+
"create": {
13
+
"draft1": {
14
+
"mailboxIds": {"#newBox": true},
15
+
"subject": "Draft in new folder"
16
+
}
17
+
}
18
+
}, "c2"]
19
+
]
20
+
}
+7
test/proto/request/valid/with_result_reference.json
+7
test/proto/request/valid/with_result_reference.json
···
1
+
{
2
+
"using": ["urn:ietf:params:jmap:core", "urn:ietf:params:jmap:mail"],
3
+
"methodCalls": [
4
+
["Mailbox/query", {"accountId": "acc1", "filter": {"role": "inbox"}}, "0"],
5
+
["Mailbox/get", {"accountId": "acc1", "#ids": {"resultOf": "0", "name": "Mailbox/query", "path": "/ids"}}, "1"]
6
+
]
7
+
}
+5
test/proto/response/invalid/missing_session_state.json
+5
test/proto/response/invalid/missing_session_state.json
+7
test/proto/response/valid/multiple_responses.json
+7
test/proto/response/valid/multiple_responses.json
···
1
+
{
2
+
"methodResponses": [
3
+
["Email/query", {"accountId": "acc1", "queryState": "q1", "canCalculateChanges": true, "position": 0, "ids": ["e1", "e2", "e3"], "total": 100}, "c1"],
4
+
["Email/get", {"accountId": "acc1", "state": "s1", "list": [{"id": "e1", "blobId": "b1", "threadId": "t1", "mailboxIds": {"inbox": true}, "keywords": {"$seen": true}, "size": 1234, "receivedAt": "2024-01-15T10:30:00Z"}], "notFound": []}, "c2"]
5
+
],
6
+
"sessionState": "sessionABC"
7
+
}
+6
test/proto/response/valid/success.json
+6
test/proto/response/valid/success.json
+9
test/proto/response/valid/with_created_ids.json
+9
test/proto/response/valid/with_created_ids.json
+6
test/proto/response/valid/with_error.json
+6
test/proto/response/valid/with_error.json
+22
test/proto/session/edge/empty_accounts.json
+22
test/proto/session/edge/empty_accounts.json
···
1
+
{
2
+
"capabilities": {
3
+
"urn:ietf:params:jmap:core": {
4
+
"maxSizeUpload": 50000000,
5
+
"maxConcurrentUpload": 4,
6
+
"maxSizeRequest": 10000000,
7
+
"maxConcurrentRequests": 4,
8
+
"maxCallsInRequest": 16,
9
+
"maxObjectsInGet": 500,
10
+
"maxObjectsInSet": 500,
11
+
"collationAlgorithms": []
12
+
}
13
+
},
14
+
"accounts": {},
15
+
"primaryAccounts": {},
16
+
"username": "anonymous",
17
+
"apiUrl": "https://api.example.com/jmap/",
18
+
"downloadUrl": "https://api.example.com/download/{accountId}/{blobId}/{name}",
19
+
"uploadUrl": "https://api.example.com/upload/{accountId}/",
20
+
"eventSourceUrl": "https://api.example.com/events/",
21
+
"state": "empty"
22
+
}
+10
test/proto/session/invalid/missing_api_url.json
+10
test/proto/session/invalid/missing_api_url.json
···
1
+
{
2
+
"capabilities": {},
3
+
"accounts": {},
4
+
"primaryAccounts": {},
5
+
"username": "test@example.com",
6
+
"downloadUrl": "https://api.example.com/download/",
7
+
"uploadUrl": "https://api.example.com/upload/",
8
+
"eventSourceUrl": "https://api.example.com/events/",
9
+
"state": "abc"
10
+
}
+17
test/proto/session/invalid/missing_capabilities.json
+17
test/proto/session/invalid/missing_capabilities.json
···
1
+
{
2
+
"accounts": {
3
+
"acc1": {
4
+
"name": "Test Account",
5
+
"isPersonal": true,
6
+
"isReadOnly": false,
7
+
"accountCapabilities": {}
8
+
}
9
+
},
10
+
"primaryAccounts": {},
11
+
"username": "test@example.com",
12
+
"apiUrl": "https://api.example.com/jmap/",
13
+
"downloadUrl": "https://api.example.com/download/",
14
+
"uploadUrl": "https://api.example.com/upload/",
15
+
"eventSourceUrl": "https://api.example.com/events/",
16
+
"state": "abc"
17
+
}
+31
test/proto/session/valid/minimal.json
+31
test/proto/session/valid/minimal.json
···
1
+
{
2
+
"capabilities": {
3
+
"urn:ietf:params:jmap:core": {
4
+
"maxSizeUpload": 50000000,
5
+
"maxConcurrentUpload": 4,
6
+
"maxSizeRequest": 10000000,
7
+
"maxConcurrentRequests": 4,
8
+
"maxCallsInRequest": 16,
9
+
"maxObjectsInGet": 500,
10
+
"maxObjectsInSet": 500,
11
+
"collationAlgorithms": ["i;ascii-casemap", "i;octet"]
12
+
}
13
+
},
14
+
"accounts": {
15
+
"acc1": {
16
+
"name": "Test Account",
17
+
"isPersonal": true,
18
+
"isReadOnly": false,
19
+
"accountCapabilities": {}
20
+
}
21
+
},
22
+
"primaryAccounts": {
23
+
"urn:ietf:params:jmap:core": "acc1"
24
+
},
25
+
"username": "test@example.com",
26
+
"apiUrl": "https://api.example.com/jmap/",
27
+
"downloadUrl": "https://api.example.com/jmap/download/{accountId}/{blobId}/{name}?type={type}",
28
+
"uploadUrl": "https://api.example.com/jmap/upload/{accountId}/",
29
+
"eventSourceUrl": "https://api.example.com/jmap/eventsource/",
30
+
"state": "abc123"
31
+
}
+44
test/proto/session/valid/with_accounts.json
+44
test/proto/session/valid/with_accounts.json
···
1
+
{
2
+
"capabilities": {
3
+
"urn:ietf:params:jmap:core": {
4
+
"maxSizeUpload": 50000000,
5
+
"maxConcurrentUpload": 4,
6
+
"maxSizeRequest": 10000000,
7
+
"maxConcurrentRequests": 4,
8
+
"maxCallsInRequest": 16,
9
+
"maxObjectsInGet": 500,
10
+
"maxObjectsInSet": 500,
11
+
"collationAlgorithms": ["i;ascii-casemap", "i;unicode-casemap"]
12
+
}
13
+
},
14
+
"accounts": {
15
+
"acc1": {
16
+
"name": "Personal Account",
17
+
"isPersonal": true,
18
+
"isReadOnly": false,
19
+
"accountCapabilities": {
20
+
"urn:ietf:params:jmap:core": {},
21
+
"urn:ietf:params:jmap:mail": {}
22
+
}
23
+
},
24
+
"acc2": {
25
+
"name": "Shared Account",
26
+
"isPersonal": false,
27
+
"isReadOnly": true,
28
+
"accountCapabilities": {
29
+
"urn:ietf:params:jmap:core": {},
30
+
"urn:ietf:params:jmap:mail": {}
31
+
}
32
+
}
33
+
},
34
+
"primaryAccounts": {
35
+
"urn:ietf:params:jmap:core": "acc1",
36
+
"urn:ietf:params:jmap:mail": "acc1"
37
+
},
38
+
"username": "user@example.com",
39
+
"apiUrl": "https://api.example.com/jmap/",
40
+
"downloadUrl": "https://api.example.com/download/{accountId}/{blobId}/{name}?accept={type}",
41
+
"uploadUrl": "https://api.example.com/upload/{accountId}/",
42
+
"eventSourceUrl": "https://api.example.com/eventsource/?types={types}&closeafter={closeafter}&ping={ping}",
43
+
"state": "session123"
44
+
}
+56
test/proto/session/valid/with_mail.json
+56
test/proto/session/valid/with_mail.json
···
1
+
{
2
+
"capabilities": {
3
+
"urn:ietf:params:jmap:core": {
4
+
"maxSizeUpload": 50000000,
5
+
"maxConcurrentUpload": 4,
6
+
"maxSizeRequest": 10000000,
7
+
"maxConcurrentRequests": 4,
8
+
"maxCallsInRequest": 16,
9
+
"maxObjectsInGet": 500,
10
+
"maxObjectsInSet": 500,
11
+
"collationAlgorithms": ["i;ascii-casemap", "i;octet"]
12
+
},
13
+
"urn:ietf:params:jmap:mail": {
14
+
"maxMailboxesPerEmail": 1000,
15
+
"maxMailboxDepth": 10,
16
+
"maxSizeMailboxName": 490,
17
+
"maxSizeAttachmentsPerEmail": 50000000,
18
+
"emailQuerySortOptions": ["receivedAt", "from", "to", "subject", "size"],
19
+
"mayCreateTopLevelMailbox": true
20
+
},
21
+
"urn:ietf:params:jmap:submission": {
22
+
"maxDelayedSend": 86400,
23
+
"submissionExtensions": {}
24
+
}
25
+
},
26
+
"accounts": {
27
+
"A001": {
28
+
"name": "Personal",
29
+
"isPersonal": true,
30
+
"isReadOnly": false,
31
+
"accountCapabilities": {
32
+
"urn:ietf:params:jmap:core": {},
33
+
"urn:ietf:params:jmap:mail": {}
34
+
}
35
+
},
36
+
"A002": {
37
+
"name": "Shared Archive",
38
+
"isPersonal": false,
39
+
"isReadOnly": true,
40
+
"accountCapabilities": {
41
+
"urn:ietf:params:jmap:mail": {}
42
+
}
43
+
}
44
+
},
45
+
"primaryAccounts": {
46
+
"urn:ietf:params:jmap:core": "A001",
47
+
"urn:ietf:params:jmap:mail": "A001",
48
+
"urn:ietf:params:jmap:submission": "A001"
49
+
},
50
+
"username": "john.doe@example.com",
51
+
"apiUrl": "https://jmap.example.com/api/",
52
+
"downloadUrl": "https://jmap.example.com/download/{accountId}/{blobId}/{name}?type={type}",
53
+
"uploadUrl": "https://jmap.example.com/upload/{accountId}/",
54
+
"eventSourceUrl": "https://jmap.example.com/events/?types={types}&closeafter={closeafter}&ping={ping}",
55
+
"state": "xyz789-session-state"
56
+
}
+987
test/proto/test_proto.ml
+987
test/proto/test_proto.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** JMAP Protocol codec tests using sample JSON files *)
7
+
8
+
let read_file path =
9
+
let ic = open_in path in
10
+
let n = in_channel_length ic in
11
+
let s = really_input_string ic n in
12
+
close_in ic;
13
+
s
14
+
15
+
let decode jsont json_str =
16
+
Jsont_bytesrw.decode_string' jsont json_str
17
+
18
+
let encode jsont value =
19
+
Jsont_bytesrw.encode_string' jsont value
20
+
21
+
(* Test helpers *)
22
+
23
+
let test_decode_success name jsont path () =
24
+
let json = read_file path in
25
+
match decode jsont json with
26
+
| Ok _ -> ()
27
+
| Error e ->
28
+
Alcotest.failf "%s: expected success but got error: %s" name (Jsont.Error.to_string e)
29
+
30
+
let test_decode_failure name jsont path () =
31
+
let json = read_file path in
32
+
match decode jsont json with
33
+
| Ok _ -> Alcotest.failf "%s: expected failure but got success" name
34
+
| Error _ -> ()
35
+
36
+
let test_roundtrip name jsont path () =
37
+
let json = read_file path in
38
+
match decode jsont json with
39
+
| Error e ->
40
+
Alcotest.failf "%s: decode failed: %s" name (Jsont.Error.to_string e)
41
+
| Ok value ->
42
+
match encode jsont value with
43
+
| Error e ->
44
+
Alcotest.failf "%s: encode failed: %s" name (Jsont.Error.to_string e)
45
+
| Ok encoded ->
46
+
match decode jsont encoded with
47
+
| Error e ->
48
+
Alcotest.failf "%s: re-decode failed: %s" name (Jsont.Error.to_string e)
49
+
| Ok _ -> ()
50
+
51
+
(* ID tests *)
52
+
module Id_tests = struct
53
+
open Jmap_proto
54
+
55
+
let test_valid_simple () =
56
+
let json = "\"abc123\"" in
57
+
match decode Id.jsont json with
58
+
| Ok id -> Alcotest.(check string) "id value" "abc123" (Id.to_string id)
59
+
| Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)
60
+
61
+
let test_valid_single_char () =
62
+
let json = "\"a\"" in
63
+
match decode Id.jsont json with
64
+
| Ok id -> Alcotest.(check string) "id value" "a" (Id.to_string id)
65
+
| Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)
66
+
67
+
let test_valid_with_hyphen () =
68
+
let json = "\"msg-2024-01\"" in
69
+
match decode Id.jsont json with
70
+
| Ok id -> Alcotest.(check string) "id value" "msg-2024-01" (Id.to_string id)
71
+
| Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)
72
+
73
+
let test_valid_with_underscore () =
74
+
let json = "\"user_id_123\"" in
75
+
match decode Id.jsont json with
76
+
| Ok id -> Alcotest.(check string) "id value" "user_id_123" (Id.to_string id)
77
+
| Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)
78
+
79
+
let test_invalid_empty () =
80
+
let json = "\"\"" in
81
+
match decode Id.jsont json with
82
+
| Ok _ -> Alcotest.fail "expected failure for empty id"
83
+
| Error _ -> ()
84
+
85
+
let test_invalid_with_space () =
86
+
let json = "\"hello world\"" in
87
+
match decode Id.jsont json with
88
+
| Ok _ -> Alcotest.fail "expected failure for id with space"
89
+
| Error _ -> ()
90
+
91
+
let test_invalid_with_special () =
92
+
let json = "\"abc@def\"" in
93
+
match decode Id.jsont json with
94
+
| Ok _ -> Alcotest.fail "expected failure for id with @"
95
+
| Error _ -> ()
96
+
97
+
let test_invalid_not_string () =
98
+
let json = "12345" in
99
+
match decode Id.jsont json with
100
+
| Ok _ -> Alcotest.fail "expected failure for non-string"
101
+
| Error _ -> ()
102
+
103
+
let test_edge_max_length () =
104
+
let id_255 = String.make 255 'a' in
105
+
let json = Printf.sprintf "\"%s\"" id_255 in
106
+
match decode Id.jsont json with
107
+
| Ok id -> Alcotest.(check int) "id length" 255 (String.length (Id.to_string id))
108
+
| Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)
109
+
110
+
let test_edge_over_max_length () =
111
+
let id_256 = String.make 256 'a' in
112
+
let json = Printf.sprintf "\"%s\"" id_256 in
113
+
match decode Id.jsont json with
114
+
| Ok _ -> Alcotest.fail "expected failure for 256 char id"
115
+
| Error _ -> ()
116
+
117
+
let tests = [
118
+
"valid: simple", `Quick, test_valid_simple;
119
+
"valid: single char", `Quick, test_valid_single_char;
120
+
"valid: with hyphen", `Quick, test_valid_with_hyphen;
121
+
"valid: with underscore", `Quick, test_valid_with_underscore;
122
+
"invalid: empty", `Quick, test_invalid_empty;
123
+
"invalid: with space", `Quick, test_invalid_with_space;
124
+
"invalid: with special", `Quick, test_invalid_with_special;
125
+
"invalid: not string", `Quick, test_invalid_not_string;
126
+
"edge: max length 255", `Quick, test_edge_max_length;
127
+
"edge: over max length 256", `Quick, test_edge_over_max_length;
128
+
]
129
+
end
130
+
131
+
(* Int53 tests *)
132
+
module Int53_tests = struct
133
+
open Jmap_proto
134
+
135
+
let test_zero () =
136
+
match decode Int53.Signed.jsont "0" with
137
+
| Ok n -> Alcotest.(check int64) "value" 0L n
138
+
| Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)
139
+
140
+
let test_positive () =
141
+
match decode Int53.Signed.jsont "12345" with
142
+
| Ok n -> Alcotest.(check int64) "value" 12345L n
143
+
| Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)
144
+
145
+
let test_negative () =
146
+
match decode Int53.Signed.jsont "-12345" with
147
+
| Ok n -> Alcotest.(check int64) "value" (-12345L) n
148
+
| Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)
149
+
150
+
let test_max_safe () =
151
+
match decode Int53.Signed.jsont "9007199254740991" with
152
+
| Ok n -> Alcotest.(check int64) "value" 9007199254740991L n
153
+
| Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)
154
+
155
+
let test_min_safe () =
156
+
match decode Int53.Signed.jsont "-9007199254740991" with
157
+
| Ok n -> Alcotest.(check int64) "value" (-9007199254740991L) n
158
+
| Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)
159
+
160
+
let test_over_max_safe () =
161
+
match decode Int53.Signed.jsont "9007199254740992" with
162
+
| Ok _ -> Alcotest.fail "expected failure for over max safe"
163
+
| Error _ -> ()
164
+
165
+
let test_under_min_safe () =
166
+
match decode Int53.Signed.jsont "-9007199254740992" with
167
+
| Ok _ -> Alcotest.fail "expected failure for under min safe"
168
+
| Error _ -> ()
169
+
170
+
let test_unsigned_zero () =
171
+
match decode Int53.Unsigned.jsont "0" with
172
+
| Ok n -> Alcotest.(check int64) "value" 0L n
173
+
| Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)
174
+
175
+
let test_unsigned_max () =
176
+
match decode Int53.Unsigned.jsont "9007199254740991" with
177
+
| Ok n -> Alcotest.(check int64) "value" 9007199254740991L n
178
+
| Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)
179
+
180
+
let test_unsigned_negative () =
181
+
match decode Int53.Unsigned.jsont "-1" with
182
+
| Ok _ -> Alcotest.fail "expected failure for negative unsigned"
183
+
| Error _ -> ()
184
+
185
+
let tests = [
186
+
"signed: zero", `Quick, test_zero;
187
+
"signed: positive", `Quick, test_positive;
188
+
"signed: negative", `Quick, test_negative;
189
+
"signed: max safe", `Quick, test_max_safe;
190
+
"signed: min safe", `Quick, test_min_safe;
191
+
"signed: over max safe", `Quick, test_over_max_safe;
192
+
"signed: under min safe", `Quick, test_under_min_safe;
193
+
"unsigned: zero", `Quick, test_unsigned_zero;
194
+
"unsigned: max", `Quick, test_unsigned_max;
195
+
"unsigned: negative fails", `Quick, test_unsigned_negative;
196
+
]
197
+
end
198
+
199
+
(* Date tests *)
200
+
module Date_tests = struct
201
+
open Jmap_proto
202
+
203
+
let test_utc_z () =
204
+
match decode Date.Utc.jsont "\"2024-01-15T10:30:00Z\"" with
205
+
| Ok _ -> ()
206
+
| Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)
207
+
208
+
let test_rfc3339_with_offset () =
209
+
match decode Date.Rfc3339.jsont "\"2024-01-15T10:30:00+05:30\"" with
210
+
| Ok _ -> ()
211
+
| Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)
212
+
213
+
let test_with_milliseconds () =
214
+
match decode Date.Rfc3339.jsont "\"2024-01-15T10:30:00.123Z\"" with
215
+
| Ok _ -> ()
216
+
| Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)
217
+
218
+
let test_invalid_format () =
219
+
match decode Date.Rfc3339.jsont "\"January 15, 2024\"" with
220
+
| Ok _ -> Alcotest.fail "expected failure for invalid format"
221
+
| Error _ -> ()
222
+
223
+
let test_not_string () =
224
+
match decode Date.Rfc3339.jsont "1705315800" with
225
+
| Ok _ -> Alcotest.fail "expected failure for non-string"
226
+
| Error _ -> ()
227
+
228
+
let tests = [
229
+
"utc: Z suffix", `Quick, test_utc_z;
230
+
"rfc3339: with offset", `Quick, test_rfc3339_with_offset;
231
+
"rfc3339: with milliseconds", `Quick, test_with_milliseconds;
232
+
"invalid: bad format", `Quick, test_invalid_format;
233
+
"invalid: not string", `Quick, test_not_string;
234
+
]
235
+
end
236
+
237
+
(* Session tests *)
238
+
module Session_tests = struct
239
+
open Jmap_proto
240
+
241
+
let test_minimal () =
242
+
test_decode_success "minimal session" Session.jsont "session/valid/minimal.json" ()
243
+
244
+
let test_with_mail () =
245
+
test_decode_success "session with mail" Session.jsont "session/valid/with_mail.json" ()
246
+
247
+
let test_roundtrip_minimal () =
248
+
test_roundtrip "minimal session roundtrip" Session.jsont "session/valid/minimal.json" ()
249
+
250
+
let test_values () =
251
+
let json = read_file "session/valid/minimal.json" in
252
+
match decode Session.jsont json with
253
+
| Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)
254
+
| Ok session ->
255
+
Alcotest.(check string) "username" "test@example.com" (Session.username session);
256
+
Alcotest.(check string) "apiUrl" "https://api.example.com/jmap/" (Session.api_url session);
257
+
Alcotest.(check string) "state" "abc123" (Session.state session);
258
+
Alcotest.(check bool) "has core capability" true
259
+
(Session.has_capability Capability.core session)
260
+
261
+
let test_with_accounts () =
262
+
test_decode_success "with accounts" Session.jsont "session/valid/with_accounts.json" ()
263
+
264
+
let test_empty_accounts () =
265
+
test_decode_success "empty accounts" Session.jsont "session/edge/empty_accounts.json" ()
266
+
267
+
let test_accounts_values () =
268
+
let json = read_file "session/valid/with_accounts.json" in
269
+
match decode Session.jsont json with
270
+
| Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)
271
+
| Ok session ->
272
+
Alcotest.(check int) "accounts count" 2 (List.length (Session.accounts session));
273
+
Alcotest.(check int) "primary_accounts count" 2 (List.length (Session.primary_accounts session))
274
+
275
+
let tests = [
276
+
"valid: minimal", `Quick, test_minimal;
277
+
"valid: with mail", `Quick, test_with_mail;
278
+
"valid: with accounts", `Quick, test_with_accounts;
279
+
"edge: empty accounts", `Quick, test_empty_accounts;
280
+
"roundtrip: minimal", `Quick, test_roundtrip_minimal;
281
+
"values: minimal", `Quick, test_values;
282
+
"values: accounts", `Quick, test_accounts_values;
283
+
]
284
+
end
285
+
286
+
(* Request tests *)
287
+
module Request_tests = struct
288
+
open Jmap_proto
289
+
290
+
let test_single_method () =
291
+
test_decode_success "single method" Request.jsont "request/valid/single_method.json" ()
292
+
293
+
let test_multiple_methods () =
294
+
test_decode_success "multiple methods" Request.jsont "request/valid/multiple_methods.json" ()
295
+
296
+
let test_with_created_ids () =
297
+
test_decode_success "with created ids" Request.jsont "request/valid/with_created_ids.json" ()
298
+
299
+
let test_empty_methods () =
300
+
test_decode_success "empty methods" Request.jsont "request/valid/empty_methods.json" ()
301
+
302
+
let test_values () =
303
+
let json = read_file "request/valid/single_method.json" in
304
+
match decode Request.jsont json with
305
+
| Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)
306
+
| Ok request ->
307
+
Alcotest.(check int) "using count" 2 (List.length (Request.using request));
308
+
Alcotest.(check int) "method calls count" 1 (List.length (Request.method_calls request))
309
+
310
+
let test_roundtrip () =
311
+
test_roundtrip "single method roundtrip" Request.jsont "request/valid/single_method.json" ()
312
+
313
+
let tests = [
314
+
"valid: single method", `Quick, test_single_method;
315
+
"valid: multiple methods", `Quick, test_multiple_methods;
316
+
"valid: with created ids", `Quick, test_with_created_ids;
317
+
"valid: empty methods", `Quick, test_empty_methods;
318
+
"values: single method", `Quick, test_values;
319
+
"roundtrip: single method", `Quick, test_roundtrip;
320
+
]
321
+
end
322
+
323
+
(* Response tests *)
324
+
module Response_tests = struct
325
+
open Jmap_proto
326
+
327
+
let test_success () =
328
+
test_decode_success "success" Response.jsont "response/valid/success.json" ()
329
+
330
+
let test_with_created_ids () =
331
+
test_decode_success "with created ids" Response.jsont "response/valid/with_created_ids.json" ()
332
+
333
+
let test_with_error () =
334
+
test_decode_success "with error" Response.jsont "response/valid/with_error.json" ()
335
+
336
+
let test_multiple_responses () =
337
+
test_decode_success "multiple responses" Response.jsont "response/valid/multiple_responses.json" ()
338
+
339
+
let test_values () =
340
+
let json = read_file "response/valid/success.json" in
341
+
match decode Response.jsont json with
342
+
| Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)
343
+
| Ok response ->
344
+
Alcotest.(check string) "session state" "session123" (Response.session_state response);
345
+
Alcotest.(check int) "method responses count" 1 (List.length (Response.method_responses response))
346
+
347
+
let test_roundtrip () =
348
+
test_roundtrip "success roundtrip" Response.jsont "response/valid/success.json" ()
349
+
350
+
let tests = [
351
+
"valid: success", `Quick, test_success;
352
+
"valid: with created ids", `Quick, test_with_created_ids;
353
+
"valid: with error", `Quick, test_with_error;
354
+
"valid: multiple responses", `Quick, test_multiple_responses;
355
+
"values: success", `Quick, test_values;
356
+
"roundtrip: success", `Quick, test_roundtrip;
357
+
]
358
+
end
359
+
360
+
(* Invocation tests *)
361
+
module Invocation_tests = struct
362
+
open Jmap_proto
363
+
364
+
let test_get () =
365
+
test_decode_success "get" Invocation.jsont "invocation/valid/get.json" ()
366
+
367
+
let test_set () =
368
+
test_decode_success "set" Invocation.jsont "invocation/valid/set.json" ()
369
+
370
+
let test_query () =
371
+
test_decode_success "query" Invocation.jsont "invocation/valid/query.json" ()
372
+
373
+
let test_values () =
374
+
let json = read_file "invocation/valid/get.json" in
375
+
match decode Invocation.jsont json with
376
+
| Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)
377
+
| Ok inv ->
378
+
Alcotest.(check string) "name" "Email/get" (Invocation.name inv);
379
+
Alcotest.(check string) "method call id" "call-001" (Invocation.method_call_id inv)
380
+
381
+
let test_invalid_not_array () =
382
+
test_decode_failure "not array" Invocation.jsont "invocation/invalid/not_array.json" ()
383
+
384
+
let test_invalid_wrong_length () =
385
+
test_decode_failure "wrong length" Invocation.jsont "invocation/invalid/wrong_length.json" ()
386
+
387
+
let tests = [
388
+
"valid: get", `Quick, test_get;
389
+
"valid: set", `Quick, test_set;
390
+
"valid: query", `Quick, test_query;
391
+
"values: get", `Quick, test_values;
392
+
"invalid: not array", `Quick, test_invalid_not_array;
393
+
"invalid: wrong length", `Quick, test_invalid_wrong_length;
394
+
]
395
+
end
396
+
397
+
(* Capability tests *)
398
+
module Capability_tests = struct
399
+
open Jmap_proto
400
+
401
+
let test_core () =
402
+
test_decode_success "core" Capability.Core.jsont "capability/valid/core.json" ()
403
+
404
+
let test_mail () =
405
+
test_decode_success "mail" Capability.Mail.jsont "capability/valid/mail.json" ()
406
+
407
+
let test_submission () =
408
+
test_decode_success "submission" Capability.Submission.jsont "capability/valid/submission.json" ()
409
+
410
+
let test_core_values () =
411
+
let json = read_file "capability/valid/core.json" in
412
+
match decode Capability.Core.jsont json with
413
+
| Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)
414
+
| Ok cap ->
415
+
Alcotest.(check int64) "maxSizeUpload" 50000000L (Capability.Core.max_size_upload cap);
416
+
Alcotest.(check int) "maxConcurrentUpload" 4 (Capability.Core.max_concurrent_upload cap);
417
+
Alcotest.(check int) "maxCallsInRequest" 16 (Capability.Core.max_calls_in_request cap)
418
+
419
+
let test_mail_values () =
420
+
let json = read_file "capability/valid/mail.json" in
421
+
match decode Capability.Mail.jsont json with
422
+
| Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)
423
+
| Ok cap ->
424
+
Alcotest.(check int64) "maxSizeMailboxName" 490L (Capability.Mail.max_size_mailbox_name cap);
425
+
Alcotest.(check bool) "mayCreateTopLevelMailbox" true (Capability.Mail.may_create_top_level_mailbox cap)
426
+
427
+
let tests = [
428
+
"valid: core", `Quick, test_core;
429
+
"valid: mail", `Quick, test_mail;
430
+
"valid: submission", `Quick, test_submission;
431
+
"values: core", `Quick, test_core_values;
432
+
"values: mail", `Quick, test_mail_values;
433
+
]
434
+
end
435
+
436
+
(* Method args/response tests *)
437
+
module Method_tests = struct
438
+
open Jmap_proto
439
+
440
+
let test_get_args () =
441
+
test_decode_success "get_args" Method.get_args_jsont "method/valid/get_args.json" ()
442
+
443
+
let test_get_args_minimal () =
444
+
test_decode_success "get_args_minimal" Method.get_args_jsont "method/valid/get_args_minimal.json" ()
445
+
446
+
let test_query_response () =
447
+
test_decode_success "query_response" Method.query_response_jsont "method/valid/query_response.json" ()
448
+
449
+
let test_changes_response () =
450
+
test_decode_success "changes_response" Method.changes_response_jsont "method/valid/changes_response.json" ()
451
+
452
+
let test_get_args_values () =
453
+
let json = read_file "method/valid/get_args.json" in
454
+
match decode Method.get_args_jsont json with
455
+
| Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)
456
+
| Ok args ->
457
+
Alcotest.(check string) "accountId" "acc1" (Id.to_string args.account_id);
458
+
Alcotest.(check (option (list string))) "properties" (Some ["id"; "name"; "role"]) args.properties
459
+
460
+
let test_query_response_values () =
461
+
let json = read_file "method/valid/query_response.json" in
462
+
match decode Method.query_response_jsont json with
463
+
| Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)
464
+
| Ok resp ->
465
+
Alcotest.(check int) "ids count" 5 (List.length resp.ids);
466
+
Alcotest.(check int64) "position" 0L resp.position;
467
+
Alcotest.(check bool) "canCalculateChanges" true resp.can_calculate_changes;
468
+
Alcotest.(check (option int64)) "total" (Some 250L) resp.total
469
+
470
+
let test_changes_response_values () =
471
+
let json = read_file "method/valid/changes_response.json" in
472
+
match decode Method.changes_response_jsont json with
473
+
| Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)
474
+
| Ok resp ->
475
+
Alcotest.(check string) "oldState" "old123" resp.old_state;
476
+
Alcotest.(check string) "newState" "new456" resp.new_state;
477
+
Alcotest.(check bool) "hasMoreChanges" false resp.has_more_changes;
478
+
Alcotest.(check int) "created count" 2 (List.length resp.created);
479
+
Alcotest.(check int) "destroyed count" 2 (List.length resp.destroyed)
480
+
481
+
let tests = [
482
+
"valid: get_args", `Quick, test_get_args;
483
+
"valid: get_args_minimal", `Quick, test_get_args_minimal;
484
+
"valid: query_response", `Quick, test_query_response;
485
+
"valid: changes_response", `Quick, test_changes_response;
486
+
"values: get_args", `Quick, test_get_args_values;
487
+
"values: query_response", `Quick, test_query_response_values;
488
+
"values: changes_response", `Quick, test_changes_response_values;
489
+
]
490
+
end
491
+
492
+
(* Error tests *)
493
+
module Error_tests = struct
494
+
open Jmap_proto
495
+
496
+
let test_method_error () =
497
+
test_decode_success "method_error" Error.method_error_jsont "error/valid/method_error.json" ()
498
+
499
+
let test_set_error () =
500
+
test_decode_success "set_error" Error.set_error_jsont "error/valid/set_error.json" ()
501
+
502
+
let test_request_error () =
503
+
test_decode_success "request_error" Error.Request_error.jsont "error/valid/request_error.json" ()
504
+
505
+
let method_error_type_testable =
506
+
Alcotest.testable
507
+
(fun fmt t -> Format.pp_print_string fmt (Error.method_error_type_to_string t))
508
+
(=)
509
+
510
+
let test_method_error_values () =
511
+
let json = read_file "error/valid/method_error.json" in
512
+
match decode Error.method_error_jsont json with
513
+
| Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)
514
+
| Ok err ->
515
+
Alcotest.(check method_error_type_testable) "type" Error.Unknown_method err.type_
516
+
517
+
(* Additional error type tests *)
518
+
let test_set_error_forbidden () =
519
+
test_decode_success "set_error_forbidden" Error.set_error_jsont "error/valid/set_error_forbidden.json" ()
520
+
521
+
let test_set_error_not_found () =
522
+
test_decode_success "set_error_not_found" Error.set_error_jsont "error/valid/set_error_not_found.json" ()
523
+
524
+
let test_set_error_invalid_properties () =
525
+
test_decode_success "set_error_invalid_properties" Error.set_error_jsont "error/valid/set_error_invalid_properties.json" ()
526
+
527
+
let test_set_error_singleton () =
528
+
test_decode_success "set_error_singleton" Error.set_error_jsont "error/valid/set_error_singleton.json" ()
529
+
530
+
let test_set_error_over_quota () =
531
+
test_decode_success "set_error_over_quota" Error.set_error_jsont "error/valid/set_error_over_quota.json" ()
532
+
533
+
let test_method_error_invalid_arguments () =
534
+
test_decode_success "method_error_invalid_arguments" Error.method_error_jsont "error/valid/method_error_invalid_arguments.json" ()
535
+
536
+
let test_method_error_server_fail () =
537
+
test_decode_success "method_error_server_fail" Error.method_error_jsont "error/valid/method_error_server_fail.json" ()
538
+
539
+
let test_method_error_account_not_found () =
540
+
test_decode_success "method_error_account_not_found" Error.method_error_jsont "error/valid/method_error_account_not_found.json" ()
541
+
542
+
let test_method_error_forbidden () =
543
+
test_decode_success "method_error_forbidden" Error.method_error_jsont "error/valid/method_error_forbidden.json" ()
544
+
545
+
let test_method_error_account_read_only () =
546
+
test_decode_success "method_error_account_read_only" Error.method_error_jsont "error/valid/method_error_account_read_only.json" ()
547
+
548
+
let test_request_error_not_json () =
549
+
test_decode_success "request_error_not_json" Error.Request_error.jsont "error/valid/request_error_not_json.json" ()
550
+
551
+
let test_request_error_limit () =
552
+
test_decode_success "request_error_limit" Error.Request_error.jsont "error/valid/request_error_limit.json" ()
553
+
554
+
let set_error_type_testable =
555
+
Alcotest.testable
556
+
(fun fmt t -> Format.pp_print_string fmt (Error.set_error_type_to_string t))
557
+
(=)
558
+
559
+
let test_set_error_types () =
560
+
let json = read_file "error/valid/set_error_invalid_properties.json" in
561
+
match decode Error.set_error_jsont json with
562
+
| Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)
563
+
| Ok err ->
564
+
Alcotest.(check set_error_type_testable) "type" Error.Invalid_properties err.Error.type_;
565
+
match err.Error.properties with
566
+
| None -> Alcotest.fail "expected properties"
567
+
| Some props -> Alcotest.(check int) "properties count" 2 (List.length props)
568
+
569
+
let tests = [
570
+
"valid: method_error", `Quick, test_method_error;
571
+
"valid: set_error", `Quick, test_set_error;
572
+
"valid: request_error", `Quick, test_request_error;
573
+
"valid: set_error forbidden", `Quick, test_set_error_forbidden;
574
+
"valid: set_error notFound", `Quick, test_set_error_not_found;
575
+
"valid: set_error invalidProperties", `Quick, test_set_error_invalid_properties;
576
+
"valid: set_error singleton", `Quick, test_set_error_singleton;
577
+
"valid: set_error overQuota", `Quick, test_set_error_over_quota;
578
+
"valid: method_error invalidArguments", `Quick, test_method_error_invalid_arguments;
579
+
"valid: method_error serverFail", `Quick, test_method_error_server_fail;
580
+
"valid: method_error accountNotFound", `Quick, test_method_error_account_not_found;
581
+
"valid: method_error forbidden", `Quick, test_method_error_forbidden;
582
+
"valid: method_error accountReadOnly", `Quick, test_method_error_account_read_only;
583
+
"valid: request_error notJSON", `Quick, test_request_error_not_json;
584
+
"valid: request_error limit", `Quick, test_request_error_limit;
585
+
"values: method_error", `Quick, test_method_error_values;
586
+
"values: set_error types", `Quick, test_set_error_types;
587
+
]
588
+
end
589
+
590
+
(* Mailbox tests *)
591
+
module Mailbox_tests = struct
592
+
open Jmap_mail
593
+
594
+
let role_testable =
595
+
Alcotest.testable
596
+
(fun fmt t -> Format.pp_print_string fmt (Mailbox.role_to_string t))
597
+
(=)
598
+
599
+
let test_simple () =
600
+
test_decode_success "simple" Mailbox.jsont "mail/mailbox/valid/simple.json" ()
601
+
602
+
let test_nested () =
603
+
test_decode_success "nested" Mailbox.jsont "mail/mailbox/valid/nested.json" ()
604
+
605
+
let test_values () =
606
+
let json = read_file "mail/mailbox/valid/simple.json" in
607
+
match decode Mailbox.jsont json with
608
+
| Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)
609
+
| Ok mb ->
610
+
Alcotest.(check string) "id" "mb1" (Jmap_proto.Id.to_string (Mailbox.id mb));
611
+
Alcotest.(check string) "name" "Inbox" (Mailbox.name mb);
612
+
Alcotest.(check (option role_testable)) "role" (Some Mailbox.Inbox) (Mailbox.role mb);
613
+
Alcotest.(check int64) "totalEmails" 150L (Mailbox.total_emails mb);
614
+
Alcotest.(check int64) "unreadEmails" 5L (Mailbox.unread_emails mb)
615
+
616
+
let test_roundtrip () =
617
+
test_roundtrip "simple roundtrip" Mailbox.jsont "mail/mailbox/valid/simple.json" ()
618
+
619
+
let test_with_all_roles () =
620
+
test_decode_success "with all roles" Mailbox.jsont "mail/mailbox/valid/with_all_roles.json" ()
621
+
622
+
let test_all_rights_false () =
623
+
test_decode_success "all rights false" Mailbox.jsont "mail/mailbox/edge/all_rights_false.json" ()
624
+
625
+
let test_roles_values () =
626
+
let json = read_file "mail/mailbox/valid/with_all_roles.json" in
627
+
match decode Mailbox.jsont json with
628
+
| Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)
629
+
| Ok mb ->
630
+
Alcotest.(check (option role_testable)) "role" (Some Mailbox.Archive) (Mailbox.role mb);
631
+
Alcotest.(check int64) "totalEmails" 1000L (Mailbox.total_emails mb)
632
+
633
+
let tests = [
634
+
"valid: simple", `Quick, test_simple;
635
+
"valid: nested", `Quick, test_nested;
636
+
"valid: with all roles", `Quick, test_with_all_roles;
637
+
"edge: all rights false", `Quick, test_all_rights_false;
638
+
"values: simple", `Quick, test_values;
639
+
"values: roles", `Quick, test_roles_values;
640
+
"roundtrip: simple", `Quick, test_roundtrip;
641
+
]
642
+
end
643
+
644
+
(* Email tests *)
645
+
module Email_tests = struct
646
+
open Jmap_mail
647
+
648
+
let test_minimal () =
649
+
test_decode_success "minimal" Email.jsont "mail/email/valid/minimal.json" ()
650
+
651
+
let test_full () =
652
+
test_decode_success "full" Email.jsont "mail/email/valid/full.json" ()
653
+
654
+
let test_with_headers () =
655
+
test_decode_success "with_headers" Email.jsont "mail/email/valid/with_headers.json" ()
656
+
657
+
let test_minimal_values () =
658
+
let json = read_file "mail/email/valid/minimal.json" in
659
+
match decode Email.jsont json with
660
+
| Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)
661
+
| Ok email ->
662
+
Alcotest.(check string) "id" "e1" (Jmap_proto.Id.to_string (Email.id email));
663
+
Alcotest.(check string) "blobId" "blob1" (Jmap_proto.Id.to_string (Email.blob_id email));
664
+
Alcotest.(check int64) "size" 1024L (Email.size email)
665
+
666
+
let test_full_values () =
667
+
let json = read_file "mail/email/valid/full.json" in
668
+
match decode Email.jsont json with
669
+
| Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)
670
+
| Ok email ->
671
+
Alcotest.(check (option string)) "subject" (Some "Re: Important meeting") (Email.subject email);
672
+
Alcotest.(check bool) "hasAttachment" true (Email.has_attachment email);
673
+
(* Check from address *)
674
+
match Email.from email with
675
+
| None -> Alcotest.fail "expected from address"
676
+
| Some addrs ->
677
+
Alcotest.(check int) "from count" 1 (List.length addrs);
678
+
let addr = List.hd addrs in
679
+
Alcotest.(check (option string)) "from name" (Some "Alice Smith") (Email_address.name addr);
680
+
Alcotest.(check string) "from email" "alice@example.com" (Email_address.email addr)
681
+
682
+
let test_with_keywords () =
683
+
test_decode_success "with keywords" Email.jsont "mail/email/valid/with_keywords.json" ()
684
+
685
+
let test_multiple_mailboxes () =
686
+
test_decode_success "multiple mailboxes" Email.jsont "mail/email/valid/multiple_mailboxes.json" ()
687
+
688
+
let test_draft_email () =
689
+
test_decode_success "draft email" Email.jsont "mail/email/valid/draft_email.json" ()
690
+
691
+
let test_with_all_system_keywords () =
692
+
test_decode_success "all system keywords" Email.jsont "mail/email/valid/with_all_system_keywords.json" ()
693
+
694
+
let test_empty_keywords () =
695
+
test_decode_success "empty keywords" Email.jsont "mail/email/edge/empty_keywords.json" ()
696
+
697
+
let test_with_message_ids () =
698
+
test_decode_success "with message ids" Email.jsont "mail/email/valid/with_message_ids.json" ()
699
+
700
+
let test_keywords_values () =
701
+
let json = read_file "mail/email/valid/with_keywords.json" in
702
+
match decode Email.jsont json with
703
+
| Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)
704
+
| Ok email ->
705
+
let keywords = Email.keywords email in
706
+
Alcotest.(check int) "keywords count" 3 (List.length keywords);
707
+
Alcotest.(check bool) "$seen present" true (List.mem_assoc "$seen" keywords);
708
+
Alcotest.(check bool) "$flagged present" true (List.mem_assoc "$flagged" keywords)
709
+
710
+
let test_mailbox_ids_values () =
711
+
let json = read_file "mail/email/valid/multiple_mailboxes.json" in
712
+
match decode Email.jsont json with
713
+
| Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)
714
+
| Ok email ->
715
+
let mailbox_ids = Email.mailbox_ids email in
716
+
Alcotest.(check int) "mailboxIds count" 3 (List.length mailbox_ids)
717
+
718
+
let tests = [
719
+
"valid: minimal", `Quick, test_minimal;
720
+
"valid: full", `Quick, test_full;
721
+
"valid: with_headers", `Quick, test_with_headers;
722
+
"valid: with keywords", `Quick, test_with_keywords;
723
+
"valid: multiple mailboxes", `Quick, test_multiple_mailboxes;
724
+
"valid: draft email", `Quick, test_draft_email;
725
+
"valid: all system keywords", `Quick, test_with_all_system_keywords;
726
+
"valid: with message ids", `Quick, test_with_message_ids;
727
+
"edge: empty keywords", `Quick, test_empty_keywords;
728
+
"values: minimal", `Quick, test_minimal_values;
729
+
"values: full", `Quick, test_full_values;
730
+
"values: keywords", `Quick, test_keywords_values;
731
+
"values: mailboxIds", `Quick, test_mailbox_ids_values;
732
+
]
733
+
end
734
+
735
+
(* Thread tests *)
736
+
module Thread_tests = struct
737
+
open Jmap_mail
738
+
739
+
let test_simple () =
740
+
test_decode_success "simple" Thread.jsont "mail/thread/valid/simple.json" ()
741
+
742
+
let test_conversation () =
743
+
test_decode_success "conversation" Thread.jsont "mail/thread/valid/conversation.json" ()
744
+
745
+
let test_values () =
746
+
let json = read_file "mail/thread/valid/conversation.json" in
747
+
match decode Thread.jsont json with
748
+
| Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)
749
+
| Ok thread ->
750
+
Alcotest.(check string) "id" "t2" (Jmap_proto.Id.to_string (Thread.id thread));
751
+
Alcotest.(check int) "emailIds count" 5 (List.length (Thread.email_ids thread))
752
+
753
+
let tests = [
754
+
"valid: simple", `Quick, test_simple;
755
+
"valid: conversation", `Quick, test_conversation;
756
+
"values: conversation", `Quick, test_values;
757
+
]
758
+
end
759
+
760
+
(* Identity tests *)
761
+
module Identity_tests = struct
762
+
open Jmap_mail
763
+
764
+
let test_simple () =
765
+
test_decode_success "simple" Identity.jsont "mail/identity/valid/simple.json" ()
766
+
767
+
let test_values () =
768
+
let json = read_file "mail/identity/valid/simple.json" in
769
+
match decode Identity.jsont json with
770
+
| Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)
771
+
| Ok ident ->
772
+
Alcotest.(check string) "name" "Work Identity" (Identity.name ident);
773
+
Alcotest.(check string) "email" "john.doe@company.com" (Identity.email ident);
774
+
Alcotest.(check bool) "mayDelete" true (Identity.may_delete ident)
775
+
776
+
let tests = [
777
+
"valid: simple", `Quick, test_simple;
778
+
"values: simple", `Quick, test_values;
779
+
]
780
+
end
781
+
782
+
(* Email address tests *)
783
+
module Email_address_tests = struct
784
+
open Jmap_mail
785
+
786
+
let test_full () =
787
+
test_decode_success "full" Email_address.jsont "mail/email_address/valid/full.json" ()
788
+
789
+
let test_email_only () =
790
+
test_decode_success "email_only" Email_address.jsont "mail/email_address/valid/email_only.json" ()
791
+
792
+
let test_full_values () =
793
+
let json = read_file "mail/email_address/valid/full.json" in
794
+
match decode Email_address.jsont json with
795
+
| Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)
796
+
| Ok addr ->
797
+
Alcotest.(check (option string)) "name" (Some "John Doe") (Email_address.name addr);
798
+
Alcotest.(check string) "email" "john.doe@example.com" (Email_address.email addr)
799
+
800
+
let test_email_only_values () =
801
+
let json = read_file "mail/email_address/valid/email_only.json" in
802
+
match decode Email_address.jsont json with
803
+
| Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)
804
+
| Ok addr ->
805
+
Alcotest.(check (option string)) "name" None (Email_address.name addr);
806
+
Alcotest.(check string) "email" "anonymous@example.com" (Email_address.email addr)
807
+
808
+
let tests = [
809
+
"valid: full", `Quick, test_full;
810
+
"valid: email_only", `Quick, test_email_only;
811
+
"values: full", `Quick, test_full_values;
812
+
"values: email_only", `Quick, test_email_only_values;
813
+
]
814
+
end
815
+
816
+
(* Vacation tests *)
817
+
module Vacation_tests = struct
818
+
open Jmap_mail
819
+
820
+
let test_enabled () =
821
+
test_decode_success "enabled" Vacation.jsont "mail/vacation/valid/enabled.json" ()
822
+
823
+
let test_disabled () =
824
+
test_decode_success "disabled" Vacation.jsont "mail/vacation/valid/disabled.json" ()
825
+
826
+
let test_enabled_values () =
827
+
let json = read_file "mail/vacation/valid/enabled.json" in
828
+
match decode Vacation.jsont json with
829
+
| Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)
830
+
| Ok vac ->
831
+
Alcotest.(check bool) "isEnabled" true (Vacation.is_enabled vac);
832
+
Alcotest.(check (option string)) "subject" (Some "Out of Office") (Vacation.subject vac)
833
+
834
+
let test_disabled_values () =
835
+
let json = read_file "mail/vacation/valid/disabled.json" in
836
+
match decode Vacation.jsont json with
837
+
| Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)
838
+
| Ok vac ->
839
+
Alcotest.(check bool) "isEnabled" false (Vacation.is_enabled vac);
840
+
Alcotest.(check (option string)) "subject" None (Vacation.subject vac)
841
+
842
+
let tests = [
843
+
"valid: enabled", `Quick, test_enabled;
844
+
"valid: disabled", `Quick, test_disabled;
845
+
"values: enabled", `Quick, test_enabled_values;
846
+
"values: disabled", `Quick, test_disabled_values;
847
+
]
848
+
end
849
+
850
+
(* Comparator tests *)
851
+
module Comparator_tests = struct
852
+
open Jmap_proto
853
+
854
+
let test_minimal () =
855
+
test_decode_success "minimal" Filter.comparator_jsont "filter/valid/comparator_minimal.json" ()
856
+
857
+
let test_descending () =
858
+
test_decode_success "descending" Filter.comparator_jsont "filter/valid/comparator_descending.json" ()
859
+
860
+
let test_with_collation () =
861
+
test_decode_success "with collation" Filter.comparator_jsont "filter/valid/comparator_with_collation.json" ()
862
+
863
+
let test_minimal_values () =
864
+
let json = read_file "filter/valid/comparator_minimal.json" in
865
+
match decode Filter.comparator_jsont json with
866
+
| Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)
867
+
| Ok comp ->
868
+
Alcotest.(check string) "property" "size" (Filter.comparator_property comp);
869
+
Alcotest.(check bool) "isAscending" true (Filter.comparator_is_ascending comp);
870
+
Alcotest.(check (option string)) "collation" None (Filter.comparator_collation comp)
871
+
872
+
let test_collation_values () =
873
+
let json = read_file "filter/valid/comparator_with_collation.json" in
874
+
match decode Filter.comparator_jsont json with
875
+
| Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)
876
+
| Ok comp ->
877
+
Alcotest.(check string) "property" "subject" (Filter.comparator_property comp);
878
+
Alcotest.(check (option string)) "collation" (Some "i;unicode-casemap") (Filter.comparator_collation comp)
879
+
880
+
let tests = [
881
+
"valid: minimal", `Quick, test_minimal;
882
+
"valid: descending", `Quick, test_descending;
883
+
"valid: with collation", `Quick, test_with_collation;
884
+
"values: minimal", `Quick, test_minimal_values;
885
+
"values: with collation", `Quick, test_collation_values;
886
+
]
887
+
end
888
+
889
+
(* EmailBody tests *)
890
+
module EmailBody_tests = struct
891
+
open Jmap_mail
892
+
893
+
let test_text_part () =
894
+
test_decode_success "text part" Email_body.Part.jsont "mail/email_body/valid/text_part.json" ()
895
+
896
+
let test_multipart () =
897
+
test_decode_success "multipart" Email_body.Part.jsont "mail/email_body/valid/multipart.json" ()
898
+
899
+
let test_multipart_mixed () =
900
+
test_decode_success "multipart mixed" Email_body.Part.jsont "mail/email_body/valid/multipart_mixed.json" ()
901
+
902
+
let test_with_inline_image () =
903
+
test_decode_success "with inline image" Email_body.Part.jsont "mail/email_body/valid/with_inline_image.json" ()
904
+
905
+
let test_with_language () =
906
+
test_decode_success "with language" Email_body.Part.jsont "mail/email_body/valid/with_language.json" ()
907
+
908
+
let test_deep_nesting () =
909
+
test_decode_success "deep nesting" Email_body.Part.jsont "mail/email_body/edge/deep_nesting.json" ()
910
+
911
+
let test_multipart_values () =
912
+
let json = read_file "mail/email_body/valid/multipart.json" in
913
+
match decode Email_body.Part.jsont json with
914
+
| Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)
915
+
| Ok part ->
916
+
Alcotest.(check (option string)) "partId" (Some "0") (Email_body.Part.part_id part);
917
+
Alcotest.(check string) "type" "multipart/alternative" (Email_body.Part.type_ part);
918
+
match Email_body.Part.sub_parts part with
919
+
| None -> Alcotest.fail "expected sub_parts"
920
+
| Some subs -> Alcotest.(check int) "sub_parts count" 2 (List.length subs)
921
+
922
+
let tests = [
923
+
"valid: text part", `Quick, test_text_part;
924
+
"valid: multipart", `Quick, test_multipart;
925
+
"valid: multipart mixed", `Quick, test_multipart_mixed;
926
+
"valid: with inline image", `Quick, test_with_inline_image;
927
+
"valid: with language", `Quick, test_with_language;
928
+
"edge: deep nesting", `Quick, test_deep_nesting;
929
+
"values: multipart", `Quick, test_multipart_values;
930
+
]
931
+
end
932
+
933
+
(* EmailSubmission tests *)
934
+
module EmailSubmission_tests = struct
935
+
open Jmap_mail
936
+
937
+
let test_simple () =
938
+
test_decode_success "simple" Submission.jsont "mail/submission/valid/simple.json" ()
939
+
940
+
let test_with_envelope () =
941
+
test_decode_success "with envelope" Submission.jsont "mail/submission/valid/with_envelope.json" ()
942
+
943
+
let test_final_status () =
944
+
test_decode_success "final status" Submission.jsont "mail/submission/valid/final_status.json" ()
945
+
946
+
let test_simple_values () =
947
+
let json = read_file "mail/submission/valid/simple.json" in
948
+
match decode Submission.jsont json with
949
+
| Error e -> Alcotest.failf "decode failed: %s" (Jsont.Error.to_string e)
950
+
| Ok sub ->
951
+
Alcotest.(check string) "id" "sub1" (Jmap_proto.Id.to_string (Submission.id sub));
952
+
(* Check undoStatus is Pending *)
953
+
match Submission.undo_status sub with
954
+
| Submission.Pending -> ()
955
+
| _ -> Alcotest.fail "expected undoStatus to be pending"
956
+
957
+
let tests = [
958
+
"valid: simple", `Quick, test_simple;
959
+
"valid: with envelope", `Quick, test_with_envelope;
960
+
"valid: final status", `Quick, test_final_status;
961
+
"values: simple", `Quick, test_simple_values;
962
+
]
963
+
end
964
+
965
+
(* Run all tests *)
966
+
let () =
967
+
Alcotest.run "JMAP Proto Codecs" [
968
+
"Id", Id_tests.tests;
969
+
"Int53", Int53_tests.tests;
970
+
"Date", Date_tests.tests;
971
+
"Session", Session_tests.tests;
972
+
"Request", Request_tests.tests;
973
+
"Response", Response_tests.tests;
974
+
"Invocation", Invocation_tests.tests;
975
+
"Capability", Capability_tests.tests;
976
+
"Method", Method_tests.tests;
977
+
"Error", Error_tests.tests;
978
+
"Comparator", Comparator_tests.tests;
979
+
"Mailbox", Mailbox_tests.tests;
980
+
"Email", Email_tests.tests;
981
+
"EmailBody", EmailBody_tests.tests;
982
+
"Thread", Thread_tests.tests;
983
+
"Identity", Identity_tests.tests;
984
+
"Email_address", Email_address_tests.tests;
985
+
"EmailSubmission", EmailSubmission_tests.tests;
986
+
"Vacation", Vacation_tests.tests;
987
+
]