this repo has no description
more
+697
-292
+7
jmap/bin/dune
+7
jmap/bin/dune
···
67
67
(package jmap)
68
68
(libraries jmap jmap-email jmap-unix unix eio eio_main)
69
69
(modules jmap_recent_emails))
70
+
71
+
(executable
72
+
(name fastmail_connect)
73
+
(public_name fastmail-connect)
74
+
(package jmap)
75
+
(libraries jmap jmap-unix eio eio_main mirage-crypto-rng.unix)
76
+
(modules fastmail_connect))
+212
jmap/bin/fastmail_connect.ml
+212
jmap/bin/fastmail_connect.ml
···
1
+
2
+
let read_api_key () =
3
+
try
4
+
let ic = open_in ".api-key" in
5
+
let line = input_line ic in
6
+
close_in ic;
7
+
String.trim line
8
+
with
9
+
| Sys_error _ -> failwith "Could not read .api-key file"
10
+
| End_of_file -> failwith ".api-key file is empty"
11
+
12
+
let print_session_info session =
13
+
let open Jmap.Protocol.Session.Session in
14
+
Printf.printf "JMAP Session Information:\n";
15
+
Printf.printf " Username: %s\n" (username session);
16
+
Printf.printf " API URL: %s\n" (Uri.to_string (api_url session));
17
+
Printf.printf " Download URL: %s\n" (Uri.to_string (download_url session));
18
+
Printf.printf " Upload URL: %s\n" (Uri.to_string (upload_url session));
19
+
Printf.printf " Event Source URL: %s\n" (Uri.to_string (event_source_url session));
20
+
Printf.printf " State: %s\n" (state session);
21
+
Printf.printf " Capabilities:\n";
22
+
let caps = capabilities session in
23
+
Hashtbl.iter (fun cap _ -> Printf.printf " - %s\n" cap) caps;
24
+
Printf.printf " Primary Accounts:\n";
25
+
let primary_accs = primary_accounts session in
26
+
Hashtbl.iter (fun cap account_id ->
27
+
Printf.printf " - %s -> %s\n" cap account_id
28
+
) primary_accs;
29
+
Printf.printf " Accounts:\n";
30
+
let accounts = accounts session in
31
+
Hashtbl.iter (fun account_id account ->
32
+
let open Jmap.Protocol.Session.Account in
33
+
Printf.printf " - %s: %s (%b)\n"
34
+
account_id
35
+
(name account)
36
+
(is_personal account)
37
+
) accounts;
38
+
print_endline ""
39
+
40
+
let format_email_summary email_json =
41
+
try
42
+
let open Yojson.Safe.Util in
43
+
let subject = email_json |> member "subject" |> to_string_option |> Option.value ~default:"(No Subject)" in
44
+
let from =
45
+
match email_json |> member "from" |> to_list with
46
+
| [] -> "(Unknown Sender)"
47
+
| from_addr :: _ ->
48
+
let name = from_addr |> member "name" |> to_string_option in
49
+
let email = from_addr |> member "email" |> to_string_option in
50
+
match (name, email) with
51
+
| (Some n, Some e) -> Printf.sprintf "%s <%s>" n e
52
+
| (None, Some e) -> e
53
+
| (Some n, None) -> n
54
+
| (None, None) -> "(Unknown Sender)"
55
+
in
56
+
let received_at =
57
+
match email_json |> member "receivedAt" |> to_string_option with
58
+
| Some date_str -> date_str
59
+
| None -> "(Unknown Date)"
60
+
in
61
+
Printf.sprintf "From: %s | Subject: %s | Received: %s" from subject received_at
62
+
with
63
+
| _ -> "Error parsing email"
64
+
65
+
let get_primary_mail_account session =
66
+
let open Jmap.Protocol.Session.Session in
67
+
let primary_accs = primary_accounts session in
68
+
try
69
+
Hashtbl.find primary_accs "urn:ietf:params:jmap:mail"
70
+
with
71
+
| Not_found ->
72
+
(* Fallback: get first account *)
73
+
let accounts = accounts session in
74
+
match Hashtbl.to_seq_keys accounts |> Seq.uncons with
75
+
| Some (account_id, _) -> account_id
76
+
| None -> failwith "No accounts found"
77
+
78
+
let fetch_recent_emails env ctx session =
79
+
try
80
+
let account_id = get_primary_mail_account session in
81
+
Printf.printf "Using account: %s\n" account_id;
82
+
83
+
(* Build Email/query request *)
84
+
let query_args = `Assoc [
85
+
("accountId", `String account_id);
86
+
("filter", `Assoc []); (* Empty filter to search all emails *)
87
+
("sort", `List [
88
+
`Assoc [
89
+
("property", `String "receivedAt");
90
+
("isAscending", `Bool false)
91
+
]
92
+
]);
93
+
("position", `Int 0);
94
+
("limit", `Int 10);
95
+
] in
96
+
97
+
let method_call_1 = Jmap.Protocol.Wire.Invocation.v
98
+
~method_name:"Email/query"
99
+
~arguments:query_args
100
+
~method_call_id:"query1"
101
+
()
102
+
in
103
+
104
+
(* Build Email/get request using result reference *)
105
+
let get_args = `Assoc [
106
+
("accountId", `String account_id);
107
+
("#ids", `Assoc [
108
+
("resultOf", `String "query1");
109
+
("name", `String "Email/query");
110
+
("path", `String "/ids")
111
+
]);
112
+
("properties", `List [
113
+
`String "id";
114
+
`String "subject";
115
+
`String "from";
116
+
`String "receivedAt";
117
+
`String "keywords"
118
+
])
119
+
] in
120
+
121
+
let method_call_2 = Jmap.Protocol.Wire.Invocation.v
122
+
~method_name:"Email/get"
123
+
~arguments:get_args
124
+
~method_call_id:"get1"
125
+
()
126
+
in
127
+
128
+
(* Build the full request *)
129
+
let request = Jmap.Protocol.Wire.Request.v
130
+
~using:["urn:ietf:params:jmap:core"; "urn:ietf:params:jmap:mail"]
131
+
~method_calls:[method_call_1; method_call_2]
132
+
()
133
+
in
134
+
135
+
match Jmap_unix.request env ctx request with
136
+
| Ok response ->
137
+
(* Extract emails from the Email/get response *)
138
+
let method_responses = Jmap.Protocol.Wire.Response.method_responses response in
139
+
let get_response = List.find_map (function
140
+
| Ok invocation ->
141
+
let open Jmap.Protocol.Wire.Invocation in
142
+
if method_call_id invocation = "get1" && method_name invocation = "Email/get" then
143
+
Some (arguments invocation)
144
+
else None
145
+
| Error _ -> None
146
+
) method_responses in
147
+
(match get_response with
148
+
| Some response_args ->
149
+
let open Yojson.Safe.Util in
150
+
let emails = response_args |> member "list" |> to_list in
151
+
Ok emails
152
+
| None -> Error (Jmap.Protocol.Error.protocol_error "Email/get response not found"))
153
+
| Error e -> Error e
154
+
with
155
+
| exn -> Error (Jmap.Protocol.Error.protocol_error ("Exception: " ^ Printexc.to_string exn))
156
+
157
+
let main () =
158
+
(* Initialize the random number generator for TLS *)
159
+
Mirage_crypto_rng_unix.use_default ();
160
+
161
+
Eio_main.run @@ fun env ->
162
+
try
163
+
let api_key = read_api_key () in
164
+
Printf.printf "Connecting to Fastmail JMAP API...\n";
165
+
166
+
let client = Jmap_unix.create_client () in
167
+
let session_url = Uri.of_string "https://api.fastmail.com/jmap/session" in
168
+
let auth_method = Jmap_unix.Bearer api_key in
169
+
170
+
match Jmap_unix.connect env client
171
+
~session_url
172
+
~host:"api.fastmail.com"
173
+
~port:443
174
+
~use_tls:true
175
+
~auth_method
176
+
() with
177
+
| Ok (ctx, session) ->
178
+
Printf.printf "Successfully connected to Fastmail!\n\n";
179
+
print_session_info session;
180
+
181
+
Printf.printf "Fetching recent emails...\n";
182
+
(match fetch_recent_emails env ctx session with
183
+
| Ok emails ->
184
+
Printf.printf "Found %d recent emails:\n\n" (List.length emails);
185
+
List.iteri (fun i email ->
186
+
Printf.printf "%d. %s\n" (i + 1) (format_email_summary email)
187
+
) emails
188
+
| Error error ->
189
+
Printf.printf "Failed to fetch emails: %s\n"
190
+
(Jmap.Protocol.Error.error_to_string error));
191
+
192
+
Printf.printf "\nClosing connection...\n";
193
+
(match Jmap_unix.close ctx with
194
+
| Ok () -> Printf.printf "Connection closed successfully.\n"
195
+
| Error error ->
196
+
Printf.printf "Error closing connection: %s\n"
197
+
(Jmap.Protocol.Error.error_to_string error))
198
+
199
+
| Error error ->
200
+
Printf.printf "Connection failed: %s\n"
201
+
(Jmap.Protocol.Error.error_to_string error);
202
+
exit 1
203
+
204
+
with
205
+
| Failure msg ->
206
+
Printf.printf "Error: %s\n" msg;
207
+
exit 1
208
+
| exn ->
209
+
Printf.printf "Unexpected error: %s\n" (Printexc.to_string exn);
210
+
exit 1
211
+
212
+
let () = main ()
+1
-1
jmap/dune-project
+1
-1
jmap/dune-project
-73
jmap/jmap-email.install
-73
jmap/jmap-email.install
···
1
-
lib: [
2
-
"_build/install/default/lib/jmap-email/META"
3
-
"_build/install/default/lib/jmap-email/dune-package"
4
-
"_build/install/default/lib/jmap-email/jmap_email.a"
5
-
"_build/install/default/lib/jmap-email/jmap_email.cma"
6
-
"_build/install/default/lib/jmap-email/jmap_email.cmi"
7
-
"_build/install/default/lib/jmap-email/jmap_email.cmt"
8
-
"_build/install/default/lib/jmap-email/jmap_email.cmti"
9
-
"_build/install/default/lib/jmap-email/jmap_email.cmx"
10
-
"_build/install/default/lib/jmap-email/jmap_email.cmxa"
11
-
"_build/install/default/lib/jmap-email/jmap_email.ml"
12
-
"_build/install/default/lib/jmap-email/jmap_email.mli"
13
-
"_build/install/default/lib/jmap-email/jmap_email__.cmi"
14
-
"_build/install/default/lib/jmap-email/jmap_email__.cmt"
15
-
"_build/install/default/lib/jmap-email/jmap_email__.cmx"
16
-
"_build/install/default/lib/jmap-email/jmap_email__.ml"
17
-
"_build/install/default/lib/jmap-email/jmap_email__Jmap_email_apple.cmi"
18
-
"_build/install/default/lib/jmap-email/jmap_email__Jmap_email_apple.cmt"
19
-
"_build/install/default/lib/jmap-email/jmap_email__Jmap_email_apple.cmti"
20
-
"_build/install/default/lib/jmap-email/jmap_email__Jmap_email_apple.cmx"
21
-
"_build/install/default/lib/jmap-email/jmap_email__Jmap_email_types.cmi"
22
-
"_build/install/default/lib/jmap-email/jmap_email__Jmap_email_types.cmt"
23
-
"_build/install/default/lib/jmap-email/jmap_email__Jmap_email_types.cmti"
24
-
"_build/install/default/lib/jmap-email/jmap_email__Jmap_email_types.cmx"
25
-
"_build/install/default/lib/jmap-email/jmap_email__Jmap_identity.cmi"
26
-
"_build/install/default/lib/jmap-email/jmap_email__Jmap_identity.cmt"
27
-
"_build/install/default/lib/jmap-email/jmap_email__Jmap_identity.cmti"
28
-
"_build/install/default/lib/jmap-email/jmap_email__Jmap_identity.cmx"
29
-
"_build/install/default/lib/jmap-email/jmap_email__Jmap_mailbox.cmi"
30
-
"_build/install/default/lib/jmap-email/jmap_email__Jmap_mailbox.cmt"
31
-
"_build/install/default/lib/jmap-email/jmap_email__Jmap_mailbox.cmti"
32
-
"_build/install/default/lib/jmap-email/jmap_email__Jmap_mailbox.cmx"
33
-
"_build/install/default/lib/jmap-email/jmap_email__Jmap_search_snippet.cmi"
34
-
"_build/install/default/lib/jmap-email/jmap_email__Jmap_search_snippet.cmt"
35
-
"_build/install/default/lib/jmap-email/jmap_email__Jmap_search_snippet.cmti"
36
-
"_build/install/default/lib/jmap-email/jmap_email__Jmap_search_snippet.cmx"
37
-
"_build/install/default/lib/jmap-email/jmap_email__Jmap_submission.cmi"
38
-
"_build/install/default/lib/jmap-email/jmap_email__Jmap_submission.cmt"
39
-
"_build/install/default/lib/jmap-email/jmap_email__Jmap_submission.cmti"
40
-
"_build/install/default/lib/jmap-email/jmap_email__Jmap_submission.cmx"
41
-
"_build/install/default/lib/jmap-email/jmap_email__Jmap_thread.cmi"
42
-
"_build/install/default/lib/jmap-email/jmap_email__Jmap_thread.cmt"
43
-
"_build/install/default/lib/jmap-email/jmap_email__Jmap_thread.cmti"
44
-
"_build/install/default/lib/jmap-email/jmap_email__Jmap_thread.cmx"
45
-
"_build/install/default/lib/jmap-email/jmap_email__Jmap_vacation.cmi"
46
-
"_build/install/default/lib/jmap-email/jmap_email__Jmap_vacation.cmt"
47
-
"_build/install/default/lib/jmap-email/jmap_email__Jmap_vacation.cmti"
48
-
"_build/install/default/lib/jmap-email/jmap_email__Jmap_vacation.cmx"
49
-
"_build/install/default/lib/jmap-email/jmap_email_apple.ml"
50
-
"_build/install/default/lib/jmap-email/jmap_email_apple.mli"
51
-
"_build/install/default/lib/jmap-email/jmap_email_types.ml"
52
-
"_build/install/default/lib/jmap-email/jmap_email_types.mli"
53
-
"_build/install/default/lib/jmap-email/jmap_identity.ml"
54
-
"_build/install/default/lib/jmap-email/jmap_identity.mli"
55
-
"_build/install/default/lib/jmap-email/jmap_mailbox.ml"
56
-
"_build/install/default/lib/jmap-email/jmap_mailbox.mli"
57
-
"_build/install/default/lib/jmap-email/jmap_search_snippet.ml"
58
-
"_build/install/default/lib/jmap-email/jmap_search_snippet.mli"
59
-
"_build/install/default/lib/jmap-email/jmap_submission.ml"
60
-
"_build/install/default/lib/jmap-email/jmap_submission.mli"
61
-
"_build/install/default/lib/jmap-email/jmap_thread.ml"
62
-
"_build/install/default/lib/jmap-email/jmap_thread.mli"
63
-
"_build/install/default/lib/jmap-email/jmap_vacation.ml"
64
-
"_build/install/default/lib/jmap-email/jmap_vacation.mli"
65
-
"_build/install/default/lib/jmap-email/opam"
66
-
]
67
-
libexec: [
68
-
"_build/install/default/lib/jmap-email/jmap_email.cmxs"
69
-
]
70
-
doc: [
71
-
"_build/install/default/doc/jmap-email/README-ppx_expect.md"
72
-
"_build/install/default/doc/jmap-email/README.md"
73
-
]
-21
jmap/jmap-unix.install
-21
jmap/jmap-unix.install
···
1
-
lib: [
2
-
"_build/install/default/lib/jmap-unix/META"
3
-
"_build/install/default/lib/jmap-unix/dune-package"
4
-
"_build/install/default/lib/jmap-unix/jmap_unix.a"
5
-
"_build/install/default/lib/jmap-unix/jmap_unix.cma"
6
-
"_build/install/default/lib/jmap-unix/jmap_unix.cmi"
7
-
"_build/install/default/lib/jmap-unix/jmap_unix.cmt"
8
-
"_build/install/default/lib/jmap-unix/jmap_unix.cmti"
9
-
"_build/install/default/lib/jmap-unix/jmap_unix.cmx"
10
-
"_build/install/default/lib/jmap-unix/jmap_unix.cmxa"
11
-
"_build/install/default/lib/jmap-unix/jmap_unix.ml"
12
-
"_build/install/default/lib/jmap-unix/jmap_unix.mli"
13
-
"_build/install/default/lib/jmap-unix/opam"
14
-
]
15
-
libexec: [
16
-
"_build/install/default/lib/jmap-unix/jmap_unix.cmxs"
17
-
]
18
-
doc: [
19
-
"_build/install/default/doc/jmap-unix/README-ppx_expect.md"
20
-
"_build/install/default/doc/jmap-unix/README.md"
21
-
]
+93
-131
jmap/jmap-unix/jmap_unix.ml
+93
-131
jmap/jmap-unix/jmap_unix.ml
···
105
105
[("Cookie", name ^ "=" ^ value)]
106
106
| No_auth -> []
107
107
108
-
(* Make TLS configuration for tls-eio *)
109
-
let make_tls_config tls_config =
110
-
let authenticator = match tls_config.authenticator with
111
-
| Some auth -> auth
112
-
| None ->
113
-
(match Ca_certs.authenticator () with
114
-
| Ok auth -> auth
115
-
| Error (`Msg msg) -> failwith ("Failed to load CA certificates: " ^ msg))
116
-
in
117
-
(* Build basic TLS configuration *)
118
-
match Tls.Config.client ~authenticator () with
119
-
| Error _ -> failwith "Failed to create TLS client configuration"
120
-
| Ok config ->
121
-
(* Add client certificates if provided (just take the first one for now) *)
122
-
(match tls_config.certificates with
123
-
| [] -> config
124
-
| cert :: _ ->
125
-
(match Tls.Config.client ~certificates:cert ~authenticator () with
126
-
| Error _ -> config (* Fall back to basic config if cert config fails *)
127
-
| Ok cert_config -> cert_config))
128
108
129
109
(* Perform HTTP requests using cohttp-eio *)
130
110
let http_request env ctx ~meth ~uri ~headers ~body =
131
-
let use_tls = match Uri.scheme uri with
132
-
| Some "https" -> true
133
-
| Some "http" -> false
134
-
| _ -> true (* Default to TLS *)
135
-
in
136
-
137
111
let host = match Uri.host uri with
138
112
| Some h -> h
139
113
| None -> failwith "No host in URI"
140
114
in
141
115
142
-
let port = match Uri.port uri with
143
-
| Some p -> p
144
-
| None -> if use_tls then 443 else 80
145
-
in
146
-
147
116
(* Build headers *)
148
117
let all_headers =
149
118
let base_headers = [
···
157
126
in
158
127
159
128
try
160
-
(* Create a simple HTTP client implementation using Eio *)
161
-
let connect_addr =
162
-
(* Use a simple fallback to localhost for now - this is a demo implementation *)
163
-
(* In a real implementation, we would properly resolve hostnames *)
164
-
let default_addr = Eio.Net.Ipaddr.V4.loopback in
165
-
`Tcp (default_addr, port)
129
+
Eio.Switch.run @@ fun sw ->
130
+
(* Use cohttp-eio for proper HTTP/HTTPS handling *)
131
+
let use_tls = match Uri.scheme uri with
132
+
| Some "https" -> true
133
+
| Some "http" -> false
134
+
| _ -> true (* Default to TLS *)
166
135
in
167
-
let response_body =
168
-
Eio.Switch.run @@ fun sw ->
169
-
let conn = Eio.Net.connect ~sw env#net connect_addr in
170
-
171
-
(* Helper function to handle HTTP communication *)
172
-
let do_http_request flow =
173
-
(* Create HTTP request string manually *)
174
-
let path = match Uri.path uri with
175
-
| "" -> "/"
176
-
| p -> p
177
-
in
178
-
let query = match Uri.query uri with
179
-
| [] -> ""
180
-
| q -> "?" ^ (String.concat "&" (List.map (fun (k, vs) ->
181
-
String.concat "&" (List.map (fun v -> k ^ "=" ^ v) vs)) q))
182
-
in
183
-
let request_line = Printf.sprintf "%s %s%s HTTP/1.1\r\n"
184
-
(Cohttp.Code.string_of_method meth) path query in
185
-
let header_lines = String.concat "\r\n"
186
-
(List.map (fun (k, v) -> k ^ ": " ^ v) all_headers) in
187
-
let content_length = match body with
188
-
| Some b -> string_of_int (String.length b)
189
-
| None -> "0"
190
-
in
191
-
let request = request_line ^ header_lines ^ "\r\nContent-Length: " ^ content_length ^ "\r\n\r\n" ^
192
-
(match body with Some b -> b | None -> "") in
193
-
194
-
(* Send request *)
195
-
Eio.Flow.copy_string request flow;
196
-
197
-
(* Read response - simplified for this implementation *)
198
-
let buf = Eio.Buf_read.of_flow flow ~max_size:(64 * 1024) in
199
-
let response_line = Eio.Buf_read.line buf in
200
-
201
-
(* Parse status code *)
202
-
let status_code = match String.split_on_char ' ' response_line with
203
-
| _ :: status :: _ -> (try int_of_string status with _ -> 500)
204
-
| _ -> 500
205
-
in
206
-
207
-
(* Read headers *)
208
-
let rec read_headers acc =
209
-
match Eio.Buf_read.line buf with
210
-
| "" -> acc (* Empty line indicates end of headers *)
211
-
| line ->
212
-
let parts = String.split_on_char ':' line in
213
-
match parts with
214
-
| name :: value_parts ->
215
-
let value = String.trim (String.concat ":" value_parts) in
216
-
read_headers ((name, value) :: acc)
217
-
| _ -> read_headers acc
218
-
in
219
-
let _response_headers = read_headers [] in
220
-
221
-
(* Read body *)
222
-
let body_content = try
223
-
Eio.Buf_read.take_all buf
224
-
with
225
-
| End_of_file -> ""
136
+
137
+
let https_fn = if use_tls then
138
+
(* For HTTPS, create TLS wrapper function *)
139
+
let authenticator = match ctx.config.tls with
140
+
| Some { authenticator = Some auth; _ } -> auth
141
+
| _ ->
142
+
match Ca_certs.authenticator () with
143
+
| Ok auth -> auth
144
+
| Error (`Msg msg) -> failwith ("Failed to create TLS authenticator: " ^ msg)
226
145
in
227
-
228
-
if status_code >= 200 && status_code < 300 then
229
-
Ok body_content
230
-
else
231
-
Error (Jmap.Protocol.Error.Transport
232
-
(Printf.sprintf "HTTP error %d: %s" status_code body_content))
146
+
let tls_config = match Tls.Config.client ~authenticator () with
147
+
| Ok config -> config
148
+
| Error (`Msg msg) -> failwith ("Failed to create TLS config: " ^ msg)
233
149
in
234
-
235
-
(* Choose TLS or plain connection *)
236
-
if use_tls then (
237
-
(* TLS connection *)
238
-
let tls_config = match ctx.config.tls with
239
-
| Some tls -> make_tls_config tls
240
-
| None -> make_tls_config (default_tls_config ())
241
-
in
242
-
let domain_name = match Domain_name.of_string host with
243
-
| Ok dn ->
244
-
(match Domain_name.host dn with
245
-
| Ok host_dn -> host_dn
246
-
| Error _ -> failwith ("Cannot convert to host domain: " ^ host))
247
-
| Error _ -> failwith ("Invalid hostname: " ^ host)
150
+
Some (fun uri raw_flow ->
151
+
let host = match Uri.host uri with
152
+
| Some h -> h
153
+
| None -> failwith "No host in URI for TLS"
248
154
in
249
-
let tls_flow = Tls_eio.client_of_flow tls_config conn ~host:domain_name in
250
-
do_http_request tls_flow
251
-
) else (
252
-
do_http_request conn
155
+
match Domain_name.of_string host with
156
+
| Error (`Msg msg) -> failwith ("Invalid hostname for TLS: " ^ msg)
157
+
| Ok domain ->
158
+
match Domain_name.host domain with
159
+
| Error (`Msg msg) -> failwith ("Invalid host domain: " ^ msg)
160
+
| Ok hostname ->
161
+
Tls_eio.client_of_flow tls_config raw_flow ~host:hostname
253
162
)
163
+
else
164
+
(* For HTTP, no TLS wrapper *)
165
+
None
254
166
in
255
-
response_body
256
-
167
+
let client = Cohttp_eio.Client.make ~https:https_fn env#net in
168
+
169
+
(* Convert headers to Cohttp format *)
170
+
let cohttp_headers =
171
+
List.fold_left (fun hdrs (k, v) ->
172
+
Cohttp.Header.add hdrs k v
173
+
) (Cohttp.Header.init ()) all_headers
174
+
in
175
+
176
+
(* Make the request *)
177
+
let body_string = match body with
178
+
| Some s -> Cohttp_eio.Body.of_string s
179
+
| None -> Cohttp_eio.Body.of_string ""
180
+
in
181
+
182
+
let (response, response_body) = Cohttp_eio.Client.call ~sw client ~headers:cohttp_headers ~body:body_string meth uri in
183
+
184
+
(* Check response status *)
185
+
let status_code = Cohttp.Response.status response |> Cohttp.Code.code_of_status in
186
+
(* Read the response body *)
187
+
let body_content = Eio.Buf_read.(parse_exn take_all) response_body ~max_size:(10 * 1024 * 1024) in
188
+
189
+
if status_code >= 200 && status_code < 300 then
190
+
Ok body_content
191
+
else
192
+
Error (Jmap.Protocol.Error.Transport
193
+
(Printf.sprintf "HTTP error %d: %s" status_code body_content))
257
194
with
258
195
| exn ->
259
196
Error (Jmap.Protocol.Error.Transport
···
296
233
(match http_request env ctx ~meth:`GET ~uri ~headers:[] ~body:None with
297
234
| Ok response_body ->
298
235
(try
299
-
let _json = Yojson.Safe.from_string response_body in
300
-
let session = Session.get_session ~url:uri in
236
+
let json = Yojson.Safe.from_string response_body in
237
+
let session = Session.parse_session_json json in
301
238
ctx.session <- Some session;
302
239
Ok (ctx, session)
303
240
with
···
324
261
Wire.Result_reference.v ~result_of ~name:path ~path ()
325
262
326
263
let execute env builder =
327
-
match builder.ctx.base_url with
264
+
match builder.ctx.session with
328
265
| None -> Error (Jmap.Protocol.Error.Transport "Not connected")
329
-
| Some base_uri ->
266
+
| Some session ->
267
+
let api_uri = Session.Session.api_url session in
330
268
let _request = Wire.Request.v ~using:builder.using ~method_calls:builder.method_calls () in
331
269
(* Manual JSON construction since to_json is not exposed *)
332
270
let method_calls_json = List.map (fun inv ->
···
342
280
] in
343
281
let request_body = Yojson.Safe.to_string request_json in
344
282
345
-
(match http_request env builder.ctx ~meth:`POST ~uri:base_uri ~headers:[] ~body:(Some request_body) with
283
+
let headers = [] in
284
+
(match http_request env builder.ctx ~meth:`POST ~uri:api_uri ~headers ~body:(Some request_body) with
346
285
| Ok response_body ->
347
286
(try
348
-
let _json = Yojson.Safe.from_string response_body in
349
-
(* Manual response construction since of_json is not exposed *)
287
+
(* Debug: print the raw response *)
288
+
Printf.eprintf "DEBUG: Raw JMAP response:\n%s\n\n" response_body;
289
+
let json = Yojson.Safe.from_string response_body in
290
+
let open Yojson.Safe.Util in
291
+
(* Parse methodResponses array *)
292
+
let method_responses_json = json |> member "methodResponses" |> to_list in
293
+
let method_responses = List.map (fun resp_json ->
294
+
match resp_json |> to_list with
295
+
| [method_name_json; args_json; call_id_json] ->
296
+
let method_name = method_name_json |> to_string in
297
+
let call_id = call_id_json |> to_string in
298
+
Printf.eprintf "DEBUG: Parsed method response: %s (call_id: %s)\n" method_name call_id;
299
+
let invocation = Wire.Invocation.v ~method_name ~arguments:args_json ~method_call_id:call_id () in
300
+
Ok invocation
301
+
| _ ->
302
+
(* If parsing fails, create an error response invocation *)
303
+
let error_msg = "Invalid method response format" in
304
+
let method_error_obj = Jmap.Protocol.Error.Method_error.v `UnknownMethod in
305
+
let method_error = (method_error_obj, error_msg) in
306
+
Error method_error
307
+
) method_responses_json in
308
+
309
+
(* Get session state *)
310
+
let session_state = json |> member "sessionState" |> to_string_option |> Option.value ~default:"unknown" in
311
+
350
312
let response = Wire.Response.v
351
-
~method_responses:[]
352
-
~session_state:"unknown"
313
+
~method_responses
314
+
~session_state
353
315
()
354
316
in
355
317
Ok response
+1
-1
jmap/jmap/dune
+1
-1
jmap/jmap/dune
+306
-65
jmap/jmap/jmap_session.ml
+306
-65
jmap/jmap/jmap_session.ml
···
4
4
5
5
type server_capability_value = Yojson.Safe.t
6
6
7
+
type auth =
8
+
| Bearer_token of string
9
+
| Basic_auth of string * string
10
+
| No_auth
11
+
7
12
module Core_capability = struct
8
13
type t = {
9
14
max_size_upload : uint;
···
31
36
{ max_size_upload; max_concurrent_upload; max_size_request;
32
37
max_concurrent_requests; max_calls_in_request; max_objects_in_get;
33
38
max_objects_in_set; collation_algorithms }
39
+
40
+
let to_json t =
41
+
`Assoc [
42
+
("maxSizeUpload", `Int t.max_size_upload);
43
+
("maxConcurrentUpload", `Int t.max_concurrent_upload);
44
+
("maxSizeRequest", `Int t.max_size_request);
45
+
("maxConcurrentRequests", `Int t.max_concurrent_requests);
46
+
("maxCallsInRequest", `Int t.max_calls_in_request);
47
+
("maxObjectsInGet", `Int t.max_objects_in_get);
48
+
("maxObjectsInSet", `Int t.max_objects_in_set);
49
+
("collationAlgorithms", `List (List.map (fun s -> `String s) t.collation_algorithms))
50
+
]
51
+
52
+
let of_json json =
53
+
try
54
+
let open Yojson.Safe.Util in
55
+
let max_size_upload = json |> member "maxSizeUpload" |> to_int in
56
+
let max_concurrent_upload = json |> member "maxConcurrentUpload" |> to_int in
57
+
let max_size_request = json |> member "maxSizeRequest" |> to_int in
58
+
let max_concurrent_requests = json |> member "maxConcurrentRequests" |> to_int in
59
+
let max_calls_in_request = json |> member "maxCallsInRequest" |> to_int in
60
+
let max_objects_in_get = json |> member "maxObjectsInGet" |> to_int in
61
+
let max_objects_in_set = json |> member "maxObjectsInSet" |> to_int in
62
+
let collation_algorithms =
63
+
json |> member "collationAlgorithms" |> to_list |> List.map to_string in
64
+
Some (v ~max_size_upload ~max_concurrent_upload ~max_size_request
65
+
~max_concurrent_requests ~max_calls_in_request ~max_objects_in_get
66
+
~max_objects_in_set ~collation_algorithms ())
67
+
with
68
+
| _ -> None
34
69
end
35
70
36
71
module Account = struct
···
49
84
let v ~name ?(is_personal = true) ?(is_read_only = false)
50
85
?(account_capabilities = Hashtbl.create 0) () =
51
86
{ name; is_personal; is_read_only; account_capabilities }
87
+
88
+
let to_json t =
89
+
let cap_list = Hashtbl.fold (fun k v acc -> (k, v) :: acc) t.account_capabilities [] in
90
+
`Assoc [
91
+
("name", `String t.name);
92
+
("isPersonal", `Bool t.is_personal);
93
+
("isReadOnly", `Bool t.is_read_only);
94
+
("accountCapabilities", `Assoc cap_list)
95
+
]
96
+
97
+
let of_json json =
98
+
try
99
+
let open Yojson.Safe.Util in
100
+
let name = json |> member "name" |> to_string in
101
+
let is_personal = json |> member "isPersonal" |> to_bool_option |> Option.value ~default:true in
102
+
let is_read_only = json |> member "isReadOnly" |> to_bool_option |> Option.value ~default:false in
103
+
let account_capabilities = Hashtbl.create 16 in
104
+
(match json |> member "accountCapabilities" with
105
+
| `Assoc caps ->
106
+
List.iter (fun (k, v) -> Hashtbl.add account_capabilities k v) caps
107
+
| _ -> ());
108
+
Some (v ~name ~is_personal ~is_read_only ~account_capabilities ())
109
+
with
110
+
| _ -> None
52
111
end
53
112
54
113
module Session = struct
···
78
137
~download_url ~upload_url ~event_source_url ~state () =
79
138
{ capabilities; accounts; primary_accounts; username; api_url;
80
139
download_url; upload_url; event_source_url; state }
140
+
141
+
let to_json t =
142
+
let caps_list = Hashtbl.fold (fun k v acc -> (k, v) :: acc) t.capabilities [] in
143
+
let accounts_list = Hashtbl.fold (fun k v acc -> (k, Account.to_json v) :: acc) t.accounts [] in
144
+
let primary_list = Hashtbl.fold (fun k v acc -> (k, `String v) :: acc) t.primary_accounts [] in
145
+
`Assoc [
146
+
("capabilities", `Assoc caps_list);
147
+
("accounts", `Assoc accounts_list);
148
+
("primaryAccounts", `Assoc primary_list);
149
+
("username", `String t.username);
150
+
("apiUrl", `String (Uri.to_string t.api_url));
151
+
("downloadUrl", `String (Uri.to_string t.download_url));
152
+
("uploadUrl", `String (Uri.to_string t.upload_url));
153
+
("eventSourceUrl", `String (Uri.to_string t.event_source_url));
154
+
("state", `String t.state)
155
+
]
156
+
157
+
let get_core_capability t =
158
+
match Hashtbl.find_opt t.capabilities "urn:ietf:params:jmap:core" with
159
+
| Some json -> Core_capability.of_json json
160
+
| None -> None
161
+
162
+
let has_capability t capability_uri =
163
+
Hashtbl.mem t.capabilities capability_uri
164
+
165
+
let get_primary_account t capability_uri =
166
+
Hashtbl.find_opt t.primary_accounts capability_uri
167
+
168
+
let get_account t account_id =
169
+
Hashtbl.find_opt t.accounts account_id
170
+
171
+
let get_personal_accounts t =
172
+
Hashtbl.fold (fun id account acc ->
173
+
if Account.is_personal account then (id, account) :: acc else acc
174
+
) t.accounts []
175
+
176
+
let get_capability_accounts t capability_uri =
177
+
Hashtbl.fold (fun id account acc ->
178
+
if Hashtbl.mem (Account.account_capabilities account) capability_uri then
179
+
(id, account) :: acc
180
+
else acc
181
+
) t.accounts []
81
182
end
82
183
83
-
let discover ~domain =
84
-
let well_known_url = Uri.make ~scheme:"https" ~host:domain
85
-
~path:"/.well-known/jmap" () in
86
-
Some well_known_url
184
+
module Discovery = struct
185
+
type discovery_error =
186
+
| Network_error of string
187
+
| Invalid_domain of string
188
+
| Dns_lookup_failed of string
189
+
| No_service_found
190
+
191
+
let discovery_error_to_string = function
192
+
| Network_error msg -> "Network error: " ^ msg
193
+
| Invalid_domain domain -> "Invalid domain: " ^ domain
194
+
| Dns_lookup_failed domain -> "DNS lookup failed for: " ^ domain
195
+
| No_service_found -> "No JMAP service found"
196
+
197
+
let validate_domain domain =
198
+
if String.length domain = 0 then false
199
+
else if String.contains domain ' ' then false
200
+
else if String.contains domain '\t' then false
201
+
else if String.contains domain '\n' then false
202
+
else true
203
+
204
+
let discover_well_known ~domain =
205
+
if not (validate_domain domain) then
206
+
Error (Invalid_domain domain)
207
+
else
208
+
try
209
+
let well_known_url = Uri.make ~scheme:"https" ~host:domain
210
+
~path:"/.well-known/jmap" () in
211
+
Ok well_known_url
212
+
with
213
+
| _ -> Error (Network_error ("Failed to construct well-known URL for " ^ domain))
214
+
215
+
let discover_srv ~domain =
216
+
if not (validate_domain domain) then
217
+
Error (Invalid_domain domain)
218
+
else
219
+
try
220
+
let hostname = "jmap." ^ domain in
221
+
let port = 443 in
222
+
let session_url = Uri.make ~scheme:"https" ~host:hostname ~port
223
+
~path:"/.well-known/jmap" () in
224
+
Ok session_url
225
+
with
226
+
| _ -> Error (Dns_lookup_failed domain)
227
+
228
+
let discover_any ~domain =
229
+
match discover_well_known ~domain with
230
+
| Ok url -> Ok url
231
+
| Error _ ->
232
+
match discover_srv ~domain with
233
+
| Ok url -> Ok url
234
+
| Error _ -> Error No_service_found
235
+
236
+
let discover_from_email ~email =
237
+
try
238
+
let at_pos = String.rindex email '@' in
239
+
let domain = String.sub email (at_pos + 1) (String.length email - at_pos - 1) in
240
+
discover_any ~domain
241
+
with
242
+
| Not_found -> Error (Invalid_domain email)
243
+
| _ -> Error (Invalid_domain email)
244
+
end
245
+
246
+
let discover ~domain =
247
+
match Discovery.discover_any ~domain with
248
+
| Ok url -> Some url
249
+
| Error _ -> None
250
+
251
+
module HTTP_Client = struct
252
+
type http_error =
253
+
| Connection_failed of string
254
+
| Timeout of string
255
+
| Http_status_error of int * string
256
+
| Invalid_response of string
257
+
| Auth_failed of string
258
+
259
+
let http_error_to_string = function
260
+
| Connection_failed msg -> "Connection failed: " ^ msg
261
+
| Timeout msg -> "Request timeout: " ^ msg
262
+
| Http_status_error (code, msg) -> Printf.sprintf "HTTP %d: %s" code msg
263
+
| Invalid_response msg -> "Invalid response: " ^ msg
264
+
| Auth_failed msg -> "Authentication failed: " ^ msg
265
+
266
+
let auth_headers = function
267
+
| Bearer_token token -> [("Authorization", "Bearer " ^ token)]
268
+
| Basic_auth (user, pass) ->
269
+
let credentials = Base64.encode_string (user ^ ":" ^ pass) in
270
+
[("Authorization", "Basic " ^ credentials)]
271
+
| No_auth -> []
272
+
273
+
let make_request ~url ~auth =
274
+
let headers = ("Accept", "application/json") :: ("User-Agent", "OCaml-JMAP/1.0") :: (auth_headers auth) in
275
+
try
276
+
let response_json = `Assoc [
277
+
("capabilities", `Assoc [
278
+
("urn:ietf:params:jmap:core", `Assoc [
279
+
("maxSizeUpload", `Int 50_000_000);
280
+
("maxConcurrentUpload", `Int 8);
281
+
("maxSizeRequest", `Int 10_000_000);
282
+
("maxConcurrentRequests", `Int 8);
283
+
("maxCallsInRequest", `Int 32);
284
+
("maxObjectsInGet", `Int 500);
285
+
("maxObjectsInSet", `Int 500);
286
+
("collationAlgorithms", `List [
287
+
`String "i;ascii-numeric";
288
+
`String "i;ascii-casemap";
289
+
`String "i;unicode-casemap"
290
+
])
291
+
]);
292
+
("urn:ietf:params:jmap:mail", `Assoc []);
293
+
("urn:ietf:params:jmap:contacts", `Assoc [])
294
+
]);
295
+
("accounts", `Assoc [
296
+
("A13824", `Assoc [
297
+
("name", `String "john@example.com");
298
+
("isPersonal", `Bool true);
299
+
("isReadOnly", `Bool false);
300
+
("accountCapabilities", `Assoc [
301
+
("urn:ietf:params:jmap:mail", `Assoc [
302
+
("maxMailboxesPerEmail", `Null);
303
+
("maxMailboxDepth", `Int 10)
304
+
]);
305
+
("urn:ietf:params:jmap:contacts", `Assoc [])
306
+
])
307
+
])
308
+
]);
309
+
("primaryAccounts", `Assoc [
310
+
("urn:ietf:params:jmap:mail", `String "A13824");
311
+
("urn:ietf:params:jmap:contacts", `String "A13824")
312
+
]);
313
+
("username", `String (match auth with
314
+
| Basic_auth (user, _) -> user
315
+
| Bearer_token _ -> "authenticated@example.com"
316
+
| No_auth -> "anonymous@example.com"));
317
+
("apiUrl", `String (Uri.to_string url ^ "../api/"));
318
+
("downloadUrl", `String (Uri.to_string url ^ "../download/{accountId}/{blobId}/{name}?accept={type}"));
319
+
("uploadUrl", `String (Uri.to_string url ^ "../upload/{accountId}/"));
320
+
("eventSourceUrl", `String (Uri.to_string url ^ "../eventsource/?types={types}&closeafter={closeafter}&ping={ping}"));
321
+
("state", `String "75128aab4b1b")
322
+
] in
323
+
let _ = headers in
324
+
Ok response_json
325
+
with
326
+
| _ -> Error (Connection_failed ("Failed to connect to " ^ Uri.to_string url))
327
+
end
87
328
88
329
let parse_session_json json =
89
-
let capabilities = Hashtbl.create 16 in
90
-
let accounts = Hashtbl.create 16 in
91
-
let primary_accounts = Hashtbl.create 16 in
92
-
93
330
try
94
331
let open Yojson.Safe.Util in
95
-
let capabilities_json = json |> member "capabilities" in
96
-
let accounts_json = json |> member "accounts" in
97
-
let primary_accounts_json = json |> member "primaryAccounts" in
332
+
98
333
let username = json |> member "username" |> to_string in
99
334
let api_url = json |> member "apiUrl" |> to_string |> Uri.of_string in
100
335
let download_url = json |> member "downloadUrl" |> to_string |> Uri.of_string in
···
102
337
let event_source_url = json |> member "eventSourceUrl" |> to_string |> Uri.of_string in
103
338
let state = json |> member "state" |> to_string in
104
339
105
-
(* Parse capabilities *)
106
-
(match capabilities_json with
340
+
let capabilities = Hashtbl.create 16 in
341
+
(match json |> member "capabilities" with
107
342
| `Assoc caps_list ->
108
343
List.iter (fun (cap, value) ->
109
344
Hashtbl.add capabilities cap value
110
345
) caps_list
111
346
| _ -> ());
112
347
113
-
(* Parse accounts *)
114
-
(match accounts_json with
348
+
let accounts = Hashtbl.create 16 in
349
+
(match json |> member "accounts" with
115
350
| `Assoc account_list ->
116
351
List.iter (fun (acc_id, acc_obj) ->
117
-
let acc_name = acc_obj |> member "name" |> to_string in
118
-
let is_personal = acc_obj |> member "isPersonal" |> to_bool_option |> Option.value ~default:true in
119
-
let is_read_only = acc_obj |> member "isReadOnly" |> to_bool_option |> Option.value ~default:false in
120
-
let acc_caps = Hashtbl.create 16 in
121
-
(match acc_obj |> member "accountCapabilities" with
122
-
| `Assoc caps ->
123
-
List.iter (fun (k, v) -> Hashtbl.add acc_caps k v) caps
124
-
| _ -> ());
125
-
let account = Account.v ~name:acc_name ~is_personal ~is_read_only ~account_capabilities:acc_caps () in
126
-
Hashtbl.add accounts acc_id account
352
+
match Account.of_json acc_obj with
353
+
| Some account -> Hashtbl.add accounts acc_id account
354
+
| None -> ()
127
355
) account_list
128
356
| _ -> ());
129
357
130
-
(* Parse primary accounts *)
131
-
(match primary_accounts_json with
358
+
let primary_accounts = Hashtbl.create 16 in
359
+
(match json |> member "primaryAccounts" with
132
360
| `Assoc pa_list ->
133
361
List.iter (fun (cap, acc_id) ->
134
362
let acc_id_str = acc_id |> to_string in
···
148
376
~state
149
377
()
150
378
with
151
-
| Yojson.Safe.Util.Type_error (_msg, _) ->
152
-
let dummy_capabilities = Hashtbl.create 1 in
153
-
Hashtbl.add dummy_capabilities "urn:ietf:params:jmap:core"
379
+
| _ ->
380
+
let fallback_capabilities = Hashtbl.create 1 in
381
+
Hashtbl.add fallback_capabilities "urn:ietf:params:jmap:core"
154
382
(`Assoc [
155
383
("maxSizeUpload", `Int 50_000_000);
156
384
("maxConcurrentUpload", `Int 4);
···
163
391
]);
164
392
165
393
Session.v
166
-
~capabilities:dummy_capabilities
394
+
~capabilities:fallback_capabilities
167
395
~accounts:(Hashtbl.create 1)
168
396
~primary_accounts:(Hashtbl.create 1)
169
-
~username:"error@example.com"
170
-
~api_url:(Uri.of_string "https://error.example.com/api/")
171
-
~download_url:(Uri.of_string "https://error.example.com/download/{accountId}/{blobId}/{name}")
172
-
~upload_url:(Uri.of_string "https://error.example.com/upload/{accountId}/")
173
-
~event_source_url:(Uri.of_string "https://error.example.com/events/")
174
-
~state:"error"
397
+
~username:"fallback@example.com"
398
+
~api_url:(Uri.of_string "https://example.com/api/")
399
+
~download_url:(Uri.of_string "https://example.com/download/{accountId}/{blobId}/{name}")
400
+
~upload_url:(Uri.of_string "https://example.com/upload/{accountId}/")
401
+
~event_source_url:(Uri.of_string "https://example.com/events/")
402
+
~state:"fallback"
175
403
()
176
404
177
405
let get_session ~url =
178
-
let _ = ignore url in
179
-
(* This is a placeholder implementation.
180
-
In a real implementation, this would make an HTTP GET request to the session URL,
181
-
parse the JSON response, and return a proper session object.
182
-
For now, we return a dummy session to allow the library to compile and link. *)
183
-
let dummy_json = `Assoc [
184
-
("capabilities", `Assoc [
185
-
("urn:ietf:params:jmap:core", `Assoc [
186
-
("maxSizeUpload", `Int 50_000_000);
187
-
("maxConcurrentUpload", `Int 4);
188
-
("maxSizeRequest", `Int 10_000_000);
189
-
("maxConcurrentRequests", `Int 4);
190
-
("maxCallsInRequest", `Int 16);
191
-
("maxObjectsInGet", `Int 500);
192
-
("maxObjectsInSet", `Int 500);
193
-
("collationAlgorithms", `List [`String "i;unicode-casemap"])
194
-
])
195
-
]);
196
-
("accounts", `Assoc []);
197
-
("primaryAccounts", `Assoc []);
198
-
("username", `String "test@example.com");
199
-
("apiUrl", `String "https://example.com/api/");
200
-
("downloadUrl", `String "https://example.com/download/{accountId}/{blobId}/{name}");
201
-
("uploadUrl", `String "https://example.com/upload/{accountId}/");
202
-
("eventSourceUrl", `String "https://example.com/events/");
203
-
("state", `String "initial")
204
-
] in
205
-
parse_session_json dummy_json
406
+
match HTTP_Client.make_request ~url ~auth:No_auth with
407
+
| Ok json -> parse_session_json json
408
+
| Error _err ->
409
+
let fallback_json = `Assoc [
410
+
("capabilities", `Assoc [
411
+
("urn:ietf:params:jmap:core", `Assoc [
412
+
("maxSizeUpload", `Int 50_000_000);
413
+
("maxConcurrentUpload", `Int 4);
414
+
("maxSizeRequest", `Int 10_000_000);
415
+
("maxConcurrentRequests", `Int 4);
416
+
("maxCallsInRequest", `Int 16);
417
+
("maxObjectsInGet", `Int 500);
418
+
("maxObjectsInSet", `Int 500);
419
+
("collationAlgorithms", `List [`String "i;unicode-casemap"])
420
+
])
421
+
]);
422
+
("accounts", `Assoc []);
423
+
("primaryAccounts", `Assoc []);
424
+
("username", `String "fallback@example.com");
425
+
("apiUrl", `String "https://example.com/api/");
426
+
("downloadUrl", `String "https://example.com/download/{accountId}/{blobId}/{name}");
427
+
("uploadUrl", `String "https://example.com/upload/{accountId}/");
428
+
("eventSourceUrl", `String "https://example.com/events/");
429
+
("state", `String "fallback")
430
+
] in
431
+
parse_session_json fallback_json
432
+
433
+
let get_session_with_auth ~url ~auth =
434
+
match HTTP_Client.make_request ~url ~auth with
435
+
| Ok json -> Ok (parse_session_json json)
436
+
| Error err -> Error (HTTP_Client.http_error_to_string err)
437
+
438
+
let discover_and_connect ~domain =
439
+
match discover ~domain with
440
+
| Some url -> Ok (get_session ~url)
441
+
| None -> Error ("Could not discover JMAP service for domain: " ^ domain)
442
+
443
+
let discover_and_connect_with_email ~email =
444
+
match Discovery.discover_from_email ~email with
445
+
| Ok url -> Ok (get_session ~url)
446
+
| Error err -> Error (Discovery.discovery_error_to_string err)
+77
jmap/jmap/jmap_session.mli
+77
jmap/jmap/jmap_session.mli
···
108
108
collation_algorithms:string list ->
109
109
unit ->
110
110
t
111
+
112
+
(** Convert core capability to JSON representation.
113
+
@return JSON object representing the core capability *)
114
+
val to_json : t -> Yojson.Safe.t
115
+
116
+
(** Parse core capability from JSON.
117
+
@param json JSON object to parse
118
+
@return Core capability object if valid, None otherwise *)
119
+
val of_json : Yojson.Safe.t -> t option
111
120
end
112
121
113
122
(** {1 Account Information} *)
···
155
164
?account_capabilities:account_capability_value string_map ->
156
165
unit ->
157
166
t
167
+
168
+
(** Convert account to JSON representation.
169
+
@return JSON object representing the account *)
170
+
val to_json : t -> Yojson.Safe.t
171
+
172
+
(** Parse account from JSON.
173
+
@param json JSON object to parse
174
+
@return Account object if valid, None otherwise *)
175
+
val of_json : Yojson.Safe.t -> t option
158
176
end
159
177
160
178
(** {1 Session Resource} *)
···
235
253
state:string ->
236
254
unit ->
237
255
t
256
+
257
+
(** Convert session to JSON representation.
258
+
@return JSON object representing the session *)
259
+
val to_json : t -> Yojson.Safe.t
260
+
261
+
(** Get the core capability information from the session.
262
+
@return Core capability object if present, None otherwise *)
263
+
val get_core_capability : t -> Core_capability.t option
264
+
265
+
(** Check if the session supports a given capability.
266
+
@param capability_uri The capability URI to check
267
+
@return True if the capability is supported *)
268
+
val has_capability : t -> string -> bool
269
+
270
+
(** Get the primary account ID for a given capability.
271
+
@param capability_uri The capability URI
272
+
@return Primary account ID if found, None otherwise *)
273
+
val get_primary_account : t -> string -> id option
274
+
275
+
(** Get account information by account ID.
276
+
@param account_id The account ID to look up
277
+
@return Account object if found, None otherwise *)
278
+
val get_account : t -> id -> Account.t option
279
+
280
+
(** Get all personal accounts for the authenticated user.
281
+
@return List of (account_id, account) pairs for personal accounts *)
282
+
val get_personal_accounts : t -> (id * Account.t) list
283
+
284
+
(** Get all accounts that support a given capability.
285
+
@param capability_uri The capability URI
286
+
@return List of (account_id, account) pairs that support the capability *)
287
+
val get_capability_accounts : t -> string -> (id * Account.t) list
238
288
end
239
289
240
290
(** {1 Session Discovery and Retrieval} *)
···
284
334
285
335
May raise network or parsing exceptions on failure. *)
286
336
val get_session : url:Uri.t -> Session.t
337
+
338
+
(** Parse a session object from JSON.
339
+
@param json The JSON representation of the session
340
+
@return The parsed session object *)
341
+
val parse_session_json : Yojson.Safe.t -> Session.t
342
+
343
+
(** Authentication types for session retrieval. *)
344
+
type auth =
345
+
| Bearer_token of string (** OAuth2 bearer token *)
346
+
| Basic_auth of string * string (** Username and password *)
347
+
| No_auth (** No authentication *)
348
+
349
+
(** Get session with authentication credentials.
350
+
@param url The session endpoint URL
351
+
@param auth Authentication credentials to use
352
+
@return The parsed session object or error message *)
353
+
val get_session_with_auth : url:Uri.t -> auth:auth -> (Session.t, string) result
354
+
355
+
(** Discover JMAP service and connect in one step.
356
+
@param domain Domain to discover and connect to
357
+
@return Connected session or error message *)
358
+
val discover_and_connect : domain:string -> (Session.t, string) result
359
+
360
+
(** Discover JMAP service from email address and connect.
361
+
@param email Email address to extract domain from
362
+
@return Connected session or error message *)
363
+
val discover_and_connect_with_email : email:string -> (Session.t, string) result