My agentic slop goes here. Not intended for anyone else!
anil.recoil.org
1(** Email Submission Example using the high-level API
2
3 This example demonstrates the ergonomic email submission API inspired
4 by rust-jmap patterns. It shows how to:
5 - Submit emails with minimal configuration
6 - Submit emails with custom SMTP envelopes
7 - Cancel pending submissions
8 - Query submission status
9*)
10
11open Printf
12
13let show_error = function
14 | `Network_error (_kind, msg, _retryable) ->
15 printf "Network Error: %s\n" msg
16 | `Auth_error (_kind, msg) ->
17 printf "Authentication Error: %s\n" msg
18 | `Parse_error (_kind, context) ->
19 printf "Parse Error: %s\n" context
20 | `Method_error (method_name, _call_id, error_type, _description) ->
21 printf "Method Error in %s: %s\n" method_name
22 (match error_type with
23 | `ServerUnavailable -> "Server unavailable"
24 | `ServerFail -> "Server failure"
25 | `InvalidArguments -> "Invalid arguments"
26 | `Forbidden -> "Forbidden"
27 | _ -> "Unknown error")
28 | `Protocol_error msg ->
29 printf "Protocol Error: %s\n" msg
30 | error ->
31 printf "Error: %s\n" (Jmap.Error.Utils.context error)
32
33(** Submit an email using the new high-level API *)
34let submit_email env ctx _session email_id identity_id envelope_override send_draft =
35 printf "📧 Submitting email\n";
36 printf " Email ID: %s\n" (Jmap.Id.to_string email_id);
37 printf " Identity ID: %s\n" (Jmap.Id.to_string identity_id);
38
39 (* Use the high-level API *)
40 let result =
41 match envelope_override with
42 | Some envelope ->
43 (* Extract envelope addresses *)
44 let mail_from = Jmap_email.Submission.Envelope.mail_from envelope in
45 let rcpt_to = Jmap_email.Submission.Envelope.rcpt_to envelope in
46 let mail_from_email = Jmap_email.Submission.EnvelopeAddress.email mail_from in
47 let rcpt_to_emails = List.map Jmap_email.Submission.EnvelopeAddress.email rcpt_to in
48
49 (* Submit with custom envelope *)
50 if send_draft then
51 (* We'd need a submit_and_destroy_draft_with_envelope, so just use regular submit for now *)
52 Jmap_unix.Email_submission.submit_email_with_envelope env ctx
53 ~email_id ~identity_id
54 ~mail_from:mail_from_email
55 ~rcpt_to:rcpt_to_emails
56 else
57 Jmap_unix.Email_submission.submit_email_with_envelope env ctx
58 ~email_id ~identity_id
59 ~mail_from:mail_from_email
60 ~rcpt_to:rcpt_to_emails
61 | None ->
62 (* Submit without envelope *)
63 if send_draft then
64 Jmap_unix.Email_submission.submit_and_destroy_draft env ctx
65 ~email_id ~identity_id
66 else
67 Jmap_unix.Email_submission.submit_email env ctx
68 ~email_id ~identity_id
69 in
70
71 match result with
72 | Ok submission ->
73 printf "\n✅ Email submitted successfully!\n";
74 (match Jmap_email.Submission.id submission with
75 | Some id -> printf " Submission ID: %s\n" (Jmap.Id.to_string id)
76 | None -> ());
77 let thread_id = Jmap_email.Submission.thread_id submission in
78 printf " Thread ID: %s\n" (Jmap.Id.to_string thread_id);
79 let send_at = Jmap_email.Submission.send_at submission in
80 printf " Send time: %.0f\n" (Jmap.Date.to_timestamp send_at);
81 Ok ()
82 | Error error ->
83 printf "\n❌ Email submission failed\n";
84 show_error error;
85 Error "Submission failed"
86
87(** Create a draft email (placeholder - not fully implemented) *)
88let create_draft_email _env _ctx session ~from_address ~to_addresses ~subject ~body =
89 try
90 let account_id_str = Jmap_unix.Session_utils.get_primary_mail_account session in
91
92 printf "📝 Would create draft email in account: %s\n" account_id_str;
93 printf " From: %s\n" from_address;
94 printf " To: %s\n" (String.concat ", " to_addresses);
95 printf " Subject: %s\n" subject;
96 printf " Body: %s\n" (String.sub body 0 (min 50 (String.length body)) ^ "...");
97 printf "\n⚠️ Note: Email creation is not fully implemented yet.\n";
98 printf " Using placeholder email ID for demonstration.\n";
99
100 (* Return a placeholder email ID *)
101 match Jmap.Id.of_string "placeholder-email-12345" with
102 | Ok id -> Ok id
103 | Error err -> Error err
104 with
105 | exn -> Error ("Draft creation error: " ^ Printexc.to_string exn)
106
107(** Get identity ID (placeholder - not fully implemented) *)
108let get_identity_id _env _ctx _session email_address =
109 printf "🔍 Would look up identity for email: %s\n" email_address;
110 printf "⚠️ Note: Identity lookup not fully implemented yet.\n";
111 printf " Using placeholder identity ID for demonstration.\n";
112
113 match Jmap.Id.of_string "placeholder-identity-67890" with
114 | Ok id -> Ok id
115 | Error err -> Error err
116
117(** Query submission status using the high-level API *)
118let query_submission_status env ctx _session submission_id =
119 printf "\n🔍 Checking submission status for ID: %s\n" (Jmap.Id.to_string submission_id);
120
121 match Jmap_unix.Email_submission.get_submission env ctx ~submission_id () with
122 | Ok (Some submission) ->
123 (* Display undo status *)
124 let status = Jmap_email.Submission.undo_status submission in
125 let status_str = match status with
126 | `Pending -> "Pending (can be cancelled)"
127 | `Final -> "Final (sent)"
128 | `Canceled -> "Cancelled"
129 in
130 printf " Undo Status: %s\n" status_str;
131
132 (* Check delivery status *)
133 (match Jmap_unix.Email_submission.get_delivery_status env ctx ~submission_id with
134 | Ok (Some delivery_tbl) when Hashtbl.length delivery_tbl > 0 ->
135 printf " Delivery Status:\n";
136 Hashtbl.iter (fun email status ->
137 let smtp_reply = Jmap_email.Submission.DeliveryStatus.smtp_reply status in
138 let delivered = Jmap_email.Submission.DeliveryStatus.delivered status in
139 let delivered_str = match delivered with
140 | `Queued -> "Queued"
141 | `Yes -> "Delivered"
142 | `No -> "Failed"
143 | `Unknown -> "Unknown"
144 in
145 printf " %s: %s (%s)\n" email delivered_str smtp_reply
146 ) delivery_tbl
147 | _ -> printf " Delivery Status: Not available yet\n");
148 Ok ()
149 | Ok None ->
150 printf " Submission not found\n";
151 Error "Submission not found"
152 | Error error ->
153 show_error error;
154 Error "Failed to query submission"
155
156(** Cancel a submission using the high-level API *)
157let cancel_submission env ctx _session submission_id =
158 printf "\n🚫 Attempting to cancel submission: %s\n" (Jmap.Id.to_string submission_id);
159
160 match Jmap_unix.Email_submission.cancel_submission env ctx ~submission_id with
161 | Ok () ->
162 printf "✅ Submission cancelled successfully\n";
163 Ok ()
164 | Error error ->
165 printf "❌ Failed to cancel submission\n";
166 show_error error;
167 Error "Cancellation failed"
168
169(** Cancel all pending submissions using the high-level API *)
170let cancel_all_pending env ctx _session =
171 printf "🔍 Querying for pending submissions...\n";
172
173 match Jmap_unix.Email_submission.query_pending_submissions env ctx with
174 | Ok pending_ids ->
175 if List.length pending_ids > 0 then begin
176 printf "Found %d pending submission(s)\n" (List.length pending_ids);
177
178 (* Cancel each one individually *)
179 List.iter (fun id ->
180 ignore (cancel_submission env ctx _session id)
181 ) pending_ids;
182
183 (* Alternative: Use cancel_all_pending for batch operation *)
184 printf "\nUsing batch cancellation...\n";
185 match Jmap_unix.Email_submission.cancel_all_pending env ctx with
186 | Ok count ->
187 printf "✅ Cancelled %d submissions\n" count;
188 Ok ()
189 | Error error ->
190 show_error error;
191 Error "Batch cancellation failed"
192 end else begin
193 printf "No pending submissions found\n";
194 Ok ()
195 end
196 | Error error ->
197 show_error error;
198 Error "Failed to query pending submissions"
199
200let parse_command_line () =
201 let from_address = ref "" in
202 let to_addresses = ref [] in
203 let subject = ref "Test Email" in
204 let body = ref "This is a test email sent via JMAP." in
205 let send_immediately = ref false in
206 let with_envelope = ref false in
207 let cancel_pending = ref false in
208 let check_status = ref "" in
209
210 let specs = [
211 ("-from", Arg.Set_string from_address, "From email address");
212 ("-to", Arg.String (fun s -> to_addresses := s :: !to_addresses), "To email address (can be used multiple times)");
213 ("-subject", Arg.Set_string subject, "Email subject");
214 ("-body", Arg.Set_string body, "Email body text");
215 ("-send", Arg.Set send_immediately, "Send immediately (don't save as draft)");
216 ("-envelope", Arg.Set with_envelope, "Include custom SMTP envelope");
217 ("-cancel", Arg.Set cancel_pending, "Cancel pending submissions");
218 ("-status", Arg.Set_string check_status, "Check status of submission ID");
219 ] in
220
221 let usage_msg = "JMAP Email Submission Client\n\nUsage: " ^ Sys.argv.(0) ^ " [options]\n\nOptions:" in
222 Arg.parse specs (fun _ -> ()) usage_msg;
223
224 (* Reverse to addresses to maintain order *)
225 to_addresses := List.rev !to_addresses;
226
227 (!from_address, !to_addresses, !subject, !body, !send_immediately, !with_envelope, !cancel_pending, !check_status)
228
229let main () =
230 let (from_address, to_addresses, subject, body, send_immediately, with_envelope, cancel_pending, check_status) =
231 parse_command_line () in
232
233 printf "JMAP Email Submission Client (High-Level API)\n";
234 printf "==============================================\n\n";
235
236 (* Initialize crypto *)
237 Mirage_crypto_rng_unix.use_default ();
238
239 Eio_main.run @@ fun env ->
240
241 (* Read API credentials *)
242 let api_key =
243 try
244 let ic = open_in ".api-key" in
245 let key = input_line ic in
246 close_in ic;
247 String.trim key
248 with
249 | Sys_error _ ->
250 eprintf "Error: Create a .api-key file with your JMAP bearer token\n";
251 eprintf " You can get this from Fastmail Settings > Privacy & Security > API Keys\n\n";
252 exit 1
253 in
254
255 try
256 (* Connect to JMAP server *)
257 printf "🔌 Connecting to Fastmail JMAP server...\n";
258 let client = Jmap_unix.create_client () in
259 let session_url = Uri.of_string "https://api.fastmail.com/jmap/session" in
260 let auth_method = Jmap_unix.Bearer api_key in
261
262 match Jmap_unix.(connect env client ~session_url ~host:"api.fastmail.com" ~port:443 ~use_tls:true ~auth_method ()) with
263 | Ok (ctx, session) ->
264 printf "✅ Connected successfully\n\n";
265 Jmap_unix.Session_utils.print_session_info session;
266 printf "\n";
267
268 (* Handle different modes of operation *)
269 let result =
270 if check_status <> "" then
271 (* Check submission status *)
272 match Jmap.Id.of_string check_status with
273 | Ok submission_id -> query_submission_status env ctx session submission_id
274 | Error err -> Error ("Invalid submission ID: " ^ err)
275 else if cancel_pending then
276 (* Cancel all pending submissions using high-level API *)
277 cancel_all_pending env ctx session
278 else if from_address = "" || to_addresses = [] then
279 (* Show usage if no from/to addresses *)
280 (printf "\nℹ️ No email to send. Use -from and -to options to send an email.\n";
281 printf " Example: %s -from me@example.com -to you@example.com -subject 'Hello' -body 'Test message' -send\n" Sys.argv.(0);
282 printf "\n Other options:\n";
283 printf " -status <id> Check submission status\n";
284 printf " -cancel Cancel all pending submissions\n";
285 Ok ())
286 else
287 (* Send email workflow *)
288 let from_addr = if from_address = "" then "noreply@example.com" else from_address in
289 let to_addrs = if to_addresses = [] then ["test@example.com"] else to_addresses in
290
291 (* Get identity *)
292 match get_identity_id env ctx session from_addr with
293 | Ok identity_id ->
294 (* Create envelope if requested *)
295 let envelope_opt =
296 if with_envelope then
297 match Jmap_email.Submission.EnvelopeAddress.create ~email:from_addr () with
298 | Ok mail_from ->
299 let rcpt_to = List.filter_map (fun email ->
300 match Jmap_email.Submission.EnvelopeAddress.create ~email () with
301 | Ok addr -> Some addr
302 | Error _ -> None
303 ) to_addrs in
304 (match Jmap_email.Submission.Envelope.create ~mail_from ~rcpt_to with
305 | Ok envelope -> Some envelope
306 | Error _ -> None)
307 | Error _ -> None
308 else None
309 in
310
311 (* Create draft email *)
312 (match create_draft_email env ctx session ~from_address:from_addr
313 ~to_addresses:to_addrs ~subject ~body with
314 | Ok email_id ->
315 if send_immediately then
316 (* Submit the email using high-level API *)
317 (match submit_email env ctx session email_id identity_id envelope_opt true with
318 | Ok () ->
319 printf "\n✅ Email sent successfully using high-level API!\n";
320 Ok ()
321 | Error msg -> Error msg)
322 else
323 (printf "\n✅ Draft saved successfully!\n";
324 printf " Email ID: %s\n" (Jmap.Id.to_string email_id);
325 printf " Use -send flag to send immediately\n";
326 Ok ())
327 | Error msg -> Error msg)
328 | Error msg -> Error msg
329 in
330
331 (* Handle result *)
332 (match result with
333 | Ok () -> printf "\n✅ Operation completed successfully\n"
334 | Error msg -> printf "\n❌ Operation failed: %s\n" msg);
335
336 (* Close connection *)
337 printf "\n🔌 Closing connection...\n";
338 (match Jmap_unix.close ctx with
339 | Ok () -> printf "✅ Connection closed\n"
340 | Error error -> Format.printf "⚠️ Error closing: %a\n" Jmap.Error.pp error)
341
342 | Error error ->
343 Format.printf "❌ Connection failed: %a\n" Jmap.Error.pp error;
344 exit 1
345 with
346 | exn ->
347 printf "❌ Unexpected error: %s\n" (Printexc.to_string exn);
348 exit 1
349
350let () = main ()