My agentic slop goes here. Not intended for anyone else!
anil.recoil.org
1(** JMAP EmailSubmission Type
2
3 An EmailSubmission represents the submission of an Email for delivery
4 to one or more recipients. It tracks the delivery status and allows
5 for features like delayed sending and undo.
6
7open Jmap_core
8
9 Reference: RFC 8621 Section 7 (Email Submission)
10 Test files:
11 - test/data/mail/email_submission_get_request.json
12 - test/data/mail/email_submission_get_response.json
13*)
14
15(** SMTP Address with parameters (RFC 8621 Section 7.1.1) *)
16module Address = struct
17 type t = {
18 email : string; (** Email address *)
19 parameters : (string * string) list option; (** SMTP extension parameters *)
20 }
21
22 (** Accessors *)
23 let email t = t.email
24 let parameters t = t.parameters
25
26 (** Constructor *)
27 let v ~email ?parameters () = { email; parameters }
28
29 (** Parse Address from JSON.
30 Test files: test/data/mail/email_submission_get_response.json (envelope field)
31
32 Expected structure:
33 {
34 "email": "alice@example.com",
35 "parameters": null
36 }
37 *)
38 let of_json _json =
39 raise (Jmap_core.Error.Parse_error "Address.of_json not yet implemented")
40
41 let to_json _t =
42 raise (Jmap_core.Error.Parse_error "Address.to_json not yet implemented")
43end
44
45(** SMTP Envelope (RFC 8621 Section 7.1.1) *)
46module Envelope = struct
47 type t = {
48 mail_from : Address.t; (** MAIL FROM address *)
49 rcpt_to : Address.t list; (** RCPT TO addresses *)
50 }
51
52 (** Accessors *)
53 let mail_from t = t.mail_from
54 let rcpt_to t = t.rcpt_to
55
56 (** Constructor *)
57 let v ~mail_from ~rcpt_to = { mail_from; rcpt_to }
58
59 (** Parse Envelope from JSON.
60 Test files: test/data/mail/email_submission_get_response.json (envelope field)
61
62 Expected structure:
63 {
64 "mailFrom": {
65 "email": "alice@example.com",
66 "parameters": null
67 },
68 "rcptTo": [
69 {
70 "email": "bob@example.com",
71 "parameters": null
72 }
73 ]
74 }
75 *)
76 let of_json _json =
77 raise (Jmap_core.Error.Parse_error "Envelope.of_json not yet implemented")
78
79 let to_json _t =
80 raise (Jmap_core.Error.Parse_error "Envelope.to_json not yet implemented")
81end
82
83(** Delivery status for a single recipient (RFC 8621 Section 7.1.4) *)
84module DeliveryStatus = struct
85 (** Whether message was delivered *)
86 type delivered =
87 | Queued (** Message queued for delivery *)
88 | Yes (** Message delivered *)
89 | No (** Message not delivered (permanent failure) *)
90 | Unknown (** Delivery status unknown *)
91
92 (** Whether message was displayed (MDN) *)
93 type displayed =
94 | Unknown (** No MDN received *)
95 | Yes (** Positive MDN received *)
96
97 type t = {
98 smtp_reply : string; (** SMTP response string from server *)
99 delivered : delivered; (** Delivery status *)
100 displayed : displayed; (** Display status (from MDN) *)
101 }
102
103 (** Accessors *)
104 let smtp_reply t = t.smtp_reply
105 let delivered t = t.delivered
106 let displayed t = t.displayed
107
108 (** Constructor *)
109 let v ~smtp_reply ~delivered ~displayed = { smtp_reply; delivered; displayed }
110
111 (** Parse DeliveryStatus from JSON.
112 Test files: test/data/mail/email_submission_get_response.json (deliveryStatus field)
113
114 Expected structure:
115 {
116 "smtpReply": "250 2.0.0 OK",
117 "delivered": "yes",
118 "displayed": "unknown"
119 }
120 *)
121 let of_json _json =
122 raise (Jmap_core.Error.Parse_error "DeliveryStatus.of_json not yet implemented")
123
124 let to_json _t =
125 raise (Jmap_core.Error.Parse_error "DeliveryStatus.to_json not yet implemented")
126
127 let delivered_of_string = function
128 | "queued" -> Queued
129 | "yes" -> Yes
130 | "no" -> No
131 | "unknown" -> Unknown
132 | s -> raise (Invalid_argument ("Unknown delivered status: " ^ s))
133
134 let delivered_to_string = function
135 | Queued -> "queued"
136 | Yes -> "yes"
137 | No -> "no"
138 | Unknown -> "unknown"
139
140 let displayed_of_string = function
141 | "unknown" -> Unknown
142 | "yes" -> Yes
143 | s -> raise (Invalid_argument ("Unknown displayed status: " ^ s))
144
145 let displayed_to_string = function
146 | Unknown -> "unknown"
147 | Yes -> "yes"
148end
149
150(** Undo status (RFC 8621 Section 7.1.3) *)
151type undo_status =
152 | Pending (** Message can still be cancelled *)
153 | Final (** Message has been sent, cannot be cancelled *)
154 | Canceled (** Message was cancelled *)
155
156(** EmailSubmission object type (RFC 8621 Section 7.1) *)
157type t = {
158 id : Jmap_core.Id.t; (** Immutable server-assigned id *)
159 identity_id : Jmap_core.Id.t; (** Identity to send from *)
160 email_id : Jmap_core.Id.t; (** Email to send *)
161 thread_id : Jmap_core.Id.t; (** Thread ID of email *)
162 envelope : Envelope.t option; (** SMTP envelope (null = derive from headers) *)
163 send_at : Jmap_core.Primitives.UTCDate.t; (** When to send (may be in future) *)
164 undo_status : undo_status; (** Whether message can be cancelled *)
165 delivery_status : (string * DeliveryStatus.t) list option; (** Map of email to delivery status *)
166 dsn_blob_ids : Jmap_core.Id.t list; (** Blob IDs of received DSN messages *)
167 mdn_blob_ids : Jmap_core.Id.t list; (** Blob IDs of received MDN messages *)
168}
169
170(** Accessors *)
171let id t = t.id
172let identity_id t = t.identity_id
173let email_id t = t.email_id
174let thread_id t = t.thread_id
175let envelope t = t.envelope
176let send_at t = t.send_at
177let undo_status t = t.undo_status
178let delivery_status t = t.delivery_status
179let dsn_blob_ids t = t.dsn_blob_ids
180let mdn_blob_ids t = t.mdn_blob_ids
181
182(** Constructor *)
183let v ~id ~identity_id ~email_id ~thread_id ?envelope ~send_at ~undo_status ?delivery_status ~dsn_blob_ids ~mdn_blob_ids () =
184 { id; identity_id; email_id; thread_id; envelope; send_at; undo_status; delivery_status; dsn_blob_ids; mdn_blob_ids }
185
186(** Standard /get method (RFC 8621 Section 7.2) *)
187module Get = struct
188 type request = t Jmap_core.Standard_methods.Get.request
189 type response = t Jmap_core.Standard_methods.Get.response
190
191 (** Parse get request from JSON.
192 Test files: test/data/mail/email_submission_get_request.json
193
194 Expected structure:
195 {
196 "accountId": "u123456",
197 "ids": ["es001", "es002"]
198 }
199 *)
200 let request_of_json _json =
201 raise (Jmap_core.Error.Parse_error "EmailSubmission.Get.request_of_json not yet implemented")
202
203 (** Parse get response from JSON.
204 Test files: test/data/mail/email_submission_get_response.json
205
206 Expected structure:
207 {
208 "accountId": "u123456",
209 "state": "es42:100",
210 "list": [
211 {
212 "id": "es001",
213 "identityId": "id001",
214 "emailId": "e050",
215 "threadId": "t025",
216 "envelope": { ... },
217 "sendAt": "2025-10-07T09:30:00Z",
218 "undoStatus": "final",
219 "deliveryStatus": { ... },
220 "dsnBlobIds": [],
221 "mdnBlobIds": []
222 }
223 ],
224 "notFound": []
225 }
226 *)
227 let response_of_json _json =
228 raise (Jmap_core.Error.Parse_error "EmailSubmission.Get.response_of_json not yet implemented")
229end
230
231(** Standard /changes method (RFC 8621 Section 7.3) *)
232module Changes = struct
233 type request = Jmap_core.Standard_methods.Changes.request
234 type response = Jmap_core.Standard_methods.Changes.response
235
236 let request_of_json _json =
237 raise (Jmap_core.Error.Parse_error "EmailSubmission.Changes.request_of_json not yet implemented")
238
239 let response_of_json _json =
240 raise (Jmap_core.Error.Parse_error "EmailSubmission.Changes.response_of_json not yet implemented")
241end
242
243(** EmailSubmission-specific filter for /query (RFC 8621 Section 7.5) *)
244module Filter = struct
245 type t = {
246 identity_ids : Jmap_core.Id.t list option; (** Submission uses one of these identities *)
247 email_ids : Jmap_core.Id.t list option; (** Submission is for one of these emails *)
248 thread_ids : Jmap_core.Id.t list option; (** Submission is for email in one of these threads *)
249 undo_status : undo_status option; (** undoStatus equals this *)
250 before : Jmap_core.Primitives.UTCDate.t option; (** sendAt < this *)
251 after : Jmap_core.Primitives.UTCDate.t option; (** sendAt >= this *)
252 }
253
254 (** Accessors *)
255 let identity_ids t = t.identity_ids
256 let email_ids t = t.email_ids
257 let thread_ids t = t.thread_ids
258 let undo_status t = t.undo_status
259 let before t = t.before
260 let after t = t.after
261
262 (** Constructor *)
263 let v ?identity_ids ?email_ids ?thread_ids ?undo_status ?before ?after () =
264 { identity_ids; email_ids; thread_ids; undo_status; before; after }
265
266 let of_json _json =
267 raise (Jmap_core.Error.Parse_error "EmailSubmission.Filter.of_json not yet implemented")
268end
269
270(** Standard /query method (RFC 8621 Section 7.5) *)
271module Query = struct
272 type request = Filter.t Jmap_core.Standard_methods.Query.request
273 type response = Jmap_core.Standard_methods.Query.response
274
275 let request_of_json _json =
276 raise (Jmap_core.Error.Parse_error "EmailSubmission.Query.request_of_json not yet implemented")
277
278 let response_of_json _json =
279 raise (Jmap_core.Error.Parse_error "EmailSubmission.Query.response_of_json not yet implemented")
280end
281
282(** Standard /queryChanges method (RFC 8621 Section 7.6) *)
283module QueryChanges = struct
284 type request = Filter.t Jmap_core.Standard_methods.QueryChanges.request
285 type response = Jmap_core.Standard_methods.QueryChanges.response
286
287 let request_of_json _json =
288 raise (Jmap_core.Error.Parse_error "EmailSubmission.QueryChanges.request_of_json not yet implemented")
289
290 let response_of_json _json =
291 raise (Jmap_core.Error.Parse_error "EmailSubmission.QueryChanges.response_of_json not yet implemented")
292end
293
294(** Standard /set method (RFC 8621 Section 7.4)
295
296 EmailSubmission/set is used to:
297 - Create new submissions (send email)
298 - Update existing submissions (e.g., cancel pending send)
299 - Destroy submissions (for cleanup only - cannot unsend)
300*)
301module Set = struct
302 (** On success action for EmailSubmission/set create *)
303 type on_success = {
304 set_email_keywords : (Jmap_core.Id.t * (string * bool) list) option; (** Set keywords on sent email *)
305 }
306
307 type request = {
308 account_id : Jmap_core.Id.t;
309 if_in_state : string option;
310 create : (Jmap_core.Id.t * t) list option;
311 update : (Jmap_core.Id.t * Jmap_core.Standard_methods.Set.patch_object) list option;
312 destroy : Jmap_core.Id.t list option;
313 (* EmailSubmission-specific *)
314 on_success_update_email : (Jmap_core.Id.t * on_success) list option; (** Actions to perform on success *)
315 on_success_destroy_email : Jmap_core.Id.t list option; (** Email IDs to destroy on success *)
316 }
317
318 type response = t Jmap_core.Standard_methods.Set.response
319
320 (** Accessors for on_success *)
321 let on_success_set_email_keywords os = os.set_email_keywords
322
323 (** Constructor for on_success *)
324 let on_success_v ?set_email_keywords () =
325 { set_email_keywords }
326
327 (** Accessors for request *)
328 let account_id req = req.account_id
329 let if_in_state req = req.if_in_state
330 let create req = req.create
331 let update req = req.update
332 let destroy req = req.destroy
333 let on_success_update_email req = req.on_success_update_email
334 let on_success_destroy_email req = req.on_success_destroy_email
335
336 (** Constructor for request *)
337 let request_v ~account_id ?if_in_state ?create ?update ?destroy
338 ?on_success_update_email ?on_success_destroy_email () =
339 { account_id; if_in_state; create; update; destroy;
340 on_success_update_email; on_success_destroy_email }
341
342 let request_of_json _json =
343 raise (Jmap_core.Error.Parse_error "EmailSubmission.Set.request_of_json not yet implemented")
344
345 let response_of_json _json =
346 raise (Jmap_core.Error.Parse_error "EmailSubmission.Set.response_of_json not yet implemented")
347end
348
349(** Parser submodule *)
350module Parser = struct
351 (** Parse EmailSubmission from JSON.
352 Test files: test/data/mail/email_submission_get_response.json (list field)
353
354 Expected structure:
355 {
356 "id": "es001",
357 "identityId": "id001",
358 "emailId": "e050",
359 "threadId": "t025",
360 "envelope": {
361 "mailFrom": { "email": "alice@example.com", "parameters": null },
362 "rcptTo": [{ "email": "bob@example.com", "parameters": null }]
363 },
364 "sendAt": "2025-10-07T09:30:00Z",
365 "undoStatus": "final",
366 "deliveryStatus": {
367 "bob@example.com": {
368 "smtpReply": "250 2.0.0 OK",
369 "delivered": "yes",
370 "displayed": "unknown"
371 }
372 },
373 "dsnBlobIds": [],
374 "mdnBlobIds": []
375 }
376 *)
377 let of_json _json =
378 (* TODO: Implement JSON parsing *)
379 raise (Jmap_core.Error.Parse_error "EmailSubmission.Parser.of_json not yet implemented")
380
381 let to_json _t =
382 (* TODO: Implement JSON serialization *)
383 raise (Jmap_core.Error.Parse_error "EmailSubmission.Parser.to_json not yet implemented")
384end
385
386(** Helper functions for undo_status *)
387let undo_status_of_string = function
388 | "pending" -> Pending
389 | "final" -> Final
390 | "canceled" -> Canceled
391 | s -> raise (Invalid_argument ("Unknown undo status: " ^ s))
392
393let undo_status_to_string = function
394 | Pending -> "pending"
395 | Final -> "final"
396 | Canceled -> "canceled"