anil.recoil.org
+3
-2
bin/dune
+3
-2
bin/dune
-114
bin/flag_color_test.ml
-114
bin/flag_color_test.ml
···
1
-
(** Demo of message flags and mailbox attributes functionality *)
2
-
3
-
open Jmap_mail.Types
4
-
5
-
(** Demonstrate flag color functionality *)
6
-
let demo_flag_colors () =
7
-
Printf.printf "Flag Color Demo:\n";
8
-
Printf.printf "================\n";
9
-
10
-
(* Show all flag colors and their bit patterns *)
11
-
let colors = [Red; Orange; Yellow; Green; Blue; Purple; Gray] in
12
-
List.iter (fun color ->
13
-
let (bit0, bit1, bit2) = bits_of_flag_color color in
14
-
Printf.printf "Color: %-7s Bits: %d%d%d\n"
15
-
(match color with
16
-
| Red -> "Red"
17
-
| Orange -> "Orange"
18
-
| Yellow -> "Yellow"
19
-
| Green -> "Green"
20
-
| Blue -> "Blue"
21
-
| Purple -> "Purple"
22
-
| Gray -> "Gray")
23
-
(if bit0 then 1 else 0)
24
-
(if bit1 then 1 else 0)
25
-
(if bit2 then 1 else 0)
26
-
) colors;
27
-
28
-
Printf.printf "\n"
29
-
30
-
(** Demonstrate message keyword functionality *)
31
-
let demo_message_keywords () =
32
-
Printf.printf "Message Keywords Demo:\n";
33
-
Printf.printf "=====================\n";
34
-
35
-
(* Show all standard message keywords and their string representations *)
36
-
let keywords = [
37
-
Notify; Muted; Followed; Memo; HasMemo; HasAttachment; HasNoAttachment;
38
-
AutoSent; Unsubscribed; CanUnsubscribe; Imported; IsTrusted;
39
-
MaskedEmail; New; MailFlagBit0; MailFlagBit1; MailFlagBit2
40
-
] in
41
-
42
-
List.iter (fun kw ->
43
-
Printf.printf "%-15s -> %s\n"
44
-
(match kw with
45
-
| Notify -> "Notify"
46
-
| Muted -> "Muted"
47
-
| Followed -> "Followed"
48
-
| Memo -> "Memo"
49
-
| HasMemo -> "HasMemo"
50
-
| HasAttachment -> "HasAttachment"
51
-
| HasNoAttachment -> "HasNoAttachment"
52
-
| AutoSent -> "AutoSent"
53
-
| Unsubscribed -> "Unsubscribed"
54
-
| CanUnsubscribe -> "CanUnsubscribe"
55
-
| Imported -> "Imported"
56
-
| IsTrusted -> "IsTrusted"
57
-
| MaskedEmail -> "MaskedEmail"
58
-
| New -> "New"
59
-
| MailFlagBit0 -> "MailFlagBit0"
60
-
| MailFlagBit1 -> "MailFlagBit1"
61
-
| MailFlagBit2 -> "MailFlagBit2"
62
-
| OtherKeyword s -> "Other: " ^ s)
63
-
(string_of_message_keyword kw)
64
-
) keywords;
65
-
66
-
Printf.printf "\n"
67
-
68
-
(** Demonstrate mailbox attribute functionality *)
69
-
let demo_mailbox_attributes () =
70
-
Printf.printf "Mailbox Attributes Demo:\n";
71
-
Printf.printf "=======================\n";
72
-
73
-
(* Show all standard mailbox attributes and their string representations *)
74
-
let attributes = [Snoozed; Scheduled; Memos] in
75
-
76
-
List.iter (fun attr ->
77
-
Printf.printf "%-10s -> %s\n"
78
-
(match attr with
79
-
| Snoozed -> "Snoozed"
80
-
| Scheduled -> "Scheduled"
81
-
| Memos -> "Memos"
82
-
| OtherAttribute s -> "Other: " ^ s)
83
-
(string_of_mailbox_attribute attr)
84
-
) attributes;
85
-
86
-
Printf.printf "\n"
87
-
88
-
(** Demonstrate formatting functionality *)
89
-
let demo_formatting () =
90
-
Printf.printf "Keyword Formatting Demo:\n";
91
-
Printf.printf "======================\n";
92
-
93
-
(* Create a sample email with various keywords *)
94
-
let sample_keywords = [
95
-
(Flagged, true); (* Standard flag *)
96
-
(Custom "$MailFlagBit0", true); (* Flag color bit *)
97
-
(Custom "$MailFlagBit2", true); (* Flag color bit *)
98
-
(Custom "$notify", true); (* Message keyword *)
99
-
(Custom "$followed", true); (* Message keyword *)
100
-
(Custom "$hasattachment", true); (* Message keyword *)
101
-
(Seen, false); (* Inactive keyword *)
102
-
(Custom "$random", true); (* Unknown keyword *)
103
-
] in
104
-
105
-
(* Test formatted output *)
106
-
let formatted = format_email_keywords sample_keywords in
107
-
Printf.printf "Formatted keywords: %s\n\n" formatted
108
-
109
-
(** Main entry point *)
110
-
let () =
111
-
demo_flag_colors ();
112
-
demo_message_keywords ();
113
-
demo_mailbox_attributes ();
114
-
demo_formatting ()
+749
bin/jmap.ml
+749
bin/jmap.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** JMAP command-line client *)
7
+
8
+
open Cmdliner
9
+
10
+
(** {1 Helpers} *)
11
+
12
+
let ptime_to_string t =
13
+
let (y, m, d), ((hh, mm, ss), _tz) = Ptime.to_date_time t in
14
+
Printf.sprintf "%04d-%02d-%02d %02d:%02d:%02d" y m d hh mm ss
15
+
16
+
let truncate_string max_len s =
17
+
if String.length s <= max_len then s
18
+
else String.sub s 0 (max_len - 3) ^ "..."
19
+
20
+
let format_email_address (addr : Jmap_mail.Email_address.t) =
21
+
match addr.name with
22
+
| Some name -> Printf.sprintf "%s <%s>" name addr.email
23
+
| None -> addr.email
24
+
25
+
let format_email_addresses addrs =
26
+
String.concat ", " (List.map format_email_address addrs)
27
+
28
+
let format_keywords keywords =
29
+
keywords
30
+
|> List.filter_map (fun (k, v) -> if v then Some k else None)
31
+
|> String.concat " "
32
+
33
+
(** {1 Session Command} *)
34
+
35
+
let session_cmd =
36
+
let run cfg =
37
+
Eio_main.run @@ fun env ->
38
+
Eio.Switch.run @@ fun sw ->
39
+
let client = Jmap_eio.Cli.create_client ~sw env cfg in
40
+
let session = Jmap_eio.Client.session client in
41
+
42
+
Fmt.pr "@[<v>%a@," Fmt.(styled `Bold string) "Session Information:";
43
+
Fmt.pr " Username: %a@," Fmt.(styled `Green string) session.username;
44
+
Fmt.pr " State: %s@," session.state;
45
+
Fmt.pr " API URL: %s@," session.api_url;
46
+
Fmt.pr " Upload URL: %s@," session.upload_url;
47
+
Fmt.pr " Download URL: %s@," session.download_url;
48
+
Fmt.pr "@, %a@," Fmt.(styled `Bold string) "Capabilities:";
49
+
List.iter (fun (cap, _) ->
50
+
Fmt.pr " %s@," cap
51
+
) session.capabilities;
52
+
Fmt.pr "@, %a@," Fmt.(styled `Bold string) "Accounts:";
53
+
List.iter (fun (id, acct) ->
54
+
let acct : Jmap_proto.Session.Account.t = acct in
55
+
Fmt.pr " %a: %s (personal=%b, read_only=%b)@,"
56
+
Fmt.(styled `Cyan string) (Jmap_proto.Id.to_string id)
57
+
acct.name acct.is_personal acct.is_read_only
58
+
) session.accounts;
59
+
Fmt.pr "@, %a@," Fmt.(styled `Bold string) "Primary Accounts:";
60
+
List.iter (fun (cap, id) ->
61
+
Fmt.pr " %s: %s@," cap (Jmap_proto.Id.to_string id)
62
+
) session.primary_accounts;
63
+
Fmt.pr "@]@."
64
+
in
65
+
let doc = "Show JMAP session information" in
66
+
let info = Cmd.info "session" ~doc in
67
+
Cmd.v info Term.(const run $ Jmap_eio.Cli.config_term)
68
+
69
+
(** {1 Mailboxes Command} *)
70
+
71
+
let mailboxes_cmd =
72
+
let run cfg =
73
+
Eio_main.run @@ fun env ->
74
+
Eio.Switch.run @@ fun sw ->
75
+
let client = Jmap_eio.Cli.create_client ~sw env cfg in
76
+
let account_id = Jmap_eio.Cli.get_account_id cfg client in
77
+
78
+
Jmap_eio.Cli.debug cfg "Fetching mailboxes for account %s" (Jmap_proto.Id.to_string account_id);
79
+
80
+
let req = Jmap_eio.Client.Build.(
81
+
make_request
82
+
~capabilities:[Jmap_proto.Capability.core; Jmap_proto.Capability.mail]
83
+
[mailbox_get ~call_id:"m1" ~account_id ()]
84
+
) in
85
+
86
+
match Jmap_eio.Client.request client req with
87
+
| Error e ->
88
+
Fmt.epr "Error: %s@." (Jmap_eio.Client.error_to_string e);
89
+
exit 1
90
+
| Ok response ->
91
+
match Jmap_eio.Client.Parse.parse_mailbox_get ~call_id:"m1" response with
92
+
| Error e ->
93
+
Fmt.epr "Parse error: %s@." (Jsont.Error.to_string e);
94
+
exit 1
95
+
| Ok result ->
96
+
Fmt.pr "@[<v>%a (state: %s)@,@,"
97
+
Fmt.(styled `Bold string) "Mailboxes"
98
+
result.state;
99
+
(* Sort by sort_order then name *)
100
+
let sorted = List.sort (fun (a : Jmap_mail.Mailbox.t) (b : Jmap_mail.Mailbox.t) ->
101
+
let cmp = Int64.compare a.sort_order b.sort_order in
102
+
if cmp <> 0 then cmp else String.compare a.name b.name
103
+
) result.list in
104
+
List.iter (fun (mbox : Jmap_mail.Mailbox.t) ->
105
+
let role_str = match mbox.role with
106
+
| Some role -> Printf.sprintf " [%s]" (Jmap_mail.Mailbox.role_to_string role)
107
+
| None -> ""
108
+
in
109
+
Fmt.pr " %a %s%a (%Ld total, %Ld unread)@,"
110
+
Fmt.(styled `Cyan string) (Jmap_proto.Id.to_string mbox.id)
111
+
mbox.name
112
+
Fmt.(styled `Yellow string) role_str
113
+
mbox.total_emails mbox.unread_emails
114
+
) sorted;
115
+
Fmt.pr "@]@."
116
+
in
117
+
let doc = "List mailboxes" in
118
+
let info = Cmd.info "mailboxes" ~doc in
119
+
Cmd.v info Term.(const run $ Jmap_eio.Cli.config_term)
120
+
121
+
(** {1 Emails Command} *)
122
+
123
+
let emails_cmd =
124
+
let limit_term =
125
+
let doc = "Maximum number of emails to list" in
126
+
Arg.(value & opt int 20 & info ["limit"; "n"] ~docv:"N" ~doc)
127
+
in
128
+
let mailbox_term =
129
+
let doc = "Mailbox ID to filter by" in
130
+
Arg.(value & opt (some string) None & info ["mailbox"; "m"] ~docv:"ID" ~doc)
131
+
in
132
+
let run cfg limit mailbox_id_str =
133
+
Eio_main.run @@ fun env ->
134
+
Eio.Switch.run @@ fun sw ->
135
+
let client = Jmap_eio.Cli.create_client ~sw env cfg in
136
+
let account_id = Jmap_eio.Cli.get_account_id cfg client in
137
+
138
+
Jmap_eio.Cli.debug cfg "Querying emails with limit %d" limit;
139
+
140
+
(* Build filter if mailbox specified *)
141
+
let filter = match mailbox_id_str with
142
+
| Some id_str ->
143
+
let mailbox_id = Jmap_proto.Id.of_string_exn id_str in
144
+
let cond : Jmap_mail.Email.Filter_condition.t = {
145
+
in_mailbox = Some mailbox_id;
146
+
in_mailbox_other_than = None;
147
+
before = None; after = None;
148
+
min_size = None; max_size = None;
149
+
all_in_thread_have_keyword = None;
150
+
some_in_thread_have_keyword = None;
151
+
none_in_thread_have_keyword = None;
152
+
has_keyword = None; not_keyword = None;
153
+
has_attachment = None;
154
+
text = None; from = None; to_ = None;
155
+
cc = None; bcc = None; subject = None;
156
+
body = None; header = None;
157
+
} in
158
+
Some (Jmap_proto.Filter.Condition cond)
159
+
| None -> None
160
+
in
161
+
162
+
let sort = [Jmap_proto.Filter.comparator ~is_ascending:false "receivedAt"] in
163
+
let query_inv = Jmap_eio.Client.Build.email_query
164
+
~call_id:"q1"
165
+
~account_id
166
+
?filter
167
+
~sort
168
+
~limit:(Int64.of_int limit)
169
+
()
170
+
in
171
+
172
+
let req = Jmap_eio.Client.Build.(
173
+
make_request
174
+
~capabilities:[Jmap_proto.Capability.core; Jmap_proto.Capability.mail]
175
+
[query_inv]
176
+
) in
177
+
178
+
match Jmap_eio.Client.request client req with
179
+
| Error e ->
180
+
Fmt.epr "Error: %s@." (Jmap_eio.Client.error_to_string e);
181
+
exit 1
182
+
| Ok response ->
183
+
match Jmap_eio.Client.Parse.parse_email_query ~call_id:"q1" response with
184
+
| Error e ->
185
+
Fmt.epr "Parse error: %s@." (Jsont.Error.to_string e);
186
+
exit 1
187
+
| Ok query_result ->
188
+
let email_ids = query_result.ids in
189
+
Jmap_eio.Cli.debug cfg "Found %d email IDs" (List.length email_ids);
190
+
191
+
if List.length email_ids = 0 then (
192
+
Fmt.pr "No emails found.@.";
193
+
) else (
194
+
(* Fetch email details *)
195
+
let get_inv = Jmap_eio.Client.Build.email_get
196
+
~call_id:"g1"
197
+
~account_id
198
+
~ids:email_ids
199
+
~properties:["id"; "blobId"; "threadId"; "mailboxIds"; "keywords";
200
+
"size"; "receivedAt"; "subject"; "from"; "preview"]
201
+
()
202
+
in
203
+
let req2 = Jmap_eio.Client.Build.(
204
+
make_request
205
+
~capabilities:[Jmap_proto.Capability.core; Jmap_proto.Capability.mail]
206
+
[get_inv]
207
+
) in
208
+
209
+
match Jmap_eio.Client.request client req2 with
210
+
| Error e ->
211
+
Fmt.epr "Error: %s@." (Jmap_eio.Client.error_to_string e);
212
+
exit 1
213
+
| Ok response2 ->
214
+
match Jmap_eio.Client.Parse.parse_email_get ~call_id:"g1" response2 with
215
+
| Error e ->
216
+
Fmt.epr "Parse error: %s@." (Jsont.Error.to_string e);
217
+
exit 1
218
+
| Ok get_result ->
219
+
Fmt.pr "@[<v>%a (showing %d of %s)@,@,"
220
+
Fmt.(styled `Bold string) "Emails"
221
+
(List.length get_result.list)
222
+
(match query_result.total with
223
+
| Some n -> Int64.to_string n
224
+
| None -> "?");
225
+
List.iter (fun (email : Jmap_mail.Email.t) ->
226
+
let from_str = match email.from with
227
+
| Some addrs -> format_email_addresses addrs
228
+
| None -> "(unknown)"
229
+
in
230
+
let subject = Option.value email.subject ~default:"(no subject)" in
231
+
let flags = format_keywords email.keywords in
232
+
let flag_str = if flags = "" then "" else " [" ^ flags ^ "]" in
233
+
Fmt.pr " %a %s@,"
234
+
Fmt.(styled `Cyan string) (Jmap_proto.Id.to_string email.id)
235
+
(ptime_to_string email.received_at);
236
+
Fmt.pr " From: %s@," (truncate_string 60 from_str);
237
+
Fmt.pr " Subject: %a%s@,"
238
+
Fmt.(styled `White string) (truncate_string 60 subject)
239
+
flag_str;
240
+
Fmt.pr " Preview: %s@,@,"
241
+
(truncate_string 70 email.preview);
242
+
) get_result.list;
243
+
Fmt.pr "@]@."
244
+
)
245
+
in
246
+
let doc = "List emails" in
247
+
let info = Cmd.info "emails" ~doc in
248
+
Cmd.v info Term.(const run $ Jmap_eio.Cli.config_term $ limit_term $ mailbox_term)
249
+
250
+
(** {1 Search Command} *)
251
+
252
+
let search_cmd =
253
+
let query_term =
254
+
let doc = "Search query text" in
255
+
Arg.(required & pos 0 (some string) None & info [] ~docv:"QUERY" ~doc)
256
+
in
257
+
let limit_term =
258
+
let doc = "Maximum number of results" in
259
+
Arg.(value & opt int 20 & info ["limit"; "n"] ~docv:"N" ~doc)
260
+
in
261
+
let run cfg query limit =
262
+
Eio_main.run @@ fun env ->
263
+
Eio.Switch.run @@ fun sw ->
264
+
let client = Jmap_eio.Cli.create_client ~sw env cfg in
265
+
let account_id = Jmap_eio.Cli.get_account_id cfg client in
266
+
267
+
Jmap_eio.Cli.debug cfg "Searching for: %s" query;
268
+
269
+
(* Build text filter *)
270
+
let cond : Jmap_mail.Email.Filter_condition.t = {
271
+
in_mailbox = None; in_mailbox_other_than = None;
272
+
before = None; after = None;
273
+
min_size = None; max_size = None;
274
+
all_in_thread_have_keyword = None;
275
+
some_in_thread_have_keyword = None;
276
+
none_in_thread_have_keyword = None;
277
+
has_keyword = None; not_keyword = None;
278
+
has_attachment = None;
279
+
text = Some query;
280
+
from = None; to_ = None;
281
+
cc = None; bcc = None; subject = None;
282
+
body = None; header = None;
283
+
} in
284
+
let filter = Jmap_proto.Filter.Condition cond in
285
+
286
+
let sort = [Jmap_proto.Filter.comparator ~is_ascending:false "receivedAt"] in
287
+
let query_inv = Jmap_eio.Client.Build.email_query
288
+
~call_id:"q1"
289
+
~account_id
290
+
~filter
291
+
~sort
292
+
~limit:(Int64.of_int limit)
293
+
()
294
+
in
295
+
296
+
let req = Jmap_eio.Client.Build.(
297
+
make_request
298
+
~capabilities:[Jmap_proto.Capability.core; Jmap_proto.Capability.mail]
299
+
[query_inv]
300
+
) in
301
+
302
+
match Jmap_eio.Client.request client req with
303
+
| Error e ->
304
+
Fmt.epr "Error: %s@." (Jmap_eio.Client.error_to_string e);
305
+
exit 1
306
+
| Ok response ->
307
+
match Jmap_eio.Client.Parse.parse_email_query ~call_id:"q1" response with
308
+
| Error e ->
309
+
Fmt.epr "Parse error: %s@." (Jsont.Error.to_string e);
310
+
exit 1
311
+
| Ok query_result ->
312
+
let email_ids = query_result.ids in
313
+
314
+
if List.length email_ids = 0 then (
315
+
Fmt.pr "No emails found matching: %s@." query;
316
+
) else (
317
+
(* Fetch email details *)
318
+
let get_inv = Jmap_eio.Client.Build.email_get
319
+
~call_id:"g1"
320
+
~account_id
321
+
~ids:email_ids
322
+
~properties:["id"; "blobId"; "threadId"; "mailboxIds"; "keywords";
323
+
"size"; "receivedAt"; "subject"; "from"; "preview"]
324
+
()
325
+
in
326
+
let req2 = Jmap_eio.Client.Build.(
327
+
make_request
328
+
~capabilities:[Jmap_proto.Capability.core; Jmap_proto.Capability.mail]
329
+
[get_inv]
330
+
) in
331
+
332
+
match Jmap_eio.Client.request client req2 with
333
+
| Error e ->
334
+
Fmt.epr "Error: %s@." (Jmap_eio.Client.error_to_string e);
335
+
exit 1
336
+
| Ok response2 ->
337
+
match Jmap_eio.Client.Parse.parse_email_get ~call_id:"g1" response2 with
338
+
| Error e ->
339
+
Fmt.epr "Parse error: %s@." (Jsont.Error.to_string e);
340
+
exit 1
341
+
| Ok get_result ->
342
+
Fmt.pr "@[<v>%a for \"%s\" (%d results)@,@,"
343
+
Fmt.(styled `Bold string) "Search results"
344
+
query
345
+
(List.length get_result.list);
346
+
List.iter (fun (email : Jmap_mail.Email.t) ->
347
+
let from_str = match email.from with
348
+
| Some addrs -> format_email_addresses addrs
349
+
| None -> "(unknown)"
350
+
in
351
+
let subject = Option.value email.subject ~default:"(no subject)" in
352
+
Fmt.pr " %a %s@,"
353
+
Fmt.(styled `Cyan string) (Jmap_proto.Id.to_string email.id)
354
+
(ptime_to_string email.received_at);
355
+
Fmt.pr " From: %s@," (truncate_string 60 from_str);
356
+
Fmt.pr " Subject: %a@,"
357
+
Fmt.(styled `White string) (truncate_string 60 subject);
358
+
Fmt.pr " Preview: %s@,@,"
359
+
(truncate_string 70 email.preview);
360
+
) get_result.list;
361
+
Fmt.pr "@]@."
362
+
)
363
+
in
364
+
let doc = "Search emails by text" in
365
+
let info = Cmd.info "search" ~doc in
366
+
Cmd.v info Term.(const run $ Jmap_eio.Cli.config_term $ query_term $ limit_term)
367
+
368
+
(** {1 Recent Command - chains query + get for detailed listing} *)
369
+
370
+
let recent_cmd =
371
+
let limit_term =
372
+
let doc = "Number of recent emails to show (max 100)" in
373
+
Arg.(value & opt int 100 & info ["limit"; "n"] ~docv:"N" ~doc)
374
+
in
375
+
let format_term =
376
+
let doc = "Output format: table, compact, or detailed" in
377
+
Arg.(value & opt (enum ["table", `Table; "compact", `Compact; "detailed", `Detailed])
378
+
`Table & info ["format"; "f"] ~docv:"FORMAT" ~doc)
379
+
in
380
+
let run cfg limit format =
381
+
let limit = min limit 100 in
382
+
Eio_main.run @@ fun env ->
383
+
Eio.Switch.run @@ fun sw ->
384
+
let client = Jmap_eio.Cli.create_client ~sw env cfg in
385
+
let account_id = Jmap_eio.Cli.get_account_id cfg client in
386
+
387
+
Jmap_eio.Cli.debug cfg "Fetching %d most recent emails" limit;
388
+
389
+
(* Query for recent emails *)
390
+
let sort = [Jmap_proto.Filter.comparator ~is_ascending:false "receivedAt"] in
391
+
let query_inv = Jmap_eio.Client.Build.email_query
392
+
~call_id:"q1"
393
+
~account_id
394
+
~sort
395
+
~limit:(Int64.of_int limit)
396
+
()
397
+
in
398
+
399
+
let req = Jmap_eio.Client.Build.(
400
+
make_request
401
+
~capabilities:[Jmap_proto.Capability.core; Jmap_proto.Capability.mail]
402
+
[query_inv]
403
+
) in
404
+
405
+
match Jmap_eio.Client.request client req with
406
+
| Error e ->
407
+
Fmt.epr "Error: %s@." (Jmap_eio.Client.error_to_string e);
408
+
exit 1
409
+
| Ok response ->
410
+
match Jmap_eio.Client.Parse.parse_email_query ~call_id:"q1" response with
411
+
| Error e ->
412
+
Fmt.epr "Parse error: %s@." (Jsont.Error.to_string e);
413
+
exit 1
414
+
| Ok query_result ->
415
+
let email_ids = query_result.ids in
416
+
Jmap_eio.Cli.debug cfg "Query returned %d email IDs" (List.length email_ids);
417
+
418
+
if List.length email_ids = 0 then (
419
+
Fmt.pr "No emails found.@."
420
+
) else (
421
+
(* Fetch full details for all emails *)
422
+
let properties = [
423
+
"id"; "blobId"; "threadId"; "mailboxIds"; "keywords"; "size";
424
+
"receivedAt"; "subject"; "from"; "to"; "cc"; "preview"
425
+
] in
426
+
let get_inv = Jmap_eio.Client.Build.email_get
427
+
~call_id:"g1"
428
+
~account_id
429
+
~ids:email_ids
430
+
~properties
431
+
()
432
+
in
433
+
let req2 = Jmap_eio.Client.Build.(
434
+
make_request
435
+
~capabilities:[Jmap_proto.Capability.core; Jmap_proto.Capability.mail]
436
+
[get_inv]
437
+
) in
438
+
439
+
Jmap_eio.Cli.debug cfg "Fetching email details...";
440
+
441
+
match Jmap_eio.Client.request client req2 with
442
+
| Error e ->
443
+
Fmt.epr "Error: %s@." (Jmap_eio.Client.error_to_string e);
444
+
exit 1
445
+
| Ok response2 ->
446
+
match Jmap_eio.Client.Parse.parse_email_get ~call_id:"g1" response2 with
447
+
| Error e ->
448
+
Fmt.epr "Parse error: %s@." (Jsont.Error.to_string e);
449
+
exit 1
450
+
| Ok get_result ->
451
+
Jmap_eio.Cli.debug cfg "Got %d emails" (List.length get_result.list);
452
+
453
+
(* Output based on format *)
454
+
match format with
455
+
| `Compact ->
456
+
List.iter (fun (email : Jmap_mail.Email.t) ->
457
+
let from_str = match email.from with
458
+
| Some (addr :: _) ->
459
+
Option.value addr.name ~default:addr.email
460
+
| _ -> "?"
461
+
in
462
+
let subject = Option.value email.subject ~default:"(no subject)" in
463
+
let flags = format_keywords email.keywords in
464
+
Printf.printf "%s\t%s\t%s\t%s\t%s\n"
465
+
(Jmap_proto.Id.to_string email.id)
466
+
(ptime_to_string email.received_at)
467
+
(truncate_string 20 from_str)
468
+
(truncate_string 50 subject)
469
+
flags
470
+
) get_result.list
471
+
472
+
| `Table ->
473
+
Fmt.pr "@[<v>%a (%d emails, state: %s)@,@,"
474
+
Fmt.(styled `Bold string) "Recent Emails"
475
+
(List.length get_result.list)
476
+
get_result.state;
477
+
(* Header *)
478
+
Fmt.pr "%-12s %-19s %-20s %-40s %s@,"
479
+
"ID" "Date" "From" "Subject" "Flags";
480
+
Fmt.pr "%s@," (String.make 110 '-');
481
+
List.iter (fun (email : Jmap_mail.Email.t) ->
482
+
let from_str = match email.from with
483
+
| Some (addr :: _) ->
484
+
Option.value addr.name ~default:addr.email
485
+
| _ -> "?"
486
+
in
487
+
let subject = Option.value email.subject ~default:"(no subject)" in
488
+
let flags = format_keywords email.keywords in
489
+
let id_short =
490
+
let id = Jmap_proto.Id.to_string email.id in
491
+
if String.length id > 12 then String.sub id 0 12 else id
492
+
in
493
+
Fmt.pr "%-12s %s %-20s %-40s %s@,"
494
+
id_short
495
+
(ptime_to_string email.received_at)
496
+
(truncate_string 20 from_str)
497
+
(truncate_string 40 subject)
498
+
flags
499
+
) get_result.list;
500
+
Fmt.pr "@]@."
501
+
502
+
| `Detailed ->
503
+
Fmt.pr "@[<v>%a (%d emails)@,@,"
504
+
Fmt.(styled `Bold string) "Recent Emails"
505
+
(List.length get_result.list);
506
+
List.iteri (fun i (email : Jmap_mail.Email.t) ->
507
+
let from_str = match email.from with
508
+
| Some addrs -> format_email_addresses addrs
509
+
| None -> "(unknown)"
510
+
in
511
+
let to_str = match email.to_ with
512
+
| Some addrs -> format_email_addresses addrs
513
+
| None -> ""
514
+
in
515
+
let cc_str = match email.cc with
516
+
| Some addrs -> format_email_addresses addrs
517
+
| None -> ""
518
+
in
519
+
let subject = Option.value email.subject ~default:"(no subject)" in
520
+
let flags = format_keywords email.keywords in
521
+
let mailbox_count = List.length email.mailbox_ids in
522
+
523
+
Fmt.pr "@[<v 2>%a Email %d of %d@,"
524
+
Fmt.(styled `Bold string) "---"
525
+
(i + 1) (List.length get_result.list);
526
+
Fmt.pr "ID: %a@,"
527
+
Fmt.(styled `Cyan string) (Jmap_proto.Id.to_string email.id);
528
+
Fmt.pr "Thread: %s@," (Jmap_proto.Id.to_string email.thread_id);
529
+
Fmt.pr "Date: %s@," (ptime_to_string email.received_at);
530
+
Fmt.pr "From: %s@," from_str;
531
+
if to_str <> "" then Fmt.pr "To: %s@," to_str;
532
+
if cc_str <> "" then Fmt.pr "Cc: %s@," cc_str;
533
+
Fmt.pr "Subject: %a@,"
534
+
Fmt.(styled `White string) subject;
535
+
Fmt.pr "Size: %Ld bytes@," email.size;
536
+
Fmt.pr "Mailboxes: %d@," mailbox_count;
537
+
if flags <> "" then Fmt.pr "Flags: %s@," flags;
538
+
Fmt.pr "Preview: %s@]@,@," email.preview;
539
+
) get_result.list;
540
+
Fmt.pr "@]@."
541
+
)
542
+
in
543
+
let doc = "List recent emails with full details (chains query + get)" in
544
+
let info = Cmd.info "recent" ~doc in
545
+
Cmd.v info Term.(const run $ Jmap_eio.Cli.config_term $ limit_term $ format_term)
546
+
547
+
(** {1 Threads Command} *)
548
+
549
+
let threads_cmd =
550
+
let email_id_term =
551
+
let doc = "Email ID to get thread for" in
552
+
Arg.(required & pos 0 (some string) None & info [] ~docv:"EMAIL_ID" ~doc)
553
+
in
554
+
let run cfg email_id_str =
555
+
Eio_main.run @@ fun env ->
556
+
Eio.Switch.run @@ fun sw ->
557
+
let client = Jmap_eio.Cli.create_client ~sw env cfg in
558
+
let account_id = Jmap_eio.Cli.get_account_id cfg client in
559
+
560
+
let email_id = Jmap_proto.Id.of_string_exn email_id_str in
561
+
562
+
(* First get the email to find its thread ID - include required properties *)
563
+
let get_inv = Jmap_eio.Client.Build.email_get
564
+
~call_id:"e1"
565
+
~account_id
566
+
~ids:[email_id]
567
+
~properties:["id"; "blobId"; "threadId"; "mailboxIds"; "size"; "receivedAt"]
568
+
()
569
+
in
570
+
let req = Jmap_eio.Client.Build.(
571
+
make_request
572
+
~capabilities:[Jmap_proto.Capability.core; Jmap_proto.Capability.mail]
573
+
[get_inv]
574
+
) in
575
+
576
+
match Jmap_eio.Client.request client req with
577
+
| Error e ->
578
+
Fmt.epr "Error: %s@." (Jmap_eio.Client.error_to_string e);
579
+
exit 1
580
+
| Ok response ->
581
+
match Jmap_eio.Client.Parse.parse_email_get ~call_id:"e1" response with
582
+
| Error e ->
583
+
Fmt.epr "Parse error: %s@." (Jsont.Error.to_string e);
584
+
exit 1
585
+
| Ok email_result ->
586
+
match email_result.list with
587
+
| [] ->
588
+
Fmt.epr "Email not found: %s@." email_id_str;
589
+
exit 1
590
+
| email :: _ ->
591
+
let thread_id = email.thread_id in
592
+
Jmap_eio.Cli.debug cfg "Thread ID: %s" (Jmap_proto.Id.to_string thread_id);
593
+
594
+
(* Get the thread *)
595
+
let thread_inv = Jmap_eio.Client.Build.thread_get
596
+
~call_id:"t1"
597
+
~account_id
598
+
~ids:[thread_id]
599
+
()
600
+
in
601
+
let req2 = Jmap_eio.Client.Build.(
602
+
make_request
603
+
~capabilities:[Jmap_proto.Capability.core; Jmap_proto.Capability.mail]
604
+
[thread_inv]
605
+
) in
606
+
607
+
match Jmap_eio.Client.request client req2 with
608
+
| Error e ->
609
+
Fmt.epr "Error: %s@." (Jmap_eio.Client.error_to_string e);
610
+
exit 1
611
+
| Ok response2 ->
612
+
match Jmap_eio.Client.Parse.parse_thread_get ~call_id:"t1" response2 with
613
+
| Error e ->
614
+
Fmt.epr "Parse error: %s@." (Jsont.Error.to_string e);
615
+
exit 1
616
+
| Ok thread_result ->
617
+
match thread_result.list with
618
+
| [] ->
619
+
Fmt.epr "Thread not found@.";
620
+
exit 1
621
+
| thread :: _ ->
622
+
let email_ids = thread.email_ids in
623
+
Fmt.pr "@[<v>%a %s (%d emails)@,@,"
624
+
Fmt.(styled `Bold string) "Thread"
625
+
(Jmap_proto.Id.to_string thread.id)
626
+
(List.length email_ids);
627
+
628
+
(* Fetch all emails in thread *)
629
+
let get_inv2 = Jmap_eio.Client.Build.email_get
630
+
~call_id:"e2"
631
+
~account_id
632
+
~ids:email_ids
633
+
~properties:["id"; "blobId"; "threadId"; "mailboxIds"; "keywords";
634
+
"size"; "receivedAt"; "subject"; "from"; "preview"]
635
+
()
636
+
in
637
+
let req3 = Jmap_eio.Client.Build.(
638
+
make_request
639
+
~capabilities:[Jmap_proto.Capability.core; Jmap_proto.Capability.mail]
640
+
[get_inv2]
641
+
) in
642
+
643
+
match Jmap_eio.Client.request client req3 with
644
+
| Error e ->
645
+
Fmt.epr "Error: %s@." (Jmap_eio.Client.error_to_string e);
646
+
exit 1
647
+
| Ok response3 ->
648
+
match Jmap_eio.Client.Parse.parse_email_get ~call_id:"e2" response3 with
649
+
| Error e ->
650
+
Fmt.epr "Parse error: %s@." (Jsont.Error.to_string e);
651
+
exit 1
652
+
| Ok emails_result ->
653
+
List.iter (fun (email : Jmap_mail.Email.t) ->
654
+
let from_str = match email.from with
655
+
| Some addrs -> format_email_addresses addrs
656
+
| None -> "(unknown)"
657
+
in
658
+
let subject = Option.value email.subject ~default:"(no subject)" in
659
+
Fmt.pr " %a %s@,"
660
+
Fmt.(styled `Cyan string) (Jmap_proto.Id.to_string email.id)
661
+
(ptime_to_string email.received_at);
662
+
Fmt.pr " From: %s@," (truncate_string 60 from_str);
663
+
Fmt.pr " Subject: %a@,@,"
664
+
Fmt.(styled `White string) (truncate_string 60 subject);
665
+
) emails_result.list;
666
+
Fmt.pr "@]@."
667
+
in
668
+
let doc = "Show email thread" in
669
+
let info = Cmd.info "thread" ~doc in
670
+
Cmd.v info Term.(const run $ Jmap_eio.Cli.config_term $ email_id_term)
671
+
672
+
(** {1 Identities Command} *)
673
+
674
+
let identities_cmd =
675
+
let run cfg =
676
+
Eio_main.run @@ fun env ->
677
+
Eio.Switch.run @@ fun sw ->
678
+
let client = Jmap_eio.Cli.create_client ~sw env cfg in
679
+
let account_id = Jmap_eio.Cli.get_account_id cfg client in
680
+
681
+
let req = Jmap_eio.Client.Build.(
682
+
make_request
683
+
~capabilities:[Jmap_proto.Capability.core; Jmap_proto.Capability.mail;
684
+
Jmap_proto.Capability.submission]
685
+
[identity_get ~call_id:"i1" ~account_id ()]
686
+
) in
687
+
688
+
match Jmap_eio.Client.request client req with
689
+
| Error e ->
690
+
Fmt.epr "Error: %s@." (Jmap_eio.Client.error_to_string e);
691
+
exit 1
692
+
| Ok response ->
693
+
match Jmap_eio.Client.Parse.parse_response ~call_id:"i1"
694
+
(Jmap_eio.Client.Parse.get_response Jmap_mail.Identity.jsont)
695
+
response with
696
+
| Error e ->
697
+
Fmt.epr "Parse error: %s@." (Jsont.Error.to_string e);
698
+
exit 1
699
+
| Ok result ->
700
+
Fmt.pr "@[<v>%a (state: %s)@,@,"
701
+
Fmt.(styled `Bold string) "Identities"
702
+
result.state;
703
+
List.iter (fun (ident : Jmap_mail.Identity.t) ->
704
+
Fmt.pr " %a@,"
705
+
Fmt.(styled `Cyan string) (Jmap_proto.Id.to_string ident.id);
706
+
Fmt.pr " Name: %s@," ident.name;
707
+
Fmt.pr " Email: %a@,"
708
+
Fmt.(styled `Green string) ident.email;
709
+
if ident.text_signature <> "" then
710
+
Fmt.pr " Signature: %s@," (truncate_string 50 ident.text_signature);
711
+
Fmt.pr " May delete: %b@,@," ident.may_delete
712
+
) result.list;
713
+
Fmt.pr "@]@."
714
+
in
715
+
let doc = "List email identities" in
716
+
let info = Cmd.info "identities" ~doc in
717
+
Cmd.v info Term.(const run $ Jmap_eio.Cli.config_term)
718
+
719
+
(** {1 Main Command Group} *)
720
+
721
+
let main_cmd =
722
+
let doc = "JMAP command-line client" in
723
+
let man = [
724
+
`S Manpage.s_description;
725
+
`P "A command-line client for JMAP (JSON Meta Application Protocol) email servers.";
726
+
`S Manpage.s_environment;
727
+
`P Jmap_eio.Cli.env_docs;
728
+
`S Manpage.s_examples;
729
+
`P "List mailboxes:";
730
+
`Pre " jmap mailboxes --url https://api.fastmail.com/jmap/session -k YOUR_API_KEY";
731
+
`P "Show recent emails:";
732
+
`Pre " jmap recent -n 50 --format detailed";
733
+
`P "Search emails:";
734
+
`Pre " jmap search \"meeting notes\" -n 10";
735
+
] in
736
+
let info = Cmd.info "jmap" ~version:"0.1.0" ~doc ~man in
737
+
Cmd.group info [
738
+
session_cmd;
739
+
mailboxes_cmd;
740
+
emails_cmd;
741
+
search_cmd;
742
+
recent_cmd;
743
+
threads_cmd;
744
+
identities_cmd;
745
+
]
746
+
747
+
let () =
748
+
Fmt_tty.setup_std_outputs ();
749
+
exit (Cmd.eval main_cmd)
-189
bin/jmap_test.ml
-189
bin/jmap_test.ml
···
1
-
(*---------------------------------------------------------------------------
2
-
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
-
SPDX-License-Identifier: ISC
4
-
---------------------------------------------------------------------------*)
5
-
6
-
(** JMAP test client - connects to a JMAP server and queries recent emails *)
7
-
8
-
let ptime_to_string t =
9
-
let (y, m, d), ((hh, mm, ss), _tz) = Ptime.to_date_time t in
10
-
Printf.sprintf "%04d-%02d-%02d %02d:%02d:%02d" y m d hh mm ss
11
-
12
-
let debug_mode = ref false
13
-
14
-
let debug fmt =
15
-
if !debug_mode then
16
-
Printf.kfprintf (fun oc -> Printf.fprintf oc "\n%!") stderr ("[DEBUG] " ^^ fmt)
17
-
else
18
-
Printf.ifprintf stderr fmt
19
-
20
-
let () =
21
-
(* Parse command line arguments *)
22
-
let usage = "Usage: jmap-test [--debug] <session-url> <api-key>" in
23
-
let args = ref [] in
24
-
let spec = [
25
-
("--debug", Arg.Set debug_mode, "Enable debug output");
26
-
("-d", Arg.Set debug_mode, "Enable debug output");
27
-
] in
28
-
Arg.parse spec (fun arg -> args := arg :: !args) usage;
29
-
let session_url, api_key =
30
-
match List.rev !args with
31
-
| [url; key] -> (url, key)
32
-
| _ ->
33
-
prerr_endline usage;
34
-
exit 1
35
-
in
36
-
37
-
debug "Session URL: %s" session_url;
38
-
debug "API key length: %d chars" (String.length api_key);
39
-
40
-
(* Run with Eio *)
41
-
Eio_main.run @@ fun env ->
42
-
Eio.Switch.run @@ fun sw ->
43
-
44
-
(* Create HTTP client with Bearer token auth *)
45
-
let requests = Requests.create ~sw env in
46
-
let auth = Requests.Auth.bearer ~token:api_key in
47
-
48
-
debug "Created HTTP client with Bearer auth";
49
-
Printf.printf "Connecting to %s...\n%!" session_url;
50
-
51
-
(* Create JMAP client from session URL *)
52
-
match Jmap_eio.Client.create_from_url ~auth requests session_url with
53
-
| Error e ->
54
-
Printf.eprintf "Failed to connect: %s\n" (Jmap_eio.Client.error_to_string e);
55
-
exit 1
56
-
| Ok client ->
57
-
let session = Jmap_eio.Client.session client in
58
-
debug "Session state: %s" session.state;
59
-
debug "API URL: %s" session.api_url;
60
-
debug "Upload URL: %s" session.upload_url;
61
-
debug "Download URL: %s" session.download_url;
62
-
debug "Capabilities: %s" (String.concat ", " (List.map fst session.capabilities));
63
-
debug "Accounts: %d" (List.length session.accounts);
64
-
List.iter (fun (id, acct) ->
65
-
debug " Account %s: %s (personal=%b, read_only=%b)"
66
-
(Jmap_proto.Id.to_string id)
67
-
acct.Jmap_proto.Session.Account.name
68
-
acct.is_personal
69
-
acct.is_read_only
70
-
) session.accounts;
71
-
Printf.printf "Connected! Username: %s\n%!" session.username;
72
-
73
-
(* Get primary mail account *)
74
-
let primary_account_id =
75
-
match Jmap_proto.Session.primary_account_for Jmap_proto.Capability.mail session with
76
-
| Some id -> id
77
-
| None ->
78
-
prerr_endline "No primary mail account found";
79
-
exit 1
80
-
in
81
-
debug "Primary accounts: %s"
82
-
(String.concat ", " (List.map (fun (cap, id) ->
83
-
cap ^ "=" ^ Jmap_proto.Id.to_string id) session.primary_accounts));
84
-
Printf.printf "Primary mail account: %s\n%!" (Jmap_proto.Id.to_string primary_account_id);
85
-
86
-
(* Query for recent emails - get the 10 most recent *)
87
-
let sort = [Jmap_proto.Filter.comparator ~is_ascending:false "receivedAt"] in
88
-
let query_inv = Jmap_eio.Client.Build.email_query
89
-
~call_id:"q1"
90
-
~account_id:primary_account_id
91
-
~sort
92
-
~limit:10L
93
-
()
94
-
in
95
-
96
-
(* Build request with mail capability *)
97
-
let req = Jmap_eio.Client.Build.make_request
98
-
~capabilities:[Jmap_proto.Capability.core; Jmap_proto.Capability.mail]
99
-
[query_inv]
100
-
in
101
-
102
-
debug "Built Email/query request with sort by receivedAt desc, limit 10";
103
-
Printf.printf "Querying recent emails...\n%!";
104
-
105
-
match Jmap_eio.Client.request client req with
106
-
| Error e ->
107
-
Printf.eprintf "Query failed: %s\n" (Jmap_eio.Client.error_to_string e);
108
-
exit 1
109
-
| Ok response ->
110
-
debug "Query response received, parsing...";
111
-
(* Parse the query response *)
112
-
match Jmap_eio.Client.Parse.parse_email_query ~call_id:"q1" response with
113
-
| Error e ->
114
-
Printf.eprintf "Failed to parse query response: %s\n" (Jsont.Error.to_string e);
115
-
exit 1
116
-
| Ok query_result ->
117
-
let email_ids = query_result.ids in
118
-
debug "Query state: %s" query_result.query_state;
119
-
debug "Can calculate updates: %b" query_result.can_calculate_changes;
120
-
debug "Total results: %Ld" (Option.value query_result.total ~default:(-1L));
121
-
debug "Position: %Ld" query_result.position;
122
-
debug "Email IDs: %s"
123
-
(String.concat ", " (List.map Jmap_proto.Id.to_string email_ids));
124
-
Printf.printf "Found %d emails\n%!" (List.length email_ids);
125
-
126
-
if List.length email_ids = 0 then (
127
-
Printf.printf "No emails found.\n%!";
128
-
) else (
129
-
(* Fetch the email details - must include required properties *)
130
-
let get_inv = Jmap_eio.Client.Build.email_get
131
-
~call_id:"g1"
132
-
~account_id:primary_account_id
133
-
~ids:email_ids
134
-
~properties:["id"; "blobId"; "threadId"; "mailboxIds"; "size";
135
-
"receivedAt"; "subject"; "from"; "preview"]
136
-
()
137
-
in
138
-
139
-
let req2 = Jmap_eio.Client.Build.make_request
140
-
~capabilities:[Jmap_proto.Capability.core; Jmap_proto.Capability.mail]
141
-
[get_inv]
142
-
in
143
-
144
-
debug "Built Email/get request for %d emails" (List.length email_ids);
145
-
Printf.printf "Fetching email details...\n%!";
146
-
147
-
match Jmap_eio.Client.request client req2 with
148
-
| Error e ->
149
-
Printf.eprintf "Get failed: %s\n" (Jmap_eio.Client.error_to_string e);
150
-
exit 1
151
-
| Ok response2 ->
152
-
debug "Get response received, parsing...";
153
-
match Jmap_eio.Client.Parse.parse_email_get ~call_id:"g1" response2 with
154
-
| Error e ->
155
-
Printf.eprintf "Failed to parse get response: %s\n" (Jsont.Error.to_string e);
156
-
exit 1
157
-
| Ok get_result ->
158
-
debug "Get state: %s" get_result.state;
159
-
debug "Emails returned: %d" (List.length get_result.list);
160
-
debug "Not found: %d" (List.length get_result.not_found);
161
-
Printf.printf "\n=== Recent Emails ===\n\n%!";
162
-
List.iter (fun (email : Jmap_mail.Email.t) ->
163
-
let id = Jmap_proto.Id.to_string email.id in
164
-
let subject = Option.value email.subject ~default:"(no subject)" in
165
-
let from_addrs = Option.value email.from ~default:[] in
166
-
let from_str = match from_addrs with
167
-
| [] -> "(unknown sender)"
168
-
| addr :: _ ->
169
-
let name = Option.value addr.name ~default:"" in
170
-
let email_addr = addr.email in
171
-
if name = "" then email_addr
172
-
else Printf.sprintf "%s <%s>" name email_addr
173
-
in
174
-
let received = ptime_to_string email.received_at in
175
-
let preview = email.preview in
176
-
let preview_short =
177
-
if String.length preview > 80 then
178
-
String.sub preview 0 77 ^ "..."
179
-
else preview
180
-
in
181
-
Printf.printf "ID: %s\n" id;
182
-
Printf.printf "From: %s\n" from_str;
183
-
Printf.printf "Date: %s\n" received;
184
-
Printf.printf "Subject: %s\n" subject;
185
-
Printf.printf "Preview: %s\n" preview_short;
186
-
Printf.printf "\n%!";
187
-
) get_result.list;
188
-
Printf.printf "=== End of emails ===\n%!"
189
-
)
+214
eio/cli.ml
+214
eio/cli.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** JMAP CLI configuration and cmdliner terms *)
7
+
8
+
open Cmdliner
9
+
10
+
(** {1 Configuration Types} *)
11
+
12
+
type source = Default | Env of string | Cmdline
13
+
14
+
type config = {
15
+
session_url : string;
16
+
session_url_source : source;
17
+
api_key : string;
18
+
api_key_source : source;
19
+
account_id : string option;
20
+
account_id_source : source;
21
+
debug : bool;
22
+
}
23
+
24
+
(** {1 Pretty Printing} *)
25
+
26
+
let pp_source ppf = function
27
+
| Default -> Fmt.(styled `Faint string) ppf "default"
28
+
| Env var -> Fmt.pf ppf "%a" Fmt.(styled `Yellow string) ("env(" ^ var ^ ")")
29
+
| Cmdline -> Fmt.(styled `Blue string) ppf "cmdline"
30
+
31
+
let pp_config ppf cfg =
32
+
let pp_field name value source =
33
+
Fmt.pf ppf "@,%a %a %a"
34
+
Fmt.(styled `Cyan string) (name ^ ":")
35
+
Fmt.(styled `Green string) value
36
+
Fmt.(styled `Faint (brackets pp_source)) source
37
+
in
38
+
let pp_opt_field name value_opt source =
39
+
match value_opt with
40
+
| None -> ()
41
+
| Some value -> pp_field name value source
42
+
in
43
+
Fmt.pf ppf "@[<v>%a" Fmt.(styled `Bold string) "JMAP config:";
44
+
pp_field "session_url" cfg.session_url cfg.session_url_source;
45
+
pp_field "api_key" (String.make (min 8 (String.length cfg.api_key)) '*' ^ "...") cfg.api_key_source;
46
+
pp_opt_field "account_id" cfg.account_id cfg.account_id_source;
47
+
Fmt.pf ppf "@]"
48
+
49
+
(** {1 Cmdliner Terms} *)
50
+
51
+
let env_var_name suffix = "JMAP_" ^ suffix
52
+
53
+
let resolve_with_env ~cmdline ~env_var ~default =
54
+
match cmdline with
55
+
| Some v -> (v, Cmdline)
56
+
| None ->
57
+
match Sys.getenv_opt env_var with
58
+
| Some v when v <> "" -> (v, Env env_var)
59
+
| _ -> (default, Default)
60
+
61
+
let resolve_opt_with_env ~cmdline ~env_var =
62
+
match cmdline with
63
+
| Some v -> (Some v, Cmdline)
64
+
| None ->
65
+
match Sys.getenv_opt env_var with
66
+
| Some v when v <> "" -> (Some v, Env env_var)
67
+
| _ -> (None, Default)
68
+
69
+
(** Session URL term *)
70
+
let session_url_term =
71
+
let doc =
72
+
Printf.sprintf
73
+
"JMAP session URL. Can also be set with %s environment variable."
74
+
(env_var_name "SESSION_URL")
75
+
in
76
+
Arg.(value & opt (some string) None & info ["url"; "u"] ~docv:"URL" ~doc)
77
+
78
+
(** API key term *)
79
+
let api_key_term =
80
+
let doc =
81
+
Printf.sprintf
82
+
"JMAP API key or Bearer token. Can also be set with %s environment variable."
83
+
(env_var_name "API_KEY")
84
+
in
85
+
Arg.(value & opt (some string) None & info ["api-key"; "k"] ~docv:"KEY" ~doc)
86
+
87
+
(** API key file term *)
88
+
let api_key_file_term =
89
+
let doc =
90
+
Printf.sprintf
91
+
"File containing JMAP API key. Can also be set with %s environment variable."
92
+
(env_var_name "API_KEY_FILE")
93
+
in
94
+
Arg.(value & opt (some string) None & info ["api-key-file"; "K"] ~docv:"FILE" ~doc)
95
+
96
+
(** Account ID term *)
97
+
let account_id_term =
98
+
let doc =
99
+
Printf.sprintf
100
+
"Account ID to use (defaults to primary mail account). Can also be set with %s."
101
+
(env_var_name "ACCOUNT_ID")
102
+
in
103
+
Arg.(value & opt (some string) None & info ["account"; "a"] ~docv:"ID" ~doc)
104
+
105
+
(** Debug flag term *)
106
+
let debug_term =
107
+
let doc = "Enable debug output" in
108
+
Arg.(value & flag & info ["debug"; "d"] ~doc)
109
+
110
+
(** Read API key from file *)
111
+
let read_api_key_file path =
112
+
try
113
+
let ic = open_in path in
114
+
let key = input_line ic in
115
+
close_in ic;
116
+
String.trim key
117
+
with
118
+
| Sys_error msg -> failwith (Printf.sprintf "Cannot read API key file: %s" msg)
119
+
| End_of_file -> failwith "API key file is empty"
120
+
121
+
(** Combined configuration term *)
122
+
let config_term =
123
+
let make session_url_opt api_key_opt api_key_file_opt account_id_opt debug =
124
+
(* Resolve session URL *)
125
+
let session_url, session_url_source =
126
+
resolve_with_env
127
+
~cmdline:session_url_opt
128
+
~env_var:(env_var_name "SESSION_URL")
129
+
~default:""
130
+
in
131
+
if session_url = "" then
132
+
failwith "Session URL is required. Set via --url or JMAP_SESSION_URL";
133
+
134
+
(* Resolve API key - check key file first, then direct key *)
135
+
let api_key, api_key_source =
136
+
match api_key_file_opt with
137
+
| Some path -> (read_api_key_file path, Cmdline)
138
+
| None ->
139
+
match Sys.getenv_opt (env_var_name "API_KEY_FILE") with
140
+
| Some path when path <> "" -> (read_api_key_file path, Env (env_var_name "API_KEY_FILE"))
141
+
| _ ->
142
+
resolve_with_env
143
+
~cmdline:api_key_opt
144
+
~env_var:(env_var_name "API_KEY")
145
+
~default:""
146
+
in
147
+
if api_key = "" then
148
+
failwith "API key is required. Set via --api-key, --api-key-file, JMAP_API_KEY, or JMAP_API_KEY_FILE";
149
+
150
+
(* Resolve account ID (optional) *)
151
+
let account_id, account_id_source =
152
+
resolve_opt_with_env
153
+
~cmdline:account_id_opt
154
+
~env_var:(env_var_name "ACCOUNT_ID")
155
+
in
156
+
157
+
{ session_url; session_url_source;
158
+
api_key; api_key_source;
159
+
account_id; account_id_source;
160
+
debug }
161
+
in
162
+
Term.(const make $ session_url_term $ api_key_term $ api_key_file_term
163
+
$ account_id_term $ debug_term)
164
+
165
+
(** {1 Environment Documentation} *)
166
+
167
+
let env_docs =
168
+
{|
169
+
Environment Variables:
170
+
JMAP_SESSION_URL JMAP session URL (e.g., https://api.fastmail.com/jmap/session)
171
+
JMAP_API_KEY API key or Bearer token for authentication
172
+
JMAP_API_KEY_FILE Path to file containing API key
173
+
JMAP_ACCOUNT_ID Account ID to use (optional, defaults to primary mail account)
174
+
175
+
Configuration Precedence:
176
+
1. Command-line flags (e.g., --url, --api-key)
177
+
2. Environment variables (e.g., JMAP_SESSION_URL)
178
+
179
+
Example:
180
+
export JMAP_SESSION_URL="https://api.fastmail.com/jmap/session"
181
+
export JMAP_API_KEY_FILE="$HOME/.jmap-api-key"
182
+
jmap emails --limit 10
183
+
|}
184
+
185
+
(** {1 Client Helpers} *)
186
+
187
+
let create_client ~sw env cfg =
188
+
let requests = Requests.create ~sw env in
189
+
let auth = Requests.Auth.bearer ~token:cfg.api_key in
190
+
match Client.create_from_url ~auth requests cfg.session_url with
191
+
| Error e ->
192
+
Fmt.epr "@[<v>%a Failed to connect: %s@]@."
193
+
Fmt.(styled `Red string) "Error:"
194
+
(Client.error_to_string e);
195
+
exit 1
196
+
| Ok client -> client
197
+
198
+
let get_account_id cfg client =
199
+
match cfg.account_id with
200
+
| Some id -> Jmap_proto.Id.of_string_exn id
201
+
| None ->
202
+
let session = Client.session client in
203
+
match Jmap_proto.Session.primary_account_for Jmap_proto.Capability.mail session with
204
+
| Some id -> id
205
+
| None ->
206
+
Fmt.epr "@[<v>%a No primary mail account found. Specify --account.@]@."
207
+
Fmt.(styled `Red string) "Error:";
208
+
exit 1
209
+
210
+
let debug cfg fmt =
211
+
if cfg.debug then
212
+
Fmt.kpf (fun ppf -> Fmt.pf ppf "@.") Fmt.stderr ("@[<h>[DEBUG] " ^^ fmt ^^ "@]")
213
+
else
214
+
Format.ikfprintf ignore Format.err_formatter fmt
+94
eio/cli.mli
+94
eio/cli.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** JMAP CLI configuration and cmdliner terms
7
+
8
+
This module provides reusable cmdliner terms for building JMAP CLI tools.
9
+
It handles configuration from command-line arguments and environment
10
+
variables with proper precedence.
11
+
12
+
{2 Environment Variables}
13
+
14
+
- [JMAP_SESSION_URL] - JMAP session URL
15
+
- [JMAP_API_KEY] - API key or Bearer token
16
+
- [JMAP_API_KEY_FILE] - Path to file containing API key
17
+
- [JMAP_ACCOUNT_ID] - Account ID (optional)
18
+
19
+
{2 Configuration Precedence}
20
+
21
+
1. Command-line flags (e.g., [--url], [--api-key])
22
+
2. Environment variables (e.g., [JMAP_SESSION_URL])
23
+
3. Default values (where applicable)
24
+
*)
25
+
26
+
(** {1 Configuration Types} *)
27
+
28
+
(** Source of a configuration value. *)
29
+
type source =
30
+
| Default (** Value from default *)
31
+
| Env of string (** Value from environment variable *)
32
+
| Cmdline (** Value from command line *)
33
+
34
+
(** CLI configuration with source tracking. *)
35
+
type config = {
36
+
session_url : string;
37
+
session_url_source : source;
38
+
api_key : string;
39
+
api_key_source : source;
40
+
account_id : string option;
41
+
account_id_source : source;
42
+
debug : bool;
43
+
}
44
+
45
+
(** {1 Pretty Printing} *)
46
+
47
+
val pp_source : source Fmt.t
48
+
(** Pretty-print a configuration source. *)
49
+
50
+
val pp_config : config Fmt.t
51
+
(** Pretty-print the configuration (with masked API key). *)
52
+
53
+
(** {1 Cmdliner Terms} *)
54
+
55
+
val config_term : config Cmdliner.Term.t
56
+
(** Combined cmdliner term for JMAP configuration.
57
+
Includes session URL, API key (direct or from file), account ID, and debug flag. *)
58
+
59
+
val session_url_term : string option Cmdliner.Term.t
60
+
(** Cmdliner term for session URL. *)
61
+
62
+
val api_key_term : string option Cmdliner.Term.t
63
+
(** Cmdliner term for API key. *)
64
+
65
+
val api_key_file_term : string option Cmdliner.Term.t
66
+
(** Cmdliner term for API key file path. *)
67
+
68
+
val account_id_term : string option Cmdliner.Term.t
69
+
(** Cmdliner term for account ID. *)
70
+
71
+
val debug_term : bool Cmdliner.Term.t
72
+
(** Cmdliner term for debug flag. *)
73
+
74
+
(** {1 Environment Documentation} *)
75
+
76
+
val env_docs : string
77
+
(** Documentation string describing environment variables for use in man pages. *)
78
+
79
+
(** {1 Client Helpers} *)
80
+
81
+
val create_client :
82
+
sw:Eio.Switch.t ->
83
+
Eio_unix.Stdenv.base ->
84
+
config ->
85
+
Client.t
86
+
(** [create_client ~sw env cfg] creates a JMAP client from the configuration.
87
+
Exits with error message on connection failure. *)
88
+
89
+
val get_account_id : config -> Client.t -> Jmap_proto.Id.t
90
+
(** [get_account_id cfg client] returns the account ID from config, or the
91
+
primary mail account if not specified. Exits with error if no account found. *)
92
+
93
+
val debug : config -> ('a, Format.formatter, unit) format -> 'a
94
+
(** [debug cfg fmt ...] prints a debug message to stderr if debug mode is enabled. *)
+2
-2
eio/dune
+2
-2
eio/dune
···
1
1
(library
2
2
(name jmap_eio)
3
3
(public_name jmap-eio)
4
-
(libraries jmap jmap.mail jsont jsont.bytesrw eio requests uri str)
5
-
(modules jmap_eio codec client))
4
+
(libraries jmap jmap.mail jsont jsont.bytesrw eio requests uri str cmdliner fmt.tty)
5
+
(modules jmap_eio codec client cli))
+3
eio/jmap_eio.mli
+3
eio/jmap_eio.mli
+2
-1
jmap-eio.opam
+2
-1
jmap-eio.opam
···
10
10
doc: "https://avsm.github.io/ocaml-jmap"
11
11
bug-reports: "https://github.com/avsm/ocaml-jmap/issues"
12
12
depends: [
13
-
"dune" {>= "3.0"}
13
+
"dune" {>= "3.20"}
14
14
"ocaml" {>= "5.4.0"}
15
15
"jmap" {= version}
16
16
"jsont" {>= "0.2.0"}
···
33
33
]
34
34
]
35
35
dev-repo: "git+https://github.com/avsm/ocaml-jmap.git"
36
+
x-maintenance-intent: ["(latest)"]
+2
-1
jmap.opam
+2
-1
jmap.opam
···
10
10
doc: "https://avsm.github.io/ocaml-jmap"
11
11
bug-reports: "https://github.com/avsm/ocaml-jmap/issues"
12
12
depends: [
13
-
"dune" {>= "3.0"}
13
+
"dune" {>= "3.20"}
14
14
"ocaml" {>= "5.4.0"}
15
15
"jsont" {>= "0.2.0"}
16
16
"json-pointer"
···
32
32
]
33
33
]
34
34
dev-repo: "git+https://github.com/avsm/ocaml-jmap.git"
35
+
x-maintenance-intent: ["(latest)"]
+23
-10
proto/mail/email.ml
+23
-10
proto/mail/email.ml
···
82
82
let jsont =
83
83
let kind = "Email" in
84
84
let body_values_jsont = Jmap_proto.Json_map.of_string Email_body.Value.jsont in
85
+
(* subject can be null per RFC 8621 Section 4.1.1 *)
86
+
let nullable_string = Jsont.(option string) in
85
87
Jsont.Object.map ~kind make
86
88
|> Jsont.Object.mem "id" Jmap_proto.Id.jsont ~enc:id
87
89
|> Jsont.Object.mem "blobId" Jmap_proto.Id.jsont ~enc:blob_id
···
90
92
|> Jsont.Object.mem "receivedAt" Jmap_proto.Date.Utc.jsont ~enc:received_at
91
93
|> Jsont.Object.mem "mailboxIds" Jmap_proto.Json_map.id_to_bool ~enc:mailbox_ids
92
94
|> Jsont.Object.mem "keywords" Jmap_proto.Json_map.string_to_bool ~dec_absent:[] ~enc:keywords
93
-
|> Jsont.Object.opt_mem "messageId" (Jsont.list Jsont.string) ~enc:message_id
94
-
|> Jsont.Object.opt_mem "inReplyTo" (Jsont.list Jsont.string) ~enc:in_reply_to
95
-
|> Jsont.Object.opt_mem "references" (Jsont.list Jsont.string) ~enc:references
96
-
|> Jsont.Object.opt_mem "sender" (Jsont.list Email_address.jsont) ~enc:sender
97
-
|> Jsont.Object.opt_mem "from" (Jsont.list Email_address.jsont) ~enc:from
98
-
|> Jsont.Object.opt_mem "to" (Jsont.list Email_address.jsont) ~enc:to_
99
-
|> Jsont.Object.opt_mem "cc" (Jsont.list Email_address.jsont) ~enc:cc
100
-
|> Jsont.Object.opt_mem "bcc" (Jsont.list Email_address.jsont) ~enc:bcc
101
-
|> Jsont.Object.opt_mem "replyTo" (Jsont.list Email_address.jsont) ~enc:reply_to
102
-
|> Jsont.Object.opt_mem "subject" Jsont.string ~enc:subject
95
+
(* Header fields can be absent or null per RFC 8621 *)
96
+
|> Jsont.Object.mem "messageId" Jsont.(option (list string))
97
+
~dec_absent:None ~enc_omit:Option.is_none ~enc:message_id
98
+
|> Jsont.Object.mem "inReplyTo" Jsont.(option (list string))
99
+
~dec_absent:None ~enc_omit:Option.is_none ~enc:in_reply_to
100
+
|> Jsont.Object.mem "references" Jsont.(option (list string))
101
+
~dec_absent:None ~enc_omit:Option.is_none ~enc:references
102
+
|> Jsont.Object.mem "sender" Jsont.(option (list Email_address.jsont))
103
+
~dec_absent:None ~enc_omit:Option.is_none ~enc:sender
104
+
|> Jsont.Object.mem "from" Jsont.(option (list Email_address.jsont))
105
+
~dec_absent:None ~enc_omit:Option.is_none ~enc:from
106
+
|> Jsont.Object.mem "to" Jsont.(option (list Email_address.jsont))
107
+
~dec_absent:None ~enc_omit:Option.is_none ~enc:to_
108
+
|> Jsont.Object.mem "cc" Jsont.(option (list Email_address.jsont))
109
+
~dec_absent:None ~enc_omit:Option.is_none ~enc:cc
110
+
|> Jsont.Object.mem "bcc" Jsont.(option (list Email_address.jsont))
111
+
~dec_absent:None ~enc_omit:Option.is_none ~enc:bcc
112
+
|> Jsont.Object.mem "replyTo" Jsont.(option (list Email_address.jsont))
113
+
~dec_absent:None ~enc_omit:Option.is_none ~enc:reply_to
114
+
|> Jsont.Object.mem "subject" nullable_string
115
+
~dec_absent:None ~enc_omit:Option.is_none ~enc:subject
103
116
|> Jsont.Object.opt_mem "sentAt" Jmap_proto.Date.Rfc3339.jsont ~enc:sent_at
104
117
|> Jsont.Object.opt_mem "headers" (Jsont.list Email_header.jsont) ~enc:headers
105
118
|> Jsont.Object.opt_mem "bodyStructure" Email_body.Part.jsont ~enc:body_structure
+4
-1
proto/mail/email_address.ml
+4
-1
proto/mail/email_address.ml
···
24
24
25
25
let jsont =
26
26
let kind = "EmailAddress" in
27
+
(* name can be absent, null, or a string - all map to string option *)
28
+
(* Jsont.option maps null -> None and string -> Some string *)
27
29
Jsont.Object.map ~kind make
28
-
|> Jsont.Object.opt_mem "name" Jsont.string ~enc:name
30
+
|> Jsont.Object.mem "name" Jsont.(option string)
31
+
~dec_absent:None ~enc_omit:Option.is_none ~enc:name
29
32
|> Jsont.Object.mem "email" Jsont.string ~enc:email
30
33
|> Jsont.Object.finish
31
34
+17
-7
proto/mail/email_body.ml
+17
-7
proto/mail/email_body.ml
···
64
64
{ part_id; blob_id; size; headers; name; type_; charset; disposition;
65
65
cid; language; location; sub_parts }
66
66
in
67
+
(* Many fields can be null per RFC 8621 Section 4.1.4 *)
68
+
let nullable_string = Jsont.(option string) in
69
+
let nullable_id = Jsont.(option Jmap_proto.Id.jsont) in
67
70
lazy (
68
71
Jsont.Object.map ~kind make
69
-
|> Jsont.Object.opt_mem "partId" Jsont.string ~enc:part_id
70
-
|> Jsont.Object.opt_mem "blobId" Jmap_proto.Id.jsont ~enc:blob_id
72
+
|> Jsont.Object.mem "partId" nullable_string
73
+
~dec_absent:None ~enc_omit:Option.is_none ~enc:part_id
74
+
|> Jsont.Object.mem "blobId" nullable_id
75
+
~dec_absent:None ~enc_omit:Option.is_none ~enc:blob_id
71
76
|> Jsont.Object.opt_mem "size" Jmap_proto.Int53.Unsigned.jsont ~enc:size
72
77
|> Jsont.Object.opt_mem "headers" (Jsont.list Email_header.jsont) ~enc:headers
73
-
|> Jsont.Object.opt_mem "name" Jsont.string ~enc:name
78
+
|> Jsont.Object.mem "name" nullable_string
79
+
~dec_absent:None ~enc_omit:Option.is_none ~enc:name
74
80
|> Jsont.Object.mem "type" Jsont.string ~enc:type_
75
-
|> Jsont.Object.opt_mem "charset" Jsont.string ~enc:charset
76
-
|> Jsont.Object.opt_mem "disposition" Jsont.string ~enc:disposition
77
-
|> Jsont.Object.opt_mem "cid" Jsont.string ~enc:cid
81
+
|> Jsont.Object.mem "charset" nullable_string
82
+
~dec_absent:None ~enc_omit:Option.is_none ~enc:charset
83
+
|> Jsont.Object.mem "disposition" nullable_string
84
+
~dec_absent:None ~enc_omit:Option.is_none ~enc:disposition
85
+
|> Jsont.Object.mem "cid" nullable_string
86
+
~dec_absent:None ~enc_omit:Option.is_none ~enc:cid
78
87
|> Jsont.Object.opt_mem "language" (Jsont.list Jsont.string) ~enc:language
79
-
|> Jsont.Object.opt_mem "location" Jsont.string ~enc:location
88
+
|> Jsont.Object.mem "location" nullable_string
89
+
~dec_absent:None ~enc_omit:Option.is_none ~enc:location
80
90
|> Jsont.Object.opt_mem "subParts" (Jsont.list (Jsont.rec' jsont)) ~enc:sub_parts
81
91
|> Jsont.Object.finish
82
92
)
+14
-5
proto/mail/mailbox.ml
+14
-5
proto/mail/mailbox.ml
···
124
124
125
125
let jsont =
126
126
let kind = "Mailbox" in
127
+
(* parentId and role can be null - RFC 8621 Section 2 *)
128
+
let nullable_id = Jsont.(option Jmap_proto.Id.jsont) in
129
+
let nullable_role = Jsont.(option role_jsont) in
127
130
Jsont.Object.map ~kind make
128
131
|> Jsont.Object.mem "id" Jmap_proto.Id.jsont ~enc:id
129
132
|> Jsont.Object.mem "name" Jsont.string ~enc:name
130
-
|> Jsont.Object.opt_mem "parentId" Jmap_proto.Id.jsont ~enc:parent_id
131
-
|> Jsont.Object.opt_mem "role" role_jsont ~enc:role
133
+
|> Jsont.Object.mem "parentId" nullable_id
134
+
~dec_absent:None ~enc_omit:Option.is_none ~enc:parent_id
135
+
|> Jsont.Object.mem "role" nullable_role
136
+
~dec_absent:None ~enc_omit:Option.is_none ~enc:role
132
137
|> Jsont.Object.mem "sortOrder" Jmap_proto.Int53.Unsigned.jsont ~dec_absent:0L ~enc:sort_order
133
138
|> Jsont.Object.mem "totalEmails" Jmap_proto.Int53.Unsigned.jsont ~enc:total_emails
134
139
|> Jsont.Object.mem "unreadEmails" Jmap_proto.Int53.Unsigned.jsont ~enc:unread_emails
···
152
157
153
158
let jsont =
154
159
let kind = "MailboxFilterCondition" in
155
-
(* parentId can be null (meaning top-level) or an id *)
156
-
let nullable_id = Jsont.(some Jmap_proto.Id.jsont) in
157
-
let nullable_role = Jsont.(some role_jsont) in
160
+
(* parentId and role can be absent, null, or have a value - RFC 8621 Section 2.1 *)
161
+
(* Use opt_mem with Jsont.option to get option option type:
162
+
- None = field absent (don't filter)
163
+
- Some None = field present with null (filter for no parent/role)
164
+
- Some (Some x) = field present with value (filter for specific value) *)
165
+
let nullable_id = Jsont.(option Jmap_proto.Id.jsont) in
166
+
let nullable_role = Jsont.(option role_jsont) in
158
167
Jsont.Object.map ~kind make
159
168
|> Jsont.Object.opt_mem "parentId" nullable_id ~enc:(fun f -> f.parent_id)
160
169
|> Jsont.Object.opt_mem "name" Jsont.string ~enc:(fun f -> f.name)
+6
-2
proto/mail/search_snippet.ml
+6
-2
proto/mail/search_snippet.ml
···
17
17
18
18
let jsont =
19
19
let kind = "SearchSnippet" in
20
+
(* subject and preview can be null per RFC 8621 Section 5 *)
21
+
let nullable_string = Jsont.(option string) in
20
22
Jsont.Object.map ~kind make
21
23
|> Jsont.Object.mem "emailId" Jmap_proto.Id.jsont ~enc:email_id
22
-
|> Jsont.Object.opt_mem "subject" Jsont.string ~enc:subject
23
-
|> Jsont.Object.opt_mem "preview" Jsont.string ~enc:preview
24
+
|> Jsont.Object.mem "subject" nullable_string
25
+
~dec_absent:None ~enc_omit:Option.is_none ~enc:subject
26
+
|> Jsont.Object.mem "preview" nullable_string
27
+
~dec_absent:None ~enc_omit:Option.is_none ~enc:preview
24
28
|> Jsont.Object.finish
+8
-3
proto/mail/vacation.ml
+8
-3
proto/mail/vacation.ml
···
28
28
29
29
let jsont =
30
30
let kind = "VacationResponse" in
31
+
(* subject, textBody, htmlBody can be null per RFC 8621 Section 8 *)
32
+
let nullable_string = Jsont.(option string) in
31
33
Jsont.Object.map ~kind make
32
34
|> Jsont.Object.mem "id" Jmap_proto.Id.jsont ~enc:id
33
35
|> Jsont.Object.mem "isEnabled" Jsont.bool ~enc:is_enabled
34
36
|> Jsont.Object.opt_mem "fromDate" Jmap_proto.Date.Utc.jsont ~enc:from_date
35
37
|> Jsont.Object.opt_mem "toDate" Jmap_proto.Date.Utc.jsont ~enc:to_date
36
-
|> Jsont.Object.opt_mem "subject" Jsont.string ~enc:subject
37
-
|> Jsont.Object.opt_mem "textBody" Jsont.string ~enc:text_body
38
-
|> Jsont.Object.opt_mem "htmlBody" Jsont.string ~enc:html_body
38
+
|> Jsont.Object.mem "subject" nullable_string
39
+
~dec_absent:None ~enc_omit:Option.is_none ~enc:subject
40
+
|> Jsont.Object.mem "textBody" nullable_string
41
+
~dec_absent:None ~enc_omit:Option.is_none ~enc:text_body
42
+
|> Jsont.Object.mem "htmlBody" nullable_string
43
+
~dec_absent:None ~enc_omit:Option.is_none ~enc:html_body
39
44
|> Jsont.Object.finish
+3
-2
proto/method_.ml
+3
-2
proto/method_.ml
···
137
137
{ account_id; old_state; new_state; created; updated; destroyed;
138
138
not_created; not_updated; not_destroyed }
139
139
in
140
-
(* For updated values, the server may return null or an object *)
141
-
let nullable_obj = Jsont.(some obj_jsont) in
140
+
(* For updated values, the server may return null or an object - RFC 8620 Section 5.3 *)
141
+
(* "Id[Foo|null]" means map values can be null, use Jsont.option to handle this *)
142
+
let nullable_obj = Jsont.(option obj_jsont) in
142
143
Jsont.Object.map ~kind make
143
144
|> Jsont.Object.mem "accountId" Id.jsont ~enc:(fun r -> r.account_id)
144
145
|> Jsont.Object.opt_mem "oldState" Jsont.string ~enc:(fun r -> r.old_state)