this repo has no description
more
+92
-107
+70
-100
jmap/bin/fastmail_connect.ml
+70
-100
jmap/bin/fastmail_connect.ml
···
1
1
open Printf
2
2
3
+
(* Result monad operator for cleaner error handling *)
4
+
let (let+) x f = Result.bind x f
5
+
3
6
let fetch_recent_emails env ctx session =
4
7
try
5
8
let account_id = Jmap_unix.Session_utils.get_primary_mail_account session in
6
9
printf "Using account: %s\n" account_id;
10
+
printf "Building JMAP request using library functions...\n";
7
11
8
12
(* Create sort comparator using proper JSON generation *)
9
13
let sort_comparator = Jmap.Methods.Comparator.v
···
11
15
~is_ascending:false
12
16
() in
13
17
14
-
(* Try using the manual JMAP request approach directly *)
15
-
printf "Using manual JMAP request approach...\n";
16
-
17
18
(* Build Email/query request using Jmap.Methods functions *)
18
19
let builder = Jmap_unix.build ctx in
19
-
let builder = Jmap_unix.using builder ["urn:ietf:params:jmap:core"; "urn:ietf:params:jmap:mail"] in
20
+
let builder = Jmap_unix.using builder [Jmap.Protocol.capability_core; Jmap.Protocol.capability_mail] in
20
21
21
22
(* Create Email/query arguments without position parameter *)
22
23
let query_args = Jmap.Methods.Query_args.v
···
29
30
let builder = Jmap_unix.add_method_call builder "Email/query" query_json "q1" in
30
31
31
32
(* Add Email/get to fetch details using the query results *)
32
-
(* Using manual result reference construction since library version has issues *)
33
-
let get_json = `Assoc [
34
-
("accountId", `String account_id);
35
-
("#ids", `Assoc [
36
-
("resultOf", `String "q1");
37
-
("name", `String "Email/query");
38
-
("path", `String "/ids")
39
-
]);
40
-
("properties", `List [
41
-
`String "id";
42
-
`String "subject";
43
-
`String "from";
44
-
`String "receivedAt";
45
-
`String "preview"
46
-
])
47
-
] in
48
-
33
+
let get_args = Jmap.Methods.Get_args.v
34
+
~account_id
35
+
~properties:["id"; "subject"; "from"; "receivedAt"; "preview"]
36
+
() in
37
+
let (get_args_with_ref, result_ref_json) = Jmap.Methods.Get_args.with_result_reference
38
+
get_args
39
+
~result_of:"q1"
40
+
~name:"Email/query"
41
+
~path:"/ids"
42
+
in
43
+
let get_json = Jmap.Methods.Get_args.to_json ~result_reference_ids:(Some result_ref_json) get_args_with_ref in
49
44
let builder = Jmap_unix.add_method_call builder "Email/get" get_json "g1" in
50
45
51
46
(* Execute the request *)
52
-
match Jmap_unix.execute env builder with
53
-
| Ok response ->
54
-
printf "✓ Got JMAP response\n";
55
-
56
-
(* Parse the query response using the library function *)
57
-
(match Jmap_unix.Response.extract_method ~method_name:"Email/query" ~method_call_id:"q1" response with
58
-
| Ok query_response_json ->
59
-
(match Jmap.Methods.Query_response.of_json query_response_json with
60
-
| Ok query_response ->
61
-
let ids = Jmap.Methods.Query_response.ids query_response in
62
-
printf "✓ Found %d emails\n\n" (List.length ids);
63
-
64
-
(* Parse the get response using the library function *)
65
-
(match Jmap_unix.Response.extract_method ~method_name:"Email/get" ~method_call_id:"g1" response with
66
-
| Ok get_response_json ->
67
-
(* Create a wrapper for from_json since Jmap_email.of_json returns Result *)
68
-
let email_from_json json =
69
-
match Jmap_email.of_json json with
70
-
| Ok email -> email
71
-
| Error err -> failwith ("Email parse error: " ^ err)
72
-
in
73
-
(match Jmap.Methods.Get_response.of_json ~from_json:email_from_json get_response_json with
74
-
| Ok get_response ->
75
-
let emails = Jmap.Methods.Get_response.list get_response in
76
-
List.iteri (fun i email ->
77
-
printf "━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━\n";
78
-
printf "Email #%d:\n" (i + 1);
79
-
80
-
(* Use typed accessor functions instead of direct JSON parsing *)
81
-
let subject = match Jmap_email.subject email with
82
-
| Some s -> s
83
-
| None -> "(No Subject)"
84
-
in
85
-
printf " Subject: %s\n" subject;
86
-
87
-
(* Use typed accessor for sender *)
88
-
(match Jmap_email.from email with
89
-
| Some from_list when from_list <> [] ->
90
-
let sender = List.hd from_list in
91
-
let email_addr = Jmap_email.Email_address.email sender in
92
-
(match Jmap_email.Email_address.name sender with
93
-
| Some name -> printf " From: %s <%s>\n" name email_addr
94
-
| None -> printf " From: %s\n" email_addr)
95
-
| _ -> printf " From: (Unknown)\n");
96
-
97
-
(* Use typed accessor for date *)
98
-
(match Jmap_email.received_at email with
99
-
| Some timestamp ->
100
-
let date = Jmap.Date.of_timestamp timestamp in
101
-
let date_str = Jmap.Date.to_rfc3339 date in
102
-
printf " Date: %s\n" date_str
103
-
| None -> printf " Date: (Unknown)\n");
104
-
105
-
(* Use typed accessor for preview *)
106
-
(match Jmap_email.preview email with
107
-
| Some preview when String.length preview > 0 ->
108
-
let short_preview = if String.length preview > 100
109
-
then (String.sub preview 0 97) ^ "..."
110
-
else preview in
111
-
printf " Preview: %s\n" short_preview
112
-
| _ -> ())
113
-
) emails;
114
-
printf "━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━\n";
115
-
Ok ()
116
-
| Error parse_error ->
117
-
printf "Failed to parse email get response: %s\n" (Jmap.Protocol.Error.error_to_string parse_error);
118
-
Error (Jmap.Protocol.Error.protocol_error ("Email get parse error: " ^ Jmap.Protocol.Error.error_to_string parse_error)))
119
-
| Error e ->
120
-
printf "Failed to extract get response: %s\n" (Jmap.Protocol.Error.error_to_string e);
121
-
Error e)
122
-
| Error parse_error ->
123
-
printf "Failed to parse query response: %s\n" (Jmap.Protocol.Error.error_to_string parse_error);
124
-
Error (Jmap.Protocol.Error.protocol_error ("Query parse error: " ^ Jmap.Protocol.Error.error_to_string parse_error)))
125
-
| Error e ->
126
-
printf "Failed to extract query results: %s\n" (Jmap.Protocol.Error.error_to_string e);
127
-
Error e)
128
-
| Error e ->
129
-
printf "JMAP request failed: %s\n" (Jmap.Protocol.Error.error_to_string e);
130
-
Error e
47
+
let+ response = Jmap_unix.execute env builder in
48
+
printf "✓ Got JMAP response\n";
49
+
50
+
let+ query_response_json = Jmap_unix.Response.extract_method ~method_name:"Email/query" ~method_call_id:"q1" response in
51
+
let+ query_response = Jmap.Methods.Query_response.of_json query_response_json in
52
+
let ids = Jmap.Methods.Query_response.ids query_response in
53
+
printf "✓ Found %d emails\n\n" (List.length ids);
54
+
55
+
let+ get_response_json = Jmap_unix.Response.extract_method ~method_name:"Email/get" ~method_call_id:"g1" response in
56
+
(* Create a wrapper for from_json since Jmap_email.of_json returns Result *)
57
+
let email_from_json json =
58
+
match Jmap_email.of_json json with
59
+
| Ok email -> email
60
+
| Error err -> failwith ("Email parse error: " ^ err)
61
+
in
62
+
let+ get_response = Jmap.Methods.Get_response.of_json ~from_json:email_from_json get_response_json in
63
+
let emails = Jmap.Methods.Get_response.list get_response in
64
+
65
+
List.iteri (fun i email ->
66
+
printf "━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━\n";
67
+
printf "Email #%d:\n" (i + 1);
68
+
69
+
let subject = match Jmap_email.subject email with
70
+
| Some s -> s
71
+
| None -> "(No Subject)"
72
+
in
73
+
printf " Subject: %s\n" subject;
74
+
75
+
(match Jmap_email.from email with
76
+
| Some from_list when from_list <> [] ->
77
+
let sender = List.hd from_list in
78
+
let email_addr = Jmap_email.Email_address.email sender in
79
+
(match Jmap_email.Email_address.name sender with
80
+
| Some name -> printf " From: %s <%s>\n" name email_addr
81
+
| None -> printf " From: %s\n" email_addr)
82
+
| _ -> printf " From: (Unknown)\n");
83
+
84
+
(match Jmap_email.received_at email with
85
+
| Some timestamp ->
86
+
let date = Jmap.Date.of_timestamp timestamp in
87
+
let date_str = Jmap.Date.to_rfc3339 date in
88
+
printf " Date: %s\n" date_str
89
+
| None -> printf " Date: (Unknown)\n");
90
+
91
+
(match Jmap_email.preview email with
92
+
| Some preview when String.length preview > 0 ->
93
+
let short_preview = if String.length preview > 100
94
+
then (String.sub preview 0 97) ^ "..."
95
+
else preview in
96
+
printf " Preview: %s\n" short_preview
97
+
| _ -> ())
98
+
) emails;
99
+
printf "━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━\n";
100
+
Ok ()
131
101
with
132
102
| exn -> Error (Jmap.Protocol.Error.protocol_error ("Exception: " ^ Printexc.to_string exn))
133
103
+6
-6
jmap/jmap-unix/jmap_unix.ml
+6
-6
jmap/jmap-unix/jmap_unix.ml
···
244
244
245
245
let build ctx = {
246
246
ctx;
247
-
using = ["urn:ietf:params:jmap:core"];
247
+
using = [Jmap.Protocol.capability_core];
248
248
method_calls = [];
249
249
}
250
250
···
606
606
| None -> `Null);
607
607
] in
608
608
let builder = build ctx
609
-
|> fun b -> using b ["urn:ietf:params:jmap:core"; "urn:ietf:params:jmap:mail"]
609
+
|> fun b -> using b [Jmap.Protocol.capability_core; Jmap.Protocol.capability_mail]
610
610
|> fun b -> add_method_call b "Email/get" args "get-1"
611
611
in
612
612
match execute env builder with
···
632
632
("position", match position with Some p -> `Int p | None -> `Null);
633
633
] in
634
634
let builder = build ctx
635
-
|> fun b -> using b ["urn:ietf:params:jmap:core"; "urn:ietf:params:jmap:mail"]
635
+
|> fun b -> using b [Jmap.Protocol.capability_core; Jmap.Protocol.capability_mail]
636
636
|> fun b -> add_method_call b "Email/query" args "query-1"
637
637
in
638
638
match execute env builder with
···
656
656
) email_ids));
657
657
] in
658
658
let builder = build ctx
659
-
|> fun b -> using b ["urn:ietf:params:jmap:core"; "urn:ietf:params:jmap:mail"]
659
+
|> fun b -> using b [Jmap.Protocol.capability_core; Jmap.Protocol.capability_mail]
660
660
|> fun b -> add_method_call b "Email/set" args "set-1"
661
661
in
662
662
match execute env builder with
···
691
691
| None -> `Null);
692
692
] in
693
693
let builder = build ctx
694
-
|> fun b -> using b ["urn:ietf:params:jmap:core"; "urn:ietf:params:jmap:mail"]
694
+
|> fun b -> using b [Jmap.Protocol.capability_core; Jmap.Protocol.capability_mail]
695
695
|> fun b -> add_method_call b "Email/import" args "import-1"
696
696
in
697
697
match execute env builder with
···
758
758
let open Jmap.Protocol.Session.Session in
759
759
let primary_accs = primary_accounts session in
760
760
try
761
-
Hashtbl.find primary_accs "urn:ietf:params:jmap:mail"
761
+
Hashtbl.find primary_accs Jmap.Protocol.capability_mail
762
762
with
763
763
| Not_found ->
764
764
let accounts = accounts session in
+1
-1
jmap/jmap/jmap_methods.ml
+1
-1
jmap/jmap/jmap_methods.ml
···
29
29
("accountId", `String t.account_id);
30
30
] in
31
31
let fields = match result_reference_ids with
32
-
| Some ref_json -> ("ids", ref_json) :: base_fields
32
+
| Some ref_json -> ("#ids", ref_json) :: base_fields
33
33
| None ->
34
34
match t.ids with
35
35
| Some id_list -> ("ids", (`List (List.map (fun id -> `String id) id_list) : Yojson.Safe.t)) :: base_fields
+3
jmap/jmap/jmap_protocol.ml
+3
jmap/jmap/jmap_protocol.ml
···
17
17
type problem_details = Error.Problem_details.t
18
18
19
19
let capability_core = "urn:ietf:params:jmap:core"
20
+
let capability_mail = "urn:ietf:params:jmap:mail"
21
+
let capability_submission = "urn:ietf:params:jmap:submission"
22
+
let capability_vacationresponse = "urn:ietf:params:jmap:vacationresponse"
20
23
21
24
let supports_capability session capability =
22
25
Hashtbl.mem (Session.Session.capabilities session) capability
+12
jmap/jmap/jmap_protocol.mli
+12
jmap/jmap/jmap_protocol.mli
···
71
71
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-2> RFC 8620, Section 2 *)
72
72
val capability_core : string
73
73
74
+
(** Capability URI for JMAP Mail.
75
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-1.1> RFC 8621, Section 1.1 *)
76
+
val capability_mail : string
77
+
78
+
(** Capability URI for JMAP Email Submission.
79
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-7> RFC 8621, Section 7 *)
80
+
val capability_submission : string
81
+
82
+
(** Capability URI for JMAP Vacation Response.
83
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-8> RFC 8621, Section 8 *)
84
+
val capability_vacationresponse : string
85
+
74
86
(** {1 Protocol Helpers} *)
75
87
76
88
(** Check if a session supports a given capability.