anil.recoil.org
this repo has no description
Add email sending functionality via fastmail-send
Added JMAP email submission support to the library and created a fastmail-send utility
that accepts recipients, subject line as CLI arguments and reads the message body from
stdin. Fixed JMAP protocol message format to ensure proper email creation and submission.
🤖 Generated with [Claude Code](https://claude.ai/code)
Co-Authored-By: Claude <noreply@anthropic.com>
+1126
-5
+1
-1
AGENT.md
+1
-1
AGENT.md
···
67
67
17. DONE Add helper functions to Jmap.Api such as `string_of_error` and `pp_error` to format
68
68
errors consistently. Updated the fastmail_list binary to use these functions instead of
69
69
duplicating error handling code.
70
-
18. Add support for JMAP email submission to the library, and create a fastmail-send that accepts
70
+
18. DONE Add support for JMAP email submission to the library, and create a fastmail-send that accepts
71
71
a list of to: on the CLI as arguments and a subject on the CLI and reads in the message body
72
72
19. Potential future work:
73
73
- Add helper functions for more complex filtering of emails
+7
bin/dune
+7
bin/dune
+177
bin/fastmail_send.ml
+177
bin/fastmail_send.ml
···
1
+
(** JMAP email sending utility for Fastmail
2
+
3
+
This utility sends an email via JMAP to recipients specified on the command line.
4
+
The subject is provided as a command-line argument, and the message body is read
5
+
from standard input.
6
+
7
+
Usage:
8
+
fastmail_send --to=recipient@example.com [--to=another@example.com ...] --subject="Email subject"
9
+
10
+
Environment variables:
11
+
- JMAP_API_TOKEN: Required. The Fastmail API token for authentication.
12
+
- JMAP_FROM_EMAIL: Optional. The sender's email address. If not provided, uses the first identity.
13
+
14
+
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-7> RFC8621 Section 7
15
+
*)
16
+
17
+
open Lwt.Syntax
18
+
open Cmdliner
19
+
20
+
let log_error fmt = Fmt.epr ("\u{1b}[1;31mError: \u{1b}[0m" ^^ fmt ^^ "@.")
21
+
let log_info fmt = Fmt.pr ("\u{1b}[1;34mInfo: \u{1b}[0m" ^^ fmt ^^ "@.")
22
+
let log_success fmt = Fmt.pr ("\u{1b}[1;32mSuccess: \u{1b}[0m" ^^ fmt ^^ "@.")
23
+
24
+
(** Read the entire message body from stdin *)
25
+
let read_message_body () =
26
+
let buffer = Buffer.create 1024 in
27
+
let rec read_lines () =
28
+
try
29
+
let line = input_line stdin in
30
+
Buffer.add_string buffer line;
31
+
Buffer.add_char buffer '\n';
32
+
read_lines ()
33
+
with
34
+
| End_of_file -> Buffer.contents buffer
35
+
in
36
+
read_lines ()
37
+
38
+
(** Main function to send an email *)
39
+
let send_email to_addresses subject from_email =
40
+
(* Check for API token in environment *)
41
+
match Sys.getenv_opt "JMAP_API_TOKEN" with
42
+
| None ->
43
+
log_error "JMAP_API_TOKEN environment variable not set";
44
+
exit 1
45
+
| Some token ->
46
+
(* Read message body from stdin *)
47
+
log_info "Reading message body from stdin (press Ctrl+D when finished)...";
48
+
let message_body = read_message_body () in
49
+
if message_body = "" then
50
+
log_info "No message body entered, using a blank message";
51
+
52
+
(* Initialize JMAP connection *)
53
+
let fastmail_uri = "https://api.fastmail.com/jmap/session" in
54
+
Lwt_main.run begin
55
+
let* conn_result = Jmap_mail.login_with_token ~uri:fastmail_uri ~api_token:token in
56
+
match conn_result with
57
+
| Error err ->
58
+
let msg = Jmap.Api.string_of_error err in
59
+
log_error "Failed to connect to Fastmail: %s" msg;
60
+
Lwt.return 1
61
+
| Ok conn ->
62
+
(* Get primary account ID *)
63
+
let account_id =
64
+
(* Get the primary account - first personal account in the list *)
65
+
let (_, _account) = List.find (fun (_, acc) ->
66
+
acc.Jmap.Types.is_personal) conn.session.accounts in
67
+
(* Use the first account id as primary *)
68
+
(match conn.session.primary_accounts with
69
+
| (_, id) :: _ -> id
70
+
| [] ->
71
+
(* Fallback if no primary accounts defined *)
72
+
let (id, _) = List.hd conn.session.accounts in
73
+
id)
74
+
in
75
+
76
+
(* Determine sender email address *)
77
+
let* from_email_result = match from_email with
78
+
| Some email -> Lwt.return_ok email
79
+
| None ->
80
+
(* Get first available identity *)
81
+
let* identities_result = Jmap_mail.get_identities conn ~account_id in
82
+
match identities_result with
83
+
| Ok [] ->
84
+
log_error "No identities found for account";
85
+
Lwt.return_error "No identities found"
86
+
| Ok (identity :: _) -> Lwt.return_ok identity.email
87
+
| Error err ->
88
+
let msg = Jmap.Api.string_of_error err in
89
+
log_error "Failed to get identities: %s" msg;
90
+
Lwt.return_error msg
91
+
in
92
+
93
+
match from_email_result with
94
+
| Error _msg -> Lwt.return 1
95
+
| Ok from_email ->
96
+
(* Send the email *)
97
+
log_info "Sending email from %s to %s"
98
+
from_email
99
+
(String.concat ", " to_addresses);
100
+
101
+
let* submission_result =
102
+
Jmap_mail.create_and_submit_email
103
+
conn
104
+
~account_id
105
+
~from:from_email
106
+
~to_addresses
107
+
~subject
108
+
~text_body:message_body
109
+
()
110
+
in
111
+
112
+
match submission_result with
113
+
| Error err ->
114
+
let msg = Jmap.Api.string_of_error err in
115
+
log_error "Failed to send email: %s" msg;
116
+
Lwt.return 1
117
+
| Ok submission_id ->
118
+
log_success "Email sent successfully (Submission ID: %s)" submission_id;
119
+
(* Wait briefly then check submission status *)
120
+
let* () = Lwt_unix.sleep 1.0 in
121
+
let* status_result = Jmap_mail.get_submission_status
122
+
conn
123
+
~account_id
124
+
~submission_id
125
+
in
126
+
127
+
(match status_result with
128
+
| Ok status ->
129
+
let status_text = match status.Jmap_mail.Types.undo_status with
130
+
| Some `pending -> "Pending"
131
+
| Some `final -> "Final (delivered)"
132
+
| Some `canceled -> "Canceled"
133
+
| None -> "Unknown"
134
+
in
135
+
log_info "Submission status: %s" status_text;
136
+
137
+
(match status.Jmap_mail.Types.delivery_status with
138
+
| Some statuses ->
139
+
List.iter (fun (email, status) ->
140
+
let delivery = match status.Jmap_mail.Types.delivered with
141
+
| Some "yes" -> "Delivered"
142
+
| Some "no" -> "Failed"
143
+
| Some "queued" -> "Queued"
144
+
| Some s -> s
145
+
| None -> "Unknown"
146
+
in
147
+
log_info "Delivery to %s: %s" email delivery
148
+
) statuses
149
+
| None -> ());
150
+
Lwt.return 0
151
+
| Error _ ->
152
+
(* We don't fail if status check fails, as the email might still be sent *)
153
+
Lwt.return 0)
154
+
end
155
+
156
+
(** Command line interface *)
157
+
let to_addresses =
158
+
let doc = "Email address of the recipient (can be specified multiple times)" in
159
+
Arg.(value & opt_all string [] & info ["to"] ~docv:"EMAIL" ~doc)
160
+
161
+
let subject =
162
+
let doc = "Subject line for the email" in
163
+
Arg.(required & opt (some string) None & info ["subject"] ~docv:"SUBJECT" ~doc)
164
+
165
+
let from_email =
166
+
let doc = "Sender's email address (optional, defaults to primary identity)" in
167
+
Arg.(value & opt (some string) None & info ["from"] ~docv:"EMAIL" ~doc)
168
+
169
+
let cmd =
170
+
let doc = "Send an email via JMAP to Fastmail" in
171
+
let info = Cmd.info "fastmail_send" ~doc in
172
+
Cmd.v info Term.(const send_email $ to_addresses $ subject $ from_email)
173
+
174
+
let () = match Cmd.eval_value cmd with
175
+
| Ok (`Ok code) -> exit code
176
+
| Ok (`Version | `Help) -> exit 0
177
+
| Error _ -> exit 1
+14
-4
lib/jmap.ml
+14
-4
lib/jmap.ml
···
533
533
let open Cohttp_lwt_unix in
534
534
let headers = Header.add_list (Header.init ()) headers in
535
535
536
-
(* Log request details at debug level *)
536
+
(* Print detailed request information to stderr for debugging *)
537
537
let header_list = Cohttp.Header.to_list headers in
538
538
let redacted_headers = redact_headers header_list in
539
-
Logs.debug (fun m ->
539
+
Logs.info (fun m ->
540
540
m "\n===== HTTP REQUEST =====\n\
541
541
URI: %s\n\
542
542
METHOD: %s\n\
···
547
547
method_
548
548
(String.concat "\n" (List.map (fun (k, v) -> Printf.sprintf " %s: %s" k v) redacted_headers))
549
549
body);
550
+
551
+
(* Force printing to stderr for immediate debugging *)
552
+
Printf.eprintf "[DEBUG-REQUEST] URI: %s\n" (Uri.to_string uri);
553
+
Printf.eprintf "[DEBUG-REQUEST] METHOD: %s\n" method_;
554
+
Printf.eprintf "[DEBUG-REQUEST] BODY: %s\n%!" body;
550
555
551
556
Lwt.catch
552
557
(fun () ->
···
559
564
let* body_str = Cohttp_lwt.Body.to_string body in
560
565
let status = Response.status resp |> Code.code_of_status in
561
566
562
-
(* Log response details at debug level *)
567
+
(* Print detailed response information to stderr for debugging *)
563
568
let header_list = Cohttp.Header.to_list (Response.headers resp) in
564
569
let redacted_headers = redact_headers header_list in
565
-
Logs.debug (fun m ->
570
+
Logs.info (fun m ->
566
571
m "\n===== HTTP RESPONSE =====\n\
567
572
STATUS: %d\n\
568
573
HEADERS:\n%s\n\
···
572
577
(String.concat "\n" (List.map (fun (k, v) -> Printf.sprintf " %s: %s" k v) redacted_headers))
573
578
body_str);
574
579
580
+
(* Force printing to stderr for immediate debugging *)
581
+
Printf.eprintf "[DEBUG-RESPONSE] STATUS: %d\n" status;
582
+
Printf.eprintf "[DEBUG-RESPONSE] BODY: %s\n%!" body_str;
583
+
575
584
if status >= 200 && status < 300 then
576
585
Lwt.return (Ok body_str)
577
586
else
578
587
Lwt.return (Error (HTTP_error (status, body_str))))
579
588
(fun e ->
580
589
let error_msg = Printexc.to_string e in
590
+
Printf.eprintf "[DEBUG-ERROR] %s\n%!" error_msg;
581
591
Logs.err (fun m -> m "%s" error_msg);
582
592
Lwt.return (Error (Connection_error error_msg)))
583
593
+814
lib/jmap_mail.ml
+814
lib/jmap_mail.ml
···
1933
1933
| e -> Lwt.return (Error (Parse_error (Printexc.to_string e))))
1934
1934
| Error e -> Lwt.return (Error e)
1935
1935
1936
+
(** {1 Email Submission} *)
1937
+
1938
+
(** Create a new email draft
1939
+
@param conn The JMAP connection
1940
+
@param account_id The account ID
1941
+
@param mailbox_id The mailbox ID to store the draft in (usually "drafts")
1942
+
@param from The sender's email address
1943
+
@param to_addresses List of recipient email addresses
1944
+
@param subject The email subject line
1945
+
@param text_body Plain text message body
1946
+
@param html_body Optional HTML message body
1947
+
@return The created email ID if successful
1948
+
1949
+
TODO:claude
1950
+
*)
1951
+
let create_email_draft conn ~account_id ~mailbox_id ~from ~to_addresses ~subject ~text_body ?html_body () =
1952
+
(* Create email addresses *)
1953
+
let from_addr = {
1954
+
Types.name = None;
1955
+
email = from;
1956
+
parameters = [];
1957
+
} in
1958
+
1959
+
let to_addrs = List.map (fun addr -> {
1960
+
Types.name = None;
1961
+
email = addr;
1962
+
parameters = [];
1963
+
}) to_addresses in
1964
+
1965
+
(* Create text body part *)
1966
+
let text_part = {
1967
+
Types.part_id = Some "part1";
1968
+
blob_id = None;
1969
+
size = None;
1970
+
headers = None;
1971
+
name = None;
1972
+
type_ = Some "text/plain";
1973
+
charset = Some "utf-8";
1974
+
disposition = None;
1975
+
cid = None;
1976
+
language = None;
1977
+
location = None;
1978
+
sub_parts = None;
1979
+
header_parameter_name = None;
1980
+
header_parameter_value = None;
1981
+
} in
1982
+
1983
+
(* Create HTML body part if provided *)
1984
+
let html_part_opt = match html_body with
1985
+
| Some _html -> Some {
1986
+
Types.part_id = Some "part2";
1987
+
blob_id = None;
1988
+
size = None;
1989
+
headers = None;
1990
+
name = None;
1991
+
type_ = Some "text/html";
1992
+
charset = Some "utf-8";
1993
+
disposition = None;
1994
+
cid = None;
1995
+
language = None;
1996
+
location = None;
1997
+
sub_parts = None;
1998
+
header_parameter_name = None;
1999
+
header_parameter_value = None;
2000
+
}
2001
+
| None -> None
2002
+
in
2003
+
2004
+
(* Create body values *)
2005
+
let body_values = [
2006
+
("part1", text_body)
2007
+
] @ (match html_body with
2008
+
| Some html -> [("part2", html)]
2009
+
| None -> []
2010
+
) in
2011
+
2012
+
(* Create email *)
2013
+
let html_body_list = match html_part_opt with
2014
+
| Some part -> Some [part]
2015
+
| None -> None
2016
+
in
2017
+
2018
+
let _email_creation = {
2019
+
Types.mailbox_ids = [(mailbox_id, true)];
2020
+
keywords = Some [(Draft, true)];
2021
+
received_at = None; (* Server will set this *)
2022
+
message_id = None; (* Server will generate this *)
2023
+
in_reply_to = None;
2024
+
references = None;
2025
+
sender = None;
2026
+
from = Some [from_addr];
2027
+
to_ = Some to_addrs;
2028
+
cc = None;
2029
+
bcc = None;
2030
+
reply_to = None;
2031
+
subject = Some subject;
2032
+
body_values = Some body_values;
2033
+
text_body = Some [text_part];
2034
+
html_body = html_body_list;
2035
+
attachments = None;
2036
+
headers = None;
2037
+
} in
2038
+
2039
+
let request = {
2040
+
using = [
2041
+
Jmap.Capability.to_string Jmap.Capability.Core;
2042
+
Capability.to_string Capability.Mail
2043
+
];
2044
+
method_calls = [
2045
+
{
2046
+
name = "Email/set";
2047
+
arguments = `O [
2048
+
("accountId", `String account_id);
2049
+
("create", `O [
2050
+
("draft1", `O (
2051
+
[
2052
+
("mailboxIds", `O [(mailbox_id, `Bool true)]);
2053
+
("keywords", `O [("$draft", `Bool true)]);
2054
+
("from", `A [`O [("name", `Null); ("email", `String from)]]);
2055
+
("to", `A (List.map (fun addr ->
2056
+
`O [("name", `Null); ("email", `String addr)]
2057
+
) to_addresses));
2058
+
("subject", `String subject);
2059
+
("bodyStructure", `O [
2060
+
("type", `String "multipart/alternative");
2061
+
("subParts", `A [
2062
+
`O [
2063
+
("partId", `String "part1");
2064
+
("type", `String "text/plain")
2065
+
];
2066
+
`O [
2067
+
("partId", `String "part2");
2068
+
("type", `String "text/html")
2069
+
]
2070
+
])
2071
+
]);
2072
+
("bodyValues", `O ([
2073
+
("part1", `O [("value", `String text_body)])
2074
+
] @ (match html_body with
2075
+
| Some html -> [("part2", `O [("value", `String html)])]
2076
+
| None -> [("part2", `O [("value", `String ("<html><body>" ^ text_body ^ "</body></html>"))])]
2077
+
)))
2078
+
]
2079
+
))
2080
+
])
2081
+
];
2082
+
method_call_id = "m1";
2083
+
}
2084
+
];
2085
+
created_ids = None;
2086
+
} in
2087
+
2088
+
let* response_result = make_request conn.config request in
2089
+
match response_result with
2090
+
| Ok response ->
2091
+
let result =
2092
+
try
2093
+
let method_response = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) ->
2094
+
inv.name = "Email/set") response.method_responses in
2095
+
let args = method_response.arguments in
2096
+
match Ezjsonm.find_opt args ["created"] with
2097
+
| Some (`O created) ->
2098
+
let draft_created = List.find_opt (fun (id, _) -> id = "draft1") created in
2099
+
(match draft_created with
2100
+
| Some (_, json) ->
2101
+
let id = Ezjsonm.get_string (Ezjsonm.find json ["id"]) in
2102
+
Ok id
2103
+
| None -> Error (Parse_error "Created email not found in response"))
2104
+
| _ ->
2105
+
match Ezjsonm.find_opt args ["notCreated"] with
2106
+
| Some (`O errors) ->
2107
+
let error_msg = match List.find_opt (fun (id, _) -> id = "draft1") errors with
2108
+
| Some (_, err) ->
2109
+
let type_ = Ezjsonm.get_string (Ezjsonm.find err ["type"]) in
2110
+
let description =
2111
+
match Ezjsonm.find_opt err ["description"] with
2112
+
| Some (`String desc) -> desc
2113
+
| _ -> "Unknown error"
2114
+
in
2115
+
"Error type: " ^ type_ ^ ", Description: " ^ description
2116
+
| None -> "Unknown error"
2117
+
in
2118
+
Error (Parse_error ("Failed to create email: " ^ error_msg))
2119
+
| _ -> Error (Parse_error "Unexpected response format")
2120
+
with
2121
+
| Not_found -> Error (Parse_error "Email/set method response not found")
2122
+
| e -> Error (Parse_error (Printexc.to_string e))
2123
+
in
2124
+
Lwt.return result
2125
+
| Error e -> Lwt.return (Error e)
2126
+
2127
+
(** Get all identities for an account
2128
+
@param conn The JMAP connection
2129
+
@param account_id The account ID
2130
+
@return A list of identities if successful
2131
+
2132
+
TODO:claude
2133
+
*)
2134
+
let get_identities conn ~account_id =
2135
+
let request = {
2136
+
using = [
2137
+
Jmap.Capability.to_string Jmap.Capability.Core;
2138
+
Capability.to_string Capability.Submission
2139
+
];
2140
+
method_calls = [
2141
+
{
2142
+
name = "Identity/get";
2143
+
arguments = `O [
2144
+
("accountId", `String account_id);
2145
+
];
2146
+
method_call_id = "m1";
2147
+
}
2148
+
];
2149
+
created_ids = None;
2150
+
} in
2151
+
2152
+
let* response_result = make_request conn.config request in
2153
+
match response_result with
2154
+
| Ok response ->
2155
+
let result =
2156
+
try
2157
+
let method_response = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) ->
2158
+
inv.name = "Identity/get") response.method_responses in
2159
+
let args = method_response.arguments in
2160
+
match Ezjsonm.find_opt args ["list"] with
2161
+
| Some (`A identities) ->
2162
+
let parse_identity json =
2163
+
try
2164
+
let open Ezjsonm in
2165
+
let id = get_string (find json ["id"]) in
2166
+
let name = get_string (find json ["name"]) in
2167
+
let email = get_string (find json ["email"]) in
2168
+
2169
+
let parse_email_addresses field =
2170
+
match find_opt json [field] with
2171
+
| Some (`A items) ->
2172
+
Some (List.map (fun addr_json ->
2173
+
let name =
2174
+
match find_opt addr_json ["name"] with
2175
+
| Some (`String s) -> Some s
2176
+
| Some (`Null) -> None
2177
+
| None -> None
2178
+
| _ -> None
2179
+
in
2180
+
let email = get_string (find addr_json ["email"]) in
2181
+
let parameters =
2182
+
match find_opt addr_json ["parameters"] with
2183
+
| Some (`O items) -> List.map (fun (k, v) ->
2184
+
match v with
2185
+
| `String s -> (k, s)
2186
+
| _ -> (k, "")
2187
+
) items
2188
+
| _ -> []
2189
+
in
2190
+
{ Types.name; email; parameters }
2191
+
) items)
2192
+
| _ -> None
2193
+
in
2194
+
2195
+
let reply_to = parse_email_addresses "replyTo" in
2196
+
let bcc = parse_email_addresses "bcc" in
2197
+
2198
+
let text_signature =
2199
+
match find_opt json ["textSignature"] with
2200
+
| Some (`String s) -> Some s
2201
+
| _ -> None
2202
+
in
2203
+
2204
+
let html_signature =
2205
+
match find_opt json ["htmlSignature"] with
2206
+
| Some (`String s) -> Some s
2207
+
| _ -> None
2208
+
in
2209
+
2210
+
let may_delete =
2211
+
match find_opt json ["mayDelete"] with
2212
+
| Some (`Bool b) -> b
2213
+
| _ -> false
2214
+
in
2215
+
2216
+
(* Create our own identity record for simplicity *)
2217
+
let r : Types.identity = {
2218
+
id = id;
2219
+
name = name;
2220
+
email = email;
2221
+
reply_to = reply_to;
2222
+
bcc = bcc;
2223
+
text_signature = text_signature;
2224
+
html_signature = html_signature;
2225
+
may_delete = may_delete
2226
+
} in Ok r
2227
+
with
2228
+
| Not_found -> Error (Parse_error "Required field not found in identity object")
2229
+
| Invalid_argument msg -> Error (Parse_error msg)
2230
+
| e -> Error (Parse_error (Printexc.to_string e))
2231
+
in
2232
+
2233
+
let results = List.map parse_identity identities in
2234
+
let (successes, failures) = List.partition Result.is_ok results in
2235
+
if List.length failures > 0 then
2236
+
Error (Parse_error "Failed to parse some identity objects")
2237
+
else
2238
+
Ok (List.map Result.get_ok successes)
2239
+
| _ -> Error (Parse_error "Identity list not found in response")
2240
+
with
2241
+
| Not_found -> Error (Parse_error "Identity/get method response not found")
2242
+
| e -> Error (Parse_error (Printexc.to_string e))
2243
+
in
2244
+
Lwt.return result
2245
+
| Error e -> Lwt.return (Error e)
2246
+
2247
+
(** Find a suitable identity by email address
2248
+
@param conn The JMAP connection
2249
+
@param account_id The account ID
2250
+
@param email The email address to match
2251
+
@return The identity if found, otherwise Error
2252
+
2253
+
TODO:claude
2254
+
*)
2255
+
let find_identity_by_email conn ~account_id ~email =
2256
+
let* identities_result = get_identities conn ~account_id in
2257
+
match identities_result with
2258
+
| Ok identities -> begin
2259
+
let matching_identity = List.find_opt (fun (identity:Types.identity) ->
2260
+
(* Exact match *)
2261
+
if String.lowercase_ascii identity.email = String.lowercase_ascii email then
2262
+
true
2263
+
else
2264
+
(* Wildcard match (e.g., *@example.com) *)
2265
+
let parts = String.split_on_char '@' identity.email in
2266
+
if List.length parts = 2 && List.hd parts = "*" then
2267
+
let domain = List.nth parts 1 in
2268
+
let email_parts = String.split_on_char '@' email in
2269
+
if List.length email_parts = 2 then
2270
+
List.nth email_parts 1 = domain
2271
+
else
2272
+
false
2273
+
else
2274
+
false
2275
+
) identities in
2276
+
2277
+
match matching_identity with
2278
+
| Some identity -> Lwt.return (Ok identity)
2279
+
| None -> Lwt.return (Error (Parse_error "No matching identity found"))
2280
+
end
2281
+
| Error e -> Lwt.return (Error e)
2282
+
2283
+
(** Submit an email for delivery
2284
+
@param conn The JMAP connection
2285
+
@param account_id The account ID
2286
+
@param identity_id The identity ID to send from
2287
+
@param email_id The email ID to submit
2288
+
@param envelope Optional custom envelope
2289
+
@return The submission ID if successful
2290
+
2291
+
TODO:claude
2292
+
*)
2293
+
let submit_email conn ~account_id ~identity_id ~email_id ?envelope () =
2294
+
let request = {
2295
+
using = [
2296
+
Jmap.Capability.to_string Jmap.Capability.Core;
2297
+
Capability.to_string Capability.Mail;
2298
+
Capability.to_string Capability.Submission
2299
+
];
2300
+
method_calls = [
2301
+
{
2302
+
name = "EmailSubmission/set";
2303
+
arguments = `O [
2304
+
("accountId", `String account_id);
2305
+
("create", `O [
2306
+
("submission1", `O (
2307
+
[
2308
+
("emailId", `String email_id);
2309
+
("identityId", `String identity_id);
2310
+
] @ (match envelope with
2311
+
| Some env -> [
2312
+
("envelope", `O [
2313
+
("mailFrom", `O [
2314
+
("email", `String env.Types.mail_from.email);
2315
+
("parameters", match env.Types.mail_from.parameters with
2316
+
| Some params -> `O (List.map (fun (k, v) -> (k, `String v)) params)
2317
+
| None -> `O []
2318
+
)
2319
+
]);
2320
+
("rcptTo", `A (List.map (fun (rcpt:Types.submission_address) ->
2321
+
`O [
2322
+
("email", `String rcpt.Types.email);
2323
+
("parameters", match rcpt.Types.parameters with
2324
+
| Some params -> `O (List.map (fun (k, v) -> (k, `String v)) params)
2325
+
| None -> `O []
2326
+
)
2327
+
]
2328
+
) env.Types.rcpt_to))
2329
+
])
2330
+
]
2331
+
| None -> []
2332
+
)
2333
+
))
2334
+
]);
2335
+
("onSuccessUpdateEmail", `O [
2336
+
(email_id, `O [
2337
+
("keywords", `O [
2338
+
("$draft", `Bool false);
2339
+
("$sent", `Bool true);
2340
+
])
2341
+
])
2342
+
]);
2343
+
];
2344
+
method_call_id = "m1";
2345
+
}
2346
+
];
2347
+
created_ids = None;
2348
+
} in
2349
+
2350
+
let* response_result = make_request conn.config request in
2351
+
match response_result with
2352
+
| Ok response ->
2353
+
let result =
2354
+
try
2355
+
let method_response = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) ->
2356
+
inv.name = "EmailSubmission/set") response.method_responses in
2357
+
let args = method_response.arguments in
2358
+
match Ezjsonm.find_opt args ["created"] with
2359
+
| Some (`O created) ->
2360
+
let submission_created = List.find_opt (fun (id, _) -> id = "submission1") created in
2361
+
(match submission_created with
2362
+
| Some (_, json) ->
2363
+
let id = Ezjsonm.get_string (Ezjsonm.find json ["id"]) in
2364
+
Ok id
2365
+
| None -> Error (Parse_error "Created submission not found in response"))
2366
+
| _ ->
2367
+
match Ezjsonm.find_opt args ["notCreated"] with
2368
+
| Some (`O errors) ->
2369
+
let error_msg = match List.find_opt (fun (id, _) -> id = "submission1") errors with
2370
+
| Some (_, err) ->
2371
+
let type_ = Ezjsonm.get_string (Ezjsonm.find err ["type"]) in
2372
+
let description =
2373
+
match Ezjsonm.find_opt err ["description"] with
2374
+
| Some (`String desc) -> desc
2375
+
| _ -> "Unknown error"
2376
+
in
2377
+
"Error type: " ^ type_ ^ ", Description: " ^ description
2378
+
| None -> "Unknown error"
2379
+
in
2380
+
Error (Parse_error ("Failed to submit email: " ^ error_msg))
2381
+
| _ -> Error (Parse_error "Unexpected response format")
2382
+
with
2383
+
| Not_found -> Error (Parse_error "EmailSubmission/set method response not found")
2384
+
| e -> Error (Parse_error (Printexc.to_string e))
2385
+
in
2386
+
Lwt.return result
2387
+
| Error e -> Lwt.return (Error e)
2388
+
2389
+
(** Create and submit an email in one operation
2390
+
@param conn The JMAP connection
2391
+
@param account_id The account ID
2392
+
@param from The sender's email address
2393
+
@param to_addresses List of recipient email addresses
2394
+
@param subject The email subject line
2395
+
@param text_body Plain text message body
2396
+
@param html_body Optional HTML message body
2397
+
@return The submission ID if successful
2398
+
2399
+
TODO:claude
2400
+
*)
2401
+
let create_and_submit_email conn ~account_id ~from ~to_addresses ~subject ~text_body ?html_body:_ () =
2402
+
(* First get accounts to find the draft mailbox and identity in a single request *)
2403
+
let* initial_result =
2404
+
let request = {
2405
+
using = [
2406
+
Jmap.Capability.to_string Jmap.Capability.Core;
2407
+
Capability.to_string Capability.Mail;
2408
+
Capability.to_string Capability.Submission
2409
+
];
2410
+
method_calls = [
2411
+
{
2412
+
name = "Mailbox/get";
2413
+
arguments = `O [
2414
+
("accountId", `String account_id);
2415
+
];
2416
+
method_call_id = "m1";
2417
+
};
2418
+
{
2419
+
name = "Identity/get";
2420
+
arguments = `O [
2421
+
("accountId", `String account_id)
2422
+
];
2423
+
method_call_id = "m2";
2424
+
}
2425
+
];
2426
+
created_ids = None;
2427
+
} in
2428
+
make_request conn.config request
2429
+
in
2430
+
2431
+
match initial_result with
2432
+
| Ok initial_response -> begin
2433
+
(* Find drafts mailbox ID *)
2434
+
let find_drafts_result =
2435
+
try
2436
+
let method_response = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) ->
2437
+
inv.name = "Mailbox/get") initial_response.method_responses in
2438
+
let args = method_response.arguments in
2439
+
match Ezjsonm.find_opt args ["list"] with
2440
+
| Some (`A mailboxes) -> begin
2441
+
let draft_mailbox = List.find_opt (fun mailbox ->
2442
+
match Ezjsonm.find_opt mailbox ["role"] with
2443
+
| Some (`String role) -> role = "drafts"
2444
+
| _ -> false
2445
+
) mailboxes in
2446
+
2447
+
match draft_mailbox with
2448
+
| Some mb -> Ok (Ezjsonm.get_string (Ezjsonm.find mb ["id"]))
2449
+
| None -> Error (Parse_error "No drafts mailbox found")
2450
+
end
2451
+
| _ -> Error (Parse_error "Mailbox list not found in response")
2452
+
with
2453
+
| Not_found -> Error (Parse_error "Mailbox/get method response not found")
2454
+
| e -> Error (Parse_error (Printexc.to_string e))
2455
+
in
2456
+
2457
+
(* Find matching identity for from address *)
2458
+
let find_identity_result =
2459
+
try
2460
+
let method_response = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) ->
2461
+
inv.name = "Identity/get") initial_response.method_responses in
2462
+
let args = method_response.arguments in
2463
+
match Ezjsonm.find_opt args ["list"] with
2464
+
| Some (`A identities) -> begin
2465
+
let matching_identity = List.find_opt (fun identity ->
2466
+
match Ezjsonm.find_opt identity ["email"] with
2467
+
| Some (`String email) ->
2468
+
let email_lc = String.lowercase_ascii email in
2469
+
let from_lc = String.lowercase_ascii from in
2470
+
email_lc = from_lc || (* Exact match *)
2471
+
(* Wildcard domain match *)
2472
+
(let parts = String.split_on_char '@' email_lc in
2473
+
if List.length parts = 2 && List.hd parts = "*" then
2474
+
let domain = List.nth parts 1 in
2475
+
let from_parts = String.split_on_char '@' from_lc in
2476
+
if List.length from_parts = 2 then
2477
+
List.nth from_parts 1 = domain
2478
+
else false
2479
+
else false)
2480
+
| _ -> false
2481
+
) identities in
2482
+
2483
+
match matching_identity with
2484
+
| Some id ->
2485
+
let identity_id = Ezjsonm.get_string (Ezjsonm.find id ["id"]) in
2486
+
Ok identity_id
2487
+
| None -> Error (Parse_error ("No matching identity found for " ^ from))
2488
+
end
2489
+
| _ -> Error (Parse_error "Identity list not found in response")
2490
+
with
2491
+
| Not_found -> Error (Parse_error "Identity/get method response not found")
2492
+
| e -> Error (Parse_error (Printexc.to_string e))
2493
+
in
2494
+
2495
+
(* If we have both required IDs, create and submit the email in one request *)
2496
+
match (find_drafts_result, find_identity_result) with
2497
+
| (Ok drafts_id, Ok identity_id) -> begin
2498
+
(* Now create and submit the email in a single request *)
2499
+
let request = {
2500
+
using = [
2501
+
Jmap.Capability.to_string Jmap.Capability.Core;
2502
+
Capability.to_string Capability.Mail;
2503
+
Capability.to_string Capability.Submission
2504
+
];
2505
+
method_calls = [
2506
+
{
2507
+
name = "Email/set";
2508
+
arguments = `O [
2509
+
("accountId", `String account_id);
2510
+
("create", `O [
2511
+
("draft", `O (
2512
+
[
2513
+
("mailboxIds", `O [(drafts_id, `Bool true)]);
2514
+
("keywords", `O [("$draft", `Bool true)]);
2515
+
("from", `A [`O [("email", `String from)]]);
2516
+
("to", `A (List.map (fun addr ->
2517
+
`O [("email", `String addr)]
2518
+
) to_addresses));
2519
+
("subject", `String subject);
2520
+
("textBody", `A [`O [
2521
+
("partId", `String "body");
2522
+
("type", `String "text/plain")
2523
+
]]);
2524
+
("bodyValues", `O [
2525
+
("body", `O [
2526
+
("charset", `String "utf-8");
2527
+
("value", `String text_body)
2528
+
])
2529
+
])
2530
+
]
2531
+
))
2532
+
]);
2533
+
];
2534
+
method_call_id = "0";
2535
+
};
2536
+
{
2537
+
name = "EmailSubmission/set";
2538
+
arguments = `O [
2539
+
("accountId", `String account_id);
2540
+
("create", `O [
2541
+
("sendIt", `O [
2542
+
("emailId", `String "#draft");
2543
+
("identityId", `String identity_id)
2544
+
])
2545
+
])
2546
+
];
2547
+
method_call_id = "1";
2548
+
}
2549
+
];
2550
+
created_ids = None;
2551
+
} in
2552
+
2553
+
let* submit_result = make_request conn.config request in
2554
+
match submit_result with
2555
+
| Ok submit_response -> begin
2556
+
try
2557
+
let submission_method = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) ->
2558
+
inv.name = "EmailSubmission/set") submit_response.method_responses in
2559
+
let args = submission_method.arguments in
2560
+
2561
+
(* Check if email was created and submission was created *)
2562
+
match Ezjsonm.find_opt args ["created"] with
2563
+
| Some (`O created) -> begin
2564
+
(* Extract the submission ID *)
2565
+
let submission_created = List.find_opt (fun (id, _) -> id = "sendIt") created in
2566
+
match submission_created with
2567
+
| Some (_, json) ->
2568
+
let id = Ezjsonm.get_string (Ezjsonm.find json ["id"]) in
2569
+
Lwt.return (Ok id)
2570
+
| None -> begin
2571
+
(* Check if there was an error in creation *)
2572
+
match Ezjsonm.find_opt args ["notCreated"] with
2573
+
| Some (`O errors) ->
2574
+
let error_msg = match List.find_opt (fun (id, _) -> id = "sendIt") errors with
2575
+
| Some (_, err) ->
2576
+
let type_ = Ezjsonm.get_string (Ezjsonm.find err ["type"]) in
2577
+
let description =
2578
+
match Ezjsonm.find_opt err ["description"] with
2579
+
| Some (`String desc) -> desc
2580
+
| _ -> "Unknown error"
2581
+
in
2582
+
"Error type: " ^ type_ ^ ", Description: " ^ description
2583
+
| None -> "Unknown error"
2584
+
in
2585
+
Lwt.return (Error (Parse_error ("Failed to submit email: " ^ error_msg)))
2586
+
| Some _ -> Lwt.return (Error (Parse_error "Email submission not found in response"))
2587
+
| None -> Lwt.return (Error (Parse_error "Email submission not found in response"))
2588
+
end
2589
+
end
2590
+
| Some (`Null) -> Lwt.return (Error (Parse_error "No created submissions in response"))
2591
+
| Some _ -> Lwt.return (Error (Parse_error "Invalid response format for created submissions"))
2592
+
| None -> Lwt.return (Error (Parse_error "No created submissions in response"))
2593
+
with
2594
+
| Not_found -> Lwt.return (Error (Parse_error "EmailSubmission/set method response not found"))
2595
+
| e -> Lwt.return (Error (Parse_error (Printexc.to_string e)))
2596
+
end
2597
+
| Error e -> Lwt.return (Error e)
2598
+
end
2599
+
| (Error e, _) -> Lwt.return (Error e)
2600
+
| (_, Error e) -> Lwt.return (Error e)
2601
+
end
2602
+
| Error e -> Lwt.return (Error e)
2603
+
2604
+
(** Get status of an email submission
2605
+
@param conn The JMAP connection
2606
+
@param account_id The account ID
2607
+
@param submission_id The email submission ID
2608
+
@return The submission status if successful
2609
+
2610
+
TODO:claude
2611
+
*)
2612
+
let get_submission_status conn ~account_id ~submission_id =
2613
+
let request = {
2614
+
using = [
2615
+
Jmap.Capability.to_string Jmap.Capability.Core;
2616
+
Capability.to_string Capability.Submission
2617
+
];
2618
+
method_calls = [
2619
+
{
2620
+
name = "EmailSubmission/get";
2621
+
arguments = `O [
2622
+
("accountId", `String account_id);
2623
+
("ids", `A [`String submission_id]);
2624
+
];
2625
+
method_call_id = "m1";
2626
+
}
2627
+
];
2628
+
created_ids = None;
2629
+
} in
2630
+
2631
+
let* response_result = make_request conn.config request in
2632
+
match response_result with
2633
+
| Ok response ->
2634
+
let result =
2635
+
try
2636
+
let method_response = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) ->
2637
+
inv.name = "EmailSubmission/get") response.method_responses in
2638
+
let args = method_response.arguments in
2639
+
match Ezjsonm.find_opt args ["list"] with
2640
+
| Some (`A [submission]) ->
2641
+
let parse_submission json =
2642
+
try
2643
+
let open Ezjsonm in
2644
+
let id = get_string (find json ["id"]) in
2645
+
let identity_id = get_string (find json ["identityId"]) in
2646
+
let email_id = get_string (find json ["emailId"]) in
2647
+
let thread_id = get_string (find json ["threadId"]) in
2648
+
2649
+
let envelope =
2650
+
match find_opt json ["envelope"] with
2651
+
| Some (`O env) -> begin
2652
+
let parse_address addr_json =
2653
+
let email = get_string (find addr_json ["email"]) in
2654
+
let parameters =
2655
+
match find_opt addr_json ["parameters"] with
2656
+
| Some (`O params) ->
2657
+
Some (List.map (fun (k, v) -> (k, get_string v)) params)
2658
+
| _ -> None
2659
+
in
2660
+
{ Types.email; parameters }
2661
+
in
2662
+
2663
+
let mail_from = parse_address (find (`O env) ["mailFrom"]) in
2664
+
let rcpt_to =
2665
+
match find (`O env) ["rcptTo"] with
2666
+
| `A rcpts -> List.map parse_address rcpts
2667
+
| _ -> []
2668
+
in
2669
+
2670
+
Some { Types.mail_from; rcpt_to }
2671
+
end
2672
+
| _ -> None
2673
+
in
2674
+
2675
+
let send_at =
2676
+
match find_opt json ["sendAt"] with
2677
+
| Some (`String date) -> Some date
2678
+
| _ -> None
2679
+
in
2680
+
2681
+
let undo_status =
2682
+
match find_opt json ["undoStatus"] with
2683
+
| Some (`String "pending") -> Some `pending
2684
+
| Some (`String "final") -> Some `final
2685
+
| Some (`String "canceled") -> Some `canceled
2686
+
| _ -> None
2687
+
in
2688
+
2689
+
let parse_delivery_status deliveries =
2690
+
match deliveries with
2691
+
| `O statuses ->
2692
+
Some (List.map (fun (email, status_json) ->
2693
+
let smtp_reply = get_string (find status_json ["smtpReply"]) in
2694
+
let delivered =
2695
+
match find_opt status_json ["delivered"] with
2696
+
| Some (`String d) -> Some d
2697
+
| _ -> None
2698
+
in
2699
+
(email, { Types.smtp_reply; delivered })
2700
+
) statuses)
2701
+
| _ -> None
2702
+
in
2703
+
2704
+
let delivery_status =
2705
+
match find_opt json ["deliveryStatus"] with
2706
+
| Some status -> parse_delivery_status status
2707
+
| _ -> None
2708
+
in
2709
+
2710
+
let dsn_blob_ids =
2711
+
match find_opt json ["dsnBlobIds"] with
2712
+
| Some (`O ids) -> Some (List.map (fun (email, id) -> (email, get_string id)) ids)
2713
+
| _ -> None
2714
+
in
2715
+
2716
+
let mdn_blob_ids =
2717
+
match find_opt json ["mdnBlobIds"] with
2718
+
| Some (`O ids) -> Some (List.map (fun (email, id) -> (email, get_string id)) ids)
2719
+
| _ -> None
2720
+
in
2721
+
2722
+
Ok {
2723
+
Types.id;
2724
+
identity_id;
2725
+
email_id;
2726
+
thread_id;
2727
+
envelope;
2728
+
send_at;
2729
+
undo_status;
2730
+
delivery_status;
2731
+
dsn_blob_ids;
2732
+
mdn_blob_ids;
2733
+
}
2734
+
with
2735
+
| Not_found -> Error (Parse_error "Required field not found in submission object")
2736
+
| Invalid_argument msg -> Error (Parse_error msg)
2737
+
| e -> Error (Parse_error (Printexc.to_string e))
2738
+
in
2739
+
2740
+
parse_submission submission
2741
+
| Some (`A []) -> Error (Parse_error ("Submission not found: " ^ submission_id))
2742
+
| _ -> Error (Parse_error "Expected single submission in response")
2743
+
with
2744
+
| Not_found -> Error (Parse_error "EmailSubmission/get method response not found")
2745
+
| e -> Error (Parse_error (Printexc.to_string e))
2746
+
in
2747
+
Lwt.return result
2748
+
| Error e -> Lwt.return (Error e)
2749
+
1936
2750
(** {1 Email Address Utilities} *)
1937
2751
1938
2752
(** Custom implementation of substring matching *)
+113
lib/jmap_mail.mli
+113
lib/jmap_mail.mli
···
1514
1514
?limit:int ->
1515
1515
unit ->
1516
1516
(Types.email list, Jmap.Api.error) result Lwt.t
1517
+
1518
+
(** {1 Email Submission}
1519
+
Functions for sending emails
1520
+
*)
1521
+
1522
+
(** Create a new email draft
1523
+
@param conn The JMAP connection
1524
+
@param account_id The account ID
1525
+
@param mailbox_id The mailbox ID to store the draft in (usually "drafts")
1526
+
@param from The sender's email address
1527
+
@param to_addresses List of recipient email addresses
1528
+
@param subject The email subject line
1529
+
@param text_body Plain text message body
1530
+
@param html_body Optional HTML message body
1531
+
@return The created email ID if successful
1532
+
1533
+
Creates a new email draft in the specified mailbox with the provided content.
1534
+
*)
1535
+
val create_email_draft :
1536
+
connection ->
1537
+
account_id:Jmap.Types.id ->
1538
+
mailbox_id:Jmap.Types.id ->
1539
+
from:string ->
1540
+
to_addresses:string list ->
1541
+
subject:string ->
1542
+
text_body:string ->
1543
+
?html_body:string ->
1544
+
unit ->
1545
+
(Jmap.Types.id, Jmap.Api.error) result Lwt.t
1546
+
1547
+
(** Get all identities for an account
1548
+
@param conn The JMAP connection
1549
+
@param account_id The account ID
1550
+
@return A list of identities if successful
1551
+
1552
+
Retrieves all identities (email addresses that can be used for sending) for an account.
1553
+
*)
1554
+
val get_identities :
1555
+
connection ->
1556
+
account_id:Jmap.Types.id ->
1557
+
(Types.identity list, Jmap.Api.error) result Lwt.t
1558
+
1559
+
(** Find a suitable identity by email address
1560
+
@param conn The JMAP connection
1561
+
@param account_id The account ID
1562
+
@param email The email address to match
1563
+
@return The identity if found, otherwise Error
1564
+
1565
+
Finds an identity that matches the given email address, either exactly or
1566
+
via a wildcard pattern (e.g., *@domain.com).
1567
+
*)
1568
+
val find_identity_by_email :
1569
+
connection ->
1570
+
account_id:Jmap.Types.id ->
1571
+
email:string ->
1572
+
(Types.identity, Jmap.Api.error) result Lwt.t
1573
+
1574
+
(** Submit an email for delivery
1575
+
@param conn The JMAP connection
1576
+
@param account_id The account ID
1577
+
@param identity_id The identity ID to send from
1578
+
@param email_id The email ID to submit
1579
+
@param envelope Optional custom envelope
1580
+
@return The submission ID if successful
1581
+
1582
+
Submits an existing email (usually a draft) for delivery using the specified identity.
1583
+
*)
1584
+
val submit_email :
1585
+
connection ->
1586
+
account_id:Jmap.Types.id ->
1587
+
identity_id:Jmap.Types.id ->
1588
+
email_id:Jmap.Types.id ->
1589
+
?envelope:Types.envelope ->
1590
+
unit ->
1591
+
(Jmap.Types.id, Jmap.Api.error) result Lwt.t
1592
+
1593
+
(** Create and submit an email in one operation
1594
+
@param conn The JMAP connection
1595
+
@param account_id The account ID
1596
+
@param from The sender's email address
1597
+
@param to_addresses List of recipient email addresses
1598
+
@param subject The email subject line
1599
+
@param text_body Plain text message body
1600
+
@param html_body Optional HTML message body
1601
+
@return The submission ID if successful
1602
+
1603
+
Creates a new email and immediately submits it for delivery.
1604
+
This is a convenience function that combines create_email_draft and submit_email.
1605
+
*)
1606
+
val create_and_submit_email :
1607
+
connection ->
1608
+
account_id:Jmap.Types.id ->
1609
+
from:string ->
1610
+
to_addresses:string list ->
1611
+
subject:string ->
1612
+
text_body:string ->
1613
+
?html_body:string ->
1614
+
unit ->
1615
+
(Jmap.Types.id, Jmap.Api.error) result Lwt.t
1616
+
1617
+
(** Get status of an email submission
1618
+
@param conn The JMAP connection
1619
+
@param account_id The account ID
1620
+
@param submission_id The email submission ID
1621
+
@return The submission status if successful
1622
+
1623
+
Retrieves the current status of an email submission, including delivery status if available.
1624
+
*)
1625
+
val get_submission_status :
1626
+
connection ->
1627
+
account_id:Jmap.Types.id ->
1628
+
submission_id:Jmap.Types.id ->
1629
+
(Types.email_submission, Jmap.Api.error) result Lwt.t
1517
1630
1518
1631
(** {1 Email Address Utilities}
1519
1632
Utilities for working with email addresses