this repo has no description
anil.recoil.org
1(*
2 * jmap_email_composer.ml - Compose and send emails via JMAP
3 *
4 * This binary demonstrates JMAP's email creation and submission capabilities,
5 * including drafts, attachments, and sending.
6 *
7 * For step 2, we're only testing type checking. No implementations required.
8 *)
9
10open Cmdliner
11
12(** Email composition options **)
13type compose_options = {
14 to_recipients : string list;
15 cc_recipients : string list;
16 bcc_recipients : string list;
17 subject : string;
18 body_text : string option;
19 body_html : string option;
20 attachments : string list;
21 in_reply_to : string option;
22 draft : bool;
23 send : bool;
24}
25
26(** Command-line arguments **)
27
28let host_arg =
29 Arg.(required & opt (some string) None & info ["h"; "host"]
30 ~docv:"HOST" ~doc:"JMAP server hostname")
31
32let user_arg =
33 Arg.(required & opt (some string) None & info ["u"; "user"]
34 ~docv:"USERNAME" ~doc:"Username for authentication")
35
36let password_arg =
37 Arg.(required & opt (some string) None & info ["p"; "password"]
38 ~docv:"PASSWORD" ~doc:"Password for authentication")
39
40let to_arg =
41 Arg.(value & opt_all string [] & info ["t"; "to"]
42 ~docv:"EMAIL" ~doc:"Recipient email address (can be specified multiple times)")
43
44let cc_arg =
45 Arg.(value & opt_all string [] & info ["c"; "cc"]
46 ~docv:"EMAIL" ~doc:"CC recipient email address")
47
48let bcc_arg =
49 Arg.(value & opt_all string [] & info ["b"; "bcc"]
50 ~docv:"EMAIL" ~doc:"BCC recipient email address")
51
52let subject_arg =
53 Arg.(required & opt (some string) None & info ["s"; "subject"]
54 ~docv:"SUBJECT" ~doc:"Email subject line")
55
56let body_arg =
57 Arg.(value & opt (some string) None & info ["body"]
58 ~docv:"TEXT" ~doc:"Plain text body content")
59
60let body_file_arg =
61 Arg.(value & opt (some string) None & info ["body-file"]
62 ~docv:"FILE" ~doc:"Read body content from file")
63
64let html_arg =
65 Arg.(value & opt (some string) None & info ["html"]
66 ~docv:"HTML" ~doc:"HTML body content")
67
68let html_file_arg =
69 Arg.(value & opt (some string) None & info ["html-file"]
70 ~docv:"FILE" ~doc:"Read HTML body from file")
71
72let attach_arg =
73 Arg.(value & opt_all string [] & info ["a"; "attach"]
74 ~docv:"FILE" ~doc:"File to attach (can be specified multiple times)")
75
76let reply_to_arg =
77 Arg.(value & opt (some string) None & info ["r"; "reply-to"]
78 ~docv:"EMAIL_ID" ~doc:"Email ID to reply to")
79
80let draft_arg =
81 Arg.(value & flag & info ["d"; "draft"]
82 ~doc:"Save as draft instead of sending")
83
84let send_arg =
85 Arg.(value & flag & info ["send"]
86 ~doc:"Send the email immediately (default is to create draft)")
87
88(** Helper functions **)
89
90(* Read file contents *)
91let read_file filename =
92 let ic = open_in filename in
93 let len = in_channel_length ic in
94 let content = really_input_string ic len in
95 close_in ic;
96 content
97
98(* Get MIME type from filename *)
99let mime_type_from_filename filename =
100 match Filename.extension filename with
101 | ".pdf" -> "application/pdf"
102 | ".doc" | ".docx" -> "application/msword"
103 | ".xls" | ".xlsx" -> "application/vnd.ms-excel"
104 | ".jpg" | ".jpeg" -> "image/jpeg"
105 | ".png" -> "image/png"
106 | ".gif" -> "image/gif"
107 | ".txt" -> "text/plain"
108 | ".html" | ".htm" -> "text/html"
109 | ".zip" -> "application/zip"
110 | _ -> "application/octet-stream"
111
112(* Upload a file as a blob *)
113let upload_attachment ctx session account_id filepath =
114 Printf.printf "Uploading %s...\n" filepath;
115
116 let content = read_file filepath in
117 let filename = Filename.basename filepath in
118 let mime_type = mime_type_from_filename filename in
119
120 (* Upload blob using the JMAP upload endpoint *)
121 let upload_url = Jmap.Session.Session.upload_url session in
122 let upload_endpoint = Printf.sprintf "%s/%s" (Uri.to_string upload_url) account_id in
123
124 (* Simulate blob upload for type checking *)
125 Printf.printf " Would upload to: %s\n" upload_endpoint;
126 Printf.printf " Simulating upload of %s (%s, %d bytes)...\n" filename mime_type (String.length content);
127
128 (* Create simulated blob info *)
129 let blob_info = Jmap.Binary.Upload_response.v
130 ~account_id:""
131 ~blob_id:("blob-" ^ filename ^ "-" ^ string_of_int (Random.int 99999))
132 ~type_:mime_type
133 ~size:(String.length content)
134 () in
135 Printf.printf " Uploaded: %s (blob: %s, %d bytes)\n"
136 filename
137 (Jmap.Binary.Upload_response.blob_id blob_info)
138 (Jmap.Binary.Upload_response.size blob_info);
139 Ok blob_info
140
141(* Create email body parts *)
142let create_body_parts options attachment_blobs =
143 let parts = ref [] in
144
145 (* Add text body if provided *)
146 (match options.body_text with
147 | Some text ->
148 let text_part = Jmap_email.Types.Email_body_part.v
149 ~id:"text"
150 ~size:(String.length text)
151 ~headers:[]
152 ~mime_type:"text/plain"
153 ~charset:"utf-8"
154 () in
155 parts := text_part :: !parts
156 | None -> ());
157
158 (* Add HTML body if provided *)
159 (match options.body_html with
160 | Some html ->
161 let html_part = Jmap_email.Types.Email_body_part.v
162 ~id:"html"
163 ~size:(String.length html)
164 ~headers:[]
165 ~mime_type:"text/html"
166 ~charset:"utf-8"
167 () in
168 parts := html_part :: !parts
169 | None -> ());
170
171 (* Add attachments *)
172 List.iter2 (fun filepath blob_info ->
173 let filename = Filename.basename filepath in
174 let mime_type = mime_type_from_filename filename in
175 let attachment = Jmap_email.Types.Email_body_part.v
176 ~blob_id:(Jmap.Binary.Upload_response.blob_id blob_info)
177 ~size:(Jmap.Binary.Upload_response.size blob_info)
178 ~headers:[]
179 ~name:filename
180 ~mime_type
181 ~disposition:"attachment"
182 () in
183 parts := attachment :: !parts
184 ) options.attachments attachment_blobs;
185
186 List.rev !parts
187
188(* Main compose and send function *)
189let compose_and_send ctx session account_id options =
190 (* 1. Upload attachments first *)
191 let attachment_results = List.map (fun filepath ->
192 upload_attachment ctx session account_id filepath
193 ) options.attachments in
194
195 let attachment_blobs = List.filter_map (function
196 | Ok blob -> Some blob
197 | Error () -> None
198 ) attachment_results in
199
200 if List.length attachment_blobs < List.length options.attachments then (
201 Printf.eprintf "Warning: Some attachments failed to upload\n"
202 );
203
204 (* 2. Create the email addresses *)
205 let to_addresses = List.map (fun email ->
206 Jmap_email.Types.Email_address.v ~email ()
207 ) options.to_recipients in
208
209 let cc_addresses = List.map (fun email ->
210 Jmap_email.Types.Email_address.v ~email ()
211 ) options.cc_recipients in
212
213 let bcc_addresses = List.map (fun email ->
214 Jmap_email.Types.Email_address.v ~email ()
215 ) options.bcc_recipients in
216
217 (* 3. Get sender identity *)
218 let identity_args = Jmap.Methods.Get_args.v
219 ~account_id
220 ~properties:["id"; "email"; "name"]
221 () in
222
223 let identity_invocation = Jmap.Wire.Invocation.v
224 ~method_name:"Identity/get"
225 ~arguments:(`Assoc []) (* Would serialize identity_args *)
226 ~method_call_id:"id1"
227 () in
228
229 let request = Jmap.Wire.Request.v
230 ~using:[Jmap.capability_core; Jmap_email.capability_mail]
231 ~method_calls:[identity_invocation]
232 () in
233
234 let default_identity = match Jmap_unix.request ctx request with
235 | Ok _ ->
236 (* Would extract from response *)
237 Jmap_email.Identity.v
238 ~id:"identity1"
239 ~email:account_id
240 ~name:"User Name"
241 ~may_delete:true
242 ()
243 | Error _ ->
244 (* Fallback identity *)
245 Jmap_email.Identity.v
246 ~id:"identity1"
247 ~email:account_id
248 ~may_delete:true
249 ()
250 in
251
252 (* 4. Create the draft email *)
253 let body_parts = create_body_parts options attachment_blobs in
254
255 let draft_email = Jmap_email.Types.Email.create
256 ~subject:options.subject
257 ~from:[Jmap_email.Types.Email_address.v
258 ~email:(Jmap_email.Identity.email default_identity)
259 ~name:(Jmap_email.Identity.name default_identity)
260 ()]
261 ~to_:to_addresses
262 ~cc:cc_addresses
263 ~keywords:(Jmap_email.Types.Keywords.of_list [Jmap_email.Types.Keywords.Draft])
264 ~text_body:body_parts
265 () in
266
267 (* 5. Create the email using Email/set *)
268 let create_map = Hashtbl.create 1 in
269 Hashtbl.add create_map "draft1" draft_email;
270
271 let create_args = Jmap.Methods.Set_args.v
272 ~account_id
273 ~create:create_map
274 () in
275
276 let create_invocation = Jmap.Wire.Invocation.v
277 ~method_name:"Email/set"
278 ~arguments:(`Assoc []) (* Would serialize create_args *)
279 ~method_call_id:"create1"
280 () in
281
282 (* 6. If sending, also create EmailSubmission *)
283 let method_calls = if options.send && not options.draft then
284 let submission = {
285 Jmap_email.Submission.email_sub_create_identity_id = Jmap_email.Identity.id default_identity;
286 email_sub_create_email_id = "#draft1"; (* Back-reference to created email *)
287 email_sub_create_envelope = None;
288 } in
289
290 let submit_map = Hashtbl.create 1 in
291 Hashtbl.add submit_map "submission1" submission;
292
293 let submit_args = Jmap.Methods.Set_args.v
294 ~account_id
295 ~create:submit_map
296 () in
297
298 let submit_invocation = Jmap.Wire.Invocation.v
299 ~method_name:"EmailSubmission/set"
300 ~arguments:(`Assoc []) (* Would serialize submit_args *)
301 ~method_call_id:"submit1"
302 () in
303
304 [create_invocation; submit_invocation]
305 else
306 [create_invocation]
307 in
308
309 (* 7. Send the request *)
310 let request = Jmap.Wire.Request.v
311 ~using:[Jmap.capability_core; Jmap_email.capability_mail; Jmap_email.capability_submission]
312 ~method_calls
313 () in
314
315 match Jmap_unix.request ctx request with
316 | Ok response ->
317 if options.send && not options.draft then
318 Printf.printf "\nEmail sent successfully!\n"
319 else
320 Printf.printf "\nDraft saved successfully!\n";
321 0
322 | Error e ->
323 Printf.eprintf "\nFailed to create email: %s\n" (Jmap.Error.error_to_string e);
324 1
325
326(* Command implementation *)
327let compose_command host user password to_list cc_list bcc_list subject
328 body body_file html html_file attachments reply_to
329 draft send : int =
330 Printf.printf "JMAP Email Composer\n";
331 Printf.printf "Server: %s\n" host;
332 Printf.printf "User: %s\n\n" user;
333
334 (* Validate arguments *)
335 if to_list = [] && cc_list = [] && bcc_list = [] then (
336 Printf.eprintf "Error: Must specify at least one recipient\n";
337 exit 1
338 );
339
340 (* Read body content *)
341 let body_text = match body, body_file with
342 | Some text, _ -> Some text
343 | None, Some file -> Some (read_file file)
344 | None, None -> None
345 in
346
347 let body_html = match html, html_file with
348 | Some text, _ -> Some text
349 | None, Some file -> Some (read_file file)
350 | None, None -> None
351 in
352
353 if body_text = None && body_html = None then (
354 Printf.eprintf "Error: Must provide email body (--body, --body-file, --html, or --html-file)\n";
355 exit 1
356 );
357
358 (* Create options record *)
359 let options = {
360 to_recipients = to_list;
361 cc_recipients = cc_list;
362 bcc_recipients = bcc_list;
363 subject;
364 body_text;
365 body_html;
366 attachments;
367 in_reply_to = reply_to;
368 draft;
369 send = send || not draft; (* Send by default unless draft flag is set *)
370 } in
371
372 (* Connect to server *)
373 let ctx = Jmap_unix.create_client () in
374 let result = Jmap_unix.quick_connect ~host ~username:user ~password in
375
376 let (ctx, session) = match result with
377 | Ok (ctx, session) -> (ctx, session)
378 | Error e ->
379 Printf.eprintf "Connection failed: %s\n" (Jmap.Error.error_to_string e);
380 exit 1
381 in
382
383 (* Get the primary account ID *)
384 let account_id = match Jmap.get_primary_account session Jmap_email.capability_mail with
385 | Ok id -> id
386 | Error e ->
387 Printf.eprintf "No mail account found: %s\n" (Jmap.Error.error_to_string e);
388 exit 1
389 in
390
391 (* Compose and send/save the email *)
392 compose_and_send ctx session account_id options
393
394(* Command definition *)
395let compose_cmd =
396 let doc = "compose and send emails via JMAP" in
397 let man = [
398 `S Manpage.s_description;
399 `P "Compose and send emails using the JMAP protocol.";
400 `P "Supports plain text and HTML bodies, attachments, and drafts.";
401 `S Manpage.s_examples;
402 `P "Send a simple email:";
403 `P " $(mname) -h jmap.example.com -u user@example.com -p secret123 \\";
404 `P " -t recipient@example.com -s \"Meeting reminder\" \\";
405 `P " --body \"Don't forget our meeting at 3pm!\"";
406 `P "";
407 `P "Send email with attachment:";
408 `P " $(mname) -h jmap.example.com -u user@example.com -p secret123 \\";
409 `P " -t recipient@example.com -s \"Report attached\" \\";
410 `P " --body-file message.txt -a report.pdf";
411 `P "";
412 `P "Save as draft:";
413 `P " $(mname) -h jmap.example.com -u user@example.com -p secret123 \\";
414 `P " -t recipient@example.com -s \"Work in progress\" \\";
415 `P " --body \"Still working on this...\" --draft";
416 ] in
417
418 let cmd =
419 Cmd.v
420 (Cmd.info "jmap-email-composer" ~version:"1.0" ~doc ~man)
421 Term.(const compose_command $ host_arg $ user_arg $ password_arg $
422 to_arg $ cc_arg $ bcc_arg $ subject_arg $ body_arg $ body_file_arg $
423 html_arg $ html_file_arg $ attach_arg $ reply_to_arg $
424 draft_arg $ send_arg)
425 in
426 cmd
427
428(* Main entry point *)
429let () = exit (Cmd.eval' compose_cmd)