this repo has no description
more
+535
-714
+53
-3
jmap/jmap-unix/jmap_unix.ml
+53
-3
jmap/jmap-unix/jmap_unix.ml
···
68
68
| Session_cookie of (string * string)
69
69
| No_auth
70
70
71
+
(* Session discovery types *)
72
+
type session_auth =
73
+
| Bearer_token of string
74
+
| Basic_auth of string * string
75
+
| No_session_auth
76
+
71
77
type event_source_connection = unit
72
78
73
79
type connection_state =
···
263
269
("Failed to parse session: " ^ Printexc.to_string exn)))
264
270
| Error e -> Error e)
265
271
272
+
(* Session discovery functions using proper Eio and cohttp-eio *)
273
+
let auth_headers = function
274
+
| Bearer_token token -> [("Authorization", "Bearer " ^ token)]
275
+
| Basic_auth (user, pass) ->
276
+
let credentials = base64_encode_string (user ^ ":" ^ pass) in
277
+
[("Authorization", "Basic " ^ credentials)]
278
+
| No_session_auth -> []
279
+
280
+
let discover_session ~env ~domain =
281
+
let ctx = create_client () in
282
+
let well_known_uri = Uri.make ~scheme:"https" ~host:domain ~path:"/.well-known/jmap" () in
283
+
match http_request env ctx ~meth:`GET ~uri:well_known_uri ~headers:[] ~body:None with
284
+
| Ok response_body ->
285
+
(try
286
+
let json = Yojson.Safe.from_string response_body in
287
+
match Yojson.Safe.Util.member "sessionUrl" json with
288
+
| `String session_url -> Some (Uri.of_string session_url)
289
+
| _ -> None
290
+
with
291
+
| _ -> None)
292
+
| Error _ -> None
293
+
294
+
let get_session ~env ~url ~auth =
295
+
let ctx = create_client () in
296
+
let headers = auth_headers auth in
297
+
match http_request env ctx ~meth:`GET ~uri:url ~headers ~body:None with
298
+
| Ok response_body ->
299
+
(try
300
+
let json = Yojson.Safe.from_string response_body in
301
+
let session = Jmap.Session.parse_session_json json in
302
+
Ok session
303
+
with
304
+
| exn -> Error ("Failed to parse session: " ^ Printexc.to_string exn))
305
+
| Error _ -> Error ("Network error: failed to get session")
306
+
307
+
let extract_domain_from_email ~email =
308
+
try
309
+
let at_pos = String.rindex email '@' in
310
+
let domain = String.sub email (at_pos + 1) (String.length email - at_pos - 1) in
311
+
if String.length domain > 0 then Ok domain else Error "Empty domain"
312
+
with
313
+
| Not_found -> Error "No '@' found in email address"
314
+
| _ -> Error "Invalid email format"
315
+
266
316
let build ctx = {
267
317
ctx;
268
-
using = [Jmap.Protocol.Capability.to_string `Core];
318
+
using = [Jmap.Capability.to_string `Core];
269
319
method_calls = [];
270
320
}
271
321
272
322
let using builder capabilities =
273
-
builder.using <- Jmap.Protocol.Capability.to_strings capabilities;
323
+
builder.using <- Jmap.Capability.to_strings capabilities;
274
324
builder
275
325
276
326
let add_method_call builder method_name arguments method_call_id =
···
867
917
let open Jmap.Session.Session in
868
918
let primary_accs = primary_accounts session in
869
919
try
870
-
Hashtbl.find primary_accs (Jmap.Protocol.Capability.to_string `Mail)
920
+
Hashtbl.find primary_accs (Jmap.Capability.to_string `Mail)
871
921
with
872
922
| Not_found ->
873
923
let accounts = accounts session in
+44
jmap/jmap-unix/jmap_unix.mli
+44
jmap/jmap-unix/jmap_unix.mli
···
49
49
(** Create default configuration options *)
50
50
val default_config : unit -> client_config
51
51
52
+
(** {1 Session Discovery and Authentication} *)
53
+
54
+
(** Authentication types for session retrieval. *)
55
+
type session_auth =
56
+
| Bearer_token of string (** OAuth2 bearer token *)
57
+
| Basic_auth of string * string (** Username and password *)
58
+
| No_session_auth (** No authentication *)
59
+
60
+
(** Service discovery for JMAP.
61
+
62
+
Attempts to discover the JMAP session endpoint using well-known URIs.
63
+
Follows RFC 8620 service discovery process.
64
+
65
+
@param env Eio environment for network operations
66
+
@param domain The domain to discover JMAP service for
67
+
@return The session URL if discovery succeeds, None otherwise
68
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-2.2> RFC 8620, Section 2.2 *)
69
+
val discover_session :
70
+
env:< net : 'a Eio.Net.t ; clock : 'b Eio.Time.clock ; .. > ->
71
+
domain:string ->
72
+
Uri.t option
73
+
74
+
(** Fetch a session object from a given URL with authentication.
75
+
76
+
Retrieves and parses the session resource from the server using cohttp-eio.
77
+
78
+
@param env Eio environment for network operations
79
+
@param url The session endpoint URL
80
+
@param auth Authentication credentials to use
81
+
@return The parsed session object or error message *)
82
+
val get_session :
83
+
env:< net : 'a Eio.Net.t ; clock : 'b Eio.Time.clock ; .. > ->
84
+
url:Uri.t ->
85
+
auth:session_auth ->
86
+
(Jmap.Session.Session.t, string) result
87
+
88
+
(** Extract domain from email address for discovery.
89
+
90
+
Utility function to extract the domain part from an email address.
91
+
92
+
@param email Email address to extract domain from
93
+
@return Domain string or error message *)
94
+
val extract_domain_from_email : email:string -> (string, string) result
95
+
52
96
(** Create a client context with the specified configuration
53
97
@return The context object used for JMAP API calls
54
98
*)
+3
-1
jmap/jmap/dune
+3
-1
jmap/jmap/dune
+7
-9
jmap/jmap/jmap.ml
+7
-9
jmap/jmap/jmap.ml
···
24
24
25
25
module Error = Error
26
26
27
-
module Protocol = Jmap_protocol
27
+
module Protocol_utils = Jmap_protocol_utils
28
+
29
+
module Mime_type = Jmap_mime_type
30
+
31
+
module Error_type = Jmap_error_type
28
32
29
33
module Client = Jmap_client
30
34
31
-
let supports_capability = Protocol.supports_capability
35
+
let supports_capability = Protocol_utils.supports_capability
32
36
33
-
let get_primary_account session capability =
34
-
match Protocol.get_primary_account session capability with
35
-
| Ok id_str ->
36
-
(match Id.of_string id_str with
37
-
| Ok id -> Ok id
38
-
| Error msg -> Error (Error.method_error ~description:msg `InvalidArguments))
39
-
| Error e -> Error e
37
+
let get_primary_account = Protocol_utils.get_primary_account
40
38
41
39
let get_download_url session ~account_id ~blob_id ?name ?content_type () =
42
40
let download_url = Session.Session.download_url session in
+27
-5
jmap/jmap/jmap.mli
+27
-5
jmap/jmap/jmap.mli
···
97
97
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.6> RFC 8620, Section 3.6 *)
98
98
module Error = Error
99
99
100
-
(** Core protocol types and utilities (Request, Response, Session, Error)
101
-
This module consolidates the wire protocol, session management, and error handling. *)
102
-
module Protocol = Jmap_protocol
100
+
(** {1 Utility Modules} *)
101
+
102
+
(** JMAP protocol utilities for common operations.
103
+
104
+
Higher-level utilities for working with JMAP protocol structures including
105
+
session management, response processing, and request building.
106
+
107
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3> RFC 8620, Section 3 *)
108
+
module Protocol_utils = Jmap_protocol_utils
109
+
110
+
(** MIME type management with type-safe variants.
111
+
112
+
Provides commonly used MIME types as polymorphic variants for use in
113
+
email body parts and attachments.
114
+
115
+
@see <https://www.rfc-editor.org/rfc/rfc2046.html> RFC 2046: Media Types *)
116
+
module Mime_type = Jmap_mime_type
117
+
118
+
(** JMAP error type management with type-safe variants.
119
+
120
+
Type-safe error URIs for JMAP problem details, converting the standardized
121
+
error type URIs to polymorphic variants.
122
+
123
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.6> RFC 8620, Section 3.6 *)
124
+
module Error_type = Jmap_error_type
103
125
104
126
(** {1 Client Layer} *)
105
127
···
146
168
(* Process the response *)
147
169
match response with
148
170
| Ok resp -> (
149
-
match Jmap.Protocol.find_method_response resp "echo1" with
171
+
match Jmap.Protocol_utils.find_method_response resp "echo1" with
150
172
| Some (method_name, args, _) when method_name = "Core/echo" ->
151
173
(* Echo response should contain the same arguments we sent *)
152
174
let hello_value = match Yojson.Safe.Util.member "hello" args with
···
188
210
@param capability The capability.
189
211
@return The account ID or an error if not found.
190
212
*)
191
-
val get_primary_account : Session.Session.t -> Jmap_capability.t -> (Id.t, Error.error) result
213
+
val get_primary_account : Session.Session.t -> Jmap_capability.t -> (string, Error.error) result
192
214
193
215
(** Get the download URL for a blob.
194
216
@param session The session object.
+52
-9
jmap/jmap/jmap_client.ml
+52
-9
jmap/jmap/jmap_client.ml
···
1
-
open Jmap_protocol
2
1
open Jmap_method_names
3
2
4
3
type credentials =
···
15
14
}
16
15
17
16
type t = {
18
-
mutable session : session option;
17
+
mutable session : Session.Session.t option;
19
18
mutable base_url : Uri.t option;
20
19
mutable credentials : credentials option;
21
20
mutable stats : stats;
···
52
51
- RFC reference: RFC 8620 Section 2.1
53
52
- Priority: High
54
53
- Dependencies: HTTP client implementation *)
55
-
let session = Session.get_session ~url:session_url in
56
-
t.session <- Some session;
54
+
(* TODO: Replace with proper implementation using jmap-unix *)
55
+
let fallback_session = Session.parse_session_json (`Assoc [
56
+
("capabilities", `Assoc [
57
+
(Jmap_capability.to_string `Core, `Assoc [
58
+
("maxSizeUpload", `Int 50_000_000);
59
+
("maxConcurrentUpload", `Int 4);
60
+
("maxSizeRequest", `Int 10_000_000);
61
+
("maxConcurrentRequests", `Int 4);
62
+
("maxCallsInRequest", `Int 16);
63
+
("maxObjectsInGet", `Int 500);
64
+
("maxObjectsInSet", `Int 500);
65
+
("collationAlgorithms", `List [`String "i;unicode-casemap"])
66
+
])
67
+
]);
68
+
("accounts", `Assoc []);
69
+
("primaryAccounts", `Assoc []);
70
+
("username", `String "stub@example.com");
71
+
("apiUrl", `String (Uri.to_string session_url ^ "../api/"));
72
+
("downloadUrl", `String (Uri.to_string session_url ^ "../download/{accountId}/{blobId}/{name}"));
73
+
("uploadUrl", `String (Uri.to_string session_url ^ "../upload/{accountId}/"));
74
+
("eventSourceUrl", `String (Uri.to_string session_url ^ "../events/"));
75
+
("state", `String "stub")
76
+
]) in
77
+
t.session <- Some fallback_session;
57
78
t.stats <- { t.stats with connection_time = Some (Unix.time ()) };
58
79
59
-
Ok (t, session)
80
+
Ok (t, fallback_session)
60
81
61
82
let quick_connect ~host ~username ~password =
62
83
let t = create () in
···
148
169
match batch_request t ~using ~invocations:[invocation] with
149
170
| Error e -> Error e
150
171
| Ok response ->
151
-
match find_method_response response method_call_id with
172
+
match Jmap_protocol_utils.find_method_response response method_call_id with
152
173
| Some (_, args) -> Ok args
153
174
| None -> Error (Error.protocol_error "Method response not found")
154
175
···
159
180
| None -> Error (Error.protocol_error "Not connected")
160
181
| Some base_url ->
161
182
let session_url = Uri.with_path base_url "/.well-known/jmap" in
162
-
let session = Session.get_session ~url:session_url in
163
-
t.session <- Some session;
164
-
Ok session
183
+
(* TODO: Replace with proper implementation using jmap-unix *)
184
+
let fallback_session = Session.parse_session_json (`Assoc [
185
+
("capabilities", `Assoc [
186
+
(Jmap_capability.to_string `Core, `Assoc [
187
+
("maxSizeUpload", `Int 50_000_000);
188
+
("maxConcurrentUpload", `Int 4);
189
+
("maxSizeRequest", `Int 10_000_000);
190
+
("maxConcurrentRequests", `Int 4);
191
+
("maxCallsInRequest", `Int 16);
192
+
("maxObjectsInGet", `Int 500);
193
+
("maxObjectsInSet", `Int 500);
194
+
("collationAlgorithms", `List [`String "i;unicode-casemap"])
195
+
])
196
+
]);
197
+
("accounts", `Assoc []);
198
+
("primaryAccounts", `Assoc []);
199
+
("username", `String "stub@example.com");
200
+
("apiUrl", `String (Uri.to_string session_url ^ "../api/"));
201
+
("downloadUrl", `String (Uri.to_string session_url ^ "../download/{accountId}/{blobId}/{name}"));
202
+
("uploadUrl", `String (Uri.to_string session_url ^ "../upload/{accountId}/"));
203
+
("eventSourceUrl", `String (Uri.to_string session_url ^ "../events/"));
204
+
("state", `String "stub")
205
+
]) in
206
+
t.session <- Some fallback_session;
207
+
Ok fallback_session
165
208
166
209
let upload_blob t ~account_id ~data ?(content_type = "application/octet-stream") () =
167
210
(* TODO: Implement blob upload functionality
+11
-12
jmap/jmap/jmap_client.mli
+11
-12
jmap/jmap/jmap_client.mli
···
7
7
@see <https://www.rfc-editor.org/rfc/rfc8620.html> RFC 8620: Core JMAP *)
8
8
9
9
(* Use underlying types directly to avoid circular dependency with Jmap module *)
10
-
open Jmap_protocol
11
10
12
11
(** {1 Client Type} *)
13
12
···
44
43
?port:int ->
45
44
?use_tls:bool ->
46
45
unit ->
47
-
(t * session, error) result
46
+
(t * Session.Session.t, Error.error) result
48
47
49
48
(** Quick connect using username and password.
50
49
This is a convenience function that uses Basic authentication.
···
56
55
host:string ->
57
56
username:string ->
58
57
password:string ->
59
-
(t * session, error) result
58
+
(t * Session.Session.t, Error.error) result
60
59
61
60
(** Close the client connection and release resources. *)
62
61
val close : t -> unit
···
67
66
@param t The client instance.
68
67
@param request The JMAP request to send.
69
68
@return The response or an error. *)
70
-
val request : t -> request -> (response, error) result
69
+
val request : t -> Wire.Request.t -> (Wire.Response.t, Error.error) result
71
70
72
71
(** Send a batch of method calls.
73
72
@param t The client instance.
···
77
76
val batch_request :
78
77
t ->
79
78
using:string list ->
80
-
invocations:invocation list ->
81
-
(response, error) result
79
+
invocations:Wire.Invocation.t list ->
80
+
(Wire.Response.t, Error.error) result
82
81
83
82
(** Send a single method call.
84
83
@param t The client instance.
···
93
92
method_name:string ->
94
93
arguments:Yojson.Safe.t ->
95
94
method_call_id:string ->
96
-
(Yojson.Safe.t, error) result
95
+
(Yojson.Safe.t, Error.error) result
97
96
98
97
(** {1 Session Management} *)
99
98
100
99
(** Get the current session object.
101
100
@param t The client instance.
102
101
@return The session object or None if not connected. *)
103
-
val get_session : t -> session option
102
+
val get_session : t -> Session.Session.t option
104
103
105
104
(** Refresh the session object from the server.
106
105
@param t The client instance.
107
106
@return The updated session or an error. *)
108
-
val refresh_session : t -> (session, error) result
107
+
val refresh_session : t -> (Session.Session.t, Error.error) result
109
108
110
109
(** {1 Binary Data} *)
111
110
···
121
120
data:string ->
122
121
?content_type:string ->
123
122
unit ->
124
-
(string, error) result
123
+
(string, Error.error) result
125
124
126
125
(** Download binary data from the server.
127
126
@param t The client instance.
···
135
134
blob_id:string ->
136
135
?name:string ->
137
136
unit ->
138
-
(string, error) result
137
+
(string, Error.error) result
139
138
140
139
(** {1 URL Construction} *)
141
140
···
190
189
(** {1 Error Handling} *)
191
190
192
191
(** Convert a client error to a human-readable string. *)
193
-
val error_to_string : error -> string
192
+
val error_to_string : Error.error -> string
194
193
195
194
(** {1 Logging and Debugging} *)
196
195
+21
jmap/jmap/jmap_error_type.ml
+21
jmap/jmap/jmap_error_type.ml
···
1
+
type t = [
2
+
| `UnknownCapability
3
+
| `NotJSON
4
+
| `NotRequest
5
+
| `Limit
6
+
]
7
+
8
+
let to_string = function
9
+
| `UnknownCapability -> "urn:ietf:params:jmap:error:unknownCapability"
10
+
| `NotJSON -> "urn:ietf:params:jmap:error:notJSON"
11
+
| `NotRequest -> "urn:ietf:params:jmap:error:notRequest"
12
+
| `Limit -> "urn:ietf:params:jmap:error:limit"
13
+
14
+
let of_string = function
15
+
| "urn:ietf:params:jmap:error:unknownCapability" -> Some `UnknownCapability
16
+
| "urn:ietf:params:jmap:error:notJSON" -> Some `NotJSON
17
+
| "urn:ietf:params:jmap:error:notRequest" -> Some `NotRequest
18
+
| "urn:ietf:params:jmap:error:limit" -> Some `Limit
19
+
| _ -> None
20
+
21
+
let pp ppf error_type = Fmt.string ppf (to_string error_type)
+34
jmap/jmap/jmap_error_type.mli
+34
jmap/jmap/jmap_error_type.mli
···
1
+
(** JMAP error type management with type-safe variants.
2
+
3
+
This module provides type-safe error URIs for JMAP problem details,
4
+
converting the standardized error type URIs to polymorphic variants.
5
+
6
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.6> RFC 8620, Section 3.6 *)
7
+
8
+
(** JMAP standard error types as polymorphic variants.
9
+
10
+
These map to the standardized error type URIs defined in RFC 8620
11
+
for use in problem details objects.
12
+
13
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.6> RFC 8620, Section 3.6 *)
14
+
type t = [
15
+
| `UnknownCapability (** urn:ietf:params:jmap:error:unknownCapability *)
16
+
| `NotJSON (** urn:ietf:params:jmap:error:notJSON *)
17
+
| `NotRequest (** urn:ietf:params:jmap:error:notRequest *)
18
+
| `Limit (** urn:ietf:params:jmap:error:limit *)
19
+
]
20
+
21
+
(** Convert error type variant to URN string.
22
+
@param error_type The error type variant
23
+
@return The corresponding URN string *)
24
+
val to_string : t -> string
25
+
26
+
(** Parse URN string to error type variant.
27
+
@param urn The URN string to parse
28
+
@return Some error type if recognized, None otherwise *)
29
+
val of_string : string -> t option
30
+
31
+
(** Pretty-print an error type.
32
+
@param ppf The formatter.
33
+
@param error_type The error type to print. *)
34
+
val pp : Format.formatter -> t -> unit
+73
jmap/jmap/jmap_mime_type.ml
+73
jmap/jmap/jmap_mime_type.ml
···
1
+
type t = [
2
+
| `Text_plain
3
+
| `Text_html
4
+
| `Text_other of string
5
+
| `Multipart_mixed
6
+
| `Multipart_alternative
7
+
| `Multipart_digest
8
+
| `Multipart_other of string
9
+
| `Message_rfc822
10
+
| `Message_global
11
+
| `Message_other of string
12
+
| `Application_json
13
+
| `Application_octet_stream
14
+
| `Application_other of string
15
+
| `Image_other of string
16
+
| `Audio_other of string
17
+
| `Video_other of string
18
+
| `Other of string * string
19
+
]
20
+
21
+
let to_string = function
22
+
| `Text_plain -> "text/plain"
23
+
| `Text_html -> "text/html"
24
+
| `Text_other subtype -> "text/" ^ subtype
25
+
| `Multipart_mixed -> "multipart/mixed"
26
+
| `Multipart_alternative -> "multipart/alternative"
27
+
| `Multipart_digest -> "multipart/digest"
28
+
| `Multipart_other subtype -> "multipart/" ^ subtype
29
+
| `Message_rfc822 -> "message/rfc822"
30
+
| `Message_global -> "message/global"
31
+
| `Message_other subtype -> "message/" ^ subtype
32
+
| `Application_json -> "application/json"
33
+
| `Application_octet_stream -> "application/octet-stream"
34
+
| `Application_other subtype -> "application/" ^ subtype
35
+
| `Image_other subtype -> "image/" ^ subtype
36
+
| `Audio_other subtype -> "audio/" ^ subtype
37
+
| `Video_other subtype -> "video/" ^ subtype
38
+
| `Other (typ, subtype) -> typ ^ "/" ^ subtype
39
+
40
+
let of_string mime_string =
41
+
match String.split_on_char '/' mime_string with
42
+
| ["text"; "plain"] -> `Text_plain
43
+
| ["text"; "html"] -> `Text_html
44
+
| ["text"; subtype] -> `Text_other subtype
45
+
| ["multipart"; "mixed"] -> `Multipart_mixed
46
+
| ["multipart"; "alternative"] -> `Multipart_alternative
47
+
| ["multipart"; "digest"] -> `Multipart_digest
48
+
| ["multipart"; subtype] -> `Multipart_other subtype
49
+
| ["message"; "rfc822"] -> `Message_rfc822
50
+
| ["message"; "global"] -> `Message_global
51
+
| ["message"; subtype] -> `Message_other subtype
52
+
| ["application"; "json"] -> `Application_json
53
+
| ["application"; "octet-stream"] -> `Application_octet_stream
54
+
| ["application"; subtype] -> `Application_other subtype
55
+
| ["image"; subtype] -> `Image_other subtype
56
+
| ["audio"; subtype] -> `Audio_other subtype
57
+
| ["video"; subtype] -> `Video_other subtype
58
+
| [typ; subtype] -> `Other (typ, subtype)
59
+
| _ -> `Other ("application", "octet-stream") (* Fallback for malformed MIME types *)
60
+
61
+
let pp ppf mime_type = Fmt.string ppf (to_string mime_type)
62
+
63
+
let is_text = function
64
+
| `Text_plain | `Text_html | `Text_other _ -> true
65
+
| _ -> false
66
+
67
+
let is_multipart = function
68
+
| `Multipart_mixed | `Multipart_alternative | `Multipart_digest | `Multipart_other _ -> true
69
+
| _ -> false
70
+
71
+
let is_message = function
72
+
| `Message_rfc822 | `Message_global | `Message_other _ -> true
73
+
| _ -> false
+57
jmap/jmap/jmap_mime_type.mli
+57
jmap/jmap/jmap_mime_type.mli
···
1
+
(** MIME type management with type-safe variants.
2
+
3
+
This module provides commonly used MIME types as polymorphic variants
4
+
for use in email body parts and attachments.
5
+
6
+
@see <https://www.rfc-editor.org/rfc/rfc2046.html> RFC 2046: Media Types *)
7
+
8
+
(** Common MIME types as polymorphic variants. *)
9
+
type t = [
10
+
| `Text_plain (** text/plain *)
11
+
| `Text_html (** text/html *)
12
+
| `Text_other of string (** text/* with custom subtype *)
13
+
| `Multipart_mixed (** multipart/mixed *)
14
+
| `Multipart_alternative (** multipart/alternative *)
15
+
| `Multipart_digest (** multipart/digest *)
16
+
| `Multipart_other of string (** multipart/* with custom subtype *)
17
+
| `Message_rfc822 (** message/rfc822 *)
18
+
| `Message_global (** message/global *)
19
+
| `Message_other of string (** message/* with custom subtype *)
20
+
| `Application_json (** application/json *)
21
+
| `Application_octet_stream (** application/octet-stream *)
22
+
| `Application_other of string (** application/* with custom subtype *)
23
+
| `Image_other of string (** image/* *)
24
+
| `Audio_other of string (** audio/* *)
25
+
| `Video_other of string (** video/* *)
26
+
| `Other of string * string (** type/subtype for custom MIME types *)
27
+
]
28
+
29
+
(** Convert MIME type variant to string.
30
+
@param mime_type The MIME type variant
31
+
@return The corresponding MIME type string *)
32
+
val to_string : t -> string
33
+
34
+
(** Parse MIME type string to variant.
35
+
@param mime_string The MIME type string to parse
36
+
@return MIME type variant (uses Other for unrecognized types) *)
37
+
val of_string : string -> t
38
+
39
+
(** Pretty-print a MIME type.
40
+
@param ppf The formatter.
41
+
@param mime_type The MIME type to print. *)
42
+
val pp : Format.formatter -> t -> unit
43
+
44
+
(** Check if a MIME type is text-based.
45
+
@param mime_type The MIME type to check
46
+
@return true if it's a text/* type *)
47
+
val is_text : t -> bool
48
+
49
+
(** Check if a MIME type is multipart.
50
+
@param mime_type The MIME type to check
51
+
@return true if it's a multipart/* type *)
52
+
val is_multipart : t -> bool
53
+
54
+
(** Check if a MIME type is a message.
55
+
@param mime_type The MIME type to check
56
+
@return true if it's a message/* type *)
57
+
val is_message : t -> bool
-189
jmap/jmap/jmap_protocol.ml
-189
jmap/jmap/jmap_protocol.ml
···
1
-
type request = Wire.Request.t
2
-
3
-
type response = Wire.Response.t
4
-
5
-
type session = Session.Session.t
6
-
7
-
type invocation = Wire.Invocation.t
8
-
9
-
type error = Error.error
10
-
11
-
type problem_details = Error.Problem_details.t
12
-
13
-
module Capability = Jmap_capability
14
-
15
-
module Error_type = struct
16
-
type t = [
17
-
| `UnknownCapability
18
-
| `NotJSON
19
-
| `NotRequest
20
-
| `Limit
21
-
]
22
-
23
-
let to_string = function
24
-
| `UnknownCapability -> "urn:ietf:params:jmap:error:unknownCapability"
25
-
| `NotJSON -> "urn:ietf:params:jmap:error:notJSON"
26
-
| `NotRequest -> "urn:ietf:params:jmap:error:notRequest"
27
-
| `Limit -> "urn:ietf:params:jmap:error:limit"
28
-
29
-
let of_string = function
30
-
| "urn:ietf:params:jmap:error:unknownCapability" -> Some `UnknownCapability
31
-
| "urn:ietf:params:jmap:error:notJSON" -> Some `NotJSON
32
-
| "urn:ietf:params:jmap:error:notRequest" -> Some `NotRequest
33
-
| "urn:ietf:params:jmap:error:limit" -> Some `Limit
34
-
| _ -> None
35
-
36
-
let pp ppf error_type = Fmt.string ppf (to_string error_type)
37
-
end
38
-
39
-
module Mime_type = struct
40
-
type t = [
41
-
| `Text_plain
42
-
| `Text_html
43
-
| `Text_other of string
44
-
| `Multipart_mixed
45
-
| `Multipart_alternative
46
-
| `Multipart_digest
47
-
| `Multipart_other of string
48
-
| `Message_rfc822
49
-
| `Message_global
50
-
| `Message_other of string
51
-
| `Application_json
52
-
| `Application_octet_stream
53
-
| `Application_other of string
54
-
| `Image_other of string
55
-
| `Audio_other of string
56
-
| `Video_other of string
57
-
| `Other of string * string
58
-
]
59
-
60
-
let to_string = function
61
-
| `Text_plain -> "text/plain"
62
-
| `Text_html -> "text/html"
63
-
| `Text_other subtype -> "text/" ^ subtype
64
-
| `Multipart_mixed -> "multipart/mixed"
65
-
| `Multipart_alternative -> "multipart/alternative"
66
-
| `Multipart_digest -> "multipart/digest"
67
-
| `Multipart_other subtype -> "multipart/" ^ subtype
68
-
| `Message_rfc822 -> "message/rfc822"
69
-
| `Message_global -> "message/global"
70
-
| `Message_other subtype -> "message/" ^ subtype
71
-
| `Application_json -> "application/json"
72
-
| `Application_octet_stream -> "application/octet-stream"
73
-
| `Application_other subtype -> "application/" ^ subtype
74
-
| `Image_other subtype -> "image/" ^ subtype
75
-
| `Audio_other subtype -> "audio/" ^ subtype
76
-
| `Video_other subtype -> "video/" ^ subtype
77
-
| `Other (typ, subtype) -> typ ^ "/" ^ subtype
78
-
79
-
let of_string mime_string =
80
-
match String.split_on_char '/' mime_string with
81
-
| ["text"; "plain"] -> `Text_plain
82
-
| ["text"; "html"] -> `Text_html
83
-
| ["text"; subtype] -> `Text_other subtype
84
-
| ["multipart"; "mixed"] -> `Multipart_mixed
85
-
| ["multipart"; "alternative"] -> `Multipart_alternative
86
-
| ["multipart"; "digest"] -> `Multipart_digest
87
-
| ["multipart"; subtype] -> `Multipart_other subtype
88
-
| ["message"; "rfc822"] -> `Message_rfc822
89
-
| ["message"; "global"] -> `Message_global
90
-
| ["message"; subtype] -> `Message_other subtype
91
-
| ["application"; "json"] -> `Application_json
92
-
| ["application"; "octet-stream"] -> `Application_octet_stream
93
-
| ["application"; subtype] -> `Application_other subtype
94
-
| ["image"; subtype] -> `Image_other subtype
95
-
| ["audio"; subtype] -> `Audio_other subtype
96
-
| ["video"; subtype] -> `Video_other subtype
97
-
| [typ; subtype] -> `Other (typ, subtype)
98
-
| _ -> `Other ("application", "octet-stream") (* Fallback for malformed MIME types *)
99
-
100
-
let pp ppf mime_type = Fmt.string ppf (to_string mime_type)
101
-
102
-
let is_text = function
103
-
| `Text_plain | `Text_html | `Text_other _ -> true
104
-
| _ -> false
105
-
106
-
let is_multipart = function
107
-
| `Multipart_mixed | `Multipart_alternative | `Multipart_digest | `Multipart_other _ -> true
108
-
| _ -> false
109
-
110
-
let is_message = function
111
-
| `Message_rfc822 | `Message_global | `Message_other _ -> true
112
-
| _ -> false
113
-
end
114
-
115
-
116
-
let supports_capability session capability =
117
-
Hashtbl.mem (Session.Session.capabilities session) (Jmap_capability.to_string capability)
118
-
119
-
let get_primary_account session capability =
120
-
let capability_uri = Jmap_capability.to_string capability in
121
-
let primary_accounts = Session.Session.primary_accounts session in
122
-
match Hashtbl.find_opt primary_accounts capability_uri with
123
-
| Some id -> Ok id
124
-
| None ->
125
-
Error (Error.protocol_error
126
-
(Printf.sprintf "No primary account found for capability: %s" capability_uri))
127
-
128
-
let find_method_response response method_call_id =
129
-
let responses = Wire.Response.method_responses response in
130
-
List.find_map (function
131
-
| Ok invocation when Wire.Invocation.method_call_id invocation = method_call_id ->
132
-
Some (Wire.Invocation.method_name invocation,
133
-
Wire.Invocation.arguments invocation)
134
-
| _ -> None
135
-
) responses
136
-
137
-
let simple_request ~using ~method_name ~arguments ~method_call_id =
138
-
let invocation = Wire.Invocation.v ~method_name ~arguments ~method_call_id () in
139
-
Wire.Request.v ~using ~method_calls:[invocation] ()
140
-
141
-
let successful_responses response =
142
-
let responses = Wire.Response.method_responses response in
143
-
List.filter_map (function
144
-
| Ok invocation ->
145
-
Some (Wire.Invocation.method_name invocation,
146
-
Wire.Invocation.arguments invocation,
147
-
Wire.Invocation.method_call_id invocation)
148
-
| Error _ -> None
149
-
) responses
150
-
151
-
let error_responses response =
152
-
let responses = Wire.Response.method_responses response in
153
-
List.filter_map (function
154
-
| Error (method_error, method_call_id) ->
155
-
Some (method_call_id, method_error, method_call_id)
156
-
| Ok _ -> None
157
-
) responses
158
-
159
-
(** Response processing utilities *)
160
-
module Response = struct
161
-
(** Extract and parse a specific method response from a JMAP Response object *)
162
-
let extract_method_response response ~method_call_id ~parser =
163
-
let responses = Wire.Response.method_responses response in
164
-
(* Find the specific method response *)
165
-
let found_response = List.find_map (function
166
-
| Ok invocation when Wire.Invocation.method_call_id invocation = method_call_id ->
167
-
Some (Ok (Wire.Invocation.arguments invocation))
168
-
| Error (method_err, call_id) when call_id = method_call_id ->
169
-
Some (Error (Error.of_method_error method_err))
170
-
| _ -> None
171
-
) responses in
172
-
173
-
match found_response with
174
-
| Some (Ok json) -> parser json
175
-
| Some (Error err) -> Error err
176
-
| None ->
177
-
Error (Error.protocol_error
178
-
(Printf.sprintf "Method response not found for call ID: %s" method_call_id))
179
-
180
-
(** Extract all method responses from a JMAP Response object as (method_call_id, response_json) pairs *)
181
-
let extract_all_responses response =
182
-
let responses = Wire.Response.method_responses response in
183
-
List.filter_map (function
184
-
| Ok invocation ->
185
-
Some (Wire.Invocation.method_call_id invocation,
186
-
Wire.Invocation.arguments invocation)
187
-
| Error _ -> None (* Only include successful responses *)
188
-
) responses
189
-
end
-230
jmap/jmap/jmap_protocol.mli
-230
jmap/jmap/jmap_protocol.mli
···
1
-
(** Core JMAP Protocol types (Request, Response, Session).
2
-
3
-
This module provides a unified interface to the fundamental protocol types
4
-
used for JMAP communication as defined in RFC 8620. It consolidates wire
5
-
protocol structures, session management, and error handling into a coherent
6
-
API for JMAP implementations.
7
-
8
-
The module provides type aliases and convenience functions that reference
9
-
the individual Wire, Session, and Error modules for backwards compatibility.
10
-
11
-
@see <https://www.rfc-editor.org/rfc/rfc8620.html> RFC 8620: Core JMAP *)
12
-
13
-
(** {1 Type Aliases for Convenience} *)
14
-
15
-
(** A JMAP request *)
16
-
type request = Wire.Request.t
17
-
18
-
(** A JMAP response *)
19
-
type response = Wire.Response.t
20
-
21
-
(** A JMAP session *)
22
-
type session = Session.Session.t
23
-
24
-
(** A JMAP method invocation *)
25
-
type invocation = Wire.Invocation.t
26
-
27
-
(** A JMAP error *)
28
-
type error = Error.error
29
-
30
-
(** A JMAP problem details error *)
31
-
type problem_details = Error.Problem_details.t
32
-
33
-
(** {1 Protocol Constants} *)
34
-
35
-
(** JMAP capability management with type-safe variants.
36
-
37
-
This module provides a type-safe way to work with JMAP capabilities
38
-
using polymorphic variants instead of raw strings.
39
-
40
-
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-2> RFC 8620, Section 2 *)
41
-
module Capability : sig
42
-
(** JMAP capability types as polymorphic variants.
43
-
44
-
This provides compile-time safety for capability handling and makes
45
-
the available capabilities discoverable through IDE completion.
46
-
47
-
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-2> RFC 8620, Section 2
48
-
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-1.1> RFC 8621, Section 1.1 *)
49
-
type t = [
50
-
| `Core (** JMAP Core capability *)
51
-
| `Mail (** JMAP Mail capability *)
52
-
| `Submission (** JMAP Email Submission capability *)
53
-
| `VacationResponse (** JMAP Vacation Response capability *)
54
-
| `Apple_mail_flags (** Apple Mail color flags extension *)
55
-
]
56
-
57
-
(** Convert capability variant to URN string.
58
-
@param capability The capability variant
59
-
@return The corresponding URN string *)
60
-
val to_string : t -> string
61
-
62
-
(** Pretty-print a capability.
63
-
@param ppf The formatter.
64
-
@param capability The capability to print. *)
65
-
val pp : Format.formatter -> t -> unit
66
-
67
-
(** Parse URN string to capability variant.
68
-
@param urn The URN string to parse
69
-
@return Some capability if recognized, None otherwise *)
70
-
val of_string : string -> t option
71
-
72
-
(** Convert list of capabilities to list of URN strings.
73
-
@param capabilities List of capability variants
74
-
@return List of corresponding URN strings *)
75
-
val to_strings : t list -> string list
76
-
end
77
-
78
-
(** JMAP error type management with type-safe variants.
79
-
80
-
This module provides type-safe error URIs for JMAP problem details,
81
-
converting the standardized error type URIs to polymorphic variants.
82
-
83
-
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.6> RFC 8620, Section 3.6 *)
84
-
module Error_type : sig
85
-
(** JMAP standard error types as polymorphic variants.
86
-
87
-
These map to the standardized error type URIs defined in RFC 8620
88
-
for use in problem details objects.
89
-
90
-
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.6> RFC 8620, Section 3.6 *)
91
-
type t = [
92
-
| `UnknownCapability (** urn:ietf:params:jmap:error:unknownCapability *)
93
-
| `NotJSON (** urn:ietf:params:jmap:error:notJSON *)
94
-
| `NotRequest (** urn:ietf:params:jmap:error:notRequest *)
95
-
| `Limit (** urn:ietf:params:jmap:error:limit *)
96
-
]
97
-
98
-
(** Convert error type variant to URN string.
99
-
@param error_type The error type variant
100
-
@return The corresponding URN string *)
101
-
val to_string : t -> string
102
-
103
-
(** Parse URN string to error type variant.
104
-
@param urn The URN string to parse
105
-
@return Some error type if recognized, None otherwise *)
106
-
val of_string : string -> t option
107
-
108
-
(** Pretty-print an error type.
109
-
@param ppf The formatter.
110
-
@param error_type The error type to print. *)
111
-
val pp : Format.formatter -> t -> unit
112
-
end
113
-
114
-
(** MIME type management with type-safe variants.
115
-
116
-
This module provides commonly used MIME types as polymorphic variants
117
-
for use in email body parts and attachments.
118
-
119
-
@see <https://www.rfc-editor.org/rfc/rfc2046.html> RFC 2046: Media Types *)
120
-
module Mime_type : sig
121
-
(** Common MIME types as polymorphic variants. *)
122
-
type t = [
123
-
| `Text_plain (** text/plain *)
124
-
| `Text_html (** text/html *)
125
-
| `Text_other of string (** text/* with custom subtype *)
126
-
| `Multipart_mixed (** multipart/mixed *)
127
-
| `Multipart_alternative (** multipart/alternative *)
128
-
| `Multipart_digest (** multipart/digest *)
129
-
| `Multipart_other of string (** multipart/* with custom subtype *)
130
-
| `Message_rfc822 (** message/rfc822 *)
131
-
| `Message_global (** message/global *)
132
-
| `Message_other of string (** message/* with custom subtype *)
133
-
| `Application_json (** application/json *)
134
-
| `Application_octet_stream (** application/octet-stream *)
135
-
| `Application_other of string (** application/* with custom subtype *)
136
-
| `Image_other of string (** image/* *)
137
-
| `Audio_other of string (** audio/* *)
138
-
| `Video_other of string (** video/* *)
139
-
| `Other of string * string (** type/subtype for custom MIME types *)
140
-
]
141
-
142
-
(** Convert MIME type variant to string.
143
-
@param mime_type The MIME type variant
144
-
@return The corresponding MIME type string *)
145
-
val to_string : t -> string
146
-
147
-
(** Parse MIME type string to variant.
148
-
@param mime_string The MIME type string to parse
149
-
@return MIME type variant (uses Other for unrecognized types) *)
150
-
val of_string : string -> t
151
-
152
-
(** Pretty-print a MIME type.
153
-
@param ppf The formatter.
154
-
@param mime_type The MIME type to print. *)
155
-
val pp : Format.formatter -> t -> unit
156
-
157
-
(** Check if a MIME type is text-based.
158
-
@param mime_type The MIME type to check
159
-
@return true if it's a text/* type *)
160
-
val is_text : t -> bool
161
-
162
-
(** Check if a MIME type is multipart.
163
-
@param mime_type The MIME type to check
164
-
@return true if it's a multipart/* type *)
165
-
val is_multipart : t -> bool
166
-
167
-
(** Check if a MIME type is a message.
168
-
@param mime_type The MIME type to check
169
-
@return true if it's a message/* type *)
170
-
val is_message : t -> bool
171
-
end
172
-
173
-
(** {1 Protocol Helpers} *)
174
-
175
-
(** Check if a session supports a given capability.
176
-
@param session The session object.
177
-
@param capability The capability to check.
178
-
@return True if supported, false otherwise. *)
179
-
val supports_capability : session -> Jmap_capability.t -> bool
180
-
181
-
(** Get the primary account ID for a given capability.
182
-
@param session The session object.
183
-
@param capability The capability.
184
-
@return The account ID or an error if not found. *)
185
-
val get_primary_account : session -> Jmap_capability.t -> (string, error) result
186
-
187
-
(** Find a method response by its call ID.
188
-
@param response The response object.
189
-
@param method_call_id The method call ID to search for.
190
-
@return The method name and arguments if found. *)
191
-
val find_method_response : response -> string -> (string * Yojson.Safe.t) option
192
-
193
-
(** {1 Protocol Utilities} *)
194
-
195
-
(** Create a simple request with a single method call. *)
196
-
val simple_request :
197
-
using:string list ->
198
-
method_name:string ->
199
-
arguments:Yojson.Safe.t ->
200
-
method_call_id:string ->
201
-
request
202
-
203
-
(** Extract successful responses from a response object. *)
204
-
val successful_responses : response -> (string * Yojson.Safe.t * string) list
205
-
206
-
(** Extract error responses from a response object. *)
207
-
val error_responses : response -> (string * Error.Method_error.t * string) list
208
-
209
-
(** {1 Response Processing Utilities} *)
210
-
211
-
(** High-level response processing utilities that simplify extracting and parsing method responses. *)
212
-
module Response : sig
213
-
(** Extract and parse a specific method response from a JMAP Response object.
214
-
@param response The JMAP response to search
215
-
@param method_call_id The method call ID to extract
216
-
@param parser Function to parse the response JSON into the desired type
217
-
@return Parsed response or error if not found/parsing failed *)
218
-
val extract_method_response :
219
-
response ->
220
-
method_call_id:string ->
221
-
parser:(Yojson.Safe.t -> ('a, Error.error) result) ->
222
-
('a, Error.error) result
223
-
224
-
(** Extract all method responses from a JMAP Response object as (method_call_id, response_json) pairs.
225
-
@param response The JMAP response to extract from
226
-
@return List of all method responses with their IDs and JSON data *)
227
-
val extract_all_responses :
228
-
response ->
229
-
(string * Yojson.Safe.t) list
230
-
end
+74
jmap/jmap/jmap_protocol_utils.ml
+74
jmap/jmap/jmap_protocol_utils.ml
···
1
+
let supports_capability session capability =
2
+
Hashtbl.mem (Session.Session.capabilities session) (Jmap_capability.to_string capability)
3
+
4
+
let get_primary_account session capability =
5
+
let capability_uri = Jmap_capability.to_string capability in
6
+
let primary_accounts = Session.Session.primary_accounts session in
7
+
match Hashtbl.find_opt primary_accounts capability_uri with
8
+
| Some id -> Ok id
9
+
| None ->
10
+
Error (Error.protocol_error
11
+
(Printf.sprintf "No primary account found for capability: %s" capability_uri))
12
+
13
+
let find_method_response response method_call_id =
14
+
let responses = Wire.Response.method_responses response in
15
+
List.find_map (function
16
+
| Ok invocation when Wire.Invocation.method_call_id invocation = method_call_id ->
17
+
Some (Wire.Invocation.method_name invocation,
18
+
Wire.Invocation.arguments invocation)
19
+
| _ -> None
20
+
) responses
21
+
22
+
let simple_request ~using ~method_name ~arguments ~method_call_id =
23
+
let invocation = Wire.Invocation.v ~method_name ~arguments ~method_call_id () in
24
+
Wire.Request.v ~using ~method_calls:[invocation] ()
25
+
26
+
let successful_responses response =
27
+
let responses = Wire.Response.method_responses response in
28
+
List.filter_map (function
29
+
| Ok invocation ->
30
+
Some (Wire.Invocation.method_name invocation,
31
+
Wire.Invocation.arguments invocation,
32
+
Wire.Invocation.method_call_id invocation)
33
+
| Error _ -> None
34
+
) responses
35
+
36
+
let error_responses response =
37
+
let responses = Wire.Response.method_responses response in
38
+
List.filter_map (function
39
+
| Error (method_error, method_call_id) ->
40
+
Some (method_call_id, method_error, method_call_id)
41
+
| Ok _ -> None
42
+
) responses
43
+
44
+
(** Response processing utilities *)
45
+
module Response = struct
46
+
(** Extract and parse a specific method response from a JMAP Response object *)
47
+
let extract_method_response response ~method_call_id ~parser =
48
+
let responses = Wire.Response.method_responses response in
49
+
(* Find the specific method response *)
50
+
let found_response = List.find_map (function
51
+
| Ok invocation when Wire.Invocation.method_call_id invocation = method_call_id ->
52
+
Some (Ok (Wire.Invocation.arguments invocation))
53
+
| Error (method_err, call_id) when call_id = method_call_id ->
54
+
Some (Error (Error.of_method_error method_err))
55
+
| _ -> None
56
+
) responses in
57
+
58
+
match found_response with
59
+
| Some (Ok json) -> parser json
60
+
| Some (Error err) -> Error err
61
+
| None ->
62
+
Error (Error.protocol_error
63
+
(Printf.sprintf "Method response not found for call ID: %s" method_call_id))
64
+
65
+
(** Extract all method responses from a JMAP Response object as (method_call_id, response_json) pairs *)
66
+
let extract_all_responses response =
67
+
let responses = Wire.Response.method_responses response in
68
+
List.filter_map (function
69
+
| Ok invocation ->
70
+
Some (Wire.Invocation.method_call_id invocation,
71
+
Wire.Invocation.arguments invocation)
72
+
| Error _ -> None (* Only include successful responses *)
73
+
) responses
74
+
end
+76
jmap/jmap/jmap_protocol_utils.mli
+76
jmap/jmap/jmap_protocol_utils.mli
···
1
+
(** JMAP protocol utilities for common operations.
2
+
3
+
This module provides higher-level utilities for working with JMAP protocol
4
+
structures including session management, response processing, and request building.
5
+
6
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3> RFC 8620, Section 3 *)
7
+
8
+
(** {1 Session Utilities} *)
9
+
10
+
(** Check if a session supports a given capability.
11
+
@param session The session object.
12
+
@param capability The capability to check.
13
+
@return True if supported, false otherwise. *)
14
+
val supports_capability : Session.Session.t -> Jmap_capability.t -> bool
15
+
16
+
(** Get the primary account ID for a given capability.
17
+
@param session The session object.
18
+
@param capability The capability.
19
+
@return The account ID or an error if not found. *)
20
+
val get_primary_account : Session.Session.t -> Jmap_capability.t -> (string, Error.error) result
21
+
22
+
(** {1 Response Processing Utilities} *)
23
+
24
+
(** Find a method response by its call ID.
25
+
@param response The response object.
26
+
@param method_call_id The method call ID to search for.
27
+
@return The method name and arguments if found. *)
28
+
val find_method_response : Wire.Response.t -> string -> (string * Yojson.Safe.t) option
29
+
30
+
(** Extract successful responses from a response object.
31
+
@param response The response object to process.
32
+
@return List of (method_name, arguments, method_call_id) tuples. *)
33
+
val successful_responses : Wire.Response.t -> (string * Yojson.Safe.t * string) list
34
+
35
+
(** Extract error responses from a response object.
36
+
@param response The response object to process.
37
+
@return List of (method_call_id, method_error, method_call_id) tuples. *)
38
+
val error_responses : Wire.Response.t -> (string * Error.Method_error.t * string) list
39
+
40
+
(** {1 Request Building Utilities} *)
41
+
42
+
(** Create a simple request with a single method call.
43
+
@param using List of capabilities to declare.
44
+
@param method_name The method name to invoke.
45
+
@param arguments The method arguments as JSON.
46
+
@param method_call_id The call ID for this method.
47
+
@return A complete JMAP request. *)
48
+
val simple_request :
49
+
using:string list ->
50
+
method_name:string ->
51
+
arguments:Yojson.Safe.t ->
52
+
method_call_id:string ->
53
+
Wire.Request.t
54
+
55
+
(** {1 Advanced Response Processing} *)
56
+
57
+
(** High-level response processing utilities that simplify extracting and parsing method responses. *)
58
+
module Response : sig
59
+
(** Extract and parse a specific method response from a JMAP Response object.
60
+
@param response The JMAP response to search
61
+
@param method_call_id The method call ID to extract
62
+
@param parser Function to parse the response JSON into the desired type
63
+
@return Parsed response or error if not found/parsing failed *)
64
+
val extract_method_response :
65
+
Wire.Response.t ->
66
+
method_call_id:string ->
67
+
parser:(Yojson.Safe.t -> ('a, Error.error) result) ->
68
+
('a, Error.error) result
69
+
70
+
(** Extract all method responses from a JMAP Response object as (method_call_id, response_json) pairs.
71
+
@param response The JMAP response to extract from
72
+
@return List of all method responses with their IDs and JSON data *)
73
+
val extract_all_responses :
74
+
Wire.Response.t ->
75
+
(string * Yojson.Safe.t) list
76
+
end
+1
-186
jmap/jmap/session.ml
+1
-186
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
-
12
7
module Core_capability = struct
13
8
type t = {
14
9
max_size_upload : int;
···
347
342
) t.primary_accounts
348
343
end
349
344
350
-
module Discovery = struct
351
-
type discovery_error =
352
-
| Network_error of string
353
-
| Invalid_domain of string
354
-
| Dns_lookup_failed of string
355
-
| No_service_found
356
-
357
-
let discovery_error_to_string = function
358
-
| Network_error msg -> "Network error: " ^ msg
359
-
| Invalid_domain domain -> "Invalid domain: " ^ domain
360
-
| Dns_lookup_failed domain -> "DNS lookup failed for: " ^ domain
361
-
| No_service_found -> "No JMAP service found"
362
-
363
-
let validate_domain domain =
364
-
if String.length domain = 0 then false
365
-
else if String.contains domain ' ' then false
366
-
else if String.contains domain '\t' then false
367
-
else if String.contains domain '\n' then false
368
-
else true
369
-
370
-
let discover_well_known ~domain =
371
-
if not (validate_domain domain) then
372
-
Error (Invalid_domain domain)
373
-
else
374
-
try
375
-
let well_known_url = Uri.make ~scheme:"https" ~host:domain
376
-
~path:"/.well-known/jmap" () in
377
-
Ok well_known_url
378
-
with
379
-
| _ -> Error (Network_error ("Failed to construct well-known URL for " ^ domain))
380
-
381
-
let discover_srv ~domain =
382
-
if not (validate_domain domain) then
383
-
Error (Invalid_domain domain)
384
-
else
385
-
try
386
-
let hostname = "jmap." ^ domain in
387
-
let port = 443 in
388
-
let session_url = Uri.make ~scheme:"https" ~host:hostname ~port
389
-
~path:"/.well-known/jmap" () in
390
-
Ok session_url
391
-
with
392
-
| _ -> Error (Dns_lookup_failed domain)
393
-
394
-
let discover_any ~domain =
395
-
match discover_well_known ~domain with
396
-
| Ok url -> Ok url
397
-
| Error _ ->
398
-
match discover_srv ~domain with
399
-
| Ok url -> Ok url
400
-
| Error _ -> Error No_service_found
401
-
402
-
let discover_from_email ~email =
403
-
try
404
-
let at_pos = String.rindex email '@' in
405
-
let domain = String.sub email (at_pos + 1) (String.length email - at_pos - 1) in
406
-
discover_any ~domain
407
-
with
408
-
| Not_found -> Error (Invalid_domain email)
409
-
| _ -> Error (Invalid_domain email)
410
-
end
411
-
412
-
let discover ~domain =
413
-
match Discovery.discover_any ~domain with
414
-
| Ok url -> Some url
415
-
| Error _ -> None
416
-
417
-
module HTTP_Client = struct
418
-
type http_error =
419
-
| Connection_failed of string
420
-
421
-
let http_error_to_string = function
422
-
| Connection_failed msg -> "Connection failed: " ^ msg
423
-
424
-
let auth_headers = function
425
-
| Bearer_token token -> [("Authorization", "Bearer " ^ token)]
426
-
| Basic_auth (user, pass) ->
427
-
let credentials = Base64.encode_string (user ^ ":" ^ pass) in
428
-
[("Authorization", "Basic " ^ credentials)]
429
-
| No_auth -> []
430
-
431
-
let make_request ~url ~auth =
432
-
let headers = ("Accept", "application/json") :: ("User-Agent", "ocaml-jmap/1.0") :: (auth_headers auth) in
433
-
try
434
-
let response_json = `Assoc [
435
-
("capabilities", `Assoc [
436
-
(Jmap_capability.to_string `Core, `Assoc [
437
-
("maxSizeUpload", `Int 50_000_000);
438
-
("maxConcurrentUpload", `Int 8);
439
-
("maxSizeRequest", `Int 10_000_000);
440
-
("maxConcurrentRequests", `Int 8);
441
-
("maxCallsInRequest", `Int 32);
442
-
("maxObjectsInGet", `Int 500);
443
-
("maxObjectsInSet", `Int 500);
444
-
("collationAlgorithms", `List [
445
-
`String "i;ascii-numeric";
446
-
`String "i;ascii-casemap";
447
-
`String "i;unicode-casemap"
448
-
])
449
-
]);
450
-
(Jmap_capability.to_string `Mail, `Assoc []);
451
-
("urn:ietf:params:jmap:contacts", `Assoc [])
452
-
]);
453
-
("accounts", `Assoc [
454
-
("A13824", `Assoc [
455
-
("name", `String "john@example.com");
456
-
("isPersonal", `Bool true);
457
-
("isReadOnly", `Bool false);
458
-
("accountCapabilities", `Assoc [
459
-
(Jmap_capability.to_string `Mail, `Assoc [
460
-
("maxMailboxesPerEmail", `Null);
461
-
("maxMailboxDepth", `Int 10)
462
-
]);
463
-
("urn:ietf:params:jmap:contacts", `Assoc [])
464
-
])
465
-
])
466
-
]);
467
-
("primaryAccounts", `Assoc [
468
-
(Jmap_capability.to_string `Mail, `String "A13824");
469
-
("urn:ietf:params:jmap:contacts", `String "A13824")
470
-
]);
471
-
("username", `String (match auth with
472
-
| Basic_auth (user, _) -> user
473
-
| Bearer_token _ -> "authenticated@example.com"
474
-
| No_auth -> "anonymous@example.com"));
475
-
("apiUrl", `String (Uri.to_string url ^ "../api/"));
476
-
("downloadUrl", `String (Uri.to_string url ^ "../download/{accountId}/{blobId}/{name}?accept={type}"));
477
-
("uploadUrl", `String (Uri.to_string url ^ "../upload/{accountId}/"));
478
-
("eventSourceUrl", `String (Uri.to_string url ^ "../eventsource/?types={types}&closeafter={closeafter}&ping={ping}"));
479
-
("state", `String "75128aab4b1b")
480
-
] in
481
-
let _ = headers in
482
-
Ok response_json
483
-
with
484
-
| _ -> Error (Connection_failed ("Failed to connect to " ^ Uri.to_string url))
485
-
end
486
-
487
345
let parse_session_json json =
488
346
try
489
347
let open Yojson.Safe.Util in
···
558
416
~upload_url:(Uri.of_string "https://example.com/upload/{accountId}/")
559
417
~event_source_url:(Uri.of_string "https://example.com/events/")
560
418
~state:"fallback"
561
-
()
562
-
563
-
let get_session ~url =
564
-
match HTTP_Client.make_request ~url ~auth:No_auth with
565
-
| Ok json -> parse_session_json json
566
-
| Error _err ->
567
-
let fallback_json = `Assoc [
568
-
("capabilities", `Assoc [
569
-
(Jmap_capability.to_string `Core, `Assoc [
570
-
("maxSizeUpload", `Int 50_000_000);
571
-
("maxConcurrentUpload", `Int 4);
572
-
("maxSizeRequest", `Int 10_000_000);
573
-
("maxConcurrentRequests", `Int 4);
574
-
("maxCallsInRequest", `Int 16);
575
-
("maxObjectsInGet", `Int 500);
576
-
("maxObjectsInSet", `Int 500);
577
-
("collationAlgorithms", `List [`String "i;unicode-casemap"])
578
-
])
579
-
]);
580
-
("accounts", `Assoc []);
581
-
("primaryAccounts", `Assoc []);
582
-
("username", `String "fallback@example.com");
583
-
("apiUrl", `String "https://example.com/api/");
584
-
("downloadUrl", `String "https://example.com/download/{accountId}/{blobId}/{name}");
585
-
("uploadUrl", `String "https://example.com/upload/{accountId}/");
586
-
("eventSourceUrl", `String "https://example.com/events/");
587
-
("state", `String "fallback")
588
-
] in
589
-
parse_session_json fallback_json
590
-
591
-
let get_session_with_auth ~url ~auth =
592
-
match HTTP_Client.make_request ~url ~auth with
593
-
| Ok json -> Ok (parse_session_json json)
594
-
| Error err -> Error (HTTP_Client.http_error_to_string err)
595
-
596
-
let discover_and_connect ~domain =
597
-
match discover ~domain with
598
-
| Some url -> Ok (get_session ~url)
599
-
| None -> Error ("Could not discover JMAP service for domain: " ^ domain)
600
-
601
-
let discover_and_connect_with_email ~email =
602
-
match Discovery.discover_from_email ~email with
603
-
| Ok url -> Ok (get_session ~url)
604
-
| Error err -> Error (Discovery.discovery_error_to_string err)
419
+
()
+2
-70
jmap/jmap/session.mli
+2
-70
jmap/jmap/session.mli
···
289
289
val get_capability_accounts : t -> Jmap_capability.t -> (string * Account.t) list
290
290
end
291
291
292
-
(** {1 Session Discovery and Retrieval} *)
293
-
294
-
(** Function to perform service autodiscovery.
295
-
296
-
JMAP supports automatic discovery of the session endpoint using well-known
297
-
URIs. This function attempts to discover the JMAP session URL for a given
298
-
domain by checking the well-known location.
299
-
300
-
The discovery process involves:
301
-
1. Checking /.well-known/jmap for the domain
302
-
2. Following any redirects
303
-
3. Parsing the response to extract the session URL
304
-
305
-
{b Example usage}:
306
-
{[
307
-
match discover ~domain:"mail.example.com" with
308
-
| Some session_url -> (* Use session_url to get session *)
309
-
| None -> (* Fall back to manual configuration *)
310
-
]}
311
-
312
-
@param domain The domain to discover JMAP service for (e.g., "mail.example.com")
313
-
@return The session URL if discovery succeeds, None otherwise
314
-
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-2.2> RFC 8620, Section 2.2 *)
315
-
val discover : domain:string -> Uri.t option
316
-
317
-
(** Function to fetch the session object from a given URL.
318
-
319
-
This function retrieves and parses the session resource from the server.
320
-
The session URL is typically obtained either through service discovery
321
-
or from manual configuration.
322
-
323
-
{b Note}: This function signature assumes authentication is handled
324
-
externally (e.g., through HTTP headers or URL parameters). In a real
325
-
implementation, authentication credentials would need to be provided.
326
-
327
-
{b Example usage}:
328
-
{[
329
-
let session_url = Uri.of_string "https://mail.example.com/jmap/session" in
330
-
let session = get_session ~url:session_url in
331
-
(* Use session for subsequent JMAP requests *)
332
-
]}
333
-
334
-
@param url The session endpoint URL (typically ends with /session)
335
-
@return The parsed session object
336
-
337
-
May raise network or parsing exceptions on failure. *)
338
-
val get_session : url:Uri.t -> Session.t
292
+
(** {1 JSON Parsing} *)
339
293
340
294
(** Parse a session object from JSON.
341
295
@param json The JSON representation of the session
342
296
@return The parsed session object *)
343
-
val parse_session_json : Yojson.Safe.t -> Session.t
344
-
345
-
(** Authentication types for session retrieval. *)
346
-
type auth =
347
-
| Bearer_token of string (** OAuth2 bearer token *)
348
-
| Basic_auth of string * string (** Username and password *)
349
-
| No_auth (** No authentication *)
350
-
351
-
(** Get session with authentication credentials.
352
-
@param url The session endpoint URL
353
-
@param auth Authentication credentials to use
354
-
@return The parsed session object or error message *)
355
-
val get_session_with_auth : url:Uri.t -> auth:auth -> (Session.t, string) result
356
-
357
-
(** Discover JMAP service and connect in one step.
358
-
@param domain Domain to discover and connect to
359
-
@return Connected session or error message *)
360
-
val discover_and_connect : domain:string -> (Session.t, string) result
361
-
362
-
(** Discover JMAP service from email address and connect.
363
-
@param email Email address to extract domain from
364
-
@return Connected session or error message *)
365
-
val discover_and_connect_with_email : email:string -> (Session.t, string) result
297
+
val parse_session_json : Yojson.Safe.t -> Session.t