this repo has no description
anil.recoil.org
1(*
2 * jmap_email_search.ml - A comprehensive email search utility using JMAP
3 *
4 * This binary demonstrates JMAP's query capabilities for email searching,
5 * filtering, and sorting.
6 *
7 * For step 2, we're only testing type checking. No implementations required.
8 *)
9
10open Cmdliner
11
12(** Email search arguments type *)
13type email_search_args = {
14 query : string;
15 from : string option;
16 to_ : string option;
17 subject : string option;
18 before : string option;
19 after : string option;
20 has_attachment : bool;
21 mailbox : string option;
22 is_unread : bool;
23 limit : int;
24 sort : [`DateDesc | `DateAsc | `From | `To | `Subject | `Size];
25 format : [`Summary | `Json | `Detailed];
26}
27
28(* Module to convert ISO 8601 date strings to Unix timestamps *)
29module Date_converter = struct
30 (* Convert an ISO date string (YYYY-MM-DD) to Unix timestamp *)
31 let parse_date date_str =
32 try
33 (* Parse YYYY-MM-DD format *)
34 let (year, month, day) = Scanf.sscanf date_str "%d-%d-%d" (fun y m d -> (y, m, d)) in
35
36 (* Convert to Unix timestamp (midnight UTC of that day) *)
37 let tm = Unix.{ tm_sec = 0; tm_min = 0; tm_hour = 0;
38 tm_mday = day; tm_mon = month - 1; tm_year = year - 1900;
39 tm_wday = 0; tm_yday = 0; tm_isdst = false } in
40 Some (Unix.mktime tm |> fst)
41 with _ ->
42 Printf.eprintf "Invalid date format: %s (use YYYY-MM-DD)\n" date_str;
43 None
44
45 (* Format a Unix timestamp as ISO 8601 *)
46 let format_datetime time =
47 let tm = Unix.gmtime time in
48 Printf.sprintf "%04d-%02d-%02dT%02d:%02d:%02dZ"
49 (tm.Unix.tm_year + 1900) (tm.Unix.tm_mon + 1) tm.Unix.tm_mday
50 tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec
51end
52
53(** Command-line arguments **)
54
55let host_arg =
56 Arg.(required & opt (some string) None & info ["h"; "host"]
57 ~docv:"HOST" ~doc:"JMAP server hostname")
58
59let user_arg =
60 Arg.(required & opt (some string) None & info ["u"; "user"]
61 ~docv:"USERNAME" ~doc:"Username for authentication")
62
63let password_arg =
64 Arg.(required & opt (some string) None & info ["p"; "password"]
65 ~docv:"PASSWORD" ~doc:"Password for authentication")
66
67let query_arg =
68 Arg.(value & opt string "" & info ["q"; "query"]
69 ~docv:"QUERY" ~doc:"Text to search for in emails")
70
71let from_arg =
72 Arg.(value & opt (some string) None & info ["from"]
73 ~docv:"EMAIL" ~doc:"Filter by sender email address")
74
75let to_arg =
76 Arg.(value & opt (some string) None & info ["to"]
77 ~docv:"EMAIL" ~doc:"Filter by recipient email address")
78
79let subject_arg =
80 Arg.(value & opt (some string) None & info ["subject"]
81 ~docv:"SUBJECT" ~doc:"Filter by subject text")
82
83let before_arg =
84 Arg.(value & opt (some string) None & info ["before"]
85 ~docv:"DATE" ~doc:"Show emails before date (YYYY-MM-DD)")
86
87let after_arg =
88 Arg.(value & opt (some string) None & info ["after"]
89 ~docv:"DATE" ~doc:"Show emails after date (YYYY-MM-DD)")
90
91let has_attachment_arg =
92 Arg.(value & flag & info ["has-attachment"]
93 ~doc:"Filter to emails with attachments")
94
95let mailbox_arg =
96 Arg.(value & opt (some string) None & info ["mailbox"]
97 ~docv:"MAILBOX" ~doc:"Filter by mailbox name")
98
99let is_unread_arg =
100 Arg.(value & flag & info ["unread"]
101 ~doc:"Show only unread emails")
102
103let limit_arg =
104 Arg.(value & opt int 20 & info ["limit"]
105 ~docv:"N" ~doc:"Maximum number of results to return")
106
107let sort_arg =
108 Arg.(value & opt (enum [
109 "date-desc", `DateDesc;
110 "date-asc", `DateAsc;
111 "from", `From;
112 "to", `To;
113 "subject", `Subject;
114 "size", `Size;
115 ]) `DateDesc & info ["sort"] ~docv:"FIELD"
116 ~doc:"Sort results by field")
117
118let format_arg =
119 Arg.(value & opt (enum [
120 "summary", `Summary;
121 "json", `Json;
122 "detailed", `Detailed;
123 ]) `Summary & info ["format"] ~docv:"FORMAT"
124 ~doc:"Output format")
125
126(** Main functionality **)
127
128(* Create a filter based on command-line arguments - this function uses the actual JMAP API *)
129let create_filter _account_id mailbox_id_opt args =
130 let open Jmap.Methods.Filter in
131 let filters = [] in
132
133 (* Add filter conditions based on command-line args *)
134 let filters = match args.query with
135 | "" -> filters
136 | query -> Jmap_email.Email_filter.subject query :: filters
137 in
138
139 let filters = match args.from with
140 | None -> filters
141 | Some sender -> Jmap_email.Email_filter.from sender :: filters
142 in
143
144 let filters = match args.to_ with
145 | None -> filters
146 | Some recipient -> Jmap_email.Email_filter.to_ recipient :: filters
147 in
148
149 let filters = match args.subject with
150 | None -> filters
151 | Some subj -> Jmap_email.Email_filter.subject subj :: filters
152 in
153
154 let filters = match args.before with
155 | None -> filters
156 | Some date_str ->
157 match Date_converter.parse_date date_str with
158 | Some date -> Jmap_email.Email_filter.before date :: filters
159 | None -> filters
160 in
161
162 let filters = match args.after with
163 | None -> filters
164 | Some date_str ->
165 match Date_converter.parse_date date_str with
166 | Some date -> Jmap_email.Email_filter.after date :: filters
167 | None -> filters
168 in
169
170 let filters = if args.has_attachment then Jmap_email.Email_filter.has_attachment () :: filters else filters in
171
172 let filters = if args.is_unread then Jmap_email.Email_filter.unread () :: filters else filters in
173
174 let filters = match mailbox_id_opt with
175 | None -> filters
176 | Some mailbox_id -> Jmap_email.Email_filter.in_mailbox mailbox_id :: filters
177 in
178
179 (* Combine all filters with AND *)
180 match filters with
181 | [] -> condition (`Assoc []) (* Empty filter *)
182 | [f] -> f
183 | filters -> and_ filters
184
185(* Create sort comparator based on command-line arguments *)
186let create_sort args =
187 match args.sort with
188 | `DateDesc -> Jmap_email.Email_sort.received_newest_first ()
189 | `DateAsc -> Jmap_email.Email_sort.received_oldest_first ()
190 | `From -> Jmap_email.Email_sort.from_asc ()
191 | `To -> Jmap_email.Email_sort.subject_asc () (* Using subject as proxy for 'to' *)
192 | `Subject -> Jmap_email.Email_sort.subject_asc ()
193 | `Size -> Jmap_email.Email_sort.size_largest_first ()
194
195(* Display email results based on format option *)
196let display_results emails format =
197 match format with
198 | `Summary ->
199 emails |> List.iteri (fun i email ->
200 let id = Option.value (Jmap_email.Types.Email.id email) ~default:"(no id)" in
201 let subject = Option.value (Jmap_email.Types.Email.subject email) ~default:"(no subject)" in
202 let from_list = Option.value (Jmap_email.Types.Email.from email) ~default:[] in
203 let from = match from_list with
204 | [] -> "(no sender)"
205 | addr::_ -> Jmap_email.Types.Email_address.email addr
206 in
207 let date = match Jmap_email.Types.Email.received_at email with
208 | Some d -> Date_converter.format_datetime d
209 | None -> "(no date)"
210 in
211 Printf.printf "%3d) [%s] %s\n From: %s\n Date: %s\n\n"
212 (i+1) id subject from date
213 );
214 0
215
216 | `Detailed ->
217 emails |> List.iteri (fun i email ->
218 let id = Option.value (Jmap_email.Types.Email.id email) ~default:"(no id)" in
219 let subject = Option.value (Jmap_email.Types.Email.subject email) ~default:"(no subject)" in
220 let thread_id = Option.value (Jmap_email.Types.Email.thread_id email) ~default:"(no thread)" in
221
222 let from_list = Option.value (Jmap_email.Types.Email.from email) ~default:[] in
223 let from = match from_list with
224 | [] -> "(no sender)"
225 | addr::_ -> Jmap_email.Types.Email_address.email addr
226 in
227
228 let to_list = Option.value (Jmap_email.Types.Email.to_ email) ~default:[] in
229 let to_str = to_list
230 |> List.map Jmap_email.Types.Email_address.email
231 |> String.concat ", " in
232
233 let date = match Jmap_email.Types.Email.received_at email with
234 | Some d -> Date_converter.format_datetime d
235 | None -> "(no date)"
236 in
237
238 let keywords = match Jmap_email.Types.Email.keywords email with
239 | Some kw -> Jmap_email.Types.Keywords.custom_keywords kw
240 |> String.concat ", "
241 | None -> "(none)"
242 in
243
244 let has_attachment = match Jmap_email.Types.Email.has_attachment email with
245 | Some true -> "Yes"
246 | _ -> "No"
247 in
248
249 Printf.printf "Email %d:\n" (i+1);
250 Printf.printf " ID: %s\n" id;
251 Printf.printf " Subject: %s\n" subject;
252 Printf.printf " From: %s\n" from;
253 Printf.printf " To: %s\n" to_str;
254 Printf.printf " Date: %s\n" date;
255 Printf.printf " Thread: %s\n" thread_id;
256 Printf.printf " Flags: %s\n" keywords;
257 Printf.printf " Attachment:%s\n" has_attachment;
258
259 match Jmap_email.Types.Email.preview email with
260 | Some text -> Printf.printf " Preview: %s\n" text
261 | None -> ();
262
263 Printf.printf "\n"
264 );
265 0
266
267 | `Json ->
268 (* In a real implementation, this would properly convert emails to JSON *)
269 Printf.printf "{\n \"results\": [\n";
270 emails |> List.iteri (fun i email ->
271 let id = Option.value (Jmap_email.Types.Email.id email) ~default:"" in
272 let subject = Option.value (Jmap_email.Types.Email.subject email) ~default:"" in
273 Printf.printf " {\"id\": \"%s\", \"subject\": \"%s\"%s\n"
274 id subject (if i < List.length emails - 1 then "}," else "}")
275 );
276 Printf.printf " ]\n}\n";
277 0
278
279(* Command implementation - using the real JMAP interface *)
280let search_command host user password query from to_ subject before after
281 has_attachment mailbox is_unread limit sort format : int =
282 (* Pack arguments into a record for easier passing *)
283 let args : email_search_args = {
284 query; from; to_ = to_; subject; before; after;
285 has_attachment; mailbox; is_unread; limit; sort; format
286 } in
287
288 Printf.printf "JMAP Email Search\n";
289 Printf.printf "Server: %s\n" host;
290 Printf.printf "User: %s\n\n" user;
291
292 (* The following code demonstrates using the JMAP library interface
293 but doesn't actually run it for Step 2 (it will get a linker error,
294 which is expected since there's no implementation yet) *)
295
296 let process_search () =
297 (* 1. Create client context and connect to server *)
298 let _orig_ctx = Jmap_unix.create_client () in
299 let result = Jmap_unix.quick_connect ~host ~username:user ~password in
300
301 let (ctx, session) = match result with
302 | Ok (ctx, session) -> (ctx, session)
303 | Error _ -> failwith "Could not connect to server"
304 in
305
306 (* 2. Get the primary account ID for mail capability *)
307 let account_id = match Jmap.get_primary_account session Jmap_email.capability_mail with
308 | Ok id -> id
309 | Error _ -> failwith "No mail account found"
310 in
311
312 (* 3. Resolve mailbox name to ID if specified *)
313 let mailbox_id_opt = match args.mailbox with
314 | None -> None
315 | Some _name ->
316 (* This would use Mailbox/query and Mailbox/get to resolve the name *)
317 (* For now just simulate a mailbox ID *)
318 Some "mailbox123"
319 in
320
321 (* 4. Create filter based on search criteria *)
322 let filter = create_filter account_id mailbox_id_opt args in
323
324 (* 5. Create sort comparator *)
325 let sort = create_sort args in
326
327 (* 6. Prepare Email/query request *)
328 let _query_args = Jmap.Methods.Query_args.v
329 ~account_id
330 ~filter
331 ~sort:[sort]
332 ~position:0
333 ~limit:args.limit
334 ~calculate_total:true
335 () in
336
337 let query_invocation = Jmap.Wire.Invocation.v
338 ~method_name:"Email/query"
339 ~arguments:(`Assoc []) (* In real code, we'd serialize query_args to JSON *)
340 ~method_call_id:"q1"
341 () in
342
343 (* 7. Prepare Email/get request with back-reference to query results *)
344 let get_properties = [
345 "id"; "threadId"; "mailboxIds"; "keywords"; "size";
346 "receivedAt"; "messageId"; "inReplyTo"; "references";
347 "sender"; "from"; "to"; "cc"; "bcc"; "replyTo";
348 "subject"; "sentAt"; "hasAttachment"; "preview"
349 ] in
350
351 let _get_args = Jmap.Methods.Get_args.v
352 ~account_id
353 ~properties:get_properties
354 () in
355
356 let get_invocation = Jmap.Wire.Invocation.v
357 ~method_name:"Email/get"
358 ~arguments:(`Assoc []) (* In real code, we'd serialize get_args to JSON *)
359 ~method_call_id:"g1"
360 () in
361
362 (* 8. Prepare the JMAP request *)
363 let request = Jmap.Wire.Request.v
364 ~using:[Jmap.capability_core; Jmap_email.capability_mail]
365 ~method_calls:[query_invocation; get_invocation]
366 () in
367
368 (* 9. Send the request *)
369 let response = match Jmap_unix.request ctx request with
370 | Ok response -> response
371 | Error _ -> failwith "Request failed"
372 in
373
374 (* Helper to find a method response by ID *)
375 let find_method_response response id =
376 let open Jmap.Wire in
377 let responses = Response.method_responses response in
378 let find_by_id inv =
379 match inv with
380 | Ok invocation when Invocation.method_call_id invocation = id ->
381 Some (Invocation.method_name invocation, Invocation.arguments invocation)
382 | _ -> None
383 in
384 List.find_map find_by_id responses
385 in
386
387 (* 10. Process the response *)
388 match find_method_response response "g1" with
389 | Some (method_name, _) when method_name = "Email/get" ->
390 (* We would extract the emails from the response here *)
391 (* For now, just create a sample email for type checking *)
392 let email = Jmap_email.Types.Email.create
393 ~id:"email123"
394 ~thread_id:"thread456"
395 ~subject:"Test Email"
396 ~from:[Jmap_email.Types.Email_address.v ~name:"Sender" ~email:"sender@example.com" ()]
397 ~to_:[Jmap_email.Types.Email_address.v ~name:"Recipient" ~email:"recipient@example.com" ()]
398 ~received_at:1588000000.0
399 ~has_attachment:true
400 ~preview:"This is a test email..."
401 ~keywords:(Jmap_email.Types.Keywords.of_list [Jmap_email.Types.Keywords.Seen])
402 () in
403
404 (* Display the result *)
405 display_results [email] args.format
406 | _ ->
407 Printf.eprintf "Error: Invalid response\n";
408 1
409 in
410
411 (* Note: Since we're only type checking, this won't actually run *)
412 process_search ()
413
414(* Command definition *)
415let search_cmd =
416 let doc = "search emails using JMAP query capabilities" in
417 let man = [
418 `S Manpage.s_description;
419 `P "Searches for emails on a JMAP server with powerful filtering capabilities.";
420 `P "Demonstrates the rich query functions available in the JMAP protocol.";
421 `S Manpage.s_examples;
422 `P " $(mname) -h jmap.example.com -u user@example.com -p secret123 -q \"important meeting\"";
423 `P " $(mname) -h jmap.example.com -u user@example.com -p secret123 --from boss@company.com --after 2023-01-01";
424 ] in
425
426 let cmd =
427 Cmd.v
428 (Cmd.info "jmap-email-search" ~version:"1.0" ~doc ~man)
429 Term.(const search_command $ host_arg $ user_arg $ password_arg $
430 query_arg $ from_arg $ to_arg $ subject_arg $ before_arg $ after_arg $
431 has_attachment_arg $ mailbox_arg $ is_unread_arg $ limit_arg $ sort_arg $ format_arg)
432 in
433 cmd
434
435(* Main entry point *)
436let () = exit (Cmd.eval' search_cmd)