jon.recoil.org
forked from
anil.recoil.org/ocaml-jmap
this repo has no description
1(*---------------------------------------------------------------------------
2 Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3 SPDX-License-Identifier: ISC
4 ---------------------------------------------------------------------------*)
5
6(* EmailSubmission properties *)
7
8type property = [
9 | `Id
10 | `Identity_id
11 | `Email_id
12 | `Thread_id
13 | `Envelope
14 | `Send_at
15 | `Undo_status
16 | `Delivery_status
17 | `Dsn_blob_ids
18 | `Mdn_blob_ids
19]
20
21let property_to_string : [< property ] -> string = function
22 | `Id -> "id"
23 | `Identity_id -> "identityId"
24 | `Email_id -> "emailId"
25 | `Thread_id -> "threadId"
26 | `Envelope -> "envelope"
27 | `Send_at -> "sendAt"
28 | `Undo_status -> "undoStatus"
29 | `Delivery_status -> "deliveryStatus"
30 | `Dsn_blob_ids -> "dsnBlobIds"
31 | `Mdn_blob_ids -> "mdnBlobIds"
32
33let property_of_string s : property option =
34 match s with
35 | "id" -> Some `Id
36 | "identityId" -> Some `Identity_id
37 | "emailId" -> Some `Email_id
38 | "threadId" -> Some `Thread_id
39 | "envelope" -> Some `Envelope
40 | "sendAt" -> Some `Send_at
41 | "undoStatus" -> Some `Undo_status
42 | "deliveryStatus" -> Some `Delivery_status
43 | "dsnBlobIds" -> Some `Dsn_blob_ids
44 | "mdnBlobIds" -> Some `Mdn_blob_ids
45 | _ -> None
46
47module Address = struct
48 type t = {
49 email : string;
50 parameters : (string * string) list option;
51 }
52
53 let email t = t.email
54 let parameters t = t.parameters
55
56 let make email parameters = { email; parameters }
57
58 let jsont =
59 let kind = "EmailSubmission Address" in
60 Jsont.Object.map ~kind make
61 |> Jsont.Object.mem "email" Jsont.string ~enc:email
62 |> Jsont.Object.opt_mem "parameters" (Proto_json_map.of_string Jsont.string) ~enc:parameters
63 |> Jsont.Object.finish
64end
65
66module Envelope = struct
67 type t = {
68 mail_from : Address.t;
69 rcpt_to : Address.t list;
70 }
71
72 let mail_from t = t.mail_from
73 let rcpt_to t = t.rcpt_to
74
75 let make mail_from rcpt_to = { mail_from; rcpt_to }
76
77 let jsont =
78 let kind = "Envelope" in
79 Jsont.Object.map ~kind make
80 |> Jsont.Object.mem "mailFrom" Address.jsont ~enc:mail_from
81 |> Jsont.Object.mem "rcptTo" (Jsont.list Address.jsont) ~enc:rcpt_to
82 |> Jsont.Object.finish
83end
84
85module Delivery_status = struct
86 type delivered = [ `Queued | `Yes | `No | `Unknown ]
87
88 let delivered_to_string = function
89 | `Queued -> "queued"
90 | `Yes -> "yes"
91 | `No -> "no"
92 | `Unknown -> "unknown"
93
94 let delivered_of_string = function
95 | "queued" -> `Queued
96 | "yes" -> `Yes
97 | "no" -> `No
98 | _ -> `Unknown
99
100 let delivered_jsont =
101 Jsont.map ~kind:"DeliveryStatus.delivered"
102 ~dec:delivered_of_string ~enc:delivered_to_string Jsont.string
103
104 type displayed = [ `Unknown | `Yes ]
105
106 let displayed_to_string = function
107 | `Unknown -> "unknown"
108 | `Yes -> "yes"
109
110 let displayed_of_string = function
111 | "yes" -> `Yes
112 | _ -> `Unknown
113
114 let displayed_jsont =
115 Jsont.map ~kind:"DeliveryStatus.displayed"
116 ~dec:displayed_of_string ~enc:displayed_to_string Jsont.string
117
118 type t = {
119 smtp_reply : string;
120 delivered : delivered;
121 displayed : displayed;
122 }
123
124 let smtp_reply t = t.smtp_reply
125 let delivered t = t.delivered
126 let displayed t = t.displayed
127
128 let make smtp_reply delivered displayed =
129 { smtp_reply; delivered; displayed }
130
131 let jsont =
132 let kind = "DeliveryStatus" in
133 Jsont.Object.map ~kind make
134 |> Jsont.Object.mem "smtpReply" Jsont.string ~enc:smtp_reply
135 |> Jsont.Object.mem "delivered" delivered_jsont ~enc:delivered
136 |> Jsont.Object.mem "displayed" displayed_jsont ~enc:displayed
137 |> Jsont.Object.finish
138end
139
140type undo_status = [ `Pending | `Final | `Canceled ]
141
142let undo_status_to_string = function
143 | `Pending -> "pending"
144 | `Final -> "final"
145 | `Canceled -> "canceled"
146
147let undo_status_of_string = function
148 | "pending" -> `Pending
149 | "final" -> `Final
150 | "canceled" -> `Canceled
151 | s -> Jsont.Error.msgf Jsont.Meta.none "Unknown undo status: %s" s
152
153let undo_status_jsont =
154 Jsont.map ~kind:"UndoStatus"
155 ~dec:undo_status_of_string ~enc:undo_status_to_string Jsont.string
156
157type t = {
158 id : Proto_id.t option;
159 identity_id : Proto_id.t option;
160 email_id : Proto_id.t option;
161 thread_id : Proto_id.t option;
162 envelope : Envelope.t option;
163 send_at : Ptime.t option;
164 undo_status : undo_status option;
165 delivery_status : (string * Delivery_status.t) list option;
166 dsn_blob_ids : Proto_id.t list option;
167 mdn_blob_ids : Proto_id.t list option;
168}
169
170let id t = t.id
171let identity_id t = t.identity_id
172let email_id t = t.email_id
173let thread_id t = t.thread_id
174let envelope t = t.envelope
175let send_at t = t.send_at
176let undo_status t = t.undo_status
177let delivery_status t = t.delivery_status
178let dsn_blob_ids t = t.dsn_blob_ids
179let mdn_blob_ids t = t.mdn_blob_ids
180
181let make id identity_id email_id thread_id envelope send_at undo_status
182 delivery_status dsn_blob_ids mdn_blob_ids =
183 { id; identity_id; email_id; thread_id; envelope; send_at; undo_status;
184 delivery_status; dsn_blob_ids; mdn_blob_ids }
185
186let jsont =
187 let kind = "EmailSubmission" in
188 Jsont.Object.map ~kind make
189 |> Jsont.Object.opt_mem "id" Proto_id.jsont ~enc:id
190 |> Jsont.Object.opt_mem "identityId" Proto_id.jsont ~enc:identity_id
191 |> Jsont.Object.opt_mem "emailId" Proto_id.jsont ~enc:email_id
192 |> Jsont.Object.opt_mem "threadId" Proto_id.jsont ~enc:thread_id
193 |> Jsont.Object.opt_mem "envelope" Envelope.jsont ~enc:envelope
194 |> Jsont.Object.opt_mem "sendAt" Proto_date.Utc.jsont ~enc:send_at
195 |> Jsont.Object.opt_mem "undoStatus" undo_status_jsont ~enc:undo_status
196 |> Jsont.Object.opt_mem "deliveryStatus" (Proto_json_map.of_string Delivery_status.jsont) ~enc:delivery_status
197 |> Jsont.Object.opt_mem "dsnBlobIds" (Jsont.list Proto_id.jsont) ~enc:dsn_blob_ids
198 |> Jsont.Object.opt_mem "mdnBlobIds" (Jsont.list Proto_id.jsont) ~enc:mdn_blob_ids
199 |> Jsont.Object.finish
200
201module Filter_condition = struct
202 type t = {
203 identity_ids : Proto_id.t list option;
204 email_ids : Proto_id.t list option;
205 thread_ids : Proto_id.t list option;
206 undo_status : undo_status option;
207 before : Ptime.t option;
208 after : Ptime.t option;
209 }
210
211 let make identity_ids email_ids thread_ids undo_status before after =
212 { identity_ids; email_ids; thread_ids; undo_status; before; after }
213
214 let jsont =
215 let kind = "EmailSubmissionFilterCondition" in
216 Jsont.Object.map ~kind make
217 |> Jsont.Object.opt_mem "identityIds" (Jsont.list Proto_id.jsont) ~enc:(fun f -> f.identity_ids)
218 |> Jsont.Object.opt_mem "emailIds" (Jsont.list Proto_id.jsont) ~enc:(fun f -> f.email_ids)
219 |> Jsont.Object.opt_mem "threadIds" (Jsont.list Proto_id.jsont) ~enc:(fun f -> f.thread_ids)
220 |> Jsont.Object.opt_mem "undoStatus" undo_status_jsont ~enc:(fun f -> f.undo_status)
221 |> Jsont.Object.opt_mem "before" Proto_date.Utc.jsont ~enc:(fun f -> f.before)
222 |> Jsont.Object.opt_mem "after" Proto_date.Utc.jsont ~enc:(fun f -> f.after)
223 |> Jsont.Object.finish
224end