···
limit: string option; (* For "limit" error *)
309
+
module Api = struct
313
+
(** Error that may occur during API requests *)
315
+
| Connection_error of string
316
+
| HTTP_error of int * string
317
+
| Parse_error of string
318
+
| Authentication_error
320
+
(** Result type for API operations *)
321
+
type 'a result = ('a, error) Stdlib.result
323
+
(** Configuration for a JMAP API client *)
327
+
authentication_token: string;
330
+
(** Convert Ezjsonm.value to string *)
331
+
let json_to_string json =
332
+
Ezjsonm.to_string ~minify:false json
334
+
(** Parse response string as JSON value *)
335
+
let parse_json_string str =
336
+
try Ok (Ezjsonm.from_string str)
337
+
with e -> Error (Parse_error (Printexc.to_string e))
339
+
(** Parse JSON response as a JMAP response object *)
340
+
let parse_response json =
342
+
let method_responses =
343
+
match Ezjsonm.find json ["methodResponses"] with
345
+
List.map (fun json ->
347
+
| `A [`String name; args; `String method_call_id] ->
348
+
{ name; arguments = args; method_call_id }
349
+
| _ -> raise (Invalid_argument "Invalid invocation format in response")
351
+
| _ -> raise (Invalid_argument "methodResponses is not an array")
353
+
let created_ids_opt =
355
+
let obj = Ezjsonm.find json ["createdIds"] in
357
+
| `O items -> Some (List.map (fun (k, v) ->
359
+
| `String id -> (k, id)
360
+
| _ -> raise (Invalid_argument "createdIds value is not a string")
363
+
with Not_found -> None
365
+
let session_state =
366
+
match Ezjsonm.find json ["sessionState"] with
368
+
| _ -> raise (Invalid_argument "sessionState is not a string")
370
+
Ok { method_responses; created_ids = created_ids_opt; session_state }
372
+
| Not_found -> Error (Parse_error "Required field not found in response")
373
+
| Invalid_argument msg -> Error (Parse_error msg)
374
+
| e -> Error (Parse_error (Printexc.to_string e))
376
+
(** Serialize a JMAP request object to JSON *)
377
+
let serialize_request req =
378
+
let method_calls_json =
379
+
`A (List.map (fun inv ->
380
+
`A [`String inv.name; inv.arguments; `String inv.method_call_id]
381
+
) req.method_calls)
383
+
let using_json = `A (List.map (fun s -> `String s) req.using) in
385
+
("using", using_json);
386
+
("methodCalls", method_calls_json)
388
+
let json = match req.created_ids with
390
+
let created_ids_json = `O (List.map (fun (k, v) -> (k, `String v)) ids) in
391
+
Ezjsonm.update json ["createdIds"] created_ids_json
394
+
json_to_string json
396
+
(** Make a raw HTTP request *)
397
+
let make_http_request ~headers ~body uri =
399
+
let open Cohttp_lwt_unix in
400
+
let headers = Header.add_list (Header.init ()) headers in
403
+
let* resp, body = Client.post ~headers ~body:(Cohttp_lwt.Body.of_string body) uri in
404
+
let* body_str = Cohttp_lwt.Body.to_string body in
405
+
let status = Response.status resp |> Code.code_of_status in
406
+
if status >= 200 && status < 300 then
407
+
Lwt.return (Ok body_str)
409
+
Lwt.return (Error (HTTP_error (status, body_str))))
410
+
(fun e -> Lwt.return (Error (Connection_error (Printexc.to_string e))))
412
+
(** Make a raw JMAP API request
415
+
let make_request config req =
416
+
let body = serialize_request req in
418
+
("Content-Type", "application/json");
419
+
("Content-Length", string_of_int (String.length body));
420
+
("Authorization", "Basic " ^ Base64.encode_string (config.username ^ ":" ^ config.authentication_token))
422
+
let* result = make_http_request ~headers ~body config.api_uri in
424
+
| Ok response_body ->
425
+
(match parse_json_string response_body with
426
+
| Ok json -> Lwt.return (parse_response json)
427
+
| Error e -> Lwt.return (Error e))
428
+
| Error e -> Lwt.return (Error e)
430
+
(** Parse a JSON object as a Session object *)
431
+
let parse_session_object json =
434
+
match Ezjsonm.find json ["capabilities"] with
435
+
| `O items -> items
436
+
| _ -> raise (Invalid_argument "capabilities is not an object")
440
+
match Ezjsonm.find json ["accounts"] with
441
+
| `O items -> List.map (fun (id, json) ->
444
+
let name = Ezjsonm.get_string (Ezjsonm.find json ["name"]) in
445
+
let is_personal = Ezjsonm.get_bool (Ezjsonm.find json ["isPersonal"]) in
446
+
let is_read_only = Ezjsonm.get_bool (Ezjsonm.find json ["isReadOnly"]) in
447
+
let account_capabilities =
448
+
match Ezjsonm.find json ["accountCapabilities"] with
449
+
| `O items -> items
450
+
| _ -> raise (Invalid_argument "accountCapabilities is not an object")
452
+
(id, { name; is_personal; is_read_only; account_capabilities })
453
+
| _ -> raise (Invalid_argument "account value is not an object")
455
+
| _ -> raise (Invalid_argument "accounts is not an object")
458
+
let primary_accounts =
459
+
match Ezjsonm.find_opt json ["primaryAccounts"] with
460
+
| Some (`O items) -> List.map (fun (k, v) ->
462
+
| `String id -> (k, id)
463
+
| _ -> raise (Invalid_argument "primaryAccounts value is not a string")
465
+
| Some _ -> raise (Invalid_argument "primaryAccounts is not an object")
469
+
let username = Ezjsonm.get_string (Ezjsonm.find json ["username"]) in
470
+
let api_url = Ezjsonm.get_string (Ezjsonm.find json ["apiUrl"]) in
471
+
let download_url = Ezjsonm.get_string (Ezjsonm.find json ["downloadUrl"]) in
472
+
let upload_url = Ezjsonm.get_string (Ezjsonm.find json ["uploadUrl"]) in
473
+
let event_source_url =
474
+
try Some (Ezjsonm.get_string (Ezjsonm.find json ["eventSourceUrl"]))
475
+
with Not_found -> None
477
+
let state = Ezjsonm.get_string (Ezjsonm.find json ["state"]) in
479
+
Ok { capabilities; accounts; primary_accounts; username;
480
+
api_url; download_url; upload_url; event_source_url; state }
482
+
| Not_found -> Error (Parse_error "Required field not found in session object")
483
+
| Invalid_argument msg -> Error (Parse_error msg)
484
+
| e -> Error (Parse_error (Printexc.to_string e))
486
+
(** Fetch a Session object from a JMAP server
489
+
let get_session uri ?username ?authentication_token () =
491
+
match (username, authentication_token) with
492
+
| (Some u, Some t) -> [
493
+
("Content-Type", "application/json");
494
+
("Authorization", "Basic " ^ Base64.encode_string (u ^ ":" ^ t))
496
+
| _ -> [("Content-Type", "application/json")]
499
+
let* result = make_http_request ~headers ~body:"" uri in
501
+
| Ok response_body ->
502
+
(match parse_json_string response_body with
503
+
| Ok json -> Lwt.return (parse_session_object json)
504
+
| Error e -> Lwt.return (Error e))
505
+
| Error e -> Lwt.return (Error e)
507
+
(** Upload a binary blob to the server
510
+
let upload_blob config ~account_id ~content_type data =
511
+
let upload_url_template = config.api_uri |> Uri.to_string in
512
+
(* Replace {accountId} with the actual account ID *)
513
+
let upload_url = Str.global_replace (Str.regexp "{accountId}") account_id upload_url_template in
514
+
let upload_uri = Uri.of_string upload_url in
517
+
("Content-Type", content_type);
518
+
("Content-Length", string_of_int (String.length data));
519
+
("Authorization", "Basic " ^ Base64.encode_string (config.username ^ ":" ^ config.authentication_token))
522
+
let* result = make_http_request ~headers ~body:data upload_uri in
524
+
| Ok response_body ->
525
+
(match parse_json_string response_body with
528
+
let account_id = Ezjsonm.get_string (Ezjsonm.find json ["accountId"]) in
529
+
let blob_id = Ezjsonm.get_string (Ezjsonm.find json ["blobId"]) in
530
+
let type_ = Ezjsonm.get_string (Ezjsonm.find json ["type"]) in
531
+
let size = Ezjsonm.get_int (Ezjsonm.find json ["size"]) in
532
+
Lwt.return (Ok { account_id; blob_id; type_; size })
534
+
| Not_found -> Lwt.return (Error (Parse_error "Required field not found in upload response"))
535
+
| e -> Lwt.return (Error (Parse_error (Printexc.to_string e))))
536
+
| Error e -> Lwt.return (Error e))
537
+
| Error e -> Lwt.return (Error e)
539
+
(** Download a binary blob from the server
542
+
let download_blob config ~account_id ~blob_id ?type_ ?name () =
543
+
let download_url_template = config.api_uri |> Uri.to_string in
545
+
(* Replace template variables with actual values *)
546
+
let url = Str.global_replace (Str.regexp "{accountId}") account_id download_url_template in
547
+
let url = Str.global_replace (Str.regexp "{blobId}") blob_id url in
549
+
let url = match type_ with
550
+
| Some t -> Str.global_replace (Str.regexp "{type}") (Uri.pct_encode t) url
551
+
| None -> Str.global_replace (Str.regexp "{type}") "" url
554
+
let url = match name with
555
+
| Some n -> Str.global_replace (Str.regexp "{name}") (Uri.pct_encode n) url
556
+
| None -> Str.global_replace (Str.regexp "{name}") "file" url
559
+
let download_uri = Uri.of_string url in
562
+
("Authorization", "Basic " ^ Base64.encode_string (config.username ^ ":" ^ config.authentication_token))
565
+
let* result = make_http_request ~headers ~body:"" download_uri in
anil.recoil.org