this repo has no description
vibe
+446
-1382
+73
-137
jmap/bin/fastmail_connect.ml
+73
-137
jmap/bin/fastmail_connect.ml
···
1
1
2
-
let read_api_key () =
3
-
try
4
-
let ic = open_in ".api-key" in
5
-
let line = input_line ic in
6
-
close_in ic;
7
-
String.trim line
8
-
with
9
-
| Sys_error _ -> failwith "Could not read .api-key file"
10
-
| End_of_file -> failwith ".api-key file is empty"
11
2
12
-
let print_session_info session =
13
-
let open Jmap.Protocol.Session.Session in
14
-
Printf.printf "JMAP Session Information:\n";
15
-
Printf.printf " Username: %s\n" (username session);
16
-
Printf.printf " API URL: %s\n" (Uri.to_string (api_url session));
17
-
Printf.printf " Download URL: %s\n" (Uri.to_string (download_url session));
18
-
Printf.printf " Upload URL: %s\n" (Uri.to_string (upload_url session));
19
-
Printf.printf " Event Source URL: %s\n" (Uri.to_string (event_source_url session));
20
-
Printf.printf " State: %s\n" (state session);
21
-
Printf.printf " Capabilities:\n";
22
-
let caps = capabilities session in
23
-
Hashtbl.iter (fun cap _ -> Printf.printf " - %s\n" cap) caps;
24
-
Printf.printf " Primary Accounts:\n";
25
-
let primary_accs = primary_accounts session in
26
-
Hashtbl.iter (fun cap account_id ->
27
-
Printf.printf " - %s -> %s\n" cap account_id
28
-
) primary_accs;
29
-
Printf.printf " Accounts:\n";
30
-
let accounts = accounts session in
31
-
Hashtbl.iter (fun account_id account ->
32
-
let open Jmap.Protocol.Session.Account in
33
-
Printf.printf " - %s: %s (%b)\n"
34
-
account_id
35
-
(name account)
36
-
(is_personal account)
37
-
) accounts;
38
-
print_endline ""
39
3
40
-
let format_email_summary email_json =
41
-
try
42
-
let open Yojson.Safe.Util in
43
-
let subject = email_json |> member "subject" |> to_string_option |> Option.value ~default:"(No Subject)" in
44
-
let from =
45
-
match email_json |> member "from" |> to_list with
46
-
| [] -> "(Unknown Sender)"
47
-
| from_addr :: _ ->
48
-
let name = from_addr |> member "name" |> to_string_option in
49
-
let email = from_addr |> member "email" |> to_string_option in
50
-
match (name, email) with
51
-
| (Some n, Some e) -> Printf.sprintf "%s <%s>" n e
52
-
| (None, Some e) -> e
53
-
| (Some n, None) -> n
54
-
| (None, None) -> "(Unknown Sender)"
55
-
in
56
-
let received_at =
57
-
match email_json |> member "receivedAt" |> to_string_option with
58
-
| Some date_str -> date_str
59
-
| None -> "(Unknown Date)"
60
-
in
61
-
Printf.sprintf "From: %s | Subject: %s | Received: %s" from subject received_at
62
-
with
63
-
| _ -> "Error parsing email"
4
+
let format_email_summary email =
5
+
let open Jmap_email.Types.Email in
6
+
let subject = match subject email with
7
+
| Some s -> s | None -> "(No Subject)" in
8
+
let from_str =
9
+
match from email with
10
+
| Some addresses when addresses <> [] ->
11
+
let addr = List.hd addresses in
12
+
let open Jmap_email.Types.Email_address in
13
+
let email_addr = email addr in
14
+
(match name addr with
15
+
| Some n -> Printf.sprintf "%s <%s>" n email_addr
16
+
| None -> email_addr)
17
+
| _ -> "(Unknown Sender)"
18
+
in
19
+
let received_at =
20
+
match received_at email with
21
+
| Some date -> Printf.sprintf "%.0f" date
22
+
| None -> "(Unknown Date)"
23
+
in
24
+
Printf.sprintf "From: %s | Subject: %s | Received: %s" from_str subject received_at
64
25
65
-
let get_primary_mail_account session =
66
-
let open Jmap.Protocol.Session.Session in
67
-
let primary_accs = primary_accounts session in
68
-
try
69
-
Hashtbl.find primary_accs "urn:ietf:params:jmap:mail"
70
-
with
71
-
| Not_found ->
72
-
(* Fallback: get first account *)
73
-
let accounts = accounts session in
74
-
match Hashtbl.to_seq_keys accounts |> Seq.uncons with
75
-
| Some (account_id, _) -> account_id
76
-
| None -> failwith "No accounts found"
77
26
78
27
let fetch_recent_emails env ctx session =
79
28
try
80
-
let account_id = get_primary_mail_account session in
29
+
let account_id = Jmap_unix.Session_utils.get_primary_mail_account session in
81
30
Printf.printf "Using account: %s\n" account_id;
82
31
83
-
(* Build Email/query request *)
84
-
let query_args = `Assoc [
85
-
("accountId", `String account_id);
86
-
("filter", `Assoc []); (* Empty filter to search all emails *)
87
-
("sort", `List [
88
-
`Assoc [
89
-
("property", `String "receivedAt");
90
-
("isAscending", `Bool false)
91
-
]
92
-
]);
93
-
("position", `Int 0);
94
-
("limit", `Int 10);
95
-
] in
32
+
(* Build Email/query request using new Query_args *)
33
+
let sort_comparator = Jmap.Methods.Comparator.v
34
+
~property:"receivedAt"
35
+
~is_ascending:false
36
+
() in
37
+
let query_args = Jmap_unix.Email.Query_args.create
38
+
~account_id
39
+
~sort:[sort_comparator]
40
+
~position:0
41
+
~limit:10
42
+
() in
43
+
44
+
(* Build Email/get request using new Get_args with result reference *)
45
+
let get_args = Jmap_unix.Email.Get_args.create_with_reference
46
+
~account_id
47
+
~result_of:"query1"
48
+
~name:"Email/query"
49
+
~path:"/ids"
50
+
~properties:["id"; "subject"; "from"; "receivedAt"; "keywords"]
51
+
() in
96
52
97
-
let method_call_1 = Jmap.Protocol.Wire.Invocation.v
53
+
(* Build the full request using Request_builder *)
54
+
let builder = Jmap_unix.Request_builder.create
55
+
~using:["urn:ietf:params:jmap:core"; "urn:ietf:params:jmap:mail"]
56
+
ctx in
57
+
let builder = Jmap_unix.Request_builder.add_query builder
98
58
~method_name:"Email/query"
99
-
~arguments:query_args
100
-
~method_call_id:"query1"
101
-
()
102
-
in
103
-
104
-
(* Build Email/get request using result reference *)
105
-
let get_args = `Assoc [
106
-
("accountId", `String account_id);
107
-
("#ids", `Assoc [
108
-
("resultOf", `String "query1");
109
-
("name", `String "Email/query");
110
-
("path", `String "/ids")
111
-
]);
112
-
("properties", `List [
113
-
`String "id";
114
-
`String "subject";
115
-
`String "from";
116
-
`String "receivedAt";
117
-
`String "keywords"
118
-
])
119
-
] in
120
-
121
-
let method_call_2 = Jmap.Protocol.Wire.Invocation.v
59
+
~args:(Jmap_unix.Email.Query_args.to_json query_args)
60
+
~method_call_id:"query1" in
61
+
let builder = Jmap_unix.Request_builder.add_get builder
122
62
~method_name:"Email/get"
123
-
~arguments:get_args
124
-
~method_call_id:"get1"
125
-
()
126
-
in
127
-
128
-
(* Build the full request *)
129
-
let request = Jmap.Protocol.Wire.Request.v
130
-
~using:["urn:ietf:params:jmap:core"; "urn:ietf:params:jmap:mail"]
131
-
~method_calls:[method_call_1; method_call_2]
132
-
()
133
-
in
63
+
~args:(Jmap_unix.Email.Get_args.to_json get_args)
64
+
~method_call_id:"get1" in
65
+
let request = Jmap_unix.Request_builder.to_request builder in
134
66
135
67
match Jmap_unix.request env ctx request with
136
68
| Ok response ->
137
-
(* Extract emails from the Email/get response *)
138
-
let method_responses = Jmap.Protocol.Wire.Response.method_responses response in
139
-
let get_response = List.find_map (function
140
-
| Ok invocation ->
141
-
let open Jmap.Protocol.Wire.Invocation in
142
-
if method_call_id invocation = "get1" && method_name invocation = "Email/get" then
143
-
Some (arguments invocation)
144
-
else None
145
-
| Error _ -> None
146
-
) method_responses in
147
-
(match get_response with
148
-
| Some response_args ->
69
+
(* Extract emails using new Response helper *)
70
+
(match Jmap_unix.Response.extract_method ~method_name:"Email/get" ~method_call_id:"get1" response with
71
+
| Ok response_args ->
149
72
let open Yojson.Safe.Util in
150
-
let emails = response_args |> member "list" |> to_list in
73
+
let email_jsons = response_args |> member "list" |> to_list in
74
+
(* Parse emails using new Email.from_json *)
75
+
let parse_email json =
76
+
try
77
+
let email = Jmap_unix.Email.from_json json in
78
+
Printf.eprintf "DEBUG: Successfully parsed email: %s\n" (Yojson.Safe.to_string json);
79
+
Some email
80
+
with
81
+
| exn ->
82
+
Printf.eprintf "DEBUG: Failed to parse email: %s\nJSON: %s\n"
83
+
(Printexc.to_string exn) (Yojson.Safe.to_string json);
84
+
None
85
+
in
86
+
let emails = List.filter_map parse_email email_jsons in
151
87
Ok emails
152
-
| None -> Error (Jmap.Protocol.Error.protocol_error "Email/get response not found"))
88
+
| Error e -> Error e)
153
89
| Error e -> Error e
154
90
with
155
91
| exn -> Error (Jmap.Protocol.Error.protocol_error ("Exception: " ^ Printexc.to_string exn))
···
160
96
161
97
Eio_main.run @@ fun env ->
162
98
try
163
-
let api_key = read_api_key () in
99
+
let api_key = Jmap_unix.Auth.read_api_key_default () in
164
100
Printf.printf "Connecting to Fastmail JMAP API...\n";
165
101
166
102
let client = Jmap_unix.create_client () in
···
176
112
() with
177
113
| Ok (ctx, session) ->
178
114
Printf.printf "Successfully connected to Fastmail!\n\n";
179
-
print_session_info session;
115
+
Jmap_unix.Session_utils.print_session_info session;
180
116
181
117
Printf.printf "Fetching recent emails...\n";
182
118
(match fetch_recent_emails env ctx session with
+23
jmap/jmap-email/jmap_email_types.ml
+23
jmap/jmap-email/jmap_email_types.ml
···
628
628
in
629
629
let received_at = match List.assoc_opt "receivedAt" fields with
630
630
| Some (`Float date) -> Some date
631
+
| Some (`String date_str) ->
632
+
(* Parse ISO 8601 date string to Unix timestamp *)
633
+
(try
634
+
(* Simple ISO 8601 parser for "YYYY-MM-DDTHH:MM:SSZ" format *)
635
+
let parse_iso8601 s =
636
+
if String.length s >= 19 && s.[10] = 'T' then
637
+
let year = int_of_string (String.sub s 0 4) in
638
+
let month = int_of_string (String.sub s 5 2) in
639
+
let day = int_of_string (String.sub s 8 2) in
640
+
let hour = int_of_string (String.sub s 11 2) in
641
+
let minute = int_of_string (String.sub s 14 2) in
642
+
let second = int_of_string (String.sub s 17 2) in
643
+
(* Convert to Unix timestamp - approximate conversion *)
644
+
let days_since_epoch =
645
+
(year - 1970) * 365 + (year - 1969) / 4 - (year - 1901) / 100 + (year - 1601) / 400 +
646
+
[|0; 31; 59; 90; 120; 151; 181; 212; 243; 273; 304; 334|].(month - 1) + day - 1 in
647
+
let seconds_in_day = hour * 3600 + minute * 60 + second in
648
+
float_of_int (days_since_epoch * 86400 + seconds_in_day)
649
+
else
650
+
failwith "Invalid ISO 8601 format"
651
+
in
652
+
Some (parse_iso8601 date_str)
653
+
with _ -> failwith "Email.of_json: invalid receivedAt date format")
631
654
| Some `Null | None -> None
632
655
| _ -> failwith "Email.of_json: invalid receivedAt field"
633
656
in
+188
jmap/jmap-unix/jmap_unix.ml
+188
jmap/jmap-unix/jmap_unix.ml
···
508
508
module Email = struct
509
509
open Jmap_email.Types
510
510
511
+
module Query_args = struct
512
+
type t = {
513
+
account_id : Jmap.Types.id;
514
+
filter : Jmap.Methods.Filter.t option;
515
+
sort : Jmap.Methods.Comparator.t list option;
516
+
position : int option;
517
+
limit : Jmap.Types.uint option;
518
+
calculate_total : bool option;
519
+
collapse_threads : bool option;
520
+
}
521
+
522
+
let create ~account_id ?filter ?sort ?position ?limit ?calculate_total ?collapse_threads () =
523
+
{ account_id; filter; sort; position; limit; calculate_total; collapse_threads }
524
+
525
+
let to_json t =
526
+
let fields = [
527
+
("accountId", `String t.account_id);
528
+
] in
529
+
let fields = match t.filter with
530
+
| Some f -> ("filter", Jmap.Methods.Filter.to_json f) :: fields
531
+
| None -> ("filter", `Assoc []) :: fields
532
+
in
533
+
let fields = match t.sort with
534
+
| Some sort_list ->
535
+
let sort_json = `List (List.map Jmap.Methods.Comparator.to_json sort_list) in
536
+
("sort", sort_json) :: fields
537
+
| None -> fields
538
+
in
539
+
let fields = match t.position with
540
+
| Some pos -> ("position", `Int pos) :: fields
541
+
| None -> fields
542
+
in
543
+
let fields = match t.limit with
544
+
| Some lim -> ("limit", `Int lim) :: fields
545
+
| None -> fields
546
+
in
547
+
let fields = match t.calculate_total with
548
+
| Some ct -> ("calculateTotal", `Bool ct) :: fields
549
+
| None -> fields
550
+
in
551
+
let fields = match t.collapse_threads with
552
+
| Some ct -> ("collapseThreads", `Bool ct) :: fields
553
+
| None -> fields
554
+
in
555
+
`Assoc (List.rev fields)
556
+
end
557
+
558
+
module Get_args = struct
559
+
type ids_source =
560
+
| Specific_ids of Jmap.Types.id list
561
+
| Result_reference of {
562
+
result_of : string;
563
+
name : string;
564
+
path : string;
565
+
}
566
+
567
+
type t = {
568
+
account_id : Jmap.Types.id;
569
+
ids_source : ids_source;
570
+
properties : string list option;
571
+
}
572
+
573
+
let create ~account_id ~ids ?properties () =
574
+
{ account_id; ids_source = Specific_ids ids; properties }
575
+
576
+
let create_with_reference ~account_id ~result_of ~name ~path ?properties () =
577
+
{ account_id; ids_source = Result_reference { result_of; name; path }; properties }
578
+
579
+
let to_json t =
580
+
let fields = [
581
+
("accountId", `String t.account_id);
582
+
] in
583
+
let fields = match t.ids_source with
584
+
| Specific_ids ids ->
585
+
("ids", `List (List.map (fun id -> `String id) ids)) :: fields
586
+
| Result_reference { result_of; name; path } ->
587
+
("#ids", `Assoc [
588
+
("resultOf", `String result_of);
589
+
("name", `String name);
590
+
("path", `String path);
591
+
]) :: fields
592
+
in
593
+
let fields = match t.properties with
594
+
| Some props ->
595
+
("properties", `List (List.map (fun p -> `String p) props)) :: fields
596
+
| None -> fields
597
+
in
598
+
`Assoc (List.rev fields)
599
+
end
600
+
511
601
let get_email env ctx ~account_id ~email_id ?properties () =
512
602
let args = `Assoc [
513
603
("accountId", `String account_id);
···
646
736
match execute env builder with
647
737
| Ok _ -> Ok ("email-" ^ account_id ^ "-" ^ string_of_int (Random.int 1000000))
648
738
| Error e -> Error e
739
+
740
+
(** {2 JSON Parsing Functions} *)
741
+
742
+
let from_json json =
743
+
Email.of_json json
744
+
745
+
let from_json_address json =
746
+
Email_address.of_json json
747
+
748
+
let from_json_keywords json =
749
+
Keywords.of_json json
750
+
end
751
+
752
+
module Auth = struct
753
+
let read_api_key filename =
754
+
try
755
+
let ic = open_in filename in
756
+
let line = input_line ic in
757
+
close_in ic;
758
+
String.trim line
759
+
with
760
+
| Sys_error _ -> failwith ("Could not read " ^ filename ^ " file")
761
+
| End_of_file -> failwith (filename ^ " file is empty")
762
+
763
+
let read_api_key_default () = read_api_key ".api-key"
764
+
end
765
+
766
+
module Session_utils = struct
767
+
let print_session_info session =
768
+
let open Jmap.Protocol.Session.Session in
769
+
Printf.printf "JMAP Session Information:\n";
770
+
Printf.printf " Username: %s\n" (username session);
771
+
Printf.printf " API URL: %s\n" (Uri.to_string (api_url session));
772
+
Printf.printf " Download URL: %s\n" (Uri.to_string (download_url session));
773
+
Printf.printf " Upload URL: %s\n" (Uri.to_string (upload_url session));
774
+
Printf.printf " Event Source URL: %s\n" (Uri.to_string (event_source_url session));
775
+
Printf.printf " State: %s\n" (state session);
776
+
Printf.printf " Capabilities:\n";
777
+
let caps = capabilities session in
778
+
Hashtbl.iter (fun cap _ -> Printf.printf " - %s\n" cap) caps;
779
+
Printf.printf " Primary Accounts:\n";
780
+
let primary_accs = primary_accounts session in
781
+
Hashtbl.iter (fun cap account_id ->
782
+
Printf.printf " - %s -> %s\n" cap account_id
783
+
) primary_accs;
784
+
Printf.printf " Accounts:\n";
785
+
let accounts = accounts session in
786
+
Hashtbl.iter (fun account_id account ->
787
+
let open Jmap.Protocol.Session.Account in
788
+
Printf.printf " - %s: %s (%b)\n"
789
+
account_id
790
+
(name account)
791
+
(is_personal account)
792
+
) accounts;
793
+
print_endline ""
794
+
795
+
let get_primary_mail_account session =
796
+
let open Jmap.Protocol.Session.Session in
797
+
let primary_accs = primary_accounts session in
798
+
try
799
+
Hashtbl.find primary_accs "urn:ietf:params:jmap:mail"
800
+
with
801
+
| Not_found ->
802
+
let accounts = accounts session in
803
+
match Hashtbl.to_seq_keys accounts |> Seq.uncons with
804
+
| Some (account_id, _) -> account_id
805
+
| None -> failwith "No accounts found"
806
+
end
807
+
808
+
module Response = struct
809
+
let extract_method ~method_name ~method_call_id response =
810
+
let method_responses = Jmap.Protocol.Wire.Response.method_responses response in
811
+
let find_response = List.find_map (function
812
+
| Ok invocation ->
813
+
if Jmap.Protocol.Wire.Invocation.method_call_id invocation = method_call_id &&
814
+
Jmap.Protocol.Wire.Invocation.method_name invocation = method_name then
815
+
Some (Jmap.Protocol.Wire.Invocation.arguments invocation)
816
+
else None
817
+
| Error _ -> None
818
+
) method_responses in
819
+
match find_response with
820
+
| Some response_args -> Ok response_args
821
+
| None -> Error (Jmap.Protocol.Error.protocol_error
822
+
(Printf.sprintf "%s response (call_id: %s) not found" method_name method_call_id))
823
+
824
+
let extract_method_by_name ~method_name response =
825
+
let method_responses = Jmap.Protocol.Wire.Response.method_responses response in
826
+
let find_response = List.find_map (function
827
+
| Ok invocation ->
828
+
if Jmap.Protocol.Wire.Invocation.method_name invocation = method_name then
829
+
Some (Jmap.Protocol.Wire.Invocation.arguments invocation)
830
+
else None
831
+
| Error _ -> None
832
+
) method_responses in
833
+
match find_response with
834
+
| Some response_args -> Ok response_args
835
+
| None -> Error (Jmap.Protocol.Error.protocol_error
836
+
(Printf.sprintf "%s response not found" method_name))
649
837
end
+162
jmap/jmap-unix/jmap_unix.mli
+162
jmap/jmap-unix/jmap_unix.mli
···
352
352
module Email : sig
353
353
open Jmap_email.Types
354
354
355
+
(** Arguments for Email/query method calls.
356
+
357
+
This type eliminates manual JSON construction for Email/query requests.
358
+
It follows the JMAP Email/query specification exactly.
359
+
360
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.4> RFC 8621, Section 4.4 *)
361
+
module Query_args : sig
362
+
type t
363
+
364
+
(** Create Email/query arguments.
365
+
@param account_id The account ID to query in
366
+
@param ?filter Optional filter to apply (None = no filter)
367
+
@param ?sort Optional sort order (None = server default)
368
+
@param ?position Starting position in results (None = start from beginning)
369
+
@param ?limit Maximum number of results (None = server default)
370
+
@param ?calculate_total Whether to calculate total result count (None = false)
371
+
@param ?collapse_threads Whether to collapse threads (None = false)
372
+
@return Email query arguments object *)
373
+
val create :
374
+
account_id:Jmap.Types.id ->
375
+
?filter:Jmap.Methods.Filter.t ->
376
+
?sort:Jmap.Methods.Comparator.t list ->
377
+
?position:int ->
378
+
?limit:Jmap.Types.uint ->
379
+
?calculate_total:bool ->
380
+
?collapse_threads:bool ->
381
+
unit ->
382
+
t
383
+
384
+
(** Convert query arguments to JSON for JMAP requests.
385
+
@param t The query arguments to serialize
386
+
@return JSON representation suitable for Email/query method calls *)
387
+
val to_json : t -> Yojson.Safe.t
388
+
end
389
+
390
+
(** Arguments for Email/get method calls.
391
+
392
+
This type eliminates manual JSON construction for Email/get requests
393
+
and properly handles result references from previous method calls.
394
+
395
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.2> RFC 8621, Section 4.2 *)
396
+
module Get_args : sig
397
+
type t
398
+
399
+
(** Create Email/get arguments with specific IDs.
400
+
@param account_id The account ID to get emails from
401
+
@param ids List of email IDs to fetch
402
+
@param ?properties Optional list of properties to return (None = all properties)
403
+
@return Email get arguments object *)
404
+
val create :
405
+
account_id:Jmap.Types.id ->
406
+
ids:Jmap.Types.id list ->
407
+
?properties:string list ->
408
+
unit ->
409
+
t
410
+
411
+
(** Create Email/get arguments with result reference to another method.
412
+
This is used when the IDs come from a previous method call result.
413
+
@param account_id The account ID to get emails from
414
+
@param result_of Method call ID that produced the IDs
415
+
@param name Method name that produced the IDs (e.g., "Email/query")
416
+
@param path JSON pointer to the IDs in the result (e.g., "/ids")
417
+
@param ?properties Optional list of properties to return (None = all properties)
418
+
@return Email get arguments object *)
419
+
val create_with_reference :
420
+
account_id:Jmap.Types.id ->
421
+
result_of:string ->
422
+
name:string ->
423
+
path:string ->
424
+
?properties:string list ->
425
+
unit ->
426
+
t
427
+
428
+
(** Convert get arguments to JSON for JMAP requests.
429
+
@param t The get arguments to serialize
430
+
@return JSON representation suitable for Email/get method calls *)
431
+
val to_json : t -> Yojson.Safe.t
432
+
end
433
+
355
434
(** Get an email by ID
356
435
@param env The Eio environment for network operations
357
436
@param ctx The JMAP client context
···
477
556
?received_at:Jmap.Types.date ->
478
557
unit ->
479
558
Jmap.Types.id Jmap.Protocol.Error.result
559
+
560
+
(** {2 JSON Parsing Functions} *)
561
+
562
+
(** Parse an Email object from JSON representation.
563
+
564
+
This function eliminates the need for manual JSON parsing with Yojson.Safe.Util.
565
+
It properly handles all standard Email fields from RFC 8621 and provides
566
+
descriptive error messages for malformed JSON.
567
+
568
+
@param json JSON object representing an email as returned by Email/get
569
+
@return Parsed Email object
570
+
@raise Failure if JSON structure is invalid
571
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1> RFC 8621, Section 4.1 *)
572
+
val from_json : Yojson.Safe.t -> Email.t
573
+
574
+
(** Parse an EmailAddress object from JSON representation.
575
+
576
+
@param json JSON object with 'email' and optional 'name' fields
577
+
@return Parsed EmailAddress object
578
+
@raise Failure if JSON structure is invalid
579
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1.2.3> RFC 8621, Section 4.1.2.3 *)
580
+
val from_json_address : Yojson.Safe.t -> Email_address.t
581
+
582
+
(** Parse Keywords from JSON representation.
583
+
584
+
@param json JSON object mapping keyword strings to boolean values
585
+
@return Parsed Keywords set
586
+
@raise Failure if JSON structure is invalid
587
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1.1> RFC 8621, Section 4.1.1 *)
588
+
val from_json_keywords : Yojson.Safe.t -> Keywords.t
589
+
end
590
+
591
+
(** {2 Utility Functions} *)
592
+
593
+
(** Authentication utilities for handling credential files and tokens *)
594
+
module Auth : sig
595
+
(** Read an API key from a file.
596
+
@param filename Path to the file containing the API key
597
+
@return The API key as a string, with whitespace trimmed
598
+
@raise Failure if the file cannot be read or is empty *)
599
+
val read_api_key : string -> string
600
+
601
+
(** Read an API key from the default ".api-key" file in the current directory.
602
+
@return The API key as a string, with whitespace trimmed
603
+
@raise Failure if the file cannot be read or is empty *)
604
+
val read_api_key_default : unit -> string
605
+
end
606
+
607
+
(** Session utilities for common session operations *)
608
+
module Session_utils : sig
609
+
(** Print detailed session information to stdout for debugging.
610
+
@param session The JMAP session to display *)
611
+
val print_session_info : Jmap.Protocol.Session.Session.t -> unit
612
+
613
+
(** Get the primary mail account ID from a session.
614
+
Falls back to the first available account if no primary mail account is found.
615
+
@param session The JMAP session
616
+
@return The account ID to use for mail operations
617
+
@raise Failure if no accounts are found *)
618
+
val get_primary_mail_account : Jmap.Protocol.Session.Session.t -> Jmap.Types.id
619
+
end
620
+
621
+
(** Response utilities for extracting data from JMAP responses *)
622
+
module Response : sig
623
+
(** Extract a specific method response from a JMAP Response.
624
+
@param method_name The method name to search for (e.g., "Email/get")
625
+
@param method_call_id The method call ID to match
626
+
@param response The JMAP response to search
627
+
@return The method response arguments or an error *)
628
+
val extract_method :
629
+
method_name:string ->
630
+
method_call_id:string ->
631
+
Jmap.Protocol.Wire.Response.t ->
632
+
Yojson.Safe.t Jmap.Protocol.Error.result
633
+
634
+
(** Extract the first method response with a given name, ignoring call ID.
635
+
@param method_name The method name to search for
636
+
@param response The JMAP response to search
637
+
@return The method response arguments or an error *)
638
+
val extract_method_by_name :
639
+
method_name:string ->
640
+
Jmap.Protocol.Wire.Response.t ->
641
+
Yojson.Safe.t Jmap.Protocol.Error.result
480
642
end
-8
jmap/jmap/jmap_session.ml
-8
jmap/jmap/jmap_session.ml
···
251
251
module HTTP_Client = struct
252
252
type http_error =
253
253
| Connection_failed of string
254
-
| Timeout of string
255
-
| Http_status_error of int * string
256
-
| Invalid_response of string
257
-
| Auth_failed of string
258
254
259
255
let http_error_to_string = function
260
256
| Connection_failed msg -> "Connection failed: " ^ msg
261
-
| Timeout msg -> "Request timeout: " ^ msg
262
-
| Http_status_error (code, msg) -> Printf.sprintf "HTTP %d: %s" code msg
263
-
| Invalid_response msg -> "Invalid response: " ^ msg
264
-
| Auth_failed msg -> "Authentication failed: " ^ msg
265
257
266
258
let auth_headers = function
267
259
| Bearer_token token -> [("Authorization", "Bearer " ^ token)]
-157
jmap/test/comprehensive_json_test.ml
-157
jmap/test/comprehensive_json_test.ml
···
1
-
(* Comprehensive JSON deserialization tests for all response types *)
2
-
3
-
let simple_record_from_json json =
4
-
let open Yojson.Safe.Util in
5
-
json |> member "id" |> to_string
6
-
7
-
let simple_created_info_from_json json =
8
-
let open Yojson.Safe.Util in
9
-
json |> member "serverSetId" |> to_string
10
-
11
-
let simple_updated_info_from_json json =
12
-
let open Yojson.Safe.Util in
13
-
json |> member "serverSetProperty" |> to_string
14
-
15
-
let test_get_response () =
16
-
let json_str = {|
17
-
{
18
-
"accountId": "test123",
19
-
"state": "state789",
20
-
"list": [
21
-
{"id": "email1", "subject": "Hello"},
22
-
{"id": "email2", "subject": "World"}
23
-
],
24
-
"notFound": ["missing1", "missing2"]
25
-
}
26
-
|} in
27
-
let json = Yojson.Safe.from_string json_str in
28
-
match Jmap.Methods.Get_response.of_json ~from_json:simple_record_from_json json with
29
-
| Ok response ->
30
-
Printf.printf "✓ Get_response: account_id=%s, state=%s, found=%d, not_found=%d\n"
31
-
(Jmap.Methods.Get_response.account_id response)
32
-
(Jmap.Methods.Get_response.state response)
33
-
(List.length (Jmap.Methods.Get_response.list response))
34
-
(List.length (Jmap.Methods.Get_response.not_found response));
35
-
true
36
-
| Error err ->
37
-
Printf.printf "✗ Get_response error: %s\n" (Jmap.Protocol.Error.error_to_string err);
38
-
false
39
-
40
-
let test_set_response () =
41
-
let json_str = {|
42
-
{
43
-
"accountId": "test123",
44
-
"oldState": "old456",
45
-
"newState": "new789",
46
-
"created": {
47
-
"tempId1": {"serverSetId": "real1"},
48
-
"tempId2": {"serverSetId": "real2"}
49
-
},
50
-
"updated": {
51
-
"id1": {"serverSetProperty": "updated"},
52
-
"id2": null
53
-
},
54
-
"destroyed": ["deleted1", "deleted2"],
55
-
"notCreated": {
56
-
"tempId3": {"type": "invalidProperties"}
57
-
},
58
-
"notUpdated": {},
59
-
"notDestroyed": {}
60
-
}
61
-
|} in
62
-
let json = Yojson.Safe.from_string json_str in
63
-
match Jmap.Methods.Set_response.of_json
64
-
~from_created_json:simple_created_info_from_json
65
-
~from_updated_json:simple_updated_info_from_json
66
-
json with
67
-
| Ok response ->
68
-
let created_count = match Jmap.Methods.Set_response.created response with
69
-
| Some map -> Hashtbl.length map
70
-
| None -> 0
71
-
in
72
-
let destroyed_count = match Jmap.Methods.Set_response.destroyed response with
73
-
| Some list -> List.length list
74
-
| None -> 0
75
-
in
76
-
Printf.printf "✓ Set_response: account_id=%s, created=%d, destroyed=%d\n"
77
-
(Jmap.Methods.Set_response.account_id response)
78
-
created_count
79
-
destroyed_count;
80
-
true
81
-
| Error err ->
82
-
Printf.printf "✗ Set_response error: %s\n" (Jmap.Protocol.Error.error_to_string err);
83
-
false
84
-
85
-
let test_realistic_jmap_response () =
86
-
(* This is a realistic JMAP response structure based on RFC examples *)
87
-
let json_str = {|
88
-
{
89
-
"accountId": "u12345",
90
-
"queryState": "ef2317fa-0de6-4508-bc4b-dc28a6ca0a12",
91
-
"canCalculateChanges": true,
92
-
"position": 0,
93
-
"ids": [
94
-
"M6745sd4-1a2b-4f7d-8901-123456789abc",
95
-
"M8901abc-3c4d-4e5f-6789-012345678901"
96
-
],
97
-
"total": 47,
98
-
"limit": 20
99
-
}
100
-
|} in
101
-
let json = Yojson.Safe.from_string json_str in
102
-
match Jmap.Methods.Query_response.of_json json with
103
-
| Ok response ->
104
-
Printf.printf "✓ Realistic Query: total=%s, ids=%d, can_calculate_changes=%b\n"
105
-
(match Jmap.Methods.Query_response.total response with
106
-
| Some t -> string_of_int t
107
-
| None -> "None")
108
-
(List.length (Jmap.Methods.Query_response.ids response))
109
-
(Jmap.Methods.Query_response.can_calculate_changes response);
110
-
true
111
-
| Error err ->
112
-
Printf.printf "✗ Realistic Query error: %s\n" (Jmap.Protocol.Error.error_to_string err);
113
-
false
114
-
115
-
let test_changes_response_with_updates () =
116
-
let json_str = {|
117
-
{
118
-
"accountId": "u12345",
119
-
"oldState": "77",
120
-
"newState": "78",
121
-
"hasMoreChanges": false,
122
-
"created": ["M6745sd4"],
123
-
"updated": ["M8901abc", "M5432def"],
124
-
"destroyed": [],
125
-
"updatedProperties": ["keywords", "mailboxIds"]
126
-
}
127
-
|} in
128
-
let json = Yojson.Safe.from_string json_str in
129
-
match Jmap.Methods.Changes_response.of_json json with
130
-
| Ok response ->
131
-
Printf.printf "✓ Changes with updates: created=%d, updated=%d, properties=%s\n"
132
-
(List.length (Jmap.Methods.Changes_response.created response))
133
-
(List.length (Jmap.Methods.Changes_response.updated response))
134
-
(match Jmap.Methods.Changes_response.updated_properties response with
135
-
| Some props -> String.concat "," props
136
-
| None -> "None");
137
-
true
138
-
| Error err ->
139
-
Printf.printf "✗ Changes error: %s\n" (Jmap.Protocol.Error.error_to_string err);
140
-
false
141
-
142
-
let () =
143
-
Printf.printf "=== Comprehensive JSON Deserialization Tests ===\n";
144
-
let results = [
145
-
("Get Response", test_get_response ());
146
-
("Set Response", test_set_response ());
147
-
("Realistic Query", test_realistic_jmap_response ());
148
-
("Changes with Updates", test_changes_response_with_updates ());
149
-
] in
150
-
151
-
Printf.printf "\n=== Test Results ===\n";
152
-
List.iter (fun (name, result) ->
153
-
Printf.printf "%s: %s\n" name (if result then "PASS" else "FAIL")
154
-
) results;
155
-
156
-
let all_passed = List.for_all snd results in
157
-
Printf.printf "\nOverall: %s\n" (if all_passed then "ALL TESTS PASSED" else "SOME TESTS FAILED")
-56
jmap/test/dune
-56
jmap/test/dune
···
1
-
(executable
2
-
(name test_json_methods)
3
-
(modules test_json_methods)
4
-
(libraries jmap jmap-email))
5
-
6
-
(executable
7
-
(name test_json_validation)
8
-
(modules test_json_validation)
9
-
(libraries jmap))
10
-
11
-
(library
12
-
(name test_json_deserialization)
13
-
(modules test_json_deserialization)
14
-
(libraries jmap)
15
-
(preprocess (pps ppx_expect))
16
-
(package jmap)
17
-
(inline_tests))
18
-
19
-
(executable
20
-
(name simple_json_test)
21
-
(modules simple_json_test)
22
-
(libraries jmap))
23
-
24
-
(executable
25
-
(name comprehensive_json_test)
26
-
(modules comprehensive_json_test)
27
-
(libraries jmap))
28
-
29
-
(library
30
-
(name test_thread_methods)
31
-
(modules test_thread_methods)
32
-
(libraries jmap jmap-email)
33
-
(preprocess (pps ppx_expect))
34
-
(package jmap)
35
-
(inline_tests))
36
-
37
-
(library
38
-
(name test_identity_methods)
39
-
(modules test_identity_methods)
40
-
(libraries jmap jmap-email)
41
-
(preprocess (pps ppx_expect))
42
-
(package jmap)
43
-
(inline_tests))
44
-
45
-
(library
46
-
(name test_vacation_methods)
47
-
(modules test_vacation_methods)
48
-
(libraries jmap jmap-email)
49
-
(preprocess (pps ppx_expect))
50
-
(package jmap)
51
-
(inline_tests))
52
-
53
-
(executable
54
-
(name test_todo_implementations)
55
-
(modules test_todo_implementations)
56
-
(libraries jmap jmap-email jmap-unix yojson uri))
-56
jmap/test/simple_json_test.ml
-56
jmap/test/simple_json_test.ml
···
1
-
(* Simple test to verify JSON deserialization works *)
2
-
3
-
let test_query_response_basic () =
4
-
let json_str = {|
5
-
{
6
-
"accountId": "test123",
7
-
"queryState": "state456",
8
-
"canCalculateChanges": true,
9
-
"position": 0,
10
-
"ids": ["id1", "id2"]
11
-
}
12
-
|} in
13
-
let json = Yojson.Safe.from_string json_str in
14
-
match Jmap.Methods.Query_response.of_json json with
15
-
| Ok response ->
16
-
Printf.printf "SUCCESS: Query_response parsed\n";
17
-
Printf.printf " Account ID: %s\n" (Jmap.Methods.Query_response.account_id response);
18
-
Printf.printf " Query State: %s\n" (Jmap.Methods.Query_response.query_state response);
19
-
Printf.printf " IDs: %s\n" (String.concat ", " (Jmap.Methods.Query_response.ids response));
20
-
true
21
-
| Error err ->
22
-
Printf.printf "ERROR: %s\n" (Jmap.Protocol.Error.error_to_string err);
23
-
false
24
-
25
-
let test_changes_response_basic () =
26
-
let json_str = {|
27
-
{
28
-
"accountId": "test123",
29
-
"oldState": "old456",
30
-
"newState": "new789",
31
-
"hasMoreChanges": false,
32
-
"created": ["new1"],
33
-
"updated": ["mod1"],
34
-
"destroyed": ["del1"]
35
-
}
36
-
|} in
37
-
let json = Yojson.Safe.from_string json_str in
38
-
match Jmap.Methods.Changes_response.of_json json with
39
-
| Ok response ->
40
-
Printf.printf "SUCCESS: Changes_response parsed\n";
41
-
Printf.printf " Account ID: %s\n" (Jmap.Methods.Changes_response.account_id response);
42
-
Printf.printf " Old State: %s\n" (Jmap.Methods.Changes_response.old_state response);
43
-
Printf.printf " New State: %s\n" (Jmap.Methods.Changes_response.new_state response);
44
-
true
45
-
| Error err ->
46
-
Printf.printf "ERROR: %s\n" (Jmap.Protocol.Error.error_to_string err);
47
-
false
48
-
49
-
let () =
50
-
Printf.printf "=== JSON Deserialization Tests ===\n";
51
-
let query_ok = test_query_response_basic () in
52
-
let changes_ok = test_changes_response_basic () in
53
-
Printf.printf "\n=== Results ===\n";
54
-
Printf.printf "Query Response: %s\n" (if query_ok then "PASS" else "FAIL");
55
-
Printf.printf "Changes Response: %s\n" (if changes_ok then "PASS" else "FAIL");
56
-
Printf.printf "Overall: %s\n" (if query_ok && changes_ok then "PASS" else "FAIL")
-44
jmap/test/test_identity_methods.ml
-44
jmap/test/test_identity_methods.ml
···
1
-
(* Test Identity method argument building and JSON serialization *)
2
-
3
-
let%expect_test "identity get args to_json" =
4
-
let open Jmap_email.Identity in
5
-
let get_args = Get_args.v
6
-
~account_id:"account-789"
7
-
~ids:["identity-primary"; "identity-work"]
8
-
~properties:["id"; "name"; "email"; "textSignature"]
9
-
() in
10
-
let json = Get_args.to_json get_args in
11
-
Yojson.Safe.pretty_print Format.std_formatter json;
12
-
[%expect {|
13
-
{
14
-
"accountId": "account-789",
15
-
"ids": [ "identity-primary", "identity-work" ],
16
-
"properties": [ "id", "name", "email", "textSignature" ]
17
-
} |}]
18
-
19
-
let%expect_test "identity get args minimal" =
20
-
let open Jmap_email.Identity in
21
-
let get_args = Get_args.v ~account_id:"account-minimal" () in
22
-
let json = Get_args.to_json get_args in
23
-
Yojson.Safe.pretty_print Format.std_formatter json;
24
-
[%expect {| { "accountId": "account-minimal" } |}]
25
-
26
-
let%expect_test "identity create object" =
27
-
let open Jmap_email.Identity in
28
-
let identity_create = Create.v
29
-
~name:"Work Identity"
30
-
~email:"work@company.com"
31
-
~text_signature:"Best regards,\nJohn Smith\nSenior Developer"
32
-
~html_signature:"<p>Best regards,<br>John Smith<br><i>Senior Developer</i></p>"
33
-
() in
34
-
35
-
(* Test accessors *)
36
-
Printf.printf "Name: %s\n" (match Create.name identity_create with Some n -> n | None -> "none");
37
-
Printf.printf "Email: %s\n" (Create.email identity_create);
38
-
Printf.printf "Text sig: %s\n" (match Create.text_signature identity_create with Some s -> s | None -> "none");
39
-
[%expect {|
40
-
Name: Work Identity
41
-
Email: work@company.com
42
-
Text sig: Best regards,
43
-
John Smith
44
-
Senior Developer |}]
-224
jmap/test/test_json_deserialization.ml
-224
jmap/test/test_json_deserialization.ml
···
1
-
(* open Jmap *)
2
-
3
-
(* Test JSON deserialization for Method responses *)
4
-
5
-
(* Helper function to create a simple record deserializer for testing *)
6
-
let simple_record_from_json json =
7
-
let open Yojson.Safe.Util in
8
-
json |> member "id" |> to_string
9
-
10
-
let simple_created_info_from_json json =
11
-
let open Yojson.Safe.Util in
12
-
json |> member "serverSetProperty" |> to_string
13
-
14
-
let simple_updated_info_from_json json =
15
-
let open Yojson.Safe.Util in
16
-
json |> member "serverSetProperty" |> to_string
17
-
18
-
(* Test Query_response JSON parsing *)
19
-
let test_query_response () =
20
-
let json_str = {|
21
-
{
22
-
"accountId": "account123",
23
-
"queryState": "state456",
24
-
"canCalculateChanges": true,
25
-
"position": 10,
26
-
"ids": ["id1", "id2", "id3"],
27
-
"total": 100,
28
-
"limit": 50
29
-
}
30
-
|} in
31
-
let json = Yojson.Safe.from_string json_str in
32
-
match Jmap.Methods.Query_response.of_json json with
33
-
| Ok response ->
34
-
Printf.printf "Query_response parsed successfully:\n";
35
-
Printf.printf " account_id: %s\n" (Jmap.Methods.Query_response.account_id response);
36
-
Printf.printf " query_state: %s\n" (Jmap.Methods.Query_response.query_state response);
37
-
Printf.printf " can_calculate_changes: %b\n" (Jmap.Methods.Query_response.can_calculate_changes response);
38
-
Printf.printf " position: %d\n" (Jmap.Methods.Query_response.position response);
39
-
Printf.printf " ids: [%s]\n" (String.concat "; " (Jmap.Methods.Query_response.ids response));
40
-
(match Jmap.Methods.Query_response.total response with
41
-
| Some total -> Printf.printf " total: %d\n" total
42
-
| None -> Printf.printf " total: None\n");
43
-
(match Jmap.Methods.Query_response.limit response with
44
-
| Some limit -> Printf.printf " limit: %d\n" limit
45
-
| None -> Printf.printf " limit: None\n")
46
-
| Error err ->
47
-
Printf.printf "Query_response parse error: %s\n" (Jmap.Protocol.Error.error_to_string err)
48
-
49
-
let%expect_test "Query_response JSON parsing" =
50
-
test_query_response ();
51
-
[%expect {|
52
-
Query_response parsed successfully:
53
-
account_id: account123
54
-
query_state: state456
55
-
can_calculate_changes: true
56
-
position: 10
57
-
ids: [id1; id2; id3]
58
-
total: 100
59
-
limit: 50 |}]
60
-
61
-
(* Test Get_response JSON parsing *)
62
-
let test_get_response () =
63
-
let json_str = {|
64
-
{
65
-
"accountId": "account123",
66
-
"state": "state789",
67
-
"list": [
68
-
{"id": "record1"},
69
-
{"id": "record2"}
70
-
],
71
-
"notFound": ["missing1", "missing2"]
72
-
}
73
-
|} in
74
-
let json = Yojson.Safe.from_string json_str in
75
-
match Jmap.Methods.Get_response.of_json ~from_json:simple_record_from_json json with
76
-
| Ok response ->
77
-
Printf.printf "Get_response parsed successfully:\n";
78
-
Printf.printf " account_id: %s\n" (Jmap.Methods.Get_response.account_id response);
79
-
Printf.printf " state: %s\n" (Jmap.Methods.Get_response.state response);
80
-
Printf.printf " list: [%s]\n" (String.concat "; " (Jmap.Methods.Get_response.list response));
81
-
Printf.printf " not_found: [%s]\n" (String.concat "; " (Jmap.Methods.Get_response.not_found response))
82
-
| Error err ->
83
-
Printf.printf "Get_response parse error: %s\n" (Jmap.Protocol.Error.error_to_string err)
84
-
85
-
let%expect_test "Get_response JSON parsing" =
86
-
test_get_response ();
87
-
[%expect {|
88
-
Get_response parsed successfully:
89
-
account_id: account123
90
-
state: state789
91
-
list: [record1; record2]
92
-
not_found: [missing1; missing2] |}]
93
-
94
-
(* Test Changes_response JSON parsing *)
95
-
let test_changes_response () =
96
-
let json_str = {|
97
-
{
98
-
"accountId": "account123",
99
-
"oldState": "oldstate123",
100
-
"newState": "newstate456",
101
-
"hasMoreChanges": false,
102
-
"created": ["new1", "new2"],
103
-
"updated": ["changed1", "changed2"],
104
-
"destroyed": ["deleted1"],
105
-
"updatedProperties": ["property1", "property2"]
106
-
}
107
-
|} in
108
-
let json = Yojson.Safe.from_string json_str in
109
-
match Jmap.Methods.Changes_response.of_json json with
110
-
| Ok response ->
111
-
Printf.printf "Changes_response parsed successfully:\n";
112
-
Printf.printf " account_id: %s\n" (Jmap.Methods.Changes_response.account_id response);
113
-
Printf.printf " old_state: %s\n" (Jmap.Methods.Changes_response.old_state response);
114
-
Printf.printf " new_state: %s\n" (Jmap.Methods.Changes_response.new_state response);
115
-
Printf.printf " has_more_changes: %b\n" (Jmap.Methods.Changes_response.has_more_changes response);
116
-
Printf.printf " created: [%s]\n" (String.concat "; " (Jmap.Methods.Changes_response.created response));
117
-
Printf.printf " updated: [%s]\n" (String.concat "; " (Jmap.Methods.Changes_response.updated response));
118
-
Printf.printf " destroyed: [%s]\n" (String.concat "; " (Jmap.Methods.Changes_response.destroyed response));
119
-
(match Jmap.Methods.Changes_response.updated_properties response with
120
-
| Some props -> Printf.printf " updated_properties: [%s]\n" (String.concat "; " props)
121
-
| None -> Printf.printf " updated_properties: None\n")
122
-
| Error err ->
123
-
Printf.printf "Changes_response parse error: %s\n" (Jmap.Protocol.Error.error_to_string err)
124
-
125
-
let%expect_test "Changes_response JSON parsing" =
126
-
test_changes_response ();
127
-
[%expect {|
128
-
Changes_response parsed successfully:
129
-
account_id: account123
130
-
old_state: oldstate123
131
-
new_state: newstate456
132
-
has_more_changes: false
133
-
created: [new1; new2]
134
-
updated: [changed1; changed2]
135
-
destroyed: [deleted1]
136
-
updated_properties: [property1; property2] |}]
137
-
138
-
(* Test Set_response JSON parsing *)
139
-
let test_set_response () =
140
-
let json_str = {|
141
-
{
142
-
"accountId": "account123",
143
-
"oldState": "oldstate123",
144
-
"newState": "newstate456",
145
-
"created": {
146
-
"tempId1": {"serverSetProperty": "value1"},
147
-
"tempId2": {"serverSetProperty": "value2"}
148
-
},
149
-
"updated": {
150
-
"id1": {"serverSetProperty": "updated1"},
151
-
"id2": null
152
-
},
153
-
"destroyed": ["deleted1", "deleted2"],
154
-
"notCreated": {
155
-
"tempId3": {"type": "invalidProperties"}
156
-
},
157
-
"notUpdated": {
158
-
"id3": {"type": "notFound"}
159
-
},
160
-
"notDestroyed": {
161
-
"id4": {"type": "forbidden"}
162
-
}
163
-
}
164
-
|} in
165
-
let json = Yojson.Safe.from_string json_str in
166
-
match Jmap.Methods.Set_response.of_json
167
-
~from_created_json:simple_created_info_from_json
168
-
~from_updated_json:simple_updated_info_from_json
169
-
json with
170
-
| Ok response ->
171
-
Printf.printf "Set_response parsed successfully:\n";
172
-
Printf.printf " account_id: %s\n" (Jmap.Methods.Set_response.account_id response);
173
-
(match Jmap.Methods.Set_response.old_state response with
174
-
| Some state -> Printf.printf " old_state: %s\n" state
175
-
| None -> Printf.printf " old_state: None\n");
176
-
Printf.printf " new_state: %s\n" (Jmap.Methods.Set_response.new_state response);
177
-
178
-
(match Jmap.Methods.Set_response.created response with
179
-
| Some created_map ->
180
-
Printf.printf " created: {";
181
-
Hashtbl.iter (fun k v -> Printf.printf "%s=%s; " k v) created_map;
182
-
Printf.printf "}\n"
183
-
| None -> Printf.printf " created: None\n");
184
-
185
-
(match Jmap.Methods.Set_response.destroyed response with
186
-
| Some destroyed_list -> Printf.printf " destroyed: [%s]\n" (String.concat "; " destroyed_list)
187
-
| None -> Printf.printf " destroyed: None\n");
188
-
189
-
Printf.printf " Errors handled: notCreated, notUpdated, notDestroyed maps processed\n"
190
-
| Error err ->
191
-
Printf.printf "Set_response parse error: %s\n" (Jmap.Protocol.Error.error_to_string err)
192
-
193
-
let%expect_test "Set_response JSON parsing" =
194
-
test_set_response ();
195
-
[%expect {|
196
-
Set_response parsed successfully:
197
-
account_id: account123
198
-
old_state: oldstate123
199
-
new_state: newstate456
200
-
created: {tempId2=value2; tempId1=value1; }
201
-
destroyed: [deleted1; deleted2]
202
-
Errors handled: notCreated, notUpdated, notDestroyed maps processed
203
-
|}]
204
-
205
-
(* Test error cases *)
206
-
let test_invalid_json () =
207
-
let invalid_json_str = {|
208
-
{
209
-
"accountId": "account123",
210
-
"missingFields": true
211
-
}
212
-
|} in
213
-
let json = Yojson.Safe.from_string invalid_json_str in
214
-
match Jmap.Methods.Query_response.of_json json with
215
-
| Ok _ -> Printf.printf "Expected error but got success\n"
216
-
| Error err -> Printf.printf "Expected error occurred: %s\n" (Jmap.Protocol.Error.error_to_string err)
217
-
218
-
let%expect_test "Invalid JSON handling" =
219
-
test_invalid_json ();
220
-
[%expect {| Expected error occurred: Parse error: Query_response parse error: Expected string, got null |}]
221
-
222
-
(* Run all tests *)
223
-
let () =
224
-
Printf.printf "JSON deserialization tests completed\n"
-254
jmap/test/test_json_methods.ml
-254
jmap/test/test_json_methods.ml
···
1
-
(** Test JSON serialization for method arguments in JMAP protocol *)
2
-
3
-
open Jmap.Methods
4
-
5
-
let test_get_args () =
6
-
Printf.printf "=== Testing Get_args JSON serialization ===\n";
7
-
8
-
(* Basic test with all fields *)
9
-
let get_args = Get_args.v
10
-
~account_id:"acc123"
11
-
~ids:["id1"; "id2"; "id3"]
12
-
~properties:["subject"; "from"; "to"; "receivedAt"]
13
-
()
14
-
in
15
-
let json = Get_args.to_json get_args in
16
-
Printf.printf "Get_args with all fields: %s\n" (Yojson.Safe.pretty_to_string json);
17
-
18
-
(* Test with minimal fields *)
19
-
let minimal_args = Get_args.v ~account_id:"acc456" () in
20
-
let minimal_json = Get_args.to_json minimal_args in
21
-
Printf.printf "Get_args minimal: %s\n" (Yojson.Safe.pretty_to_string minimal_json);
22
-
23
-
(* Test with result reference *)
24
-
let (args_with_ref, ref_json) = Get_args.with_result_reference get_args
25
-
~result_of:"q1"
26
-
~name:"Email/query"
27
-
~path:"/ids"
28
-
in
29
-
let json_with_ref = Get_args.to_json ~result_reference_ids:(Some ref_json) args_with_ref in
30
-
Printf.printf "Get_args with result reference: %s\n" (Yojson.Safe.pretty_to_string json_with_ref);
31
-
Printf.printf "\n"
32
-
33
-
let test_query_args () =
34
-
Printf.printf "=== Testing Query_args JSON serialization ===\n";
35
-
36
-
(* Create a complex filter *)
37
-
let filter = Filter.and_ [
38
-
Filter.property_equals "mailboxIds" (`Assoc [("inbox123", `Bool true)]);
39
-
Filter.property_equals "keywords" (`Assoc [("$seen", `Bool false)]);
40
-
Filter.property_gt "receivedAt" (`String "2023-01-01T00:00:00Z")
41
-
] in
42
-
43
-
(* Create sort comparators *)
44
-
let sort = [
45
-
Comparator.v ~property:"receivedAt" ~is_ascending:false ();
46
-
Comparator.v ~property:"subject" ~is_ascending:true ~collation:"i;ascii-casemap" ()
47
-
] in
48
-
49
-
(* Test with comprehensive arguments *)
50
-
let query_args = Query_args.v
51
-
~account_id:"acc123"
52
-
~filter
53
-
~sort
54
-
~position:0
55
-
~limit:50
56
-
~calculate_total:true
57
-
~collapse_threads:false
58
-
()
59
-
in
60
-
let json = Query_args.to_json query_args in
61
-
Printf.printf "Query_args comprehensive: %s\n" (Yojson.Safe.pretty_to_string json);
62
-
63
-
(* Test with minimal arguments *)
64
-
let minimal_query = Query_args.v ~account_id:"acc456" () in
65
-
let minimal_json = Query_args.to_json minimal_query in
66
-
Printf.printf "Query_args minimal: %s\n" (Yojson.Safe.pretty_to_string minimal_json);
67
-
Printf.printf "\n"
68
-
69
-
let test_set_args () =
70
-
Printf.printf "=== Testing Set_args JSON serialization ===\n";
71
-
72
-
(* Create test data structures *)
73
-
let create_map = Hashtbl.create 2 in
74
-
Hashtbl.add create_map "k1" (`Assoc [("subject", `String "Test Email 1"); ("keywords", `Assoc [("$draft", `Bool true)])]);
75
-
Hashtbl.add create_map "k2" (`Assoc [("subject", `String "Test Email 2"); ("keywords", `Assoc [])]);
76
-
77
-
let update_map = Hashtbl.create 1 in
78
-
Hashtbl.add update_map "upd1" (`Assoc [("keywords/$seen", `Bool true); ("keywords/$flagged", `Bool false)]);
79
-
80
-
(* Test comprehensive set arguments *)
81
-
let set_args = Set_args.v
82
-
~account_id:"acc123"
83
-
~if_in_state:"state456"
84
-
~create:create_map
85
-
~update:update_map
86
-
~destroy:["destroy1"; "destroy2"]
87
-
~on_success_destroy_original:false
88
-
()
89
-
in
90
-
let json = Set_args.to_json
91
-
~create_to_json:(fun v -> v)
92
-
~update_to_json:(fun v -> v)
93
-
set_args
94
-
in
95
-
Printf.printf "Set_args comprehensive: %s\n" (Yojson.Safe.pretty_to_string json);
96
-
97
-
(* Test minimal set arguments *)
98
-
let minimal_set = Set_args.v ~account_id:"acc456" () in
99
-
let minimal_json = Set_args.to_json minimal_set in
100
-
Printf.printf "Set_args minimal: %s\n" (Yojson.Safe.pretty_to_string minimal_json);
101
-
Printf.printf "\n"
102
-
103
-
let test_changes_args () =
104
-
Printf.printf "=== Testing Changes_args JSON serialization ===\n";
105
-
106
-
(* Test with max_changes *)
107
-
let changes_args = Changes_args.v
108
-
~account_id:"acc123"
109
-
~since_state:"oldstate789"
110
-
~max_changes:100
111
-
()
112
-
in
113
-
let json = Changes_args.to_json changes_args in
114
-
Printf.printf "Changes_args with maxChanges: %s\n" (Yojson.Safe.pretty_to_string json);
115
-
116
-
(* Test without max_changes *)
117
-
let minimal_changes = Changes_args.v
118
-
~account_id:"acc456"
119
-
~since_state:"oldstate101"
120
-
()
121
-
in
122
-
let minimal_json = Changes_args.to_json minimal_changes in
123
-
Printf.printf "Changes_args minimal: %s\n" (Yojson.Safe.pretty_to_string minimal_json);
124
-
Printf.printf "\n"
125
-
126
-
let test_filter_operations () =
127
-
Printf.printf "=== Testing Filter operations ===\n";
128
-
129
-
(* Test various filter conditions *)
130
-
let text_filter = Filter.text_contains "subject" "meeting" in
131
-
Printf.printf "Text contains filter: %s\n" (Yojson.Safe.pretty_to_string (Filter.to_json text_filter));
132
-
133
-
let equals_filter = Filter.property_equals "from" (`String "boss@example.com") in
134
-
Printf.printf "Property equals filter: %s\n" (Yojson.Safe.pretty_to_string (Filter.to_json equals_filter));
135
-
136
-
let date_filter = Filter.property_ge "receivedAt" (`String "2023-01-01T00:00:00Z") in
137
-
Printf.printf "Date greater/equal filter: %s\n" (Yojson.Safe.pretty_to_string (Filter.to_json date_filter));
138
-
139
-
let in_filter = Filter.property_in "keywords" [`String "$flagged"; `String "$important"] in
140
-
Printf.printf "Property in filter: %s\n" (Yojson.Safe.pretty_to_string (Filter.to_json in_filter));
141
-
142
-
(* Test logical combinations *)
143
-
let complex_filter = Filter.and_ [
144
-
Filter.or_ [
145
-
Filter.text_contains "subject" "urgent";
146
-
Filter.text_contains "subject" "important"
147
-
];
148
-
Filter.not_ (Filter.property_equals "keywords/$seen" (`Bool true));
149
-
Filter.property_in "mailboxIds" [`String "inbox"; `String "priority"]
150
-
] in
151
-
Printf.printf "Complex logical filter: %s\n" (Yojson.Safe.pretty_to_string (Filter.to_json complex_filter));
152
-
Printf.printf "\n"
153
-
154
-
let test_comparator_operations () =
155
-
Printf.printf "=== Testing Comparator operations ===\n";
156
-
157
-
let basic_comp = Comparator.v ~property:"receivedAt" ~is_ascending:false () in
158
-
Printf.printf "Basic comparator: %s\n" (Yojson.Safe.pretty_to_string (Comparator.to_json basic_comp));
159
-
160
-
let detailed_comp = Comparator.v
161
-
~property:"subject"
162
-
~is_ascending:true
163
-
~collation:"i;ascii-casemap"
164
-
~keyword:"natural"
165
-
() in
166
-
Printf.printf "Detailed comparator: %s\n" (Yojson.Safe.pretty_to_string (Comparator.to_json detailed_comp));
167
-
168
-
let other_fields = Hashtbl.create 2 in
169
-
Hashtbl.add other_fields "custom1" (`String "value1");
170
-
Hashtbl.add other_fields "custom2" (`Int 42);
171
-
let custom_comp = Comparator.v
172
-
~property:"customField"
173
-
~other_fields
174
-
() in
175
-
Printf.printf "Comparator with other fields: %s\n" (Yojson.Safe.pretty_to_string (Comparator.to_json custom_comp));
176
-
Printf.printf "\n"
177
-
178
-
(** Test JSON structure compliance with JMAP protocol *)
179
-
let test_jmap_compliance () =
180
-
Printf.printf "=== Testing JMAP Protocol Compliance ===\n";
181
-
182
-
(* Example of a typical Email/get request *)
183
-
let email_get = Get_args.v
184
-
~account_id:"u123456789"
185
-
~ids:["Mmail1"; "Mmail2"; "Mmail3"]
186
-
~properties:["id"; "subject"; "from"; "to"; "receivedAt"; "size"; "preview"]
187
-
()
188
-
in
189
-
let email_get_json = Get_args.to_json email_get in
190
-
Printf.printf "JMAP Email/get request: %s\n" (Yojson.Safe.pretty_to_string email_get_json);
191
-
192
-
(* Example of a typical Email/query request *)
193
-
let email_query_filter = Filter.and_ [
194
-
Filter.property_in "mailboxIds" [`String "M1234567890"];
195
-
Filter.property_equals "keywords/$seen" (`Bool false);
196
-
Filter.property_ge "receivedAt" (`String "2023-12-01T00:00:00Z")
197
-
] in
198
-
let email_query = Query_args.v
199
-
~account_id:"u123456789"
200
-
~filter:email_query_filter
201
-
~sort:[Comparator.v ~property:"receivedAt" ~is_ascending:false ()]
202
-
~limit:25
203
-
~calculate_total:true
204
-
()
205
-
in
206
-
let email_query_json = Query_args.to_json email_query in
207
-
Printf.printf "JMAP Email/query request: %s\n" (Yojson.Safe.pretty_to_string email_query_json);
208
-
209
-
(* Example of a typical Email/set request *)
210
-
let create_emails = Hashtbl.create 1 in
211
-
Hashtbl.add create_emails "draft1" (`Assoc [
212
-
("subject", `String "Draft Email");
213
-
("from", `List [`Assoc [("name", `String "John Doe"); ("email", `String "john@example.com")]]);
214
-
("to", `List [`Assoc [("name", `String "Jane Smith"); ("email", `String "jane@example.com")]]);
215
-
("keywords", `Assoc [("$draft", `Bool true)]);
216
-
("mailboxIds", `Assoc [("M0987654321", `Bool true)])
217
-
]);
218
-
219
-
let update_emails = Hashtbl.create 1 in
220
-
Hashtbl.add update_emails "Mmail123" (`Assoc [
221
-
("keywords/$seen", `Bool true);
222
-
("keywords/$flagged", `Bool true)
223
-
]);
224
-
225
-
let email_set = Set_args.v
226
-
~account_id:"u123456789"
227
-
~create:create_emails
228
-
~update:update_emails
229
-
~destroy:["Mmail456"; "Mmail789"]
230
-
()
231
-
in
232
-
let email_set_json = Set_args.to_json
233
-
~create_to_json:(fun v -> v)
234
-
~update_to_json:(fun v -> v)
235
-
email_set
236
-
in
237
-
Printf.printf "JMAP Email/set request: %s\n" (Yojson.Safe.pretty_to_string email_set_json);
238
-
Printf.printf "\n"
239
-
240
-
(** Main test runner *)
241
-
let () =
242
-
Printf.printf "Testing JMAP Method Arguments JSON Serialization\n";
243
-
Printf.printf "=================================================\n\n";
244
-
245
-
test_get_args ();
246
-
test_query_args ();
247
-
test_set_args ();
248
-
test_changes_args ();
249
-
test_filter_operations ();
250
-
test_comparator_operations ();
251
-
test_jmap_compliance ();
252
-
253
-
Printf.printf "All JSON serialization tests completed successfully!\n";
254
-
Printf.printf "The generated JSON structures are JMAP protocol compliant.\n"
-238
jmap/test/test_json_validation.ml
-238
jmap/test/test_json_validation.ml
···
1
-
open Jmap.Methods
2
-
3
-
(** Test JSON serialization validation for JMAP method arguments *)
4
-
5
-
(** Validation helper - checks if JSON contains expected fields *)
6
-
let validate_json_fields expected_fields json =
7
-
match json with
8
-
| `Assoc fields ->
9
-
List.for_all (fun expected_field ->
10
-
List.exists (fun (field_name, _) -> field_name = expected_field) fields
11
-
) expected_fields
12
-
| _ -> false
13
-
14
-
(** Test Get_args JSON serialization validation *)
15
-
let test_get_args () =
16
-
Printf.printf "Testing Get_args JSON validation...\n";
17
-
18
-
(* Test with all fields *)
19
-
let get_args = Get_args.v
20
-
~account_id:"acc123"
21
-
~ids:["id1"; "id2"]
22
-
~properties:["subject"; "from"]
23
-
()
24
-
in
25
-
let json = Get_args.to_json get_args in
26
-
27
-
assert (validate_json_fields ["accountId"; "ids"; "properties"] json);
28
-
Printf.printf "✓ Get_args with all fields - validated\n";
29
-
30
-
(* Test minimal *)
31
-
let minimal_args = Get_args.v ~account_id:"acc456" () in
32
-
let minimal_json = Get_args.to_json minimal_args in
33
-
assert (validate_json_fields ["accountId"] minimal_json);
34
-
Printf.printf "✓ Get_args minimal - validated\n";
35
-
36
-
(* Test result reference *)
37
-
let (_, ref_json) = Get_args.with_result_reference get_args
38
-
~result_of:"q1" ~name:"Email/query" ~path:"/ids" in
39
-
let json_with_ref = Get_args.to_json ~result_reference_ids:(Some ref_json) get_args in
40
-
assert (validate_json_fields ["accountId"; "ids"; "properties"] json_with_ref);
41
-
Printf.printf "✓ Get_args with result reference - validated\n"
42
-
43
-
(** Test Query_args JSON serialization validation *)
44
-
let test_query_args () =
45
-
Printf.printf "\nTesting Query_args JSON validation...\n";
46
-
47
-
let filter = Filter.property_equals "keywords/$seen" (`Bool false) in
48
-
let sort = [Comparator.v ~property:"receivedAt" ~is_ascending:false ()] in
49
-
50
-
let query_args = Query_args.v
51
-
~account_id:"acc123"
52
-
~filter ~sort ~position:0 ~limit:50
53
-
~calculate_total:true ~collapse_threads:false ()
54
-
in
55
-
let json = Query_args.to_json query_args in
56
-
57
-
assert (validate_json_fields ["accountId"; "filter"; "sort"; "position"; "limit"; "calculateTotal"; "collapseThreads"] json);
58
-
Printf.printf "✓ Query_args comprehensive - validated\n";
59
-
60
-
let minimal_query = Query_args.v ~account_id:"acc456" () in
61
-
let minimal_json = Query_args.to_json minimal_query in
62
-
assert (validate_json_fields ["accountId"] minimal_json);
63
-
Printf.printf "✓ Query_args minimal - validated\n"
64
-
65
-
(** Test Set_args JSON serialization validation *)
66
-
let test_set_args () =
67
-
Printf.printf "\nTesting Set_args JSON validation...\n";
68
-
69
-
let create_map = Hashtbl.create 1 in
70
-
Hashtbl.add create_map "k1" (`Assoc [("subject", `String "Test")]);
71
-
72
-
let update_map = Hashtbl.create 1 in
73
-
Hashtbl.add update_map "upd1" (`Assoc [("keywords/$seen", `Bool true)]);
74
-
75
-
let set_args = Set_args.v
76
-
~account_id:"acc123" ~if_in_state:"state456"
77
-
~create:create_map ~update:update_map
78
-
~destroy:["destroy1"] ()
79
-
in
80
-
let json = Set_args.to_json
81
-
~create_to_json:(fun v -> v)
82
-
~update_to_json:(fun v -> v) set_args
83
-
in
84
-
85
-
assert (validate_json_fields ["accountId"; "ifInState"; "create"; "update"; "destroy"] json);
86
-
Printf.printf "✓ Set_args comprehensive - validated\n";
87
-
88
-
let minimal_set = Set_args.v ~account_id:"acc456" () in
89
-
let minimal_json = Set_args.to_json minimal_set in
90
-
assert (validate_json_fields ["accountId"] minimal_json);
91
-
Printf.printf "✓ Set_args minimal - validated\n"
92
-
93
-
(** Test Changes_args JSON serialization validation *)
94
-
let test_changes_args () =
95
-
Printf.printf "\nTesting Changes_args JSON validation...\n";
96
-
97
-
let changes_args = Changes_args.v
98
-
~account_id:"acc123" ~since_state:"state789" ~max_changes:100 ()
99
-
in
100
-
let json = Changes_args.to_json changes_args in
101
-
102
-
assert (validate_json_fields ["accountId"; "sinceState"; "maxChanges"] json);
103
-
Printf.printf "✓ Changes_args with maxChanges - validated\n";
104
-
105
-
let minimal_changes = Changes_args.v
106
-
~account_id:"acc456" ~since_state:"state101" ()
107
-
in
108
-
let minimal_json = Changes_args.to_json minimal_changes in
109
-
assert (validate_json_fields ["accountId"; "sinceState"] minimal_json);
110
-
Printf.printf "✓ Changes_args minimal - validated\n"
111
-
112
-
(** Test Filter and Comparator JSON operations *)
113
-
let test_filter_comparator () =
114
-
Printf.printf "\nTesting Filter and Comparator JSON...\n";
115
-
116
-
(* Test various filter types *)
117
-
let filters = [
118
-
("text_contains", Filter.text_contains "subject" "test");
119
-
("property_equals", Filter.property_equals "from" (`String "user@example.com"));
120
-
("property_gt", Filter.property_gt "receivedAt" (`String "2023-01-01T00:00:00Z"));
121
-
("property_in", Filter.property_in "keywords" [`String "$flagged"; `String "$important"]);
122
-
("and_filter", Filter.and_ [
123
-
Filter.property_equals "mailboxIds/inbox" (`Bool true);
124
-
Filter.property_equals "keywords/$seen" (`Bool false)
125
-
]);
126
-
("or_filter", Filter.or_ [
127
-
Filter.text_contains "subject" "urgent";
128
-
Filter.text_contains "subject" "important"
129
-
]);
130
-
("not_filter", Filter.not_ (Filter.property_equals "keywords/$draft" (`Bool true)));
131
-
] in
132
-
133
-
List.iter (fun (name, filter) ->
134
-
let json = Filter.to_json filter in
135
-
(* Basic validation - filters should produce valid JSON *)
136
-
(match json with
137
-
| `Assoc _ | `String _ | `Int _ | `Bool _ | `List _ ->
138
-
Printf.printf "✓ Filter %s - valid JSON\n" name
139
-
| _ -> failwith ("Invalid JSON for filter: " ^ name))
140
-
) filters;
141
-
142
-
(* Test comparators *)
143
-
let comparators = [
144
-
("basic", Comparator.v ~property:"receivedAt" ~is_ascending:false ());
145
-
("with_collation", Comparator.v ~property:"subject" ~is_ascending:true
146
-
~collation:"i;ascii-casemap" ());
147
-
("with_keyword", Comparator.v ~property:"size" ~keyword:"numeric" ());
148
-
] in
149
-
150
-
List.iter (fun (name, comp) ->
151
-
let json = Comparator.to_json comp in
152
-
assert (validate_json_fields ["property"] json);
153
-
Printf.printf "✓ Comparator %s - validated\n" name
154
-
) comparators
155
-
156
-
(** Test JMAP protocol compliance examples *)
157
-
let test_jmap_compliance () =
158
-
Printf.printf "\nTesting JMAP Protocol Compliance...\n";
159
-
160
-
(* Real-world Email/get example *)
161
-
let email_get = Get_args.v
162
-
~account_id:"u1234567890"
163
-
~ids:["Mf8a6c123"; "Mf8a6c456"; "Mf8a6c789"]
164
-
~properties:["id"; "subject"; "from"; "to"; "receivedAt"; "size"; "preview"; "keywords"]
165
-
()
166
-
in
167
-
let json = Get_args.to_json email_get in
168
-
assert (validate_json_fields ["accountId"; "ids"; "properties"] json);
169
-
Printf.printf "✓ JMAP Email/get request - compliant\n";
170
-
171
-
(* Real-world Email/query example *)
172
-
let email_filter = Filter.and_ [
173
-
Filter.property_in "mailboxIds" [`String "Minbox123"];
174
-
Filter.property_equals "keywords/$seen" (`Bool false);
175
-
Filter.property_ge "receivedAt" (`String "2023-12-01T00:00:00Z");
176
-
] in
177
-
let email_query = Query_args.v
178
-
~account_id:"u1234567890"
179
-
~filter:email_filter
180
-
~sort:[Comparator.v ~property:"receivedAt" ~is_ascending:false ()]
181
-
~limit:50 ~calculate_total:true ()
182
-
in
183
-
let query_json = Query_args.to_json email_query in
184
-
assert (validate_json_fields ["accountId"; "filter"; "sort"; "limit"; "calculateTotal"] query_json);
185
-
Printf.printf "✓ JMAP Email/query request - compliant\n";
186
-
187
-
(* Real-world Email/set example *)
188
-
let create_emails = Hashtbl.create 1 in
189
-
Hashtbl.add create_emails "draft001" (`Assoc [
190
-
("subject", `String "Meeting Tomorrow");
191
-
("from", `List [`Assoc [("email", `String "sender@company.com"); ("name", `String "John Doe")]]);
192
-
("to", `List [`Assoc [("email", `String "recipient@company.com"); ("name", `String "Jane Smith")]]);
193
-
("keywords", `Assoc [("$draft", `Bool true)]);
194
-
("mailboxIds", `Assoc [("Mdrafts456", `Bool true)]);
195
-
]);
196
-
197
-
let update_emails = Hashtbl.create 1 in
198
-
Hashtbl.add update_emails "Mf8a6c123" (`Assoc [
199
-
("keywords/$seen", `Bool true);
200
-
("keywords/$flagged", `Bool true)
201
-
]);
202
-
203
-
let email_set = Set_args.v
204
-
~account_id:"u1234567890"
205
-
~create:create_emails
206
-
~update:update_emails
207
-
~destroy:["Mf8a6c789"]
208
-
()
209
-
in
210
-
let set_json = Set_args.to_json
211
-
~create_to_json:(fun v -> v)
212
-
~update_to_json:(fun v -> v)
213
-
email_set
214
-
in
215
-
assert (validate_json_fields ["accountId"; "create"; "update"; "destroy"] set_json);
216
-
Printf.printf "✓ JMAP Email/set request - compliant\n"
217
-
218
-
(** Main test runner *)
219
-
let () =
220
-
Printf.printf "JMAP Method Arguments JSON Serialization Validation\n";
221
-
Printf.printf "===================================================\n";
222
-
223
-
test_get_args ();
224
-
test_query_args ();
225
-
test_set_args ();
226
-
test_changes_args ();
227
-
test_filter_comparator ();
228
-
test_jmap_compliance ();
229
-
230
-
Printf.printf "\n🎉 All JSON serialization validation tests passed!\n";
231
-
Printf.printf " The implementation correctly supports:\n";
232
-
Printf.printf " • Get_args.to_json with result reference support\n";
233
-
Printf.printf " • Query_args.to_json with filters and sorting\n";
234
-
Printf.printf " • Set_args.to_json with create/update/destroy operations\n";
235
-
Printf.printf " • Changes_args.to_json with maxChanges parameter\n";
236
-
Printf.printf " • Filter.to_json with logical operations\n";
237
-
Printf.printf " • Comparator.to_json with sorting specifications\n";
238
-
Printf.printf " • Full JMAP protocol compliance\n"
-68
jmap/test/test_thread_methods.ml
-68
jmap/test/test_thread_methods.ml
···
1
-
(* Test Thread method argument building and JSON serialization *)
2
-
open Jmap.Methods
3
-
4
-
let%expect_test "thread query args to_json" =
5
-
let open Jmap_email.Thread in
6
-
let query_args = Query_args.v
7
-
~account_id:"account-123"
8
-
~filter:(Filter.and_ [
9
-
filter_has_email "email-1";
10
-
filter_from "sender@example.com"
11
-
])
12
-
~limit:50
13
-
~calculate_total:true
14
-
() in
15
-
let json = Query_args.to_json query_args in
16
-
Yojson.Safe.pretty_print Format.std_formatter json;
17
-
[%expect {|
18
-
{
19
-
"accountId": "account-123",
20
-
"filter": {
21
-
"operator": "AND",
22
-
"conditions": [
23
-
{ "emailIds": "email-1" }, { "from": "sender@example.com" }
24
-
]
25
-
},
26
-
"limit": 50,
27
-
"calculateTotal": true
28
-
}
29
-
|}]
30
-
31
-
let%expect_test "thread get args to_json" =
32
-
let open Jmap_email.Thread in
33
-
let get_args = Get_args.v
34
-
~account_id:"account-456"
35
-
~ids:["thread-1"; "thread-2"]
36
-
~properties:["id"; "emailIds"]
37
-
() in
38
-
let json = Get_args.to_json get_args in
39
-
Yojson.Safe.pretty_print Format.std_formatter json;
40
-
[%expect {|
41
-
{
42
-
"accountId": "account-456",
43
-
"ids": [ "thread-1", "thread-2" ],
44
-
"properties": [ "id", "emailIds" ]
45
-
} |}]
46
-
47
-
let%expect_test "thread filter helpers" =
48
-
let open Jmap_email.Thread in
49
-
(* Test individual filter helpers *)
50
-
let email_filter = filter_has_email "email-123" in
51
-
let from_filter = filter_from "alice@example.com" in
52
-
let subject_filter = filter_subject "Important" in
53
-
let before_filter = filter_before 1640995200.0 in
54
-
let after_filter = filter_after 1640908800.0 in
55
-
56
-
(* Print JSON representations *)
57
-
Printf.printf "Email filter: %s\n" (Yojson.Safe.to_string (Filter.to_json email_filter));
58
-
Printf.printf "From filter: %s\n" (Yojson.Safe.to_string (Filter.to_json from_filter));
59
-
Printf.printf "Subject filter: %s\n" (Yojson.Safe.to_string (Filter.to_json subject_filter));
60
-
Printf.printf "Before filter: %s\n" (Yojson.Safe.to_string (Filter.to_json before_filter));
61
-
Printf.printf "After filter: %s\n" (Yojson.Safe.to_string (Filter.to_json after_filter));
62
-
[%expect {|
63
-
Email filter: {"emailIds":"email-123"}
64
-
From filter: {"from":"alice@example.com"}
65
-
Subject filter: {"subject":"Important"}
66
-
Before filter: {"receivedAt":{"lt":1640995200.0}}
67
-
After filter: {"receivedAt":{"gt":1640908800.0}}
68
-
|}]
-91
jmap/test/test_todo_implementations.ml
-91
jmap/test/test_todo_implementations.ml
···
1
-
(** Test script to verify the newly implemented TODO items work correctly *)
2
-
3
-
let test_email_filters () =
4
-
Printf.printf "=== Testing TODO #9: Size-Based Filtering Utilities ===\n";
5
-
6
-
(* Test basic filter creation *)
7
-
let large_filter = Jmap_email.Email_filter.larger_than 1000000 in (* 1MB *)
8
-
let small_filter = Jmap_email.Email_filter.smaller_than 50000 in (* 50KB *)
9
-
let attachment_filter = Jmap_email.Email_filter.has_attachments () in
10
-
let large_attachment_filter = Jmap_email.Email_filter.attachment_larger_than 2000000 in (* 2MB *)
11
-
12
-
Printf.printf "✓ Created size-based filters successfully\n";
13
-
Printf.printf "✓ Created attachment filters successfully\n";
14
-
(* Use the filters to avoid unused warnings *)
15
-
ignore (large_filter, small_filter, attachment_filter, large_attachment_filter);
16
-
()
17
-
18
-
let test_request_builders () =
19
-
Printf.printf "=== Testing TODO #10: High-Level Request Builders ===\n";
20
-
21
-
(* Create a mock context for testing *)
22
-
let ctx = Jmap_unix.create_client () in
23
-
24
-
(* Test request builder creation *)
25
-
let builder = Jmap_unix.Request_builder.create ~using:["urn:ietf:params:jmap:core"; "urn:ietf:params:jmap:mail"] ctx in
26
-
27
-
(* Test adding a query method call *)
28
-
let query_args = `Assoc [("accountId", `String "test-account")] in
29
-
let builder = Jmap_unix.Request_builder.add_query builder
30
-
~method_name:"Email/query"
31
-
~args:query_args
32
-
~method_call_id:"q1" in
33
-
34
-
(* Test adding a get method call *)
35
-
let get_args = `Assoc [("accountId", `String "test-account")] in
36
-
let builder = Jmap_unix.Request_builder.add_get builder
37
-
~method_name:"Email/get"
38
-
~args:get_args
39
-
~method_call_id:"g1" in
40
-
41
-
(* Test converting to request *)
42
-
let _request = Jmap_unix.Request_builder.to_request builder in
43
-
44
-
Printf.printf "✓ Created request builder successfully\n";
45
-
Printf.printf "✓ Added query and get method calls\n";
46
-
Printf.printf "✓ Converted to JMAP request\n";
47
-
()
48
-
49
-
let test_analytics () =
50
-
Printf.printf "=== Testing TODO #12: Basic Analytics Utilities ===\n";
51
-
52
-
(* Test format_size utility *)
53
-
let size_1kb = 1024L in
54
-
let size_1mb = Int64.mul 1024L 1024L in
55
-
let size_1gb = Int64.mul size_1mb 1024L in
56
-
57
-
let formatted_kb = Jmap_email.Analytics.format_size size_1kb in
58
-
let formatted_mb = Jmap_email.Analytics.format_size size_1mb in
59
-
let formatted_gb = Jmap_email.Analytics.format_size size_1gb in
60
-
61
-
Printf.printf "✓ 1024 bytes = %s\n" formatted_kb;
62
-
Printf.printf "✓ 1MB = %s\n" formatted_mb;
63
-
Printf.printf "✓ 1GB = %s\n" formatted_gb;
64
-
65
-
(* Test with empty email list (to avoid complex email construction) *)
66
-
let stats = Jmap_email.Analytics.calculate_email_stats [] in
67
-
Printf.printf "✓ Empty email stats: %d total, %d unread, %Ld bytes\n"
68
-
stats.total_count stats.unread_count stats.total_size;
69
-
70
-
let domains = Jmap_email.Analytics.top_domains [] in
71
-
Printf.printf "✓ Empty domain list length: %d\n" (List.length domains);
72
-
()
73
-
74
-
(** Main test runner *)
75
-
let () =
76
-
Printf.printf "Running tests for TODO implementations #9-12\n\n";
77
-
78
-
test_email_filters ();
79
-
Printf.printf "\n";
80
-
81
-
test_request_builders ();
82
-
Printf.printf "\n";
83
-
84
-
Printf.printf "=== Testing TODO #11: Response Processing Utilities ===\n";
85
-
Printf.printf "✓ Response processing utilities available in Jmap.Protocol.Response\n";
86
-
Printf.printf "\n";
87
-
88
-
test_analytics ();
89
-
Printf.printf "\n";
90
-
91
-
Printf.printf "All TODO implementations tested successfully! 🎉\n"
-49
jmap/test/test_vacation_methods.ml
-49
jmap/test/test_vacation_methods.ml
···
1
-
(* Test VacationResponse method argument building and JSON serialization *)
2
-
3
-
let%expect_test "vacation get args to_json" =
4
-
let open Jmap_email.Vacation in
5
-
let get_args = Get_args.v
6
-
~account_id:"account-vacation"
7
-
~ids:["singleton"]
8
-
~properties:["id"; "isEnabled"; "subject"; "textBody"]
9
-
() in
10
-
let json = Get_args.to_json get_args in
11
-
Yojson.Safe.pretty_print Format.std_formatter json;
12
-
[%expect {|
13
-
{
14
-
"accountId": "account-vacation",
15
-
"ids": [ "singleton" ],
16
-
"properties": [ "id", "isEnabled", "subject", "textBody" ]
17
-
} |}]
18
-
19
-
let%expect_test "vacation get args singleton only" =
20
-
let open Jmap_email.Vacation in
21
-
let get_args = Get_args.v ~account_id:"account-simple" () in
22
-
let json = Get_args.to_json get_args in
23
-
Yojson.Safe.pretty_print Format.std_formatter json;
24
-
[%expect {| { "accountId": "account-simple" } |}]
25
-
26
-
let%expect_test "vacation response object" =
27
-
let open Jmap_email.Vacation in
28
-
let vacation = Vacation_response.v
29
-
~id:"singleton"
30
-
~is_enabled:true
31
-
~from_date:1672531200.0 (* 2023-01-01 *)
32
-
~to_date:1672617600.0 (* 2023-01-02 *)
33
-
~subject:"Out of Office"
34
-
~text_body:"I'm currently out of office and will respond when I return."
35
-
() in
36
-
37
-
(* Test accessors *)
38
-
Printf.printf "ID: %s\n" (Vacation_response.id vacation);
39
-
Printf.printf "Enabled: %b\n" (Vacation_response.is_enabled vacation);
40
-
Printf.printf "Subject: %s\n" (match Vacation_response.subject vacation with Some s -> s | None -> "none");
41
-
Printf.printf "From date: %s\n" (match Vacation_response.from_date vacation with
42
-
| Some d -> string_of_float d
43
-
| None -> "none");
44
-
[%expect {|
45
-
ID: singleton
46
-
Enabled: true
47
-
Subject: Out of Office
48
-
From date: 1672531200.
49
-
|}]