My agentic slop goes here. Not intended for anyone else!
1(** JMAP HTTP Client - Eio Implementation *)
2
3type t = {
4 session_url : string;
5 get_request : timeout:Requests.Timeout.t -> string -> Requests.Response.t;
6 post_request : timeout:Requests.Timeout.t -> headers:Requests.Headers.t -> body:Requests.Body.t -> string -> Requests.Response.t;
7 conn : Jmap_connection.t;
8 session : Jmap_core.Session.t option ref;
9}
10
11let create ~sw ~env ~conn ~session_url () =
12 let requests_session = Requests.create ~sw env in
13
14 (* Set authentication if configured *)
15 let requests_session = match Jmap_connection.auth conn with
16 | Some (Jmap_connection.Bearer token) ->
17 Requests.set_auth requests_session (Requests.Auth.bearer ~token)
18 | Some (Jmap_connection.Basic (user, pass)) ->
19 Requests.set_auth requests_session (Requests.Auth.basic ~username:user ~password:pass)
20 | None -> requests_session
21 in
22
23 (* Set user agent *)
24 let config = Jmap_connection.config conn in
25 let requests_session = Requests.set_default_header requests_session "User-Agent"
26 (Jmap_connection.user_agent config) in
27
28 { session_url;
29 get_request = (fun ~timeout url -> Requests.get requests_session ~timeout url);
30 post_request = (fun ~timeout ~headers ~body url -> Requests.post requests_session ~timeout ~headers ~body url);
31 conn;
32 session = ref None }
33
34let fetch_session t =
35 let config = Jmap_connection.config t.conn in
36 let timeout = Requests.Timeout.create ~total:(Jmap_connection.timeout config) () in
37
38 let response = t.get_request ~timeout t.session_url in
39
40 if not (Requests.Response.ok response) then
41 failwith (Printf.sprintf "Failed to fetch session: HTTP %d"
42 (Requests.Response.status_code response));
43
44 let body_str =
45 let buf = Buffer.create 4096 in
46 Eio.Flow.copy (Requests.Response.body response) (Eio.Flow.buffer_sink buf);
47 Buffer.contents buf
48 in
49
50 let session = Jmap_core.Session.Parser.of_string body_str in
51 t.session := Some session;
52 session
53
54let get_session t =
55 match !(t.session) with
56 | Some s -> s
57 | None -> fetch_session t
58
59let call t req =
60 let session = get_session t in
61 let api_url = Jmap_core.Session.api_url session in
62 let config = Jmap_connection.config t.conn in
63 let timeout = Requests.Timeout.create ~total:(Jmap_connection.timeout config) () in
64
65 (* Convert request to JSON *)
66 let req_json = Jmap_core.Request.to_json req in
67
68 (* Set up headers *)
69 let headers = Requests.Headers.(empty
70 |> set "Accept" "application/json") in
71
72 (* Make POST request with JSON body *)
73 let body = Requests.Body.json req_json in
74 let response = t.post_request ~timeout ~headers ~body api_url in
75
76 (* Read response body first *)
77 let body_str =
78 let buf = Buffer.create 4096 in
79 Eio.Flow.copy (Requests.Response.body response) (Eio.Flow.buffer_sink buf);
80 Buffer.contents buf
81 in
82
83 if not (Requests.Response.ok response) then (
84 Printf.eprintf "JMAP API call failed: HTTP %d\n" (Requests.Response.status_code response);
85 Printf.eprintf "Response body: %s\n%!" body_str;
86 failwith (Printf.sprintf "JMAP API call failed: HTTP %d"
87 (Requests.Response.status_code response))
88 );
89
90 Jmap_core.Response.Parser.of_string body_str
91
92let upload t ~account_id ~content_type:ct data =
93 let session = get_session t in
94 let upload_url = Jmap_core.Session.upload_url session in
95 let config = Jmap_connection.config t.conn in
96 let timeout = Requests.Timeout.create ~total:(Jmap_connection.timeout config) () in
97
98 (* Replace {accountId} placeholder *)
99 let upload_url = Str.global_replace (Str.regexp_string "{accountId}")
100 account_id upload_url in
101
102 let mime = Requests.Mime.of_string ct in
103 let headers = Requests.Headers.empty in
104
105 let body = Requests.Body.of_string mime data in
106 let response = t.post_request ~timeout ~headers ~body upload_url in
107
108 if not (Requests.Response.ok response) then
109 failwith (Printf.sprintf "Upload failed: HTTP %d"
110 (Requests.Response.status_code response));
111
112 let body_str =
113 let buf = Buffer.create 4096 in
114 Eio.Flow.copy (Requests.Response.body response) (Eio.Flow.buffer_sink buf);
115 Buffer.contents buf
116 in
117
118 let json = Ezjsonm.value_from_string body_str in
119 Jmap_core.Binary.Upload.of_json json
120
121let download t ~account_id ~blob_id ~name =
122 let session = get_session t in
123 let download_url = Jmap_core.Session.download_url session in
124 let config = Jmap_connection.config t.conn in
125 let timeout = Requests.Timeout.create ~total:(Jmap_connection.timeout config) () in
126
127 (* Replace placeholders *)
128 let download_url = download_url
129 |> Str.global_replace (Str.regexp_string "{accountId}") account_id
130 |> Str.global_replace (Str.regexp_string "{blobId}") blob_id
131 |> Str.global_replace (Str.regexp_string "{name}") name in
132
133 let response = t.get_request ~timeout download_url in
134
135 if not (Requests.Response.ok response) then
136 failwith (Printf.sprintf "Download failed: HTTP %d"
137 (Requests.Response.status_code response));
138
139 let buf = Buffer.create 4096 in
140 Eio.Flow.copy (Requests.Response.body response) (Eio.Flow.buffer_sink buf);
141 Buffer.contents buf