This repository has no description
1(*---------------------------------------------------------------------------
2 Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3 SPDX-License-Identifier: ISC
4 ---------------------------------------------------------------------------*)
5
6(** JMAP command-line client *)
7
8open Cmdliner
9
10(** {1 Helpers} *)
11
12let ptime_to_string t =
13 let (y, m, d), ((hh, mm, ss), _tz) = Ptime.to_date_time t in
14 Printf.sprintf "%04d-%02d-%02d %02d:%02d:%02d" y m d hh mm ss
15
16let truncate_string max_len s =
17 if String.length s <= max_len then s
18 else String.sub s 0 (max_len - 3) ^ "..."
19
20let format_email_address (addr : Jmap.Proto.Email_address.t) =
21 match addr.name with
22 | Some name -> Printf.sprintf "%s <%s>" name addr.email
23 | None -> addr.email
24
25let format_email_addresses addrs =
26 String.concat ", " (List.map format_email_address addrs)
27
28let format_keywords keywords =
29 keywords
30 |> List.filter_map (fun (k, v) -> if v then Some k else None)
31 |> String.concat " "
32
33(* Helpers for optional Email fields *)
34let email_id (e : Jmap.Proto.Email.t) =
35 match e.id with Some id -> Jmap.Proto.Id.to_string id | None -> "?"
36
37let email_received_at (e : Jmap.Proto.Email.t) =
38 match e.received_at with Some t -> ptime_to_string t | None -> "?"
39
40let email_keywords (e : Jmap.Proto.Email.t) =
41 Option.value ~default:[] e.keywords
42
43let email_preview (e : Jmap.Proto.Email.t) =
44 Option.value ~default:"" e.preview
45
46let email_thread_id (e : Jmap.Proto.Email.t) =
47 match e.thread_id with Some id -> Jmap.Proto.Id.to_string id | None -> "?"
48
49let email_size (e : Jmap.Proto.Email.t) =
50 Option.value ~default:0L e.size
51
52let email_mailbox_ids (e : Jmap.Proto.Email.t) =
53 Option.value ~default:[] e.mailbox_ids
54
55(** {1 Session Command} *)
56
57let session_cmd =
58 let run cfg =
59 Eio_main.run @@ fun env ->
60 Eio.Switch.run @@ fun sw ->
61 let client = Jmap_eio.Cli.create_client ~sw env cfg in
62 let session = Jmap_eio.Client.session client in
63
64 Fmt.pr "@[<v>%a@," Fmt.(styled `Bold string) "Session Information:";
65 Fmt.pr " Username: %a@," Fmt.(styled `Green string) session.username;
66 Fmt.pr " State: %s@," session.state;
67 Fmt.pr " API URL: %s@," session.api_url;
68 Fmt.pr " Upload URL: %s@," session.upload_url;
69 Fmt.pr " Download URL: %s@," session.download_url;
70 Fmt.pr "@, %a@," Fmt.(styled `Bold string) "Capabilities:";
71 List.iter (fun (cap, _) ->
72 Fmt.pr " %s@," cap
73 ) session.capabilities;
74 Fmt.pr "@, %a@," Fmt.(styled `Bold string) "Accounts:";
75 List.iter (fun (id, acct) ->
76 let acct : Jmap.Proto.Session.Account.t = acct in
77 Fmt.pr " %a: %s (personal=%b, read_only=%b)@,"
78 Fmt.(styled `Cyan string) (Jmap.Proto.Id.to_string id)
79 acct.name acct.is_personal acct.is_read_only
80 ) session.accounts;
81 Fmt.pr "@, %a@," Fmt.(styled `Bold string) "Primary Accounts:";
82 List.iter (fun (cap, id) ->
83 Fmt.pr " %s: %s@," cap (Jmap.Proto.Id.to_string id)
84 ) session.primary_accounts;
85 Fmt.pr "@]@."
86 in
87 let doc = "Show JMAP session information" in
88 let info = Cmd.info "session" ~doc in
89 Cmd.v info Term.(const run $ Jmap_eio.Cli.config_term)
90
91(** {1 Mailboxes Command} *)
92
93let mailboxes_cmd =
94 let run cfg =
95 Eio_main.run @@ fun env ->
96 Eio.Switch.run @@ fun sw ->
97 let client = Jmap_eio.Cli.create_client ~sw env cfg in
98 let account_id = Jmap_eio.Cli.get_account_id cfg client in
99
100 Jmap_eio.Cli.debug cfg "Fetching mailboxes for account %s" (Jmap.Proto.Id.to_string account_id);
101
102 let req = Jmap_eio.Client.Build.(
103 make_request
104 ~capabilities:[Jmap.Proto.Capability.core; Jmap.Proto.Capability.mail]
105 [mailbox_get ~call_id:"m1" ~account_id ()]
106 ) in
107
108 match Jmap_eio.Client.request client req with
109 | Error e ->
110 Fmt.epr "Error: %s@." (Jmap_eio.Client.error_to_string e);
111 exit 1
112 | Ok response ->
113 match Jmap_eio.Client.Parse.parse_mailbox_get ~call_id:"m1" response with
114 | Error e ->
115 Fmt.epr "Parse error: %s@." (Jsont.Error.to_string e);
116 exit 1
117 | Ok result ->
118 Fmt.pr "@[<v>%a (state: %s)@,@,"
119 Fmt.(styled `Bold string) "Mailboxes"
120 result.state;
121 (* Sort by sort_order then name *)
122 let sorted = List.sort (fun (a : Jmap.Proto.Mailbox.t) (b : Jmap.Proto.Mailbox.t) ->
123 let sort_a = Option.value ~default:0L a.sort_order in
124 let sort_b = Option.value ~default:0L b.sort_order in
125 let cmp = Int64.compare sort_a sort_b in
126 let name_a = Option.value ~default:"" a.name in
127 let name_b = Option.value ~default:"" b.name in
128 if cmp <> 0 then cmp else String.compare name_a name_b
129 ) result.list in
130 List.iter (fun (mbox : Jmap.Proto.Mailbox.t) ->
131 let role_str = match mbox.role with
132 | Some role -> Printf.sprintf " [%s]" (Jmap.Proto.Mailbox.role_to_string role)
133 | None -> ""
134 in
135 let id_str = match mbox.id with
136 | Some id -> Jmap.Proto.Id.to_string id
137 | None -> "?"
138 in
139 let name = Option.value ~default:"(unnamed)" mbox.name in
140 let total = Option.value ~default:0L mbox.total_emails in
141 let unread = Option.value ~default:0L mbox.unread_emails in
142 Fmt.pr " %a %s%a (%Ld total, %Ld unread)@,"
143 Fmt.(styled `Cyan string) id_str
144 name
145 Fmt.(styled `Yellow string) role_str
146 total unread
147 ) sorted;
148 Fmt.pr "@]@."
149 in
150 let doc = "List mailboxes" in
151 let info = Cmd.info "mailboxes" ~doc in
152 Cmd.v info Term.(const run $ Jmap_eio.Cli.config_term)
153
154(** {1 Emails Command} *)
155
156let emails_cmd =
157 let limit_term =
158 let doc = "Maximum number of emails to list" in
159 Arg.(value & opt int 20 & info ["limit"; "n"] ~docv:"N" ~doc)
160 in
161 let mailbox_term =
162 let doc = "Mailbox ID to filter by" in
163 Arg.(value & opt (some string) None & info ["mailbox"; "m"] ~docv:"ID" ~doc)
164 in
165 let run cfg limit mailbox_id_str =
166 Eio_main.run @@ fun env ->
167 Eio.Switch.run @@ fun sw ->
168 let client = Jmap_eio.Cli.create_client ~sw env cfg in
169 let account_id = Jmap_eio.Cli.get_account_id cfg client in
170
171 Jmap_eio.Cli.debug cfg "Querying emails with limit %d" limit;
172
173 (* Build filter if mailbox specified *)
174 let filter = match mailbox_id_str with
175 | Some id_str ->
176 let mailbox_id = Jmap.Proto.Id.of_string_exn id_str in
177 let cond : Jmap.Proto.Email.Filter_condition.t = {
178 in_mailbox = Some mailbox_id;
179 in_mailbox_other_than = None;
180 before = None; after = None;
181 min_size = None; max_size = None;
182 all_in_thread_have_keyword = None;
183 some_in_thread_have_keyword = None;
184 none_in_thread_have_keyword = None;
185 has_keyword = None; not_keyword = None;
186 has_attachment = None;
187 text = None; from = None; to_ = None;
188 cc = None; bcc = None; subject = None;
189 body = None; header = None;
190 } in
191 Some (Jmap.Proto.Filter.Condition cond)
192 | None -> None
193 in
194
195 let sort = [Jmap.Proto.Filter.comparator ~is_ascending:false "receivedAt"] in
196 let query_inv = Jmap_eio.Client.Build.email_query
197 ~call_id:"q1"
198 ~account_id
199 ?filter
200 ~sort
201 ~limit:(Int64.of_int limit)
202 ()
203 in
204
205 let req = Jmap_eio.Client.Build.(
206 make_request
207 ~capabilities:[Jmap.Proto.Capability.core; Jmap.Proto.Capability.mail]
208 [query_inv]
209 ) in
210
211 match Jmap_eio.Client.request client req with
212 | Error e ->
213 Fmt.epr "Error: %s@." (Jmap_eio.Client.error_to_string e);
214 exit 1
215 | Ok response ->
216 match Jmap_eio.Client.Parse.parse_email_query ~call_id:"q1" response with
217 | Error e ->
218 Fmt.epr "Parse error: %s@." (Jsont.Error.to_string e);
219 exit 1
220 | Ok query_result ->
221 let email_ids = query_result.ids in
222 Jmap_eio.Cli.debug cfg "Found %d email IDs" (List.length email_ids);
223
224 if List.length email_ids = 0 then (
225 Fmt.pr "No emails found.@.";
226 ) else (
227 (* Fetch email details *)
228 let get_inv = Jmap_eio.Client.Build.email_get
229 ~call_id:"g1"
230 ~account_id
231 ~ids:email_ids
232 ~properties:["id"; "blobId"; "threadId"; "mailboxIds"; "keywords";
233 "size"; "receivedAt"; "subject"; "from"; "preview"]
234 ()
235 in
236 let req2 = Jmap_eio.Client.Build.(
237 make_request
238 ~capabilities:[Jmap.Proto.Capability.core; Jmap.Proto.Capability.mail]
239 [get_inv]
240 ) in
241
242 match Jmap_eio.Client.request client req2 with
243 | Error e ->
244 Fmt.epr "Error: %s@." (Jmap_eio.Client.error_to_string e);
245 exit 1
246 | Ok response2 ->
247 match Jmap_eio.Client.Parse.parse_email_get ~call_id:"g1" response2 with
248 | Error e ->
249 Fmt.epr "Parse error: %s@." (Jsont.Error.to_string e);
250 exit 1
251 | Ok get_result ->
252 Fmt.pr "@[<v>%a (showing %d of %s)@,@,"
253 Fmt.(styled `Bold string) "Emails"
254 (List.length get_result.list)
255 (match query_result.total with
256 | Some n -> Int64.to_string n
257 | None -> "?");
258 List.iter (fun (email : Jmap.Proto.Email.t) ->
259 let from_str = match email.from with
260 | Some addrs -> format_email_addresses addrs
261 | None -> "(unknown)"
262 in
263 let subject = Option.value email.subject ~default:"(no subject)" in
264 let keywords = Option.value ~default:[] email.keywords in
265 let flags = format_keywords keywords in
266 let flag_str = if flags = "" then "" else " [" ^ flags ^ "]" in
267 let id_str = match email.id with
268 | Some id -> Jmap.Proto.Id.to_string id
269 | None -> "?"
270 in
271 let received = match email.received_at with
272 | Some t -> ptime_to_string t
273 | None -> "?"
274 in
275 let preview = Option.value ~default:"" email.preview in
276 Fmt.pr " %a %s@,"
277 Fmt.(styled `Cyan string) id_str
278 received;
279 Fmt.pr " From: %s@," (truncate_string 60 from_str);
280 Fmt.pr " Subject: %a%s@,"
281 Fmt.(styled `White string) (truncate_string 60 subject)
282 flag_str;
283 Fmt.pr " Preview: %s@,@,"
284 (truncate_string 70 preview);
285 ) get_result.list;
286 Fmt.pr "@]@."
287 )
288 in
289 let doc = "List emails" in
290 let info = Cmd.info "emails" ~doc in
291 Cmd.v info Term.(const run $ Jmap_eio.Cli.config_term $ limit_term $ mailbox_term)
292
293(** {1 Search Command} *)
294
295let search_cmd =
296 let query_term =
297 let doc = "Search query text" in
298 Arg.(required & pos 0 (some string) None & info [] ~docv:"QUERY" ~doc)
299 in
300 let limit_term =
301 let doc = "Maximum number of results" in
302 Arg.(value & opt int 20 & info ["limit"; "n"] ~docv:"N" ~doc)
303 in
304 let run cfg query limit =
305 Eio_main.run @@ fun env ->
306 Eio.Switch.run @@ fun sw ->
307 let client = Jmap_eio.Cli.create_client ~sw env cfg in
308 let account_id = Jmap_eio.Cli.get_account_id cfg client in
309
310 Jmap_eio.Cli.debug cfg "Searching for: %s" query;
311
312 (* Build text filter *)
313 let cond : Jmap.Proto.Email.Filter_condition.t = {
314 in_mailbox = None; in_mailbox_other_than = None;
315 before = None; after = None;
316 min_size = None; max_size = None;
317 all_in_thread_have_keyword = None;
318 some_in_thread_have_keyword = None;
319 none_in_thread_have_keyword = None;
320 has_keyword = None; not_keyword = None;
321 has_attachment = None;
322 text = Some query;
323 from = None; to_ = None;
324 cc = None; bcc = None; subject = None;
325 body = None; header = None;
326 } in
327 let filter = Jmap.Proto.Filter.Condition cond in
328
329 let sort = [Jmap.Proto.Filter.comparator ~is_ascending:false "receivedAt"] in
330 let query_inv = Jmap_eio.Client.Build.email_query
331 ~call_id:"q1"
332 ~account_id
333 ~filter
334 ~sort
335 ~limit:(Int64.of_int limit)
336 ()
337 in
338
339 let req = Jmap_eio.Client.Build.(
340 make_request
341 ~capabilities:[Jmap.Proto.Capability.core; Jmap.Proto.Capability.mail]
342 [query_inv]
343 ) in
344
345 match Jmap_eio.Client.request client req with
346 | Error e ->
347 Fmt.epr "Error: %s@." (Jmap_eio.Client.error_to_string e);
348 exit 1
349 | Ok response ->
350 match Jmap_eio.Client.Parse.parse_email_query ~call_id:"q1" response with
351 | Error e ->
352 Fmt.epr "Parse error: %s@." (Jsont.Error.to_string e);
353 exit 1
354 | Ok query_result ->
355 let email_ids = query_result.ids in
356
357 if List.length email_ids = 0 then (
358 Fmt.pr "No emails found matching: %s@." query;
359 ) else (
360 (* Fetch email details *)
361 let get_inv = Jmap_eio.Client.Build.email_get
362 ~call_id:"g1"
363 ~account_id
364 ~ids:email_ids
365 ~properties:["id"; "blobId"; "threadId"; "mailboxIds"; "keywords";
366 "size"; "receivedAt"; "subject"; "from"; "preview"]
367 ()
368 in
369 let req2 = Jmap_eio.Client.Build.(
370 make_request
371 ~capabilities:[Jmap.Proto.Capability.core; Jmap.Proto.Capability.mail]
372 [get_inv]
373 ) in
374
375 match Jmap_eio.Client.request client req2 with
376 | Error e ->
377 Fmt.epr "Error: %s@." (Jmap_eio.Client.error_to_string e);
378 exit 1
379 | Ok response2 ->
380 match Jmap_eio.Client.Parse.parse_email_get ~call_id:"g1" response2 with
381 | Error e ->
382 Fmt.epr "Parse error: %s@." (Jsont.Error.to_string e);
383 exit 1
384 | Ok get_result ->
385 Fmt.pr "@[<v>%a for \"%s\" (%d results)@,@,"
386 Fmt.(styled `Bold string) "Search results"
387 query
388 (List.length get_result.list);
389 List.iter (fun (email : Jmap.Proto.Email.t) ->
390 let from_str = match email.from with
391 | Some addrs -> format_email_addresses addrs
392 | None -> "(unknown)"
393 in
394 let subject = Option.value email.subject ~default:"(no subject)" in
395 let id_str = match email.id with
396 | Some id -> Jmap.Proto.Id.to_string id
397 | None -> "?"
398 in
399 let received = match email.received_at with
400 | Some t -> ptime_to_string t
401 | None -> "?"
402 in
403 let preview = Option.value ~default:"" email.preview in
404 Fmt.pr " %a %s@,"
405 Fmt.(styled `Cyan string) id_str
406 received;
407 Fmt.pr " From: %s@," (truncate_string 60 from_str);
408 Fmt.pr " Subject: %a@,"
409 Fmt.(styled `White string) (truncate_string 60 subject);
410 Fmt.pr " Preview: %s@,@,"
411 (truncate_string 70 preview);
412 ) get_result.list;
413 Fmt.pr "@]@."
414 )
415 in
416 let doc = "Search emails by text" in
417 let info = Cmd.info "search" ~doc in
418 Cmd.v info Term.(const run $ Jmap_eio.Cli.config_term $ query_term $ limit_term)
419
420(** {1 Recent Command - chains query + get for detailed listing} *)
421
422let recent_cmd =
423 let limit_term =
424 let doc = "Number of recent emails to show (max 100)" in
425 Arg.(value & opt int 100 & info ["limit"; "n"] ~docv:"N" ~doc)
426 in
427 let format_term =
428 let doc = "Output format: table, compact, or detailed" in
429 Arg.(value & opt (enum ["table", `Table; "compact", `Compact; "detailed", `Detailed])
430 `Table & info ["format"; "f"] ~docv:"FORMAT" ~doc)
431 in
432 let run cfg limit format =
433 let limit = min limit 100 in
434 Eio_main.run @@ fun env ->
435 Eio.Switch.run @@ fun sw ->
436 let client = Jmap_eio.Cli.create_client ~sw env cfg in
437 let account_id = Jmap_eio.Cli.get_account_id cfg client in
438
439 Jmap_eio.Cli.debug cfg "Fetching %d most recent emails" limit;
440
441 (* Query for recent emails *)
442 let sort = [Jmap.Proto.Filter.comparator ~is_ascending:false "receivedAt"] in
443 let query_inv = Jmap_eio.Client.Build.email_query
444 ~call_id:"q1"
445 ~account_id
446 ~sort
447 ~limit:(Int64.of_int limit)
448 ()
449 in
450
451 let req = Jmap_eio.Client.Build.(
452 make_request
453 ~capabilities:[Jmap.Proto.Capability.core; Jmap.Proto.Capability.mail]
454 [query_inv]
455 ) in
456
457 match Jmap_eio.Client.request client req with
458 | Error e ->
459 Fmt.epr "Error: %s@." (Jmap_eio.Client.error_to_string e);
460 exit 1
461 | Ok response ->
462 match Jmap_eio.Client.Parse.parse_email_query ~call_id:"q1" response with
463 | Error e ->
464 Fmt.epr "Parse error: %s@." (Jsont.Error.to_string e);
465 exit 1
466 | Ok query_result ->
467 let email_ids = query_result.ids in
468 Jmap_eio.Cli.debug cfg "Query returned %d email IDs" (List.length email_ids);
469
470 if List.length email_ids = 0 then (
471 Fmt.pr "No emails found.@."
472 ) else (
473 (* Fetch full details for all emails *)
474 let properties = [
475 "id"; "blobId"; "threadId"; "mailboxIds"; "keywords"; "size";
476 "receivedAt"; "subject"; "from"; "to"; "cc"; "preview"
477 ] in
478 let get_inv = Jmap_eio.Client.Build.email_get
479 ~call_id:"g1"
480 ~account_id
481 ~ids:email_ids
482 ~properties
483 ()
484 in
485 let req2 = Jmap_eio.Client.Build.(
486 make_request
487 ~capabilities:[Jmap.Proto.Capability.core; Jmap.Proto.Capability.mail]
488 [get_inv]
489 ) in
490
491 Jmap_eio.Cli.debug cfg "Fetching email details...";
492
493 match Jmap_eio.Client.request client req2 with
494 | Error e ->
495 Fmt.epr "Error: %s@." (Jmap_eio.Client.error_to_string e);
496 exit 1
497 | Ok response2 ->
498 match Jmap_eio.Client.Parse.parse_email_get ~call_id:"g1" response2 with
499 | Error e ->
500 Fmt.epr "Parse error: %s@." (Jsont.Error.to_string e);
501 exit 1
502 | Ok get_result ->
503 Jmap_eio.Cli.debug cfg "Got %d emails" (List.length get_result.list);
504
505 (* Output based on format *)
506 match format with
507 | `Compact ->
508 List.iter (fun (email : Jmap.Proto.Email.t) ->
509 let from_str = match email.from with
510 | Some (addr :: _) ->
511 Option.value addr.name ~default:addr.email
512 | _ -> "?"
513 in
514 let subject = Option.value email.subject ~default:"(no subject)" in
515 let flags = format_keywords (email_keywords email) in
516 Printf.printf "%s\t%s\t%s\t%s\t%s\n"
517 (email_id email)
518 (email_received_at email)
519 (truncate_string 20 from_str)
520 (truncate_string 50 subject)
521 flags
522 ) get_result.list
523
524 | `Table ->
525 Fmt.pr "@[<v>%a (%d emails, state: %s)@,@,"
526 Fmt.(styled `Bold string) "Recent Emails"
527 (List.length get_result.list)
528 get_result.state;
529 (* Header *)
530 Fmt.pr "%-12s %-19s %-20s %-40s %s@,"
531 "ID" "Date" "From" "Subject" "Flags";
532 Fmt.pr "%s@," (String.make 110 '-');
533 List.iter (fun (email : Jmap.Proto.Email.t) ->
534 let from_str = match email.from with
535 | Some (addr :: _) ->
536 Option.value addr.name ~default:addr.email
537 | _ -> "?"
538 in
539 let subject = Option.value email.subject ~default:"(no subject)" in
540 let flags = format_keywords (email_keywords email) in
541 let id_short =
542 let id = email_id email in
543 if String.length id > 12 then String.sub id 0 12 else id
544 in
545 Fmt.pr "%-12s %s %-20s %-40s %s@,"
546 id_short
547 (email_received_at email)
548 (truncate_string 20 from_str)
549 (truncate_string 40 subject)
550 flags
551 ) get_result.list;
552 Fmt.pr "@]@."
553
554 | `Detailed ->
555 Fmt.pr "@[<v>%a (%d emails)@,@,"
556 Fmt.(styled `Bold string) "Recent Emails"
557 (List.length get_result.list);
558 List.iteri (fun i (email : Jmap.Proto.Email.t) ->
559 let from_str = match email.from with
560 | Some addrs -> format_email_addresses addrs
561 | None -> "(unknown)"
562 in
563 let to_str = match email.to_ with
564 | Some addrs -> format_email_addresses addrs
565 | None -> ""
566 in
567 let cc_str = match email.cc with
568 | Some addrs -> format_email_addresses addrs
569 | None -> ""
570 in
571 let subject = Option.value email.subject ~default:"(no subject)" in
572 let flags = format_keywords (email_keywords email) in
573 let mailbox_count = List.length (email_mailbox_ids email) in
574
575 Fmt.pr "@[<v 2>%a Email %d of %d@,"
576 Fmt.(styled `Bold string) "---"
577 (i + 1) (List.length get_result.list);
578 Fmt.pr "ID: %a@,"
579 Fmt.(styled `Cyan string) (email_id email);
580 Fmt.pr "Thread: %s@," (email_thread_id email);
581 Fmt.pr "Date: %s@," (email_received_at email);
582 Fmt.pr "From: %s@," from_str;
583 if to_str <> "" then Fmt.pr "To: %s@," to_str;
584 if cc_str <> "" then Fmt.pr "Cc: %s@," cc_str;
585 Fmt.pr "Subject: %a@,"
586 Fmt.(styled `White string) subject;
587 Fmt.pr "Size: %Ld bytes@," (email_size email);
588 Fmt.pr "Mailboxes: %d@," mailbox_count;
589 if flags <> "" then Fmt.pr "Flags: %s@," flags;
590 Fmt.pr "Preview: %s@]@,@," (email_preview email);
591 ) get_result.list;
592 Fmt.pr "@]@."
593 )
594 in
595 let doc = "List recent emails with full details (chains query + get)" in
596 let info = Cmd.info "recent" ~doc in
597 Cmd.v info Term.(const run $ Jmap_eio.Cli.config_term $ limit_term $ format_term)
598
599(** {1 Threads Command} *)
600
601let threads_cmd =
602 let email_id_term =
603 let doc = "Email ID to get thread for" in
604 Arg.(required & pos 0 (some string) None & info [] ~docv:"EMAIL_ID" ~doc)
605 in
606 let run cfg email_id_str =
607 Eio_main.run @@ fun env ->
608 Eio.Switch.run @@ fun sw ->
609 let client = Jmap_eio.Cli.create_client ~sw env cfg in
610 let account_id = Jmap_eio.Cli.get_account_id cfg client in
611
612 let target_email_id = Jmap.Proto.Id.of_string_exn email_id_str in
613
614 (* First get the email to find its thread ID - include required properties *)
615 let get_inv = Jmap_eio.Client.Build.email_get
616 ~call_id:"e1"
617 ~account_id
618 ~ids:[target_email_id]
619 ~properties:["id"; "blobId"; "threadId"; "mailboxIds"; "size"; "receivedAt"]
620 ()
621 in
622 let req = Jmap_eio.Client.Build.(
623 make_request
624 ~capabilities:[Jmap.Proto.Capability.core; Jmap.Proto.Capability.mail]
625 [get_inv]
626 ) in
627
628 match Jmap_eio.Client.request client req with
629 | Error e ->
630 Fmt.epr "Error: %s@." (Jmap_eio.Client.error_to_string e);
631 exit 1
632 | Ok response ->
633 match Jmap_eio.Client.Parse.parse_email_get ~call_id:"e1" response with
634 | Error e ->
635 Fmt.epr "Parse error: %s@." (Jsont.Error.to_string e);
636 exit 1
637 | Ok email_result ->
638 match email_result.list with
639 | [] ->
640 Fmt.epr "Email not found: %s@." email_id_str;
641 exit 1
642 | email :: _ ->
643 let thread_id = match email.thread_id with
644 | Some id -> id
645 | None ->
646 Fmt.epr "Email has no thread ID@.";
647 exit 1
648 in
649 Jmap_eio.Cli.debug cfg "Thread ID: %s" (Jmap.Proto.Id.to_string thread_id);
650
651 (* Get the thread *)
652 let thread_inv = Jmap_eio.Client.Build.thread_get
653 ~call_id:"t1"
654 ~account_id
655 ~ids:[thread_id]
656 ()
657 in
658 let req2 = Jmap_eio.Client.Build.(
659 make_request
660 ~capabilities:[Jmap.Proto.Capability.core; Jmap.Proto.Capability.mail]
661 [thread_inv]
662 ) in
663
664 match Jmap_eio.Client.request client req2 with
665 | Error e ->
666 Fmt.epr "Error: %s@." (Jmap_eio.Client.error_to_string e);
667 exit 1
668 | Ok response2 ->
669 match Jmap_eio.Client.Parse.parse_thread_get ~call_id:"t1" response2 with
670 | Error e ->
671 Fmt.epr "Parse error: %s@." (Jsont.Error.to_string e);
672 exit 1
673 | Ok thread_result ->
674 match thread_result.list with
675 | [] ->
676 Fmt.epr "Thread not found@.";
677 exit 1
678 | thread :: _ ->
679 let thread_id_str = match thread.id with
680 | Some id -> Jmap.Proto.Id.to_string id
681 | None -> "?"
682 in
683 let email_ids = Option.value ~default:[] thread.email_ids in
684 Fmt.pr "@[<v>%a %s (%d emails)@,@,"
685 Fmt.(styled `Bold string) "Thread"
686 thread_id_str
687 (List.length email_ids);
688
689 (* Fetch all emails in thread *)
690 let get_inv2 = Jmap_eio.Client.Build.email_get
691 ~call_id:"e2"
692 ~account_id
693 ~ids:email_ids
694 ~properties:["id"; "blobId"; "threadId"; "mailboxIds"; "keywords";
695 "size"; "receivedAt"; "subject"; "from"; "preview"]
696 ()
697 in
698 let req3 = Jmap_eio.Client.Build.(
699 make_request
700 ~capabilities:[Jmap.Proto.Capability.core; Jmap.Proto.Capability.mail]
701 [get_inv2]
702 ) in
703
704 match Jmap_eio.Client.request client req3 with
705 | Error e ->
706 Fmt.epr "Error: %s@." (Jmap_eio.Client.error_to_string e);
707 exit 1
708 | Ok response3 ->
709 match Jmap_eio.Client.Parse.parse_email_get ~call_id:"e2" response3 with
710 | Error e ->
711 Fmt.epr "Parse error: %s@." (Jsont.Error.to_string e);
712 exit 1
713 | Ok emails_result ->
714 List.iter (fun (email : Jmap.Proto.Email.t) ->
715 let from_str = match email.from with
716 | Some addrs -> format_email_addresses addrs
717 | None -> "(unknown)"
718 in
719 let subject = Option.value email.subject ~default:"(no subject)" in
720 Fmt.pr " %a %s@,"
721 Fmt.(styled `Cyan string) (email_id email)
722 (email_received_at email);
723 Fmt.pr " From: %s@," (truncate_string 60 from_str);
724 Fmt.pr " Subject: %a@,@,"
725 Fmt.(styled `White string) (truncate_string 60 subject);
726 ) emails_result.list;
727 Fmt.pr "@]@."
728 in
729 let doc = "Show email thread" in
730 let info = Cmd.info "thread" ~doc in
731 Cmd.v info Term.(const run $ Jmap_eio.Cli.config_term $ email_id_term)
732
733(** {1 Identities Command} *)
734
735let identities_cmd =
736 let run cfg =
737 Eio_main.run @@ fun env ->
738 Eio.Switch.run @@ fun sw ->
739 let client = Jmap_eio.Cli.create_client ~sw env cfg in
740 let account_id = Jmap_eio.Cli.get_account_id cfg client in
741
742 let req = Jmap_eio.Client.Build.(
743 make_request
744 ~capabilities:[Jmap.Proto.Capability.core; Jmap.Proto.Capability.mail;
745 Jmap.Proto.Capability.submission]
746 [identity_get ~call_id:"i1" ~account_id ()]
747 ) in
748
749 match Jmap_eio.Client.request client req with
750 | Error e ->
751 Fmt.epr "Error: %s@." (Jmap_eio.Client.error_to_string e);
752 exit 1
753 | Ok response ->
754 match Jmap_eio.Client.Parse.parse_response ~call_id:"i1"
755 (Jmap_eio.Client.Parse.get_response Jmap.Proto.Identity.jsont)
756 response with
757 | Error e ->
758 Fmt.epr "Parse error: %s@." (Jsont.Error.to_string e);
759 exit 1
760 | Ok result ->
761 Fmt.pr "@[<v>%a (state: %s)@,@,"
762 Fmt.(styled `Bold string) "Identities"
763 result.state;
764 List.iter (fun (ident : Jmap.Proto.Identity.t) ->
765 let ident_id = match ident.id with Some id -> Jmap.Proto.Id.to_string id | None -> "?" in
766 let ident_name = Option.value ~default:"(unnamed)" ident.name in
767 let ident_email = Option.value ~default:"(no email)" ident.email in
768 let ident_sig = Option.value ~default:"" ident.text_signature in
769 let ident_may_delete = Option.value ~default:false ident.may_delete in
770 Fmt.pr " %a@,"
771 Fmt.(styled `Cyan string) ident_id;
772 Fmt.pr " Name: %s@," ident_name;
773 Fmt.pr " Email: %a@,"
774 Fmt.(styled `Green string) ident_email;
775 if ident_sig <> "" then
776 Fmt.pr " Signature: %s@," (truncate_string 50 ident_sig);
777 Fmt.pr " May delete: %b@,@," ident_may_delete
778 ) result.list;
779 Fmt.pr "@]@."
780 in
781 let doc = "List email identities" in
782 let info = Cmd.info "identities" ~doc in
783 Cmd.v info Term.(const run $ Jmap_eio.Cli.config_term)
784
785(** {1 Chained Commands - Using the Chain monad} *)
786
787(** Inbox command - demonstrates simple query+get chain *)
788let inbox_cmd =
789 let limit_term =
790 let doc = "Maximum number of emails to show" in
791 Arg.(value & opt int 20 & info ["limit"; "n"] ~docv:"N" ~doc)
792 in
793 let run cfg limit =
794 Eio_main.run @@ fun env ->
795 Eio.Switch.run @@ fun sw ->
796 let client = Jmap_eio.Cli.create_client ~sw env cfg in
797 let account_id = Jmap_eio.Cli.get_account_id cfg client in
798
799 Jmap_eio.Cli.debug cfg "Fetching inbox emails using Chain API";
800
801 (* Find inbox mailbox first *)
802 let mbox_req = Jmap_eio.Client.Build.(
803 make_request
804 ~capabilities:[Jmap.Proto.Capability.core; Jmap.Proto.Capability.mail]
805 [mailbox_get ~call_id:"m1" ~account_id ()]
806 ) in
807
808 match Jmap_eio.Client.request client mbox_req with
809 | Error e ->
810 Fmt.epr "Error: %s@." (Jmap_eio.Client.error_to_string e);
811 exit 1
812 | Ok mbox_response ->
813 match Jmap_eio.Client.Parse.parse_mailbox_get ~call_id:"m1" mbox_response with
814 | Error e ->
815 Fmt.epr "Parse error: %s@." (Jsont.Error.to_string e);
816 exit 1
817 | Ok mbox_result ->
818 (* Find inbox *)
819 let inbox =
820 List.find_opt (fun (m : Jmap.Proto.Mailbox.t) ->
821 m.role = Some `Inbox
822 ) mbox_result.list
823 in
824 match inbox with
825 | None ->
826 Fmt.epr "No inbox found@.";
827 exit 1
828 | Some inbox ->
829 let inbox_id = match inbox.id with
830 | Some id -> id
831 | None ->
832 Fmt.epr "Inbox has no ID@.";
833 exit 1
834 in
835 Jmap_eio.Cli.debug cfg "Found inbox: %s" (Jmap.Proto.Id.to_string inbox_id);
836
837 (* Now use Chain API to query and get emails in one request *)
838 let open Jmap_eio.Chain in
839 let filter_cond : Jmap.Proto.Email.Filter_condition.t = {
840 in_mailbox = Some inbox_id;
841 in_mailbox_other_than = None;
842 before = None; after = None;
843 min_size = None; max_size = None;
844 all_in_thread_have_keyword = None;
845 some_in_thread_have_keyword = None;
846 none_in_thread_have_keyword = None;
847 has_keyword = None; not_keyword = None;
848 has_attachment = None;
849 text = None; from = None; to_ = None;
850 cc = None; bcc = None; subject = None;
851 body = None; header = None;
852 } in
853 let sort = [Jmap.Proto.Filter.comparator ~is_ascending:false "receivedAt"] in
854
855 let request, email_handle = build
856 ~capabilities:[Jmap.Proto.Capability.core; Jmap.Proto.Capability.mail]
857 begin
858 let* query = email_query ~account_id
859 ~filter:(Jmap.Proto.Filter.Condition filter_cond)
860 ~sort
861 ~limit:(Int64.of_int limit)
862 ()
863 in
864 let* emails = email_get ~account_id
865 ~ids:(from_query query)
866 ~properties:["id"; "blobId"; "threadId"; "mailboxIds"; "size"; "receivedAt"; "subject"; "from"; "preview"; "keywords"]
867 ()
868 in
869 return emails
870 end in
871
872 Jmap_eio.Cli.debug cfg "Sending chained request (query + get in one round trip)";
873
874 match Jmap_eio.Client.request client request with
875 | Error e ->
876 Fmt.epr "Error: %s@." (Jmap_eio.Client.error_to_string e);
877 exit 1
878 | Ok response ->
879 match parse email_handle response with
880 | Error e ->
881 Fmt.epr "Parse error: %s@." (Jsont.Error.to_string e);
882 exit 1
883 | Ok result ->
884 Fmt.pr "@[<v>%a (%d emails in inbox)@,@,"
885 Fmt.(styled `Bold string) "Inbox"
886 (List.length result.list);
887 List.iter (fun (email : Jmap.Proto.Email.t) ->
888 let from_str = match email.from with
889 | Some (addr :: _) ->
890 Option.value addr.name ~default:addr.email
891 | _ -> "?"
892 in
893 let subject = Option.value email.subject ~default:"(no subject)" in
894 let flags = format_keywords (email_keywords email) in
895 Fmt.pr " %a %s@,"
896 Fmt.(styled `Cyan string) (email_id email)
897 (email_received_at email);
898 Fmt.pr " From: %s@," (truncate_string 40 from_str);
899 Fmt.pr " Subject: %a%s@,"
900 Fmt.(styled `White string) (truncate_string 50 subject)
901 (if flags = "" then "" else " [" ^ flags ^ "]");
902 Fmt.pr "@,"
903 ) result.list;
904 Fmt.pr "@]@."
905 in
906 let doc = "List inbox emails (uses Chain API for query+get in single request)" in
907 let info = Cmd.info "inbox" ~doc in
908 Cmd.v info Term.(const run $ Jmap_eio.Cli.config_term $ limit_term)
909
910(** Thread-view command - demonstrates multi-step chaining (RFC 8620 example) *)
911let thread_view_cmd =
912 let limit_term =
913 let doc = "Number of threads to show" in
914 Arg.(value & opt int 10 & info ["limit"; "n"] ~docv:"N" ~doc)
915 in
916 let run cfg limit =
917 Eio_main.run @@ fun env ->
918 Eio.Switch.run @@ fun sw ->
919 let client = Jmap_eio.Cli.create_client ~sw env cfg in
920 let account_id = Jmap_eio.Cli.get_account_id cfg client in
921
922 Jmap_eio.Cli.debug cfg "Fetching threaded view using multi-step Chain API";
923
924 (*
925 This implements the RFC 8620 example:
926 1. Email/query with collapseThreads to get one email per thread
927 2. Email/get to fetch threadId for each
928 3. Thread/get to fetch all emailIds in each thread
929 4. Email/get to fetch details for all emails in those threads
930 *)
931 let open Jmap_eio.Chain in
932 let sort = [Jmap.Proto.Filter.comparator ~is_ascending:false "receivedAt"] in
933
934 let request, (query_h, final_emails_h) = build
935 ~capabilities:[Jmap.Proto.Capability.core; Jmap.Proto.Capability.mail]
936 begin
937 (* Step 1: Query for recent emails, collapsing threads *)
938 let* query = email_query ~account_id
939 ~sort
940 ~collapse_threads:true
941 ~limit:(Int64.of_int limit)
942 ()
943 in
944 (* Step 2: Get just threadId for those emails *)
945 let* emails1 = email_get ~account_id
946 ~ids:(from_query query)
947 ~properties:["id"; "blobId"; "threadId"; "mailboxIds"; "size"; "receivedAt"]
948 ()
949 in
950 (* Step 3: Get threads using threadIds from step 2 *)
951 let* threads = thread_get ~account_id
952 ~ids:(from_get_field emails1 "threadId")
953 ()
954 in
955 (* Step 4: Get all emails in those threads *)
956 let* emails2 = email_get ~account_id
957 ~ids:(from_get_field threads "emailIds")
958 ~properties:["id"; "blobId"; "threadId"; "mailboxIds"; "size"; "receivedAt"; "subject"; "from"; "preview"]
959 ()
960 in
961 return (query, emails2)
962 end in
963
964 Jmap_eio.Cli.debug cfg "Sending 4-step chained request in single round trip";
965
966 match Jmap_eio.Client.request client request with
967 | Error e ->
968 Fmt.epr "Error: %s@." (Jmap_eio.Client.error_to_string e);
969 exit 1
970 | Ok response ->
971 let query_result = parse_exn query_h response in
972 let emails_result = parse_exn final_emails_h response in
973
974 (* Group emails by thread *)
975 let threads_map = Hashtbl.create 16 in
976 List.iter (fun (email : Jmap.Proto.Email.t) ->
977 let tid = email_thread_id email in
978 let existing = try Hashtbl.find threads_map tid with Not_found -> [] in
979 Hashtbl.replace threads_map tid (email :: existing)
980 ) emails_result.list;
981
982 Fmt.pr "@[<v>%a (%d threads, %d total emails)@,@,"
983 Fmt.(styled `Bold string) "Threaded View"
984 (Hashtbl.length threads_map)
985 (List.length emails_result.list);
986 Fmt.pr "Query found %s total matching emails@,@,"
987 (match query_result.total with Some n -> Int64.to_string n | None -> "?");
988
989 (* Print threads *)
990 Hashtbl.iter (fun _tid emails ->
991 let emails = List.sort (fun (a : Jmap.Proto.Email.t) (b : Jmap.Proto.Email.t) ->
992 let a_time = Option.value ~default:Ptime.epoch a.received_at in
993 let b_time = Option.value ~default:Ptime.epoch b.received_at in
994 Ptime.compare a_time b_time
995 ) emails in
996 let first_email = List.hd emails in
997 let subject = Option.value first_email.subject ~default:"(no subject)" in
998 Fmt.pr " %a Thread: %s (%d emails)@,"
999 Fmt.(styled `Bold string) "▸"
1000 (truncate_string 50 subject)
1001 (List.length emails);
1002 List.iter (fun (email : Jmap.Proto.Email.t) ->
1003 let from_str = match email.from with
1004 | Some (addr :: _) -> Option.value addr.name ~default:addr.email
1005 | _ -> "?"
1006 in
1007 Fmt.pr " %s %s %s@,"
1008 (email_id email |> truncate_string 12)
1009 (email_received_at email)
1010 (truncate_string 30 from_str)
1011 ) emails;
1012 Fmt.pr "@,"
1013 ) threads_map;
1014 Fmt.pr "@]@."
1015 in
1016 let doc = "Show threaded view (demonstrates RFC 8620 multi-step chain)" in
1017 let info = Cmd.info "thread-view" ~doc in
1018 Cmd.v info Term.(const run $ Jmap_eio.Cli.config_term $ limit_term)
1019
1020(** Mark-read command - demonstrates email_set for updating keywords *)
1021let mark_read_cmd =
1022 let email_id_term =
1023 let doc = "Email ID to mark as read" in
1024 Arg.(required & pos 0 (some string) None & info [] ~docv:"EMAIL_ID" ~doc)
1025 in
1026 let unread_term =
1027 let doc = "Mark as unread instead of read" in
1028 Arg.(value & flag & info ["unread"; "u"] ~doc)
1029 in
1030 let run cfg email_id_str unread =
1031 Eio_main.run @@ fun env ->
1032 Eio.Switch.run @@ fun sw ->
1033 let client = Jmap_eio.Cli.create_client ~sw env cfg in
1034 let account_id = Jmap_eio.Cli.get_account_id cfg client in
1035 let email_id = Jmap.Proto.Id.of_string_exn email_id_str in
1036
1037 Jmap_eio.Cli.debug cfg "%s email %s"
1038 (if unread then "Marking as unread" else "Marking as read")
1039 email_id_str;
1040
1041 (* Build the patch object - set or unset $seen keyword *)
1042 let patch =
1043 let open Jmap_eio.Chain in
1044 if unread then
1045 json_obj [("keywords/$seen", json_null)]
1046 else
1047 json_obj [("keywords/$seen", json_bool true)]
1048 in
1049
1050 let open Jmap_eio.Chain in
1051 let request, set_h = build
1052 ~capabilities:[Jmap.Proto.Capability.core; Jmap.Proto.Capability.mail]
1053 begin
1054 email_set ~account_id
1055 ~update:[(email_id, patch)]
1056 ()
1057 end in
1058
1059 match Jmap_eio.Client.request client request with
1060 | Error e ->
1061 Fmt.epr "Error: %s@." (Jmap_eio.Client.error_to_string e);
1062 exit 1
1063 | Ok response ->
1064 match parse set_h response with
1065 | Error e ->
1066 Fmt.epr "Parse error: %s@." (Jsont.Error.to_string e);
1067 exit 1
1068 | Ok result ->
1069 (* Check if update succeeded *)
1070 let updated_ids =
1071 result.updated
1072 |> Option.value ~default:[]
1073 |> List.map (fun (id, _) -> Jmap.Proto.Id.to_string id)
1074 in
1075 if List.mem email_id_str updated_ids then
1076 Fmt.pr "Email %s marked as %s@."
1077 email_id_str
1078 (if unread then "unread" else "read")
1079 else (
1080 Fmt.epr "Failed to update email. ";
1081 let not_updated = Option.value ~default:[] result.not_updated in
1082 (match List.find_opt (fun (id, _) -> Jmap.Proto.Id.to_string id = email_id_str) not_updated with
1083 | Some (_, err) ->
1084 let open Jmap.Proto.Error in
1085 let err_type = set_error_type_to_string err.type_ in
1086 let err_desc = Option.value ~default:"" err.description in
1087 Fmt.epr "Error: %s (%s)@." err_type err_desc
1088 | None ->
1089 Fmt.epr "Unknown error@.");
1090 exit 1
1091 )
1092 in
1093 let doc = "Mark an email as read/unread (demonstrates Email/set)" in
1094 let info = Cmd.info "mark-read" ~doc in
1095 Cmd.v info Term.(const run $ Jmap_eio.Cli.config_term $ email_id_term $ unread_term)
1096
1097(** Delete email command - demonstrates email_set destroy *)
1098let delete_email_cmd =
1099 let email_ids_term =
1100 let doc = "Email IDs to delete" in
1101 Arg.(non_empty & pos_all string [] & info [] ~docv:"EMAIL_ID" ~doc)
1102 in
1103 let run cfg email_id_strs =
1104 Eio_main.run @@ fun env ->
1105 Eio.Switch.run @@ fun sw ->
1106 let client = Jmap_eio.Cli.create_client ~sw env cfg in
1107 let account_id = Jmap_eio.Cli.get_account_id cfg client in
1108 let email_ids = List.map Jmap.Proto.Id.of_string_exn email_id_strs in
1109
1110 Jmap_eio.Cli.debug cfg "Deleting %d email(s)" (List.length email_ids);
1111
1112 let open Jmap_eio.Chain in
1113 let request, set_h = build
1114 ~capabilities:[Jmap.Proto.Capability.core; Jmap.Proto.Capability.mail]
1115 begin
1116 email_set ~account_id
1117 ~destroy:(ids email_ids)
1118 ()
1119 end in
1120
1121 match Jmap_eio.Client.request client request with
1122 | Error e ->
1123 Fmt.epr "Error: %s@." (Jmap_eio.Client.error_to_string e);
1124 exit 1
1125 | Ok response ->
1126 match parse set_h response with
1127 | Error e ->
1128 Fmt.epr "Parse error: %s@." (Jsont.Error.to_string e);
1129 exit 1
1130 | Ok result ->
1131 let destroyed = Option.value ~default:[] result.destroyed in
1132 let destroyed_ids = List.map Jmap.Proto.Id.to_string destroyed in
1133 Fmt.pr "Deleted %d email(s):@." (List.length destroyed_ids);
1134 List.iter (fun id -> Fmt.pr " %s@." id) destroyed_ids;
1135 (* Report any failures *)
1136 let not_destroyed = Option.value ~default:[] result.not_destroyed in
1137 if not_destroyed <> [] then begin
1138 Fmt.epr "Failed to delete %d email(s):@." (List.length not_destroyed);
1139 List.iter (fun (id, err) ->
1140 let open Jmap.Proto.Error in
1141 let err_type = set_error_type_to_string err.type_ in
1142 Fmt.epr " %s: %s@."
1143 (Jmap.Proto.Id.to_string id)
1144 err_type
1145 ) not_destroyed
1146 end
1147 in
1148 let doc = "Delete emails (demonstrates Email/set destroy)" in
1149 let info = Cmd.info "delete" ~doc in
1150 Cmd.v info Term.(const run $ Jmap_eio.Cli.config_term $ email_ids_term)
1151
1152(** Changes command - demonstrates email_changes for sync *)
1153let changes_cmd =
1154 let state_term =
1155 let doc = "State to get changes since (use 'current' to just show current state)" in
1156 Arg.(required & pos 0 (some string) None & info [] ~docv:"STATE" ~doc)
1157 in
1158 let run cfg state_str =
1159 Eio_main.run @@ fun env ->
1160 Eio.Switch.run @@ fun sw ->
1161 let client = Jmap_eio.Cli.create_client ~sw env cfg in
1162 let account_id = Jmap_eio.Cli.get_account_id cfg client in
1163
1164 if state_str = "current" then (
1165 (* Just get current state by doing a minimal query *)
1166 let open Jmap_eio.Chain in
1167 let request, get_h = build
1168 ~capabilities:[Jmap.Proto.Capability.core; Jmap.Proto.Capability.mail]
1169 begin
1170 (* Get empty list just to see state *)
1171 email_get ~account_id ~ids:(ids []) ()
1172 end in
1173
1174 match Jmap_eio.Client.request client request with
1175 | Error e ->
1176 Fmt.epr "Error: %s@." (Jmap_eio.Client.error_to_string e);
1177 exit 1
1178 | Ok response ->
1179 match parse get_h response with
1180 | Error e ->
1181 Fmt.epr "Parse error: %s@." (Jsont.Error.to_string e);
1182 exit 1
1183 | Ok result ->
1184 Fmt.pr "Current email state: %a@."
1185 Fmt.(styled `Cyan string) result.state
1186 ) else (
1187 Jmap_eio.Cli.debug cfg "Getting changes since state: %s" state_str;
1188
1189 let open Jmap_eio.Chain in
1190 let request, changes_h = build
1191 ~capabilities:[Jmap.Proto.Capability.core; Jmap.Proto.Capability.mail]
1192 begin
1193 email_changes ~account_id ~since_state:state_str ()
1194 end in
1195
1196 match Jmap_eio.Client.request client request with
1197 | Error e ->
1198 Fmt.epr "Error: %s@." (Jmap_eio.Client.error_to_string e);
1199 exit 1
1200 | Ok response ->
1201 match parse changes_h response with
1202 | Error e ->
1203 Fmt.epr "Parse error: %s@." (Jsont.Error.to_string e);
1204 exit 1
1205 | Ok result ->
1206 Fmt.pr "@[<v>%a@,@,"
1207 Fmt.(styled `Bold string) "Email Changes";
1208 Fmt.pr "Old state: %s@," result.old_state;
1209 Fmt.pr "New state: %a@," Fmt.(styled `Cyan string) result.new_state;
1210 Fmt.pr "Has more changes: %b@,@," result.has_more_changes;
1211 Fmt.pr "Created: %d email(s)@," (List.length result.created);
1212 List.iter (fun id ->
1213 Fmt.pr " + %s@," (Jmap.Proto.Id.to_string id)
1214 ) result.created;
1215 Fmt.pr "Updated: %d email(s)@," (List.length result.updated);
1216 List.iter (fun id ->
1217 Fmt.pr " ~ %s@," (Jmap.Proto.Id.to_string id)
1218 ) result.updated;
1219 Fmt.pr "Destroyed: %d email(s)@," (List.length result.destroyed);
1220 List.iter (fun id ->
1221 Fmt.pr " - %s@," (Jmap.Proto.Id.to_string id)
1222 ) result.destroyed;
1223 Fmt.pr "@]@."
1224 )
1225 in
1226 let doc = "Show email changes since a state (demonstrates Email/changes)" in
1227 let info = Cmd.info "changes" ~doc in
1228 Cmd.v info Term.(const run $ Jmap_eio.Cli.config_term $ state_term)
1229
1230(** Sync command - demonstrates changes + get pattern for incremental sync *)
1231let sync_cmd =
1232 let state_term =
1233 let doc = "State to sync from" in
1234 Arg.(required & pos 0 (some string) None & info [] ~docv:"STATE" ~doc)
1235 in
1236 let run cfg state_str =
1237 Eio_main.run @@ fun env ->
1238 Eio.Switch.run @@ fun sw ->
1239 let client = Jmap_eio.Cli.create_client ~sw env cfg in
1240 let account_id = Jmap_eio.Cli.get_account_id cfg client in
1241
1242 Jmap_eio.Cli.debug cfg "Syncing from state: %s" state_str;
1243
1244 (* Chain: changes → get created → get updated *)
1245 let open Jmap_eio.Chain in
1246 let request, (changes_h, created_h, updated_h) = build
1247 ~capabilities:[Jmap.Proto.Capability.core; Jmap.Proto.Capability.mail]
1248 begin
1249 let* changes = email_changes ~account_id ~since_state:state_str () in
1250 let* created = email_get ~account_id
1251 ~ids:(from_changes_created changes)
1252 ~properties:["id"; "blobId"; "threadId"; "mailboxIds"; "size"; "receivedAt"; "subject"; "from"; "preview"]
1253 ()
1254 in
1255 let* updated = email_get ~account_id
1256 ~ids:(from_changes_updated changes)
1257 ~properties:["id"; "blobId"; "threadId"; "mailboxIds"; "size"; "receivedAt"; "subject"; "from"; "keywords"]
1258 ()
1259 in
1260 return (changes, created, updated)
1261 end in
1262
1263 Jmap_eio.Cli.debug cfg "Sending chained sync request";
1264
1265 match Jmap_eio.Client.request client request with
1266 | Error e ->
1267 Fmt.epr "Error: %s@." (Jmap_eio.Client.error_to_string e);
1268 exit 1
1269 | Ok response ->
1270 let changes_result = parse_exn changes_h response in
1271 let created_result = parse_exn created_h response in
1272 let updated_result = parse_exn updated_h response in
1273
1274 Fmt.pr "@[<v>%a (state: %s → %s)@,@,"
1275 Fmt.(styled `Bold string) "Sync Results"
1276 changes_result.old_state
1277 changes_result.new_state;
1278
1279 if List.length created_result.list > 0 then begin
1280 Fmt.pr "%a (%d)@,"
1281 Fmt.(styled `Green string) "New emails"
1282 (List.length created_result.list);
1283 List.iter (fun (email : Jmap.Proto.Email.t) ->
1284 let from_str = match email.from with
1285 | Some (addr :: _) -> Option.value addr.name ~default:addr.email
1286 | _ -> "?"
1287 in
1288 let subject = Option.value email.subject ~default:"(no subject)" in
1289 Fmt.pr " + %s %s %s@,"
1290 (email_id email |> truncate_string 12)
1291 (truncate_string 20 from_str)
1292 (truncate_string 40 subject)
1293 ) created_result.list;
1294 Fmt.pr "@,"
1295 end;
1296
1297 if List.length updated_result.list > 0 then begin
1298 Fmt.pr "%a (%d)@,"
1299 Fmt.(styled `Yellow string) "Updated emails"
1300 (List.length updated_result.list);
1301 List.iter (fun (email : Jmap.Proto.Email.t) ->
1302 let flags = format_keywords (email_keywords email) in
1303 Fmt.pr " ~ %s [%s]@,"
1304 (email_id email |> truncate_string 12)
1305 flags
1306 ) updated_result.list;
1307 Fmt.pr "@,"
1308 end;
1309
1310 if List.length changes_result.destroyed > 0 then begin
1311 Fmt.pr "%a (%d)@,"
1312 Fmt.(styled `Red string) "Deleted emails"
1313 (List.length changes_result.destroyed);
1314 List.iter (fun id ->
1315 Fmt.pr " - %s@," (Jmap.Proto.Id.to_string id)
1316 ) changes_result.destroyed;
1317 Fmt.pr "@,"
1318 end;
1319
1320 if changes_result.has_more_changes then
1321 Fmt.pr "%a - call sync again with state %s@,"
1322 Fmt.(styled `Bold string) "More changes available"
1323 changes_result.new_state;
1324
1325 Fmt.pr "@]@."
1326 in
1327 let doc = "Incremental sync (demonstrates changes + get chain)" in
1328 let info = Cmd.info "sync" ~doc in
1329 Cmd.v info Term.(const run $ Jmap_eio.Cli.config_term $ state_term)
1330
1331(** Headers command - demonstrates RFC 8621 §4.1 header property queries *)
1332let headers_cmd =
1333 let email_id_term =
1334 let doc = "Email ID to get headers for" in
1335 Arg.(required & pos 0 (some string) None & info [] ~docv:"EMAIL_ID" ~doc)
1336 in
1337
1338 (* Format a header value for display *)
1339 let format_header_value = function
1340 | Jmap.Proto.Email_header.String_single None -> "(null)"
1341 | Jmap.Proto.Email_header.String_single (Some s) -> s
1342 | Jmap.Proto.Email_header.String_all [] -> "(empty list)"
1343 | Jmap.Proto.Email_header.String_all strs -> String.concat "; " strs
1344 | Jmap.Proto.Email_header.Addresses_single None -> "(null)"
1345 | Jmap.Proto.Email_header.Addresses_single (Some []) -> "(empty)"
1346 | Jmap.Proto.Email_header.Addresses_single (Some addrs) ->
1347 String.concat ", " (List.map (fun a ->
1348 match a.Jmap.Proto.Email_address.name with
1349 | Some n -> Printf.sprintf "%s <%s>" n a.email
1350 | None -> a.email
1351 ) addrs)
1352 | Jmap.Proto.Email_header.Addresses_all [] -> "(empty list)"
1353 | Jmap.Proto.Email_header.Addresses_all groups ->
1354 String.concat " | " (List.map (fun addrs ->
1355 String.concat ", " (List.map (fun a ->
1356 match a.Jmap.Proto.Email_address.name with
1357 | Some n -> Printf.sprintf "%s <%s>" n a.email
1358 | None -> a.email
1359 ) addrs)
1360 ) groups)
1361 | Jmap.Proto.Email_header.Grouped_single None -> "(null)"
1362 | Jmap.Proto.Email_header.Grouped_single (Some groups) ->
1363 String.concat "; " (List.map (fun g ->
1364 let name = Option.value ~default:"(ungrouped)" g.Jmap.Proto.Email_address.Group.name in
1365 let addrs = String.concat ", " (List.map (fun a ->
1366 match a.Jmap.Proto.Email_address.name with
1367 | Some n -> Printf.sprintf "%s <%s>" n a.email
1368 | None -> a.email
1369 ) g.addresses) in
1370 Printf.sprintf "%s: %s" name addrs
1371 ) groups)
1372 | Jmap.Proto.Email_header.Grouped_all _ -> "(grouped addresses list)"
1373 | Jmap.Proto.Email_header.Date_single None -> "(null)"
1374 | Jmap.Proto.Email_header.Date_single (Some t) -> ptime_to_string t
1375 | Jmap.Proto.Email_header.Date_all [] -> "(empty list)"
1376 | Jmap.Proto.Email_header.Date_all dates ->
1377 String.concat "; " (List.map (function
1378 | None -> "(null)"
1379 | Some t -> ptime_to_string t
1380 ) dates)
1381 | Jmap.Proto.Email_header.Strings_single None -> "(null)"
1382 | Jmap.Proto.Email_header.Strings_single (Some []) -> "(empty)"
1383 | Jmap.Proto.Email_header.Strings_single (Some strs) -> String.concat ", " strs
1384 | Jmap.Proto.Email_header.Strings_all [] -> "(empty list)"
1385 | Jmap.Proto.Email_header.Strings_all groups ->
1386 String.concat " | " (List.map (function
1387 | None -> "(null)"
1388 | Some strs -> String.concat ", " strs
1389 ) groups)
1390 in
1391
1392 let run cfg email_id_str =
1393 Eio_main.run @@ fun env ->
1394 Eio.Switch.run @@ fun sw ->
1395 let client = Jmap_eio.Cli.create_client ~sw env cfg in
1396 let account_id = Jmap_eio.Cli.get_account_id cfg client in
1397 let target_email_id = Jmap.Proto.Id.of_string_exn email_id_str in
1398
1399 Jmap_eio.Cli.debug cfg "Fetching headers for email %s" email_id_str;
1400
1401 (* Demonstrate various header forms from RFC 8621 §4.1.2:
1402 - header:name - Raw value
1403 - header:name:asText - Text decoded
1404 - header:name:asAddresses - Address list
1405 - header:name:asGroupedAddresses - Address groups
1406 - header:name:asMessageIds - Message-ID list
1407 - header:name:asDate - RFC 3339 date
1408 - header:name:asURLs - URL list
1409 - header:name:all - All values (not just first)
1410 *)
1411 let header_props = [
1412 (* Raw and text forms *)
1413 "header:Subject";
1414 "header:Subject:asText";
1415 (* Address headers *)
1416 "header:From:asAddresses";
1417 "header:To:asAddresses";
1418 "header:Cc:asAddresses";
1419 "header:Bcc:asAddresses";
1420 "header:Reply-To:asAddresses";
1421 "header:Sender:asAddresses";
1422 (* Grouped addresses *)
1423 "header:From:asGroupedAddresses";
1424 (* Message ID headers *)
1425 "header:Message-ID:asMessageIds";
1426 "header:In-Reply-To:asMessageIds";
1427 "header:References:asMessageIds";
1428 (* Date header *)
1429 "header:Date:asDate";
1430 (* List headers as URLs *)
1431 "header:List-Unsubscribe:asURLs";
1432 "header:List-Post:asURLs";
1433 "header:List-Archive:asURLs";
1434 (* Custom headers *)
1435 "header:X-Mailer:asText";
1436 "header:X-Priority";
1437 "header:X-Spam-Status:asText";
1438 "header:Content-Type";
1439 "header:MIME-Version";
1440 (* Get all Received headers (typically multiple) *)
1441 "header:Received:all";
1442 ] in
1443
1444 let properties = "id" :: "threadId" :: "subject" :: header_props in
1445
1446 let get_inv = Jmap_eio.Client.Build.email_get
1447 ~call_id:"h1"
1448 ~account_id
1449 ~ids:[target_email_id]
1450 ~properties
1451 ()
1452 in
1453 let req = Jmap_eio.Client.Build.(
1454 make_request
1455 ~capabilities:[Jmap.Proto.Capability.core; Jmap.Proto.Capability.mail]
1456 [get_inv]
1457 ) in
1458
1459 match Jmap_eio.Client.request client req with
1460 | Error e ->
1461 Fmt.epr "Error: %s@." (Jmap_eio.Client.error_to_string e);
1462 exit 1
1463 | Ok response ->
1464 match Jmap_eio.Client.Parse.parse_email_get ~call_id:"h1" response with
1465 | Error e ->
1466 Fmt.epr "Parse error: %s@." (Jsont.Error.to_string e);
1467 exit 1
1468 | Ok email_result ->
1469 match email_result.list with
1470 | [] ->
1471 Fmt.epr "Email not found: %s@." email_id_str;
1472 exit 1
1473 | email :: _ ->
1474 Fmt.pr "@[<v>%a@," Fmt.(styled `Bold string) "Email Headers (RFC 8621 §4.1)";
1475 Fmt.pr "ID: %s@," (email_id email);
1476 Fmt.pr "Thread: %s@," (email_thread_id email);
1477 (match email.subject with
1478 | Some s -> Fmt.pr "Subject (convenience): %s@," s
1479 | None -> ());
1480 Fmt.pr "@,";
1481
1482 (* Print dynamic headers grouped by category *)
1483 let raw_headers = Jmap.Proto.Email.dynamic_headers_raw email in
1484 if raw_headers = [] then
1485 Fmt.pr "%a@," Fmt.(styled `Yellow string) "No dynamic headers returned"
1486 else begin
1487 Fmt.pr "%a (%d properties)@,@,"
1488 Fmt.(styled `Bold string) "Dynamic Header Properties"
1489 (List.length raw_headers);
1490
1491 List.iter (fun (name, json) ->
1492 match Jmap.Proto.Email.decode_header_value name json with
1493 | None ->
1494 Fmt.pr " %a: (decode failed)@,"
1495 Fmt.(styled `Red string) name
1496 | Some value ->
1497 let formatted = format_header_value value in
1498 if String.length formatted > 80 then
1499 Fmt.pr " %a:@, %s@,"
1500 Fmt.(styled `Cyan string) name
1501 formatted
1502 else
1503 Fmt.pr " %a: %s@,"
1504 Fmt.(styled `Cyan string) name
1505 formatted
1506 ) raw_headers
1507 end;
1508 Fmt.pr "@]@."
1509 in
1510 let doc = "Show email headers in various forms (demonstrates RFC 8621 §4.1)" in
1511 let info = Cmd.info "headers" ~doc in
1512 Cmd.v info Term.(const run $ Jmap_eio.Cli.config_term $ email_id_term)
1513
1514(** {1 Main Command Group} *)
1515
1516let main_cmd =
1517 let doc = "JMAP command-line client" in
1518 let man = [
1519 `S Manpage.s_description;
1520 `P "A command-line client for JMAP (JSON Meta Application Protocol) email servers.";
1521 `S Manpage.s_environment;
1522 `P Jmap_eio.Cli.env_docs;
1523 `S Manpage.s_examples;
1524 `P "List mailboxes:";
1525 `Pre " jmap mailboxes --url https://api.fastmail.com/jmap/session -k YOUR_API_KEY";
1526 `P "Show recent emails:";
1527 `Pre " jmap recent -n 50 --format detailed";
1528 `P "Search emails:";
1529 `Pre " jmap search \"meeting notes\" -n 10";
1530 ] in
1531 let info = Cmd.info "jmap" ~version:"0.1.0" ~doc ~man in
1532 Cmd.group info [
1533 session_cmd;
1534 mailboxes_cmd;
1535 emails_cmd;
1536 search_cmd;
1537 recent_cmd;
1538 threads_cmd;
1539 identities_cmd;
1540 headers_cmd;
1541 (* Chain API examples *)
1542 inbox_cmd;
1543 thread_view_cmd;
1544 mark_read_cmd;
1545 delete_email_cmd;
1546 changes_cmd;
1547 sync_cmd;
1548 ]
1549
1550let () =
1551 Fmt_tty.setup_std_outputs ();
1552 exit (Cmd.eval main_cmd)