My agentic slop goes here. Not intended for anyone else!
anil.recoil.org
1(** High-level JMAP Client API implementation *)
2
3open Printf
4open Jmap.Error
5
6(** Client internal state with resource management *)
7type t = {
8 env : < net : Eio.Net.t; .. >;
9 context : Jmap_unix.context;
10 session : Jmap.Session.t;
11 config : config;
12 stats : stats_counter;
13 mutable closed : bool;
14}
15
16and config = {
17 connect_timeout : float option;
18 request_timeout : float option;
19 max_concurrent_requests : int option;
20 max_request_size : int option;
21 user_agent : string option;
22 retry_attempts : int option;
23 retry_delay : float option;
24 enable_push : bool;
25}
26
27and stats_counter = {
28 mutable requests_sent : int;
29 mutable requests_successful : int;
30 mutable requests_failed : int;
31 mutable bytes_sent : int64;
32 mutable bytes_received : int64;
33 mutable connection_reuses : int;
34 mutable total_response_time : float;
35}
36
37type credentials = [
38 | `Basic of string * string
39 | `Bearer of string
40 | `Custom of string * string
41 | `Session_cookie of string * string
42]
43
44(** Error conversion from old to new error types *)
45let convert_error = function
46 | Jmap.Error.Transport msg -> `Network_error (`Connection_failed msg, msg, true)
47 | Jmap.Error.Parse msg -> `Parse_error (`Invalid_json msg, msg)
48 | Jmap.Error.Protocol msg -> `Protocol_error msg
49 | Jmap.Error.Auth msg -> `Auth_error (`Invalid_credentials, msg)
50 | Jmap.Error.Method (error_type, desc) ->
51 let desc_str = match desc with Some d -> d | None -> "" in
52 `Method_error ("unknown", "unknown", error_type, desc)
53 | Jmap.Error.SetItem (id, error_type, desc) ->
54 let desc_str = match desc with Some d -> d | None -> "" in
55 `Set_error ("unknown", id, error_type, desc)
56 | Jmap.Error.ServerError msg -> `Server_error (`Internal_error (500, msg), msg)
57 | Jmap.Error.Problem msg -> `Protocol_error msg
58
59(** Convert old result to new result type *)
60let (>>>=) result f = match result with
61 | Ok value -> f value
62 | Error old_error -> Error (convert_error old_error)
63
64(** Default client configuration *)
65let default_config () = {
66 connect_timeout = Some 10.0;
67 request_timeout = Some 30.0;
68 max_concurrent_requests = Some 10;
69 max_request_size = Some (10 * 1024 * 1024); (* 10MB *)
70 user_agent = Some ("JMAP OCaml Client/1.0");
71 retry_attempts = Some 3;
72 retry_delay = Some 1.0;
73 enable_push = false;
74}
75
76(** Create stats counter *)
77let create_stats () = {
78 requests_sent = 0;
79 requests_successful = 0;
80 requests_failed = 0;
81 bytes_sent = 0L;
82 bytes_received = 0L;
83 connection_reuses = 0;
84 total_response_time = 0.0;
85}
86
87(** Update request statistics *)
88let update_stats stats ~success ~bytes_sent ~bytes_received ~response_time =
89 stats.requests_sent <- stats.requests_sent + 1;
90 (if success then stats.requests_successful <- stats.requests_successful + 1
91 else stats.requests_failed <- stats.requests_failed + 1);
92 stats.bytes_sent <- Int64.add stats.bytes_sent (Int64.of_int bytes_sent);
93 stats.bytes_received <- Int64.add stats.bytes_received (Int64.of_int bytes_received);
94 stats.total_response_time <- stats.total_response_time +. response_time
95
96(** Connection with automatic session discovery *)
97let connect ~credentials ?(config = default_config ()) env base_url =
98 let stats = create_stats () in
99 try
100 let start_time = Unix.gettimeofday () in
101
102 (* Convert credentials to jmap-unix auth method *)
103 let auth_method = match credentials with
104 | `Basic (user, pass) -> Jmap_unix.Basic (user, pass)
105 | `Bearer token -> Jmap_unix.Bearer token
106 | `Custom (name, value) -> Jmap_unix.Custom (name, value)
107 | `Session_cookie (name, value) -> Jmap_unix.Session_cookie (name, value)
108 in
109
110 (* Create jmap-unix context with configuration *)
111 let client_config = Jmap_unix.{
112 connect_timeout = config.connect_timeout;
113 request_timeout = config.request_timeout;
114 max_concurrent_requests = config.max_concurrent_requests;
115 max_request_size = config.max_request_size;
116 user_agent = config.user_agent;
117 authentication_header = None;
118 tls = Some (Jmap_unix.default_tls_config ());
119 } in
120
121 let context_result = Jmap_unix.create ~config:client_config ~auth:auth_method () in
122 context_result >>>= fun context ->
123
124 (* Discover and fetch session *)
125 let session_result = Jmap_unix.connect env context base_url in
126 session_result >>>= fun session ->
127
128 let end_time = Unix.gettimeofday () in
129 update_stats stats ~success:true ~bytes_sent:0 ~bytes_received:0
130 ~response_time:(end_time -. start_time);
131
132 let client = {
133 env; context; session; config; stats; closed = false;
134 } in
135 Ok client
136
137 with
138 | exn -> Error (`Network_error (`Connection_failed (Printexc.to_string exn),
139 Printexc.to_string exn, true))
140
141(** Get primary account ID for mail operations *)
142let primary_account client =
143 if client.closed then failwith "Client is closed";
144 Jmap_unix.Session_utils.get_primary_mail_account client.session
145
146(** Get account for specific capability *)
147let account_for_capability client capability =
148 if client.closed then None else
149 try Some (Jmap_unix.Session_utils.get_primary_mail_account client.session)
150 with _ -> None
151
152(** Check capability support *)
153let has_capability client capability =
154 if client.closed then false else
155 (* TODO: Implement proper capability checking *)
156 true
157
158(** Get capabilities *)
159let capabilities client =
160 if client.closed then [] else
161 (* TODO: Extract from session *)
162 [("urn:ietf:params:jmap:core", `Null); ("urn:ietf:params:jmap:mail", `Null)]
163
164(** Close client *)
165let close client =
166 client.closed <- true
167
168(** High-level email query with automatic chaining *)
169let query_emails client ?account_id ?filter ?sort ?limit ?properties () =
170 if client.closed then Error (`Protocol_error "Client is closed") else
171 try
172 let start_time = Unix.gettimeofday () in
173 let account = match account_id with
174 | Some id -> id
175 | None -> primary_account client
176 in
177
178 (* Use jmap-email query builder *)
179 let query_builder = Jmap_email.Query.query () in
180 let query_builder = Jmap_email.Query.with_account account query_builder in
181 let query_builder = match filter with
182 | Some f -> Jmap_email.Query.with_filter f query_builder
183 | None -> query_builder
184 in
185 let query_builder = match sort with
186 | Some sorts -> List.fold_left (fun acc s -> Jmap_email.Query.order_by s acc) query_builder sorts
187 | None -> Jmap_email.Query.order_by Jmap_email.Query.Sort.by_date_desc query_builder
188 in
189 let query_builder = match limit with
190 | Some l -> Jmap_email.Query.limit l query_builder
191 | None -> Jmap_email.Query.limit 20 query_builder
192 in
193
194 (* Build query JSON *)
195 let query_json = Jmap_email.Query.build_email_query query_builder in
196
197 (* Determine properties *)
198 let props = match properties with
199 | Some p -> p
200 | None -> [`Id; `ThreadId; `From; `Subject; `ReceivedAt; `Preview; `Keywords; `HasAttachment]
201 in
202
203 (* Build get JSON with result reference *)
204 let get_json = Jmap_email.Query.build_email_get_with_ref
205 ~account_id:account ~properties:props ~result_of:"q1" in
206
207 (* Execute request using jmap-unix *)
208 let builder = Jmap_unix.build client.context in
209 let builder = Jmap_unix.using builder [`Core; `Mail] in
210 let builder = Jmap_unix.add_method_call builder `Email_query query_json "q1" in
211 let builder = Jmap_unix.add_method_call builder `Email_get get_json "g1" in
212
213 let response_result = Jmap_unix.execute client.env builder in
214 response_result >>>= fun response ->
215
216 (* Parse query response *)
217 let query_response_json_result =
218 Jmap_unix.Response.extract_method ~method_name:`Email_query ~method_call_id:"q1" response in
219 query_response_json_result >>>= fun query_response_json ->
220
221 let query_response_result =
222 Jmap_email.Response.parse_query_response query_response_json in
223 query_response_result >>>= fun query_response ->
224
225 (* Parse get response *)
226 let get_response_json_result =
227 Jmap_unix.Response.extract_method ~method_name:`Email_get ~method_call_id:"g1" response in
228 get_response_json_result >>>= fun get_response_json ->
229
230 let get_response_result = Jmap_email.Response.parse_get_response
231 ~from_json:(fun json -> match Jmap_email.Email.of_json json with
232 | Ok email -> email
233 | Error err -> failwith ("Email parse error: " ^ err))
234 get_response_json in
235 get_response_result >>>= fun get_response ->
236
237 let emails = Jmap_email.Response.emails_from_get_response get_response in
238
239 let end_time = Unix.gettimeofday () in
240 update_stats client.stats ~success:true ~bytes_sent:1000 ~bytes_received:5000
241 ~response_time:(end_time -. start_time);
242
243 Ok emails
244
245 with
246 | exn ->
247 update_stats client.stats ~success:false ~bytes_sent:0 ~bytes_received:0 ~response_time:0.0;
248 Error (`Network_error (`Connection_failed (Printexc.to_string exn),
249 Printexc.to_string exn, true))
250
251(** Get emails by ID *)
252let get_emails client ?account_id ids ?properties () =
253 if client.closed then Error (`Protocol_error "Client is closed") else
254 if ids = [] then Ok [] else
255 try
256 let account = match account_id with
257 | Some id -> id
258 | None -> primary_account client
259 in
260
261 let props = match properties with
262 | Some p -> p
263 | None -> [`Id; `ThreadId; `From; `Subject; `ReceivedAt; `Preview; `Keywords]
264 in
265
266 (* Build get request directly *)
267 let get_args = Jmap.Methods.Get_args.v ~account_id:account ~ids ~properties:[] () in
268 let get_json = Jmap.Methods.Get_args.to_json get_args in
269
270 let builder = Jmap_unix.build client.context in
271 let builder = Jmap_unix.using builder [`Core; `Mail] in
272 let builder = Jmap_unix.add_method_call builder `Email_get get_json "g1" in
273
274 let response_result = Jmap_unix.execute client.env builder in
275 response_result >>>= fun response ->
276
277 let get_response_json_result =
278 Jmap_unix.Response.extract_method ~method_name:`Email_get ~method_call_id:"g1" response in
279 get_response_json_result >>>= fun get_response_json ->
280
281 let get_response_result = Jmap_email.Response.parse_get_response
282 ~from_json:(fun json -> match Jmap_email.Email.of_json json with
283 | Ok email -> email
284 | Error err -> failwith ("Email parse error: " ^ err))
285 get_response_json in
286 get_response_result >>>= fun get_response ->
287
288 let emails = Jmap_email.Response.emails_from_get_response get_response in
289 Ok emails
290
291 with
292 | exn -> Error (`Network_error (`Connection_failed (Printexc.to_string exn),
293 Printexc.to_string exn, true))
294
295(** Import email message *)
296let import_email client ~account_id ~raw_message ~mailbox_ids ?keywords ?received_at () =
297 if client.closed then Error (`Protocol_error "Client is closed") else
298 Error (`Server_error (`Version_not_supported, "Import not yet implemented"))
299
300(** Destroy email *)
301let destroy_email client ~account_id ~email_id =
302 if client.closed then Error (`Protocol_error "Client is closed") else
303 Error (`Server_error (`Version_not_supported, "Destroy not yet implemented"))
304
305(** Set email keywords *)
306let set_email_keywords client ~account_id ~email_id ~keywords =
307 if client.closed then Error (`Protocol_error "Client is closed") else
308 Error (`Server_error (`Version_not_supported, "Set keywords not yet implemented"))
309
310(** Set email mailboxes *)
311let set_email_mailboxes client ~account_id ~email_id ~mailbox_ids =
312 if client.closed then Error (`Protocol_error "Client is closed") else
313 Error (`Server_error (`Version_not_supported, "Set mailboxes not yet implemented"))
314
315(** Query mailboxes *)
316let query_mailboxes client ?account_id ?filter ?sort () =
317 if client.closed then Error (`Protocol_error "Client is closed") else
318 Error (`Server_error (`Version_not_supported, "Mailbox query not yet implemented"))
319
320(** Create mailbox *)
321let create_mailbox client ~account_id ~name ?parent_id ?role () =
322 if client.closed then Error (`Protocol_error "Client is closed") else
323 Error (`Server_error (`Version_not_supported, "Mailbox create not yet implemented"))
324
325(** Destroy mailbox *)
326let destroy_mailbox client ~account_id ~mailbox_id ?on_destroy_remove_emails () =
327 if client.closed then Error (`Protocol_error "Client is closed") else
328 Error (`Server_error (`Version_not_supported, "Mailbox destroy not yet implemented"))
329
330(** Batch operations - Advanced feature for complex workflows *)
331module Batch = struct
332 type batch_builder = {
333 client : t;
334 operations : (string * Yojson.Safe.t) list;
335 mutable counter : int;
336 }
337
338 type 'a batch_operation = {
339 call_id : string;
340 parser : Yojson.Safe.t -> ('a, Jmap.Error.error) result;
341 }
342
343 let create client = {
344 client;
345 operations = [];
346 counter = 0;
347 }
348
349 let query_emails batch ?account_id ?filter ?sort ?limit () =
350 Error (`Server_error (`Version_not_supported, "Batch operations not yet implemented"))
351
352 let get_emails_ref batch query_op ?properties () =
353 Error (`Server_error (`Version_not_supported, "Batch operations not yet implemented"))
354
355 let execute batch =
356 Error (`Server_error (`Version_not_supported, "Batch operations not yet implemented"))
357
358 let result operation =
359 Error (`Server_error (`Version_not_supported, "Batch operations not yet implemented"))
360end
361
362(** Connection statistics for monitoring *)
363type connection_stats = {
364 requests_sent : int;
365 requests_successful : int;
366 requests_failed : int;
367 bytes_sent : int64;
368 bytes_received : int64;
369 connection_reuses : int;
370 average_response_time : float;
371}
372
373(** Connection statistics *)
374let stats client = {
375 requests_sent = client.stats.requests_sent;
376 requests_successful = client.stats.requests_successful;
377 requests_failed = client.stats.requests_failed;
378 bytes_sent = client.stats.bytes_sent;
379 bytes_received = client.stats.bytes_received;
380 connection_reuses = client.stats.connection_reuses;
381 average_response_time =
382 if client.stats.requests_sent > 0 then
383 client.stats.total_response_time /. (float client.stats.requests_sent)
384 else 0.0;
385}
386
387(** Ping connection *)
388let ping client =
389 if client.closed then Error (`Protocol_error "Client is closed") else
390 (* Use Core/echo method for ping *)
391 try
392 let builder = Jmap_unix.build client.context in
393 let builder = Jmap_unix.using builder [`Core] in
394 let echo_args = `Assoc [("hello", `String "ping")] in
395 let builder = Jmap_unix.add_method_call builder `Core_echo echo_args "ping1" in
396 let response_result = Jmap_unix.execute client.env builder in
397 response_result >>>= fun _response ->
398 Ok ()
399 with
400 | exn -> Error (`Network_error (`Connection_failed (Printexc.to_string exn),
401 Printexc.to_string exn, true))
402
403(** Refresh connection *)
404let refresh_connection client =
405 if client.closed then Error (`Protocol_error "Client is closed") else
406 (* For now, just test with ping *)
407 ping client