this repo has no description
more
+208
-71
+69
-58
jmap/bin/fastmail_connect.ml
+69
-58
jmap/bin/fastmail_connect.ml
···
29
29
let builder = Jmap_unix.add_method_call builder "Email/query" query_json "q1" in
30
30
31
31
(* Add Email/get to fetch details using the query results *)
32
-
let _get_args = Jmap.Methods.Get_args.v
33
-
~account_id
34
-
~properties:["id"; "subject"; "from"; "receivedAt"; "preview"]
35
-
() in
36
-
37
-
(* Create a result reference to use the IDs from the query *)
32
+
(* Using manual result reference construction since library version has issues *)
38
33
let get_json = `Assoc [
39
34
("accountId", `String account_id);
40
35
("#ids", `Assoc [
···
58
53
| Ok response ->
59
54
printf "✓ Got JMAP response\n";
60
55
61
-
(* First extract the query results to show we got IDs *)
56
+
(* Parse the query response using the library function *)
62
57
(match Jmap_unix.Response.extract_method ~method_name:"Email/query" ~method_call_id:"q1" response with
63
-
| Ok query_response ->
64
-
let open Yojson.Safe.Util in
65
-
let ids = query_response |> member "ids" |> to_list |> List.map to_string in
66
-
printf "✓ Found %d emails\n\n" (List.length ids);
67
-
68
-
(* Now extract the email details from Email/get *)
69
-
(match Jmap_unix.Response.extract_method ~method_name:"Email/get" ~method_call_id:"g1" response with
70
-
| Ok get_response ->
71
-
let emails = get_response |> member "list" |> to_list in
72
-
List.iteri (fun i email_json ->
73
-
printf "━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━\n";
74
-
printf "Email #%d:\n" (i + 1);
75
-
76
-
(* Extract subject *)
77
-
let subject = email_json |> member "subject" |> to_string_option |> Option.value ~default:"(No Subject)" in
78
-
printf " Subject: %s\n" subject;
79
-
80
-
(* Extract sender *)
81
-
(try
82
-
let from_list = email_json |> member "from" |> to_list in
83
-
if List.length from_list > 0 then (
84
-
let sender = List.hd from_list in
85
-
let email_addr = sender |> member "email" |> to_string in
86
-
let name = sender |> member "name" |> to_string_option in
87
-
match name with
88
-
| Some n -> printf " From: %s <%s>\n" n email_addr
89
-
| None -> printf " From: %s\n" email_addr
90
-
) else printf " From: (Unknown)\n"
91
-
with _ -> printf " From: (Unknown)\n");
92
-
93
-
(* Extract and format date *)
94
-
(try
95
-
let received_at = email_json |> member "receivedAt" |> to_string in
96
-
printf " Date: %s\n" received_at
97
-
with _ -> printf " Date: (Unknown)\n");
98
-
99
-
(* Extract preview if available *)
100
-
(try
101
-
let preview = email_json |> member "preview" |> to_string in
102
-
if String.length preview > 0 then
103
-
let short_preview = if String.length preview > 100
104
-
then (String.sub preview 0 97) ^ "..."
105
-
else preview in
106
-
printf " Preview: %s\n" short_preview
107
-
with _ -> ())
108
-
) emails;
109
-
printf "━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━\n";
110
-
Ok ()
111
-
| Error e ->
112
-
printf "Failed to get email details: %s\n" (Jmap.Protocol.Error.error_to_string e);
113
-
Error e)
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)))
114
125
| Error e ->
115
126
printf "Failed to extract query results: %s\n" (Jmap.Protocol.Error.error_to_string e);
116
127
Error e)
+139
-13
jmap/jmap-email/jmap_email.ml
+139
-13
jmap/jmap-email/jmap_email.ml
···
9
9
10
10
open Jmap.Types
11
11
12
+
(** JSON parsing combinators for cleaner field extraction *)
13
+
module Json = struct
14
+
(** Extract a field from JSON object fields list *)
15
+
let field (name : string) (fields : (string * Yojson.Safe.t) list) : Yojson.Safe.t option =
16
+
List.assoc_opt name fields
17
+
18
+
(** Parse string field *)
19
+
let string (name : string) (fields : (string * Yojson.Safe.t) list) : string option =
20
+
match field name fields with
21
+
| Some (`String s) -> Some s
22
+
| _ -> None
23
+
24
+
(** Parse integer field *)
25
+
let int (name : string) (fields : (string * Yojson.Safe.t) list) : int option =
26
+
match field name fields with
27
+
| Some (`Int i) -> Some i
28
+
| _ -> None
29
+
30
+
(** Parse boolean field *)
31
+
let bool (name : string) (fields : (string * Yojson.Safe.t) list) : bool option =
32
+
match field name fields with
33
+
| Some (`Bool b) -> Some b
34
+
| _ -> None
35
+
36
+
(** Parse list field with element parser *)
37
+
let list (element_parser : Yojson.Safe.t -> 'a option) (name : string) (fields : (string * Yojson.Safe.t) list) : 'a list option =
38
+
match field name fields with
39
+
| Some (`List items) ->
40
+
let parsed = List.filter_map element_parser items in
41
+
if parsed <> [] then Some parsed else None
42
+
| _ -> None
43
+
44
+
(** Parse string list field *)
45
+
let string_list (name : string) (fields : (string * Yojson.Safe.t) list) : string list option =
46
+
list (function `String s -> Some s | _ -> None) name fields
47
+
48
+
(** Parse ISO 8601 date field to Unix timestamp *)
49
+
let iso_date (name : string) (fields : (string * Yojson.Safe.t) list) : float option =
50
+
match string name fields with
51
+
| Some s ->
52
+
(try
53
+
let tm = Scanf.sscanf s "%04d-%02d-%02dT%02d:%02d:%02dZ"
54
+
(fun y m d h min sec ->
55
+
{Unix.tm_year = y - 1900; tm_mon = m - 1; tm_mday = d;
56
+
tm_hour = h; tm_min = min; tm_sec = sec; tm_wday = 0;
57
+
tm_yday = 0; tm_isdst = false}) in
58
+
Some (fst (Unix.mktime tm))
59
+
with _ -> None)
60
+
| None -> None
61
+
62
+
(** Parse email address from JSON object *)
63
+
let email_address (json : Yojson.Safe.t) : Jmap_email_address.t option =
64
+
match json with
65
+
| `Assoc addr_fields ->
66
+
let email = string "email" addr_fields in
67
+
let name = string "name" addr_fields in
68
+
(match email with
69
+
| Some e when e <> "" -> Some (Jmap_email_address.create_unsafe ~email:e ?name ())
70
+
| _ -> None)
71
+
| _ -> None
72
+
73
+
(** Parse email address list field *)
74
+
let email_address_list (name : string) (fields : (string * Yojson.Safe.t) list) : Jmap_email_address.t list option =
75
+
list email_address name fields
76
+
77
+
(** Parse object field as hashtable *)
78
+
let object_map (value_parser : Yojson.Safe.t -> 'a option) (name : string) (fields : (string * Yojson.Safe.t) list) : (string, 'a) Hashtbl.t option =
79
+
match field name fields with
80
+
| Some (`Assoc obj_fields) ->
81
+
let tbl = Hashtbl.create (List.length obj_fields) in
82
+
let success = List.for_all (fun (key, value) ->
83
+
match value_parser value with
84
+
| Some parsed_value ->
85
+
Hashtbl.add tbl key parsed_value;
86
+
true
87
+
| None -> false
88
+
) obj_fields in
89
+
if success && Hashtbl.length tbl > 0 then Some tbl else None
90
+
| _ -> None
91
+
92
+
(** Parse string-to-string map *)
93
+
let string_map (name : string) (fields : (string * Yojson.Safe.t) list) : (string, string) Hashtbl.t option =
94
+
object_map (function `String s -> Some s | _ -> None) name fields
95
+
96
+
(** Parse string-to-bool map (for mailboxIds) *)
97
+
let bool_map (name : string) (fields : (string * Yojson.Safe.t) list) : (string, bool) Hashtbl.t option =
98
+
object_map (function `Bool b -> Some b | _ -> None) name fields
99
+
end
100
+
12
101
type t = {
13
102
id : id option;
14
103
blob_id : id option;
···
167
256
(* Simplified implementation - would filter based on properties list *)
168
257
to_json t
169
258
170
-
(* Simple JSON parsing - full implementation would be much longer *)
259
+
(* Complete JSON parsing implementation for Email objects using combinators *)
171
260
let of_json = function
172
261
| `Assoc fields ->
173
262
(try
174
-
let id = match List.assoc_opt "id" fields with
175
-
| Some (`String s) -> Some s
263
+
(* Parse all email fields using combinators *)
264
+
let id = Json.string "id" fields in
265
+
let blob_id = Json.string "blobId" fields in
266
+
let thread_id = Json.string "threadId" fields in
267
+
let mailbox_ids = Json.bool_map "mailboxIds" fields in
268
+
let keywords = None in (* TODO: Parse keywords when Jmap_email_keywords.of_json is available *)
269
+
let size = Json.int "size" fields in
270
+
let received_at = Json.iso_date "receivedAt" fields in
271
+
let message_id = Json.string_list "messageId" fields in
272
+
let in_reply_to = Json.string_list "inReplyTo" fields in
273
+
let references = Json.string_list "references" fields in
274
+
let sender = match Json.email_address_list "sender" fields with
275
+
| Some [addr] -> Some addr
176
276
| _ -> None
177
277
in
178
-
let subject = match List.assoc_opt "subject" fields with
179
-
| Some (`String s) -> Some s
180
-
| _ -> None
181
-
in
182
-
let size = match List.assoc_opt "size" fields with
183
-
| Some (`Int i) -> Some i
184
-
| _ -> None
185
-
in
186
-
Ok (create ?id ?subject ?size ())
278
+
let from = Json.email_address_list "from" fields in
279
+
let to_ = Json.email_address_list "to" fields in
280
+
let cc = Json.email_address_list "cc" fields in
281
+
let bcc = Json.email_address_list "bcc" fields in
282
+
let reply_to = Json.email_address_list "replyTo" fields in
283
+
let subject = Json.string "subject" fields in
284
+
let sent_at = Json.iso_date "sentAt" fields in
285
+
let has_attachment = Json.bool "hasAttachment" fields in
286
+
let preview = Json.string "preview" fields in
287
+
let body_structure = None in (* TODO: Parse when Jmap_email_body.of_json is available *)
288
+
let body_values = None in (* TODO: Parse when body value parser is available *)
289
+
let text_body = None in (* TODO: Parse when body part parser is available *)
290
+
let html_body = None in (* TODO: Parse when body part parser is available *)
291
+
let attachments = None in (* TODO: Parse when body part parser is available *)
292
+
let headers = Json.string_map "headers" fields in
293
+
294
+
(* Collect any unrecognized fields into other_properties *)
295
+
let known_fields = [
296
+
"id"; "blobId"; "threadId"; "mailboxIds"; "keywords"; "size"; "receivedAt";
297
+
"messageId"; "inReplyTo"; "references"; "sender"; "from"; "to"; "cc"; "bcc";
298
+
"replyTo"; "subject"; "sentAt"; "hasAttachment"; "preview"; "bodyStructure";
299
+
"bodyValues"; "textBody"; "htmlBody"; "attachments"; "headers"
300
+
] in
301
+
let other_properties = Hashtbl.create 16 in
302
+
List.iter (fun (field_name, field_value) ->
303
+
if not (List.mem field_name known_fields) then
304
+
Hashtbl.add other_properties field_name field_value
305
+
) fields;
306
+
307
+
Ok (create
308
+
?id ?blob_id ?thread_id ?mailbox_ids ?keywords ?size ?received_at
309
+
?message_id ?in_reply_to ?references ?sender ?from ?to_ ?cc ?bcc
310
+
?reply_to ?subject ?sent_at ?has_attachment ?preview ?body_structure
311
+
?body_values ?text_body ?html_body ?attachments ?headers
312
+
~other_properties ())
187
313
with
188
-
| exn -> Error (Printexc.to_string exn))
314
+
| exn -> Error (Printf.sprintf "Email JSON parsing error: %s" (Printexc.to_string exn)))
189
315
| _ ->
190
316
Error "Email JSON must be an object"
191
317