this repo has no description
1(**
2 * fastmail_list - Lists emails from a Fastmail account using JMAP API
3 *
4 * This binary connects to the Fastmail JMAP API using an authentication token
5 * from the JMAP_API_TOKEN environment variable and lists the most recent 100
6 * emails with their subjects, sender details, and labels.
7 *
8 * Usage:
9 * JMAP_API_TOKEN=your_api_token ./fastmail_list [options]
10 *
11 * Options:
12 * -unread List only unread messages
13 * -labels Show labels/keywords associated with messages
14 * -debug LEVEL Set debug level (0-4, where 4 is most verbose)
15 *)
16
17open Lwt.Syntax
18open Jmap
19open Jmap_mail
20module Mail = Jmap_mail.Types
21
22(** Prints the email details *)
23let print_email ~show_labels (email : Mail.email) =
24 let sender =
25 match email.from with
26 | Some (addr :: _) ->
27 (match addr.name with
28 | Some name -> Printf.sprintf "%s <%s>" name addr.email
29 | None -> addr.email)
30 | _ -> "<unknown>"
31 in
32 let subject =
33 match email.subject with
34 | Some s -> s
35 | None -> "<no subject>"
36 in
37 let date = email.received_at in
38
39 (* Format labels/keywords if requested *)
40 let labels_str =
41 if show_labels then
42 let formatted = Jmap_mail.Types.format_email_keywords email.keywords in
43 if formatted <> "" then
44 " [" ^ formatted ^ "]"
45 else
46 ""
47 else
48 ""
49 in
50
51 Printf.printf "%s | %s | %s%s\n" date sender subject labels_str
52
53(** Check if an email is unread *)
54let is_unread (email : Mail.email) =
55 let is_unread_keyword =
56 List.exists (fun (kw, active) ->
57 kw = Mail.Unread && active
58 ) email.keywords
59 in
60 let is_not_seen =
61 not (List.exists (fun (kw, active) ->
62 kw = Mail.Seen && active
63 ) email.keywords)
64 in
65 is_unread_keyword || is_not_seen
66
67(** Example function demonstrating how to use result references for chained requests *)
68let demo_result_references conn account_id =
69 let open Jmap.Types in
70
71 (* Create a request that chains the following operations:
72 1. Get mailboxes
73 2. Query emails in the first mailbox found
74 3. Get the full email objects for those IDs
75 *)
76
77 (* Create method call IDs *)
78 let mailbox_get_id = "mailboxGet" in
79 let email_query_id = "emailQuery" in
80 let email_get_id = "emailGet" in
81
82 (* First call: Get mailboxes *)
83 let mailbox_get_call = {
84 name = "Mailbox/get";
85 arguments = `O [
86 ("accountId", `String account_id);
87 ];
88 method_call_id = mailbox_get_id;
89 } in
90
91 (* Second call: Query emails in the first mailbox using result reference *)
92 (* Create reference to the first mailbox ID from the previous result *)
93 let mailbox_id_ref = Jmap.ResultReference.create
94 ~result_of:mailbox_get_id
95 ~name:"Mailbox/get"
96 ~path:"/list/0/id" in
97
98 (* Use the reference to create the query arguments *)
99 let (mailbox_id_ref_key, mailbox_id_ref_value) =
100 Jmap.ResultReference.reference_arg "inMailbox" mailbox_id_ref in
101
102 let email_query_call = {
103 name = "Email/query";
104 arguments = `O [
105 ("accountId", `String account_id);
106 ("filter", `O [
107 (mailbox_id_ref_key, mailbox_id_ref_value)
108 ]);
109 ("limit", `Float 10.0);
110 ];
111 method_call_id = email_query_id;
112 } in
113
114 (* Third call: Get full email objects using the query result *)
115 (* Create reference to the email IDs from the query result *)
116 let email_ids_ref = Jmap.ResultReference.create
117 ~result_of:email_query_id
118 ~name:"Email/query"
119 ~path:"/ids" in
120
121 (* Use the reference to create the get arguments *)
122 let (email_ids_ref_key, email_ids_ref_value) =
123 Jmap.ResultReference.reference_arg "ids" email_ids_ref in
124
125 let email_get_call = {
126 name = "Email/get";
127 arguments = `O [
128 ("accountId", `String account_id);
129 (email_ids_ref_key, email_ids_ref_value)
130 ];
131 method_call_id = email_get_id;
132 } in
133
134 (* Create the complete request with all three method calls *)
135 let request = {
136 using = [
137 Jmap.Capability.to_string Jmap.Capability.Core;
138 Jmap_mail.Capability.to_string Jmap_mail.Capability.Mail
139 ];
140 method_calls = [
141 mailbox_get_call;
142 email_query_call;
143 email_get_call
144 ];
145 created_ids = None;
146 } in
147
148 (* Make the request *)
149 let* response_result = Jmap.Api.make_request conn.config request in
150 Printf.printf "\nResult Reference Demo:\n";
151 Printf.printf "=====================\n";
152
153 match response_result with
154 | Error err ->
155 Printf.printf "Error executing chained request: %s\n"
156 (match err with
157 | Jmap.Api.Connection_error msg -> "Connection error: " ^ msg
158 | Jmap.Api.HTTP_error (code, body) -> Printf.sprintf "HTTP error %d: %s" code body
159 | Jmap.Api.Parse_error msg -> "Parse error: " ^ msg
160 | Jmap.Api.Authentication_error -> "Authentication error");
161 Lwt.return_unit
162 | Ok response ->
163 (* Process the response *)
164 try
165 (* Look for the Email/get method response *)
166 let email_get_result = List.find (fun (inv : Ezjsonm.value invocation) ->
167 inv.name = "Email/get"
168 ) response.method_responses in
169
170 (* Extract the email list from the response *)
171 let list = Ezjsonm.find email_get_result.arguments ["list"] in
172 match list with
173 | `A emails ->
174 Printf.printf "Successfully retrieved %d emails using chained result references!\n"
175 (List.length emails);
176 Lwt.return_unit
177 | _ ->
178 Printf.printf "Unexpected email list format in response.\n";
179 Lwt.return_unit
180 with
181 | Not_found ->
182 Printf.printf "No Email/get result found in response.\n";
183 Lwt.return_unit
184 | e ->
185 Printf.printf "Error processing response: %s\n" (Printexc.to_string e);
186 Lwt.return_unit
187
188(** Main function *)
189let main () =
190 (* Parse command-line arguments *)
191 let unread_only = ref false in
192 let show_labels = ref false in
193 let debug_level = ref 0 in
194 let demo_refs = ref false in
195 let sender_filter = ref "" in
196
197 let args = [
198 ("-unread", Arg.Set unread_only, "List only unread messages");
199 ("-labels", Arg.Set show_labels, "Show labels/keywords associated with messages");
200 ("-debug", Arg.Int (fun level -> debug_level := level), "Set debug level (0-4, where 4 is most verbose)");
201 ("-demo-refs", Arg.Set demo_refs, "Demonstrate result references");
202 ("-from", Arg.Set_string sender_filter, "Filter messages by sender email address (supports wildcards: * and ?)");
203 ] in
204
205 let usage_msg = "Usage: JMAP_API_TOKEN=your_token fastmail_list [options]" in
206 Arg.parse args (fun _ -> ()) usage_msg;
207
208 (* Configure logging *)
209 init_logging ~level:!debug_level ~enable_logs:(!debug_level > 0) ~redact_sensitive:true ();
210
211 match Sys.getenv_opt "JMAP_API_TOKEN" with
212 | None ->
213 Printf.eprintf "Error: JMAP_API_TOKEN environment variable not set\n";
214 Printf.eprintf "Usage: JMAP_API_TOKEN=your_token ./fastmail_list [options]\n";
215 Printf.eprintf "Options:\n";
216 Printf.eprintf " -unread List only unread messages\n";
217 Printf.eprintf " -labels Show labels/keywords associated with messages\n";
218 Printf.eprintf " -debug LEVEL Set debug level (0-4, where 4 is most verbose)\n";
219 Printf.eprintf " -demo-refs Demonstrate result references\n";
220 Printf.eprintf " -from PATTERN Filter messages by sender email address (supports wildcards: * and ?)\n";
221 exit 1
222 | Some token ->
223 (* Only print token info at Info level or higher *)
224 Logs.info (fun m -> m "Using API token: %s" (redact_token token));
225
226 (* Connect to Fastmail JMAP API *)
227 let formatted_token = token in
228
229 (* Only print instructions at Info level *)
230 let level = match Logs.level () with
231 | None -> 0
232 | Some Logs.Error -> 1
233 | Some Logs.Info -> 2
234 | Some Logs.Debug -> 3
235 | _ -> 2
236 in
237 if level >= 2 then begin
238 Printf.printf "\nFastmail API Instructions:\n";
239 Printf.printf "1. Get a token from: https://app.fastmail.com/settings/tokens\n";
240 Printf.printf "2. Create a new token with Mail scope (read/write)\n";
241 Printf.printf "3. Copy the full token (example: 3de40-5fg1h2-a1b2c3...)\n";
242 Printf.printf "4. Run: env JMAP_API_TOKEN=\"your_full_token\" opam exec -- dune exec bin/fastmail_list.exe [options]\n\n";
243 Printf.printf "Note: This example is working correctly but needs a valid Fastmail token.\n\n";
244 end;
245 let* result = login_with_token
246 ~uri:"https://api.fastmail.com/jmap/session"
247 ~api_token:formatted_token
248 in
249 match result with
250 | Error err ->
251 (match err with
252 | Api.Connection_error msg ->
253 Printf.eprintf "Connection error: %s\n" msg
254 | Api.HTTP_error (code, body) ->
255 Printf.eprintf "HTTP error %d: %s\n" code body
256 | Api.Parse_error msg ->
257 Printf.eprintf "Parse error: %s\n" msg
258 | Api.Authentication_error ->
259 Printf.eprintf "Authentication error. Check your API token.\n");
260 Lwt.return 1
261 | Ok conn ->
262 (* Get the primary account ID *)
263 let primary_account_id =
264 let mail_capability = Jmap_mail.Capability.to_string Jmap_mail.Capability.Mail in
265 match List.assoc_opt mail_capability conn.session.primary_accounts with
266 | Some id -> id
267 | None ->
268 match conn.session.accounts with
269 | (id, _) :: _ -> id
270 | [] ->
271 Printf.eprintf "No accounts found\n";
272 exit 1
273 in
274
275 (* Run result references demo if requested *)
276 let* () =
277 if !demo_refs then
278 demo_result_references conn primary_account_id
279 else
280 Lwt.return_unit
281 in
282
283 (* Get the Inbox mailbox *)
284 let* mailboxes_result = get_mailboxes conn ~account_id:primary_account_id in
285 match mailboxes_result with
286 | Error err ->
287 Printf.eprintf "Failed to get mailboxes: %s\n"
288 (match err with
289 | Api.Connection_error msg -> "Connection error: " ^ msg
290 | Api.HTTP_error (code, body) -> Printf.sprintf "HTTP error %d: %s" code body
291 | Api.Parse_error msg -> "Parse error: " ^ msg
292 | Api.Authentication_error -> "Authentication error");
293 Lwt.return 1
294 | Ok mailboxes ->
295 (* If there's a mailbox list, just use the first one for this example *)
296 let inbox_id =
297 match mailboxes with
298 | mailbox :: _ -> mailbox.Mail.id
299 | [] ->
300 Printf.eprintf "No mailboxes found\n";
301 exit 1
302 in
303
304 (* Get messages from inbox *)
305 let* emails_result = get_messages_in_mailbox
306 conn
307 ~account_id:primary_account_id
308 ~mailbox_id:inbox_id
309 ~limit:1000
310 ()
311 in
312 match emails_result with
313 | Error err ->
314 Printf.eprintf "Failed to get emails: %s\n"
315 (match err with
316 | Api.Connection_error msg -> "Connection error: " ^ msg
317 | Api.HTTP_error (code, body) -> Printf.sprintf "HTTP error %d: %s" code body
318 | Api.Parse_error msg -> "Parse error: " ^ msg
319 | Api.Authentication_error -> "Authentication error");
320 Lwt.return 1
321 | Ok emails ->
322 (* Apply filters based on command line arguments *)
323 let filtered_by_unread =
324 if !unread_only then
325 List.filter is_unread emails
326 else
327 emails
328 in
329
330 (* Apply sender filter if specified *)
331 let filtered_emails =
332 if !sender_filter <> "" then begin
333 Printf.printf "Filtering by sender: %s\n" !sender_filter;
334 List.filter (fun email ->
335 Jmap_mail.email_matches_sender email !sender_filter
336 ) filtered_by_unread
337 end else
338 filtered_by_unread
339 in
340
341 (* Create description of applied filters *)
342 let filter_description =
343 let parts = [] in
344 let parts = if !unread_only then "unread" :: parts else parts in
345 let parts = if !sender_filter <> "" then ("from \"" ^ !sender_filter ^ "\"") :: parts else parts in
346 match parts with
347 | [] -> "the most recent"
348 | [p] -> p
349 | _ -> String.concat " and " parts
350 in
351
352 Printf.printf "Listing %s %d emails in your inbox:\n"
353 filter_description
354 (List.length filtered_emails);
355 Printf.printf "--------------------------------------------\n";
356 List.iter (print_email ~show_labels:!show_labels) filtered_emails;
357 Lwt.return 0
358
359(** Program entry point *)
360let () =
361 let exit_code = Lwt_main.run (main ()) in
362 exit exit_code