this repo has no description
more
+2076
-198
-2
stack/jmap/jmap-client/jmap_client.ml
-2
stack/jmap/jmap-client/jmap_client.ml
-2
stack/jmap/jmap-client/jmap_client.mli
-2
stack/jmap/jmap-client/jmap_client.mli
+19
-2
stack/jmap/jmap-client/jmap_connection.ml
+19
-2
stack/jmap/jmap-client/jmap_connection.ml
···
1
-
(** JMAP Connection Management - Stub Implementation *)
1
+
(** JMAP Connection Management *)
2
2
3
3
type config = {
4
4
max_retries : int;
···
21
21
auth : auth option;
22
22
}
23
23
24
-
let create ?(config = default_config) ?auth () =
24
+
(** Config accessors *)
25
+
let max_retries c = c.max_retries
26
+
let timeout c = c.timeout
27
+
let user_agent c = c.user_agent
28
+
29
+
(** Config constructor *)
30
+
let config_v ~max_retries ~timeout ~user_agent =
31
+
{ max_retries; timeout; user_agent }
32
+
33
+
(** Connection accessors *)
34
+
let config t = t.config
35
+
let auth t = t.auth
36
+
37
+
(** Connection constructor *)
38
+
let v ?(config = default_config) ?auth () =
25
39
{ config; auth }
40
+
41
+
(** Legacy alias for backwards compatibility *)
42
+
let create = v
+16
-1
stack/jmap/jmap-client/jmap_connection.mli
+16
-1
stack/jmap/jmap-client/jmap_connection.mli
···
10
10
(** Default configuration *)
11
11
val default_config : config
12
12
13
+
(** Config accessors *)
14
+
val max_retries : config -> int
15
+
val timeout : config -> float
16
+
val user_agent : config -> string
17
+
18
+
(** Config constructor *)
19
+
val config_v : max_retries:int -> timeout:float -> user_agent:string -> config
20
+
13
21
(** Authentication method *)
14
22
type auth =
15
23
| Basic of string * string (** username, password *)
···
18
26
(** Connection state *)
19
27
type t
20
28
21
-
(** Create a connection *)
29
+
(** Connection accessors *)
30
+
val config : t -> config
31
+
val auth : t -> auth option
32
+
33
+
(** Connection constructor *)
34
+
val v : ?config:config -> ?auth:auth -> unit -> t
35
+
36
+
(** Legacy alias for backwards compatibility *)
22
37
val create : ?config:config -> ?auth:auth -> unit -> t
+81
stack/jmap/jmap-core/jmap_error.ml
+81
stack/jmap/jmap-core/jmap_error.ml
···
214
214
| Forbidden_from -> "forbiddenFrom"
215
215
| Forbidden_to_send -> "forbiddenToSend"
216
216
| Cannot_unsend -> "cannotUnsend"
217
+
218
+
let set_error_type_of_string = function
219
+
| "forbidden" -> Forbidden
220
+
| "overQuota" -> Over_quota
221
+
| "tooLarge" -> Too_large
222
+
| "rateLimit" -> Rate_limit
223
+
| "notFound" -> Not_found
224
+
| "invalidPatch" -> Invalid_patch
225
+
| "willDestroy" -> Will_destroy
226
+
| "invalidProperties" -> Invalid_properties
227
+
| "singleton" -> Singleton
228
+
| "alreadyExists" -> Already_exists
229
+
| "mailboxHasChild" -> Mailbox_has_child
230
+
| "mailboxHasEmail" -> Mailbox_has_email
231
+
| "blobNotFound" -> Blob_not_found
232
+
| "tooManyKeywords" -> Too_many_keywords
233
+
| "tooManyMailboxes" -> Too_many_mailboxes
234
+
| "invalidEmail" -> Invalid_email
235
+
| "tooManyRecipients" -> Too_many_recipients
236
+
| "noRecipients" -> No_recipients
237
+
| "invalidRecipients" -> Invalid_recipients
238
+
| "forbiddenMailFrom" -> Forbidden_mail_from
239
+
| "forbiddenFrom" -> Forbidden_from
240
+
| "forbiddenToSend" -> Forbidden_to_send
241
+
| "cannotUnsend" -> Cannot_unsend
242
+
| s -> raise (Parse_error (Printf.sprintf "Unknown set error type: %s" s))
243
+
244
+
(** Parse set_error_detail from JSON *)
245
+
let parse_set_error_detail json =
246
+
match json with
247
+
| `O fields ->
248
+
let error_type = match List.assoc_opt "type" fields with
249
+
| Some (`String s) -> set_error_type_of_string s
250
+
| Some _ -> raise (Parse_error "SetError type must be a string")
251
+
| None -> raise (Parse_error "SetError requires 'type' field")
252
+
in
253
+
let description = match List.assoc_opt "description" fields with
254
+
| Some (`String s) -> Some s
255
+
| Some `Null | None -> None
256
+
| Some _ -> raise (Parse_error "SetError description must be a string")
257
+
in
258
+
let properties = match List.assoc_opt "properties" fields with
259
+
| Some (`A items) ->
260
+
Some (List.map (function
261
+
| `String s -> s
262
+
| _ -> raise (Parse_error "SetError properties must be strings")
263
+
) items)
264
+
| Some `Null | None -> None
265
+
| Some _ -> raise (Parse_error "SetError properties must be an array")
266
+
in
267
+
let existing_id = match List.assoc_opt "existingId" fields with
268
+
| Some (`String s) -> Some s
269
+
| Some `Null | None -> None
270
+
| Some _ -> raise (Parse_error "SetError existingId must be a string")
271
+
in
272
+
let not_found = match List.assoc_opt "notFound" fields with
273
+
| Some (`A items) ->
274
+
Some (List.map (function
275
+
| `String s -> s
276
+
| _ -> raise (Parse_error "SetError notFound must be strings")
277
+
) items)
278
+
| Some `Null | None -> None
279
+
| Some _ -> raise (Parse_error "SetError notFound must be an array")
280
+
in
281
+
let max_recipients = match List.assoc_opt "maxRecipients" fields with
282
+
| Some (`Float f) -> Some (int_of_float f)
283
+
| Some `Null | None -> None
284
+
| Some _ -> raise (Parse_error "SetError maxRecipients must be a number")
285
+
in
286
+
let invalid_recipients = match List.assoc_opt "invalidRecipients" fields with
287
+
| Some (`A items) ->
288
+
Some (List.map (function
289
+
| `String s -> s
290
+
| _ -> raise (Parse_error "SetError invalidRecipients must be strings")
291
+
) items)
292
+
| Some `Null | None -> None
293
+
| Some _ -> raise (Parse_error "SetError invalidRecipients must be an array")
294
+
in
295
+
{ error_type; description; properties; existing_id; not_found;
296
+
max_recipients; invalid_recipients }
297
+
| _ -> raise (Parse_error "SetError must be a JSON object")
+4
stack/jmap/jmap-core/jmap_error.mli
+4
stack/jmap/jmap-core/jmap_error.mli
···
88
88
val request_error_to_string : request_error -> string
89
89
val method_error_to_string : method_error -> string
90
90
val set_error_type_to_string : set_error_type -> string
91
+
val set_error_type_of_string : string -> set_error_type
92
+
93
+
(** Parse set_error_detail from JSON *)
94
+
val parse_set_error_detail : Ezjsonm.value -> set_error_detail
+274
-32
stack/jmap/jmap-core/jmap_standard_methods.ml
+274
-32
stack/jmap/jmap-core/jmap_standard_methods.ml
···
8
8
Reference: RFC 8620 Sections 5.1-5.6
9
9
*)
10
10
11
+
(** Local helper functions to avoid circular dependency with Jmap_parser *)
12
+
module Helpers = struct
13
+
let expect_object = function
14
+
| `O fields -> fields
15
+
| _ -> raise (Jmap_error.Parse_error "Expected JSON object")
16
+
17
+
let expect_string = function
18
+
| `String s -> s
19
+
| _ -> raise (Jmap_error.Parse_error "Expected JSON string")
20
+
21
+
let find_field name fields = List.assoc_opt name fields
22
+
23
+
let require_field name fields =
24
+
match find_field name fields with
25
+
| Some v -> v
26
+
| None -> raise (Jmap_error.Parse_error (Printf.sprintf "Missing required field: %s" name))
27
+
28
+
let get_string name fields =
29
+
match require_field name fields with
30
+
| `String s -> s
31
+
| _ -> raise (Jmap_error.Parse_error (Printf.sprintf "Field %s must be a string" name))
32
+
33
+
let get_string_opt name fields =
34
+
match find_field name fields with
35
+
| Some (`String s) -> Some s
36
+
| Some _ -> raise (Jmap_error.Parse_error (Printf.sprintf "Field %s must be a string" name))
37
+
| None -> None
38
+
39
+
let get_bool name fields =
40
+
match require_field name fields with
41
+
| `Bool b -> b
42
+
| _ -> raise (Jmap_error.Parse_error (Printf.sprintf "Field %s must be a boolean" name))
43
+
44
+
let parse_array parse_elem = function
45
+
| `A items -> List.map parse_elem items
46
+
| `Null -> []
47
+
| _ -> raise (Jmap_error.Parse_error "Expected JSON array")
48
+
end
49
+
11
50
(** Standard /get method (RFC 8620 Section 5.1) *)
12
51
module Get = struct
13
52
type 'a request = {
···
44
83
45
84
(** Parse request from JSON.
46
85
Test files: test/data/core/request_get.json *)
47
-
let request_of_json _parse_obj json =
48
-
(* TODO: Implement JSON parsing *)
49
-
ignore json;
50
-
raise (Jmap_error.Parse_error "Get.request_of_json not yet implemented")
86
+
let request_of_json parse_obj json =
87
+
ignore parse_obj;
88
+
let open Helpers in
89
+
let fields = expect_object json in
90
+
let account_id = Jmap_id.of_json (require_field "accountId" fields) in
91
+
let ids = match find_field "ids" fields with
92
+
| Some `Null | None -> None
93
+
| Some v -> Some (parse_array Jmap_id.of_json v)
94
+
in
95
+
let properties = match find_field "properties" fields with
96
+
| Some `Null | None -> None
97
+
| Some v -> Some (parse_array expect_string v)
98
+
in
99
+
{ account_id; ids; properties }
51
100
52
101
(** Parse response from JSON.
53
102
Test files: test/data/core/response_get.json *)
54
-
let response_of_json _parse_obj json =
55
-
(* TODO: Implement JSON parsing *)
56
-
ignore json;
57
-
raise (Jmap_error.Parse_error "Get.response_of_json not yet implemented")
103
+
let response_of_json parse_obj json =
104
+
let open Helpers in
105
+
let fields = expect_object json in
106
+
let account_id = Jmap_id.of_json (require_field "accountId" fields) in
107
+
let state = get_string "state" fields in
108
+
let list = parse_array parse_obj (require_field "list" fields) in
109
+
let not_found = match find_field "notFound" fields with
110
+
| Some v -> parse_array Jmap_id.of_json v
111
+
| None -> []
112
+
in
113
+
{ account_id; state; list; not_found }
58
114
end
59
115
60
116
(** Standard /changes method (RFC 8620 Section 5.2) *)
···
99
155
100
156
(** Parse request from JSON.
101
157
Test files: test/data/core/request_changes.json *)
102
-
let request_of_json _json =
103
-
(* TODO: Implement JSON parsing *)
104
-
raise (Jmap_error.Parse_error "Changes.request_of_json not yet implemented")
158
+
let request_of_json json =
159
+
let open Helpers in
160
+
let fields = expect_object json in
161
+
let account_id = Jmap_id.of_json (require_field "accountId" fields) in
162
+
let since_state = get_string "sinceState" fields in
163
+
let max_changes = match find_field "maxChanges" fields with
164
+
| Some v -> Some (Jmap_primitives.UnsignedInt.of_json v)
165
+
| None -> None
166
+
in
167
+
{ account_id; since_state; max_changes }
105
168
106
169
(** Parse response from JSON.
107
170
Test files: test/data/core/response_changes.json *)
108
-
let response_of_json _json =
109
-
(* TODO: Implement JSON parsing *)
110
-
raise (Jmap_error.Parse_error "Changes.response_of_json not yet implemented")
171
+
let response_of_json json =
172
+
let open Helpers in
173
+
let fields = expect_object json in
174
+
let account_id = Jmap_id.of_json (require_field "accountId" fields) in
175
+
let old_state = get_string "oldState" fields in
176
+
let new_state = get_string "newState" fields in
177
+
let has_more_changes = get_bool "hasMoreChanges" fields in
178
+
let created = parse_array Jmap_id.of_json (require_field "created" fields) in
179
+
let updated = parse_array Jmap_id.of_json (require_field "updated" fields) in
180
+
let destroyed = parse_array Jmap_id.of_json (require_field "destroyed" fields) in
181
+
{ account_id; old_state; new_state; has_more_changes; created; updated; destroyed }
111
182
end
112
183
113
184
(** Standard /set method (RFC 8620 Section 5.3) *)
···
167
238
- test/data/core/request_set_update.json
168
239
- test/data/core/request_set_destroy.json
169
240
*)
170
-
let request_of_json _parse_obj _json =
171
-
(* TODO: Implement JSON parsing *)
172
-
raise (Jmap_error.Parse_error "Set.request_of_json not yet implemented")
241
+
let request_of_json parse_obj json =
242
+
let open Helpers in
243
+
let fields = expect_object json in
244
+
let account_id = Jmap_id.of_json (require_field "accountId" fields) in
245
+
let if_in_state = get_string_opt "ifInState" fields in
246
+
let create = match find_field "create" fields with
247
+
| Some `Null | None -> None
248
+
| Some (`O pairs) ->
249
+
Some (List.map (fun (k, v) -> (Jmap_id.of_string k, parse_obj v)) pairs)
250
+
| Some _ -> raise (Jmap_error.Parse_error "create must be an object")
251
+
in
252
+
let update = match find_field "update" fields with
253
+
| Some `Null | None -> None
254
+
| Some (`O pairs) ->
255
+
Some (List.map (fun (k, v) ->
256
+
let id = Jmap_id.of_string k in
257
+
let patch = match v with
258
+
| `O patch_fields ->
259
+
List.map (fun (pk, pv) ->
260
+
match pv with
261
+
| `Null -> (pk, None)
262
+
| _ -> (pk, Some pv)
263
+
) patch_fields
264
+
| _ -> raise (Jmap_error.Parse_error "update value must be an object")
265
+
in
266
+
(id, patch)
267
+
) pairs)
268
+
| Some _ -> raise (Jmap_error.Parse_error "update must be an object")
269
+
in
270
+
let destroy = match find_field "destroy" fields with
271
+
| Some `Null | None -> None
272
+
| Some v -> Some (parse_array Jmap_id.of_json v)
273
+
in
274
+
{ account_id; if_in_state; create; update; destroy }
173
275
174
276
(** Parse response from JSON.
175
277
Test files:
···
177
279
- test/data/core/response_set_update.json
178
280
- test/data/core/response_set_destroy.json
179
281
*)
180
-
let response_of_json _parse_obj _json =
181
-
(* TODO: Implement JSON parsing *)
182
-
raise (Jmap_error.Parse_error "Set.response_of_json not yet implemented")
282
+
let response_of_json parse_obj json =
283
+
let open Helpers in
284
+
let fields = expect_object json in
285
+
let account_id = Jmap_id.of_json (require_field "accountId" fields) in
286
+
let old_state = get_string_opt "oldState" fields in
287
+
let new_state = get_string "newState" fields in
288
+
let created = match find_field "created" fields with
289
+
| Some `Null | None -> None
290
+
| Some (`O pairs) ->
291
+
Some (List.map (fun (k, v) -> (Jmap_id.of_string k, parse_obj v)) pairs)
292
+
| Some _ -> raise (Jmap_error.Parse_error "created must be an object")
293
+
in
294
+
let updated = match find_field "updated" fields with
295
+
| Some `Null | None -> None
296
+
| Some (`O pairs) ->
297
+
Some (List.map (fun (k, v) ->
298
+
let id = Jmap_id.of_string k in
299
+
match v with
300
+
| `Null -> (id, None)
301
+
| _ -> (id, Some (parse_obj v))
302
+
) pairs)
303
+
| Some _ -> raise (Jmap_error.Parse_error "updated must be an object")
304
+
in
305
+
let destroyed = match find_field "destroyed" fields with
306
+
| Some `Null | None -> None
307
+
| Some v -> Some (parse_array Jmap_id.of_json v)
308
+
in
309
+
let not_created = match find_field "notCreated" fields with
310
+
| Some `Null | None -> None
311
+
| Some (`O pairs) ->
312
+
Some (List.map (fun (k, v) ->
313
+
(Jmap_id.of_string k, Jmap_error.parse_set_error_detail v)
314
+
) pairs)
315
+
| Some _ -> raise (Jmap_error.Parse_error "notCreated must be an object")
316
+
in
317
+
let not_updated = match find_field "notUpdated" fields with
318
+
| Some `Null | None -> None
319
+
| Some (`O pairs) ->
320
+
Some (List.map (fun (k, v) ->
321
+
(Jmap_id.of_string k, Jmap_error.parse_set_error_detail v)
322
+
) pairs)
323
+
| Some _ -> raise (Jmap_error.Parse_error "notUpdated must be an object")
324
+
in
325
+
let not_destroyed = match find_field "notDestroyed" fields with
326
+
| Some `Null | None -> None
327
+
| Some (`O pairs) ->
328
+
Some (List.map (fun (k, v) ->
329
+
(Jmap_id.of_string k, Jmap_error.parse_set_error_detail v)
330
+
) pairs)
331
+
| Some _ -> raise (Jmap_error.Parse_error "notDestroyed must be an object")
332
+
in
333
+
{ account_id; old_state; new_state; created; updated; destroyed;
334
+
not_created; not_updated; not_destroyed }
183
335
end
184
336
185
337
(** Standard /copy method (RFC 8620 Section 5.4) *)
···
293
445
294
446
(** Parse request from JSON.
295
447
Test files: test/data/core/request_query.json *)
296
-
let request_of_json _parse_filter _json =
297
-
(* TODO: Implement JSON parsing *)
298
-
raise (Jmap_error.Parse_error "Query.request_of_json not yet implemented")
448
+
let request_of_json parse_filter json =
449
+
let open Helpers in
450
+
let fields = expect_object json in
451
+
let account_id = Jmap_id.of_json (require_field "accountId" fields) in
452
+
let filter = match find_field "filter" fields with
453
+
| Some v -> Some (Jmap_filter.of_json parse_filter v)
454
+
| None -> None
455
+
in
456
+
let sort = match find_field "sort" fields with
457
+
| Some v -> Some (parse_array Jmap_comparator.of_json v)
458
+
| None -> None
459
+
in
460
+
let position = match find_field "position" fields with
461
+
| Some v -> Some (Jmap_primitives.Int53.of_json v)
462
+
| None -> None
463
+
in
464
+
let anchor = match find_field "anchor" fields with
465
+
| Some v -> Some (Jmap_id.of_json v)
466
+
| None -> None
467
+
in
468
+
let anchor_offset = match find_field "anchorOffset" fields with
469
+
| Some v -> Some (Jmap_primitives.Int53.of_json v)
470
+
| None -> None
471
+
in
472
+
let limit = match find_field "limit" fields with
473
+
| Some v -> Some (Jmap_primitives.UnsignedInt.of_json v)
474
+
| None -> None
475
+
in
476
+
let calculate_total = match find_field "calculateTotal" fields with
477
+
| Some (`Bool b) -> Some b
478
+
| Some _ -> raise (Jmap_error.Parse_error "calculateTotal must be a boolean")
479
+
| None -> None
480
+
in
481
+
{ account_id; filter; sort; position; anchor; anchor_offset; limit; calculate_total }
299
482
300
483
(** Parse response from JSON.
301
484
Test files: test/data/core/response_query.json *)
302
-
let response_of_json _json =
303
-
(* TODO: Implement JSON parsing *)
304
-
raise (Jmap_error.Parse_error "Query.response_of_json not yet implemented")
485
+
let response_of_json json =
486
+
let open Helpers in
487
+
let fields = expect_object json in
488
+
let account_id = Jmap_id.of_json (require_field "accountId" fields) in
489
+
let query_state = get_string "queryState" fields in
490
+
let can_calculate_changes = get_bool "canCalculateChanges" fields in
491
+
let position = Jmap_primitives.UnsignedInt.of_json (require_field "position" fields) in
492
+
let ids = parse_array Jmap_id.of_json (require_field "ids" fields) in
493
+
let total = match find_field "total" fields with
494
+
| Some v -> Some (Jmap_primitives.UnsignedInt.of_json v)
495
+
| None -> None
496
+
in
497
+
let limit = match find_field "limit" fields with
498
+
| Some v -> Some (Jmap_primitives.UnsignedInt.of_json v)
499
+
| None -> None
500
+
in
501
+
{ account_id; query_state; can_calculate_changes; position; ids; total; limit }
305
502
end
306
503
307
504
(** Standard /queryChanges method (RFC 8620 Section 5.6) *)
···
365
562
366
563
(** Parse request from JSON.
367
564
Test files: test/data/core/request_query_changes.json *)
368
-
let request_of_json _parse_filter _json =
369
-
(* TODO: Implement JSON parsing *)
370
-
raise (Jmap_error.Parse_error "QueryChanges.request_of_json not yet implemented")
565
+
let request_of_json parse_filter json =
566
+
let open Helpers in
567
+
let fields = expect_object json in
568
+
let account_id = Jmap_id.of_json (require_field "accountId" fields) in
569
+
let filter = match find_field "filter" fields with
570
+
| Some v -> Some (Jmap_filter.of_json parse_filter v)
571
+
| None -> None
572
+
in
573
+
let sort = match find_field "sort" fields with
574
+
| Some v -> Some (parse_array Jmap_comparator.of_json v)
575
+
| None -> None
576
+
in
577
+
let since_query_state = get_string "sinceQueryState" fields in
578
+
let max_changes = match find_field "maxChanges" fields with
579
+
| Some v -> Some (Jmap_primitives.UnsignedInt.of_json v)
580
+
| None -> None
581
+
in
582
+
let up_to_id = match find_field "upToId" fields with
583
+
| Some v -> Some (Jmap_id.of_json v)
584
+
| None -> None
585
+
in
586
+
let calculate_total = match find_field "calculateTotal" fields with
587
+
| Some (`Bool b) -> Some b
588
+
| Some _ -> raise (Jmap_error.Parse_error "calculateTotal must be a boolean")
589
+
| None -> None
590
+
in
591
+
{ account_id; filter; sort; since_query_state; max_changes; up_to_id; calculate_total }
371
592
372
593
(** Parse response from JSON.
373
594
Test files: test/data/core/response_query_changes.json *)
374
-
let response_of_json _json =
375
-
(* TODO: Implement JSON parsing *)
376
-
raise (Jmap_error.Parse_error "QueryChanges.response_of_json not yet implemented")
595
+
let response_of_json json =
596
+
let open Helpers in
597
+
let fields = expect_object json in
598
+
let account_id = Jmap_id.of_json (require_field "accountId" fields) in
599
+
let old_query_state = get_string "oldQueryState" fields in
600
+
let new_query_state = get_string "newQueryState" fields in
601
+
let total = match find_field "total" fields with
602
+
| Some v -> Some (Jmap_primitives.UnsignedInt.of_json v)
603
+
| None -> None
604
+
in
605
+
let removed = parse_array Jmap_id.of_json (require_field "removed" fields) in
606
+
let added = match require_field "added" fields with
607
+
| `A items ->
608
+
List.map (fun item ->
609
+
match item with
610
+
| `O item_fields ->
611
+
let id = Jmap_id.of_json (require_field "id" item_fields) in
612
+
let index = Jmap_primitives.UnsignedInt.of_json (require_field "index" item_fields) in
613
+
{ id; index }
614
+
| _ -> raise (Jmap_error.Parse_error "Added item must be an object")
615
+
) items
616
+
| _ -> raise (Jmap_error.Parse_error "added must be an array")
617
+
in
618
+
{ account_id; old_query_state; new_query_state; total; removed; added }
377
619
end
378
620
379
621
(** Core/echo method (RFC 8620 Section 7.3) *)
+657
-75
stack/jmap/jmap-mail/jmap_email.ml
+657
-75
stack/jmap/jmap-mail/jmap_email.ml
···
38
38
"email": "bob@example.com"
39
39
}
40
40
*)
41
-
let of_json _json =
42
-
raise (Jmap_core.Jmap_error.Parse_error "EmailAddress.of_json not yet implemented")
41
+
let of_json json =
42
+
let open Jmap_core.Jmap_parser.Helpers in
43
+
let fields = expect_object json in
44
+
let name = get_string_opt "name" fields in
45
+
let email = get_string "email" fields in
46
+
{ name; email }
43
47
44
-
let to_json _t =
45
-
raise (Jmap_core.Jmap_error.Parse_error "EmailAddress.to_json not yet implemented")
48
+
let to_json t =
49
+
let fields = [("email", `String t.email)] in
50
+
let fields = match t.name with
51
+
| Some n -> ("name", `String n) :: fields
52
+
| None -> fields
53
+
in
54
+
`O fields
46
55
47
56
(* Accessors *)
48
57
let name t = t.name
···
60
69
value : string; (** Header field value (decoded) *)
61
70
}
62
71
63
-
let of_json _json =
64
-
raise (Jmap_core.Jmap_error.Parse_error "EmailHeader.of_json not yet implemented")
72
+
let of_json json =
73
+
let open Jmap_core.Jmap_parser.Helpers in
74
+
let fields = expect_object json in
75
+
let name = get_string "name" fields in
76
+
let value = get_string "value" fields in
77
+
{ name; value }
65
78
66
-
let to_json _t =
67
-
raise (Jmap_core.Jmap_error.Parse_error "EmailHeader.to_json not yet implemented")
79
+
let to_json t =
80
+
`O [
81
+
("name", `String t.name);
82
+
("value", `String t.value);
83
+
]
68
84
69
85
(* Accessors *)
70
86
let name t = t.name
···
115
131
"subParts": [...]
116
132
}
117
133
*)
118
-
let of_json _json =
119
-
raise (Jmap_core.Jmap_error.Parse_error "BodyPart.of_json not yet implemented")
134
+
let rec of_json json =
135
+
let open Jmap_core.Jmap_parser.Helpers in
136
+
let fields = expect_object json in
137
+
let part_id = get_string_opt "partId" fields in
138
+
let blob_id = match find_field "blobId" fields with
139
+
| Some (`String s) -> Some (Jmap_core.Jmap_id.of_string s)
140
+
| Some `Null | None -> None
141
+
| Some _ -> raise (Jmap_core.Jmap_error.Parse_error "blobId must be a string")
142
+
in
143
+
let size = match find_field "size" fields with
144
+
| Some s -> Jmap_core.Jmap_primitives.UnsignedInt.of_json s
145
+
| None -> Jmap_core.Jmap_primitives.UnsignedInt.of_int 0
146
+
in
147
+
let headers = match find_field "headers" fields with
148
+
| Some (`A items) -> List.map EmailHeader.of_json items
149
+
| Some `Null | None -> []
150
+
| Some _ -> raise (Jmap_core.Jmap_error.Parse_error "headers must be an array")
151
+
in
152
+
let name = get_string_opt "name" fields in
153
+
let type_ = get_string "type" fields in
154
+
let charset = get_string_opt "charset" fields in
155
+
let disposition = get_string_opt "disposition" fields in
156
+
let cid = get_string_opt "cid" fields in
157
+
let language = match find_field "language" fields with
158
+
| Some (`A items) -> Some (List.map expect_string items)
159
+
| Some `Null | None -> None
160
+
| Some _ -> raise (Jmap_core.Jmap_error.Parse_error "language must be an array")
161
+
in
162
+
let location = get_string_opt "location" fields in
163
+
let sub_parts = match find_field "subParts" fields with
164
+
| Some (`A items) -> Some (List.map of_json items)
165
+
| Some `Null | None -> None
166
+
| Some _ -> raise (Jmap_core.Jmap_error.Parse_error "subParts must be an array")
167
+
in
168
+
{ part_id; blob_id; size; headers; name; type_; charset;
169
+
disposition; cid; language; location; sub_parts }
120
170
121
-
let to_json _t =
122
-
raise (Jmap_core.Jmap_error.Parse_error "BodyPart.to_json not yet implemented")
171
+
let rec to_json t =
172
+
let fields = [("type", `String t.type_)] in
173
+
let fields = match t.part_id with
174
+
| Some id -> ("partId", `String id) :: fields
175
+
| None -> fields
176
+
in
177
+
let fields = match t.blob_id with
178
+
| Some id -> ("blobId", Jmap_core.Jmap_id.to_json id) :: fields
179
+
| None -> fields
180
+
in
181
+
let fields = ("size", Jmap_core.Jmap_primitives.UnsignedInt.to_json t.size) :: fields in
182
+
let fields = if t.headers <> [] then
183
+
("headers", `A (List.map EmailHeader.to_json t.headers)) :: fields
184
+
else
185
+
fields
186
+
in
187
+
let fields = match t.name with
188
+
| Some n -> ("name", `String n) :: fields
189
+
| None -> fields
190
+
in
191
+
let fields = match t.charset with
192
+
| Some c -> ("charset", `String c) :: fields
193
+
| None -> fields
194
+
in
195
+
let fields = match t.disposition with
196
+
| Some d -> ("disposition", `String d) :: fields
197
+
| None -> fields
198
+
in
199
+
let fields = match t.cid with
200
+
| Some c -> ("cid", `String c) :: fields
201
+
| None -> fields
202
+
in
203
+
let fields = match t.language with
204
+
| Some l -> ("language", `A (List.map (fun s -> `String s) l)) :: fields
205
+
| None -> fields
206
+
in
207
+
let fields = match t.location with
208
+
| Some l -> ("location", `String l) :: fields
209
+
| None -> fields
210
+
in
211
+
let fields = match t.sub_parts with
212
+
| Some parts -> ("subParts", `A (List.map to_json parts)) :: fields
213
+
| None -> fields
214
+
in
215
+
`O fields
123
216
124
217
(* Accessors *)
125
218
let part_id t = t.part_id
···
160
253
"isTruncated": false
161
254
}
162
255
*)
163
-
let of_json _json =
164
-
raise (Jmap_core.Jmap_error.Parse_error "BodyValue.of_json not yet implemented")
256
+
let of_json json =
257
+
let open Jmap_core.Jmap_parser.Helpers in
258
+
let fields = expect_object json in
259
+
let value = get_string "value" fields in
260
+
let is_encoding_problem = get_bool_opt "isEncodingProblem" fields false in
261
+
let is_truncated = get_bool_opt "isTruncated" fields false in
262
+
{ value; is_encoding_problem; is_truncated }
165
263
166
-
let to_json _t =
167
-
raise (Jmap_core.Jmap_error.Parse_error "BodyValue.to_json not yet implemented")
264
+
let to_json t =
265
+
`O [
266
+
("value", `String t.value);
267
+
("isEncodingProblem", `Bool t.is_encoding_problem);
268
+
("isTruncated", `Bool t.is_truncated);
269
+
]
168
270
169
271
(* Accessors *)
170
272
let value t = t.value
···
247
349
reply_to; subject; sent_at; body_structure; body_values; text_body;
248
350
html_body; attachments; has_attachment; preview }
249
351
352
+
(** Parse Email from JSON.
353
+
Test files: test/data/mail/email_get_response.json (list field)
354
+
355
+
Expected structure:
356
+
{
357
+
"id": "e001",
358
+
"blobId": "Ge5f13e2d7b8a9c0d1e2f3a4b5c6d7e8f9a0b1c2d3e4f5a6b7c8",
359
+
"threadId": "t001",
360
+
"mailboxIds": { "mb001": true },
361
+
"keywords": { "$seen": true },
362
+
"size": 15234,
363
+
"receivedAt": "2025-10-05T09:15:30Z",
364
+
...
365
+
}
366
+
*)
367
+
let of_json json =
368
+
let open Jmap_core.Jmap_parser.Helpers in
369
+
let fields = expect_object json in
370
+
371
+
(* Required fields *)
372
+
let id = Jmap_core.Jmap_id.of_json (require_field "id" fields) in
373
+
let blob_id = Jmap_core.Jmap_id.of_json (require_field "blobId" fields) in
374
+
let thread_id = Jmap_core.Jmap_id.of_json (require_field "threadId" fields) in
375
+
376
+
(* mailboxIds - map of id -> bool *)
377
+
let mailbox_ids = match require_field "mailboxIds" fields with
378
+
| `O map_fields ->
379
+
List.map (fun (k, v) ->
380
+
(Jmap_core.Jmap_id.of_string k, expect_bool v)
381
+
) map_fields
382
+
| _ -> raise (Jmap_core.Jmap_error.Parse_error "mailboxIds must be an object")
383
+
in
384
+
385
+
(* keywords - map of string -> bool *)
386
+
let keywords = match require_field "keywords" fields with
387
+
| `O map_fields ->
388
+
List.map (fun (k, v) -> (k, expect_bool v)) map_fields
389
+
| _ -> raise (Jmap_core.Jmap_error.Parse_error "keywords must be an object")
390
+
in
391
+
392
+
let size = Jmap_core.Jmap_primitives.UnsignedInt.of_json (require_field "size" fields) in
393
+
let received_at = Jmap_core.Jmap_primitives.UTCDate.of_json (require_field "receivedAt" fields) in
394
+
395
+
(* Optional header fields *)
396
+
let message_id = match find_field "messageId" fields with
397
+
| Some (`A items) -> Some (List.map expect_string items)
398
+
| Some `Null | None -> None
399
+
| Some _ -> raise (Jmap_core.Jmap_error.Parse_error "messageId must be an array")
400
+
in
401
+
let in_reply_to = match find_field "inReplyTo" fields with
402
+
| Some (`A items) -> Some (List.map expect_string items)
403
+
| Some `Null | None -> None
404
+
| Some _ -> raise (Jmap_core.Jmap_error.Parse_error "inReplyTo must be an array")
405
+
in
406
+
let references = match find_field "references" fields with
407
+
| Some (`A items) -> Some (List.map expect_string items)
408
+
| Some `Null | None -> None
409
+
| Some _ -> raise (Jmap_core.Jmap_error.Parse_error "references must be an array")
410
+
in
411
+
let sender = match find_field "sender" fields with
412
+
| Some (`A items) -> Some (List.map EmailAddress.of_json items)
413
+
| Some `Null | None -> None
414
+
| Some _ -> raise (Jmap_core.Jmap_error.Parse_error "sender must be an array")
415
+
in
416
+
let from = match find_field "from" fields with
417
+
| Some (`A items) -> Some (List.map EmailAddress.of_json items)
418
+
| Some `Null | None -> None
419
+
| Some _ -> raise (Jmap_core.Jmap_error.Parse_error "from must be an array")
420
+
in
421
+
let to_ = match find_field "to" fields with
422
+
| Some (`A items) -> Some (List.map EmailAddress.of_json items)
423
+
| Some `Null | None -> None
424
+
| Some _ -> raise (Jmap_core.Jmap_error.Parse_error "to must be an array")
425
+
in
426
+
let cc = match find_field "cc" fields with
427
+
| Some (`A items) -> Some (List.map EmailAddress.of_json items)
428
+
| Some `Null | None -> None
429
+
| Some _ -> raise (Jmap_core.Jmap_error.Parse_error "cc must be an array")
430
+
in
431
+
let bcc = match find_field "bcc" fields with
432
+
| Some (`A items) -> Some (List.map EmailAddress.of_json items)
433
+
| Some `Null | None -> None
434
+
| Some _ -> raise (Jmap_core.Jmap_error.Parse_error "bcc must be an array")
435
+
in
436
+
let reply_to = match find_field "replyTo" fields with
437
+
| Some (`A items) -> Some (List.map EmailAddress.of_json items)
438
+
| Some `Null | None -> None
439
+
| Some _ -> raise (Jmap_core.Jmap_error.Parse_error "replyTo must be an array")
440
+
in
441
+
let subject = get_string_opt "subject" fields in
442
+
let sent_at = match find_field "sentAt" fields with
443
+
| Some (`String s) -> Some (Jmap_core.Jmap_primitives.Date.of_string s)
444
+
| Some `Null | None -> None
445
+
| Some _ -> raise (Jmap_core.Jmap_error.Parse_error "sentAt must be a string")
446
+
in
447
+
448
+
(* Body properties *)
449
+
let body_structure = match find_field "bodyStructure" fields with
450
+
| Some ((`O _) as json) -> Some (BodyPart.of_json json)
451
+
| Some `Null | None -> None
452
+
| Some _ -> raise (Jmap_core.Jmap_error.Parse_error "bodyStructure must be an object")
453
+
in
454
+
455
+
(* bodyValues - map of partId -> BodyValue *)
456
+
let body_values = match find_field "bodyValues" fields with
457
+
| Some (`O map_fields) ->
458
+
Some (List.map (fun (k, v) -> (k, BodyValue.of_json v)) map_fields)
459
+
| Some `Null | None -> None
460
+
| Some _ -> raise (Jmap_core.Jmap_error.Parse_error "bodyValues must be an object")
461
+
in
462
+
463
+
let text_body = match find_field "textBody" fields with
464
+
| Some (`A items) -> Some (List.map BodyPart.of_json items)
465
+
| Some `Null | None -> None
466
+
| Some _ -> raise (Jmap_core.Jmap_error.Parse_error "textBody must be an array")
467
+
in
468
+
let html_body = match find_field "htmlBody" fields with
469
+
| Some (`A items) -> Some (List.map BodyPart.of_json items)
470
+
| Some `Null | None -> None
471
+
| Some _ -> raise (Jmap_core.Jmap_error.Parse_error "htmlBody must be an array")
472
+
in
473
+
let attachments = match find_field "attachments" fields with
474
+
| Some (`A items) -> Some (List.map BodyPart.of_json items)
475
+
| Some `Null | None -> None
476
+
| Some _ -> raise (Jmap_core.Jmap_error.Parse_error "attachments must be an array")
477
+
in
478
+
479
+
let has_attachment = get_bool_opt "hasAttachment" fields false in
480
+
let preview = get_string "preview" fields in
481
+
482
+
{ id; blob_id; thread_id; mailbox_ids; keywords; size; received_at;
483
+
message_id; in_reply_to; references; sender; from; to_; cc; bcc;
484
+
reply_to; subject; sent_at; body_structure; body_values; text_body;
485
+
html_body; attachments; has_attachment; preview }
486
+
487
+
let to_json t =
488
+
let fields = [
489
+
("id", Jmap_core.Jmap_id.to_json t.id);
490
+
("blobId", Jmap_core.Jmap_id.to_json t.blob_id);
491
+
("threadId", Jmap_core.Jmap_id.to_json t.thread_id);
492
+
("mailboxIds", `O (List.map (fun (id, b) ->
493
+
(Jmap_core.Jmap_id.to_string id, `Bool b)) t.mailbox_ids));
494
+
("keywords", `O (List.map (fun (k, b) -> (k, `Bool b)) t.keywords));
495
+
("size", Jmap_core.Jmap_primitives.UnsignedInt.to_json t.size);
496
+
("receivedAt", Jmap_core.Jmap_primitives.UTCDate.to_json t.received_at);
497
+
("hasAttachment", `Bool t.has_attachment);
498
+
("preview", `String t.preview);
499
+
] in
500
+
501
+
(* Add optional fields *)
502
+
let fields = match t.message_id with
503
+
| Some ids -> ("messageId", `A (List.map (fun s -> `String s) ids)) :: fields
504
+
| None -> fields
505
+
in
506
+
let fields = match t.in_reply_to with
507
+
| Some ids -> ("inReplyTo", `A (List.map (fun s -> `String s) ids)) :: fields
508
+
| None -> fields
509
+
in
510
+
let fields = match t.references with
511
+
| Some ids -> ("references", `A (List.map (fun s -> `String s) ids)) :: fields
512
+
| None -> fields
513
+
in
514
+
let fields = match t.sender with
515
+
| Some addrs -> ("sender", `A (List.map EmailAddress.to_json addrs)) :: fields
516
+
| None -> fields
517
+
in
518
+
let fields = match t.from with
519
+
| Some addrs -> ("from", `A (List.map EmailAddress.to_json addrs)) :: fields
520
+
| None -> fields
521
+
in
522
+
let fields = match t.to_ with
523
+
| Some addrs -> ("to", `A (List.map EmailAddress.to_json addrs)) :: fields
524
+
| None -> fields
525
+
in
526
+
let fields = match t.cc with
527
+
| Some addrs -> ("cc", `A (List.map EmailAddress.to_json addrs)) :: fields
528
+
| None -> fields
529
+
in
530
+
let fields = match t.bcc with
531
+
| Some addrs -> ("bcc", `A (List.map EmailAddress.to_json addrs)) :: fields
532
+
| None -> fields
533
+
in
534
+
let fields = match t.reply_to with
535
+
| Some addrs -> ("replyTo", `A (List.map EmailAddress.to_json addrs)) :: fields
536
+
| None -> fields
537
+
in
538
+
let fields = match t.subject with
539
+
| Some s -> ("subject", `String s) :: fields
540
+
| None -> fields
541
+
in
542
+
let fields = match t.sent_at with
543
+
| Some d -> ("sentAt", Jmap_core.Jmap_primitives.Date.to_json d) :: fields
544
+
| None -> fields
545
+
in
546
+
let fields = match t.body_structure with
547
+
| Some bs -> ("bodyStructure", BodyPart.to_json bs) :: fields
548
+
| None -> fields
549
+
in
550
+
let fields = match t.body_values with
551
+
| Some bv -> ("bodyValues", `O (List.map (fun (k, v) ->
552
+
(k, BodyValue.to_json v)) bv)) :: fields
553
+
| None -> fields
554
+
in
555
+
let fields = match t.text_body with
556
+
| Some tb -> ("textBody", `A (List.map BodyPart.to_json tb)) :: fields
557
+
| None -> fields
558
+
in
559
+
let fields = match t.html_body with
560
+
| Some hb -> ("htmlBody", `A (List.map BodyPart.to_json hb)) :: fields
561
+
| None -> fields
562
+
in
563
+
let fields = match t.attachments with
564
+
| Some att -> ("attachments", `A (List.map BodyPart.to_json att)) :: fields
565
+
| None -> fields
566
+
in
567
+
`O fields
568
+
250
569
(** Email-specific filter for /query (RFC 8621 Section 4.4) *)
251
570
module Filter = struct
252
571
type t = {
···
272
591
header : (string * string) list option; (** Header name contains value *)
273
592
}
274
593
275
-
let of_json _json =
276
-
raise (Jmap_core.Jmap_error.Parse_error "Email.Filter.of_json not yet implemented")
594
+
let of_json json =
595
+
let open Jmap_core.Jmap_parser.Helpers in
596
+
let fields = expect_object json in
597
+
let in_mailbox = match find_field "inMailbox" fields with
598
+
| Some (`String s) -> Some (Jmap_core.Jmap_id.of_string s)
599
+
| Some `Null | None -> None
600
+
| Some _ -> raise (Jmap_core.Jmap_error.Parse_error "inMailbox must be a string")
601
+
in
602
+
let in_mailbox_other_than = match find_field "inMailboxOtherThan" fields with
603
+
| Some (`A items) -> Some (List.map (fun s -> Jmap_core.Jmap_id.of_json s) items)
604
+
| Some `Null | None -> None
605
+
| Some _ -> raise (Jmap_core.Jmap_error.Parse_error "inMailboxOtherThan must be an array")
606
+
in
607
+
let before = match find_field "before" fields with
608
+
| Some (`String s) -> Some (Jmap_core.Jmap_primitives.UTCDate.of_string s)
609
+
| Some `Null | None -> None
610
+
| Some _ -> raise (Jmap_core.Jmap_error.Parse_error "before must be a string")
611
+
in
612
+
let after = match find_field "after" fields with
613
+
| Some (`String s) -> Some (Jmap_core.Jmap_primitives.UTCDate.of_string s)
614
+
| Some `Null | None -> None
615
+
| Some _ -> raise (Jmap_core.Jmap_error.Parse_error "after must be a string")
616
+
in
617
+
let min_size = match find_field "minSize" fields with
618
+
| Some s -> Some (Jmap_core.Jmap_primitives.UnsignedInt.of_json s)
619
+
| None -> None
620
+
in
621
+
let max_size = match find_field "maxSize" fields with
622
+
| Some s -> Some (Jmap_core.Jmap_primitives.UnsignedInt.of_json s)
623
+
| None -> None
624
+
in
625
+
let all_in_thread_have_keyword = get_string_opt "allInThreadHaveKeyword" fields in
626
+
let some_in_thread_have_keyword = get_string_opt "someInThreadHaveKeyword" fields in
627
+
let none_in_thread_have_keyword = get_string_opt "noneInThreadHaveKeyword" fields in
628
+
let has_keyword = get_string_opt "hasKeyword" fields in
629
+
let not_keyword = get_string_opt "notKeyword" fields in
630
+
let has_attachment = match find_field "hasAttachment" fields with
631
+
| Some (`Bool b) -> Some b
632
+
| Some `Null | None -> None
633
+
| Some _ -> raise (Jmap_core.Jmap_error.Parse_error "hasAttachment must be a boolean")
634
+
in
635
+
let text = get_string_opt "text" fields in
636
+
let from = get_string_opt "from" fields in
637
+
let to_ = get_string_opt "to" fields in
638
+
let cc = get_string_opt "cc" fields in
639
+
let bcc = get_string_opt "bcc" fields in
640
+
let subject = get_string_opt "subject" fields in
641
+
let body = get_string_opt "body" fields in
642
+
let header = match find_field "header" fields with
643
+
| Some (`A items) ->
644
+
Some (List.map (fun item ->
645
+
let hdr_fields = expect_object item in
646
+
let name = get_string "name" hdr_fields in
647
+
let value = get_string "value" hdr_fields in
648
+
(name, value)
649
+
) items)
650
+
| Some `Null | None -> None
651
+
| Some _ -> raise (Jmap_core.Jmap_error.Parse_error "header must be an array")
652
+
in
653
+
{ in_mailbox; in_mailbox_other_than; before; after; min_size; max_size;
654
+
all_in_thread_have_keyword; some_in_thread_have_keyword;
655
+
none_in_thread_have_keyword; has_keyword; not_keyword; has_attachment;
656
+
text; from; to_; cc; bcc; subject; body; header }
277
657
278
658
(* Accessors *)
279
659
let in_mailbox t = t.in_mailbox
···
346
726
- test/data/mail/email_get_request.json
347
727
- test/data/mail/email_get_full_request.json
348
728
*)
349
-
let request_of_json _json =
350
-
raise (Jmap_core.Jmap_error.Parse_error "Email.Get.request_of_json not yet implemented")
729
+
let request_of_json json =
730
+
let open Jmap_core.Jmap_parser.Helpers in
731
+
let fields = expect_object json in
732
+
let account_id = Jmap_core.Jmap_id.of_json (require_field "accountId" fields) in
733
+
let ids = match find_field "ids" fields with
734
+
| Some (`A items) -> Some (List.map Jmap_core.Jmap_id.of_json items)
735
+
| Some `Null | None -> None
736
+
| Some _ -> raise (Jmap_core.Jmap_error.Parse_error "ids must be an array")
737
+
in
738
+
let properties = match find_field "properties" fields with
739
+
| Some (`A items) -> Some (List.map expect_string items)
740
+
| Some `Null | None -> None
741
+
| Some _ -> raise (Jmap_core.Jmap_error.Parse_error "properties must be an array")
742
+
in
743
+
let body_properties = match find_field "bodyProperties" fields with
744
+
| Some (`A items) -> Some (List.map expect_string items)
745
+
| Some `Null | None -> None
746
+
| Some _ -> raise (Jmap_core.Jmap_error.Parse_error "bodyProperties must be an array")
747
+
in
748
+
let fetch_text_body_values = match find_field "fetchTextBodyValues" fields with
749
+
| Some (`Bool b) -> Some b
750
+
| Some `Null | None -> None
751
+
| Some _ -> raise (Jmap_core.Jmap_error.Parse_error "fetchTextBodyValues must be a boolean")
752
+
in
753
+
let fetch_html_body_values = match find_field "fetchHTMLBodyValues" fields with
754
+
| Some (`Bool b) -> Some b
755
+
| Some `Null | None -> None
756
+
| Some _ -> raise (Jmap_core.Jmap_error.Parse_error "fetchHTMLBodyValues must be a boolean")
757
+
in
758
+
let fetch_all_body_values = match find_field "fetchAllBodyValues" fields with
759
+
| Some (`Bool b) -> Some b
760
+
| Some `Null | None -> None
761
+
| Some _ -> raise (Jmap_core.Jmap_error.Parse_error "fetchAllBodyValues must be a boolean")
762
+
in
763
+
let max_body_value_bytes = match find_field "maxBodyValueBytes" fields with
764
+
| Some v -> Some (Jmap_core.Jmap_primitives.UnsignedInt.of_json v)
765
+
| None -> None
766
+
in
767
+
{ account_id; ids; properties; body_properties; fetch_text_body_values;
768
+
fetch_html_body_values; fetch_all_body_values; max_body_value_bytes }
351
769
352
770
(** Parse get response from JSON.
353
771
Test files:
354
772
- test/data/mail/email_get_response.json
355
773
- test/data/mail/email_get_full_response.json
356
774
*)
357
-
let response_of_json _json =
358
-
raise (Jmap_core.Jmap_error.Parse_error "Email.Get.response_of_json not yet implemented")
775
+
let response_of_json json =
776
+
Jmap_core.Jmap_standard_methods.Get.response_of_json of_json json
359
777
end
360
778
361
779
(** Standard /changes method (RFC 8621 Section 4.3) *)
···
363
781
type request = Jmap_core.Jmap_standard_methods.Changes.request
364
782
type response = Jmap_core.Jmap_standard_methods.Changes.response
365
783
366
-
let request_of_json _json =
367
-
raise (Jmap_core.Jmap_error.Parse_error "Email.Changes.request_of_json not yet implemented")
784
+
let request_of_json json =
785
+
Jmap_core.Jmap_standard_methods.Changes.request_of_json json
368
786
369
-
let response_of_json _json =
370
-
raise (Jmap_core.Jmap_error.Parse_error "Email.Changes.response_of_json not yet implemented")
787
+
let response_of_json json =
788
+
Jmap_core.Jmap_standard_methods.Changes.response_of_json json
371
789
end
372
790
373
791
(** Standard /query method (RFC 8621 Section 4.4) *)
···
406
824
407
825
(** Parse query request from JSON.
408
826
Test files: test/data/mail/email_query_request.json *)
409
-
let request_of_json _json =
410
-
raise (Jmap_core.Jmap_error.Parse_error "Email.Query.request_of_json not yet implemented")
827
+
let request_of_json json =
828
+
let open Jmap_core.Jmap_parser.Helpers in
829
+
let fields = expect_object json in
830
+
let account_id = Jmap_core.Jmap_id.of_json (require_field "accountId" fields) in
831
+
let filter = match find_field "filter" fields with
832
+
| Some v -> Some (Jmap_core.Jmap_filter.of_json Filter.of_json v)
833
+
| None -> None
834
+
in
835
+
let sort = match find_field "sort" fields with
836
+
| Some (`A items) -> Some (List.map Jmap_core.Jmap_comparator.of_json items)
837
+
| Some `Null | None -> None
838
+
| Some _ -> raise (Jmap_core.Jmap_error.Parse_error "sort must be an array")
839
+
in
840
+
let position = match find_field "position" fields with
841
+
| Some v -> Some (Jmap_core.Jmap_primitives.Int53.of_json v)
842
+
| None -> None
843
+
in
844
+
let anchor = match find_field "anchor" fields with
845
+
| Some (`String s) -> Some (Jmap_core.Jmap_id.of_string s)
846
+
| Some `Null | None -> None
847
+
| Some _ -> raise (Jmap_core.Jmap_error.Parse_error "anchor must be a string")
848
+
in
849
+
let anchor_offset = match find_field "anchorOffset" fields with
850
+
| Some v -> Some (Jmap_core.Jmap_primitives.Int53.of_json v)
851
+
| None -> None
852
+
in
853
+
let limit = match find_field "limit" fields with
854
+
| Some v -> Some (Jmap_core.Jmap_primitives.UnsignedInt.of_json v)
855
+
| None -> None
856
+
in
857
+
let calculate_total = match find_field "calculateTotal" fields with
858
+
| Some (`Bool b) -> Some b
859
+
| Some `Null | None -> None
860
+
| Some _ -> raise (Jmap_core.Jmap_error.Parse_error "calculateTotal must be a boolean")
861
+
in
862
+
let collapse_threads = match find_field "collapseThreads" fields with
863
+
| Some (`Bool b) -> Some b
864
+
| Some `Null | None -> None
865
+
| Some _ -> raise (Jmap_core.Jmap_error.Parse_error "collapseThreads must be a boolean")
866
+
in
867
+
{ account_id; filter; sort; position; anchor; anchor_offset;
868
+
limit; calculate_total; collapse_threads }
411
869
412
870
(** Parse query response from JSON.
413
871
Test files: test/data/mail/email_query_response.json *)
414
-
let response_of_json _json =
415
-
raise (Jmap_core.Jmap_error.Parse_error "Email.Query.response_of_json not yet implemented")
872
+
let response_of_json json =
873
+
Jmap_core.Jmap_standard_methods.Query.response_of_json json
416
874
end
417
875
418
876
(** Standard /queryChanges method (RFC 8621 Section 4.5) *)
···
447
905
{ account_id; filter; sort; since_query_state; max_changes;
448
906
up_to_id; calculate_total; collapse_threads }
449
907
450
-
let request_of_json _json =
451
-
raise (Jmap_core.Jmap_error.Parse_error "Email.QueryChanges.request_of_json not yet implemented")
908
+
let request_of_json json =
909
+
let open Jmap_core.Jmap_parser.Helpers in
910
+
let fields = expect_object json in
911
+
let account_id = Jmap_core.Jmap_id.of_json (require_field "accountId" fields) in
912
+
let filter = match find_field "filter" fields with
913
+
| Some v -> Some (Jmap_core.Jmap_filter.of_json Filter.of_json v)
914
+
| None -> None
915
+
in
916
+
let sort = match find_field "sort" fields with
917
+
| Some (`A items) -> Some (List.map Jmap_core.Jmap_comparator.of_json items)
918
+
| Some `Null | None -> None
919
+
| Some _ -> raise (Jmap_core.Jmap_error.Parse_error "sort must be an array")
920
+
in
921
+
let since_query_state = get_string "sinceQueryState" fields in
922
+
let max_changes = match find_field "maxChanges" fields with
923
+
| Some v -> Some (Jmap_core.Jmap_primitives.UnsignedInt.of_json v)
924
+
| None -> None
925
+
in
926
+
let up_to_id = match find_field "upToId" fields with
927
+
| Some (`String s) -> Some (Jmap_core.Jmap_id.of_string s)
928
+
| Some `Null | None -> None
929
+
| Some _ -> raise (Jmap_core.Jmap_error.Parse_error "upToId must be a string")
930
+
in
931
+
let calculate_total = match find_field "calculateTotal" fields with
932
+
| Some (`Bool b) -> Some b
933
+
| Some `Null | None -> None
934
+
| Some _ -> raise (Jmap_core.Jmap_error.Parse_error "calculateTotal must be a boolean")
935
+
in
936
+
let collapse_threads = match find_field "collapseThreads" fields with
937
+
| Some (`Bool b) -> Some b
938
+
| Some `Null | None -> None
939
+
| Some _ -> raise (Jmap_core.Jmap_error.Parse_error "collapseThreads must be a boolean")
940
+
in
941
+
{ account_id; filter; sort; since_query_state; max_changes;
942
+
up_to_id; calculate_total; collapse_threads }
452
943
453
-
let response_of_json _json =
454
-
raise (Jmap_core.Jmap_error.Parse_error "Email.QueryChanges.response_of_json not yet implemented")
944
+
let response_of_json json =
945
+
Jmap_core.Jmap_standard_methods.QueryChanges.response_of_json json
455
946
end
456
947
457
948
(** Standard /set method (RFC 8621 Section 4.6) *)
···
461
952
462
953
(** Parse set request from JSON.
463
954
Test files: test/data/mail/email_set_request.json *)
464
-
let request_of_json _json =
465
-
raise (Jmap_core.Jmap_error.Parse_error "Email.Set.request_of_json not yet implemented")
955
+
let request_of_json json =
956
+
Jmap_core.Jmap_standard_methods.Set.request_of_json of_json json
466
957
467
958
(** Parse set response from JSON.
468
959
Test files: test/data/mail/email_set_response.json *)
469
-
let response_of_json _json =
470
-
raise (Jmap_core.Jmap_error.Parse_error "Email.Set.response_of_json not yet implemented")
960
+
let response_of_json json =
961
+
Jmap_core.Jmap_standard_methods.Set.response_of_json of_json json
471
962
end
472
963
473
964
(** Standard /copy method (RFC 8621 Section 4.7) *)
···
475
966
type request = t Jmap_core.Jmap_standard_methods.Copy.request
476
967
type response = t Jmap_core.Jmap_standard_methods.Copy.response
477
968
478
-
let request_of_json _json =
479
-
raise (Jmap_core.Jmap_error.Parse_error "Email.Copy.request_of_json not yet implemented")
969
+
let request_of_json json =
970
+
Jmap_core.Jmap_standard_methods.Copy.request_of_json of_json json
480
971
481
-
let response_of_json _json =
482
-
raise (Jmap_core.Jmap_error.Parse_error "Email.Copy.response_of_json not yet implemented")
972
+
let response_of_json json =
973
+
Jmap_core.Jmap_standard_methods.Copy.response_of_json of_json json
483
974
end
484
975
485
976
(** Email/import method (RFC 8621 Section 4.8) *)
···
538
1029
539
1030
(** Parse import request from JSON.
540
1031
Test files: test/data/mail/email_import_request.json *)
541
-
let request_of_json _json =
542
-
raise (Jmap_core.Jmap_error.Parse_error "Email.Import.request_of_json not yet implemented")
1032
+
let request_of_json json =
1033
+
let open Jmap_core.Jmap_parser.Helpers in
1034
+
let fields = expect_object json in
1035
+
let account_id = Jmap_core.Jmap_id.of_json (require_field "accountId" fields) in
1036
+
let if_in_state = get_string_opt "ifInState" fields in
1037
+
let emails = match require_field "emails" fields with
1038
+
| `O pairs ->
1039
+
List.map (fun (k, v) ->
1040
+
let ie_fields = expect_object v in
1041
+
let blob_id = Jmap_core.Jmap_id.of_json (require_field "blobId" ie_fields) in
1042
+
let mailbox_ids = match require_field "mailboxIds" ie_fields with
1043
+
| `O map_fields ->
1044
+
List.map (fun (mid, b) ->
1045
+
(Jmap_core.Jmap_id.of_string mid, expect_bool b)
1046
+
) map_fields
1047
+
| _ -> raise (Jmap_core.Jmap_error.Parse_error "mailboxIds must be an object")
1048
+
in
1049
+
let keywords = match require_field "keywords" ie_fields with
1050
+
| `O map_fields ->
1051
+
List.map (fun (kw, b) -> (kw, expect_bool b)) map_fields
1052
+
| _ -> raise (Jmap_core.Jmap_error.Parse_error "keywords must be an object")
1053
+
in
1054
+
let received_at = match find_field "receivedAt" ie_fields with
1055
+
| Some (`String s) -> Some (Jmap_core.Jmap_primitives.UTCDate.of_string s)
1056
+
| Some `Null | None -> None
1057
+
| Some _ -> raise (Jmap_core.Jmap_error.Parse_error "receivedAt must be a string")
1058
+
in
1059
+
let import_email = { blob_id; mailbox_ids; keywords; received_at } in
1060
+
(Jmap_core.Jmap_id.of_string k, import_email)
1061
+
) pairs
1062
+
| _ -> raise (Jmap_core.Jmap_error.Parse_error "emails must be an object")
1063
+
in
1064
+
{ account_id; if_in_state; emails }
543
1065
544
1066
(** Parse import response from JSON.
545
1067
Test files: test/data/mail/email_import_response.json *)
546
-
let response_of_json _json =
547
-
raise (Jmap_core.Jmap_error.Parse_error "Email.Import.response_of_json not yet implemented")
1068
+
let response_of_json json =
1069
+
let open Jmap_core.Jmap_parser.Helpers in
1070
+
let fields = expect_object json in
1071
+
let account_id = Jmap_core.Jmap_id.of_json (require_field "accountId" fields) in
1072
+
let old_state = get_string_opt "oldState" fields in
1073
+
let new_state = get_string "newState" fields in
1074
+
let created = match find_field "created" fields with
1075
+
| Some `Null | None -> None
1076
+
| Some (`O pairs) ->
1077
+
Some (List.map (fun (k, v) ->
1078
+
(Jmap_core.Jmap_id.of_string k, of_json v)
1079
+
) pairs)
1080
+
| Some _ -> raise (Jmap_core.Jmap_error.Parse_error "created must be an object")
1081
+
in
1082
+
let not_created = match find_field "notCreated" fields with
1083
+
| Some `Null | None -> None
1084
+
| Some (`O pairs) ->
1085
+
Some (List.map (fun (k, v) ->
1086
+
(Jmap_core.Jmap_id.of_string k, Jmap_core.Jmap_error.parse_set_error_detail v)
1087
+
) pairs)
1088
+
| Some _ -> raise (Jmap_core.Jmap_error.Parse_error "notCreated must be an object")
1089
+
in
1090
+
{ account_id; old_state; new_state; created; not_created }
548
1091
end
549
1092
550
1093
(** Email/parse method (RFC 8621 Section 4.9) *)
···
596
1139
597
1140
(** Parse parse request from JSON.
598
1141
Test files: test/data/mail/email_parse_request.json *)
599
-
let request_of_json _json =
600
-
raise (Jmap_core.Jmap_error.Parse_error "Email.Parse.request_of_json not yet implemented")
1142
+
let request_of_json json =
1143
+
let open Jmap_core.Jmap_parser.Helpers in
1144
+
let fields = expect_object json in
1145
+
let account_id = Jmap_core.Jmap_id.of_json (require_field "accountId" fields) in
1146
+
let blob_ids = match require_field "blobIds" fields with
1147
+
| `A items -> List.map Jmap_core.Jmap_id.of_json items
1148
+
| _ -> raise (Jmap_core.Jmap_error.Parse_error "blobIds must be an array")
1149
+
in
1150
+
let properties = match find_field "properties" fields with
1151
+
| Some (`A items) -> Some (List.map expect_string items)
1152
+
| Some `Null | None -> None
1153
+
| Some _ -> raise (Jmap_core.Jmap_error.Parse_error "properties must be an array")
1154
+
in
1155
+
let body_properties = match find_field "bodyProperties" fields with
1156
+
| Some (`A items) -> Some (List.map expect_string items)
1157
+
| Some `Null | None -> None
1158
+
| Some _ -> raise (Jmap_core.Jmap_error.Parse_error "bodyProperties must be an array")
1159
+
in
1160
+
let fetch_text_body_values = match find_field "fetchTextBodyValues" fields with
1161
+
| Some (`Bool b) -> Some b
1162
+
| Some `Null | None -> None
1163
+
| Some _ -> raise (Jmap_core.Jmap_error.Parse_error "fetchTextBodyValues must be a boolean")
1164
+
in
1165
+
let fetch_html_body_values = match find_field "fetchHTMLBodyValues" fields with
1166
+
| Some (`Bool b) -> Some b
1167
+
| Some `Null | None -> None
1168
+
| Some _ -> raise (Jmap_core.Jmap_error.Parse_error "fetchHTMLBodyValues must be a boolean")
1169
+
in
1170
+
let fetch_all_body_values = match find_field "fetchAllBodyValues" fields with
1171
+
| Some (`Bool b) -> Some b
1172
+
| Some `Null | None -> None
1173
+
| Some _ -> raise (Jmap_core.Jmap_error.Parse_error "fetchAllBodyValues must be a boolean")
1174
+
in
1175
+
let max_body_value_bytes = match find_field "maxBodyValueBytes" fields with
1176
+
| Some v -> Some (Jmap_core.Jmap_primitives.UnsignedInt.of_json v)
1177
+
| None -> None
1178
+
in
1179
+
{ account_id; blob_ids; properties; body_properties; fetch_text_body_values;
1180
+
fetch_html_body_values; fetch_all_body_values; max_body_value_bytes }
601
1181
602
1182
(** Parse parse response from JSON.
603
1183
Test files: test/data/mail/email_parse_response.json *)
604
-
let response_of_json _json =
605
-
raise (Jmap_core.Jmap_error.Parse_error "Email.Parse.response_of_json not yet implemented")
1184
+
let response_of_json json =
1185
+
let open Jmap_core.Jmap_parser.Helpers in
1186
+
let fields = expect_object json in
1187
+
let account_id = Jmap_core.Jmap_id.of_json (require_field "accountId" fields) in
1188
+
let parsed = match find_field "parsed" fields with
1189
+
| Some `Null | None -> None
1190
+
| Some (`O pairs) ->
1191
+
Some (List.map (fun (k, v) ->
1192
+
(Jmap_core.Jmap_id.of_string k, of_json v)
1193
+
) pairs)
1194
+
| Some _ -> raise (Jmap_core.Jmap_error.Parse_error "parsed must be an object")
1195
+
in
1196
+
let not_parsable = match find_field "notParsable" fields with
1197
+
| Some (`A items) -> Some (List.map Jmap_core.Jmap_id.of_json items)
1198
+
| Some `Null | None -> None
1199
+
| Some _ -> raise (Jmap_core.Jmap_error.Parse_error "notParsable must be an array")
1200
+
in
1201
+
let not_found = match find_field "notFound" fields with
1202
+
| Some (`A items) -> Some (List.map Jmap_core.Jmap_id.of_json items)
1203
+
| Some `Null | None -> None
1204
+
| Some _ -> raise (Jmap_core.Jmap_error.Parse_error "notFound must be an array")
1205
+
in
1206
+
{ account_id; parsed; not_parsable; not_found }
606
1207
end
607
1208
608
-
(** Parser submodule *)
609
-
module Parser = struct
610
-
(** Parse Email from JSON.
611
-
Test files: test/data/mail/email_get_response.json (list field)
612
-
613
-
Expected structure:
614
-
{
615
-
"id": "e001",
616
-
"blobId": "Ge5f13e2d7b8a9c0d1e2f3a4b5c6d7e8f9a0b1c2d3e4f5a6b7c8",
617
-
"threadId": "t001",
618
-
"mailboxIds": { "mb001": true },
619
-
"keywords": { "$seen": true },
620
-
"size": 15234,
621
-
"receivedAt": "2025-10-05T09:15:30Z",
622
-
...
623
-
}
624
-
*)
625
-
let of_json _json =
626
-
(* TODO: Implement JSON parsing *)
627
-
raise (Jmap_core.Jmap_error.Parse_error "Email.Parser.of_json not yet implemented")
628
-
629
-
let to_json _t =
630
-
(* TODO: Implement JSON serialization *)
631
-
raise (Jmap_core.Jmap_error.Parse_error "Email.Parser.to_json not yet implemented")
632
-
end
633
1209
634
1210
(** Standard email keywords (RFC 8621 Section 4.1.1) *)
635
1211
module Keyword = struct
···
642
1218
let junk = "$junk" (* Message is junk/spam *)
643
1219
let notjunk = "$notjunk" (* Message is definitely not junk *)
644
1220
end
1221
+
1222
+
(** Parser submodule *)
1223
+
module Parser = struct
1224
+
let of_json = of_json
1225
+
let to_json = to_json
1226
+
end
+10
stack/jmap/jmap-mail/jmap_mail.ml
+10
stack/jmap/jmap-mail/jmap_mail.ml
···
1
1
(** JMAP Mail Extension Library *)
2
2
3
3
(** Re-export all submodules *)
4
+
module Mailbox = Jmap_mailbox
5
+
module Thread = Jmap_thread
6
+
module Email = Jmap_email
7
+
module Identity = Jmap_identity
8
+
module Email_submission = Jmap_email_submission
9
+
module Vacation_response = Jmap_vacation_response
10
+
module Search_snippet = Jmap_search_snippet
11
+
module Mail_parser = Jmap_mail_parser
12
+
13
+
(** For backwards compatibility *)
4
14
module Jmap_mailbox = Jmap_mailbox
5
15
module Jmap_thread = Jmap_thread
6
16
module Jmap_email = Jmap_email
+183
-57
stack/jmap/jmap-mail/jmap_mailbox.ml
+183
-57
stack/jmap/jmap-mail/jmap_mailbox.ml
···
45
45
"maySubmit": true
46
46
}
47
47
*)
48
-
let of_json _json =
49
-
(* TODO: Implement JSON parsing *)
50
-
raise (Jmap_core.Jmap_error.Parse_error "Rights.of_json not yet implemented")
48
+
let of_json json =
49
+
let open Jmap_core.Jmap_parser.Helpers in
50
+
let fields = expect_object json in
51
+
{
52
+
may_read_items = get_bool "mayReadItems" fields;
53
+
may_add_items = get_bool "mayAddItems" fields;
54
+
may_remove_items = get_bool "mayRemoveItems" fields;
55
+
may_set_seen = get_bool "maySetSeen" fields;
56
+
may_set_keywords = get_bool "maySetKeywords" fields;
57
+
may_create_child = get_bool "mayCreateChild" fields;
58
+
may_rename = get_bool "mayRename" fields;
59
+
may_delete = get_bool "mayDelete" fields;
60
+
may_submit = get_bool "maySubmit" fields;
61
+
}
51
62
52
-
let to_json _t =
53
-
(* TODO: Implement JSON serialization *)
54
-
raise (Jmap_core.Jmap_error.Parse_error "Rights.to_json not yet implemented")
63
+
let to_json t =
64
+
`O [
65
+
("mayReadItems", `Bool t.may_read_items);
66
+
("mayAddItems", `Bool t.may_add_items);
67
+
("mayRemoveItems", `Bool t.may_remove_items);
68
+
("maySetSeen", `Bool t.may_set_seen);
69
+
("maySetKeywords", `Bool t.may_set_keywords);
70
+
("mayCreateChild", `Bool t.may_create_child);
71
+
("mayRename", `Bool t.may_rename);
72
+
("mayDelete", `Bool t.may_delete);
73
+
("maySubmit", `Bool t.may_submit);
74
+
]
55
75
56
76
(* Accessors *)
57
77
let may_read_items t = t.may_read_items
···
105
125
{ id; name; parent_id; role; sort_order; total_emails; unread_emails;
106
126
total_threads; unread_threads; my_rights; is_subscribed }
107
127
128
+
(** Parser submodule *)
129
+
module Parser = struct
130
+
(** Parse Mailbox from JSON.
131
+
Test files: test/data/mail/mailbox_get_response.json (list field)
132
+
133
+
Expected structure:
134
+
{
135
+
"id": "mb001",
136
+
"name": "INBOX",
137
+
"parentId": null,
138
+
"role": "inbox",
139
+
"sortOrder": 10,
140
+
"totalEmails": 1523,
141
+
"unreadEmails": 42,
142
+
"totalThreads": 987,
143
+
"unreadThreads": 35,
144
+
"myRights": { ... },
145
+
"isSubscribed": true
146
+
}
147
+
*)
148
+
let of_json json =
149
+
let open Jmap_core.Jmap_parser.Helpers in
150
+
let fields = expect_object json in
151
+
let id = Jmap_core.Jmap_id.of_json (require_field "id" fields) in
152
+
let name = get_string "name" fields in
153
+
let parent_id = match find_field "parentId" fields with
154
+
| Some `Null | None -> None
155
+
| Some v -> Some (Jmap_core.Jmap_id.of_json v)
156
+
in
157
+
let role = match find_field "role" fields with
158
+
| Some `Null | None -> None
159
+
| Some (`String s) -> Some s
160
+
| Some _ -> raise (Jmap_core.Jmap_error.Parse_error "role must be a string or null")
161
+
in
162
+
let sort_order = Jmap_core.Jmap_primitives.UnsignedInt.of_json (require_field "sortOrder" fields) in
163
+
let total_emails = Jmap_core.Jmap_primitives.UnsignedInt.of_json (require_field "totalEmails" fields) in
164
+
let unread_emails = Jmap_core.Jmap_primitives.UnsignedInt.of_json (require_field "unreadEmails" fields) in
165
+
let total_threads = Jmap_core.Jmap_primitives.UnsignedInt.of_json (require_field "totalThreads" fields) in
166
+
let unread_threads = Jmap_core.Jmap_primitives.UnsignedInt.of_json (require_field "unreadThreads" fields) in
167
+
let my_rights = Rights.of_json (require_field "myRights" fields) in
168
+
let is_subscribed = get_bool "isSubscribed" fields in
169
+
{ id; name; parent_id; role; sort_order; total_emails; unread_emails;
170
+
total_threads; unread_threads; my_rights; is_subscribed }
171
+
172
+
let to_json t =
173
+
let fields = [
174
+
("id", Jmap_core.Jmap_id.to_json t.id);
175
+
("name", `String t.name);
176
+
("sortOrder", Jmap_core.Jmap_primitives.UnsignedInt.to_json t.sort_order);
177
+
("totalEmails", Jmap_core.Jmap_primitives.UnsignedInt.to_json t.total_emails);
178
+
("unreadEmails", Jmap_core.Jmap_primitives.UnsignedInt.to_json t.unread_emails);
179
+
("totalThreads", Jmap_core.Jmap_primitives.UnsignedInt.to_json t.total_threads);
180
+
("unreadThreads", Jmap_core.Jmap_primitives.UnsignedInt.to_json t.unread_threads);
181
+
("myRights", Rights.to_json t.my_rights);
182
+
("isSubscribed", `Bool t.is_subscribed);
183
+
] in
184
+
let fields = match t.parent_id with
185
+
| Some pid -> ("parentId", Jmap_core.Jmap_id.to_json pid) :: fields
186
+
| None -> ("parentId", `Null) :: fields
187
+
in
188
+
let fields = match t.role with
189
+
| Some r -> ("role", `String r) :: fields
190
+
| None -> ("role", `Null) :: fields
191
+
in
192
+
`O fields
193
+
end
194
+
108
195
(** Standard /get method (RFC 8621 Section 2.2) *)
109
196
module Get = struct
110
197
type request = t Jmap_core.Jmap_standard_methods.Get.request
111
198
type response = t Jmap_core.Jmap_standard_methods.Get.response
112
199
113
200
(** Parse get request from JSON *)
114
-
let request_of_json _json =
115
-
raise (Jmap_core.Jmap_error.Parse_error "Mailbox.Get.request_of_json not yet implemented")
201
+
let request_of_json json =
202
+
Jmap_core.Jmap_standard_methods.Get.request_of_json Parser.of_json json
116
203
117
204
(** Parse get response from JSON *)
118
-
let response_of_json _json =
119
-
raise (Jmap_core.Jmap_error.Parse_error "Mailbox.Get.response_of_json not yet implemented")
205
+
let response_of_json json =
206
+
Jmap_core.Jmap_standard_methods.Get.response_of_json Parser.of_json json
120
207
end
121
208
122
209
(** Standard /changes method (RFC 8621 Section 2.3) *)
···
124
211
type request = Jmap_core.Jmap_standard_methods.Changes.request
125
212
type response = Jmap_core.Jmap_standard_methods.Changes.response
126
213
127
-
let request_of_json _json =
128
-
raise (Jmap_core.Jmap_error.Parse_error "Mailbox.Changes.request_of_json not yet implemented")
214
+
let request_of_json json =
215
+
Jmap_core.Jmap_standard_methods.Changes.request_of_json json
129
216
130
-
let response_of_json _json =
131
-
raise (Jmap_core.Jmap_error.Parse_error "Mailbox.Changes.response_of_json not yet implemented")
217
+
let response_of_json json =
218
+
Jmap_core.Jmap_standard_methods.Changes.response_of_json json
132
219
end
133
220
134
221
(** Mailbox-specific filter for /query (RFC 8621 Section 2.5) *)
···
141
228
is_subscribed : bool option; (** isSubscribed equals this value *)
142
229
}
143
230
144
-
let of_json _json =
145
-
raise (Jmap_core.Jmap_error.Parse_error "Mailbox.Filter.of_json not yet implemented")
231
+
let of_json json =
232
+
let open Jmap_core.Jmap_parser.Helpers in
233
+
let fields = expect_object json in
234
+
let parent_id = match find_field "parentId" fields with
235
+
| Some `Null -> Some None (* Explicitly filter for null parent *)
236
+
| Some v -> Some (Some (Jmap_core.Jmap_id.of_json v))
237
+
| None -> None (* Don't filter on parentId *)
238
+
in
239
+
let name = get_string_opt "name" fields in
240
+
let role = get_string_opt "role" fields in
241
+
let has_any_role = match find_field "hasAnyRole" fields with
242
+
| Some (`Bool b) -> Some b
243
+
| Some _ -> raise (Jmap_core.Jmap_error.Parse_error "hasAnyRole must be a boolean")
244
+
| None -> None
245
+
in
246
+
let is_subscribed = match find_field "isSubscribed" fields with
247
+
| Some (`Bool b) -> Some b
248
+
| Some _ -> raise (Jmap_core.Jmap_error.Parse_error "isSubscribed must be a boolean")
249
+
| None -> None
250
+
in
251
+
(* Note: parent_id has special handling - None means don't filter,
252
+
Some None means filter for null, Some (Some id) means filter for that id *)
253
+
let parent_id_simple = match parent_id with
254
+
| Some (Some id) -> Some id
255
+
| _ -> None (* We'll need to handle the "null" case specially in actual filtering *)
256
+
in
257
+
{ parent_id = parent_id_simple; name; role; has_any_role; is_subscribed }
146
258
147
259
(* Accessors *)
148
260
let parent_id t = t.parent_id
···
194
306
195
307
(** Parse query request from JSON.
196
308
Test files: test/data/mail/mailbox_query_request.json *)
197
-
let request_of_json _json =
198
-
raise (Jmap_core.Jmap_error.Parse_error "Mailbox.Query.request_of_json not yet implemented")
309
+
let request_of_json json =
310
+
let open Jmap_core.Jmap_parser.Helpers in
311
+
let fields = expect_object json in
312
+
let account_id = Jmap_core.Jmap_id.of_json (require_field "accountId" fields) in
313
+
let filter = match find_field "filter" fields with
314
+
| Some v -> Some (Jmap_core.Jmap_filter.of_json Filter.of_json v)
315
+
| None -> None
316
+
in
317
+
let sort = match find_field "sort" fields with
318
+
| Some v -> Some (parse_array Jmap_core.Jmap_comparator.of_json v)
319
+
| None -> None
320
+
in
321
+
let position = match find_field "position" fields with
322
+
| Some v -> Some (Jmap_core.Jmap_primitives.Int53.of_json v)
323
+
| None -> None
324
+
in
325
+
let anchor = match find_field "anchor" fields with
326
+
| Some v -> Some (Jmap_core.Jmap_id.of_json v)
327
+
| None -> None
328
+
in
329
+
let anchor_offset = match find_field "anchorOffset" fields with
330
+
| Some v -> Some (Jmap_core.Jmap_primitives.Int53.of_json v)
331
+
| None -> None
332
+
in
333
+
let limit = match find_field "limit" fields with
334
+
| Some v -> Some (Jmap_core.Jmap_primitives.UnsignedInt.of_json v)
335
+
| None -> None
336
+
in
337
+
let calculate_total = match find_field "calculateTotal" fields with
338
+
| Some (`Bool b) -> Some b
339
+
| Some _ -> raise (Jmap_core.Jmap_error.Parse_error "calculateTotal must be a boolean")
340
+
| None -> None
341
+
in
342
+
let sort_as_tree = match find_field "sortAsTree" fields with
343
+
| Some (`Bool b) -> Some b
344
+
| Some _ -> raise (Jmap_core.Jmap_error.Parse_error "sortAsTree must be a boolean")
345
+
| None -> None
346
+
in
347
+
let filter_as_tree = match find_field "filterAsTree" fields with
348
+
| Some (`Bool b) -> Some b
349
+
| Some _ -> raise (Jmap_core.Jmap_error.Parse_error "filterAsTree must be a boolean")
350
+
| None -> None
351
+
in
352
+
{ account_id; filter; sort; position; anchor; anchor_offset; limit;
353
+
calculate_total; sort_as_tree; filter_as_tree }
199
354
200
355
(** Parse query response from JSON.
201
356
Test files: test/data/mail/mailbox_query_response.json *)
202
-
let response_of_json _json =
203
-
raise (Jmap_core.Jmap_error.Parse_error "Mailbox.Query.response_of_json not yet implemented")
357
+
let response_of_json json =
358
+
Jmap_core.Jmap_standard_methods.Query.response_of_json json
204
359
end
205
360
206
361
(** Standard /queryChanges method (RFC 8621 Section 2.6) *)
···
208
363
type request = Filter.t Jmap_core.Jmap_standard_methods.QueryChanges.request
209
364
type response = Jmap_core.Jmap_standard_methods.QueryChanges.response
210
365
211
-
let request_of_json _json =
212
-
raise (Jmap_core.Jmap_error.Parse_error "Mailbox.QueryChanges.request_of_json not yet implemented")
366
+
let request_of_json json =
367
+
Jmap_core.Jmap_standard_methods.QueryChanges.request_of_json Filter.of_json json
213
368
214
-
let response_of_json _json =
215
-
raise (Jmap_core.Jmap_error.Parse_error "Mailbox.QueryChanges.response_of_json not yet implemented")
369
+
let response_of_json json =
370
+
Jmap_core.Jmap_standard_methods.QueryChanges.response_of_json json
216
371
end
217
372
218
373
(** Standard /set method (RFC 8621 Section 2.4) *)
···
222
377
223
378
(** Parse set request from JSON.
224
379
Test files: test/data/mail/mailbox_set_request.json *)
225
-
let request_of_json _json =
226
-
raise (Jmap_core.Jmap_error.Parse_error "Mailbox.Set.request_of_json not yet implemented")
380
+
let request_of_json json =
381
+
Jmap_core.Jmap_standard_methods.Set.request_of_json Parser.of_json json
227
382
228
383
(** Parse set response from JSON.
229
384
Test files: test/data/mail/mailbox_set_response.json *)
230
-
let response_of_json _json =
231
-
raise (Jmap_core.Jmap_error.Parse_error "Mailbox.Set.response_of_json not yet implemented")
232
-
end
233
-
234
-
(** Parser submodule *)
235
-
module Parser = struct
236
-
(** Parse Mailbox from JSON.
237
-
Test files: test/data/mail/mailbox_get_response.json (list field)
238
-
239
-
Expected structure:
240
-
{
241
-
"id": "mb001",
242
-
"name": "INBOX",
243
-
"parentId": null,
244
-
"role": "inbox",
245
-
"sortOrder": 10,
246
-
"totalEmails": 1523,
247
-
"unreadEmails": 42,
248
-
"totalThreads": 987,
249
-
"unreadThreads": 35,
250
-
"myRights": { ... },
251
-
"isSubscribed": true
252
-
}
253
-
*)
254
-
let of_json _json =
255
-
(* TODO: Implement JSON parsing *)
256
-
raise (Jmap_core.Jmap_error.Parse_error "Mailbox.Parser.of_json not yet implemented")
257
-
258
-
let to_json _t =
259
-
(* TODO: Implement JSON serialization *)
260
-
raise (Jmap_core.Jmap_error.Parse_error "Mailbox.Parser.to_json not yet implemented")
385
+
let response_of_json json =
386
+
Jmap_core.Jmap_standard_methods.Set.response_of_json Parser.of_json json
261
387
end
262
388
263
389
(** Standard mailbox role values (RFC 8621 Section 2.1) *)
+3
-1
stack/jmap/test/dune
+3
-1
stack/jmap/test/dune
+829
-26
stack/jmap/test/test_jmap.ml
+829
-26
stack/jmap/test/test_jmap.ml
···
1
1
(** JMAP Test Suite using Alcotest
2
2
3
3
This test suite validates JMAP parsing using the comprehensive
4
-
JSON test files in test/data/.
4
+
JSON test files in data/.
5
5
6
6
To run: dune test
7
7
*)
···
10
10
11
11
(** Helper to load JSON file *)
12
12
let load_json path =
13
-
let ic = open_in path in
13
+
(* When running from _build/default/jmap/test, we need to go up to workspace root *)
14
+
let try_paths = [
15
+
path; (* Try direct path *)
16
+
"data/" ^ (Filename.basename path); (* Try data/ subdirectory *)
17
+
"../../../../jmap/test/" ^ path; (* From _build/default/jmap/test to jmap/test *)
18
+
] in
19
+
let rec find_file = function
20
+
| [] -> path (* Return original path, will fail with proper error *)
21
+
| p :: rest -> if Sys.file_exists p then p else find_file rest
22
+
in
23
+
let full_path = find_file try_paths in
24
+
let ic = open_in full_path in
14
25
Fun.protect
15
26
~finally:(fun () -> close_in ic)
16
27
(fun () -> Ezjsonm.from_channel ic)
···
18
29
(** Test Core Protocol *)
19
30
20
31
let test_echo_request () =
21
-
let _json = load_json "test/data/core/request_echo.json" in
32
+
let _json = load_json "data/core/request_echo.json" in
22
33
(* TODO: Parse and validate *)
23
34
check bool "Echo request loaded" true true
24
35
25
36
let test_echo_response () =
26
-
let _json = load_json "test/data/core/response_echo.json" in
37
+
let _json = load_json "data/core/response_echo.json" in
27
38
(* TODO: Parse and validate *)
28
39
check bool "Echo response loaded" true true
29
40
30
41
let test_get_request () =
31
-
let _json = load_json "test/data/core/request_get.json" in
42
+
let _json = load_json "data/core/request_get.json" in
32
43
(* TODO: Parse and validate *)
33
44
check bool "Get request loaded" true true
34
45
35
46
let test_get_response () =
36
-
let _json = load_json "test/data/core/response_get.json" in
47
+
let _json = load_json "data/core/response_get.json" in
37
48
(* TODO: Parse and validate *)
38
49
check bool "Get response loaded" true true
39
50
40
51
let test_session () =
41
-
let _json = load_json "test/data/core/session.json" in
52
+
let _json = load_json "data/core/session.json" in
42
53
(* TODO: Parse Session object *)
43
54
check bool "Session loaded" true true
44
55
45
-
(** Test Mail Protocol *)
56
+
(** Test Mail Protocol - Mailbox *)
46
57
47
58
let test_mailbox_get_request () =
48
-
let _json = load_json "test/data/mail/mailbox_get_request.json" in
49
-
(* TODO: Parse Mailbox/get request *)
50
-
check bool "Mailbox/get request loaded" true true
59
+
let json = load_json "data/mail/mailbox_get_request.json" in
60
+
let req = Jmap_mail.Jmap_mailbox.Get.request_of_json json in
61
+
62
+
(* Verify account_id *)
63
+
let account_id = Jmap_core.Jmap_standard_methods.Get.account_id req in
64
+
check string "Account ID" "u123456" (Jmap_core.Jmap_id.to_string account_id);
65
+
66
+
(* Verify ids is null (None) *)
67
+
let ids = Jmap_core.Jmap_standard_methods.Get.ids req in
68
+
check bool "IDs should be None" true (ids = None);
69
+
70
+
(* Verify properties list *)
71
+
let props = Jmap_core.Jmap_standard_methods.Get.properties req in
72
+
match props with
73
+
| Some p ->
74
+
check int "Properties count" 11 (List.length p);
75
+
check bool "Has id property" true (List.mem "id" p);
76
+
check bool "Has name property" true (List.mem "name" p);
77
+
check bool "Has role property" true (List.mem "role" p);
78
+
check bool "Has myRights property" true (List.mem "myRights" p)
79
+
| None ->
80
+
fail "Properties should not be None"
51
81
52
82
let test_mailbox_get_response () =
53
-
let _json = load_json "test/data/mail/mailbox_get_response.json" in
54
-
(* TODO: Parse Mailbox/get response *)
55
-
check bool "Mailbox/get response loaded" true true
83
+
let json = load_json "data/mail/mailbox_get_response.json" in
84
+
let resp = Jmap_mail.Jmap_mailbox.Get.response_of_json json in
85
+
86
+
(* Verify account_id *)
87
+
let account_id = Jmap_core.Jmap_standard_methods.Get.response_account_id resp in
88
+
check string "Account ID" "u123456" (Jmap_core.Jmap_id.to_string account_id);
89
+
90
+
(* Verify state *)
91
+
let state = Jmap_core.Jmap_standard_methods.Get.state resp in
92
+
check string "State" "m42:100" state;
93
+
94
+
(* Verify mailbox list *)
95
+
let mailboxes = Jmap_core.Jmap_standard_methods.Get.list resp in
96
+
check int "Mailbox count" 5 (List.length mailboxes);
97
+
98
+
(* Verify not_found is empty *)
99
+
let not_found = Jmap_core.Jmap_standard_methods.Get.not_found resp in
100
+
check int "Not found count" 0 (List.length not_found);
101
+
102
+
(* Test first mailbox (INBOX) *)
103
+
let inbox = List.hd mailboxes in
104
+
check string "INBOX id" "mb001" (Jmap_core.Jmap_id.to_string (Jmap_mail.Jmap_mailbox.id inbox));
105
+
check string "INBOX name" "INBOX" (Jmap_mail.Jmap_mailbox.name inbox);
106
+
check bool "INBOX parentId is None" true (Jmap_mail.Jmap_mailbox.parent_id inbox = None);
107
+
check string "INBOX role" "inbox" (match Jmap_mail.Jmap_mailbox.role inbox with Some r -> r | None -> "");
108
+
check int "INBOX sortOrder" 10 (Jmap_core.Jmap_primitives.UnsignedInt.to_int (Jmap_mail.Jmap_mailbox.sort_order inbox));
109
+
check int "INBOX totalEmails" 1523 (Jmap_core.Jmap_primitives.UnsignedInt.to_int (Jmap_mail.Jmap_mailbox.total_emails inbox));
110
+
check int "INBOX unreadEmails" 42 (Jmap_core.Jmap_primitives.UnsignedInt.to_int (Jmap_mail.Jmap_mailbox.unread_emails inbox));
111
+
check int "INBOX totalThreads" 987 (Jmap_core.Jmap_primitives.UnsignedInt.to_int (Jmap_mail.Jmap_mailbox.total_threads inbox));
112
+
check int "INBOX unreadThreads" 35 (Jmap_core.Jmap_primitives.UnsignedInt.to_int (Jmap_mail.Jmap_mailbox.unread_threads inbox));
113
+
check bool "INBOX isSubscribed" true (Jmap_mail.Jmap_mailbox.is_subscribed inbox);
114
+
115
+
(* Test INBOX rights *)
116
+
let inbox_rights = Jmap_mail.Jmap_mailbox.my_rights inbox in
117
+
check bool "INBOX mayReadItems" true (Jmap_mail.Jmap_mailbox.Rights.may_read_items inbox_rights);
118
+
check bool "INBOX mayAddItems" true (Jmap_mail.Jmap_mailbox.Rights.may_add_items inbox_rights);
119
+
check bool "INBOX mayRemoveItems" true (Jmap_mail.Jmap_mailbox.Rights.may_remove_items inbox_rights);
120
+
check bool "INBOX maySetSeen" true (Jmap_mail.Jmap_mailbox.Rights.may_set_seen inbox_rights);
121
+
check bool "INBOX maySetKeywords" true (Jmap_mail.Jmap_mailbox.Rights.may_set_keywords inbox_rights);
122
+
check bool "INBOX mayCreateChild" true (Jmap_mail.Jmap_mailbox.Rights.may_create_child inbox_rights);
123
+
check bool "INBOX mayRename" false (Jmap_mail.Jmap_mailbox.Rights.may_rename inbox_rights);
124
+
check bool "INBOX mayDelete" false (Jmap_mail.Jmap_mailbox.Rights.may_delete inbox_rights);
125
+
check bool "INBOX maySubmit" true (Jmap_mail.Jmap_mailbox.Rights.may_submit inbox_rights);
126
+
127
+
(* Test second mailbox (Sent) *)
128
+
let sent = List.nth mailboxes 1 in
129
+
check string "Sent id" "mb002" (Jmap_core.Jmap_id.to_string (Jmap_mail.Jmap_mailbox.id sent));
130
+
check string "Sent name" "Sent" (Jmap_mail.Jmap_mailbox.name sent);
131
+
check string "Sent role" "sent" (match Jmap_mail.Jmap_mailbox.role sent with Some r -> r | None -> "");
132
+
check int "Sent sortOrder" 20 (Jmap_core.Jmap_primitives.UnsignedInt.to_int (Jmap_mail.Jmap_mailbox.sort_order sent));
133
+
134
+
(* Test Work mailbox (no role) *)
135
+
let work = List.nth mailboxes 4 in
136
+
check string "Work id" "mb005" (Jmap_core.Jmap_id.to_string (Jmap_mail.Jmap_mailbox.id work));
137
+
check string "Work name" "Work" (Jmap_mail.Jmap_mailbox.name work);
138
+
check bool "Work role is None" true (Jmap_mail.Jmap_mailbox.role work = None);
139
+
check int "Work totalEmails" 342 (Jmap_core.Jmap_primitives.UnsignedInt.to_int (Jmap_mail.Jmap_mailbox.total_emails work));
140
+
141
+
(* Test Work rights (user-created mailbox has full permissions) *)
142
+
let work_rights = Jmap_mail.Jmap_mailbox.my_rights work in
143
+
check bool "Work mayRename" true (Jmap_mail.Jmap_mailbox.Rights.may_rename work_rights);
144
+
check bool "Work mayDelete" true (Jmap_mail.Jmap_mailbox.Rights.may_delete work_rights)
145
+
146
+
let test_mailbox_query_request () =
147
+
let json = load_json "data/mail/mailbox_query_request.json" in
148
+
let req = Jmap_mail.Jmap_mailbox.Query.request_of_json json in
149
+
150
+
(* Verify account_id *)
151
+
let account_id = Jmap_mail.Jmap_mailbox.Query.account_id req in
152
+
check string "Account ID" "u123456" (Jmap_core.Jmap_id.to_string account_id);
153
+
154
+
(* Verify filter is present *)
155
+
let filter = Jmap_mail.Jmap_mailbox.Query.filter req in
156
+
check bool "Filter should be Some" true (filter <> None);
157
+
158
+
(* Verify sort *)
159
+
let sort = Jmap_mail.Jmap_mailbox.Query.sort req in
160
+
match sort with
161
+
| Some s ->
162
+
check int "Sort criteria count" 2 (List.length s);
163
+
(* First sort by sortOrder ascending *)
164
+
let sort1 = List.hd s in
165
+
check string "First sort property" "sortOrder" (Jmap_core.Jmap_comparator.property sort1);
166
+
check bool "First sort ascending" true (Jmap_core.Jmap_comparator.is_ascending sort1);
167
+
(* Second sort by name ascending *)
168
+
let sort2 = List.nth s 1 in
169
+
check string "Second sort property" "name" (Jmap_core.Jmap_comparator.property sort2);
170
+
check bool "Second sort ascending" true (Jmap_core.Jmap_comparator.is_ascending sort2)
171
+
| None ->
172
+
fail "Sort should not be None";
173
+
174
+
(* Verify calculateTotal *)
175
+
let calculate_total = Jmap_mail.Jmap_mailbox.Query.calculate_total req in
176
+
check bool "Calculate total should be Some true" true (calculate_total = Some true)
177
+
178
+
let test_mailbox_query_response () =
179
+
let json = load_json "data/mail/mailbox_query_response.json" in
180
+
let resp = Jmap_mail.Jmap_mailbox.Query.response_of_json json in
181
+
182
+
(* Verify account_id *)
183
+
let account_id = Jmap_core.Jmap_standard_methods.Query.response_account_id resp in
184
+
check string "Account ID" "u123456" (Jmap_core.Jmap_id.to_string account_id);
185
+
186
+
(* Verify query_state *)
187
+
let query_state = Jmap_core.Jmap_standard_methods.Query.query_state resp in
188
+
check string "Query state" "mq42:100" query_state;
189
+
190
+
(* Verify can_calculate_changes *)
191
+
let can_calc = Jmap_core.Jmap_standard_methods.Query.can_calculate_changes resp in
192
+
check bool "Can calculate changes" true can_calc;
193
+
194
+
(* Verify position *)
195
+
let position = Jmap_core.Jmap_standard_methods.Query.response_position resp in
196
+
check int "Position" 0 (Jmap_core.Jmap_primitives.UnsignedInt.to_int position);
197
+
198
+
(* Verify ids *)
199
+
let ids = Jmap_core.Jmap_standard_methods.Query.ids resp in
200
+
check int "IDs count" 3 (List.length ids);
201
+
check string "First ID" "mb005" (Jmap_core.Jmap_id.to_string (List.hd ids));
202
+
check string "Second ID" "mb008" (Jmap_core.Jmap_id.to_string (List.nth ids 1));
203
+
check string "Third ID" "mb012" (Jmap_core.Jmap_id.to_string (List.nth ids 2));
204
+
205
+
(* Verify total *)
206
+
let total = Jmap_core.Jmap_standard_methods.Query.total resp in
207
+
match total with
208
+
| Some t -> check int "Total" 3 (Jmap_core.Jmap_primitives.UnsignedInt.to_int t)
209
+
| None -> fail "Total should not be None"
210
+
211
+
let test_mailbox_set_request () =
212
+
let json = load_json "data/mail/mailbox_set_request.json" in
213
+
let req = Jmap_mail.Jmap_mailbox.Set.request_of_json json in
214
+
215
+
(* Verify account_id *)
216
+
let account_id = Jmap_core.Jmap_standard_methods.Set.account_id req in
217
+
check string "Account ID" "u123456" (Jmap_core.Jmap_id.to_string account_id);
218
+
219
+
(* Verify if_in_state *)
220
+
let if_in_state = Jmap_core.Jmap_standard_methods.Set.if_in_state req in
221
+
check bool "If in state should be Some" true (if_in_state = Some "m42:100");
222
+
223
+
(* Verify create *)
224
+
let create = Jmap_core.Jmap_standard_methods.Set.create req in
225
+
(match create with
226
+
| Some c ->
227
+
check int "Create count" 1 (List.length c);
228
+
let (temp_id, mailbox) = List.hd c in
229
+
check string "Temp ID" "temp-mb-1" (Jmap_core.Jmap_id.to_string temp_id);
230
+
check string "Created mailbox name" "Projects" (Jmap_mail.Jmap_mailbox.name mailbox);
231
+
check bool "Created mailbox parentId is None" true (Jmap_mail.Jmap_mailbox.parent_id mailbox = None);
232
+
check bool "Created mailbox role is None" true (Jmap_mail.Jmap_mailbox.role mailbox = None);
233
+
check int "Created mailbox sortOrder" 60 (Jmap_core.Jmap_primitives.UnsignedInt.to_int (Jmap_mail.Jmap_mailbox.sort_order mailbox));
234
+
check bool "Created mailbox isSubscribed" true (Jmap_mail.Jmap_mailbox.is_subscribed mailbox)
235
+
| None ->
236
+
fail "Create should not be None");
237
+
238
+
(* Verify update *)
239
+
let update = Jmap_core.Jmap_standard_methods.Set.update req in
240
+
(match update with
241
+
| Some u ->
242
+
check int "Update count" 1 (List.length u);
243
+
let (update_id, _patches) = List.hd u in
244
+
check string "Update ID" "mb005" (Jmap_core.Jmap_id.to_string update_id)
245
+
| None ->
246
+
fail "Update should not be None");
247
+
248
+
(* Verify destroy *)
249
+
let destroy = Jmap_core.Jmap_standard_methods.Set.destroy req in
250
+
(match destroy with
251
+
| Some d ->
252
+
check int "Destroy count" 1 (List.length d);
253
+
check string "Destroy ID" "mb012" (Jmap_core.Jmap_id.to_string (List.hd d))
254
+
| None ->
255
+
fail "Destroy should not be None")
256
+
257
+
let test_mailbox_set_response () =
258
+
let json = load_json "data/mail/mailbox_set_response.json" in
259
+
let resp = Jmap_mail.Jmap_mailbox.Set.response_of_json json in
260
+
261
+
(* Verify account_id *)
262
+
let account_id = Jmap_core.Jmap_standard_methods.Set.response_account_id resp in
263
+
check string "Account ID" "u123456" (Jmap_core.Jmap_id.to_string account_id);
264
+
265
+
(* Verify old_state *)
266
+
let old_state = Jmap_core.Jmap_standard_methods.Set.old_state resp in
267
+
check bool "Old state should be Some" true (old_state = Some "m42:100");
268
+
269
+
(* Verify new_state *)
270
+
let new_state = Jmap_core.Jmap_standard_methods.Set.new_state resp in
271
+
check string "New state" "m42:103" new_state;
272
+
273
+
(* Verify created *)
274
+
let created = Jmap_core.Jmap_standard_methods.Set.created resp in
275
+
(match created with
276
+
| Some c ->
277
+
check int "Created count" 1 (List.length c);
278
+
let (temp_id, mailbox) = List.hd c in
279
+
check string "Created temp ID" "temp-mb-1" (Jmap_core.Jmap_id.to_string temp_id);
280
+
check string "Created mailbox ID" "mb020" (Jmap_core.Jmap_id.to_string (Jmap_mail.Jmap_mailbox.id mailbox));
281
+
check int "Created mailbox totalEmails" 0 (Jmap_core.Jmap_primitives.UnsignedInt.to_int (Jmap_mail.Jmap_mailbox.total_emails mailbox));
282
+
check int "Created mailbox unreadEmails" 0 (Jmap_core.Jmap_primitives.UnsignedInt.to_int (Jmap_mail.Jmap_mailbox.unread_emails mailbox));
283
+
(* Verify rights of created mailbox *)
284
+
let rights = Jmap_mail.Jmap_mailbox.my_rights mailbox in
285
+
check bool "Created mailbox mayRename" true (Jmap_mail.Jmap_mailbox.Rights.may_rename rights);
286
+
check bool "Created mailbox mayDelete" true (Jmap_mail.Jmap_mailbox.Rights.may_delete rights)
287
+
| None ->
288
+
fail "Created should not be None");
289
+
290
+
(* Verify updated *)
291
+
let updated = Jmap_core.Jmap_standard_methods.Set.updated resp in
292
+
(match updated with
293
+
| Some u ->
294
+
check int "Updated count" 1 (List.length u);
295
+
let (update_id, update_val) = List.hd u in
296
+
check string "Updated ID" "mb005" (Jmap_core.Jmap_id.to_string update_id);
297
+
check bool "Updated value is None" true (update_val = None)
298
+
| None ->
299
+
fail "Updated should not be None");
300
+
301
+
(* Verify destroyed *)
302
+
let destroyed = Jmap_core.Jmap_standard_methods.Set.destroyed resp in
303
+
(match destroyed with
304
+
| Some d ->
305
+
check int "Destroyed count" 1 (List.length d);
306
+
check string "Destroyed ID" "mb012" (Jmap_core.Jmap_id.to_string (List.hd d))
307
+
| None ->
308
+
fail "Destroyed should not be None");
309
+
310
+
(* Verify not_created, not_updated, not_destroyed are None *)
311
+
check bool "Not created is None" true (Jmap_core.Jmap_standard_methods.Set.not_created resp = None);
312
+
check bool "Not updated is None" true (Jmap_core.Jmap_standard_methods.Set.not_updated resp = None);
313
+
check bool "Not destroyed is None" true (Jmap_core.Jmap_standard_methods.Set.not_destroyed resp = None)
314
+
315
+
(** Test Mail Protocol - Email *)
56
316
57
317
let test_email_get_request () =
58
-
let _json = load_json "test/data/mail/email_get_request.json" in
59
-
(* TODO: Parse Email/get request *)
60
-
check bool "Email/get request loaded" true true
318
+
let json = load_json "data/mail/email_get_request.json" in
319
+
let request = Jmap_mail.Jmap_email.Get.request_of_json json in
320
+
321
+
(* Validate account_id *)
322
+
let account_id = Jmap_mail.Jmap_email.Get.account_id request in
323
+
check string "Account ID" "u123456" (Jmap_core.Jmap_id.to_string account_id);
324
+
325
+
(* Validate ids *)
326
+
let ids = Jmap_mail.Jmap_email.Get.ids request in
327
+
check bool "IDs present" true (Option.is_some ids);
328
+
let ids_list = Option.get ids in
329
+
check int "Two IDs requested" 2 (List.length ids_list);
330
+
check string "First ID" "e001" (Jmap_core.Jmap_id.to_string (List.nth ids_list 0));
331
+
check string "Second ID" "e002" (Jmap_core.Jmap_id.to_string (List.nth ids_list 1));
332
+
333
+
(* Validate properties *)
334
+
let properties = Jmap_mail.Jmap_email.Get.properties request in
335
+
check bool "Properties present" true (Option.is_some properties);
336
+
let props_list = Option.get properties in
337
+
check bool "Properties include 'subject'" true (List.mem "subject" props_list);
338
+
check bool "Properties include 'from'" true (List.mem "from" props_list);
339
+
check bool "Properties include 'to'" true (List.mem "to" props_list)
340
+
341
+
let test_email_get_full_request () =
342
+
let json = load_json "data/mail/email_get_full_request.json" in
343
+
let request = Jmap_mail.Jmap_email.Get.request_of_json json in
344
+
345
+
(* Validate body fetch options *)
346
+
let fetch_text = Jmap_mail.Jmap_email.Get.fetch_text_body_values request in
347
+
check bool "Fetch text body values" true (Option.value ~default:false fetch_text);
348
+
349
+
let fetch_html = Jmap_mail.Jmap_email.Get.fetch_html_body_values request in
350
+
check bool "Fetch HTML body values" true (Option.value ~default:false fetch_html);
351
+
352
+
let fetch_all = Jmap_mail.Jmap_email.Get.fetch_all_body_values request in
353
+
check bool "Fetch all body values is false" false (Option.value ~default:true fetch_all);
354
+
355
+
let max_bytes = Jmap_mail.Jmap_email.Get.max_body_value_bytes request in
356
+
check bool "Max body value bytes present" true (Option.is_some max_bytes);
357
+
check int "Max bytes is 32768" 32768
358
+
(Jmap_core.Jmap_primitives.UnsignedInt.to_int (Option.get max_bytes))
61
359
62
360
let test_email_get_response () =
63
-
let _json = load_json "test/data/mail/email_get_response.json" in
64
-
(* TODO: Parse Email/get response *)
65
-
check bool "Email/get response loaded" true true
361
+
let json = load_json "data/mail/email_get_response.json" in
362
+
let response = Jmap_mail.Jmap_email.Get.response_of_json json in
363
+
364
+
(* Validate response metadata *)
365
+
let account_id = Jmap_core.Jmap_standard_methods.Get.response_account_id response in
366
+
check string "Response account ID" "u123456" (Jmap_core.Jmap_id.to_string account_id);
367
+
368
+
let state = Jmap_core.Jmap_standard_methods.Get.state response in
369
+
check string "Response state" "e42:100" state;
370
+
371
+
(* Validate emails list *)
372
+
let emails = Jmap_core.Jmap_standard_methods.Get.list response in
373
+
check int "Two emails returned" 2 (List.length emails);
374
+
375
+
(* Test first email (e001) *)
376
+
let email1 = List.nth emails 0 in
377
+
check string "Email 1 ID" "e001" (Jmap_core.Jmap_id.to_string (Jmap_mail.Jmap_email.id email1));
378
+
check string "Email 1 thread ID" "t001" (Jmap_core.Jmap_id.to_string (Jmap_mail.Jmap_email.thread_id email1));
379
+
check string "Email 1 subject" "Project Update Q4 2025"
380
+
(Option.get (Jmap_mail.Jmap_email.subject email1));
381
+
check int "Email 1 size" 15234
382
+
(Jmap_core.Jmap_primitives.UnsignedInt.to_int (Jmap_mail.Jmap_email.size email1));
383
+
check bool "Email 1 has no attachment" false (Jmap_mail.Jmap_email.has_attachment email1);
384
+
385
+
(* Test email 1 from address *)
386
+
let from1 = Option.get (Jmap_mail.Jmap_email.from email1) in
387
+
check int "Email 1 has one from address" 1 (List.length from1);
388
+
let from_addr = List.nth from1 0 in
389
+
check string "Email 1 from name" "Bob Smith"
390
+
(Option.get (Jmap_mail.Jmap_email.EmailAddress.name from_addr));
391
+
check string "Email 1 from email" "bob@example.com"
392
+
(Jmap_mail.Jmap_email.EmailAddress.email from_addr);
393
+
394
+
(* Test email 1 to addresses *)
395
+
let to1 = Option.get (Jmap_mail.Jmap_email.to_ email1) in
396
+
check int "Email 1 has one to address" 1 (List.length to1);
397
+
let to_addr = List.nth to1 0 in
398
+
check string "Email 1 to name" "Alice Jones"
399
+
(Option.get (Jmap_mail.Jmap_email.EmailAddress.name to_addr));
400
+
check string "Email 1 to email" "alice@example.com"
401
+
(Jmap_mail.Jmap_email.EmailAddress.email to_addr);
402
+
403
+
(* Test email 1 keywords *)
404
+
let keywords1 = Jmap_mail.Jmap_email.keywords email1 in
405
+
check bool "Email 1 has $seen keyword" true
406
+
(List.mem_assoc "$seen" keywords1);
407
+
check bool "Email 1 $seen is true" true
408
+
(List.assoc "$seen" keywords1);
409
+
410
+
(* Test second email (e002) *)
411
+
let email2 = List.nth emails 1 in
412
+
check string "Email 2 ID" "e002" (Jmap_core.Jmap_id.to_string (Jmap_mail.Jmap_email.id email2));
413
+
check string "Email 2 subject" "Re: Technical Requirements Review"
414
+
(Option.get (Jmap_mail.Jmap_email.subject email2));
415
+
416
+
(* Test email 2 to addresses (multiple recipients) *)
417
+
let to2 = Option.get (Jmap_mail.Jmap_email.to_ email2) in
418
+
check int "Email 2 has two to addresses" 2 (List.length to2);
419
+
420
+
(* Test email 2 keywords *)
421
+
let keywords2 = Jmap_mail.Jmap_email.keywords email2 in
422
+
check bool "Email 2 has $seen keyword" true
423
+
(List.mem_assoc "$seen" keywords2);
424
+
check bool "Email 2 has $flagged keyword" true
425
+
(List.mem_assoc "$flagged" keywords2);
426
+
427
+
(* Test email 2 replyTo *)
428
+
let reply_to2 = Jmap_mail.Jmap_email.reply_to email2 in
429
+
check bool "Email 2 has replyTo" true (Option.is_some reply_to2);
430
+
let reply_to_list = Option.get reply_to2 in
431
+
check int "Email 2 has one replyTo address" 1 (List.length reply_to_list);
432
+
let reply_addr = List.nth reply_to_list 0 in
433
+
check string "Email 2 replyTo email" "support@company.com"
434
+
(Jmap_mail.Jmap_email.EmailAddress.email reply_addr);
435
+
436
+
(* Validate notFound is empty *)
437
+
let not_found = Jmap_core.Jmap_standard_methods.Get.not_found response in
438
+
check int "No emails not found" 0 (List.length not_found)
439
+
440
+
let test_email_get_full_response () =
441
+
let json = load_json "data/mail/email_get_full_response.json" in
442
+
let response = Jmap_mail.Jmap_email.Get.response_of_json json in
443
+
444
+
let emails = Jmap_core.Jmap_standard_methods.Get.list response in
445
+
check int "One email returned" 1 (List.length emails);
446
+
447
+
let email = List.nth emails 0 in
448
+
449
+
(* Validate basic fields *)
450
+
check string "Email ID" "e001" (Jmap_core.Jmap_id.to_string (Jmap_mail.Jmap_email.id email));
451
+
check bool "Has attachment" true (Jmap_mail.Jmap_email.has_attachment email);
452
+
453
+
(* Validate bodyStructure (multipart/mixed with nested multipart/alternative) *)
454
+
let body_structure = Jmap_mail.Jmap_email.body_structure email in
455
+
check bool "Has bodyStructure" true (Option.is_some body_structure);
456
+
457
+
let root_part = Option.get body_structure in
458
+
check string "Root type is multipart/mixed" "multipart/mixed"
459
+
(Jmap_mail.Jmap_email.BodyPart.type_ root_part);
460
+
461
+
let sub_parts = Jmap_mail.Jmap_email.BodyPart.sub_parts root_part in
462
+
check bool "Root has subParts" true (Option.is_some sub_parts);
463
+
let parts_list = Option.get sub_parts in
464
+
check int "Root has 2 subParts" 2 (List.length parts_list);
465
+
466
+
(* First subpart: multipart/alternative *)
467
+
let alt_part = List.nth parts_list 0 in
468
+
check string "First subpart is multipart/alternative" "multipart/alternative"
469
+
(Jmap_mail.Jmap_email.BodyPart.type_ alt_part);
470
+
471
+
let alt_sub_parts = Option.get (Jmap_mail.Jmap_email.BodyPart.sub_parts alt_part) in
472
+
check int "Alternative has 2 subParts" 2 (List.length alt_sub_parts);
473
+
474
+
(* Text/plain part *)
475
+
let text_part = List.nth alt_sub_parts 0 in
476
+
check string "Text part type" "text/plain" (Jmap_mail.Jmap_email.BodyPart.type_ text_part);
477
+
check string "Text part charset" "utf-8"
478
+
(Option.get (Jmap_mail.Jmap_email.BodyPart.charset text_part));
479
+
check string "Text part ID" "1" (Option.get (Jmap_mail.Jmap_email.BodyPart.part_id text_part));
480
+
check int "Text part size" 2134
481
+
(Jmap_core.Jmap_primitives.UnsignedInt.to_int (Jmap_mail.Jmap_email.BodyPart.size text_part));
482
+
483
+
(* Text/html part *)
484
+
let html_part = List.nth alt_sub_parts 1 in
485
+
check string "HTML part type" "text/html" (Jmap_mail.Jmap_email.BodyPart.type_ html_part);
486
+
check string "HTML part ID" "2" (Option.get (Jmap_mail.Jmap_email.BodyPart.part_id html_part));
487
+
check int "HTML part size" 4567
488
+
(Jmap_core.Jmap_primitives.UnsignedInt.to_int (Jmap_mail.Jmap_email.BodyPart.size html_part));
489
+
490
+
(* Attachment part *)
491
+
let attach_part = List.nth parts_list 1 in
492
+
check string "Attachment type" "application/pdf"
493
+
(Jmap_mail.Jmap_email.BodyPart.type_ attach_part);
494
+
check string "Attachment name" "Q4_Report.pdf"
495
+
(Option.get (Jmap_mail.Jmap_email.BodyPart.name attach_part));
496
+
check string "Attachment disposition" "attachment"
497
+
(Option.get (Jmap_mail.Jmap_email.BodyPart.disposition attach_part));
498
+
check string "Attachment part ID" "3"
499
+
(Option.get (Jmap_mail.Jmap_email.BodyPart.part_id attach_part));
500
+
check int "Attachment size" 8533
501
+
(Jmap_core.Jmap_primitives.UnsignedInt.to_int (Jmap_mail.Jmap_email.BodyPart.size attach_part));
502
+
503
+
(* Validate textBody *)
504
+
let text_body = Jmap_mail.Jmap_email.text_body email in
505
+
check bool "Has textBody" true (Option.is_some text_body);
506
+
let text_body_list = Option.get text_body in
507
+
check int "One textBody part" 1 (List.length text_body_list);
508
+
let text_body_part = List.nth text_body_list 0 in
509
+
check string "textBody part ID" "1"
510
+
(Option.get (Jmap_mail.Jmap_email.BodyPart.part_id text_body_part));
511
+
check string "textBody type" "text/plain"
512
+
(Jmap_mail.Jmap_email.BodyPart.type_ text_body_part);
513
+
514
+
(* Validate htmlBody *)
515
+
let html_body = Jmap_mail.Jmap_email.html_body email in
516
+
check bool "Has htmlBody" true (Option.is_some html_body);
517
+
let html_body_list = Option.get html_body in
518
+
check int "One htmlBody part" 1 (List.length html_body_list);
519
+
let html_body_part = List.nth html_body_list 0 in
520
+
check string "htmlBody part ID" "2"
521
+
(Option.get (Jmap_mail.Jmap_email.BodyPart.part_id html_body_part));
522
+
check string "htmlBody type" "text/html"
523
+
(Jmap_mail.Jmap_email.BodyPart.type_ html_body_part);
524
+
525
+
(* Validate attachments *)
526
+
let attachments = Jmap_mail.Jmap_email.attachments email in
527
+
check bool "Has attachments" true (Option.is_some attachments);
528
+
let attachments_list = Option.get attachments in
529
+
check int "One attachment" 1 (List.length attachments_list);
530
+
let attachment = List.nth attachments_list 0 in
531
+
check string "Attachment name" "Q4_Report.pdf"
532
+
(Option.get (Jmap_mail.Jmap_email.BodyPart.name attachment));
533
+
534
+
(* Validate bodyValues *)
535
+
let body_values = Jmap_mail.Jmap_email.body_values email in
536
+
check bool "Has bodyValues" true (Option.is_some body_values);
537
+
let values_list = Option.get body_values in
538
+
check int "Two bodyValues" 2 (List.length values_list);
539
+
540
+
(* Text body value *)
541
+
check bool "Has bodyValue for part 1" true (List.mem_assoc "1" values_list);
542
+
let text_value = List.assoc "1" values_list in
543
+
let text_content = Jmap_mail.Jmap_email.BodyValue.value text_value in
544
+
check bool "Text content starts with 'Hi Alice'" true
545
+
(String.starts_with ~prefix:"Hi Alice" text_content);
546
+
check bool "Text not truncated" false
547
+
(Jmap_mail.Jmap_email.BodyValue.is_truncated text_value);
548
+
check bool "Text no encoding problem" false
549
+
(Jmap_mail.Jmap_email.BodyValue.is_encoding_problem text_value);
550
+
551
+
(* HTML body value *)
552
+
check bool "Has bodyValue for part 2" true (List.mem_assoc "2" values_list);
553
+
let html_value = List.assoc "2" values_list in
554
+
let html_content = Jmap_mail.Jmap_email.BodyValue.value html_value in
555
+
check bool "HTML content starts with '<html>'" true
556
+
(String.starts_with ~prefix:"<html>" html_content);
557
+
check bool "HTML not truncated" false
558
+
(Jmap_mail.Jmap_email.BodyValue.is_truncated html_value)
559
+
560
+
let test_email_query_request () =
561
+
let json = load_json "data/mail/email_query_request.json" in
562
+
let request = Jmap_mail.Jmap_email.Query.request_of_json json in
563
+
564
+
(* Validate account_id *)
565
+
let account_id = Jmap_mail.Jmap_email.Query.account_id request in
566
+
check string "Account ID" "u123456" (Jmap_core.Jmap_id.to_string account_id);
567
+
568
+
(* Validate limit *)
569
+
let limit = Jmap_mail.Jmap_email.Query.limit request in
570
+
check bool "Has limit" true (Option.is_some limit);
571
+
check int "Limit is 50" 50
572
+
(Jmap_core.Jmap_primitives.UnsignedInt.to_int (Option.get limit));
573
+
574
+
(* Validate calculateTotal *)
575
+
let calc_total = Jmap_mail.Jmap_email.Query.calculate_total request in
576
+
check bool "Calculate total is true" true (Option.value ~default:false calc_total);
577
+
578
+
(* Validate collapseThreads *)
579
+
let collapse = Jmap_mail.Jmap_email.Query.collapse_threads request in
580
+
check bool "Collapse threads is false" false (Option.value ~default:true collapse);
581
+
582
+
(* Validate position *)
583
+
let position = Jmap_mail.Jmap_email.Query.position request in
584
+
check bool "Has position" true (Option.is_some position);
585
+
check int "Position is 0" 0
586
+
(Jmap_core.Jmap_primitives.Int53.to_int (Option.get position))
587
+
588
+
let test_email_query_response () =
589
+
let json = load_json "data/mail/email_query_response.json" in
590
+
let response = Jmap_mail.Jmap_email.Query.response_of_json json in
591
+
592
+
(* Validate account_id *)
593
+
let account_id = Jmap_core.Jmap_standard_methods.Query.response_account_id response in
594
+
check string "Account ID" "u123456" (Jmap_core.Jmap_id.to_string account_id);
595
+
596
+
(* Validate query state *)
597
+
let query_state = Jmap_core.Jmap_standard_methods.Query.query_state response in
598
+
check string "Query state" "eq42:100" query_state;
599
+
600
+
(* Validate can calculate changes *)
601
+
let can_calc = Jmap_core.Jmap_standard_methods.Query.can_calculate_changes response in
602
+
check bool "Can calculate changes" true can_calc;
603
+
604
+
(* Validate position *)
605
+
let position = Jmap_core.Jmap_standard_methods.Query.response_position response in
606
+
check int "Position is 0" 0 (Jmap_core.Jmap_primitives.UnsignedInt.to_int position);
607
+
608
+
(* Validate IDs *)
609
+
let ids = Jmap_core.Jmap_standard_methods.Query.ids response in
610
+
check int "Five IDs returned" 5 (List.length ids);
611
+
check string "First ID" "e015" (Jmap_core.Jmap_id.to_string (List.nth ids 0));
612
+
check string "Last ID" "e005" (Jmap_core.Jmap_id.to_string (List.nth ids 4));
613
+
614
+
(* Validate total *)
615
+
let total = Jmap_core.Jmap_standard_methods.Query.total response in
616
+
check bool "Has total" true (Option.is_some total);
617
+
check int "Total is 5" 5
618
+
(Jmap_core.Jmap_primitives.UnsignedInt.to_int (Option.get total))
619
+
620
+
let test_email_set_request () =
621
+
let json = load_json "data/mail/email_set_request.json" in
622
+
let request = Jmap_mail.Jmap_email.Set.request_of_json json in
623
+
624
+
(* Validate account_id *)
625
+
let account_id = Jmap_core.Jmap_standard_methods.Set.account_id request in
626
+
check string "Account ID" "u123456" (Jmap_core.Jmap_id.to_string account_id);
627
+
628
+
(* Validate ifInState *)
629
+
let if_in_state = Jmap_core.Jmap_standard_methods.Set.if_in_state request in
630
+
check bool "Has ifInState" true (Option.is_some if_in_state);
631
+
check string "ifInState value" "e42:100" (Option.get if_in_state);
632
+
633
+
(* Validate create *)
634
+
let create = Jmap_core.Jmap_standard_methods.Set.create request in
635
+
check bool "Has create" true (Option.is_some create);
636
+
let create_list = Option.get create in
637
+
check int "One email to create" 1 (List.length create_list);
638
+
let (create_id, _email) = List.nth create_list 0 in
639
+
check string "Create ID" "temp-email-1" (Jmap_core.Jmap_id.to_string create_id);
640
+
641
+
(* Validate update *)
642
+
let update = Jmap_core.Jmap_standard_methods.Set.update request in
643
+
check bool "Has update" true (Option.is_some update);
644
+
let update_list = Option.get update in
645
+
check int "Two emails to update" 2 (List.length update_list);
646
+
647
+
(* Validate destroy *)
648
+
let destroy = Jmap_core.Jmap_standard_methods.Set.destroy request in
649
+
check bool "Has destroy" true (Option.is_some destroy);
650
+
let destroy_list = Option.get destroy in
651
+
check int "One email to destroy" 1 (List.length destroy_list);
652
+
check string "Destroy ID" "e099" (Jmap_core.Jmap_id.to_string (List.nth destroy_list 0))
653
+
654
+
let test_email_set_response () =
655
+
let json = load_json "data/mail/email_set_response.json" in
656
+
let response = Jmap_mail.Jmap_email.Set.response_of_json json in
657
+
658
+
(* Validate account_id *)
659
+
let account_id = Jmap_core.Jmap_standard_methods.Set.response_account_id response in
660
+
check string "Account ID" "u123456" (Jmap_core.Jmap_id.to_string account_id);
661
+
662
+
(* Validate states *)
663
+
let old_state = Jmap_core.Jmap_standard_methods.Set.old_state response in
664
+
check bool "Has old state" true (Option.is_some old_state);
665
+
check string "Old state" "e42:100" (Option.get old_state);
666
+
667
+
let new_state = Jmap_core.Jmap_standard_methods.Set.new_state response in
668
+
check string "New state" "e42:103" new_state;
669
+
670
+
(* Validate created *)
671
+
let created = Jmap_core.Jmap_standard_methods.Set.created response in
672
+
check bool "Has created" true (Option.is_some created);
673
+
let created_list = Option.get created in
674
+
check int "One email created" 1 (List.length created_list);
675
+
let (temp_id, email) = List.nth created_list 0 in
676
+
check string "Created temp ID" "temp-email-1" (Jmap_core.Jmap_id.to_string temp_id);
677
+
check string "Created email ID" "e101" (Jmap_core.Jmap_id.to_string (Jmap_mail.Jmap_email.id email));
678
+
check string "Created thread ID" "t050"
679
+
(Jmap_core.Jmap_id.to_string (Jmap_mail.Jmap_email.thread_id email));
680
+
681
+
(* Validate updated *)
682
+
let updated = Jmap_core.Jmap_standard_methods.Set.updated response in
683
+
check bool "Has updated" true (Option.is_some updated);
684
+
let updated_map = Option.get updated in
685
+
check int "Two emails updated" 2 (List.length updated_map);
686
+
687
+
(* Validate destroyed *)
688
+
let destroyed = Jmap_core.Jmap_standard_methods.Set.destroyed response in
689
+
check bool "Has destroyed" true (Option.is_some destroyed);
690
+
let destroyed_list = Option.get destroyed in
691
+
check int "One email destroyed" 1 (List.length destroyed_list);
692
+
check string "Destroyed ID" "e099" (Jmap_core.Jmap_id.to_string (List.nth destroyed_list 0))
693
+
694
+
let test_email_import_request () =
695
+
let json = load_json "data/mail/email_import_request.json" in
696
+
let request = Jmap_mail.Jmap_email.Import.request_of_json json in
697
+
698
+
(* Validate account_id *)
699
+
let account_id = Jmap_mail.Jmap_email.Import.account_id request in
700
+
check string "Account ID" "u123456" (Jmap_core.Jmap_id.to_string account_id);
701
+
702
+
(* Validate ifInState *)
703
+
let if_in_state = Jmap_mail.Jmap_email.Import.if_in_state request in
704
+
check bool "Has ifInState" true (Option.is_some if_in_state);
705
+
check string "ifInState value" "e42:103" (Option.get if_in_state);
706
+
707
+
(* Validate emails *)
708
+
let emails = Jmap_mail.Jmap_email.Import.emails request in
709
+
check int "Two emails to import" 2 (List.length emails);
710
+
711
+
let (import_id1, import_email1) = List.nth emails 0 in
712
+
check string "First import ID" "temp-import-1" (Jmap_core.Jmap_id.to_string import_id1);
713
+
let blob_id1 = Jmap_mail.Jmap_email.Import.import_blob_id import_email1 in
714
+
check string "First blob ID starts correctly" "Gb5f55i6"
715
+
(String.sub (Jmap_core.Jmap_id.to_string blob_id1) 0 8);
716
+
717
+
let keywords1 = Jmap_mail.Jmap_email.Import.import_keywords import_email1 in
718
+
check bool "First email has $seen keyword" true
719
+
(List.mem_assoc "$seen" keywords1)
720
+
721
+
let test_email_import_response () =
722
+
let json = load_json "data/mail/email_import_response.json" in
723
+
let response = Jmap_mail.Jmap_email.Import.response_of_json json in
724
+
725
+
(* Validate account_id *)
726
+
let account_id = Jmap_mail.Jmap_email.Import.response_account_id response in
727
+
check string "Account ID" "u123456" (Jmap_core.Jmap_id.to_string account_id);
728
+
729
+
(* Validate states *)
730
+
let old_state = Jmap_mail.Jmap_email.Import.old_state response in
731
+
check bool "Has old state" true (Option.is_some old_state);
732
+
check string "Old state" "e42:103" (Option.get old_state);
733
+
734
+
let new_state = Jmap_mail.Jmap_email.Import.new_state response in
735
+
check string "New state" "e42:105" new_state;
736
+
737
+
(* Validate created *)
738
+
let created = Jmap_mail.Jmap_email.Import.created response in
739
+
check bool "Has created" true (Option.is_some created);
740
+
let created_list = Option.get created in
741
+
check int "Two emails imported" 2 (List.length created_list);
742
+
743
+
let (temp_id1, email1) = List.nth created_list 0 in
744
+
check string "First temp ID" "temp-import-1" (Jmap_core.Jmap_id.to_string temp_id1);
745
+
check string "First email ID" "e102" (Jmap_core.Jmap_id.to_string (Jmap_mail.Jmap_email.id email1));
746
+
check string "First thread ID" "t051"
747
+
(Jmap_core.Jmap_id.to_string (Jmap_mail.Jmap_email.thread_id email1));
748
+
749
+
let (temp_id2, email2) = List.nth created_list 1 in
750
+
check string "Second temp ID" "temp-import-2" (Jmap_core.Jmap_id.to_string temp_id2);
751
+
check string "Second email ID" "e103" (Jmap_core.Jmap_id.to_string (Jmap_mail.Jmap_email.id email2))
752
+
753
+
let test_email_parse_request () =
754
+
let json = load_json "data/mail/email_parse_request.json" in
755
+
let request = Jmap_mail.Jmap_email.Parse.request_of_json json in
756
+
757
+
(* Validate account_id *)
758
+
let account_id = Jmap_mail.Jmap_email.Parse.account_id request in
759
+
check string "Account ID" "u123456" (Jmap_core.Jmap_id.to_string account_id);
760
+
761
+
(* Validate blob_ids *)
762
+
let blob_ids = Jmap_mail.Jmap_email.Parse.blob_ids request in
763
+
check int "One blob ID" 1 (List.length blob_ids);
764
+
let blob_id = List.nth blob_ids 0 in
765
+
check string "Blob ID starts correctly" "Gb5f77k8"
766
+
(String.sub (Jmap_core.Jmap_id.to_string blob_id) 0 8);
767
+
768
+
(* Validate fetch options *)
769
+
let fetch_text = Jmap_mail.Jmap_email.Parse.fetch_text_body_values request in
770
+
check bool "Fetch text body values" true (Option.value ~default:false fetch_text);
771
+
772
+
let fetch_html = Jmap_mail.Jmap_email.Parse.fetch_html_body_values request in
773
+
check bool "Fetch HTML body values" true (Option.value ~default:false fetch_html);
774
+
775
+
let max_bytes = Jmap_mail.Jmap_email.Parse.max_body_value_bytes request in
776
+
check bool "Has max bytes" true (Option.is_some max_bytes);
777
+
check int "Max bytes is 16384" 16384
778
+
(Jmap_core.Jmap_primitives.UnsignedInt.to_int (Option.get max_bytes))
779
+
780
+
let test_email_parse_response () =
781
+
let json = load_json "data/mail/email_parse_response.json" in
782
+
let response = Jmap_mail.Jmap_email.Parse.response_of_json json in
783
+
784
+
(* Validate account_id *)
785
+
let account_id = Jmap_mail.Jmap_email.Parse.response_account_id response in
786
+
check string "Account ID" "u123456" (Jmap_core.Jmap_id.to_string account_id);
787
+
788
+
(* Validate parsed *)
789
+
let parsed = Jmap_mail.Jmap_email.Parse.parsed response in
790
+
check bool "Has parsed emails" true (Option.is_some parsed);
791
+
let parsed_list = Option.get parsed in
792
+
check int "One email parsed" 1 (List.length parsed_list);
793
+
794
+
let (blob_id, email) = List.nth parsed_list 0 in
795
+
check string "Blob ID starts correctly" "Gb5f77k8"
796
+
(String.sub (Jmap_core.Jmap_id.to_string blob_id) 0 8);
797
+
798
+
(* Validate parsed email *)
799
+
check string "Subject" "Important Announcement"
800
+
(Option.get (Jmap_mail.Jmap_email.subject email));
801
+
check bool "Has no attachment" false (Jmap_mail.Jmap_email.has_attachment email);
802
+
803
+
(* Validate from *)
804
+
let from = Option.get (Jmap_mail.Jmap_email.from email) in
805
+
check int "One from address" 1 (List.length from);
806
+
let from_addr = List.nth from 0 in
807
+
check string "From name" "Charlie Green"
808
+
(Option.get (Jmap_mail.Jmap_email.EmailAddress.name from_addr));
809
+
check string "From email" "charlie@company.com"
810
+
(Jmap_mail.Jmap_email.EmailAddress.email from_addr);
66
811
67
-
let test_email_full () =
68
-
let _json = load_json "test/data/mail/email_get_full_response.json" in
69
-
(* TODO: Parse full Email with bodyStructure *)
70
-
check bool "Full email loaded" true true
812
+
(* Validate bodyStructure (simple text/plain) *)
813
+
let body_structure = Jmap_mail.Jmap_email.body_structure email in
814
+
check bool "Has bodyStructure" true (Option.is_some body_structure);
815
+
let body_part = Option.get body_structure in
816
+
check string "Body type" "text/plain" (Jmap_mail.Jmap_email.BodyPart.type_ body_part);
817
+
check string "Body part ID" "1"
818
+
(Option.get (Jmap_mail.Jmap_email.BodyPart.part_id body_part));
819
+
check int "Body size" 1523
820
+
(Jmap_core.Jmap_primitives.UnsignedInt.to_int (Jmap_mail.Jmap_email.BodyPart.size body_part));
821
+
822
+
(* Validate textBody *)
823
+
let text_body = Jmap_mail.Jmap_email.text_body email in
824
+
check bool "Has textBody" true (Option.is_some text_body);
825
+
let text_body_list = Option.get text_body in
826
+
check int "One textBody part" 1 (List.length text_body_list);
827
+
828
+
(* Validate htmlBody is empty *)
829
+
let html_body = Jmap_mail.Jmap_email.html_body email in
830
+
check bool "Has htmlBody" true (Option.is_some html_body);
831
+
let html_body_list = Option.get html_body in
832
+
check int "No htmlBody parts" 0 (List.length html_body_list);
833
+
834
+
(* Validate attachments is empty *)
835
+
let attachments = Jmap_mail.Jmap_email.attachments email in
836
+
check bool "Has attachments" true (Option.is_some attachments);
837
+
let attachments_list = Option.get attachments in
838
+
check int "No attachments" 0 (List.length attachments_list);
839
+
840
+
(* Validate bodyValues *)
841
+
let body_values = Jmap_mail.Jmap_email.body_values email in
842
+
check bool "Has bodyValues" true (Option.is_some body_values);
843
+
let values_list = Option.get body_values in
844
+
check int "One bodyValue" 1 (List.length values_list);
845
+
check bool "Has bodyValue for part 1" true (List.mem_assoc "1" values_list);
846
+
let body_value = List.assoc "1" values_list in
847
+
let content = Jmap_mail.Jmap_email.BodyValue.value body_value in
848
+
check bool "Content starts with 'Team'" true
849
+
(String.starts_with ~prefix:"Team" content);
850
+
851
+
(* Validate notParsable and notFound are empty *)
852
+
let not_parsable = Jmap_mail.Jmap_email.Parse.not_parsable response in
853
+
check bool "Has notParsable" true (Option.is_some not_parsable);
854
+
check int "No unparsable blobs" 0 (List.length (Option.get not_parsable));
855
+
856
+
let not_found = Jmap_mail.Jmap_email.Parse.not_found response in
857
+
check bool "Has notFound" true (Option.is_some not_found);
858
+
check int "No blobs not found" 0 (List.length (Option.get not_found))
71
859
72
860
(** Test suite definition *)
73
861
let () =
···
79
867
test_case "Get response" `Quick test_get_response;
80
868
test_case "Session object" `Quick test_session;
81
869
];
82
-
"Mail Protocol", [
870
+
"Mail Protocol - Mailbox", [
83
871
test_case "Mailbox/get request" `Quick test_mailbox_get_request;
84
872
test_case "Mailbox/get response" `Quick test_mailbox_get_response;
873
+
test_case "Mailbox/query request" `Quick test_mailbox_query_request;
874
+
test_case "Mailbox/query response" `Quick test_mailbox_query_response;
875
+
test_case "Mailbox/set request" `Quick test_mailbox_set_request;
876
+
test_case "Mailbox/set response" `Quick test_mailbox_set_response;
877
+
];
878
+
"Mail Protocol - Email", [
85
879
test_case "Email/get request" `Quick test_email_get_request;
880
+
test_case "Email/get full request" `Quick test_email_get_full_request;
86
881
test_case "Email/get response" `Quick test_email_get_response;
87
-
test_case "Email full body" `Quick test_email_full;
882
+
test_case "Email/get full response" `Quick test_email_get_full_response;
883
+
test_case "Email/query request" `Quick test_email_query_request;
884
+
test_case "Email/query response" `Quick test_email_query_response;
885
+
test_case "Email/set request" `Quick test_email_set_request;
886
+
test_case "Email/set response" `Quick test_email_set_response;
887
+
test_case "Email/import request" `Quick test_email_import_request;
888
+
test_case "Email/import response" `Quick test_email_import_response;
889
+
test_case "Email/parse request" `Quick test_email_parse_request;
890
+
test_case "Email/parse response" `Quick test_email_parse_response;
88
891
];
89
892
]