this repo has no description
more
+1670
-1636
+23
-22
jmap/CLAUDE.md
+23
-22
jmap/CLAUDE.md
···
131
131
let args = `Assoc [("accountId", `String id); ...]
132
132
133
133
(* CORRECT in jmap-unix *)
134
-
let query = Jmap_email_query.query () |> with_account id |> ...
134
+
let query = Jmap_email.Query.query () |> with_account id |> ...
135
135
```
136
136
137
137
## 3. **Layer Responsibilities and Dependencies** ⬆️
···
155
155
- **Exports**: Email-specific JSON builders, property utilities, email parsers
156
156
- **NO I/O**: Pure JSON processing, no transport or execution
157
157
- **Key Functions**:
158
-
- `Jmap_email_query.to_json : query_builder -> Yojson.Safe.t`
159
-
- `Jmap_email_query.property_preset_to_strings : preset -> string list`
160
-
- `Jmap_email.of_json : Yojson.Safe.t -> (t, error) result`
158
+
- `Jmap_email.Query.to_json : query_builder -> Yojson.Safe.t`
159
+
- `Jmap_email.Query.property_preset_to_strings : preset -> string list`
160
+
- `Jmap_email.Email.of_json : Yojson.Safe.t -> (t, error) result`
161
161
162
162
### **jmap-unix** (Network Transport Layer)
163
163
- **Purpose**: Network I/O, connection management, request execution
···
165
165
- **Exports**: High-level email operations with network execution
166
166
- **Has Context**: Manages connection state, sessions, authentication
167
167
- **Key Functions**:
168
-
- `query_emails : context -> Jmap_email_query.query_builder -> (email list, error) result`
169
-
- `get_emails : context -> Jmap_email_query.get_args -> (email list, error) result`
168
+
- `query_emails : context -> Jmap_email.Query.query_builder -> (email list, error) result`
169
+
- `get_emails : context -> Jmap_email.Query.get_args -> (email list, error) result`
170
170
171
171
### **CRITICAL ARCHITECTURAL INSIGHT**:
172
172
**jmap-email produces JSON, jmap-unix consumes it for transport**
···
177
177
178
178
(* jmap-unix: uses jmap-email builders + adds transport *)
179
179
let query_emails env ctx query_builder =
180
-
let query_json = Jmap_email_query.build_email_query query_builder in
180
+
let query_json = Jmap_email.Query.build_email_query query_builder in
181
181
(* ... execute via network transport ... *)
182
182
```
183
183
···
187
187
188
188
```ocaml
189
189
(* jmap-unix: ONLY these imports allowed *)
190
-
open Jmap_email_query
191
-
open Jmap_email_batch
192
-
open Jmap_email_methods
190
+
open Jmap_email.Query
191
+
open Jmap_email.Email
192
+
open Jmap_email.Response
193
193
194
194
(* jmap-email: ONLY these imports allowed *)
195
195
open Jmap.Methods
196
196
open Jmap.Types
197
-
open Jmap.Protocol
197
+
open Jmap.Wire
198
198
199
199
(* jmap: ONLY these imports allowed *)
200
200
open Jmap_sigs
···
202
202
203
203
**FORBIDDEN imports:**
204
204
- jmap-unix importing Jmap directly
205
-
- jmap-email importing Jmap_sigs directly
205
+
- jmap-email importing Jmap_sigs directly
206
206
- Any cross-layer violations
207
+
- Using old nested module paths like `Jmap.Protocol.Wire`
207
208
208
209
# CODE QUALITY PRINCIPLES FOR UNRELEASED LIBRARY
209
210
···
429
430
@param id The unique identifier for this email
430
431
@param blob_id The identifier for the raw RFC5322 message content *)
431
432
type t = {
432
-
id : Id.t;
433
-
blob_id : Id.t option;
433
+
id : Jmap.Types.Id.t;
434
+
blob_id : Jmap.Types.Id.t option;
434
435
(* ... *)
435
436
}
436
437
```
···
446
447
JMAP's error model maps well to OCaml's result types:
447
448
448
449
```ocaml
449
-
type 'a result = ('a, Error.t) Result.t
450
+
type 'a result = ('a, Jmap.Error.error) Result.t
450
451
451
452
module Error : sig
452
453
type t =
···
685
686
val query_emails :
686
687
env:< net : 'a Eio.Net.t ; .. > ->
687
688
context ->
688
-
Jmap_email_query.query_builder ->
689
-
(Jmap_email.t list, error) result
689
+
Jmap_email.Query.query_builder ->
690
+
(Jmap_email.Email.t list, error) result
690
691
691
692
(* Implementation example *)
692
693
let query_emails env ctx query_builder =
693
694
(* Use jmap-email to build JSON *)
694
-
let query_json = Jmap_email_query.build_email_query query_builder in
695
+
let query_json = Jmap_email.Query.build_email_query query_builder in
695
696
let builder = build ctx |> add_method_call "Email/query" query_json "q1" in
696
697
(* Execute via network transport *)
697
698
execute env builder >>= fun response ->
698
699
(* Use jmap-email to parse response *)
699
-
Jmap_email.parse_email_list response
700
+
Jmap_email.Email.parse_email_list response
700
701
```
701
702
702
703
## 🔧 **Current fastmail_connect Issues**
···
718
719
**Line 66-71**: Manual email parsing
719
720
```ocaml
720
721
(* WRONG: Direct JSON parsing bypassing jmap-email *)
721
-
let email_from_json json = match Jmap_email.of_json json with ...
722
+
let email_from_json json = match Jmap_email.Email.of_json json with ...
722
723
```
723
724
724
725
### **Needed Implementation (Priority Order)**
725
726
726
727
1. **jmap-email JSON builders** (eliminates lines 23-52):
727
-
- `Jmap_email_query.build_query : query_builder -> Yojson.Safe.t`
728
-
- `Jmap_email_query.build_get_args : property list -> Yojson.Safe.t`
728
+
- `Jmap_email.Query.build_query : query_builder -> Yojson.Safe.t`
729
+
- `Jmap_email.Query.build_get_args : property list -> Yojson.Safe.t`
729
730
- Property preset utilities
730
731
731
732
2. **jmap-unix high-level operations** (eliminates manual execution):
+8
-5
jmap/README.md
+8
-5
jmap/README.md
···
47
47
48
48
(* Using the JMAP Email extension library *)
49
49
open Jmap_email
50
-
open Jmap_email.Types
51
50
52
51
(* Example: Connecting to a JMAP server *)
53
-
let connect_to_server () =
54
-
let credentials = Jmap_unix.Basic("username", "password") in
55
-
let (ctx, session) = Jmap_unix.quick_connect ~host:"jmap.example.com" ~username:"user" ~password:"pass" in
56
-
...
52
+
let connect_to_server env =
53
+
let ctx = Jmap_unix.create_client () in
54
+
match Jmap_unix.quick_connect env ~host:"jmap.example.com" ~username:"user" ~password:"pass" () with
55
+
| Ok (ctx, session) ->
56
+
(* Use ctx and session for JMAP requests *)
57
+
Printf.printf "Connected successfully!\n"
58
+
| Error err ->
59
+
Printf.eprintf "Connection failed: %s\n" (Jmap.Error.to_string err)
57
60
```
58
61
59
62
## Building
+20
-20
jmap/bin/fastmail_connect.ml
+20
-20
jmap/bin/fastmail_connect.ml
···
9
9
printf "Using account: %s\nBuilding JMAP request using type-safe capabilities...\n" account_id;
10
10
11
11
let query_json =
12
-
Jmap_email.Jmap_email_query.(query () |> with_account account_id |> order_by Sort.by_date_desc |> limit 5 |> build_email_query) in
12
+
Jmap_email.Query.(query () |> with_account account_id |> order_by Sort.by_date_desc |> limit 5 |> build_email_query) in
13
13
14
14
let get_json =
15
-
Jmap_email.Jmap_email_query.(build_email_get_with_ref ~account_id
15
+
Jmap_email.Query.(build_email_get_with_ref ~account_id
16
16
~properties:[`Id; `ThreadId; `From; `Subject; `ReceivedAt; `Preview; `Keywords; `HasAttachment]
17
17
~result_of:"q1") in
18
18
···
25
25
printf "✓ Got JMAP response\n";
26
26
27
27
let+ query_response_json = Jmap_unix.Response.extract_method ~method_name:`Email_query ~method_call_id:"q1" response in
28
-
let+ query_response = Jmap_email.Email_response.parse_query_response query_response_json in
29
-
printf "✓ Found %d emails\n\n" (Jmap_email.Email_response.ids_from_query_response query_response |> List.length);
28
+
let+ query_response = Jmap_email.Response.parse_query_response query_response_json in
29
+
printf "✓ Found %d emails\n\n" (Jmap_email.Response.ids_from_query_response query_response |> List.length);
30
30
31
31
let+ get_response_json = Jmap_unix.Response.extract_method ~method_name:`Email_get ~method_call_id:"g1" response in
32
-
let+ get_response = Jmap_email.Email_response.parse_get_response
33
-
~from_json:(fun json -> match Jmap_email.of_json json with
32
+
let+ get_response = Jmap_email.Response.parse_get_response
33
+
~from_json:(fun json -> match Jmap_email.Email.of_json json with
34
34
| Ok email -> email
35
35
| Error err -> failwith ("Email parse error: " ^ err))
36
36
get_response_json in
37
37
38
-
let emails = Jmap_email.Email_response.emails_from_get_response get_response in
38
+
let emails = Jmap_email.Response.emails_from_get_response get_response in
39
39
40
40
let print_sender email =
41
-
Jmap_email.(match from email with
41
+
Jmap_email.Email.(match from email with
42
42
| Some (sender :: _) ->
43
-
Jmap_email.Email_address.(printf " From: %s\n"
43
+
Jmap_email.Address.(printf " From: %s\n"
44
44
(match name sender with | Some n -> n ^ " <" ^ email sender ^ ">" | None -> email sender))
45
45
| _ -> printf " From: (Unknown)\n") in
46
46
47
47
let print_preview email =
48
-
Jmap_email.(match preview email with
48
+
Jmap_email.Email.(match preview email with
49
49
| Some p when String.length p > 0 ->
50
50
let preview = if String.length p > 100 then String.sub p 0 97 ^ "..." else p in
51
51
printf " Preview: %s\n" preview
···
53
53
54
54
List.iteri (fun i email ->
55
55
printf "━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━\nEmail #%d:\n" (i + 1);
56
-
printf " Subject: %s\n" Jmap_email.(subject email |> Option.value ~default:"(No Subject)");
56
+
printf " Subject: %s\n" (Jmap_email.Email.subject email |> Option.value ~default:"(No Subject)");
57
57
print_sender email;
58
-
Jmap_email.(received_at email |> Option.iter (fun t ->
59
-
printf " Date: %s\n" Jmap.Date.(of_timestamp t |> to_rfc3339)));
58
+
Jmap_email.Email.(received_at email |> Option.iter (fun t ->
59
+
printf " Date: %s\n" Jmap.Types.Date.(of_timestamp t |> to_rfc3339)));
60
60
print_preview email
61
61
) emails;
62
62
printf "━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━\n";
63
63
Ok ()
64
64
with
65
-
| exn -> Error (Jmap.Protocol.Error.protocol_error ("Exception: " ^ Printexc.to_string exn))
65
+
| exn -> Error (Jmap.Error.protocol_error ("Exception: " ^ Printexc.to_string exn))
66
66
67
67
let main () =
68
68
(* Initialize the random number generator for TLS *)
···
77
77
printf "Testing core JMAP modules...\n";
78
78
79
79
let test_modules = [
80
-
("Jmap.Id", Jmap.Id.(of_string "test-id-123" |> Result.map (Format.asprintf "%a" pp)));
81
-
("Jmap.Date", Ok (Jmap.Date.(Unix.time () |> of_timestamp |> to_timestamp |> Printf.sprintf "%.0f")));
82
-
("Jmap.UInt", Jmap.UInt.(of_int 42 |> Result.map (Format.asprintf "%a" pp)));
80
+
("Jmap.Types.Id", Jmap.Types.Id.(of_string "test-id-123" |> Result.map (Format.asprintf "%a" pp)));
81
+
("Jmap.Types.Date", Ok (Jmap.Types.Date.(Unix.time () |> of_timestamp |> to_timestamp |> Printf.sprintf "%.0f")));
82
+
("Jmap.Types.UInt", Jmap.Types.UInt.(of_int 42 |> Result.map (Format.asprintf "%a" pp)));
83
83
] in
84
84
85
85
let test_results = List.map (fun (name, result) -> match result with
···
125
125
printf "\n📧 Fetching recent emails...\n";
126
126
(match fetch_recent_emails env ctx session with
127
127
| Ok () -> printf "✓ Email fetch completed successfully\n"
128
-
| Error error -> Format.printf "⚠ Email fetch failed: %a\n" Jmap.Protocol.Error.pp error);
128
+
| Error error -> Format.printf "⚠ Email fetch failed: %a\n" Jmap.Error.pp error);
129
129
130
130
printf "\nClosing connection...\n";
131
131
(match Jmap_unix.close ctx with
132
132
| Ok () -> printf "✓ Connection closed successfully\n"
133
-
| Error error -> Format.printf "⚠ Error closing connection: %a\n" Jmap.Protocol.Error.pp error);
133
+
| Error error -> Format.printf "⚠ Error closing connection: %a\n" Jmap.Error.pp error);
134
134
135
135
printf "\nOverall: ALL TESTS PASSED\n"
136
136
137
137
| Error error ->
138
138
Format.eprintf "✗ Connection failed: %a\n"
139
-
Jmap.Protocol.Error.pp error;
139
+
Jmap.Error.pp error;
140
140
eprintf "\nThis could be due to:\n";
141
141
eprintf " - Invalid API key\n";
142
142
eprintf " - Network connectivity issues\n";
+9
-9
jmap/bin/test_session_wire.ml
+9
-9
jmap/bin/test_session_wire.ml
···
4
4
let test_session_wire_type () =
5
5
printf "Testing Session WIRE_TYPE implementation...\n";
6
6
7
-
(* Use the Protocol.Session.Session module *)
8
-
let open Protocol.Session.Session in
7
+
(* Use the Session module *)
8
+
let open Session in
9
9
10
10
(* Create a basic session *)
11
11
let capabilities = Hashtbl.create 1 in
···
24
24
let accounts = Hashtbl.create 0 in
25
25
let primary_accounts = Hashtbl.create 0 in
26
26
27
-
let session = v
27
+
let session = Session.v
28
28
~capabilities
29
29
~accounts
30
30
~primary_accounts
···
38
38
39
39
(* Test validation *)
40
40
printf "Testing validation...\n";
41
-
(match validate session with
41
+
(match Session.validate session with
42
42
| Ok () -> printf "✓ Session validation passed\n"
43
43
| Error msg -> printf "✗ Session validation failed: %s\n" msg);
44
44
45
45
(* Test pretty printing *)
46
46
printf "Testing pretty printing...\n";
47
-
Format.printf "Session (pp): %a\n" pp session;
48
-
Format.printf "Session (pp_hum):\n%a\n" pp_hum session;
47
+
Format.printf "Session (pp): %a\n" Session.pp session;
48
+
Format.printf "Session (pp_hum):\n%a\n" Session.pp_hum session;
49
49
50
50
(* Test JSON roundtrip *)
51
51
printf "Testing JSON serialization...\n";
52
-
let json = to_json session in
53
-
(match of_json json with
52
+
let json = Session.to_json session in
53
+
(match Session.of_json json with
54
54
| Ok session2 ->
55
55
printf "✓ JSON roundtrip successful\n";
56
-
(match validate session2 with
56
+
(match Session.validate session2 with
57
57
| Ok () -> printf "✓ Deserialized session is valid\n"
58
58
| Error msg -> printf "✗ Deserialized session validation failed: %s\n" msg)
59
59
| Error msg -> printf "✗ JSON roundtrip failed: %s\n" msg);
+1
-1
jmap/docs/queries/README.md
+1
-1
jmap/docs/queries/README.md
···
163
163
- [RFC 8620: The JSON Meta Application Protocol (JMAP)](https://www.rfc-editor.org/rfc/rfc8620.html)
164
164
- [RFC 8621: The JSON Meta Application Protocol (JMAP) for Mail](https://www.rfc-editor.org/rfc/rfc8621.html)
165
165
- [JMAP Method Documentation](../jmap/jmap_methods.mli)
166
-
- [Email Type Definitions](../jmap-email/jmap_email_types.mli)
166
+
- [Email Type Definitions](../jmap-email/email.mli)
+18
-18
jmap/jmap-email/dune
+18
-18
jmap/jmap-email/dune
···
3
3
(public_name jmap-email)
4
4
(libraries jmap yojson uri)
5
5
(modules
6
-
jmap_email
7
-
jmap_email_types
8
-
jmap_email_address
9
-
jmap_email_keywords
10
-
jmap_email_property
11
-
jmap_email_query
12
-
jmap_email_response
13
-
jmap_email_set
14
-
jmap_email_changes
15
-
jmap_email_header
16
-
jmap_email_body
17
-
jmap_email_apple
18
-
jmap_mailbox
19
-
jmap_thread
20
-
jmap_search_snippet
21
-
jmap_identity
22
-
jmap_submission
23
-
jmap_vacation))
6
+
email
7
+
types
8
+
address
9
+
keywords
10
+
property
11
+
query
12
+
response
13
+
set
14
+
changes
15
+
header
16
+
body
17
+
apple
18
+
mailbox
19
+
thread
20
+
search
21
+
identity
22
+
submission
23
+
vacation))
24
24
+42
-42
jmap/jmap-email/jmap_email.ml
jmap/jmap-email/email.ml
+42
-42
jmap/jmap-email/jmap_email.ml
jmap/jmap-email/email.ml
···
62
62
| None -> None
63
63
64
64
(** Parse email address from JSON object *)
65
-
let email_address (json : Yojson.Safe.t) : Jmap_email_address.t option =
65
+
let email_address (json : Yojson.Safe.t) : Address.t option =
66
66
match json with
67
67
| `Assoc addr_fields ->
68
68
let email = string "email" addr_fields in
69
69
let name = string "name" addr_fields in
70
70
(match email with
71
-
| Some e when e <> "" -> Some (Jmap_email_address.create_unsafe ~email:e ?name ())
71
+
| Some e when e <> "" -> Some (Address.create_unsafe ~email:e ?name ())
72
72
| _ -> None)
73
73
| _ -> None
74
74
75
75
(** Parse email address list field *)
76
-
let email_address_list (name : string) (fields : (string * Yojson.Safe.t) list) : Jmap_email_address.t list option =
76
+
let email_address_list (name : string) (fields : (string * Yojson.Safe.t) list) : Address.t list option =
77
77
list email_address name fields
78
78
79
79
(** Parse object field as hashtable *)
···
105
105
blob_id : id option;
106
106
thread_id : id option;
107
107
mailbox_ids : bool id_map option;
108
-
keywords : Jmap_email_keywords.t option;
108
+
keywords : Keywords.t option;
109
109
size : uint option;
110
110
received_at : date option;
111
111
message_id : string list option;
112
112
in_reply_to : string list option;
113
113
references : string list option;
114
-
sender : Jmap_email_address.t option;
115
-
from : Jmap_email_address.t list option;
116
-
to_ : Jmap_email_address.t list option;
117
-
cc : Jmap_email_address.t list option;
118
-
bcc : Jmap_email_address.t list option;
119
-
reply_to : Jmap_email_address.t list option;
114
+
sender : Address.t option;
115
+
from : Address.t list option;
116
+
to_ : Address.t list option;
117
+
cc : Address.t list option;
118
+
bcc : Address.t list option;
119
+
reply_to : Address.t list option;
120
120
subject : string option;
121
121
sent_at : date option;
122
122
has_attachment : bool option;
123
123
preview : string option;
124
-
body_structure : Jmap_email_body.t option;
125
-
body_values : Jmap_email_body.Value.t string_map option;
126
-
text_body : Jmap_email_body.t list option;
127
-
html_body : Jmap_email_body.t list option;
128
-
attachments : Jmap_email_body.t list option;
124
+
body_structure : Body.t option;
125
+
body_values : Body.Value.t string_map option;
126
+
text_body : Body.t list option;
127
+
html_body : Body.t list option;
128
+
attachments : Body.t list option;
129
129
headers : string string_map option;
130
130
other_properties : Yojson.Safe.t string_map;
131
131
}
···
230
230
let is_unread t =
231
231
match t.keywords with
232
232
| Some keywords ->
233
-
not (Jmap_email_keywords.is_draft keywords) &&
234
-
not (Jmap_email_keywords.is_seen keywords)
233
+
not (Keywords.is_draft keywords) &&
234
+
not (Keywords.is_seen keywords)
235
235
| None -> false (* Cannot determine without keywords *)
236
236
237
237
let is_draft t =
238
238
match t.keywords with
239
-
| Some keywords -> Jmap_email_keywords.is_draft keywords
239
+
| Some keywords -> Keywords.is_draft keywords
240
240
| None -> false
241
241
242
242
let is_flagged t =
243
243
match t.keywords with
244
-
| Some keywords -> Jmap_email_keywords.is_flagged keywords
244
+
| Some keywords -> Keywords.is_flagged keywords
245
245
| None -> false
246
246
247
247
let primary_sender t =
···
259
259
let display_summary t =
260
260
let sender_str = match primary_sender t with
261
261
| Some addr ->
262
-
(match Jmap_email_address.name addr with
262
+
(match Address.name addr with
263
263
| Some name -> name
264
-
| None -> Jmap_email_address.email addr)
264
+
| None -> Address.email addr)
265
265
| None -> "Unknown sender"
266
266
in
267
267
let subject_str = match t.subject with
···
318
318
- Handle standard and custom keywords
319
319
- RFC reference: RFC 8621 Section 4.1.4
320
320
- Priority: Medium
321
-
- Dependencies: Jmap_email_keywords.of_json *)
321
+
- Dependencies: Keywords.of_json *)
322
322
let keywords = None in (* Keywords parsing not implemented *)
323
323
let size = Json.int "size" fields in
324
324
let received_at = Json.iso_date "receivedAt" fields in
···
343
343
- Handle multipart/alternative, multipart/mixed
344
344
- RFC reference: RFC 8621 Section 4.1.7
345
345
- Priority: High
346
-
- Dependencies: Jmap_email_body.of_json *)
346
+
- Dependencies: Body.of_json *)
347
347
let body_structure = None in (* Body structure parsing not implemented *)
348
348
(* TODO: Implement body values parsing from JSON
349
349
- Parse bodyValues map for text/html content
350
350
- Handle charset conversion and truncation
351
351
- RFC reference: RFC 8621 Section 4.1.8
352
352
- Priority: High
353
-
- Dependencies: Jmap_email_body.Value.of_json *)
353
+
- Dependencies: Body.Value.of_json *)
354
354
let body_values = None in (* Body values parsing not implemented *)
355
355
(* TODO: Implement text/html/attachment body part parsing
356
356
- Parse textBody, htmlBody, attachments arrays
···
398
398
| None -> "<no-subject>"
399
399
in
400
400
let sender_str = match primary_sender t with
401
-
| Some addr -> Jmap_email_address.email addr
401
+
| Some addr -> Address.email addr
402
402
| None -> "<unknown-sender>"
403
403
in
404
404
Format.fprintf ppf "Email{id=%s; from=%s; subject=%s}"
···
415
415
`List patches
416
416
417
417
let mark_read () =
418
-
create ~add_keywords:[Jmap_email_keywords.Seen] ()
418
+
create ~add_keywords:[Keywords.Seen] ()
419
419
420
420
let mark_unread () =
421
-
create ~remove_keywords:[Jmap_email_keywords.Seen] ()
421
+
create ~remove_keywords:[Keywords.Seen] ()
422
422
423
423
let flag () =
424
-
create ~add_keywords:[Jmap_email_keywords.Flagged] ()
424
+
create ~add_keywords:[Keywords.Flagged] ()
425
425
426
426
let unflag () =
427
-
create ~remove_keywords:[Jmap_email_keywords.Flagged] ()
427
+
create ~remove_keywords:[Keywords.Flagged] ()
428
428
429
429
let move_to_mailboxes _mailbox_ids =
430
430
`List [] (* Simplified implementation *)
431
431
end
432
432
433
433
(* Module aliases for external access *)
434
-
module Email_address = Jmap_email_address
435
-
module Email_keywords = Jmap_email_keywords
436
-
module Email_header = Jmap_email_header
437
-
module Email_body = Jmap_email_body
438
-
module Apple_mail = Jmap_email_apple
439
-
module Thread = Jmap_thread
440
-
module Identity = Jmap_identity
441
-
module Jmap_email_query = Jmap_email_query
442
-
module Email_response = Jmap_email_response
443
-
module Email_set = Jmap_email_set
444
-
module Email_changes = Jmap_email_changes
434
+
module Email_address = Address
435
+
module Email_keywords = Keywords
436
+
module Email_header = Header
437
+
module Email_body = Body
438
+
module Apple_mail = Apple
439
+
module Thread = Thread
440
+
module Identity = Identity
441
+
module Query = Query
442
+
module Email_response = Response
443
+
module Email_set = Set
444
+
module Email_changes = Changes
445
445
446
446
(* Legacy aliases for compatibility *)
447
447
module Types = struct
448
-
module Keywords = Jmap_email_keywords
449
-
module Email_address = Jmap_email_address
448
+
module Keywords = Keywords
449
+
module Email_address = Address
450
450
module Email = struct
451
451
type nonrec t = t (* Alias the main email type *)
452
452
let id = id
+43
-43
jmap/jmap-email/jmap_email.mli
jmap/jmap-email/email.mli
+43
-43
jmap/jmap-email/jmap_email.mli
jmap/jmap-email/email.mli
···
53
53
(** Get the keywords/flags applied to this email.
54
54
@param t The email object
55
55
@return Set of keywords if included in the retrieved properties *)
56
-
val keywords : t -> Jmap_email_keywords.t option
56
+
val keywords : t -> Keywords.t option
57
57
58
58
(** Get the total size of the raw message.
59
59
@param t The email object
···
83
83
(** Get the Sender header address.
84
84
@param t The email object
85
85
@return Single sender address if the Sender property was requested *)
86
-
val sender : t -> Jmap_email_address.t option
86
+
val sender : t -> Address.t option
87
87
88
88
(** Get the From header addresses.
89
89
@param t The email object
90
90
@return List of sender addresses if the From property was requested *)
91
-
val from : t -> Jmap_email_address.t list option
91
+
val from : t -> Address.t list option
92
92
93
93
(** Get the To header addresses.
94
94
@param t The email object
95
95
@return List of primary recipient addresses if the To property was requested *)
96
-
val to_ : t -> Jmap_email_address.t list option
96
+
val to_ : t -> Address.t list option
97
97
98
98
(** Get the Cc header addresses.
99
99
@param t The email object
100
100
@return List of carbon copy addresses if the Cc property was requested *)
101
-
val cc : t -> Jmap_email_address.t list option
101
+
val cc : t -> Address.t list option
102
102
103
103
(** Get the Bcc header addresses.
104
104
@param t The email object
105
105
@return List of blind carbon copy addresses if the Bcc property was requested *)
106
-
val bcc : t -> Jmap_email_address.t list option
106
+
val bcc : t -> Address.t list option
107
107
108
108
(** Get the Reply-To header addresses.
109
109
@param t The email object
110
110
@return List of reply-to addresses if the ReplyTo property was requested *)
111
-
val reply_to : t -> Jmap_email_address.t list option
111
+
val reply_to : t -> Address.t list option
112
112
113
113
(** Get the email subject line.
114
114
@param t The email object
···
133
133
(** Get the complete MIME structure tree of the message.
134
134
@param t The email object
135
135
@return Body structure if the BodyStructure property was requested *)
136
-
val body_structure : t -> Jmap_email_body.t option
136
+
val body_structure : t -> Body.t option
137
137
138
138
(** Get decoded content of requested text body parts.
139
139
@param t The email object
140
140
@return Map of part IDs to decoded content if BodyValues was requested *)
141
-
val body_values : t -> Jmap_email_body.Value.t string_map option
141
+
val body_values : t -> Body.Value.t string_map option
142
142
143
143
(** Get text/plain body parts suitable for display.
144
144
@param t The email object
145
145
@return List of text body parts if the TextBody property was requested *)
146
-
val text_body : t -> Jmap_email_body.t list option
146
+
val text_body : t -> Body.t list option
147
147
148
148
(** Get text/html body parts suitable for display.
149
149
@param t The email object
150
150
@return List of HTML body parts if the HtmlBody property was requested *)
151
-
val html_body : t -> Jmap_email_body.t list option
151
+
val html_body : t -> Body.t list option
152
152
153
153
(** Get attachment body parts.
154
154
@param t The email object
155
155
@return List of attachment parts if the Attachments property was requested *)
156
-
val attachments : t -> Jmap_email_body.t list option
156
+
val attachments : t -> Body.t list option
157
157
158
158
(** Get the value of a specific header field.
159
159
···
213
213
?blob_id:id ->
214
214
?thread_id:id ->
215
215
?mailbox_ids:bool id_map ->
216
-
?keywords:Jmap_email_keywords.t ->
216
+
?keywords:Keywords.t ->
217
217
?size:uint ->
218
218
?received_at:date ->
219
219
?message_id:string list ->
220
220
?in_reply_to:string list ->
221
221
?references:string list ->
222
-
?sender:Jmap_email_address.t ->
223
-
?from:Jmap_email_address.t list ->
224
-
?to_:Jmap_email_address.t list ->
225
-
?cc:Jmap_email_address.t list ->
226
-
?bcc:Jmap_email_address.t list ->
227
-
?reply_to:Jmap_email_address.t list ->
222
+
?sender:Address.t ->
223
+
?from:Address.t list ->
224
+
?to_:Address.t list ->
225
+
?cc:Address.t list ->
226
+
?bcc:Address.t list ->
227
+
?reply_to:Address.t list ->
228
228
?subject:string ->
229
229
?sent_at:date ->
230
230
?has_attachment:bool ->
231
231
?preview:string ->
232
-
?body_structure:Jmap_email_body.t ->
233
-
?body_values:Jmap_email_body.Value.t string_map ->
234
-
?text_body:Jmap_email_body.t list ->
235
-
?html_body:Jmap_email_body.t list ->
236
-
?attachments:Jmap_email_body.t list ->
232
+
?body_structure:Body.t ->
233
+
?body_values:Body.Value.t string_map ->
234
+
?text_body:Body.t list ->
235
+
?html_body:Body.t list ->
236
+
?attachments:Body.t list ->
237
237
?headers:string string_map ->
238
238
?other_properties:Yojson.Safe.t string_map ->
239
239
unit -> t
···
276
276
277
277
@param t The email object
278
278
@return Primary sender address if available *)
279
-
val primary_sender : t -> Jmap_email_address.t option
279
+
val primary_sender : t -> Address.t option
280
280
281
281
(** Get all recipient addresses (To, Cc, Bcc combined).
282
282
283
283
@param t The email object
284
284
@return List of all recipient addresses from To, Cc, and Bcc fields *)
285
-
val all_recipients : t -> Jmap_email_address.t list
285
+
val all_recipients : t -> Address.t list
286
286
287
287
(** Get a short display summary of the email.
288
288
···
313
313
@param remove_mailboxes Mailboxes to remove the email from
314
314
@return JSON Patch operations for Email/set *)
315
315
val create :
316
-
?add_keywords:Jmap_email_keywords.t ->
317
-
?remove_keywords:Jmap_email_keywords.t ->
316
+
?add_keywords:Keywords.t ->
317
+
?remove_keywords:Keywords.t ->
318
318
?add_mailboxes:id list ->
319
319
?remove_mailboxes:id list ->
320
320
unit -> Yojson.Safe.t
···
345
345
(** Module aliases for external access *)
346
346
347
347
(** Email address types and operations *)
348
-
module Email_address = Jmap_email_address
348
+
module Email_address = Address
349
349
350
350
(** Email keywords and flags *)
351
-
module Email_keywords = Jmap_email_keywords
351
+
module Email_keywords = Keywords
352
352
353
353
(** Email header fields *)
354
-
module Email_header = Jmap_email_header
354
+
module Email_header = Header
355
355
356
356
(** Email body parts and content *)
357
-
module Email_body = Jmap_email_body
357
+
module Email_body = Body
358
358
359
359
(** Apple Mail extensions *)
360
-
module Apple_mail = Jmap_email_apple
360
+
module Apple_mail = Apple
361
361
362
362
(** Thread operations and data types *)
363
-
module Thread = Jmap_thread
363
+
module Thread = Thread
364
364
365
365
(** Identity operations and data types *)
366
-
module Identity = Jmap_identity
366
+
module Identity = Identity
367
367
368
368
(** Email query builder and operations *)
369
-
module Jmap_email_query = Jmap_email_query
369
+
module Query = Query
370
370
371
371
(** Email response parsing using core JMAP parsers *)
372
-
module Email_response = Jmap_email_response
372
+
module Email_response = Response
373
373
374
374
(** Email set operations using core JMAP Set_args *)
375
-
module Email_set = Jmap_email_set
375
+
module Email_set = Set
376
376
377
377
(** Email changes operations using core JMAP Changes_args *)
378
-
module Email_changes = Jmap_email_changes
378
+
module Email_changes = Changes
379
379
380
380
(** Legacy aliases for backward compatibility *)
381
381
module Types : sig
382
-
module Keywords = Jmap_email_keywords
383
-
module Email_address = Jmap_email_address
382
+
module Keywords = Keywords
383
+
module Email_address = Address
384
384
module Email : sig
385
385
type nonrec t = t
386
386
val id : t -> id option
387
387
val received_at : t -> date option
388
388
val subject : t -> string option
389
-
val from : t -> Jmap_email_address.t list option
390
-
val keywords : t -> Jmap_email_keywords.t option
389
+
val from : t -> Address.t list option
390
+
val keywords : t -> Keywords.t option
391
391
end
392
392
end
jmap/jmap-email/jmap_email_address.ml
jmap/jmap-email/address.ml
jmap/jmap-email/jmap_email_address.ml
jmap/jmap-email/address.ml
jmap/jmap-email/jmap_email_address.mli
jmap/jmap-email/address.mli
jmap/jmap-email/jmap_email_address.mli
jmap/jmap-email/address.mli
+1
-1
jmap/jmap-email/jmap_email_apple.ml
jmap/jmap-email/apple.ml
+1
-1
jmap/jmap-email/jmap_email_apple.ml
jmap/jmap-email/apple.ml
+1
-1
jmap/jmap-email/jmap_email_apple.mli
jmap/jmap-email/apple.mli
+1
-1
jmap/jmap-email/jmap_email_apple.mli
jmap/jmap-email/apple.mli
+3
-3
jmap/jmap-email/jmap_email_body.ml
jmap/jmap-email/body.ml
+3
-3
jmap/jmap-email/jmap_email_body.ml
jmap/jmap-email/body.ml
···
13
13
id : string option;
14
14
blob_id : id option;
15
15
size : uint;
16
-
headers : Jmap_email_header.t list;
16
+
headers : Header.t list;
17
17
name : string option;
18
18
mime_type : string;
19
19
charset : string option;
···
119
119
let rec to_json t =
120
120
let fields = [
121
121
("size", `Int t.size);
122
-
("headers", Jmap_email_header.list_to_json t.headers);
122
+
("headers", Header.list_to_json t.headers);
123
123
("type", `String t.mime_type);
124
124
] in
125
125
let add_opt_string fields name = function
···
158
158
in
159
159
let headers = match List.assoc_opt "headers" fields with
160
160
| Some json ->
161
-
(match Jmap_email_header.list_of_json json with
161
+
(match Header.list_of_json json with
162
162
| Ok h -> h
163
163
| Error msg -> failwith ("Invalid headers: " ^ msg))
164
164
| None -> []
+3
-3
jmap/jmap-email/jmap_email_body.mli
jmap/jmap-email/body.mli
+3
-3
jmap/jmap-email/jmap_email_body.mli
jmap/jmap-email/body.mli
···
45
45
(** Get the list of MIME headers for this part.
46
46
@param t The body part
47
47
@return List of header fields specific to this body part *)
48
-
val headers : t -> Jmap_email_header.t list
48
+
val headers : t -> Header.t list
49
49
50
50
(** Get the filename parameter from Content-Disposition or Content-Type.
51
51
@param t The body part
···
116
116
?id:string ->
117
117
?blob_id:id ->
118
118
size:uint ->
119
-
headers:Jmap_email_header.t list ->
119
+
headers:Header.t list ->
120
120
?name:string ->
121
121
mime_type:string ->
122
122
?charset:string ->
···
151
151
?id:string ->
152
152
?blob_id:id ->
153
153
size:uint ->
154
-
headers:Jmap_email_header.t list ->
154
+
headers:Header.t list ->
155
155
?name:string ->
156
156
mime_type:string ->
157
157
?charset:string ->
jmap/jmap-email/jmap_email_changes.ml
jmap/jmap-email/changes.ml
jmap/jmap-email/jmap_email_changes.ml
jmap/jmap-email/changes.ml
jmap/jmap-email/jmap_email_changes.mli
jmap/jmap-email/changes.mli
jmap/jmap-email/jmap_email_changes.mli
jmap/jmap-email/changes.mli
jmap/jmap-email/jmap_email_header.ml
jmap/jmap-email/header.ml
jmap/jmap-email/jmap_email_header.ml
jmap/jmap-email/header.ml
jmap/jmap-email/jmap_email_header.mli
jmap/jmap-email/header.mli
jmap/jmap-email/jmap_email_header.mli
jmap/jmap-email/header.mli
jmap/jmap-email/jmap_email_keywords.ml
jmap/jmap-email/keywords.ml
jmap/jmap-email/jmap_email_keywords.ml
jmap/jmap-email/keywords.ml
jmap/jmap-email/jmap_email_keywords.mli
jmap/jmap-email/keywords.mli
jmap/jmap-email/jmap_email_keywords.mli
jmap/jmap-email/keywords.mli
jmap/jmap-email/jmap_email_property.ml
jmap/jmap-email/property.ml
jmap/jmap-email/jmap_email_property.ml
jmap/jmap-email/property.ml
jmap/jmap-email/jmap_email_property.mli
jmap/jmap-email/property.mli
jmap/jmap-email/jmap_email_property.mli
jmap/jmap-email/property.mli
+12
-12
jmap/jmap-email/jmap_email_query.ml
jmap/jmap-email/query.ml
+12
-12
jmap/jmap-email/jmap_email_query.ml
jmap/jmap-email/query.ml
···
1
1
(** High-level Email query implementation *)
2
2
3
-
type property = Jmap_email_property.t
3
+
type property = Property.t
4
4
5
5
6
6
···
91
91
sort = [Sort.by_date_desc];
92
92
limit_count = None;
93
93
position = None;
94
-
properties = Jmap_email_property.common_list_properties;
94
+
properties = Property.common_list_properties;
95
95
collapse_threads = false;
96
96
calculate_total = false;
97
97
}
···
116
116
117
117
let select_preset preset builder =
118
118
let properties = match preset with
119
-
| `ListV -> Jmap_email_property.common_list_properties
120
-
| `Preview -> Jmap_email_property.for_preview ()
121
-
| `Full -> Jmap_email_property.for_reading ()
122
-
| `Threading -> Jmap_email_property.minimal_for_query ()
119
+
| `ListV -> Property.common_list_properties
120
+
| `Preview -> Property.for_preview ()
121
+
| `Full -> Property.for_reading ()
122
+
| `Threading -> Property.minimal_for_query ()
123
123
in
124
124
{ builder with properties }
125
125
···
163
163
Jmap.Methods.Query_args.to_json args
164
164
165
165
let property_preset_to_strings = function
166
-
| `ListV -> Jmap_email_property.to_string_list Jmap_email_property.common_list_properties
167
-
| `Preview -> Jmap_email_property.to_string_list (Jmap_email_property.for_preview ())
168
-
| `Full -> Jmap_email_property.to_string_list (Jmap_email_property.for_reading ())
169
-
| `Threading -> Jmap_email_property.to_string_list (Jmap_email_property.minimal_for_query ())
166
+
| `ListV -> Property.to_string_list Property.common_list_properties
167
+
| `Preview -> Property.to_string_list (Property.for_preview ())
168
+
| `Full -> Property.to_string_list (Property.for_reading ())
169
+
| `Threading -> Property.to_string_list (Property.minimal_for_query ())
170
170
171
171
let build_email_get_with_ref ~account_id ~properties ~result_of =
172
-
let property_strings = Jmap_email_property.to_string_list properties in
172
+
let property_strings = Property.to_string_list properties in
173
173
`Assoc [
174
174
("accountId", `String account_id);
175
175
("properties", `List (List.map (fun s -> `String s) property_strings));
···
181
181
]
182
182
183
183
let properties_to_strings properties =
184
-
Jmap_email_property.to_string_list properties
184
+
Property.to_string_list properties
185
185
186
186
187
187
(* Common query builders *)
+2
-2
jmap/jmap-email/jmap_email_query.mli
jmap/jmap-email/query.mli
+2
-2
jmap/jmap-email/jmap_email_query.mli
jmap/jmap-email/query.mli
···
9
9
10
10
(** Type-safe email property selectors.
11
11
12
-
Uses the canonical polymorphic variant property system from [Jmap_email_property].
12
+
Uses the canonical polymorphic variant property system from [property].
13
13
This provides full compatibility with all JMAP Email properties including
14
14
header and custom extension properties.
15
15
*)
16
-
type property = Jmap_email_property.t
16
+
type property = Property.t
17
17
18
18
19
19
jmap/jmap-email/jmap_email_response.ml
jmap/jmap-email/response.ml
jmap/jmap-email/jmap_email_response.ml
jmap/jmap-email/response.ml
jmap/jmap-email/jmap_email_response.mli
jmap/jmap-email/response.mli
jmap/jmap-email/jmap_email_response.mli
jmap/jmap-email/response.mli
+9
-9
jmap/jmap-email/jmap_email_set.ml
jmap/jmap-email/set.ml
+9
-9
jmap/jmap-email/jmap_email_set.ml
jmap/jmap-email/set.ml
···
7
7
module Create = struct
8
8
type t = {
9
9
mailbox_ids : (id * bool) list;
10
-
keywords : (Jmap_email_keywords.keyword * bool) list;
10
+
keywords : (Keywords.keyword * bool) list;
11
11
received_at : Jmap.Types.utc_date option;
12
12
(* Additional fields as needed *)
13
13
}
···
21
21
let to_json t : Yojson.Safe.t =
22
22
let fields = [
23
23
("mailboxIds", (`Assoc (List.map (fun (id, v) -> (id, `Bool v)) t.mailbox_ids) : Yojson.Safe.t));
24
-
("keywords", (`Assoc (List.map (fun (kw, v) -> (Jmap_email_keywords.keyword_to_string kw, `Bool v)) t.keywords) : Yojson.Safe.t));
24
+
("keywords", (`Assoc (List.map (fun (kw, v) -> (Keywords.keyword_to_string kw, `Bool v)) t.keywords) : Yojson.Safe.t));
25
25
] in
26
26
let fields = match t.received_at with
27
27
| Some timestamp -> ("receivedAt", (`String (Jmap.Date.of_timestamp timestamp |> Jmap.Date.to_rfc3339) : Yojson.Safe.t)) :: fields
···
36
36
let patch_builder () = []
37
37
38
38
let set_keywords keywords patch =
39
-
("keywords", `Assoc (List.map (fun (kw, v) -> (Jmap_email_keywords.keyword_to_string kw, `Bool v)) keywords)) :: patch
39
+
("keywords", `Assoc (List.map (fun (kw, v) -> (Keywords.keyword_to_string kw, `Bool v)) keywords)) :: patch
40
40
41
41
let add_keyword keyword patch =
42
-
("keywords/" ^ (Jmap_email_keywords.keyword_to_string keyword), `Bool true) :: patch
42
+
("keywords/" ^ (Keywords.keyword_to_string keyword), `Bool true) :: patch
43
43
44
44
let remove_keyword keyword patch =
45
-
("keywords/" ^ (Jmap_email_keywords.keyword_to_string keyword), `Null) :: patch
45
+
("keywords/" ^ (Keywords.keyword_to_string keyword), `Null) :: patch
46
46
47
47
let move_to_mailbox mailbox_id patch =
48
48
(* Clear all existing mailboxes and set new one *)
···
81
81
let mark_as_read ~account_id email_ids =
82
82
let update_map : patch_object id_map = Hashtbl.create (List.length email_ids) in
83
83
List.iter (fun id ->
84
-
Hashtbl.add update_map id (Update.add_keyword Jmap_email_keywords.Seen [])
84
+
Hashtbl.add update_map id (Update.add_keyword Keywords.Seen [])
85
85
) email_ids;
86
86
build_set_args ~account_id ~update:update_map ()
87
87
···
89
89
let mark_as_unread ~account_id email_ids =
90
90
let update_map : patch_object id_map = Hashtbl.create (List.length email_ids) in
91
91
List.iter (fun id ->
92
-
Hashtbl.add update_map id (Update.remove_keyword Jmap_email_keywords.Seen [])
92
+
Hashtbl.add update_map id (Update.remove_keyword Keywords.Seen [])
93
93
) email_ids;
94
94
build_set_args ~account_id ~update:update_map ()
95
95
···
97
97
let flag_emails ~account_id email_ids =
98
98
let update_map : patch_object id_map = Hashtbl.create (List.length email_ids) in
99
99
List.iter (fun id ->
100
-
Hashtbl.add update_map id (Update.add_keyword Jmap_email_keywords.Flagged [])
100
+
Hashtbl.add update_map id (Update.add_keyword Keywords.Flagged [])
101
101
) email_ids;
102
102
build_set_args ~account_id ~update:update_map ()
103
103
···
105
105
let unflag_emails ~account_id email_ids =
106
106
let update_map : patch_object id_map = Hashtbl.create (List.length email_ids) in
107
107
List.iter (fun id ->
108
-
Hashtbl.add update_map id (Update.remove_keyword Jmap_email_keywords.Flagged [])
108
+
Hashtbl.add update_map id (Update.remove_keyword Keywords.Flagged [])
109
109
) email_ids;
110
110
build_set_args ~account_id ~update:update_map ()
111
111
+5
-5
jmap/jmap-email/jmap_email_set.mli
jmap/jmap-email/set.mli
+5
-5
jmap/jmap-email/jmap_email_set.mli
jmap/jmap-email/set.mli
···
21
21
@return Email creation arguments *)
22
22
val make :
23
23
mailbox_ids:(id * bool) list ->
24
-
?keywords:(Jmap_email_keywords.keyword * bool) list ->
24
+
?keywords:(Keywords.keyword * bool) list ->
25
25
?received_at:Jmap.Types.utc_date ->
26
26
unit -> t
27
27
···
37
37
val patch_builder : unit -> patch_object
38
38
39
39
(** Set all keywords (replaces existing) *)
40
-
val set_keywords : (Jmap_email_keywords.keyword * bool) list -> patch_object -> patch_object
40
+
val set_keywords : (Keywords.keyword * bool) list -> patch_object -> patch_object
41
41
42
42
(** Add a single keyword *)
43
-
val add_keyword : Jmap_email_keywords.keyword -> patch_object -> patch_object
43
+
val add_keyword : Keywords.keyword -> patch_object -> patch_object
44
44
45
45
(** Remove a single keyword *)
46
-
val remove_keyword : Jmap_email_keywords.keyword -> patch_object -> patch_object
46
+
val remove_keyword : Keywords.keyword -> patch_object -> patch_object
47
47
48
48
(** Move to a single mailbox (removes from all others) *)
49
49
val move_to_mailbox : id -> patch_object -> patch_object
···
165
165
val create_draft :
166
166
account_id:id ->
167
167
mailbox_ids:(id * bool) list ->
168
-
?keywords:(Jmap_email_keywords.keyword * bool) list ->
168
+
?keywords:(Keywords.keyword * bool) list ->
169
169
?subject:string ->
170
170
?from:string ->
171
171
?to_:string list ->
+2
-2
jmap/jmap-email/jmap_email_types.ml
jmap/jmap-email/types.ml
+2
-2
jmap/jmap-email/jmap_email_types.ml
jmap/jmap-email/types.ml
···
744
744
type response = {
745
745
account_id : id;
746
746
created : email_import_result id_map;
747
-
not_created : Jmap.Protocol.Error.Set_error.t id_map;
747
+
not_created : Jmap.Error.Set_error.t id_map;
748
748
}
749
749
750
750
let create_response ~account_id ~created ~not_created () =
···
797
797
from_account_id : id;
798
798
account_id : id;
799
799
created : Email.t id_map option;
800
-
not_created : Jmap.Protocol.Error.Set_error.t id_map option;
800
+
not_created : Jmap.Error.Set_error.t id_map option;
801
801
}
802
802
803
803
let create_response ~from_account_id ~account_id ?created ?not_created () =
+4
-4
jmap/jmap-email/jmap_email_types.mli
jmap/jmap-email/types.mli
+4
-4
jmap/jmap-email/jmap_email_types.mli
jmap/jmap-email/types.mli
···
621
621
type response = {
622
622
account_id : id; (** Account where import was attempted *)
623
623
created : email_import_result id_map; (** Successfully imported emails by blob ID *)
624
-
not_created : Jmap.Protocol.Error.Set_error.t id_map; (** Failed imports with error details *)
624
+
not_created : Jmap.Error.Set_error.t id_map; (** Failed imports with error details *)
625
625
}
626
626
627
627
(** Create an import response object.
···
632
632
val create_response :
633
633
account_id:id ->
634
634
created:email_import_result id_map ->
635
-
not_created:Jmap.Protocol.Error.Set_error.t id_map ->
635
+
not_created:Jmap.Error.Set_error.t id_map ->
636
636
unit -> response
637
637
end
638
638
···
744
744
from_account_id : id; (** Source account ID *)
745
745
account_id : id; (** Destination account ID *)
746
746
created : Email.t id_map option; (** Successfully created emails by creation ID *)
747
-
not_created : Jmap.Protocol.Error.Set_error.t id_map option; (** Failed copies with error details *)
747
+
not_created : Jmap.Error.Set_error.t id_map option; (** Failed copies with error details *)
748
748
}
749
749
750
750
(** Create a copy response object.
···
757
757
from_account_id:id ->
758
758
account_id:id ->
759
759
?created:Email.t id_map ->
760
-
?not_created:Jmap.Protocol.Error.Set_error.t id_map ->
760
+
?not_created:Jmap.Error.Set_error.t id_map ->
761
761
unit -> response
762
762
end
763
763
+23
-23
jmap/jmap-email/jmap_identity.ml
jmap/jmap-email/identity.ml
+23
-23
jmap/jmap-email/jmap_identity.ml
jmap/jmap-email/identity.ml
···
9
9
10
10
open Jmap.Types
11
11
open Jmap.Method_names
12
-
open Jmap.Protocol.Error
12
+
open Jmap.Error
13
13
14
14
(** Identity object *)
15
15
type t = {
16
16
id : id option;
17
17
name : string;
18
18
email : string;
19
-
reply_to : Jmap_email_types.Email_address.t list option;
20
-
bcc : Jmap_email_types.Email_address.t list option;
19
+
reply_to : Types.Email_address.t list option;
20
+
bcc : Types.Email_address.t list option;
21
21
text_signature : string;
22
22
html_signature : string;
23
23
may_delete : bool;
···
55
55
] in
56
56
let fields = match t.reply_to with
57
57
| None -> ("replyTo", `Null) :: fields
58
-
| Some addrs -> ("replyTo", `List (List.map Jmap_email_types.Email_address.to_json addrs)) :: fields
58
+
| Some addrs -> ("replyTo", `List (List.map Types.Email_address.to_json addrs)) :: fields
59
59
in
60
60
let fields = match t.bcc with
61
61
| None -> ("bcc", `Null) :: fields
62
-
| Some addrs -> ("bcc", `List (List.map Jmap_email_types.Email_address.to_json addrs)) :: fields
62
+
| Some addrs -> ("bcc", `List (List.map Types.Email_address.to_json addrs)) :: fields
63
63
in
64
64
`Assoc (List.rev fields)
65
65
···
75
75
("email", `String t.email);
76
76
("replyTo", (match t.reply_to with
77
77
| None -> `Null
78
-
| Some addrs -> `List (List.map Jmap_email_types.Email_address.to_json addrs)));
78
+
| Some addrs -> `List (List.map Types.Email_address.to_json addrs)));
79
79
("bcc", (match t.bcc with
80
80
| None -> `Null
81
-
| Some addrs -> `List (List.map Jmap_email_types.Email_address.to_json addrs)));
81
+
| Some addrs -> `List (List.map Types.Email_address.to_json addrs)));
82
82
("textSignature", `String t.text_signature);
83
83
("htmlSignature", `String t.html_signature);
84
84
("mayDelete", `Bool t.may_delete);
···
114
114
let rec process_addresses acc = function
115
115
| [] -> Some (List.rev acc)
116
116
| addr :: rest ->
117
-
(match Jmap_email_types.Email_address.of_json addr with
117
+
(match Types.Email_address.of_json addr with
118
118
| Ok a -> process_addresses (a :: acc) rest
119
119
| Error _ -> failwith ("Invalid address in " ^ key ^ " field"))
120
120
in
···
155
155
type t = {
156
156
name : string option;
157
157
email : string;
158
-
reply_to : Jmap_email_types.Email_address.t list option;
159
-
bcc : Jmap_email_types.Email_address.t list option;
158
+
reply_to : Types.Email_address.t list option;
159
+
bcc : Types.Email_address.t list option;
160
160
text_signature : string option;
161
161
html_signature : string option;
162
162
}
···
185
185
in
186
186
let fields = match t.reply_to with
187
187
| None -> fields
188
-
| Some addrs -> ("replyTo", `List (List.map Jmap_email_types.Email_address.to_json addrs)) :: fields
188
+
| Some addrs -> ("replyTo", `List (List.map Types.Email_address.to_json addrs)) :: fields
189
189
in
190
190
let fields = match t.bcc with
191
191
| None -> fields
192
-
| Some addrs -> ("bcc", `List (List.map Jmap_email_types.Email_address.to_json addrs)) :: fields
192
+
| Some addrs -> ("bcc", `List (List.map Types.Email_address.to_json addrs)) :: fields
193
193
in
194
194
let fields = match t.text_signature with
195
195
| None -> fields
···
217
217
let rec process_addresses acc = function
218
218
| [] -> Some (List.rev acc)
219
219
| addr :: rest ->
220
-
(match Jmap_email_types.Email_address.of_json addr with
220
+
(match Types.Email_address.of_json addr with
221
221
| Ok a -> process_addresses (a :: acc) rest
222
222
| Error _ -> failwith ("Invalid address in " ^ key ^ " field"))
223
223
in
···
287
287
module Update = struct
288
288
type t = {
289
289
name : string option;
290
-
reply_to : Jmap_email_types.Email_address.t list option option;
291
-
bcc : Jmap_email_types.Email_address.t list option option;
290
+
reply_to : Types.Email_address.t list option option;
291
+
bcc : Types.Email_address.t list option option;
292
292
text_signature : string option;
293
293
html_signature : string option;
294
294
}
···
359
359
let fields = match t.reply_to with
360
360
| None -> fields
361
361
| Some None -> ("replyTo", `Null) :: fields
362
-
| Some (Some addrs) -> ("replyTo", `List (List.map Jmap_email_types.Email_address.to_json addrs)) :: fields
362
+
| Some (Some addrs) -> ("replyTo", `List (List.map Types.Email_address.to_json addrs)) :: fields
363
363
in
364
364
let fields = match t.bcc with
365
365
| None -> fields
366
366
| Some None -> ("bcc", `Null) :: fields
367
-
| Some (Some addrs) -> ("bcc", `List (List.map Jmap_email_types.Email_address.to_json addrs)) :: fields
367
+
| Some (Some addrs) -> ("bcc", `List (List.map Types.Email_address.to_json addrs)) :: fields
368
368
in
369
369
let fields = match t.text_signature with
370
370
| None -> fields
···
393
393
let rec process_addresses acc = function
394
394
| [] -> Some (Some (List.rev acc))
395
395
| addr :: rest ->
396
-
(match Jmap_email_types.Email_address.of_json addr with
396
+
(match Types.Email_address.of_json addr with
397
397
| Ok a -> process_addresses (a :: acc) rest
398
398
| Error _ -> failwith ("Invalid address in " ^ key ^ " field"))
399
399
in
···
863
863
id : id;
864
864
name : string;
865
865
email : string;
866
-
reply_to : Jmap_email_types.Email_address.t list option;
867
-
bcc : Jmap_email_types.Email_address.t list option;
866
+
reply_to : Types.Email_address.t list option;
867
+
bcc : Types.Email_address.t list option;
868
868
text_signature : string;
869
869
html_signature : string;
870
870
may_delete : bool;
···
896
896
] in
897
897
let fields = match identity.reply_to with
898
898
| None -> ("replyTo", `Null) :: fields
899
-
| Some addrs -> ("replyTo", `List (List.map Jmap_email_types.Email_address.to_json addrs)) :: fields
899
+
| Some addrs -> ("replyTo", `List (List.map Types.Email_address.to_json addrs)) :: fields
900
900
in
901
901
let fields = match identity.bcc with
902
902
| None -> ("bcc", `Null) :: fields
903
-
| Some addrs -> ("bcc", `List (List.map Jmap_email_types.Email_address.to_json addrs)) :: fields
903
+
| Some addrs -> ("bcc", `List (List.map Types.Email_address.to_json addrs)) :: fields
904
904
in
905
905
`Assoc (List.rev fields)
906
906
···
925
925
let rec process_addresses acc = function
926
926
| [] -> Some (List.rev acc)
927
927
| addr :: rest ->
928
-
(match Jmap_email_types.Email_address.of_json addr with
928
+
(match Types.Email_address.of_json addr with
929
929
| Ok a -> process_addresses (a :: acc) rest
930
930
| Error _ -> failwith ("Invalid address in " ^ key ^ " field"))
931
931
in
+13
-13
jmap/jmap-email/jmap_identity.mli
jmap/jmap-email/identity.mli
+13
-13
jmap/jmap-email/jmap_identity.mli
jmap/jmap-email/identity.mli
···
13
13
*)
14
14
15
15
open Jmap.Types
16
-
open Jmap.Protocol.Error
16
+
open Jmap.Error
17
17
18
18
(** Complete identity object representation.
19
19
···
47
47
48
48
(** Get the default Reply-To addresses for this identity.
49
49
@return List of reply-to addresses, or None if not specified *)
50
-
val reply_to : t -> Jmap_email_types.Email_address.t list option
50
+
val reply_to : t -> Types.Email_address.t list option
51
51
52
52
(** Get the default Bcc addresses for this identity.
53
53
@return List of addresses to always Bcc, or None if not specified *)
54
-
val bcc : t -> Jmap_email_types.Email_address.t list option
54
+
val bcc : t -> Types.Email_address.t list option
55
55
56
56
(** Get the plain text email signature.
57
57
@return Text signature to append to plain text messages *)
···
79
79
id:id ->
80
80
?name:string ->
81
81
email:string ->
82
-
?reply_to:Jmap_email_types.Email_address.t list ->
83
-
?bcc:Jmap_email_types.Email_address.t list ->
82
+
?reply_to:Types.Email_address.t list ->
83
+
?bcc:Types.Email_address.t list ->
84
84
?text_signature:string ->
85
85
?html_signature:string ->
86
86
may_delete:bool ->
···
110
110
111
111
(** Get the Reply-To addresses for creation.
112
112
@return Optional list of reply-to addresses *)
113
-
val reply_to : t -> Jmap_email_types.Email_address.t list option
113
+
val reply_to : t -> Types.Email_address.t list option
114
114
115
115
(** Get the Bcc addresses for creation.
116
116
@return Optional list of default Bcc addresses *)
117
-
val bcc : t -> Jmap_email_types.Email_address.t list option
117
+
val bcc : t -> Types.Email_address.t list option
118
118
119
119
(** Get the plain text signature for creation.
120
120
@return Optional text signature *)
···
135
135
val v :
136
136
?name:string ->
137
137
email:string ->
138
-
?reply_to:Jmap_email_types.Email_address.t list ->
139
-
?bcc:Jmap_email_types.Email_address.t list ->
138
+
?reply_to:Types.Email_address.t list ->
139
+
?bcc:Types.Email_address.t list ->
140
140
?text_signature:string ->
141
141
?html_signature:string ->
142
142
unit -> t
···
201
201
(** Create an update that sets the Reply-To addresses.
202
202
@param reply_to New Reply-To addresses (None to clear)
203
203
@return Update patch object *)
204
-
val set_reply_to : Jmap_email_types.Email_address.t list option -> t
204
+
val set_reply_to : Types.Email_address.t list option -> t
205
205
206
206
(** Create an update that sets the Bcc addresses.
207
207
@param bcc New default Bcc addresses (None to clear)
208
208
@return Update patch object *)
209
-
val set_bcc : Jmap_email_types.Email_address.t list option -> t
209
+
val set_bcc : Types.Email_address.t list option -> t
210
210
211
211
(** Create an update that sets the plain text signature.
212
212
@param text_signature New text signature (empty string to clear)
···
320
320
id : id;
321
321
name : string;
322
322
email : string;
323
-
reply_to : Jmap_email_types.Email_address.t list option;
324
-
bcc : Jmap_email_types.Email_address.t list option;
323
+
reply_to : Types.Email_address.t list option;
324
+
bcc : Types.Email_address.t list option;
325
325
text_signature : string;
326
326
html_signature : string;
327
327
may_delete : bool;
+3
-3
jmap/jmap-email/jmap_mailbox.ml
jmap/jmap-email/mailbox.ml
+3
-3
jmap/jmap-email/jmap_mailbox.ml
jmap/jmap-email/mailbox.ml
···
923
923
created : (string * Create.Response.t) list;
924
924
updated : (id * Update.Response.t) list;
925
925
destroyed : id list;
926
-
not_created : (string * Jmap.Protocol.Error.error) list;
927
-
not_updated : (id * Jmap.Protocol.Error.error) list;
928
-
not_destroyed : (id * Jmap.Protocol.Error.error) list;
926
+
not_created : (string * Jmap.Error.error) list;
927
+
not_updated : (id * Jmap.Error.error) list;
928
+
not_destroyed : (id * Jmap.Error.error) list;
929
929
}
930
930
931
931
let account_id resp = resp.account_id
+3
-3
jmap/jmap-email/jmap_mailbox.mli
jmap/jmap-email/mailbox.mli
+3
-3
jmap/jmap-email/jmap_mailbox.mli
jmap/jmap-email/mailbox.mli
···
887
887
(** Get the creation failures.
888
888
@param response Set response
889
889
@return Map of creation IDs to error objects *)
890
-
val not_created : t -> (string * Jmap.Protocol.Error.error) list
890
+
val not_created : t -> (string * Jmap.Error.error) list
891
891
892
892
(** Get the update failures.
893
893
@param response Set response
894
894
@return Map of mailbox IDs to error objects *)
895
-
val not_updated : t -> (id * Jmap.Protocol.Error.error) list
895
+
val not_updated : t -> (id * Jmap.Error.error) list
896
896
897
897
(** Get the destruction failures.
898
898
@param response Set response
899
899
@return Map of mailbox IDs to error objects *)
900
-
val not_destroyed : t -> (id * Jmap.Protocol.Error.error) list
900
+
val not_destroyed : t -> (id * Jmap.Error.error) list
901
901
end
902
902
903
903
module Changes_args : sig
jmap/jmap-email/jmap_search_snippet.ml
jmap/jmap-email/search.ml
jmap/jmap-email/jmap_search_snippet.ml
jmap/jmap-email/search.ml
jmap/jmap-email/jmap_search_snippet.mli
jmap/jmap-email/search.mli
jmap/jmap-email/jmap_search_snippet.mli
jmap/jmap-email/search.mli
jmap/jmap-email/jmap_submission.ml
jmap/jmap-email/submission.ml
jmap/jmap-email/jmap_submission.ml
jmap/jmap-email/submission.ml
+3
-3
jmap/jmap-email/jmap_submission.mli
jmap/jmap-email/submission.mli
+3
-3
jmap/jmap-email/jmap_submission.mli
jmap/jmap-email/submission.mli
···
662
662
(** Get the submission IDs that could not be created.
663
663
@param response The set response object
664
664
@return Submission IDs that could not be created *)
665
-
val not_created : t -> Jmap.Protocol.Error.Set_error.t id_map option
665
+
val not_created : t -> Jmap.Error.Set_error.t id_map option
666
666
667
667
(** Get the submission IDs that could not be updated.
668
668
@param response The set response object
669
669
@return Submission IDs that could not be updated *)
670
-
val not_updated : t -> Jmap.Protocol.Error.Set_error.t id_map option
670
+
val not_updated : t -> Jmap.Error.Set_error.t id_map option
671
671
672
672
(** Get the submission IDs that could not be destroyed.
673
673
@param response The set response object
674
674
@return Submission IDs that could not be destroyed *)
675
-
val not_destroyed : t -> Jmap.Protocol.Error.Set_error.t id_map option
675
+
val not_destroyed : t -> Jmap.Error.Set_error.t id_map option
676
676
end
677
677
678
678
(** {1 Filter Helper Functions} *)
jmap/jmap-email/jmap_thread.ml
jmap/jmap-email/thread.ml
jmap/jmap-email/jmap_thread.ml
jmap/jmap-email/thread.ml
jmap/jmap-email/jmap_thread.mli
jmap/jmap-email/thread.mli
jmap/jmap-email/jmap_thread.mli
jmap/jmap-email/thread.mli
+2
-2
jmap/jmap-email/jmap_vacation.ml
jmap/jmap-email/vacation.ml
+2
-2
jmap/jmap-email/jmap_vacation.ml
jmap/jmap-email/vacation.ml
···
8
8
*)
9
9
10
10
open Jmap.Types
11
-
open Jmap.Protocol.Error
11
+
open Jmap.Error
12
12
open Yojson.Safe.Util
13
13
14
14
(* Alias for easier access to error types *)
15
-
module Error = Jmap.Protocol.Error
15
+
module Error = Jmap.Error
16
16
17
17
(** VacationResponse object *)
18
18
type t = {
+1
-1
jmap/jmap-email/jmap_vacation.mli
jmap/jmap-email/vacation.mli
+1
-1
jmap/jmap-email/jmap_vacation.mli
jmap/jmap-email/vacation.mli
+2
-2
jmap/jmap-email/test_apple_mail.ml
+2
-2
jmap/jmap-email/test_apple_mail.ml
+3
-3
jmap/jmap-email/test_email_json.ml
+3
-3
jmap/jmap-email/test_email_json.ml
···
1
-
open Jmap_email_address
2
-
open Jmap_email_keywords
1
+
open Address
2
+
open Keywords
3
3
4
4
let%expect_test "email_address_json_roundtrip" =
5
5
let addr = match create ~name:"John Doe" ~email:"john@example.com" () with
···
203
203
204
204
(* EmailSubmission tests *)
205
205
(* Access submission module through the main Jmap_email module *)
206
-
module Submission = Jmap_email.Submission
206
+
module Submission = Submission
207
207
open Jmap.Methods
208
208
209
209
let%expect_test "email_submission_filter_identity_ids" =
+32
-19
jmap/jmap-unix/README.md
+32
-19
jmap/jmap-unix/README.md
···
21
21
open Jmap_unix
22
22
23
23
(* Create a connection to a JMAP server *)
24
-
let credentials = Basic("username", "password") in
25
-
let (ctx, session) = Jmap_unix.connect ~host:"jmap.example.com" ~credentials in
26
-
27
-
(* Use the connection for JMAP requests *)
28
-
let response = Jmap_unix.request ctx request in
29
-
30
-
(* Close the connection when done *)
31
-
Jmap_unix.close ctx
24
+
let connect_example env =
25
+
let ctx = Jmap_unix.create_client () in
26
+
match Jmap_unix.quick_connect env ~host:"jmap.example.com" ~username:"user" ~password:"pass" () with
27
+
| Ok (ctx, session) ->
28
+
(* Use the connection for JMAP requests *)
29
+
let builder = Jmap_unix.build ctx in
30
+
let builder = Jmap_unix.using builder [`Core] in
31
+
(* ... add method calls ... *)
32
+
let response = Jmap_unix.execute env builder in
33
+
ignore (Jmap_unix.close ctx)
34
+
| Error err ->
35
+
Printf.eprintf "Connection failed: %s\n" (Jmap.Error.to_string err)
32
36
```
33
37
34
38
## Email Operations
···
37
41
38
42
```ocaml
39
43
open Jmap
40
-
open Jmap.Unix
44
+
open Jmap_unix
41
45
42
46
(* Get an email *)
43
-
let email = Email.get_email ctx ~account_id ~email_id ()
47
+
let get_email_example env ctx account_id email_id =
48
+
match Email.get_email env ctx ~account_id ~email_id () with
49
+
| Ok email -> Printf.printf "Got email: %s\n" (Jmap_email.Email.subject email)
50
+
| Error err -> Printf.eprintf "Error: %s\n" (Jmap.Error.to_string err)
44
51
45
52
(* Search for unread emails *)
46
-
let filter = Jmap_email.Email_filter.unread ()
47
-
let (ids, emails) = Email.search_emails ctx ~account_id ~filter ()
53
+
let search_unread env ctx account_id =
54
+
let filter = Jmap.Methods.Filter.(["hasKeyword", `String "$unseen"]) in
55
+
match Email.search_emails env ctx ~account_id ~filter () with
56
+
| Ok (ids, Some emails) -> Printf.printf "Found %d unread emails\n" (List.length emails)
57
+
| Ok (ids, None) -> Printf.printf "Found %d unread email IDs\n" (List.length ids)
58
+
| Error err -> Printf.eprintf "Search error: %s\n" (Jmap.Error.to_string err)
48
59
49
60
(* Mark emails as read *)
50
-
Email.mark_as_seen ctx ~account_id ~email_ids:["email1"; "email2"] ()
51
-
52
-
(* Move emails to another mailbox *)
53
-
Email.move_emails ctx ~account_id ~email_ids ~mailbox_id ()
61
+
let mark_read env ctx account_id email_ids =
62
+
match Email.mark_as_seen env ctx ~account_id ~email_ids () with
63
+
| Ok () -> Printf.printf "Marked %d emails as read\n" (List.length email_ids)
64
+
| Error err -> Printf.eprintf "Mark error: %s\n" (Jmap.Error.to_string err)
54
65
```
55
66
56
67
## Dependencies
57
68
58
69
- jmap (core library)
59
70
- jmap-email (email types and helpers)
60
-
- yojson
61
-
- uri
62
-
- unix
71
+
- eio (structured concurrency)
72
+
- tls-eio (TLS support)
73
+
- cohttp-eio (HTTP client)
74
+
- yojson (JSON handling)
75
+
- uri (URL parsing)
+56
-57
jmap/jmap-unix/jmap_unix.ml
+56
-57
jmap/jmap-unix/jmap_unix.ml
···
16
16
*)
17
17
18
18
(* Core JMAP protocol for transport layer *)
19
-
open Jmap.Protocol
20
19
21
20
(* Email-layer imports - using proper jmap-email abstractions *)
22
21
module JmapEmail = Jmap_email
23
-
(* module JmapEmailQuery = Jmap_email_query (* Module interface issue - will implement later *) *)
22
+
(* module JmapEmailQuery = Jmap_email.Query (* Module interface issue - will implement later *) *)
24
23
25
24
26
25
(* Simple Base64 encoding function *)
···
76
75
| Connected of Uri.t (* Base URL for API calls *)
77
76
78
77
type context = {
79
-
mutable session : Session.Session.t option;
78
+
mutable session : Jmap.Session.Session.t option;
80
79
mutable base_url : Uri.t option;
81
80
mutable auth : auth_method;
82
81
config : client_config;
···
86
85
type request_builder = {
87
86
ctx : context;
88
87
mutable using : string list;
89
-
mutable method_calls : Wire.Invocation.t list;
88
+
mutable method_calls : Jmap.Wire.Invocation.t list;
90
89
}
91
90
92
91
let default_tls_config () = {
···
211
210
if status_code >= 200 && status_code < 300 then
212
211
Ok body_content
213
212
else
214
-
Error (Jmap.Protocol.Error.Transport
213
+
Error (Jmap.Error.Transport
215
214
(Printf.sprintf "HTTP error %d: %s" status_code body_content))
216
215
with
217
216
| exn ->
218
-
Error (Jmap.Protocol.Error.Transport
217
+
Error (Jmap.Error.Transport
219
218
(Printf.sprintf "Network error: %s" (Printexc.to_string exn)))
220
219
221
220
(* Discover JMAP session endpoint *)
···
227
226
let json = Yojson.Safe.from_string response_body in
228
227
match Yojson.Safe.Util.member "apiUrl" json with
229
228
| `String api_url -> Ok (Uri.of_string api_url)
230
-
| _ -> Error (Jmap.Protocol.Error.Protocol "Invalid session discovery response")
229
+
| _ -> Error (Jmap.Error.Protocol "Invalid session discovery response")
231
230
with
232
231
| Yojson.Json_error msg ->
233
-
Error (Jmap.Protocol.Error.Protocol ("JSON parse error: " ^ msg)))
232
+
Error (Jmap.Error.Protocol ("JSON parse error: " ^ msg)))
234
233
| Error e -> Error e
235
234
236
235
let connect env ctx ?session_url ?username ~host ?(port = 443) ?(use_tls = true) ?(auth_method = No_auth) () =
···
256
255
| Ok response_body ->
257
256
(try
258
257
let json = Yojson.Safe.from_string response_body in
259
-
let session = Session.parse_session_json json in
258
+
let session = Jmap.Session.parse_session_json json in
260
259
ctx.session <- Some session;
261
260
Ok (ctx, session)
262
261
with
263
-
| exn -> Error (Jmap.Protocol.Error.Protocol
262
+
| exn -> Error (Jmap.Error.Protocol
264
263
("Failed to parse session: " ^ Printexc.to_string exn)))
265
264
| Error e -> Error e)
266
265
···
276
275
277
276
let add_method_call builder method_name arguments method_call_id =
278
277
let method_name_str = Jmap.Method_names.method_to_string method_name in
279
-
let invocation = Wire.Invocation.v ~method_name:method_name_str ~arguments ~method_call_id () in
278
+
let invocation = Jmap.Wire.Invocation.v ~method_name:method_name_str ~arguments ~method_call_id () in
280
279
builder.method_calls <- builder.method_calls @ [invocation];
281
280
builder
282
281
283
282
let create_reference result_of path =
284
-
Wire.Result_reference.v ~result_of ~name:path ~path ()
283
+
Jmap.Wire.Result_reference.v ~result_of ~name:path ~path ()
285
284
286
285
let execute env builder =
287
286
match builder.ctx.session with
288
-
| None -> Error (Jmap.Protocol.Error.Transport "Not connected")
287
+
| None -> Error (Jmap.Error.Transport "Not connected")
289
288
| Some session ->
290
-
let api_uri = Session.Session.api_url session in
289
+
let api_uri = Jmap.Session.Session.api_url session in
291
290
(* Manual JSON construction since to_json is not exposed *)
292
291
let method_calls_json = List.map (fun inv ->
293
292
`List [
294
-
`String (Wire.Invocation.method_name inv);
295
-
Wire.Invocation.arguments inv;
296
-
`String (Wire.Invocation.method_call_id inv)
293
+
`String (Jmap.Wire.Invocation.method_name inv);
294
+
Jmap.Wire.Invocation.arguments inv;
295
+
`String (Jmap.Wire.Invocation.method_call_id inv)
297
296
]
298
297
) builder.method_calls in
299
298
let request_json = `Assoc [
···
320
319
let method_name = method_name_json |> to_string in
321
320
let call_id = call_id_json |> to_string in
322
321
Printf.eprintf "DEBUG: Parsed method response: %s (call_id: %s)\n" method_name call_id;
323
-
let invocation = Wire.Invocation.v ~method_name ~arguments:args_json ~method_call_id:call_id () in
322
+
let invocation = Jmap.Wire.Invocation.v ~method_name ~arguments:args_json ~method_call_id:call_id () in
324
323
Ok invocation
325
324
| _ ->
326
325
(* If parsing fails, create an error response invocation *)
327
326
let error_msg = "Invalid method response format" in
328
-
let method_error_obj = Jmap.Protocol.Error.Method_error.v `UnknownMethod in
327
+
let method_error_obj = Jmap.Error.Method_error.v `UnknownMethod in
329
328
let method_error = (method_error_obj, error_msg) in
330
329
Error method_error
331
330
) method_responses_json in
···
333
332
(* Get session state *)
334
333
let session_state = json |> member "sessionState" |> to_string_option |> Option.value ~default:"unknown" in
335
334
336
-
let response = Wire.Response.v
335
+
let response = Jmap.Wire.Response.v
337
336
~method_responses
338
337
~session_state
339
338
()
340
339
in
341
340
Ok response
342
341
with
343
-
| exn -> Error (Jmap.Protocol.Error.Protocol
342
+
| exn -> Error (Jmap.Error.Protocol
344
343
("Failed to parse response: " ^ Printexc.to_string exn)))
345
344
| Error e -> Error e)
346
345
347
346
let request env ctx req =
348
-
let builder = { ctx; using = Wire.Request.using req; method_calls = Wire.Request.method_calls req } in
347
+
let builder = { ctx; using = Jmap.Wire.Request.using req; method_calls = Jmap.Wire.Request.method_calls req } in
349
348
execute env builder
350
349
351
350
let upload env ctx ~account_id ~content_type ~data_stream =
352
351
match ctx.base_url, ctx.session with
353
-
| None, _ -> Error (Jmap.Protocol.Error.Transport "Not connected")
354
-
| _, None -> Error (Jmap.Protocol.Error.Transport "No session")
352
+
| None, _ -> Error (Jmap.Error.Transport "Not connected")
353
+
| _, None -> Error (Jmap.Error.Transport "No session")
355
354
| Some _base_uri, Some session ->
356
-
let upload_template = Session.Session.upload_url session in
355
+
let upload_template = Jmap.Session.Session.upload_url session in
357
356
let upload_url = Uri.to_string upload_template ^ "?accountId=" ^ account_id in
358
357
let upload_uri = Uri.of_string upload_url in
359
358
let data_string = Seq.fold_left (fun acc chunk -> acc ^ chunk) "" data_stream in
···
374
373
375
374
let download env ctx ~account_id ~blob_id ?(content_type="application/octet-stream") ?(name="download") () =
376
375
match ctx.base_url, ctx.session with
377
-
| None, _ -> Error (Jmap.Protocol.Error.Transport "Not connected")
378
-
| _, None -> Error (Jmap.Protocol.Error.Transport "No session")
376
+
| None, _ -> Error (Jmap.Error.Transport "Not connected")
377
+
| _, None -> Error (Jmap.Error.Transport "No session")
379
378
| Some _, Some session ->
380
-
let download_template = Session.Session.download_url session in
379
+
let download_template = Jmap.Session.Session.download_url session in
381
380
let params = [
382
381
("accountId", account_id);
383
382
("blobId", blob_id);
···
396
395
397
396
let copy_blobs env ctx ~from_account_id ~account_id ~blob_ids =
398
397
match ctx.base_url with
399
-
| None -> Error (Jmap.Protocol.Error.Transport "Not connected")
398
+
| None -> Error (Jmap.Error.Transport "Not connected")
400
399
| Some _base_uri ->
401
400
let args = `Assoc [
402
401
("fromAccountId", `String from_account_id);
···
453
452
let _ = ignore req in
454
453
(* WebSocket send implementation would go here *)
455
454
(* For now, return a placeholder response *)
456
-
let response = Wire.Response.v
455
+
let response = Jmap.Wire.Response.v
457
456
~method_responses:[]
458
457
~session_state:"state"
459
458
()
···
521
520
let base_args = [
522
521
("accountId", `String account_id);
523
522
("ids", `Assoc [("#", `Assoc [
524
-
("resultOf", `String (Wire.Result_reference.result_of result_reference));
525
-
("name", `String (Wire.Result_reference.name result_reference));
526
-
("path", `String (Wire.Result_reference.path result_reference));
523
+
("resultOf", `String (Jmap.Wire.Result_reference.result_of result_reference));
524
+
("name", `String (Jmap.Wire.Result_reference.name result_reference));
525
+
("path", `String (Jmap.Wire.Result_reference.path result_reference));
527
526
])]);
528
527
] in
529
528
let args_with_props = match properties with
···
536
535
537
536
(** Convert the request builder to a JMAP Request object *)
538
537
let to_request builder =
539
-
Wire.Request.v ~using:builder.using ~method_calls:builder.method_calls ()
538
+
Jmap.Wire.Request.v ~using:builder.using ~method_calls:builder.method_calls ()
540
539
end
541
540
542
541
module Email = struct
···
652
651
- RFC reference: RFC 8621 Section 4.2
653
652
- Priority: High
654
653
- Dependencies: Jmap_email.of_json implementation *)
655
-
| Ok _ -> Error (Jmap.Protocol.Error.Method (`InvalidArguments, Some "Email parsing not implemented"))
654
+
| Ok _ -> Error (Jmap.Error.Method (`InvalidArguments, Some "Email parsing not implemented"))
656
655
| Error e -> Error e
657
656
658
657
let search_emails env ctx ~account_id ~filter ?sort ?limit ?position ?properties () =
···
703
702
- RFC reference: RFC 8621 Section 4.3
704
703
- Priority: High
705
704
- Dependencies: Email patch operations *)
706
-
Error (Jmap.Protocol.Error.Method (`InvalidArguments, Some "mark_seen not implemented"))
705
+
Error (Jmap.Error.Method (`InvalidArguments, Some "mark_seen not implemented"))
707
706
708
707
let mark_as_unseen _env _ctx ~account_id ~email_ids:_ () =
709
708
let _ = ignore account_id in
···
713
712
- RFC reference: RFC 8621 Section 4.3
714
713
- Priority: High
715
714
- Dependencies: Email patch operations *)
716
-
Error (Jmap.Protocol.Error.Method (`InvalidArguments, Some "mark_unseen not implemented"))
715
+
Error (Jmap.Error.Method (`InvalidArguments, Some "mark_unseen not implemented"))
717
716
718
717
let move_emails _env _ctx ~account_id:_ ~email_ids:_ ~mailbox_id:_ ?remove_from_mailboxes:_ () =
719
718
(* TODO: Implement email move functionality
···
722
721
- RFC reference: RFC 8621 Section 4.3
723
722
- Priority: High
724
723
- Dependencies: Mailbox management, Email patches *)
725
-
Error (Jmap.Protocol.Error.Method (`InvalidArguments, Some "move_emails not implemented"))
724
+
Error (Jmap.Error.Method (`InvalidArguments, Some "move_emails not implemented"))
726
725
727
726
let import_email env ctx ~account_id ~rfc822 ~mailbox_ids ?keywords ?received_at () =
728
727
let _ = ignore rfc822 in
···
754
753
Jmap_email.of_json json
755
754
756
755
let from_json_address json =
757
-
Jmap_email_address.of_json json
756
+
Jmap_email.Address.of_json json
758
757
759
758
let from_json_keywords json =
760
-
Jmap_email_keywords.of_json json *)
759
+
Jmap_email.Keywords.of_json json *)
761
760
end
762
761
763
762
module Auth = struct
···
776
775
777
776
module Session_utils = struct
778
777
let print_session_info session =
779
-
let open Jmap.Protocol.Session.Session in
778
+
let open Jmap.Session.Session in
780
779
Printf.printf "JMAP Session Information:\n";
781
780
Printf.printf " Username: %s\n" (username session);
782
781
Printf.printf " API URL: %s\n" (Uri.to_string (api_url session));
···
795
794
Printf.printf " Accounts:\n";
796
795
let accounts = accounts session in
797
796
Hashtbl.iter (fun account_id account ->
798
-
let open Jmap.Protocol.Session.Account in
797
+
let open Jmap.Session.Account in
799
798
Printf.printf " - %s: %s (%b)\n"
800
799
account_id
801
800
(name account)
···
804
803
print_endline ""
805
804
806
805
let get_primary_mail_account session =
807
-
let open Jmap.Protocol.Session.Session in
806
+
let open Jmap.Session.Session in
808
807
let primary_accs = primary_accounts session in
809
808
try
810
809
Hashtbl.find primary_accs (Jmap.Protocol.Capability.to_string `Mail)
···
819
818
module Response = struct
820
819
let extract_method ~method_name ~method_call_id response =
821
820
let method_name_str = Jmap.Method_names.method_to_string method_name in
822
-
let method_responses = Jmap.Protocol.Wire.Response.method_responses response in
821
+
let method_responses = Jmap.Wire.Response.method_responses response in
823
822
let find_response = List.find_map (function
824
823
| Ok invocation ->
825
-
if Jmap.Protocol.Wire.Invocation.method_call_id invocation = method_call_id &&
826
-
Jmap.Protocol.Wire.Invocation.method_name invocation = method_name_str then
827
-
Some (Jmap.Protocol.Wire.Invocation.arguments invocation)
824
+
if Jmap.Wire.Invocation.method_call_id invocation = method_call_id &&
825
+
Jmap.Wire.Invocation.method_name invocation = method_name_str then
826
+
Some (Jmap.Wire.Invocation.arguments invocation)
828
827
else None
829
828
| Error _ -> None
830
829
) method_responses in
831
830
match find_response with
832
831
| Some response_args -> Ok response_args
833
-
| None -> Error (Jmap.Protocol.Error.protocol_error
832
+
| None -> Error (Jmap.Error.protocol_error
834
833
(Printf.sprintf "%s response (call_id: %s) not found" method_name_str method_call_id))
835
834
836
835
let extract_method_by_name ~method_name response =
837
836
let method_name_str = Jmap.Method_names.method_to_string method_name in
838
-
let method_responses = Jmap.Protocol.Wire.Response.method_responses response in
837
+
let method_responses = Jmap.Wire.Response.method_responses response in
839
838
let find_response = List.find_map (function
840
839
| Ok invocation ->
841
-
if Jmap.Protocol.Wire.Invocation.method_name invocation = method_name_str then
842
-
Some (Jmap.Protocol.Wire.Invocation.arguments invocation)
840
+
if Jmap.Wire.Invocation.method_name invocation = method_name_str then
841
+
Some (Jmap.Wire.Invocation.arguments invocation)
843
842
else None
844
843
| Error _ -> None
845
844
) method_responses in
846
845
match find_response with
847
846
| Some response_args -> Ok response_args
848
-
| None -> Error (Jmap.Protocol.Error.protocol_error
847
+
| None -> Error (Jmap.Error.protocol_error
849
848
(Printf.sprintf "%s response not found" method_name_str))
850
849
end
851
850
···
1052
1051
let list_json = json |> member "list" |> to_list in
1053
1052
Ok list_json
1054
1053
with
1055
-
| exn -> Error (Jmap.Protocol.Error.protocol_error
1054
+
| exn -> Error (Jmap.Error.protocol_error
1056
1055
("Failed to parse Email/get list: " ^ Printexc.to_string exn)))
1057
1056
| Error e -> Error e
1058
1057
end
···
1071
1070
let list_json = json |> member "list" |> to_list in
1072
1071
Ok list_json
1073
1072
with
1074
-
| exn -> Error (Jmap.Protocol.Error.protocol_error
1073
+
| exn -> Error (Jmap.Error.protocol_error
1075
1074
("Failed to parse Thread/get list: " ^ Printexc.to_string exn)))
1076
1075
| Error e -> Error e
1077
1076
end
···
1090
1089
let list_json = json |> member "list" |> to_list in
1091
1090
Ok list_json
1092
1091
with
1093
-
| exn -> Error (Jmap.Protocol.Error.protocol_error
1092
+
| exn -> Error (Jmap.Error.protocol_error
1094
1093
("Failed to parse Mailbox/get list: " ^ Printexc.to_string exn)))
1095
1094
| Error e -> Error e
1096
1095
end
···
1325
1324
| Error e -> Error e)
1326
1325
| Error e -> Error e
1327
1326
with
1328
-
| exn -> Error (Jmap.Protocol.Error.protocol_error
1327
+
| exn -> Error (Jmap.Error.protocol_error
1329
1328
("Failed to parse mailbox: " ^ Printexc.to_string exn)))
1330
-
| Ok None -> Error (Jmap.Protocol.Error.protocol_error
1329
+
| Ok None -> Error (Jmap.Error.protocol_error
1331
1330
("Mailbox with role '" ^ mailbox_role ^ "' not found"))
1332
1331
| Error e -> Error e
1333
1332
+77
-78
jmap/jmap-unix/jmap_unix.mli
+77
-78
jmap/jmap-unix/jmap_unix.mli
···
78
78
?use_tls:bool ->
79
79
?auth_method:auth_method ->
80
80
unit ->
81
-
(context * Jmap.Protocol.Session.Session.t) Jmap.Protocol.Error.result
81
+
(context * Jmap.Session.Session.t) Jmap.Error.result
82
82
83
83
(** Create a request builder for constructing a JMAP request.
84
84
@param ctx The client context.
···
91
91
@param capabilities List of capability variants to use.
92
92
@return The updated request builder.
93
93
*)
94
-
val using : request_builder -> Jmap.Protocol.Capability.t list -> request_builder
94
+
val using : request_builder -> Jmap.Capability.t list -> request_builder
95
95
96
96
(** Add a method call to a request builder.
97
97
@param builder The request builder.
···
112
112
@param name Path in the response.
113
113
@return A ResultReference to use in another method call.
114
114
*)
115
-
val create_reference : string -> string -> Jmap.Protocol.Wire.Result_reference.t
115
+
val create_reference : string -> string -> Jmap.Wire.Result_reference.t
116
116
117
117
(** Execute a request and return the response.
118
118
@param env The Eio environment for network operations.
119
119
@param builder The request builder to execute.
120
120
@return The JMAP response from the server.
121
121
*)
122
-
val execute : < net : 'a Eio.Net.t ; .. > -> request_builder -> Jmap.Protocol.Wire.Response.t Jmap.Protocol.Error.result
122
+
val execute : < net : 'a Eio.Net.t ; .. > -> request_builder -> Jmap.Wire.Response.t Jmap.Error.result
123
123
124
124
(** Perform a JMAP API request.
125
125
@param env The Eio environment for network operations.
···
127
127
@param request The JMAP request object.
128
128
@return The JMAP response from the server.
129
129
*)
130
-
val request : < net : 'a Eio.Net.t ; .. > -> context -> Jmap.Protocol.Wire.Request.t -> Jmap.Protocol.Wire.Response.t Jmap.Protocol.Error.result
130
+
val request : < net : 'a Eio.Net.t ; .. > -> context -> Jmap.Wire.Request.t -> Jmap.Wire.Response.t Jmap.Error.result
131
131
132
132
(** Upload binary data.
133
133
@param env The Eio environment for network operations.
···
143
143
account_id:Jmap.Types.id ->
144
144
content_type:string ->
145
145
data_stream:string Seq.t ->
146
-
Jmap.Binary.Upload_response.t Jmap.Protocol.Error.result
146
+
Jmap.Binary.Upload_response.t Jmap.Error.result
147
147
148
148
(** Download binary data.
149
149
@param env The Eio environment for network operations.
···
162
162
?content_type:string ->
163
163
?name:string ->
164
164
unit ->
165
-
(string Seq.t) Jmap.Protocol.Error.result
165
+
(string Seq.t) Jmap.Error.result
166
166
167
167
(** Copy blobs between accounts.
168
168
@param env The Eio environment for network operations.
···
178
178
from_account_id:Jmap.Types.id ->
179
179
account_id:Jmap.Types.id ->
180
180
blob_ids:Jmap.Types.id list ->
181
-
Jmap.Binary.Blob_copy_response.t Jmap.Protocol.Error.result
181
+
Jmap.Binary.Blob_copy_response.t Jmap.Error.result
182
182
183
183
(** Connect to the EventSource for push notifications.
184
184
@param env The Eio environment for network operations.
···
196
196
?ping:Jmap.Types.uint ->
197
197
unit ->
198
198
(event_source_connection *
199
-
([`State of Jmap.Push.State_change.t | `Ping of Jmap.Push.Event_source_ping_data.t ] Seq.t)) Jmap.Protocol.Error.result
199
+
([`State of Jmap.Push.State_change.t | `Ping of Jmap.Push.Event_source_ping_data.t ] Seq.t)) Jmap.Error.result
200
200
201
201
(** Create a websocket connection for JMAP over WebSocket.
202
202
@param env The Eio environment for network operations.
···
206
206
val connect_websocket :
207
207
< net : 'a Eio.Net.t ; .. > ->
208
208
context ->
209
-
event_source_connection Jmap.Protocol.Error.result
209
+
event_source_connection Jmap.Error.result
210
210
211
211
(** Send a message over a websocket connection.
212
212
@param env The Eio environment for network operations.
···
217
217
val websocket_send :
218
218
< net : 'a Eio.Net.t ; .. > ->
219
219
event_source_connection ->
220
-
Jmap.Protocol.Wire.Request.t ->
221
-
Jmap.Protocol.Wire.Response.t Jmap.Protocol.Error.result
220
+
Jmap.Wire.Request.t ->
221
+
Jmap.Wire.Response.t Jmap.Error.result
222
222
223
223
(** Close an EventSource or WebSocket connection.
224
224
@param conn The connection handle.
225
225
@return A result with either unit or an error.
226
226
*)
227
-
val close_connection : event_source_connection -> unit Jmap.Protocol.Error.result
227
+
val close_connection : event_source_connection -> unit Jmap.Error.result
228
228
229
229
(** Close the JMAP connection context.
230
230
@return A result with either unit or an error.
231
231
*)
232
-
val close : context -> unit Jmap.Protocol.Error.result
232
+
val close : context -> unit Jmap.Error.result
233
233
234
234
(** {2 Helper Methods for Common Tasks} *)
235
235
···
250
250
object_id:Jmap.Types.id ->
251
251
?properties:string list ->
252
252
unit ->
253
-
Yojson.Safe.t Jmap.Protocol.Error.result
253
+
Yojson.Safe.t Jmap.Error.result
254
254
255
255
(** Helper to set up the connection with minimal options.
256
256
@param env The Eio environment for network operations.
···
269
269
?use_tls:bool ->
270
270
?port:int ->
271
271
unit ->
272
-
(context * Jmap.Protocol.Session.Session.t) Jmap.Protocol.Error.result
272
+
(context * Jmap.Session.Session.t) Jmap.Error.result
273
273
274
274
(** Perform a Core/echo request to test connectivity.
275
275
@param env The Eio environment for network operations.
···
282
282
context ->
283
283
?data:Yojson.Safe.t ->
284
284
unit ->
285
-
Yojson.Safe.t Jmap.Protocol.Error.result
285
+
Yojson.Safe.t Jmap.Error.result
286
286
287
287
(** {2 Request Builder Pattern} *)
288
288
···
294
294
(** Create a new request builder with specified capabilities.
295
295
@param using List of capability variants to use in the request
296
296
@return A new request builder with the specified capabilities *)
297
-
val create : using:Jmap.Protocol.Capability.t list -> context -> t
297
+
val create : using:Jmap.Capability.t list -> context -> t
298
298
299
299
(** Add a query method call to the request builder.
300
300
@param t The request builder
···
334
334
t ->
335
335
method_name:Jmap.Method_names.jmap_method ->
336
336
account_id:Jmap.Types.id ->
337
-
result_reference:Jmap.Protocol.Wire.Result_reference.t ->
337
+
result_reference:Jmap.Wire.Result_reference.t ->
338
338
?properties:string list ->
339
339
method_call_id:string ->
340
340
unit ->
···
343
343
(** Convert the request builder to a JMAP Request object.
344
344
@param t The request builder
345
345
@return A JMAP Request ready to be sent *)
346
-
val to_request : t -> Jmap.Protocol.Wire.Request.t
346
+
val to_request : t -> Jmap.Wire.Request.t
347
347
end
348
348
349
349
(** {2 Email Operations} *)
350
350
351
351
(** High-level email operations that map to JMAP email methods *)
352
352
module Email : sig
353
-
open Jmap_email
354
353
355
354
(** Arguments for Email/query method calls.
356
355
···
446
445
email_id:Jmap.Types.id ->
447
446
?properties:string list ->
448
447
unit ->
449
-
t Jmap.Protocol.Error.result
448
+
Jmap_email.Email.t Jmap.Error.result
450
449
451
450
(** Search for emails using a filter
452
451
@param env The Eio environment for network operations
···
468
467
?position:int ->
469
468
?properties:string list ->
470
469
unit ->
471
-
(Jmap.Types.id list * t list option) Jmap.Protocol.Error.result
470
+
(Jmap.Types.id list * Jmap_email.Email.t list option) Jmap.Error.result
472
471
473
472
(** Mark multiple emails with a keyword
474
473
@param env The Eio environment for network operations
···
483
482
context ->
484
483
account_id:Jmap.Types.id ->
485
484
email_ids:Jmap.Types.id list ->
486
-
keyword:Jmap_email.Email_keywords.keyword ->
485
+
keyword:Jmap_email.Keywords.keyword ->
487
486
unit ->
488
-
unit Jmap.Protocol.Error.result
487
+
unit Jmap.Error.result
489
488
490
489
(** Mark emails as seen/read
491
490
@param env The Eio environment for network operations
···
500
499
account_id:Jmap.Types.id ->
501
500
email_ids:Jmap.Types.id list ->
502
501
unit ->
503
-
unit Jmap.Protocol.Error.result
502
+
unit Jmap.Error.result
504
503
505
504
(** Mark emails as unseen/unread
506
505
@param env The Eio environment for network operations
···
515
514
account_id:Jmap.Types.id ->
516
515
email_ids:Jmap.Types.id list ->
517
516
unit ->
518
-
unit Jmap.Protocol.Error.result
517
+
unit Jmap.Error.result
519
518
520
519
(** Move emails to a different mailbox
521
520
@param env The Eio environment for network operations
···
534
533
mailbox_id:Jmap.Types.id ->
535
534
?remove_from_mailboxes:Jmap.Types.id list ->
536
535
unit ->
537
-
unit Jmap.Protocol.Error.result
536
+
unit Jmap.Error.result
538
537
539
538
(** Import an RFC822 message
540
539
@param env The Eio environment for network operations
···
552
551
account_id:Jmap.Types.id ->
553
552
rfc822:string ->
554
553
mailbox_ids:Jmap.Types.id list ->
555
-
?keywords:Jmap_email.Email_keywords.t ->
554
+
?keywords:Jmap_email.Keywords.t ->
556
555
?received_at:Jmap.Types.date ->
557
556
unit ->
558
-
Jmap.Types.id Jmap.Protocol.Error.result
557
+
Jmap.Types.id Jmap.Error.result
559
558
560
559
(** {2 JSON Parsing Functions} *)
561
560
···
585
584
@return Parsed Keywords set
586
585
587
586
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1.1> RFC 8621, Section 4.1.1 *)
588
-
val from_json_keywords : Yojson.Safe.t -> Jmap_email.Email_keywords.t *)
587
+
val from_json_keywords : Yojson.Safe.t -> Jmap_email.Keywords.t *)
589
588
end
590
589
591
590
(** {2 Utility Functions} *)
···
606
605
module Session_utils : sig
607
606
(** Print detailed session information to stdout for debugging.
608
607
@param session The JMAP session to display *)
609
-
val print_session_info : Jmap.Protocol.Session.Session.t -> unit
608
+
val print_session_info : Jmap.Session.Session.t -> unit
610
609
611
610
(** Get the primary mail account ID from a session.
612
611
Falls back to the first available account if no primary mail account is found.
613
612
@param session The JMAP session
614
613
@return The account ID to use for mail operations *)
615
-
val get_primary_mail_account : Jmap.Protocol.Session.Session.t -> Jmap.Types.id
614
+
val get_primary_mail_account : Jmap.Session.Session.t -> Jmap.Types.id
616
615
end
617
616
618
617
(** Response utilities for extracting data from JMAP responses *)
···
625
624
val extract_method :
626
625
method_name:Jmap.Method_names.jmap_method ->
627
626
method_call_id:string ->
628
-
Jmap.Protocol.Wire.Response.t ->
629
-
Yojson.Safe.t Jmap.Protocol.Error.result
627
+
Jmap.Wire.Response.t ->
628
+
Yojson.Safe.t Jmap.Error.result
630
629
631
630
(** Extract the first method response with a given name, ignoring call ID.
632
631
@param method_name Typed method name to search for
···
634
633
@return The method response arguments or an error *)
635
634
val extract_method_by_name :
636
635
method_name:Jmap.Method_names.jmap_method ->
637
-
Jmap.Protocol.Wire.Response.t ->
638
-
Yojson.Safe.t Jmap.Protocol.Error.result
636
+
Jmap.Wire.Response.t ->
637
+
Yojson.Safe.t Jmap.Error.result
639
638
end
640
639
641
640
(** {2 Email High-Level Operations} *)
···
662
661
(** Add Email/get method with automatic result reference *)
663
662
val email_get :
664
663
?account_id:Jmap.Types.id ->
665
-
?ids:Jmap.Id.t list ->
664
+
?ids:Jmap.Types.Id.t list ->
666
665
?properties:string list ->
667
666
?reference_from:string -> (* Call ID to reference *)
668
667
t -> t
···
671
670
val email_set :
672
671
?account_id:Jmap.Types.id ->
673
672
?create:(string * Yojson.Safe.t) list ->
674
-
?update:(Jmap.Id.t * Jmap.Patch.t) list ->
675
-
?destroy:Jmap.Id.t list ->
673
+
?update:(Jmap.Types.Id.t * Jmap.Types.Patch.t) list ->
674
+
?destroy:Jmap.Types.Id.t list ->
676
675
t -> t
677
676
678
677
(** Add Thread/get method *)
679
678
val thread_get :
680
679
?account_id:Jmap.Types.id ->
681
-
?ids:Jmap.Id.t list ->
680
+
?ids:Jmap.Types.Id.t list ->
682
681
t -> t
683
682
684
683
(** Add Mailbox/query method *)
···
691
690
(** Add Mailbox/get method *)
692
691
val mailbox_get :
693
692
?account_id:Jmap.Types.id ->
694
-
?ids:Jmap.Id.t list ->
693
+
?ids:Jmap.Types.Id.t list ->
695
694
t -> t
696
695
697
696
(** Execute the built request *)
698
697
val execute :
699
698
< net : 'a Eio.Net.t ; .. > ->
700
-
session:Jmap.Protocol.Session.Session.t ->
699
+
session:Jmap.Session.Session.t ->
701
700
t ->
702
-
(Jmap.Protocol.Wire.Response.t, Jmap.Protocol.Error.error) result
701
+
(Jmap.Wire.Response.t, Jmap.Error.error) result
703
702
704
703
(** Get specific method response by type *)
705
704
val get_response :
706
705
method_:Jmap.Method_names.jmap_method ->
707
706
?call_id:string ->
708
-
Jmap.Protocol.Wire.Response.t ->
709
-
(Yojson.Safe.t, Jmap.Protocol.Error.error) result
707
+
Jmap.Wire.Response.t ->
708
+
(Yojson.Safe.t, Jmap.Error.error) result
710
709
end
711
710
712
711
(** Response parsing functions *)
···
714
713
(** Extract and parse Email/query response *)
715
714
val parse_email_query :
716
715
?call_id:string ->
717
-
Jmap.Protocol.Wire.Response.t ->
718
-
(Yojson.Safe.t, Jmap.Protocol.Error.error) result
716
+
Jmap.Wire.Response.t ->
717
+
(Yojson.Safe.t, Jmap.Error.error) result
719
718
720
719
(** Extract and parse Email/get response *)
721
720
val parse_email_get :
722
721
?call_id:string ->
723
-
Jmap.Protocol.Wire.Response.t ->
724
-
(Yojson.Safe.t list, Jmap.Protocol.Error.error) result
722
+
Jmap.Wire.Response.t ->
723
+
(Yojson.Safe.t list, Jmap.Error.error) result
725
724
726
725
(** Extract and parse Thread/get response *)
727
726
val parse_thread_get :
728
727
?call_id:string ->
729
-
Jmap.Protocol.Wire.Response.t ->
730
-
(Yojson.Safe.t list, Jmap.Protocol.Error.error) result
728
+
Jmap.Wire.Response.t ->
729
+
(Yojson.Safe.t list, Jmap.Error.error) result
731
730
732
731
(** Extract and parse Mailbox/get response *)
733
732
val parse_mailbox_get :
734
733
?call_id:string ->
735
-
Jmap.Protocol.Wire.Response.t ->
736
-
(Yojson.Safe.t list, Jmap.Protocol.Error.error) result
734
+
Jmap.Wire.Response.t ->
735
+
(Yojson.Safe.t list, Jmap.Error.error) result
737
736
end
738
737
739
738
(** Common email operation patterns *)
···
742
741
val query_and_fetch :
743
742
< net : 'a Eio.Net.t ; .. > ->
744
743
ctx:context ->
745
-
session:Jmap.Protocol.Session.Session.t ->
744
+
session:Jmap.Session.Session.t ->
746
745
?account_id:Jmap.Types.id ->
747
746
?filter:Yojson.Safe.t ->
748
747
?sort:Jmap.Methods.Comparator.t list ->
749
748
?limit:int ->
750
749
?properties:string list ->
751
750
unit ->
752
-
(Yojson.Safe.t list, Jmap.Protocol.Error.error) result
751
+
(Yojson.Safe.t list, Jmap.Error.error) result
753
752
754
753
(** Get emails by IDs *)
755
754
val get_emails_by_ids :
756
755
< net : 'a Eio.Net.t ; .. > ->
757
756
ctx:context ->
758
-
session:Jmap.Protocol.Session.Session.t ->
757
+
session:Jmap.Session.Session.t ->
759
758
?account_id:Jmap.Types.id ->
760
759
?properties:string list ->
761
-
Jmap.Id.t list ->
762
-
(Yojson.Safe.t list, Jmap.Protocol.Error.error) result
760
+
Jmap.Types.Id.t list ->
761
+
(Yojson.Safe.t list, Jmap.Error.error) result
763
762
764
763
(** Get all mailboxes *)
765
764
val get_mailboxes :
766
765
< net : 'a Eio.Net.t ; .. > ->
767
766
ctx:context ->
768
-
session:Jmap.Protocol.Session.Session.t ->
767
+
session:Jmap.Session.Session.t ->
769
768
?account_id:Jmap.Types.id ->
770
769
unit ->
771
-
(Yojson.Safe.t list, Jmap.Protocol.Error.error) result
770
+
(Yojson.Safe.t list, Jmap.Error.error) result
772
771
773
772
(** Find mailbox by role (e.g., "inbox", "sent", "drafts") *)
774
773
val find_mailbox_by_role :
775
774
< net : 'a Eio.Net.t ; .. > ->
776
775
ctx:context ->
777
-
session:Jmap.Protocol.Session.Session.t ->
776
+
session:Jmap.Session.Session.t ->
778
777
?account_id:Jmap.Types.id ->
779
778
string ->
780
-
(Yojson.Safe.t option, Jmap.Protocol.Error.error) result
779
+
(Yojson.Safe.t option, Jmap.Error.error) result
781
780
end
782
781
783
782
(** {2 Email Query Operations} *)
···
789
788
val execute_query :
790
789
< net : 'a Eio.Net.t ; .. > ->
791
790
ctx:context ->
792
-
session:Jmap.Protocol.Session.Session.t ->
791
+
session:Jmap.Session.Session.t ->
793
792
Yojson.Safe.t ->
794
-
(Yojson.Safe.t, Jmap.Protocol.Error.error) result
793
+
(Yojson.Safe.t, Jmap.Error.error) result
795
794
796
795
(** Execute query and automatically fetch email data *)
797
796
val execute_with_fetch :
798
797
< net : 'a Eio.Net.t ; .. > ->
799
798
ctx:context ->
800
-
session:Jmap.Protocol.Session.Session.t ->
799
+
session:Jmap.Session.Session.t ->
801
800
Yojson.Safe.t ->
802
-
(Yojson.Safe.t, Jmap.Protocol.Error.error) result
801
+
(Yojson.Safe.t, Jmap.Error.error) result
803
802
804
803
end
805
804
···
812
811
val execute :
813
812
< net : 'a Eio.Net.t ; .. > ->
814
813
ctx:context ->
815
-
session:Jmap.Protocol.Session.Session.t ->
814
+
session:Jmap.Session.Session.t ->
816
815
?account_id:Jmap.Types.id ->
817
816
Yojson.Safe.t ->
818
-
(Yojson.Safe.t, Jmap.Protocol.Error.error) result
817
+
(Yojson.Safe.t, Jmap.Error.error) result
819
818
820
819
(** Common batch workflow operations *)
821
820
···
823
822
val process_inbox :
824
823
< net : 'a Eio.Net.t ; .. > ->
825
824
ctx:context ->
826
-
session:Jmap.Protocol.Session.Session.t ->
827
-
email_ids:Jmap.Id.t list ->
828
-
(Yojson.Safe.t, Jmap.Protocol.Error.error) result
825
+
session:Jmap.Session.Session.t ->
826
+
email_ids:Jmap.Types.Id.t list ->
827
+
(Yojson.Safe.t, Jmap.Error.error) result
829
828
830
829
(** Bulk delete spam/trash emails older than N days *)
831
830
val cleanup_old_emails :
832
831
< net : 'a Eio.Net.t ; .. > ->
833
832
ctx:context ->
834
-
session:Jmap.Protocol.Session.Session.t ->
833
+
session:Jmap.Session.Session.t ->
835
834
mailbox_role:string -> (* "spam" or "trash" *)
836
835
older_than_days:int ->
837
-
(Yojson.Safe.t, Jmap.Protocol.Error.error) result
836
+
(Yojson.Safe.t, Jmap.Error.error) result
838
837
839
838
(** Organize emails by sender into mailboxes *)
840
839
val organize_by_sender :
841
840
< net : 'a Eio.Net.t ; .. > ->
842
841
ctx:context ->
843
-
session:Jmap.Protocol.Session.Session.t ->
842
+
session:Jmap.Session.Session.t ->
844
843
rules:(string * string) list -> (* sender email -> mailbox name *)
845
-
(Yojson.Safe.t, Jmap.Protocol.Error.error) result
844
+
(Yojson.Safe.t, Jmap.Error.error) result
846
845
847
846
(** Progress callback for long operations *)
848
847
type progress = {
···
855
854
val execute_with_progress :
856
855
< net : 'a Eio.Net.t ; .. > ->
857
856
ctx:context ->
858
-
session:Jmap.Protocol.Session.Session.t ->
857
+
session:Jmap.Session.Session.t ->
859
858
?account_id:Jmap.Types.id ->
860
859
progress_fn:(progress -> unit) ->
861
860
Yojson.Safe.t ->
862
-
(Yojson.Safe.t, Jmap.Protocol.Error.error) result
861
+
(Yojson.Safe.t, Jmap.Error.error) result
863
862
end
+4
-8
jmap/jmap/dune
+4
-8
jmap/jmap/dune
···
4
4
(libraries yojson uri unix base64 jmap-sigs)
5
5
(modules
6
6
jmap
7
-
jmap_id
8
-
jmap_date
9
-
jmap_uint
10
-
jmap_patch
11
-
jmap_types
12
-
jmap_error
13
-
jmap_wire
7
+
types
8
+
wire
9
+
session
10
+
error
14
11
jmap_capability
15
-
jmap_session
16
12
jmap_methods
17
13
jmap_method_names
18
14
jmap_binary
+16
-12
jmap/jmap/jmap.ml
+16
-12
jmap/jmap/jmap.ml
···
1
-
module Id = Jmap_id
2
-
3
-
module Date = Jmap_date
1
+
module Types = Types
4
2
5
-
module UInt = Jmap_uint
6
-
7
-
module Patch = Jmap_patch
3
+
(* Backwards compatibility aliases *)
4
+
module Id = Types.Id
5
+
module Date = Types.Date
6
+
module UInt = Types.UInt
7
+
module Patch = Types.Patch
8
8
9
-
module Types = Jmap_types
9
+
module Capability = Jmap_capability
10
10
11
11
module Methods = Jmap_methods
12
12
···
20
20
21
21
module Push = Jmap_push
22
22
23
+
module Wire = Wire
24
+
25
+
module Session = Session
26
+
27
+
module Error = Error
28
+
23
29
module Protocol = Jmap_protocol
24
30
25
31
module Client = Jmap_client
26
32
27
-
module Error = Jmap_error
28
-
29
33
let supports_capability = Protocol.supports_capability
30
34
31
35
let get_primary_account session capability =
···
33
37
| Ok id_str ->
34
38
(match Id.of_string id_str with
35
39
| Ok id -> Ok id
36
-
| Error msg -> Error (Protocol.Error.method_error ~description:msg `InvalidArguments))
40
+
| Error msg -> Error (Error.method_error ~description:msg `InvalidArguments))
37
41
| Error e -> Error e
38
42
39
43
let get_download_url session ~account_id ~blob_id ?name ?content_type () =
40
-
let download_url = Protocol.Session.Session.download_url session in
44
+
let download_url = Session.Session.download_url session in
41
45
let url_str = Uri.to_string download_url in
42
46
43
47
(* Convert Id.t to string for URL construction *)
···
65
69
Uri.with_query base_url query_params
66
70
67
71
let get_upload_url session ~account_id =
68
-
let upload_url = Protocol.Session.Session.upload_url session in
72
+
let upload_url = Session.Session.upload_url session in
69
73
let url_str = Uri.to_string upload_url in
70
74
71
75
(* Convert Id.t to string for URL construction *)
+82
-51
jmap/jmap/jmap.mli
+82
-51
jmap/jmap/jmap.mli
···
25
25
26
26
(** {1 Core Types and Methods} *)
27
27
28
-
(** JMAP Id data type with validation and JSON serialization
28
+
(** JMAP core types with unified interface
29
+
30
+
This module consolidates all fundamental JMAP data types including Id, Date,
31
+
UInt, Patch, and collection types. It provides both modern structured modules
32
+
and legacy type aliases for compatibility.
33
+
34
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1> RFC 8620, Section 1 *)
35
+
module Types = Types
36
+
37
+
(** {2 Backwards Compatibility Aliases} *)
38
+
39
+
(** JMAP Id data type (alias to Types.Id)
29
40
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.2> RFC 8620, Section 1.2 *)
30
-
module Id = Jmap_id
41
+
module Id = Types.Id
31
42
32
-
(** JMAP Date data type with RFC 3339 support and JSON serialization
43
+
(** JMAP Date data type (alias to Types.Date)
33
44
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.4> RFC 8620, Section 1.4 *)
34
-
module Date = Jmap_date
45
+
module Date = Types.Date
35
46
36
-
(** JMAP UnsignedInt data type with range validation and JSON serialization
47
+
(** JMAP UnsignedInt data type (alias to Types.UInt)
37
48
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.3> RFC 8620, Section 1.3 *)
38
-
module UInt = Jmap_uint
49
+
module UInt = Types.UInt
39
50
40
-
(** JMAP Patch Object for property updates and JSON serialization
51
+
(** JMAP Patch Object (alias to Types.Patch)
41
52
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.3> RFC 8620, Section 5.3 *)
42
-
module Patch = Jmap_patch
53
+
module Patch = Types.Patch
43
54
44
-
(** Basic JMAP types (legacy - prefer specific modules above)
45
-
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1> RFC 8620, Section 1 *)
46
-
module Types = Jmap_types
55
+
(** JMAP Capability management (alias to Jmap_capability)
56
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-2> RFC 8620, Section 2 *)
57
+
module Capability = Jmap_capability
47
58
48
59
(** Standard JMAP method patterns (/get, /set, /query, etc.)
49
60
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5> RFC 8620, Section 5 *)
···
71
82
72
83
(** {1 Protocol Layer} *)
73
84
85
+
(** Wire protocol types for JMAP requests and responses.
86
+
87
+
This includes the core structures for method invocations, requests,
88
+
responses, and result references that enable method call chaining.
89
+
90
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3> RFC 8620, Section 3 *)
91
+
module Wire = Wire
92
+
93
+
(** Session management and capability discovery.
94
+
95
+
Provides session resource handling, account enumeration, capability
96
+
negotiation, and service autodiscovery functionality.
97
+
98
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-2> RFC 8620, Section 2 *)
99
+
module Session = Session
100
+
101
+
(** Error types used throughout the protocol.
102
+
103
+
Comprehensive error handling including method errors, set errors,
104
+
transport errors, and unified error types with proper RFC references.
105
+
106
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.6> RFC 8620, Section 3.6 *)
107
+
module Error = Error
108
+
74
109
(** Core protocol types and utilities (Request, Response, Session, Error)
75
110
This module consolidates the wire protocol, session management, and error handling. *)
76
111
module Protocol = Jmap_protocol
···
81
116
This module provides connection management, authentication, and request handling. *)
82
117
module Client = Jmap_client
83
118
84
-
(** JMAP Error Types and Error Handling.
85
-
86
-
This module provides comprehensive error handling for the JMAP protocol, including
87
-
method-level errors, set operation errors, and transport-level errors with structured
88
-
error types that implement the ERROR_TYPE signature. *)
89
-
module Error = Jmap_error
90
-
91
119
(** {1 Example Usage}
92
120
93
121
The following example demonstrates using the Core JMAP library with the Unix implementation
94
122
to make a simple echo request.
95
123
96
124
{[
97
-
(* OCaml 5.1 required for Lwt let operators *)
98
-
open Lwt.Syntax
125
+
(* OCaml 5.1 required for Eio *)
99
126
open Jmap
100
127
open Jmap.Types
101
-
open Jmap.Protocol.Wire
128
+
open Jmap.Wire
102
129
open Jmap.Methods
103
-
open Jmap.Unix
104
130
105
-
let simple_echo_request ctx session =
131
+
let simple_echo_request env ctx session =
106
132
(* Prepare an echo invocation *)
107
133
let echo_args = Yojson.Safe.to_basic (`Assoc [
108
134
("hello", `String "world");
109
135
("array", `List [`Int 1; `Int 2; `Int 3]);
110
136
]) in
111
137
112
-
let echo_invocation = Invocation.v
138
+
let echo_invocation = Wire.Invocation.v
113
139
~method_name:"Core/echo"
114
140
~arguments:echo_args
115
141
~method_call_id:"echo1"
···
117
143
in
118
144
119
145
(* Prepare the JMAP request *)
120
-
let request = Request.v
121
-
~using:[Protocol.Capability.to_string `Core]
146
+
let request = Wire.Request.v
147
+
~using:[Jmap_capability.to_string `Core]
122
148
~method_calls:[echo_invocation]
123
149
()
124
150
in
125
151
126
152
(* Send the request *)
127
-
let* response = Jmap.Unix.request ctx request in
153
+
let response = Jmap_unix.request env ctx request in
128
154
129
155
(* Process the response *)
130
-
match Protocol.find_method_response response "echo1" with
131
-
| Some (method_name, args, _) when method_name = "Core/echo" ->
132
-
(* Echo response should contain the same arguments we sent *)
133
-
let hello_value = match Yojson.Safe.Util.member "hello" args with
134
-
| `String s -> s
135
-
| _ -> "not found"
136
-
in
137
-
Printf.printf "Echo response received: hello=%s\n" hello_value;
138
-
Lwt.return_unit
139
-
| _ ->
140
-
Printf.eprintf "Echo response not found or unexpected format\n";
141
-
Lwt.return_unit
156
+
match response with
157
+
| Ok resp -> (
158
+
match Jmap.Protocol.find_method_response resp "echo1" with
159
+
| Some (method_name, args, _) when method_name = "Core/echo" ->
160
+
(* Echo response should contain the same arguments we sent *)
161
+
let hello_value = match Yojson.Safe.Util.member "hello" args with
162
+
| `String s -> s
163
+
| _ -> "not found"
164
+
in
165
+
Printf.printf "Echo response received: hello=%s\n" hello_value
166
+
| _ ->
167
+
Printf.eprintf "Echo response not found or unexpected format\n"
168
+
)
169
+
| Error err ->
170
+
Printf.eprintf "Request failed: %s\n" (Jmap.Error.to_string err)
142
171
143
-
let main () =
144
-
(* Authentication details are placeholder *)
145
-
let credentials = "my_auth_token" in
146
-
let* (ctx, session) = Jmap.Unix.connect ~host:"jmap.example.com" ~credentials in
147
-
let* () = simple_echo_request ctx session in
148
-
Jmap.Unix.close ctx
172
+
let main env =
173
+
let ctx = Jmap_unix.create_client () in
174
+
match Jmap_unix.connect env ctx ~host:"jmap.example.com" () with
175
+
| Ok (ctx, session) ->
176
+
simple_echo_request ctx session;
177
+
ignore (Jmap_unix.close ctx)
178
+
| Error err ->
179
+
Printf.eprintf "Connection failed: %s\n" (Jmap.Error.to_string err)
149
180
150
-
(* Lwt_main.run (main ()) *)
151
-
]}
181
+
(* Eio_main.run @@ fun env -> main env *)
182
+
]}
152
183
*)
153
184
154
185
···
159
190
@param capability The capability URI to check.
160
191
@return True if supported, false otherwise.
161
192
*)
162
-
val supports_capability : Protocol.Session.Session.t -> Jmap_capability.t -> bool
193
+
val supports_capability : Session.Session.t -> Jmap_capability.t -> bool
163
194
164
195
(** Get the primary account ID for a given capability.
165
196
@param session The session object.
166
197
@param capability The capability.
167
198
@return The account ID or an error if not found.
168
199
*)
169
-
val get_primary_account : Protocol.Session.Session.t -> Jmap_capability.t -> (Id.t, Protocol.Error.error) result
200
+
val get_primary_account : Session.Session.t -> Jmap_capability.t -> (Id.t, Error.error) result
170
201
171
202
(** Get the download URL for a blob.
172
203
@param session The session object.
···
177
208
@return The download URL.
178
209
*)
179
210
val get_download_url :
180
-
Protocol.Session.Session.t ->
211
+
Session.Session.t ->
181
212
account_id:Id.t ->
182
213
blob_id:Id.t ->
183
214
?name:string ->
···
190
221
@param account_id The account ID.
191
222
@return The upload URL.
192
223
*)
193
-
val get_upload_url : Protocol.Session.Session.t -> account_id:Id.t -> Uri.t
224
+
val get_upload_url : Session.Session.t -> account_id:Id.t -> Uri.t
+2
-2
jmap/jmap/jmap_binary.ml
+2
-2
jmap/jmap/jmap_binary.ml
···
1
-
open Jmap_types
1
+
open Types
2
2
3
3
module Upload_response = struct
4
4
type t = {
···
37
37
from_account_id : id;
38
38
account_id : id;
39
39
copied : id id_map option;
40
-
not_copied : Jmap_error.Set_error.t id_map option;
40
+
not_copied : Error.Set_error.t id_map option;
41
41
}
42
42
43
43
let from_account_id t = t.from_account_id
+3
-3
jmap/jmap/jmap_binary.mli
+3
-3
jmap/jmap/jmap_binary.mli
···
12
12
13
13
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-6> RFC 8620, Section 6 *)
14
14
15
-
open Jmap_types
15
+
open Types
16
16
17
17
(** Response from uploading binary data.
18
18
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-6.1> RFC 8620, Section 6.1 *)
···
58
58
val from_account_id : t -> id
59
59
val account_id : t -> id
60
60
val copied : t -> id id_map option
61
-
val not_copied : t -> Jmap_error.Set_error.t id_map option
61
+
val not_copied : t -> Error.Set_error.t id_map option
62
62
63
63
val v :
64
64
from_account_id:id ->
65
65
account_id:id ->
66
66
?copied:id id_map ->
67
-
?not_copied:Jmap_error.Set_error.t id_map ->
67
+
?not_copied:Error.Set_error.t id_map ->
68
68
unit ->
69
69
t
70
70
end
+1
-1
jmap/jmap/jmap_client.mli
+1
-1
jmap/jmap/jmap_client.mli
-122
jmap/jmap/jmap_date.ml
-122
jmap/jmap/jmap_date.ml
···
1
-
(** JMAP Date data type implementation *)
2
-
3
-
type t = float (* Unix timestamp *)
4
-
5
-
(* Basic RFC 3339 parsing - simplified for JMAP usage *)
6
-
let parse_rfc3339 str =
7
-
try
8
-
(* Use Unix.strptime if available, otherwise simplified parsing *)
9
-
let len = String.length str in
10
-
if len < 19 then failwith "Too short for RFC 3339";
11
-
12
-
(* Extract year, month, day, hour, minute, second *)
13
-
let year = int_of_string (String.sub str 0 4) in
14
-
let month = int_of_string (String.sub str 5 2) in
15
-
let day = int_of_string (String.sub str 8 2) in
16
-
let hour = int_of_string (String.sub str 11 2) in
17
-
let minute = int_of_string (String.sub str 14 2) in
18
-
let second = int_of_string (String.sub str 17 2) in
19
-
20
-
(* Basic validation *)
21
-
if year < 1970 || year > 9999 then failwith "Invalid year";
22
-
if month < 1 || month > 12 then failwith "Invalid month";
23
-
if day < 1 || day > 31 then failwith "Invalid day";
24
-
if hour < 0 || hour > 23 then failwith "Invalid hour";
25
-
if minute < 0 || minute > 59 then failwith "Invalid minute";
26
-
if second < 0 || second > 59 then failwith "Invalid second";
27
-
28
-
(* Convert to Unix timestamp using built-in functions *)
29
-
let tm = {
30
-
Unix.tm_year = year - 1900;
31
-
tm_mon = month - 1;
32
-
tm_mday = day;
33
-
tm_hour = hour;
34
-
tm_min = minute;
35
-
tm_sec = second;
36
-
tm_wday = 0;
37
-
tm_yday = 0;
38
-
tm_isdst = false;
39
-
} in
40
-
41
-
(* Handle timezone - simplified to assume UTC for 'Z' suffix *)
42
-
let timestamp =
43
-
if len >= 20 && str.[len-1] = 'Z' then
44
-
(* UTC time - convert to UTC timestamp *)
45
-
let local_time = fst (Unix.mktime tm) in
46
-
let gm_tm = Unix.gmtime local_time in
47
-
let utc_time = fst (Unix.mktime gm_tm) in
48
-
utc_time
49
-
else if len >= 25 && (str.[len-6] = '+' || str.[len-6] = '-') then
50
-
(* Timezone offset specified *)
51
-
let sign = if str.[len-6] = '+' then -1.0 else 1.0 in
52
-
let tz_hours = int_of_string (String.sub str (len-5) 2) in
53
-
let tz_minutes = int_of_string (String.sub str (len-2) 2) in
54
-
let offset = sign *. (float_of_int tz_hours *. 3600.0 +. float_of_int tz_minutes *. 60.0) in
55
-
fst (Unix.mktime tm) +. offset
56
-
else
57
-
(* No timezone - assume local time *)
58
-
fst (Unix.mktime tm)
59
-
in
60
-
Ok timestamp
61
-
with
62
-
| Failure msg -> Error ("Invalid RFC 3339 format: " ^ msg)
63
-
| Invalid_argument _ -> Error "Invalid RFC 3339 format: parsing error"
64
-
| _ -> Error "Invalid RFC 3339 format"
65
-
66
-
let format_rfc3339 timestamp =
67
-
let tm = Unix.gmtime timestamp in
68
-
Printf.sprintf "%04d-%02d-%02dT%02d:%02d:%02dZ"
69
-
(tm.tm_year + 1900)
70
-
(tm.tm_mon + 1)
71
-
tm.tm_mday
72
-
tm.tm_hour
73
-
tm.tm_min
74
-
tm.tm_sec
75
-
76
-
let of_timestamp timestamp = timestamp
77
-
78
-
let to_timestamp date = date
79
-
80
-
let of_rfc3339 str = parse_rfc3339 str
81
-
82
-
let to_rfc3339 date = format_rfc3339 date
83
-
84
-
let now () = Unix.time ()
85
-
86
-
let validate date =
87
-
if date >= 0.0 && date <= 253402300799.0 (* 9999-12-31T23:59:59Z *) then
88
-
Ok ()
89
-
else
90
-
Error "Date timestamp out of valid range"
91
-
92
-
let equal date1 date2 =
93
-
(* Equal within 1 second precision *)
94
-
abs_float (date1 -. date2) < 1.0
95
-
96
-
let compare date1 date2 =
97
-
if date1 < date2 then -1
98
-
else if date1 > date2 then 1
99
-
else 0
100
-
101
-
let is_before date1 date2 = date1 < date2
102
-
103
-
let is_after date1 date2 = date1 > date2
104
-
105
-
let pp ppf date = Fmt.string ppf (to_rfc3339 date)
106
-
107
-
let pp_hum ppf date = Fmt.pf ppf "Date(%s)" (to_rfc3339 date)
108
-
109
-
let pp_debug ppf date =
110
-
Fmt.pf ppf "Date(%s)" (to_rfc3339 date)
111
-
112
-
let to_string_debug date =
113
-
Printf.sprintf "Date(%s)" (to_rfc3339 date)
114
-
115
-
(* JSON serialization *)
116
-
let to_json date = `String (to_rfc3339 date)
117
-
118
-
let of_json = function
119
-
| `String str -> of_rfc3339 str
120
-
| json ->
121
-
let json_str = Yojson.Safe.to_string json in
122
-
Error (Printf.sprintf "Expected JSON string for Date, got: %s" json_str)
-98
jmap/jmap/jmap_date.mli
-98
jmap/jmap/jmap_date.mli
···
1
-
(** JMAP Date data type (RFC 8620).
2
-
3
-
The Date data type is a string in RFC 3339 "date-time" format, optionally
4
-
with timezone information. For example: "2014-10-30T14:12:00+08:00" or
5
-
"2014-10-30T06:12:00Z".
6
-
7
-
In this OCaml implementation, dates are internally represented as Unix
8
-
timestamps (float) for efficient computation, with conversion to/from
9
-
RFC 3339 string format handled by the serialization functions.
10
-
11
-
{b Note}: When represented as a float, precision may be lost for sub-second
12
-
values. The implementation preserves second-level precision.
13
-
14
-
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.4> RFC 8620, Section 1.4
15
-
@see <https://www.rfc-editor.org/rfc/rfc3339.html> RFC 3339 *)
16
-
17
-
(** Abstract type representing a JMAP Date. *)
18
-
type t
19
-
20
-
(** JSON serialization interface *)
21
-
include Jmap_sigs.JSONABLE with type t := t
22
-
23
-
(** Pretty-printing interface *)
24
-
include Jmap_sigs.PRINTABLE with type t := t
25
-
26
-
(** {1 Construction and Access} *)
27
-
28
-
(** Create a Date from a Unix timestamp.
29
-
@param timestamp The Unix timestamp (seconds since epoch).
30
-
@return A Date representing the timestamp. *)
31
-
val of_timestamp : float -> t
32
-
33
-
(** Convert a Date to a Unix timestamp.
34
-
@param date The Date to convert.
35
-
@return The Unix timestamp (seconds since epoch). *)
36
-
val to_timestamp : t -> float
37
-
38
-
(** Create a Date from an RFC 3339 string.
39
-
@param str The RFC 3339 formatted string.
40
-
@return Ok with the parsed Date, or Error if the string is not valid RFC 3339. *)
41
-
val of_rfc3339 : string -> (t, string) result
42
-
43
-
(** Convert a Date to an RFC 3339 string.
44
-
@param date The Date to convert.
45
-
@return The RFC 3339 formatted string. *)
46
-
val to_rfc3339 : t -> string
47
-
48
-
(** Create a Date representing the current time.
49
-
@return A Date set to the current time. *)
50
-
val now : unit -> t
51
-
52
-
(** {1 Validation} *)
53
-
54
-
(** Validate a Date according to JMAP constraints.
55
-
@param date The Date to validate.
56
-
@return Ok () if valid, Error with description if invalid. *)
57
-
val validate : t -> (unit, string) result
58
-
59
-
(** {1 Comparison and Utilities} *)
60
-
61
-
(** Compare two Dates for equality.
62
-
@param date1 First Date.
63
-
@param date2 Second Date.
64
-
@return True if equal (within 1 second precision), false otherwise. *)
65
-
val equal : t -> t -> bool
66
-
67
-
(** Compare two Dates chronologically.
68
-
@param date1 First Date.
69
-
@param date2 Second Date.
70
-
@return Negative if date1 < date2, zero if equal, positive if date1 > date2. *)
71
-
val compare : t -> t -> int
72
-
73
-
(** Check if first Date is before second Date.
74
-
@param date1 First Date.
75
-
@param date2 Second Date.
76
-
@return True if date1 is before date2. *)
77
-
val is_before : t -> t -> bool
78
-
79
-
(** Check if first Date is after second Date.
80
-
@param date1 First Date.
81
-
@param date2 Second Date.
82
-
@return True if date1 is after date2. *)
83
-
val is_after : t -> t -> bool
84
-
85
-
(** Pretty-print a Date in RFC3339 format.
86
-
@param ppf The formatter.
87
-
@param date The Date to print. *)
88
-
val pp : Format.formatter -> t -> unit
89
-
90
-
(** Pretty-print a Date for debugging.
91
-
@param ppf The formatter.
92
-
@param date The Date to format. *)
93
-
val pp_debug : Format.formatter -> t -> unit
94
-
95
-
(** Convert a Date to a human-readable string for debugging.
96
-
@param date The Date to format.
97
-
@return A debug string representation. *)
98
-
val to_string_debug : t -> string
+1
-1
jmap/jmap/jmap_error.ml
jmap/jmap/error.ml
+1
-1
jmap/jmap/jmap_error.ml
jmap/jmap/error.ml
+1
-1
jmap/jmap/jmap_error.mli
jmap/jmap/error.mli
+1
-1
jmap/jmap/jmap_error.mli
jmap/jmap/error.mli
-54
jmap/jmap/jmap_id.ml
-54
jmap/jmap/jmap_id.ml
···
1
-
(** JMAP Id data type implementation *)
2
-
3
-
type t = string
4
-
5
-
let is_base64url_char c =
6
-
(c >= 'A' && c <= 'Z') ||
7
-
(c >= 'a' && c <= 'z') ||
8
-
(c >= '0' && c <= '9') ||
9
-
c = '-' || c = '_'
10
-
11
-
let is_valid_string str =
12
-
let len = String.length str in
13
-
len > 0 && len <= 255 &&
14
-
let rec check i =
15
-
if i >= len then true
16
-
else if is_base64url_char str.[i] then check (i + 1)
17
-
else false
18
-
in
19
-
check 0
20
-
21
-
let of_string str =
22
-
if is_valid_string str then Ok str
23
-
else
24
-
let len = String.length str in
25
-
if len = 0 then Error "Id cannot be empty"
26
-
else if len > 255 then Error "Id cannot be longer than 255 octets"
27
-
else Error "Id contains invalid characters (must be base64url alphabet only)"
28
-
29
-
let to_string id = id
30
-
31
-
let pp ppf id = Fmt.string ppf id
32
-
33
-
let pp_hum ppf id = Fmt.pf ppf "Id(%s)" id
34
-
35
-
let validate id =
36
-
if is_valid_string id then Ok ()
37
-
else Error "Invalid Id format"
38
-
39
-
let equal = String.equal
40
-
41
-
let compare = String.compare
42
-
43
-
let pp_debug ppf id = Fmt.pf ppf "Id(%s)" id
44
-
45
-
let to_string_debug id = Printf.sprintf "Id(%s)" id
46
-
47
-
(* JSON serialization *)
48
-
let to_json id = `String id
49
-
50
-
let of_json = function
51
-
| `String str -> of_string str
52
-
| json ->
53
-
let json_str = Yojson.Safe.to_string json in
54
-
Error (Printf.sprintf "Expected JSON string for Id, got: %s" json_str)
-74
jmap/jmap/jmap_id.mli
-74
jmap/jmap/jmap_id.mli
···
1
-
(** JMAP Id data type (RFC 8620).
2
-
3
-
The Id data type is a string of 1 to 255 octets in length and MUST consist
4
-
only of characters from the base64url alphabet, as defined in Section 5 of
5
-
RFC 4648. This includes ASCII alphanumeric characters, plus the characters
6
-
'-' and '_'.
7
-
8
-
Ids are used to identify JMAP objects within an account. They are assigned
9
-
by the server and are immutable once assigned. The same id MUST refer to
10
-
the same object throughout the lifetime of the object.
11
-
12
-
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.2> RFC 8620, Section 1.2 *)
13
-
14
-
(** Abstract type representing a JMAP Id. *)
15
-
type t
16
-
17
-
(** JSON serialization interface *)
18
-
include Jmap_sigs.JSONABLE with type t := t
19
-
20
-
(** Pretty-printing interface *)
21
-
include Jmap_sigs.PRINTABLE with type t := t
22
-
23
-
(** {1 Construction and Access} *)
24
-
25
-
(** Create a new Id from a string.
26
-
@param str The string representation.
27
-
@return Ok with the created Id, or Error if the string violates Id constraints. *)
28
-
val of_string : string -> (t, string) result
29
-
30
-
(** Convert an Id to its string representation.
31
-
@param id The Id to convert.
32
-
@return The string representation. *)
33
-
val to_string : t -> string
34
-
35
-
(** Pretty-print an Id.
36
-
@param ppf The formatter.
37
-
@param id The Id to print. *)
38
-
val pp : Format.formatter -> t -> unit
39
-
40
-
(** {1 Validation} *)
41
-
42
-
(** Check if a string is a valid JMAP Id.
43
-
@param str The string to validate.
44
-
@return True if the string meets Id requirements, false otherwise. *)
45
-
val is_valid_string : string -> bool
46
-
47
-
(** Validate an Id according to JMAP constraints.
48
-
@param id The Id to validate.
49
-
@return Ok () if valid, Error with description if invalid. *)
50
-
val validate : t -> (unit, string) result
51
-
52
-
(** {1 Comparison and Utilities} *)
53
-
54
-
(** Compare two Ids for equality.
55
-
@param id1 First Id.
56
-
@param id2 Second Id.
57
-
@return True if equal, false otherwise. *)
58
-
val equal : t -> t -> bool
59
-
60
-
(** Compare two Ids lexicographically.
61
-
@param id1 First Id.
62
-
@param id2 Second Id.
63
-
@return Negative if id1 < id2, zero if equal, positive if id1 > id2. *)
64
-
val compare : t -> t -> int
65
-
66
-
(** Pretty-print an Id for debugging.
67
-
@param ppf The formatter.
68
-
@param id The Id to format. *)
69
-
val pp_debug : Format.formatter -> t -> unit
70
-
71
-
(** Convert an Id to a human-readable string for debugging.
72
-
@param id The Id to format.
73
-
@return A debug string representation. *)
74
-
val to_string_debug : t -> string
+17
-17
jmap/jmap/jmap_methods.ml
+17
-17
jmap/jmap/jmap_methods.ml
···
1
-
open Jmap_types
1
+
open Types
2
2
open Jmap_method_names
3
3
4
4
type generic_record
···
75
75
let not_found = List.map to_string not_found_json in
76
76
Ok { account_id; state; list; not_found }
77
77
with
78
-
| Yojson.Safe.Util.Type_error (msg, _) -> Error (Jmap_error.parse_error ("Get_response parse error: " ^ msg))
79
-
| exn -> Error (Jmap_error.parse_error ("Get_response parse error: " ^ Printexc.to_string exn))
78
+
| Yojson.Safe.Util.Type_error (msg, _) -> Error (Error.parse_error ("Get_response parse error: " ^ msg))
79
+
| exn -> Error (Error.parse_error ("Get_response parse error: " ^ Printexc.to_string exn))
80
80
end
81
81
82
82
module Changes_args = struct
···
153
153
Ok { account_id; old_state; new_state; has_more_changes;
154
154
created; updated; destroyed; updated_properties }
155
155
with
156
-
| Yojson.Safe.Util.Type_error (msg, _) -> Error (Jmap_error.parse_error ("Changes_response parse error: " ^ msg))
157
-
| exn -> Error (Jmap_error.parse_error ("Changes_response parse error: " ^ Printexc.to_string exn))
156
+
| Yojson.Safe.Util.Type_error (msg, _) -> Error (Error.parse_error ("Changes_response parse error: " ^ msg))
157
+
| exn -> Error (Error.parse_error ("Changes_response parse error: " ^ Printexc.to_string exn))
158
158
end
159
159
160
160
type patch_object = (json_pointer * Yojson.Safe.t) list
···
238
238
created : 'created_record_info id_map option;
239
239
updated : 'updated_record_info option id_map option;
240
240
destroyed : id list option;
241
-
not_created : Jmap_error.Set_error.t id_map option;
242
-
not_updated : Jmap_error.Set_error.t id_map option;
243
-
not_destroyed : Jmap_error.Set_error.t id_map option;
241
+
not_created : Error.Set_error.t id_map option;
242
+
not_updated : Error.Set_error.t id_map option;
243
+
not_destroyed : Error.Set_error.t id_map option;
244
244
}
245
245
246
246
let account_id t = t.account_id
···
316
316
let table = Hashtbl.create (List.length pairs) in
317
317
List.iter (fun (k, _v) ->
318
318
(* Simplified: just create a basic error *)
319
-
let error = Jmap_error.Set_error.v `InvalidProperties in
319
+
let error = Error.Set_error.v `InvalidProperties in
320
320
Hashtbl.add table k error
321
321
) pairs;
322
322
Some table
···
328
328
| `Assoc pairs ->
329
329
let table = Hashtbl.create (List.length pairs) in
330
330
List.iter (fun (k, _v) ->
331
-
let error = Jmap_error.Set_error.v `InvalidProperties in
331
+
let error = Error.Set_error.v `InvalidProperties in
332
332
Hashtbl.add table k error
333
333
) pairs;
334
334
Some table
···
340
340
| `Assoc pairs ->
341
341
let table = Hashtbl.create (List.length pairs) in
342
342
List.iter (fun (k, _v) ->
343
-
let error = Jmap_error.Set_error.v `NotFound in
343
+
let error = Error.Set_error.v `NotFound in
344
344
Hashtbl.add table k error
345
345
) pairs;
346
346
Some table
···
350
350
Ok { account_id; old_state; new_state; created; updated; destroyed;
351
351
not_created; not_updated; not_destroyed }
352
352
with
353
-
| Yojson.Safe.Util.Type_error (msg, _) -> Error (Jmap_error.parse_error ("Set_response parse error: " ^ msg))
354
-
| exn -> Error (Jmap_error.parse_error ("Set_response parse error: " ^ Printexc.to_string exn))
353
+
| Yojson.Safe.Util.Type_error (msg, _) -> Error (Error.parse_error ("Set_response parse error: " ^ msg))
354
+
| exn -> Error (Error.parse_error ("Set_response parse error: " ^ Printexc.to_string exn))
355
355
end
356
356
357
357
module Copy_args = struct
···
387
387
old_state : string option;
388
388
new_state : string;
389
389
created : 'created_record_info id_map option;
390
-
not_created : Jmap_error.Set_error.t id_map option;
390
+
not_created : Error.Set_error.t id_map option;
391
391
}
392
392
393
393
let from_account_id t = t.from_account_id
···
663
663
Ok { account_id; query_state; can_calculate_changes; position;
664
664
ids; total; limit }
665
665
with
666
-
| Yojson.Safe.Util.Type_error (msg, _) -> Error (Jmap_error.parse_error ("Query_response parse error: " ^ msg))
667
-
| exn -> Error (Jmap_error.parse_error ("Query_response parse error: " ^ Printexc.to_string exn))
666
+
| Yojson.Safe.Util.Type_error (msg, _) -> Error (Error.parse_error ("Query_response parse error: " ^ msg))
667
+
| exn -> Error (Error.parse_error ("Query_response parse error: " ^ Printexc.to_string exn))
668
668
end
669
669
670
670
module Added_item = struct
···
734
734
735
735
(* Method handling utilities *)
736
736
module Method_handler = struct
737
-
type _handler = Yojson.Safe.t -> (Yojson.Safe.t, Jmap_error.error) result
737
+
type _handler = Yojson.Safe.t -> (Yojson.Safe.t, Error.error) result
738
738
739
739
let handlers = Hashtbl.create 16
740
740
+13
-13
jmap/jmap/jmap_methods.mli
+13
-13
jmap/jmap/jmap_methods.mli
···
19
19
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-4> RFC 8620, Section 4 (Core/echo)
20
20
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5> RFC 8620, Section 5 (Standard Methods) *)
21
21
22
-
open Jmap_types
22
+
open Types
23
23
24
24
(** {1 Generic Types} *)
25
25
···
163
163
val of_json :
164
164
from_json:(Yojson.Safe.t -> 'record) ->
165
165
Yojson.Safe.t ->
166
-
('record t, Jmap_error.error) result
166
+
('record t, Error.error) result
167
167
end
168
168
169
169
(** Arguments for /changes methods.
···
225
225
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.2> RFC 8620, Section 5.2 *)
226
226
val of_json :
227
227
Yojson.Safe.t ->
228
-
(t, Jmap_error.error) result
228
+
(t, Error.error) result
229
229
end
230
230
231
231
(** Patch object for /set update.
···
287
287
val created : ('a, 'b) t -> 'a id_map option
288
288
val updated : ('a, 'b) t -> 'b option id_map option
289
289
val destroyed : ('a, 'b) t -> id list option
290
-
val not_created : ('a, 'b) t -> Jmap_error.Set_error.t id_map option
291
-
val not_updated : ('a, 'b) t -> Jmap_error.Set_error.t id_map option
292
-
val not_destroyed : ('a, 'b) t -> Jmap_error.Set_error.t id_map option
290
+
val not_created : ('a, 'b) t -> Error.Set_error.t id_map option
291
+
val not_updated : ('a, 'b) t -> Error.Set_error.t id_map option
292
+
val not_destroyed : ('a, 'b) t -> Error.Set_error.t id_map option
293
293
294
294
val v :
295
295
account_id:id ->
···
298
298
?created:'a id_map ->
299
299
?updated:'b option id_map ->
300
300
?destroyed:id list ->
301
-
?not_created:Jmap_error.Set_error.t id_map ->
302
-
?not_updated:Jmap_error.Set_error.t id_map ->
303
-
?not_destroyed:Jmap_error.Set_error.t id_map ->
301
+
?not_created:Error.Set_error.t id_map ->
302
+
?not_updated:Error.Set_error.t id_map ->
303
+
?not_destroyed:Error.Set_error.t id_map ->
304
304
unit ->
305
305
('a, 'b) t
306
306
···
319
319
from_created_json:(Yojson.Safe.t -> 'a) ->
320
320
from_updated_json:(Yojson.Safe.t -> 'b) ->
321
321
Yojson.Safe.t ->
322
-
(('a, 'b) t, Jmap_error.error) result
322
+
(('a, 'b) t, Error.error) result
323
323
end
324
324
325
325
(** Arguments for /copy methods.
···
359
359
val old_state : 'a t -> string option
360
360
val new_state : 'a t -> string
361
361
val created : 'a t -> 'a id_map option
362
-
val not_created : 'a t -> Jmap_error.Set_error.t id_map option
362
+
val not_created : 'a t -> Error.Set_error.t id_map option
363
363
364
364
val v :
365
365
from_account_id:id ->
···
367
367
?old_state:string ->
368
368
new_state:string ->
369
369
?created:'a id_map ->
370
-
?not_created:Jmap_error.Set_error.t id_map ->
370
+
?not_created:Error.Set_error.t id_map ->
371
371
unit ->
372
372
'a t
373
373
end
···
573
573
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.5> RFC 8620, Section 5.5 *)
574
574
val of_json :
575
575
Yojson.Safe.t ->
576
-
(t, Jmap_error.error) result
576
+
(t, Error.error) result
577
577
end
578
578
579
579
(** Item indicating an added record in /queryChanges.
-134
jmap/jmap/jmap_patch.ml
-134
jmap/jmap/jmap_patch.ml
···
1
-
(** JMAP Patch Object data type implementation *)
2
-
3
-
(* Internal representation as a hash table for efficient operations *)
4
-
type t = (string, Yojson.Safe.t) Hashtbl.t
5
-
6
-
(* JSON Pointer validation - simplified but covers common cases *)
7
-
let is_valid_property_path path =
8
-
let len = String.length path in
9
-
if len = 0 then true (* empty path is valid root *)
10
-
else if path.[0] <> '/' then true (* simple property names are valid *)
11
-
else
12
-
(* Check for valid JSON Pointer format *)
13
-
let rec check_escaping i =
14
-
if i >= len then true
15
-
else match path.[i] with
16
-
| '~' when i + 1 < len ->
17
-
(match path.[i + 1] with
18
-
| '0' | '1' -> check_escaping (i + 2)
19
-
| _ -> false)
20
-
| '/' -> check_escaping (i + 1)
21
-
| _ -> check_escaping (i + 1)
22
-
in
23
-
check_escaping 0
24
-
25
-
let empty = Hashtbl.create 8
26
-
27
-
let of_operations operations =
28
-
let patch = Hashtbl.create (List.length operations) in
29
-
let rec process = function
30
-
| [] -> Ok patch
31
-
| (property, value) :: rest ->
32
-
if is_valid_property_path property then (
33
-
Hashtbl.replace patch property value;
34
-
process rest
35
-
) else
36
-
Error ("Invalid property path: " ^ property)
37
-
in
38
-
process operations
39
-
40
-
let to_operations patch =
41
-
Hashtbl.fold (fun property value acc ->
42
-
(property, value) :: acc
43
-
) patch []
44
-
45
-
let of_json_object = function
46
-
| `Assoc pairs -> of_operations pairs
47
-
| json ->
48
-
let json_str = Yojson.Safe.to_string json in
49
-
Error (Printf.sprintf "Expected JSON object for Patch, got: %s" json_str)
50
-
51
-
let to_json_object patch =
52
-
let pairs = to_operations patch in
53
-
`Assoc pairs
54
-
55
-
let set_property patch property value =
56
-
if is_valid_property_path property then (
57
-
let new_patch = Hashtbl.copy patch in
58
-
Hashtbl.replace new_patch property value;
59
-
Ok new_patch
60
-
) else
61
-
Error ("Invalid property path: " ^ property)
62
-
63
-
let remove_property patch property =
64
-
set_property patch property `Null
65
-
66
-
let has_property patch property =
67
-
Hashtbl.mem patch property
68
-
69
-
let get_property patch property =
70
-
try Some (Hashtbl.find patch property)
71
-
with Not_found -> None
72
-
73
-
let merge patch1 patch2 =
74
-
let result = Hashtbl.copy patch1 in
75
-
Hashtbl.iter (fun property value ->
76
-
Hashtbl.replace result property value
77
-
) patch2;
78
-
result
79
-
80
-
let is_empty patch =
81
-
Hashtbl.length patch = 0
82
-
83
-
let size patch =
84
-
Hashtbl.length patch
85
-
86
-
let validate patch =
87
-
(* Validate all property paths *)
88
-
try
89
-
Hashtbl.iter (fun property _value ->
90
-
if not (is_valid_property_path property) then
91
-
failwith ("Invalid property path: " ^ property)
92
-
) patch;
93
-
Ok ()
94
-
with
95
-
| Failure msg -> Error msg
96
-
97
-
let equal patch1 patch2 =
98
-
if Hashtbl.length patch1 <> Hashtbl.length patch2 then false
99
-
else
100
-
try
101
-
Hashtbl.iter (fun property value1 ->
102
-
match get_property patch2 property with
103
-
| None -> failwith "Property not found"
104
-
| Some value2 when Yojson.Safe.equal value1 value2 -> ()
105
-
| Some _ -> failwith "Property values differ"
106
-
) patch1;
107
-
true
108
-
with
109
-
| Failure _ -> false
110
-
111
-
let pp ppf patch =
112
-
Fmt.pf ppf "%s" (Yojson.Safe.to_string (to_json_object patch))
113
-
114
-
let pp_hum ppf patch =
115
-
let operations = to_operations patch in
116
-
let op_count = List.length operations in
117
-
let key_list = List.map fst operations in
118
-
let key_str = match key_list with
119
-
| [] -> "none"
120
-
| keys -> String.concat ", " keys
121
-
in
122
-
Fmt.pf ppf "Patch{operations=%d; keys=[%s]}" op_count key_str
123
-
124
-
let to_string_debug patch =
125
-
let operations = to_operations patch in
126
-
let op_strings = List.map (fun (prop, value) ->
127
-
Printf.sprintf "%s: %s" prop (Yojson.Safe.to_string value)
128
-
) operations in
129
-
Printf.sprintf "Patch({%s})" (String.concat "; " op_strings)
130
-
131
-
(* JSON serialization *)
132
-
let to_json patch = to_json_object patch
133
-
134
-
let of_json json = of_json_object json
-122
jmap/jmap/jmap_patch.mli
-122
jmap/jmap/jmap_patch.mli
···
1
-
(** JMAP Patch Object data type (RFC 8620).
2
-
3
-
A patch object is used to update properties of JMAP objects. It represents
4
-
a JSON object where each key is a property path (using JSON Pointer syntax)
5
-
and each value is the new value to set for that property, or null to remove
6
-
the property.
7
-
8
-
Patch objects are commonly used in /set method calls to update existing
9
-
objects without having to send the complete object representation.
10
-
11
-
Examples of patch operations:
12
-
- Setting a property: [{"name": "New Name"}]
13
-
- Removing a property: [{"oldProperty": null}]
14
-
- Setting nested properties: [{"address/street": "123 Main St"}]
15
-
16
-
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.3> RFC 8620, Section 5.3
17
-
@see <https://www.rfc-editor.org/rfc/rfc6901.html> RFC 6901 (JSON Pointer) *)
18
-
19
-
(** Abstract type representing a JMAP Patch Object. *)
20
-
type t
21
-
22
-
(** JSON serialization interface *)
23
-
include Jmap_sigs.JSONABLE with type t := t
24
-
25
-
(** Pretty-printing interface *)
26
-
include Jmap_sigs.PRINTABLE with type t := t
27
-
28
-
(** {1 Construction and Access} *)
29
-
30
-
(** Create an empty patch object.
31
-
@return An empty patch with no operations. *)
32
-
val empty : t
33
-
34
-
(** Create a patch from a list of property-value pairs.
35
-
@param operations List of (property_path, value) pairs.
36
-
@return Ok with the patch, or Error if any property path is invalid. *)
37
-
val of_operations : (string * Yojson.Safe.t) list -> (t, string) result
38
-
39
-
(** Convert a patch to a list of property-value pairs.
40
-
@param patch The patch to convert.
41
-
@return List of (property_path, value) pairs. *)
42
-
val to_operations : t -> (string * Yojson.Safe.t) list
43
-
44
-
(** Create a patch from a Yojson.Safe.t object directly.
45
-
@param json The JSON object.
46
-
@return Ok with the patch, or Error if the JSON is not a valid object. *)
47
-
val of_json_object : Yojson.Safe.t -> (t, string) result
48
-
49
-
(** Convert a patch to a Yojson.Safe.t object directly.
50
-
@param patch The patch to convert.
51
-
@return The JSON object representation. *)
52
-
val to_json_object : t -> Yojson.Safe.t
53
-
54
-
(** {1 Patch Operations} *)
55
-
56
-
(** Set a property in the patch.
57
-
@param patch The patch to modify.
58
-
@param property The property path (JSON Pointer format).
59
-
@param value The value to set.
60
-
@return Ok with the updated patch, or Error if the property path is invalid. *)
61
-
val set_property : t -> string -> Yojson.Safe.t -> (t, string) result
62
-
63
-
(** Remove a property in the patch (set to null).
64
-
@param patch The patch to modify.
65
-
@param property The property path to remove.
66
-
@return Ok with the updated patch, or Error if the property path is invalid. *)
67
-
val remove_property : t -> string -> (t, string) result
68
-
69
-
(** Check if a property is set in the patch.
70
-
@param patch The patch to check.
71
-
@param property The property path to check.
72
-
@return True if the property is explicitly set in the patch. *)
73
-
val has_property : t -> string -> bool
74
-
75
-
(** Get a property value from the patch.
76
-
@param patch The patch to query.
77
-
@param property The property path to get.
78
-
@return Some value if the property is set, None if not present. *)
79
-
val get_property : t -> string -> Yojson.Safe.t option
80
-
81
-
(** {1 Patch Composition} *)
82
-
83
-
(** Merge two patches, with the second patch taking precedence.
84
-
@param patch1 The first patch.
85
-
@param patch2 The second patch (higher precedence).
86
-
@return The merged patch. *)
87
-
val merge : t -> t -> t
88
-
89
-
(** Check if a patch is empty (no operations).
90
-
@param patch The patch to check.
91
-
@return True if the patch has no operations. *)
92
-
val is_empty : t -> bool
93
-
94
-
(** Get the number of operations in a patch.
95
-
@param patch The patch to count.
96
-
@return The number of property operations. *)
97
-
val size : t -> int
98
-
99
-
(** {1 Validation} *)
100
-
101
-
(** Validate a patch according to JMAP constraints.
102
-
@param patch The patch to validate.
103
-
@return Ok () if valid, Error with description if invalid. *)
104
-
val validate : t -> (unit, string) result
105
-
106
-
(** Validate a JSON Pointer path.
107
-
@param path The property path to validate.
108
-
@return True if the path is a valid JSON Pointer, false otherwise. *)
109
-
val is_valid_property_path : string -> bool
110
-
111
-
(** {1 Comparison and Utilities} *)
112
-
113
-
(** Compare two patches for equality.
114
-
@param patch1 First patch.
115
-
@param patch2 Second patch.
116
-
@return True if patches have identical operations, false otherwise. *)
117
-
val equal : t -> t -> bool
118
-
119
-
(** Convert a patch to a human-readable string for debugging.
120
-
@param patch The patch to format.
121
-
@return A debug string representation. *)
122
-
val to_string_debug : t -> string
-6
jmap/jmap/jmap_protocol.ml
-6
jmap/jmap/jmap_protocol.ml
+3
-39
jmap/jmap/jmap_protocol.mli
+3
-39
jmap/jmap/jmap_protocol.mli
···
5
5
protocol structures, session management, and error handling into a coherent
6
6
API for JMAP implementations.
7
7
8
-
The module organizes protocol functionality into logical groups:
9
-
- Wire protocol: Request/response structures and invocations
10
-
- Session management: Capability discovery and account information
11
-
- Error handling: Comprehensive error types and utilities
12
-
- Protocol helpers: Convenience functions for common operations
8
+
The module provides type aliases and convenience functions that reference
9
+
the individual Wire, Session, and Error modules for backwards compatibility.
13
10
14
11
@see <https://www.rfc-editor.org/rfc/rfc8620.html> RFC 8620: Core JMAP *)
15
12
16
-
(** {1 Wire Protocol Types} *)
17
-
18
-
(** Wire protocol types for JMAP requests and responses.
19
-
20
-
This includes the core structures for method invocations, requests,
21
-
responses, and result references that enable method call chaining.
22
-
23
-
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3> RFC 8620, Section 3 *)
24
-
module Wire = Jmap_wire
25
-
26
-
(** {1 Session Management} *)
27
-
28
-
(** Session management and capability discovery.
29
-
30
-
Provides session resource handling, account enumeration, capability
31
-
negotiation, and service autodiscovery functionality.
32
-
33
-
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-2> RFC 8620, Section 2 *)
34
-
module Session = Jmap_session
35
-
36
-
(** {1 Error Types} *)
37
-
38
-
(** Error types used throughout the protocol.
39
-
40
-
Comprehensive error handling including method errors, set errors,
41
-
transport errors, and unified error types with proper RFC references.
42
-
43
-
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.6> RFC 8620, Section 3.6 *)
44
-
module Error = Jmap_error
45
-
46
13
(** {1 Type Aliases for Convenience} *)
47
-
48
-
(** Convenient type aliases for commonly used protocol types *)
49
14
50
15
(** A JMAP request *)
51
16
type request = Wire.Request.t
···
205
170
val is_message : t -> bool
206
171
end
207
172
208
-
209
173
(** {1 Protocol Helpers} *)
210
174
211
175
(** Check if a session supports a given capability.
···
218
182
@param session The session object.
219
183
@param capability The capability.
220
184
@return The account ID or an error if not found. *)
221
-
val get_primary_account : session -> Jmap_capability.t -> (Jmap_types.id, error) result
185
+
val get_primary_account : session -> Jmap_capability.t -> (Types.id, error) result
222
186
223
187
(** Find a method response by its call ID.
224
188
@param response The response object.
+4
-4
jmap/jmap/jmap_push.ml
+4
-4
jmap/jmap/jmap_push.ml
···
1
-
open Jmap_types
1
+
open Types
2
2
open Jmap_methods
3
3
4
4
type type_state = string string_map
···
134
134
created : Push_subscription_created_info.t id_map option;
135
135
updated : Push_subscription_updated_info.t option id_map option;
136
136
destroyed : id list option;
137
-
not_created : Jmap_error.Set_error.t id_map option;
138
-
not_updated : Jmap_error.Set_error.t id_map option;
139
-
not_destroyed : Jmap_error.Set_error.t id_map option;
137
+
not_created : Error.Set_error.t id_map option;
138
+
not_updated : Error.Set_error.t id_map option;
139
+
not_destroyed : Error.Set_error.t id_map option;
140
140
}
141
141
142
142
let created t = t.created
+7
-7
jmap/jmap/jmap_push.mli
+7
-7
jmap/jmap/jmap_push.mli
···
1
1
(** JMAP Push Notifications.
2
2
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7> RFC 8620, Section 7 *)
3
3
4
-
open Jmap_types
4
+
open Types
5
5
open Jmap_methods
6
6
7
7
(** TypeState object map (TypeName -> StateString).
···
185
185
val created : t -> Push_subscription_created_info.t id_map option
186
186
val updated : t -> Push_subscription_updated_info.t option id_map option
187
187
val destroyed : t -> id list option
188
-
val not_created : t -> Jmap_error.Set_error.t id_map option
189
-
val not_updated : t -> Jmap_error.Set_error.t id_map option
190
-
val not_destroyed : t -> Jmap_error.Set_error.t id_map option
188
+
val not_created : t -> Error.Set_error.t id_map option
189
+
val not_updated : t -> Error.Set_error.t id_map option
190
+
val not_destroyed : t -> Error.Set_error.t id_map option
191
191
192
192
val v :
193
193
?created:Push_subscription_created_info.t id_map ->
194
194
?updated:Push_subscription_updated_info.t option id_map ->
195
195
?destroyed:id list ->
196
-
?not_created:Jmap_error.Set_error.t id_map ->
197
-
?not_updated:Jmap_error.Set_error.t id_map ->
198
-
?not_destroyed:Jmap_error.Set_error.t id_map ->
196
+
?not_created:Error.Set_error.t id_map ->
197
+
?not_updated:Error.Set_error.t id_map ->
198
+
?not_destroyed:Error.Set_error.t id_map ->
199
199
unit ->
200
200
t
201
201
end
+3
-3
jmap/jmap/jmap_request.ml
+3
-3
jmap/jmap/jmap_request.ml
···
1
1
(** Implementation of type-safe JMAP request building and management. *)
2
2
3
-
open Jmap_types
3
+
open Types
4
4
5
5
(** Internal representation of a JMAP request under construction *)
6
6
type t = {
···
144
144
let invocations = List.rev t.methods |> List.map (fun (method_call, call_id) ->
145
145
let method_name = Jmap_method.method_name method_call in
146
146
let arguments = Jmap_method.arguments method_call in
147
-
Jmap_wire.Invocation.v
147
+
Wire.Invocation.v
148
148
~method_name
149
149
~method_call_id:call_id
150
150
~arguments
151
151
()
152
152
) in
153
-
Jmap_wire.Request.v
153
+
Wire.Request.v
154
154
~using:t.using
155
155
~method_calls:invocations
156
156
?created_ids:t.created_ids
+2
-2
jmap/jmap/jmap_request.mli
+2
-2
jmap/jmap/jmap_request.mli
···
22
22
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.3> RFC 8620, Section 3.3 (Request Object)
23
23
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.7> RFC 8620, Section 3.7 (Result References) *)
24
24
25
-
open Jmap_types
25
+
open Types
26
26
27
27
(** {1 Request Types} *)
28
28
···
213
213
214
214
@param request The high-level request to convert
215
215
@return Wire protocol Request object *)
216
-
val to_wire_request : t -> Jmap_wire.Request.t
216
+
val to_wire_request : t -> Wire.Request.t
217
217
218
218
(** Convert the request directly to JSON.
219
219
+25
-25
jmap/jmap/jmap_response.ml
+25
-25
jmap/jmap/jmap_response.ml
···
25
25
| Email_submission_changes_data of Jmap_methods.Changes_response.t
26
26
| Vacation_response_get_data of Yojson.Safe.t Jmap_methods.Get_response.t
27
27
| Vacation_response_set_data of (Yojson.Safe.t, Yojson.Safe.t) Jmap_methods.Set_response.t
28
-
| Error_data of Jmap_error.error
28
+
| Error_data of Error.error
29
29
30
30
type t = {
31
31
method_name: string;
···
182
182
(* Not yet implemented methods - return error for now *)
183
183
| Some (`Blob_get | `Blob_lookup | `Email_parse | `Email_copy | `SearchSnippet_get
184
184
| `Thread_query | `Email_import | `Blob_copy) ->
185
-
Error (Jmap_error.Method (`UnknownMethod, Some method_name))
185
+
Error (Error.Method (`UnknownMethod, Some method_name))
186
186
187
187
| None ->
188
-
Error (Jmap_error.Method (`UnknownMethod, Some method_name))
188
+
Error (Error.Method (`UnknownMethod, Some method_name))
189
189
in
190
190
match result with
191
191
| Ok data -> Ok { method_name; data; raw_json = json }
192
192
| Error err -> Error err
193
193
with
194
-
| exn -> Error (Jmap_error.Method (`InvalidArguments, Some (Printexc.to_string exn)))
194
+
| exn -> Error (Error.Method (`InvalidArguments, Some (Printexc.to_string exn)))
195
195
196
196
let parse_method_response_array json =
197
197
let open Yojson.Safe.Util in
···
206
206
(match parse_method_response ~method_name response_json with
207
207
| Ok response -> Ok (method_name, response, call_id)
208
208
| Error err -> Error err)
209
-
| _ -> Error (Jmap_error.Parse "Invalid method response array format")
209
+
| _ -> Error (Error.Parse "Invalid method response array format")
210
210
with
211
-
| exn -> Error (Jmap_error.Parse (Printexc.to_string exn))
211
+
| exn -> Error (Error.Parse (Printexc.to_string exn))
212
212
213
213
(** {1 Response Pattern Matching} *)
214
214
···
290
290
match Jmap_methods.Query_response.of_json json with
291
291
| Ok t -> Ok t
292
292
| Error err -> Error ("Failed to parse Query_response: " ^ (match err with
293
-
| Jmap_error.Parse msg -> msg
293
+
| Error.Parse msg -> msg
294
294
| _ -> "unknown error"))
295
295
296
296
let pp fmt t =
···
325
325
match Jmap_methods.Get_response.of_json ~from_json:(fun j -> j) json with
326
326
| Ok t -> Ok t
327
327
| Error err -> Error ("Failed to parse Get_response: " ^ (match err with
328
-
| Jmap_error.Parse msg -> msg
328
+
| Error.Parse msg -> msg
329
329
| _ -> "unknown error"))
330
330
331
331
let pp fmt t =
···
368
368
match Jmap_methods.Set_response.of_json ~from_created_json:(fun j -> j) ~from_updated_json:(fun j -> j) json with
369
369
| Ok t -> Ok t
370
370
| Error err -> Error ("Failed to parse Set_response: " ^ (match err with
371
-
| Jmap_error.Parse msg -> msg
371
+
| Error.Parse msg -> msg
372
372
| _ -> "unknown error"))
373
373
374
374
let pp fmt t =
···
406
406
match Jmap_methods.Changes_response.of_json json with
407
407
| Ok t -> Ok t
408
408
| Error err -> Error ("Failed to parse Changes_response: " ^ (match err with
409
-
| Jmap_error.Parse msg -> msg
409
+
| Error.Parse msg -> msg
410
410
| _ -> "unknown error"))
411
411
412
412
let pp fmt t =
···
441
441
match Jmap_methods.Get_response.of_json ~from_json:(fun j -> j) json with
442
442
| Ok t -> Ok t
443
443
| Error err -> Error ("Failed to parse Get_response: " ^ (match err with
444
-
| Jmap_error.Parse msg -> msg
444
+
| Error.Parse msg -> msg
445
445
| _ -> "unknown error"))
446
446
447
447
let pp fmt t =
···
476
476
match Jmap_methods.Query_response.of_json json with
477
477
| Ok t -> Ok t
478
478
| Error err -> Error ("Failed to parse Query_response: " ^ (match err with
479
-
| Jmap_error.Parse msg -> msg
479
+
| Error.Parse msg -> msg
480
480
| _ -> "unknown error"))
481
481
482
482
let pp fmt t =
···
518
518
match Jmap_methods.Set_response.of_json ~from_created_json:(fun j -> j) ~from_updated_json:(fun j -> j) json with
519
519
| Ok t -> Ok t
520
520
| Error err -> Error ("Failed to parse Set_response: " ^ (match err with
521
-
| Jmap_error.Parse msg -> msg
521
+
| Error.Parse msg -> msg
522
522
| _ -> "unknown error"))
523
523
524
524
let pp fmt t =
···
555
555
match Jmap_methods.Changes_response.of_json json with
556
556
| Ok t -> Ok t
557
557
| Error err -> Error ("Failed to parse Changes_response: " ^ (match err with
558
-
| Jmap_error.Parse msg -> msg
558
+
| Error.Parse msg -> msg
559
559
| _ -> "unknown error"))
560
560
561
561
let pp fmt t =
···
590
590
match Jmap_methods.Get_response.of_json ~from_json:(fun j -> j) json with
591
591
| Ok t -> Ok t
592
592
| Error err -> Error ("Failed to parse Get_response: " ^ (match err with
593
-
| Jmap_error.Parse msg -> msg
593
+
| Error.Parse msg -> msg
594
594
| _ -> "unknown error"))
595
595
596
596
let pp fmt t =
···
624
624
match Jmap_methods.Changes_response.of_json json with
625
625
| Ok t -> Ok t
626
626
| Error err -> Error ("Failed to parse Changes_response: " ^ (match err with
627
-
| Jmap_error.Parse msg -> msg
627
+
| Error.Parse msg -> msg
628
628
| _ -> "unknown error"))
629
629
630
630
let pp fmt t =
···
659
659
match Jmap_methods.Get_response.of_json ~from_json:(fun j -> j) json with
660
660
| Ok t -> Ok t
661
661
| Error err -> Error ("Failed to parse Get_response: " ^ (match err with
662
-
| Jmap_error.Parse msg -> msg
662
+
| Error.Parse msg -> msg
663
663
| _ -> "unknown error"))
664
664
665
665
let pp fmt t =
···
701
701
match Jmap_methods.Set_response.of_json ~from_created_json:(fun j -> j) ~from_updated_json:(fun j -> j) json with
702
702
| Ok t -> Ok t
703
703
| Error err -> Error ("Failed to parse Set_response: " ^ (match err with
704
-
| Jmap_error.Parse msg -> msg
704
+
| Error.Parse msg -> msg
705
705
| _ -> "unknown error"))
706
706
707
707
let pp fmt t =
···
738
738
match Jmap_methods.Changes_response.of_json json with
739
739
| Ok t -> Ok t
740
740
| Error err -> Error ("Failed to parse Changes_response: " ^ (match err with
741
-
| Jmap_error.Parse msg -> msg
741
+
| Error.Parse msg -> msg
742
742
| _ -> "unknown error"))
743
743
744
744
let pp fmt t =
···
773
773
match Jmap_methods.Get_response.of_json ~from_json:(fun j -> j) json with
774
774
| Ok t -> Ok t
775
775
| Error err -> Error ("Failed to parse Get_response: " ^ (match err with
776
-
| Jmap_error.Parse msg -> msg
776
+
| Error.Parse msg -> msg
777
777
| _ -> "unknown error"))
778
778
779
779
let pp fmt t =
···
815
815
match Jmap_methods.Set_response.of_json ~from_created_json:(fun j -> j) ~from_updated_json:(fun j -> j) json with
816
816
| Ok t -> Ok t
817
817
| Error err -> Error ("Failed to parse Set_response: " ^ (match err with
818
-
| Jmap_error.Parse msg -> msg
818
+
| Error.Parse msg -> msg
819
819
| _ -> "unknown error"))
820
820
821
821
let pp fmt t =
···
853
853
match Jmap_methods.Query_response.of_json json with
854
854
| Ok t -> Ok t
855
855
| Error err -> Error ("Failed to parse Query_response: " ^ (match err with
856
-
| Jmap_error.Parse msg -> msg
856
+
| Error.Parse msg -> msg
857
857
| _ -> "unknown error"))
858
858
859
859
let pp fmt t =
···
887
887
match Jmap_methods.Changes_response.of_json json with
888
888
| Ok t -> Ok t
889
889
| Error err -> Error ("Failed to parse Changes_response: " ^ (match err with
890
-
| Jmap_error.Parse msg -> msg
890
+
| Error.Parse msg -> msg
891
891
| _ -> "unknown error"))
892
892
893
893
let pp fmt t =
···
922
922
match Jmap_methods.Get_response.of_json ~from_json:(fun j -> j) json with
923
923
| Ok t -> Ok t
924
924
| Error err -> Error ("Failed to parse Get_response: " ^ (match err with
925
-
| Jmap_error.Parse msg -> msg
925
+
| Error.Parse msg -> msg
926
926
| _ -> "unknown error"))
927
927
928
928
let pp fmt t =
···
964
964
match Jmap_methods.Set_response.of_json ~from_created_json:(fun j -> j) ~from_updated_json:(fun j -> j) json with
965
965
| Ok t -> Ok t
966
966
| Error err -> Error ("Failed to parse Set_response: " ^ (match err with
967
-
| Jmap_error.Parse msg -> msg
967
+
| Error.Parse msg -> msg
968
968
| _ -> "unknown error"))
969
969
970
970
let pp fmt t =
+5
-5
jmap/jmap/jmap_response.mli
+5
-5
jmap/jmap/jmap_response.mli
···
25
25
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.4> RFC 8620, Section 3.4 (Method Responses)
26
26
@see <https://www.rfc-editor.org/rfc/rfc8621.html> RFC 8621 (Email Extensions) *)
27
27
28
-
open Jmap_types
28
+
open Types
29
29
30
30
(** {1 Response Types} *)
31
31
···
74
74
@param raw_json The original JSON for debugging purposes *)
75
75
val create_error_response :
76
76
method_name:string ->
77
-
Jmap_error.error ->
77
+
Error.error ->
78
78
Yojson.Safe.t ->
79
79
t
80
80
···
94
94
val parse_method_response :
95
95
method_name:string ->
96
96
Yojson.Safe.t ->
97
-
(t, Jmap_error.error) result
97
+
(t, Error.error) result
98
98
99
99
(** Parse a complete JMAP method response array.
100
100
···
105
105
@return Tuple of (method_name, parsed_response, call_id) or error *)
106
106
val parse_method_response_array :
107
107
Yojson.Safe.t ->
108
-
(string * t * string option, Jmap_error.error) result
108
+
(string * t * string option, Error.error) result
109
109
110
110
(** {1 Response Pattern Matching} *)
111
111
···
497
497
(** Extract error information if this is an error response.
498
498
@param response The response to check
499
499
@return Error details if this is an error response *)
500
-
val error : t -> Jmap_error.error option
500
+
val error : t -> Error.error option
501
501
502
502
(** Get the account ID from responses that include it.
503
503
@param response The response to extract from
+2
-2
jmap/jmap/jmap_session.ml
jmap/jmap/session.ml
+2
-2
jmap/jmap/jmap_session.ml
jmap/jmap/session.ml
···
1
-
open Jmap_types
1
+
open Types
2
2
3
3
type account_capability_value = Yojson.Safe.t
4
4
···
429
429
| No_auth -> []
430
430
431
431
let make_request ~url ~auth =
432
-
let headers = ("Accept", Jmap_types.Constants.Content_type.json) :: ("User-Agent", Jmap_types.Constants.User_agent.ocaml_jmap) :: (auth_headers auth) in
432
+
let headers = ("Accept", Types.Constants.Content_type.json) :: ("User-Agent", Types.Constants.User_agent.ocaml_jmap) :: (auth_headers auth) in
433
433
try
434
434
let response_json = `Assoc [
435
435
("capabilities", `Assoc [
+2
-2
jmap/jmap/jmap_session.mli
jmap/jmap/session.mli
+2
-2
jmap/jmap/jmap_session.mli
jmap/jmap/session.mli
···
11
11
12
12
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-2> RFC 8620, Section 2 *)
13
13
14
-
open Jmap_types
14
+
open Types
15
15
16
16
(** {1 Capability Types} *)
17
17
···
362
362
(** Discover JMAP service from email address and connect.
363
363
@param email Email address to extract domain from
364
364
@return Connected session or error message *)
365
-
val discover_and_connect_with_email : email:string -> (Session.t, string) result
365
+
val discover_and_connect_with_email : email:string -> (Session.t, string) result
-28
jmap/jmap/jmap_types.ml
-28
jmap/jmap/jmap_types.ml
···
1
-
type id = string
2
-
3
-
type jint = int
4
-
5
-
type uint = int
6
-
7
-
type date = float
8
-
9
-
type utc_date = float
10
-
11
-
type 'v string_map = (string, 'v) Hashtbl.t
12
-
13
-
type 'v id_map = (id, 'v) Hashtbl.t
14
-
15
-
type json_pointer = string
16
-
17
-
module Constants = struct
18
-
let vacation_response_id = "singleton"
19
-
20
-
module Content_type = struct
21
-
let json = "application/json"
22
-
end
23
-
24
-
module User_agent = struct
25
-
let ocaml_jmap = "OCaml-JMAP/1.0"
26
-
let eio_client = "OCaml JMAP Client/Eio"
27
-
end
28
-
end
-148
jmap/jmap/jmap_types.mli
-148
jmap/jmap/jmap_types.mli
···
1
-
(** Basic JMAP types as defined in RFC 8620.
2
-
3
-
This module defines the fundamental data types used throughout the JMAP
4
-
protocol. These types provide type-safe representations of JSON values
5
-
that have specific constraints in the JMAP specification.
6
-
7
-
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1> RFC 8620, Section 1 *)
8
-
9
-
(** {1 Primitive Data Types} *)
10
-
11
-
(** The Id data type.
12
-
13
-
A string of 1 to 255 octets in length and MUST consist only of characters
14
-
from the base64url alphabet, as defined in Section 5 of RFC 4648. This
15
-
includes ASCII alphanumeric characters, plus the characters '-' and '_'.
16
-
17
-
Ids are used to identify JMAP objects within an account. They are assigned
18
-
by the server and are immutable once assigned. The same id MUST refer to
19
-
the same object throughout the lifetime of the object.
20
-
21
-
{b Note}: In this OCaml implementation, ids are represented as regular strings.
22
-
Validation of id format is the responsibility of the client/server implementation.
23
-
24
-
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.2> RFC 8620, Section 1.2 *)
25
-
type id = string
26
-
27
-
(** The Int data type.
28
-
29
-
A signed 53-bit integer in the range [-2^53+1, 2^53-1]. This corresponds
30
-
to the safe integer range in JavaScript and JSON implementations.
31
-
32
-
In OCaml, this is represented as a regular [int]. Note that OCaml's [int]
33
-
on 64-bit platforms has a larger range, but JMAP protocol compliance
34
-
requires staying within the specified range.
35
-
36
-
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.3> RFC 8620, Section 1.3 *)
37
-
type jint = int
38
-
39
-
(** The UnsignedInt data type.
40
-
41
-
An unsigned integer in the range [0, 2^53-1]. This is the same as [jint]
42
-
but restricted to non-negative values.
43
-
44
-
Common uses include counts, limits, positions, and sizes within the protocol.
45
-
46
-
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.3> RFC 8620, Section 1.3 *)
47
-
type uint = int
48
-
49
-
(** The Date data type.
50
-
51
-
A string in RFC 3339 "date-time" format, optionally with timezone information.
52
-
For example: "2014-10-30T14:12:00+08:00" or "2014-10-30T06:12:00Z".
53
-
54
-
In this OCaml implementation, dates are represented as Unix timestamps (float).
55
-
Conversion to/from RFC 3339 string format is handled by the wire protocol
56
-
serialization layer.
57
-
58
-
{b Note}: When represented as a float, precision may be lost for sub-second
59
-
values. Consider the precision requirements of your application.
60
-
61
-
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.4> RFC 8620, Section 1.4
62
-
@see <https://www.rfc-editor.org/rfc/rfc3339.html> RFC 3339 *)
63
-
type date = float
64
-
65
-
(** The UTCDate data type.
66
-
67
-
A string in RFC 3339 "date-time" format with timezone restricted to UTC
68
-
(i.e., ending with "Z"). For example: "2014-10-30T06:12:00Z".
69
-
70
-
This is a more restrictive version of the [date] type, used in contexts
71
-
where timezone normalization is required.
72
-
73
-
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.4> RFC 8620, Section 1.4 *)
74
-
type utc_date = float
75
-
76
-
(** {1 Collection Types} *)
77
-
78
-
(** Represents a JSON object used as a map from String to arbitrary values.
79
-
80
-
In JMAP, many objects are represented as maps with string keys. This type
81
-
provides a convenient OCaml representation using hash tables for efficient
82
-
lookup and modification.
83
-
84
-
{b Usage example}: Account capabilities, session capabilities, and various
85
-
property maps throughout the protocol.
86
-
87
-
@param 'v The type of values stored in the map *)
88
-
type 'v string_map = (string, 'v) Hashtbl.t
89
-
90
-
(** Represents a JSON object used as a map from Id to arbitrary values.
91
-
92
-
This is similar to [string_map] but specifically for JMAP Id keys. Common
93
-
use cases include mapping object IDs to objects, errors, or update information.
94
-
95
-
{b Usage example}: The "create" argument in /set methods maps client-assigned
96
-
IDs to objects to be created.
97
-
98
-
@param 'v The type of values stored in the map *)
99
-
type 'v id_map = (id, 'v) Hashtbl.t
100
-
101
-
(** {1 Protocol-Specific Types} *)
102
-
103
-
(** Represents a JSON Pointer path with JMAP extensions.
104
-
105
-
A JSON Pointer is a string syntax for identifying specific values within
106
-
a JSON document. JMAP extends this with additional syntax for referencing
107
-
values from previous method calls within the same request.
108
-
109
-
Examples of valid JSON pointers in JMAP:
110
-
- "/property" - References the "property" field in the root object
111
-
- "/items/0" - References the first item in the "items" array
112
-
- "*" - Represents all properties or all array elements
113
-
114
-
The pointer syntax is used extensively in result references and patch
115
-
operations within JMAP.
116
-
117
-
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.7> RFC 8620, Section 3.7
118
-
@see <https://www.rfc-editor.org/rfc/rfc6901.html> RFC 6901 (JSON Pointer) *)
119
-
type json_pointer = string
120
-
121
-
(** {1 Protocol Constants} *)
122
-
123
-
(** Protocol constants for common values.
124
-
125
-
This module contains commonly used constant values throughout the
126
-
JMAP protocol, reducing hardcoded strings and providing type safety. *)
127
-
module Constants : sig
128
-
(** VacationResponse singleton object ID.
129
-
130
-
VacationResponse objects always use this fixed ID per JMAP specification.
131
-
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-7> RFC 8621, Section 7 *)
132
-
val vacation_response_id : string
133
-
134
-
(** HTTP Content-Type values for JMAP protocol. *)
135
-
module Content_type : sig
136
-
(** JMAP protocol content type. *)
137
-
val json : string
138
-
end
139
-
140
-
(** Default User-Agent strings. *)
141
-
module User_agent : sig
142
-
(** Default OCaml JMAP client user agent. *)
143
-
val ocaml_jmap : string
144
-
145
-
(** Eio-based client user agent. *)
146
-
val eio_client : string
147
-
end
148
-
end
-85
jmap/jmap/jmap_uint.ml
-85
jmap/jmap/jmap_uint.ml
···
1
-
(** JMAP UnsignedInt data type implementation *)
2
-
3
-
type t = int
4
-
5
-
(* Maximum safe integer value for JavaScript: 2^53 - 1 *)
6
-
let max_safe_value = 9007199254740991
7
-
8
-
let is_valid_int i = i >= 0 && i <= max_safe_value
9
-
10
-
let of_int i =
11
-
if is_valid_int i then Ok i
12
-
else if i < 0 then Error "UnsignedInt cannot be negative"
13
-
else Error "UnsignedInt cannot exceed 2^53-1"
14
-
15
-
let to_int uint = uint
16
-
17
-
let of_string str =
18
-
try
19
-
let i = int_of_string str in
20
-
of_int i
21
-
with
22
-
| Failure _ -> Error "Invalid integer string format"
23
-
| Invalid_argument _ -> Error "Invalid integer string format"
24
-
25
-
let to_string uint = string_of_int uint
26
-
27
-
let pp ppf uint = Fmt.int ppf uint
28
-
29
-
let pp_hum ppf uint = Fmt.pf ppf "UInt(%d)" uint
30
-
31
-
(* Constants *)
32
-
let zero = 0
33
-
let one = 1
34
-
let max_safe = max_safe_value
35
-
36
-
let validate uint =
37
-
if is_valid_int uint then Ok ()
38
-
else Error "UnsignedInt value out of valid range"
39
-
40
-
(* Arithmetic operations with overflow checking *)
41
-
let add uint1 uint2 =
42
-
let result = uint1 + uint2 in
43
-
if result >= uint1 && result >= uint2 && is_valid_int result then
44
-
Ok result
45
-
else
46
-
Error "UnsignedInt addition overflow"
47
-
48
-
let sub uint1 uint2 =
49
-
if uint1 >= uint2 then Ok (uint1 - uint2)
50
-
else Error "UnsignedInt subtraction would result in negative value"
51
-
52
-
let mul uint1 uint2 =
53
-
if uint1 = 0 || uint2 = 0 then Ok 0
54
-
else if uint1 <= max_safe_value / uint2 then
55
-
Ok (uint1 * uint2)
56
-
else
57
-
Error "UnsignedInt multiplication overflow"
58
-
59
-
(* Comparison and utilities *)
60
-
let equal = (=)
61
-
62
-
let compare = compare
63
-
64
-
let min uint1 uint2 = if uint1 <= uint2 then uint1 else uint2
65
-
66
-
let max uint1 uint2 = if uint1 >= uint2 then uint1 else uint2
67
-
68
-
let pp_debug ppf uint = Fmt.pf ppf "UInt(%d)" uint
69
-
70
-
let to_string_debug uint = Printf.sprintf "UInt(%d)" uint
71
-
72
-
(* JSON serialization *)
73
-
let to_json uint = `Int uint
74
-
75
-
let of_json = function
76
-
| `Int i -> of_int i
77
-
| `Float f ->
78
-
(* Handle case where JSON parser represents integers as floats *)
79
-
if f >= 0.0 && f <= float_of_int max_safe_value && f = Float.round f then
80
-
of_int (int_of_float f)
81
-
else
82
-
Error "Float value is not a valid UnsignedInt"
83
-
| json ->
84
-
let json_str = Yojson.Safe.to_string json in
85
-
Error (Printf.sprintf "Expected JSON number for UnsignedInt, got: %s" json_str)
-128
jmap/jmap/jmap_uint.mli
-128
jmap/jmap/jmap_uint.mli
···
1
-
(** JMAP UnsignedInt data type (RFC 8620).
2
-
3
-
The UnsignedInt data type is an unsigned integer in the range [0, 2^53-1].
4
-
This corresponds to the safe integer range for unsigned values in JavaScript
5
-
and JSON implementations.
6
-
7
-
In OCaml, this is represented as a regular [int]. Note that OCaml's [int]
8
-
on 64-bit platforms has a larger range, but JMAP protocol compliance
9
-
requires staying within the specified range and ensuring non-negative values.
10
-
11
-
Common uses include counts, limits, positions, and sizes within the protocol.
12
-
13
-
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.3> RFC 8620, Section 1.3 *)
14
-
15
-
(** Abstract type representing a JMAP UnsignedInt. *)
16
-
type t
17
-
18
-
(** JSON serialization interface *)
19
-
include Jmap_sigs.JSONABLE with type t := t
20
-
21
-
(** Pretty-printing interface *)
22
-
include Jmap_sigs.PRINTABLE with type t := t
23
-
24
-
(** {1 Construction and Access} *)
25
-
26
-
(** Create an UnsignedInt from an int.
27
-
@param i The int value.
28
-
@return Ok with the UnsignedInt, or Error if the value is negative or too large. *)
29
-
val of_int : int -> (t, string) result
30
-
31
-
(** Convert an UnsignedInt to an int.
32
-
@param uint The UnsignedInt to convert.
33
-
@return The int representation. *)
34
-
val to_int : t -> int
35
-
36
-
(** Create an UnsignedInt from a string.
37
-
@param str The string representation of a non-negative integer.
38
-
@return Ok with the UnsignedInt, or Error if parsing fails or value is invalid. *)
39
-
val of_string : string -> (t, string) result
40
-
41
-
(** Convert an UnsignedInt to a string.
42
-
@param uint The UnsignedInt to convert.
43
-
@return The string representation. *)
44
-
val to_string : t -> string
45
-
46
-
(** Pretty-print an UnsignedInt.
47
-
@param ppf The formatter.
48
-
@param uint The UnsignedInt to print. *)
49
-
val pp : Format.formatter -> t -> unit
50
-
51
-
(** {1 Constants} *)
52
-
53
-
(** Zero value. *)
54
-
val zero : t
55
-
56
-
(** One value. *)
57
-
val one : t
58
-
59
-
(** Maximum safe value (2^53 - 1). *)
60
-
val max_safe : t
61
-
62
-
(** {1 Validation} *)
63
-
64
-
(** Check if an int is a valid UnsignedInt value.
65
-
@param i The int to validate.
66
-
@return True if the value is in valid range, false otherwise. *)
67
-
val is_valid_int : int -> bool
68
-
69
-
(** Validate an UnsignedInt according to JMAP constraints.
70
-
@param uint The UnsignedInt to validate.
71
-
@return Ok () if valid, Error with description if invalid. *)
72
-
val validate : t -> (unit, string) result
73
-
74
-
(** {1 Arithmetic Operations} *)
75
-
76
-
(** Add two UnsignedInts.
77
-
@param uint1 First UnsignedInt.
78
-
@param uint2 Second UnsignedInt.
79
-
@return Ok with the sum, or Error if overflow would occur. *)
80
-
val add : t -> t -> (t, string) result
81
-
82
-
(** Subtract two UnsignedInts.
83
-
@param uint1 First UnsignedInt (minuend).
84
-
@param uint2 Second UnsignedInt (subtrahend).
85
-
@return Ok with the difference, or Error if result would be negative. *)
86
-
val sub : t -> t -> (t, string) result
87
-
88
-
(** Multiply two UnsignedInts.
89
-
@param uint1 First UnsignedInt.
90
-
@param uint2 Second UnsignedInt.
91
-
@return Ok with the product, or Error if overflow would occur. *)
92
-
val mul : t -> t -> (t, string) result
93
-
94
-
(** {1 Comparison and Utilities} *)
95
-
96
-
(** Compare two UnsignedInts for equality.
97
-
@param uint1 First UnsignedInt.
98
-
@param uint2 Second UnsignedInt.
99
-
@return True if equal, false otherwise. *)
100
-
val equal : t -> t -> bool
101
-
102
-
(** Compare two UnsignedInts numerically.
103
-
@param uint1 First UnsignedInt.
104
-
@param uint2 Second UnsignedInt.
105
-
@return Negative if uint1 < uint2, zero if equal, positive if uint1 > uint2. *)
106
-
val compare : t -> t -> int
107
-
108
-
(** Get the minimum of two UnsignedInts.
109
-
@param uint1 First UnsignedInt.
110
-
@param uint2 Second UnsignedInt.
111
-
@return The smaller value. *)
112
-
val min : t -> t -> t
113
-
114
-
(** Get the maximum of two UnsignedInts.
115
-
@param uint1 First UnsignedInt.
116
-
@param uint2 Second UnsignedInt.
117
-
@return The larger value. *)
118
-
val max : t -> t -> t
119
-
120
-
(** Pretty-print an UnsignedInt for debugging.
121
-
@param ppf The formatter.
122
-
@param uint The UnsignedInt to format. *)
123
-
val pp_debug : Format.formatter -> t -> unit
124
-
125
-
(** Convert an UnsignedInt to a human-readable string for debugging.
126
-
@param uint The UnsignedInt to format.
127
-
@return A debug string representation. *)
128
-
val to_string_debug : t -> string
+3
-4
jmap/jmap/jmap_wire.ml
jmap/jmap/wire.ml
+3
-4
jmap/jmap/jmap_wire.ml
jmap/jmap/wire.ml
···
1
-
open Jmap_types
1
+
open Types
2
2
3
3
module Invocation = struct
4
4
type t = {
···
15
15
{ method_name; arguments; method_call_id }
16
16
end
17
17
18
-
type method_error = Jmap_error.Method_error.t * string
18
+
type method_error = Error.Method_error.t * string
19
19
20
20
type response_invocation = (Invocation.t, method_error) result
21
21
···
62
62
63
63
let v ~method_responses ?created_ids ~session_state () =
64
64
{ method_responses; created_ids; session_state }
65
-
end
66
-
65
+
end
+3
-3
jmap/jmap/jmap_wire.mli
jmap/jmap/wire.mli
+3
-3
jmap/jmap/jmap_wire.mli
jmap/jmap/wire.mli
···
12
12
13
13
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3> RFC 8620, Section 3 *)
14
14
15
-
open Jmap_types
15
+
open Types
16
16
17
17
(** {1 Method Invocations} *)
18
18
···
65
65
with the method call ID for correlation.
66
66
67
67
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.6.2> RFC 8620, Section 3.6.2 *)
68
-
type method_error = Jmap_error.Method_error.t * string
68
+
type method_error = Error.Method_error.t * string
69
69
70
70
(** A response invocation part, which can be a standard response or an error.
71
71
···
239
239
session_state:string ->
240
240
unit ->
241
241
t
242
-
end
242
+
end
+432
jmap/jmap/types.ml
+432
jmap/jmap/types.ml
···
1
+
(** JMAP Core Types Implementation *)
2
+
3
+
(* Id module implementation *)
4
+
module Id = struct
5
+
type t = string
6
+
7
+
let is_base64url_char c =
8
+
(c >= 'A' && c <= 'Z') ||
9
+
(c >= 'a' && c <= 'z') ||
10
+
(c >= '0' && c <= '9') ||
11
+
c = '-' || c = '_'
12
+
13
+
let is_valid_string str =
14
+
let len = String.length str in
15
+
len > 0 && len <= 255 &&
16
+
let rec check i =
17
+
if i >= len then true
18
+
else if is_base64url_char str.[i] then check (i + 1)
19
+
else false
20
+
in
21
+
check 0
22
+
23
+
let of_string str =
24
+
if is_valid_string str then Ok str
25
+
else
26
+
let len = String.length str in
27
+
if len = 0 then Error "Id cannot be empty"
28
+
else if len > 255 then Error "Id cannot be longer than 255 octets"
29
+
else Error "Id contains invalid characters (must be base64url alphabet only)"
30
+
31
+
let to_string id = id
32
+
33
+
let pp ppf id = Format.fprintf ppf "%s" id
34
+
35
+
let pp_hum ppf id = Format.fprintf ppf "Id(%s)" id
36
+
37
+
let validate id =
38
+
if is_valid_string id then Ok ()
39
+
else Error "Invalid Id format"
40
+
41
+
let equal = String.equal
42
+
43
+
let compare = String.compare
44
+
45
+
let pp_debug ppf id = Format.fprintf ppf "Id(%s)" id
46
+
47
+
let to_string_debug id = Printf.sprintf "Id(%s)" id
48
+
49
+
(* JSON serialization *)
50
+
let to_json id = `String id
51
+
52
+
let of_json = function
53
+
| `String str -> of_string str
54
+
| json ->
55
+
let json_str = Yojson.Safe.to_string json in
56
+
Error (Printf.sprintf "Expected JSON string for Id, got: %s" json_str)
57
+
end
58
+
59
+
(* Date module implementation *)
60
+
module Date = struct
61
+
type t = float (* Unix timestamp *)
62
+
63
+
(* Basic RFC 3339 parsing - simplified for JMAP usage *)
64
+
let parse_rfc3339 str =
65
+
try
66
+
(* Use Unix.strptime if available, otherwise simplified parsing *)
67
+
let len = String.length str in
68
+
if len < 19 then failwith "Too short for RFC 3339";
69
+
70
+
(* Extract year, month, day, hour, minute, second *)
71
+
let year = int_of_string (String.sub str 0 4) in
72
+
let month = int_of_string (String.sub str 5 2) in
73
+
let day = int_of_string (String.sub str 8 2) in
74
+
let hour = int_of_string (String.sub str 11 2) in
75
+
let minute = int_of_string (String.sub str 14 2) in
76
+
let second = int_of_string (String.sub str 17 2) in
77
+
78
+
(* Basic validation *)
79
+
if year < 1970 || year > 9999 then failwith "Invalid year";
80
+
if month < 1 || month > 12 then failwith "Invalid month";
81
+
if day < 1 || day > 31 then failwith "Invalid day";
82
+
if hour < 0 || hour > 23 then failwith "Invalid hour";
83
+
if minute < 0 || minute > 59 then failwith "Invalid minute";
84
+
if second < 0 || second > 59 then failwith "Invalid second";
85
+
86
+
(* Convert to Unix timestamp using built-in functions *)
87
+
let tm = {
88
+
Unix.tm_year = year - 1900;
89
+
tm_mon = month - 1;
90
+
tm_mday = day;
91
+
tm_hour = hour;
92
+
tm_min = minute;
93
+
tm_sec = second;
94
+
tm_wday = 0;
95
+
tm_yday = 0;
96
+
tm_isdst = false;
97
+
} in
98
+
99
+
(* Handle timezone - simplified to assume UTC for 'Z' suffix *)
100
+
let timestamp =
101
+
if len >= 20 && str.[len-1] = 'Z' then
102
+
(* UTC time - convert to UTC timestamp *)
103
+
let local_time = fst (Unix.mktime tm) in
104
+
let gm_tm = Unix.gmtime local_time in
105
+
let utc_time = fst (Unix.mktime gm_tm) in
106
+
utc_time
107
+
else if len >= 25 && (str.[len-6] = '+' || str.[len-6] = '-') then
108
+
(* Timezone offset specified *)
109
+
let sign = if str.[len-6] = '+' then -1.0 else 1.0 in
110
+
let tz_hours = int_of_string (String.sub str (len-5) 2) in
111
+
let tz_minutes = int_of_string (String.sub str (len-2) 2) in
112
+
let offset = sign *. (float_of_int tz_hours *. 3600.0 +. float_of_int tz_minutes *. 60.0) in
113
+
fst (Unix.mktime tm) +. offset
114
+
else
115
+
(* No timezone - assume local time *)
116
+
fst (Unix.mktime tm)
117
+
in
118
+
Ok timestamp
119
+
with
120
+
| Failure msg -> Error ("Invalid RFC 3339 format: " ^ msg)
121
+
| Invalid_argument _ -> Error "Invalid RFC 3339 format: parsing error"
122
+
| _ -> Error "Invalid RFC 3339 format"
123
+
124
+
let format_rfc3339 timestamp =
125
+
let tm = Unix.gmtime timestamp in
126
+
Printf.sprintf "%04d-%02d-%02dT%02d:%02d:%02dZ"
127
+
(tm.tm_year + 1900)
128
+
(tm.tm_mon + 1)
129
+
tm.tm_mday
130
+
tm.tm_hour
131
+
tm.tm_min
132
+
tm.tm_sec
133
+
134
+
let of_timestamp timestamp = timestamp
135
+
136
+
let to_timestamp date = date
137
+
138
+
let of_rfc3339 str = parse_rfc3339 str
139
+
140
+
let to_rfc3339 date = format_rfc3339 date
141
+
142
+
let now () = Unix.time ()
143
+
144
+
let validate date =
145
+
if date >= 0.0 && date <= 253402300799.0 (* 9999-12-31T23:59:59Z *) then
146
+
Ok ()
147
+
else
148
+
Error "Date timestamp out of valid range"
149
+
150
+
let equal date1 date2 =
151
+
(* Equal within 1 second precision *)
152
+
abs_float (date1 -. date2) < 1.0
153
+
154
+
let compare date1 date2 =
155
+
if date1 < date2 then -1
156
+
else if date1 > date2 then 1
157
+
else 0
158
+
159
+
let is_before date1 date2 = date1 < date2
160
+
161
+
let is_after date1 date2 = date1 > date2
162
+
163
+
let pp ppf date = Format.fprintf ppf "%s" (to_rfc3339 date)
164
+
165
+
let pp_hum ppf date = Format.fprintf ppf "Date(%s)" (to_rfc3339 date)
166
+
167
+
let pp_debug ppf date =
168
+
Format.fprintf ppf "Date(%s)" (to_rfc3339 date)
169
+
170
+
let to_string_debug date =
171
+
Printf.sprintf "Date(%s)" (to_rfc3339 date)
172
+
173
+
(* JSON serialization *)
174
+
let to_json date = `String (to_rfc3339 date)
175
+
176
+
let of_json = function
177
+
| `String str -> of_rfc3339 str
178
+
| json ->
179
+
let json_str = Yojson.Safe.to_string json in
180
+
Error (Printf.sprintf "Expected JSON string for Date, got: %s" json_str)
181
+
end
182
+
183
+
(* UInt module implementation *)
184
+
module UInt = struct
185
+
type t = int
186
+
187
+
(* Maximum safe integer value for JavaScript: 2^53 - 1 *)
188
+
let max_safe_value = 9007199254740991
189
+
190
+
let is_valid_int i = i >= 0 && i <= max_safe_value
191
+
192
+
let of_int i =
193
+
if is_valid_int i then Ok i
194
+
else if i < 0 then Error "UnsignedInt cannot be negative"
195
+
else Error "UnsignedInt cannot exceed 2^53-1"
196
+
197
+
let to_int uint = uint
198
+
199
+
let of_string str =
200
+
try
201
+
let i = int_of_string str in
202
+
of_int i
203
+
with
204
+
| Failure _ -> Error "Invalid integer string format"
205
+
| Invalid_argument _ -> Error "Invalid integer string format"
206
+
207
+
let to_string uint = string_of_int uint
208
+
209
+
let pp ppf uint = Format.fprintf ppf "%d" uint
210
+
211
+
let pp_hum ppf uint = Format.fprintf ppf "UInt(%d)" uint
212
+
213
+
(* Constants *)
214
+
let zero = 0
215
+
let one = 1
216
+
let max_safe = max_safe_value
217
+
218
+
let validate uint =
219
+
if is_valid_int uint then Ok ()
220
+
else Error "UnsignedInt value out of valid range"
221
+
222
+
(* Arithmetic operations with overflow checking *)
223
+
let add uint1 uint2 =
224
+
let result = uint1 + uint2 in
225
+
if result >= uint1 && result >= uint2 && is_valid_int result then
226
+
Ok result
227
+
else
228
+
Error "UnsignedInt addition overflow"
229
+
230
+
let sub uint1 uint2 =
231
+
if uint1 >= uint2 then Ok (uint1 - uint2)
232
+
else Error "UnsignedInt subtraction would result in negative value"
233
+
234
+
let mul uint1 uint2 =
235
+
if uint1 = 0 || uint2 = 0 then Ok 0
236
+
else if uint1 <= max_safe_value / uint2 then
237
+
Ok (uint1 * uint2)
238
+
else
239
+
Error "UnsignedInt multiplication overflow"
240
+
241
+
(* Comparison and utilities *)
242
+
let equal = (=)
243
+
244
+
let compare = compare
245
+
246
+
let min uint1 uint2 = if uint1 <= uint2 then uint1 else uint2
247
+
248
+
let max uint1 uint2 = if uint1 >= uint2 then uint1 else uint2
249
+
250
+
let pp_debug ppf uint = Format.fprintf ppf "UInt(%d)" uint
251
+
252
+
let to_string_debug uint = Printf.sprintf "UInt(%d)" uint
253
+
254
+
(* JSON serialization *)
255
+
let to_json uint = `Int uint
256
+
257
+
let of_json = function
258
+
| `Int i -> of_int i
259
+
| `Float f ->
260
+
(* Handle case where JSON parser represents integers as floats *)
261
+
if f >= 0.0 && f <= float_of_int max_safe_value && f = Float.round f then
262
+
of_int (int_of_float f)
263
+
else
264
+
Error "Float value is not a valid UnsignedInt"
265
+
| json ->
266
+
let json_str = Yojson.Safe.to_string json in
267
+
Error (Printf.sprintf "Expected JSON number for UnsignedInt, got: %s" json_str)
268
+
end
269
+
270
+
(* Patch module implementation *)
271
+
module Patch = struct
272
+
(* Internal representation as a hash table for efficient operations *)
273
+
type t = (string, Yojson.Safe.t) Hashtbl.t
274
+
275
+
(* JSON Pointer validation - simplified but covers common cases *)
276
+
let is_valid_property_path path =
277
+
let len = String.length path in
278
+
if len = 0 then true (* empty path is valid root *)
279
+
else if path.[0] <> '/' then true (* simple property names are valid *)
280
+
else
281
+
(* Check for valid JSON Pointer format *)
282
+
let rec check_escaping i =
283
+
if i >= len then true
284
+
else match path.[i] with
285
+
| '~' when i + 1 < len ->
286
+
(match path.[i + 1] with
287
+
| '0' | '1' -> check_escaping (i + 2)
288
+
| _ -> false)
289
+
| '/' -> check_escaping (i + 1)
290
+
| _ -> check_escaping (i + 1)
291
+
in
292
+
check_escaping 0
293
+
294
+
let empty = Hashtbl.create 8
295
+
296
+
let of_operations operations =
297
+
let patch = Hashtbl.create (List.length operations) in
298
+
let rec process = function
299
+
| [] -> Ok patch
300
+
| (property, value) :: rest ->
301
+
if is_valid_property_path property then (
302
+
Hashtbl.replace patch property value;
303
+
process rest
304
+
) else
305
+
Error ("Invalid property path: " ^ property)
306
+
in
307
+
process operations
308
+
309
+
let to_operations patch =
310
+
Hashtbl.fold (fun property value acc ->
311
+
(property, value) :: acc
312
+
) patch []
313
+
314
+
let of_json_object = function
315
+
| `Assoc pairs -> of_operations pairs
316
+
| json ->
317
+
let json_str = Yojson.Safe.to_string json in
318
+
Error (Printf.sprintf "Expected JSON object for Patch, got: %s" json_str)
319
+
320
+
let to_json_object patch =
321
+
let pairs = to_operations patch in
322
+
`Assoc pairs
323
+
324
+
let set_property patch property value =
325
+
if is_valid_property_path property then (
326
+
let new_patch = Hashtbl.copy patch in
327
+
Hashtbl.replace new_patch property value;
328
+
Ok new_patch
329
+
) else
330
+
Error ("Invalid property path: " ^ property)
331
+
332
+
let remove_property patch property =
333
+
set_property patch property `Null
334
+
335
+
let has_property patch property =
336
+
Hashtbl.mem patch property
337
+
338
+
let get_property patch property =
339
+
try Some (Hashtbl.find patch property)
340
+
with Not_found -> None
341
+
342
+
let merge patch1 patch2 =
343
+
let result = Hashtbl.copy patch1 in
344
+
Hashtbl.iter (fun property value ->
345
+
Hashtbl.replace result property value
346
+
) patch2;
347
+
result
348
+
349
+
let is_empty patch =
350
+
Hashtbl.length patch = 0
351
+
352
+
let size patch =
353
+
Hashtbl.length patch
354
+
355
+
let validate patch =
356
+
(* Validate all property paths *)
357
+
try
358
+
Hashtbl.iter (fun property _value ->
359
+
if not (is_valid_property_path property) then
360
+
failwith ("Invalid property path: " ^ property)
361
+
) patch;
362
+
Ok ()
363
+
with
364
+
| Failure msg -> Error msg
365
+
366
+
let equal patch1 patch2 =
367
+
if Hashtbl.length patch1 <> Hashtbl.length patch2 then false
368
+
else
369
+
try
370
+
Hashtbl.iter (fun property value1 ->
371
+
match get_property patch2 property with
372
+
| None -> failwith "Property not found"
373
+
| Some value2 when Yojson.Safe.equal value1 value2 -> ()
374
+
| Some _ -> failwith "Property values differ"
375
+
) patch1;
376
+
true
377
+
with
378
+
| Failure _ -> false
379
+
380
+
let pp ppf patch =
381
+
Format.fprintf ppf "%s" (Yojson.Safe.to_string (to_json_object patch))
382
+
383
+
let pp_hum ppf patch =
384
+
let operations = to_operations patch in
385
+
let op_count = List.length operations in
386
+
let key_list = List.map fst operations in
387
+
let key_str = match key_list with
388
+
| [] -> "none"
389
+
| keys -> String.concat ", " keys
390
+
in
391
+
Format.fprintf ppf "Patch{operations=%d; keys=[%s]}" op_count key_str
392
+
393
+
let to_string_debug patch =
394
+
let operations = to_operations patch in
395
+
let op_strings = List.map (fun (prop, value) ->
396
+
Printf.sprintf "%s: %s" prop (Yojson.Safe.to_string value)
397
+
) operations in
398
+
Printf.sprintf "Patch({%s})" (String.concat "; " op_strings)
399
+
400
+
(* JSON serialization *)
401
+
let to_json patch = to_json_object patch
402
+
403
+
let of_json json = of_json_object json
404
+
end
405
+
406
+
(* Legacy type aliases *)
407
+
type id = string
408
+
type jint = int
409
+
type uint = int
410
+
type date = float
411
+
type utc_date = float
412
+
413
+
(* Collection types *)
414
+
type 'v string_map = (string, 'v) Hashtbl.t
415
+
type 'v id_map = (id, 'v) Hashtbl.t
416
+
417
+
(* Protocol-specific types *)
418
+
type json_pointer = string
419
+
420
+
(* Constants module *)
421
+
module Constants = struct
422
+
let vacation_response_id = "singleton"
423
+
424
+
module Content_type = struct
425
+
let json = "application/json"
426
+
end
427
+
428
+
module User_agent = struct
429
+
let ocaml_jmap = "OCaml-JMAP/1.0"
430
+
let eio_client = "OCaml JMAP Client/Eio"
431
+
end
432
+
end
+592
jmap/jmap/types.mli
+592
jmap/jmap/types.mli
···
1
+
(** JMAP Core Types Library (RFC 8620)
2
+
3
+
This module provides all fundamental JMAP data types in a unified interface.
4
+
It consolidates the core primitives (Id, Date, UInt), data structures (Patch),
5
+
and collection types used throughout the JMAP protocol.
6
+
7
+
The module is organized into clear sections:
8
+
- {!Types.Id}: JMAP Id type with validation and JSON serialization
9
+
- {!Types.Date}: JMAP Date type with RFC 3339 support
10
+
- {!Types.UInt}: JMAP UnsignedInt type with range validation
11
+
- {!Types.Patch}: JMAP Patch objects for property updates
12
+
- Legacy type aliases for backwards compatibility
13
+
14
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1> RFC 8620, Section 1 *)
15
+
16
+
(** {1 Core JMAP Types} *)
17
+
18
+
(** JMAP Id data type with validation and JSON serialization.
19
+
20
+
The Id data type is a string of 1 to 255 octets in length and MUST consist
21
+
only of characters from the base64url alphabet, as defined in Section 5 of
22
+
RFC 4648. This includes ASCII alphanumeric characters, plus the characters
23
+
'-' and '_'.
24
+
25
+
Ids are used to identify JMAP objects within an account. They are assigned
26
+
by the server and are immutable once assigned. The same id MUST refer to
27
+
the same object throughout the lifetime of the object.
28
+
29
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.2> RFC 8620, Section 1.2 *)
30
+
module Id : sig
31
+
(** Abstract type representing a JMAP Id. *)
32
+
type t
33
+
34
+
(** JSON serialization interface *)
35
+
include Jmap_sigs.JSONABLE with type t := t
36
+
37
+
(** Pretty-printing interface *)
38
+
include Jmap_sigs.PRINTABLE with type t := t
39
+
40
+
(** {2 Construction and Access} *)
41
+
42
+
(** Create a new Id from a string.
43
+
@param str The string representation.
44
+
@return Ok with the created Id, or Error if the string violates Id constraints. *)
45
+
val of_string : string -> (t, string) result
46
+
47
+
(** Convert an Id to its string representation.
48
+
@param id The Id to convert.
49
+
@return The string representation. *)
50
+
val to_string : t -> string
51
+
52
+
(** Pretty-print an Id.
53
+
@param ppf The formatter.
54
+
@param id The Id to print. *)
55
+
val pp : Format.formatter -> t -> unit
56
+
57
+
(** {2 Validation} *)
58
+
59
+
(** Check if a string is a valid JMAP Id.
60
+
@param str The string to validate.
61
+
@return True if the string meets Id requirements, false otherwise. *)
62
+
val is_valid_string : string -> bool
63
+
64
+
(** Validate an Id according to JMAP constraints.
65
+
@param id The Id to validate.
66
+
@return Ok () if valid, Error with description if invalid. *)
67
+
val validate : t -> (unit, string) result
68
+
69
+
(** {2 Comparison and Utilities} *)
70
+
71
+
(** Compare two Ids for equality.
72
+
@param id1 First Id.
73
+
@param id2 Second Id.
74
+
@return True if equal, false otherwise. *)
75
+
val equal : t -> t -> bool
76
+
77
+
(** Compare two Ids lexicographically.
78
+
@param id1 First Id.
79
+
@param id2 Second Id.
80
+
@return Negative if id1 < id2, zero if equal, positive if id1 > id2. *)
81
+
val compare : t -> t -> int
82
+
83
+
(** Pretty-print an Id for debugging.
84
+
@param ppf The formatter.
85
+
@param id The Id to format. *)
86
+
val pp_debug : Format.formatter -> t -> unit
87
+
88
+
(** Convert an Id to a human-readable string for debugging.
89
+
@param id The Id to format.
90
+
@return A debug string representation. *)
91
+
val to_string_debug : t -> string
92
+
end
93
+
94
+
(** JMAP Date data type with RFC 3339 support and JSON serialization.
95
+
96
+
The Date data type is a string in RFC 3339 "date-time" format, optionally
97
+
with timezone information. For example: "2014-10-30T14:12:00+08:00" or
98
+
"2014-10-30T06:12:00Z".
99
+
100
+
In this OCaml implementation, dates are internally represented as Unix
101
+
timestamps (float) for efficient computation, with conversion to/from
102
+
RFC 3339 string format handled by the serialization functions.
103
+
104
+
{b Note}: When represented as a float, precision may be lost for sub-second
105
+
values. The implementation preserves second-level precision.
106
+
107
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.4> RFC 8620, Section 1.4
108
+
@see <https://www.rfc-editor.org/rfc/rfc3339.html> RFC 3339 *)
109
+
module Date : sig
110
+
(** Abstract type representing a JMAP Date. *)
111
+
type t
112
+
113
+
(** JSON serialization interface *)
114
+
include Jmap_sigs.JSONABLE with type t := t
115
+
116
+
(** Pretty-printing interface *)
117
+
include Jmap_sigs.PRINTABLE with type t := t
118
+
119
+
(** {2 Construction and Access} *)
120
+
121
+
(** Create a Date from a Unix timestamp.
122
+
@param timestamp The Unix timestamp (seconds since epoch).
123
+
@return A Date representing the timestamp. *)
124
+
val of_timestamp : float -> t
125
+
126
+
(** Convert a Date to a Unix timestamp.
127
+
@param date The Date to convert.
128
+
@return The Unix timestamp (seconds since epoch). *)
129
+
val to_timestamp : t -> float
130
+
131
+
(** Create a Date from an RFC 3339 string.
132
+
@param str The RFC 3339 formatted string.
133
+
@return Ok with the parsed Date, or Error if the string is not valid RFC 3339. *)
134
+
val of_rfc3339 : string -> (t, string) result
135
+
136
+
(** Convert a Date to an RFC 3339 string.
137
+
@param date The Date to convert.
138
+
@return The RFC 3339 formatted string. *)
139
+
val to_rfc3339 : t -> string
140
+
141
+
(** Create a Date representing the current time.
142
+
@return A Date set to the current time. *)
143
+
val now : unit -> t
144
+
145
+
(** {2 Validation} *)
146
+
147
+
(** Validate a Date according to JMAP constraints.
148
+
@param date The Date to validate.
149
+
@return Ok () if valid, Error with description if invalid. *)
150
+
val validate : t -> (unit, string) result
151
+
152
+
(** {2 Comparison and Utilities} *)
153
+
154
+
(** Compare two Dates for equality.
155
+
@param date1 First Date.
156
+
@param date2 Second Date.
157
+
@return True if equal (within 1 second precision), false otherwise. *)
158
+
val equal : t -> t -> bool
159
+
160
+
(** Compare two Dates chronologically.
161
+
@param date1 First Date.
162
+
@param date2 Second Date.
163
+
@return Negative if date1 < date2, zero if equal, positive if date1 > date2. *)
164
+
val compare : t -> t -> int
165
+
166
+
(** Check if first Date is before second Date.
167
+
@param date1 First Date.
168
+
@param date2 Second Date.
169
+
@return True if date1 is before date2. *)
170
+
val is_before : t -> t -> bool
171
+
172
+
(** Check if first Date is after second Date.
173
+
@param date1 First Date.
174
+
@param date2 Second Date.
175
+
@return True if date1 is after date2. *)
176
+
val is_after : t -> t -> bool
177
+
178
+
(** Pretty-print a Date in RFC3339 format.
179
+
@param ppf The formatter.
180
+
@param date The Date to print. *)
181
+
val pp : Format.formatter -> t -> unit
182
+
183
+
(** Pretty-print a Date for debugging.
184
+
@param ppf The formatter.
185
+
@param date The Date to format. *)
186
+
val pp_debug : Format.formatter -> t -> unit
187
+
188
+
(** Convert a Date to a human-readable string for debugging.
189
+
@param date The Date to format.
190
+
@return A debug string representation. *)
191
+
val to_string_debug : t -> string
192
+
end
193
+
194
+
(** JMAP UnsignedInt data type with range validation and JSON serialization.
195
+
196
+
The UnsignedInt data type is an unsigned integer in the range [0, 2^53-1].
197
+
This corresponds to the safe integer range for unsigned values in JavaScript
198
+
and JSON implementations.
199
+
200
+
In OCaml, this is represented as a regular [int]. Note that OCaml's [int]
201
+
on 64-bit platforms has a larger range, but JMAP protocol compliance
202
+
requires staying within the specified range and ensuring non-negative values.
203
+
204
+
Common uses include counts, limits, positions, and sizes within the protocol.
205
+
206
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.3> RFC 8620, Section 1.3 *)
207
+
module UInt : sig
208
+
(** Abstract type representing a JMAP UnsignedInt. *)
209
+
type t
210
+
211
+
(** JSON serialization interface *)
212
+
include Jmap_sigs.JSONABLE with type t := t
213
+
214
+
(** Pretty-printing interface *)
215
+
include Jmap_sigs.PRINTABLE with type t := t
216
+
217
+
(** {2 Construction and Access} *)
218
+
219
+
(** Create an UnsignedInt from an int.
220
+
@param i The int value.
221
+
@return Ok with the UnsignedInt, or Error if the value is negative or too large. *)
222
+
val of_int : int -> (t, string) result
223
+
224
+
(** Convert an UnsignedInt to an int.
225
+
@param uint The UnsignedInt to convert.
226
+
@return The int representation. *)
227
+
val to_int : t -> int
228
+
229
+
(** Create an UnsignedInt from a string.
230
+
@param str The string representation of a non-negative integer.
231
+
@return Ok with the UnsignedInt, or Error if parsing fails or value is invalid. *)
232
+
val of_string : string -> (t, string) result
233
+
234
+
(** Convert an UnsignedInt to a string.
235
+
@param uint The UnsignedInt to convert.
236
+
@return The string representation. *)
237
+
val to_string : t -> string
238
+
239
+
(** Pretty-print an UnsignedInt.
240
+
@param ppf The formatter.
241
+
@param uint The UnsignedInt to print. *)
242
+
val pp : Format.formatter -> t -> unit
243
+
244
+
(** {2 Constants} *)
245
+
246
+
(** Zero value. *)
247
+
val zero : t
248
+
249
+
(** One value. *)
250
+
val one : t
251
+
252
+
(** Maximum safe value (2^53 - 1). *)
253
+
val max_safe : t
254
+
255
+
(** {2 Validation} *)
256
+
257
+
(** Check if an int is a valid UnsignedInt value.
258
+
@param i The int to validate.
259
+
@return True if the value is in valid range, false otherwise. *)
260
+
val is_valid_int : int -> bool
261
+
262
+
(** Validate an UnsignedInt according to JMAP constraints.
263
+
@param uint The UnsignedInt to validate.
264
+
@return Ok () if valid, Error with description if invalid. *)
265
+
val validate : t -> (unit, string) result
266
+
267
+
(** {2 Arithmetic Operations} *)
268
+
269
+
(** Add two UnsignedInts.
270
+
@param uint1 First UnsignedInt.
271
+
@param uint2 Second UnsignedInt.
272
+
@return Ok with the sum, or Error if overflow would occur. *)
273
+
val add : t -> t -> (t, string) result
274
+
275
+
(** Subtract two UnsignedInts.
276
+
@param uint1 First UnsignedInt (minuend).
277
+
@param uint2 Second UnsignedInt (subtrahend).
278
+
@return Ok with the difference, or Error if result would be negative. *)
279
+
val sub : t -> t -> (t, string) result
280
+
281
+
(** Multiply two UnsignedInts.
282
+
@param uint1 First UnsignedInt.
283
+
@param uint2 Second UnsignedInt.
284
+
@return Ok with the product, or Error if overflow would occur. *)
285
+
val mul : t -> t -> (t, string) result
286
+
287
+
(** {2 Comparison and Utilities} *)
288
+
289
+
(** Compare two UnsignedInts for equality.
290
+
@param uint1 First UnsignedInt.
291
+
@param uint2 Second UnsignedInt.
292
+
@return True if equal, false otherwise. *)
293
+
val equal : t -> t -> bool
294
+
295
+
(** Compare two UnsignedInts numerically.
296
+
@param uint1 First UnsignedInt.
297
+
@param uint2 Second UnsignedInt.
298
+
@return Negative if uint1 < uint2, zero if equal, positive if uint1 > uint2. *)
299
+
val compare : t -> t -> int
300
+
301
+
(** Get the minimum of two UnsignedInts.
302
+
@param uint1 First UnsignedInt.
303
+
@param uint2 Second UnsignedInt.
304
+
@return The smaller value. *)
305
+
val min : t -> t -> t
306
+
307
+
(** Get the maximum of two UnsignedInts.
308
+
@param uint1 First UnsignedInt.
309
+
@param uint2 Second UnsignedInt.
310
+
@return The larger value. *)
311
+
val max : t -> t -> t
312
+
313
+
(** Pretty-print an UnsignedInt for debugging.
314
+
@param ppf The formatter.
315
+
@param uint The UnsignedInt to format. *)
316
+
val pp_debug : Format.formatter -> t -> unit
317
+
318
+
(** Convert an UnsignedInt to a human-readable string for debugging.
319
+
@param uint The UnsignedInt to format.
320
+
@return A debug string representation. *)
321
+
val to_string_debug : t -> string
322
+
end
323
+
324
+
(** JMAP Patch Object for property updates with JSON serialization.
325
+
326
+
A patch object is used to update properties of JMAP objects. It represents
327
+
a JSON object where each key is a property path (using JSON Pointer syntax)
328
+
and each value is the new value to set for that property, or null to remove
329
+
the property.
330
+
331
+
Patch objects are commonly used in /set method calls to update existing
332
+
objects without having to send the complete object representation.
333
+
334
+
Examples of patch operations:
335
+
- Setting a property: [{"name": "New Name"}]
336
+
- Removing a property: [{"oldProperty": null}]
337
+
- Setting nested properties: [{"address/street": "123 Main St"}]
338
+
339
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.3> RFC 8620, Section 5.3
340
+
@see <https://www.rfc-editor.org/rfc/rfc6901.html> RFC 6901 (JSON Pointer) *)
341
+
module Patch : sig
342
+
(** Abstract type representing a JMAP Patch Object. *)
343
+
type t
344
+
345
+
(** JSON serialization interface *)
346
+
include Jmap_sigs.JSONABLE with type t := t
347
+
348
+
(** Pretty-printing interface *)
349
+
include Jmap_sigs.PRINTABLE with type t := t
350
+
351
+
(** {2 Construction and Access} *)
352
+
353
+
(** Create an empty patch object.
354
+
@return An empty patch with no operations. *)
355
+
val empty : t
356
+
357
+
(** Create a patch from a list of property-value pairs.
358
+
@param operations List of (property_path, value) pairs.
359
+
@return Ok with the patch, or Error if any property path is invalid. *)
360
+
val of_operations : (string * Yojson.Safe.t) list -> (t, string) result
361
+
362
+
(** Convert a patch to a list of property-value pairs.
363
+
@param patch The patch to convert.
364
+
@return List of (property_path, value) pairs. *)
365
+
val to_operations : t -> (string * Yojson.Safe.t) list
366
+
367
+
(** Create a patch from a Yojson.Safe.t object directly.
368
+
@param json The JSON object.
369
+
@return Ok with the patch, or Error if the JSON is not a valid object. *)
370
+
val of_json_object : Yojson.Safe.t -> (t, string) result
371
+
372
+
(** Convert a patch to a Yojson.Safe.t object directly.
373
+
@param patch The patch to convert.
374
+
@return The JSON object representation. *)
375
+
val to_json_object : t -> Yojson.Safe.t
376
+
377
+
(** {2 Patch Operations} *)
378
+
379
+
(** Set a property in the patch.
380
+
@param patch The patch to modify.
381
+
@param property The property path (JSON Pointer format).
382
+
@param value The value to set.
383
+
@return Ok with the updated patch, or Error if the property path is invalid. *)
384
+
val set_property : t -> string -> Yojson.Safe.t -> (t, string) result
385
+
386
+
(** Remove a property in the patch (set to null).
387
+
@param patch The patch to modify.
388
+
@param property The property path to remove.
389
+
@return Ok with the updated patch, or Error if the property path is invalid. *)
390
+
val remove_property : t -> string -> (t, string) result
391
+
392
+
(** Check if a property is set in the patch.
393
+
@param patch The patch to check.
394
+
@param property The property path to check.
395
+
@return True if the property is explicitly set in the patch. *)
396
+
val has_property : t -> string -> bool
397
+
398
+
(** Get a property value from the patch.
399
+
@param patch The patch to query.
400
+
@param property The property path to get.
401
+
@return Some value if the property is set, None if not present. *)
402
+
val get_property : t -> string -> Yojson.Safe.t option
403
+
404
+
(** {2 Patch Composition} *)
405
+
406
+
(** Merge two patches, with the second patch taking precedence.
407
+
@param patch1 The first patch.
408
+
@param patch2 The second patch (higher precedence).
409
+
@return The merged patch. *)
410
+
val merge : t -> t -> t
411
+
412
+
(** Check if a patch is empty (no operations).
413
+
@param patch The patch to check.
414
+
@return True if the patch has no operations. *)
415
+
val is_empty : t -> bool
416
+
417
+
(** Get the number of operations in a patch.
418
+
@param patch The patch to count.
419
+
@return The number of property operations. *)
420
+
val size : t -> int
421
+
422
+
(** {2 Validation} *)
423
+
424
+
(** Validate a patch according to JMAP constraints.
425
+
@param patch The patch to validate.
426
+
@return Ok () if valid, Error with description if invalid. *)
427
+
val validate : t -> (unit, string) result
428
+
429
+
(** Validate a JSON Pointer path.
430
+
@param path The property path to validate.
431
+
@return True if the path is a valid JSON Pointer, false otherwise. *)
432
+
val is_valid_property_path : string -> bool
433
+
434
+
(** {2 Comparison and Utilities} *)
435
+
436
+
(** Compare two patches for equality.
437
+
@param patch1 First patch.
438
+
@param patch2 Second patch.
439
+
@return True if patches have identical operations, false otherwise. *)
440
+
val equal : t -> t -> bool
441
+
442
+
(** Convert a patch to a human-readable string for debugging.
443
+
@param patch The patch to format.
444
+
@return A debug string representation. *)
445
+
val to_string_debug : t -> string
446
+
end
447
+
448
+
(** {1 Legacy Types and Collections}
449
+
450
+
This section provides type aliases and collection types for compatibility
451
+
and common use cases throughout the JMAP protocol. These types maintain
452
+
backwards compatibility with existing code while the core types above
453
+
provide the preferred interface. *)
454
+
455
+
(** The Id data type (legacy alias - prefer {!Types.Id}).
456
+
457
+
A string of 1 to 255 octets in length and MUST consist only of characters
458
+
from the base64url alphabet, as defined in Section 5 of RFC 4648. This
459
+
includes ASCII alphanumeric characters, plus the characters '-' and '_'.
460
+
461
+
Ids are used to identify JMAP objects within an account. They are assigned
462
+
by the server and are immutable once assigned. The same id MUST refer to
463
+
the same object throughout the lifetime of the object.
464
+
465
+
{b Note}: In this OCaml implementation, ids are represented as regular strings.
466
+
Validation of id format is the responsibility of the client/server implementation.
467
+
468
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.2> RFC 8620, Section 1.2 *)
469
+
type id = string
470
+
471
+
(** The Int data type.
472
+
473
+
A signed 53-bit integer in the range [-2^53+1, 2^53-1]. This corresponds
474
+
to the safe integer range in JavaScript and JSON implementations.
475
+
476
+
In OCaml, this is represented as a regular [int]. Note that OCaml's [int]
477
+
on 64-bit platforms has a larger range, but JMAP protocol compliance
478
+
requires staying within the specified range.
479
+
480
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.3> RFC 8620, Section 1.3 *)
481
+
type jint = int
482
+
483
+
(** The UnsignedInt data type (legacy alias - prefer {!Types.UInt}).
484
+
485
+
An unsigned integer in the range [0, 2^53-1]. This is the same as [jint]
486
+
but restricted to non-negative values.
487
+
488
+
Common uses include counts, limits, positions, and sizes within the protocol.
489
+
490
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.3> RFC 8620, Section 1.3 *)
491
+
type uint = int
492
+
493
+
(** The Date data type (legacy alias - prefer {!Types.Date}).
494
+
495
+
A string in RFC 3339 "date-time" format, optionally with timezone information.
496
+
For example: "2014-10-30T14:12:00+08:00" or "2014-10-30T06:12:00Z".
497
+
498
+
In this OCaml implementation, dates are represented as Unix timestamps (float).
499
+
Conversion to/from RFC 3339 string format is handled by the wire protocol
500
+
serialization layer.
501
+
502
+
{b Note}: When represented as a float, precision may be lost for sub-second
503
+
values. Consider the precision requirements of your application.
504
+
505
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.4> RFC 8620, Section 1.4
506
+
@see <https://www.rfc-editor.org/rfc/rfc3339.html> RFC 3339 *)
507
+
type date = float
508
+
509
+
(** The UTCDate data type.
510
+
511
+
A string in RFC 3339 "date-time" format with timezone restricted to UTC
512
+
(i.e., ending with "Z"). For example: "2014-10-30T06:12:00Z".
513
+
514
+
This is a more restrictive version of the [date] type, used in contexts
515
+
where timezone normalization is required.
516
+
517
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.4> RFC 8620, Section 1.4 *)
518
+
type utc_date = float
519
+
520
+
(** {2 Collection Types} *)
521
+
522
+
(** Represents a JSON object used as a map from String to arbitrary values.
523
+
524
+
In JMAP, many objects are represented as maps with string keys. This type
525
+
provides a convenient OCaml representation using hash tables for efficient
526
+
lookup and modification.
527
+
528
+
{b Usage example}: Account capabilities, session capabilities, and various
529
+
property maps throughout the protocol.
530
+
531
+
@param 'v The type of values stored in the map *)
532
+
type 'v string_map = (string, 'v) Hashtbl.t
533
+
534
+
(** Represents a JSON object used as a map from Id to arbitrary values.
535
+
536
+
This is similar to [string_map] but specifically for JMAP Id keys. Common
537
+
use cases include mapping object IDs to objects, errors, or update information.
538
+
539
+
{b Usage example}: The "create" argument in /set methods maps client-assigned
540
+
IDs to objects to be created.
541
+
542
+
@param 'v The type of values stored in the map *)
543
+
type 'v id_map = (id, 'v) Hashtbl.t
544
+
545
+
(** {2 Protocol-Specific Types} *)
546
+
547
+
(** Represents a JSON Pointer path with JMAP extensions.
548
+
549
+
A JSON Pointer is a string syntax for identifying specific values within
550
+
a JSON document. JMAP extends this with additional syntax for referencing
551
+
values from previous method calls within the same request.
552
+
553
+
Examples of valid JSON pointers in JMAP:
554
+
- "/property" - References the "property" field in the root object
555
+
- "/items/0" - References the first item in the "items" array
556
+
- "*" - Represents all properties or all array elements
557
+
558
+
The pointer syntax is used extensively in result references and patch
559
+
operations within JMAP.
560
+
561
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.7> RFC 8620, Section 3.7
562
+
@see <https://www.rfc-editor.org/rfc/rfc6901.html> RFC 6901 (JSON Pointer) *)
563
+
type json_pointer = string
564
+
565
+
(** {2 Protocol Constants} *)
566
+
567
+
(** Protocol constants for common values.
568
+
569
+
This module contains commonly used constant values throughout the
570
+
JMAP protocol, reducing hardcoded strings and providing type safety. *)
571
+
module Constants : sig
572
+
(** VacationResponse singleton object ID.
573
+
574
+
VacationResponse objects always use this fixed ID per JMAP specification.
575
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-7> RFC 8621, Section 7 *)
576
+
val vacation_response_id : string
577
+
578
+
(** HTTP Content-Type values for JMAP protocol. *)
579
+
module Content_type : sig
580
+
(** JMAP protocol content type. *)
581
+
val json : string
582
+
end
583
+
584
+
(** Default User-Agent strings. *)
585
+
module User_agent : sig
586
+
(** Default OCaml JMAP client user agent. *)
587
+
val ocaml_jmap : string
588
+
589
+
(** Eio-based client user agent. *)
590
+
val eio_client : string
591
+
end
592
+
end
+23
-23
jmap/test_method.ml
+23
-23
jmap/test_method.ml
···
5
5
printf "Testing JMAP Id module:\n";
6
6
7
7
(* Test valid ID creation *)
8
-
let valid_id = Jmap.Id.of_string "abc123-_xyz" in
8
+
let valid_id = Jmap.Types.Id.of_string "abc123-_xyz" in
9
9
match valid_id with
10
10
| Ok id ->
11
-
printf "✓ Created valid ID: %s\n" (Jmap.Id.to_string id);
12
-
printf "✓ Debug representation: %s\n" (Jmap.Id.to_string_debug id)
11
+
printf "✓ Created valid ID: %s\n" (Jmap.Types.Id.to_string id);
12
+
printf "✓ Debug representation: %s\n" (Jmap.Types.Id.to_string_debug id)
13
13
| Error msg ->
14
14
printf "✗ Failed to create valid ID: %s\n" msg
15
15
···
17
17
printf "\nTesting JMAP Date module:\n";
18
18
19
19
(* Test RFC 3339 parsing *)
20
-
let rfc_date = Jmap.Date.of_rfc3339 "2023-12-01T10:30:00Z" in
20
+
let rfc_date = Jmap.Types.Date.of_rfc3339 "2023-12-01T10:30:00Z" in
21
21
match rfc_date with
22
22
| Ok date ->
23
-
printf "✓ Parsed RFC 3339 date: %s\n" (Jmap.Date.to_rfc3339 date);
24
-
printf "✓ Debug representation: %s\n" (Jmap.Date.to_string_debug date)
23
+
printf "✓ Parsed RFC 3339 date: %s\n" (Jmap.Types.Date.to_rfc3339 date);
24
+
printf "✓ Debug representation: %s\n" (Jmap.Types.Date.to_string_debug date)
25
25
| Error msg ->
26
26
printf "✗ Failed to parse RFC 3339 date: %s\n" msg
27
27
···
29
29
printf "\nTesting JMAP UInt module:\n";
30
30
31
31
(* Test valid unsigned int *)
32
-
let valid_uint = Jmap.UInt.of_int 42 in
32
+
let valid_uint = Jmap.Types.UInt.of_int 42 in
33
33
match valid_uint with
34
34
| Ok uint ->
35
-
printf "✓ Created UInt: %d\n" (Jmap.UInt.to_int uint);
36
-
printf "✓ Debug representation: %s\n" (Jmap.UInt.to_string_debug uint)
35
+
printf "✓ Created UInt: %d\n" (Jmap.Types.UInt.to_int uint);
36
+
printf "✓ Debug representation: %s\n" (Jmap.Types.UInt.to_string_debug uint)
37
37
| Error msg ->
38
38
printf "✗ Failed to create UInt: %s\n" msg;
39
39
40
40
(* Test invalid (negative) int *)
41
-
let invalid_uint = Jmap.UInt.of_int (-1) in
41
+
let invalid_uint = Jmap.Types.UInt.of_int (-1) in
42
42
match invalid_uint with
43
43
| Ok _ -> printf "✗ Should have failed for negative value\n"
44
44
| Error msg -> printf "✓ Correctly rejected negative value: %s\n" msg
···
47
47
printf "\nTesting JMAP Patch module:\n";
48
48
49
49
(* Test empty patch *)
50
-
let empty = Jmap.Patch.empty in
51
-
printf "✓ Empty patch created, size: %d\n" (Jmap.Patch.size empty);
50
+
let empty = Jmap.Types.Patch.empty in
51
+
printf "✓ Empty patch created, size: %d\n" (Jmap.Types.Patch.size empty);
52
52
53
53
(* Test setting a property *)
54
-
match Jmap.Patch.set_property empty "name" (`String "John") with
54
+
match Jmap.Types.Patch.set_property empty "name" (`String "John") with
55
55
| Ok patch ->
56
-
printf "✓ Set property 'name': %s\n" (Jmap.Patch.to_string_debug patch);
57
-
printf "✓ Has property 'name': %b\n" (Jmap.Patch.has_property patch "name")
56
+
printf "✓ Set property 'name': %s\n" (Jmap.Types.Patch.to_string_debug patch);
57
+
printf "✓ Has property 'name': %b\n" (Jmap.Types.Patch.has_property patch "name")
58
58
| Error msg ->
59
59
printf "✗ Failed to set property: %s\n" msg
60
60
···
62
62
printf "\nTesting JSON serialization:\n";
63
63
64
64
(* Test Id JSON roundtrip *)
65
-
(match Jmap.Id.of_string "test123" with
65
+
(match Jmap.Types.Id.of_string "test123" with
66
66
| Ok id ->
67
-
let json = Jmap.Id.to_json id in
68
-
let parsed = Jmap.Id.of_json json in
67
+
let json = Jmap.Types.Id.to_json id in
68
+
let parsed = Jmap.Types.Id.of_json json in
69
69
(match parsed with
70
-
| Ok parsed_id when Jmap.Id.equal id parsed_id ->
70
+
| Ok parsed_id when Jmap.Types.Id.equal id parsed_id ->
71
71
printf "✓ Id JSON roundtrip successful\n"
72
72
| Ok _ -> printf "✗ Id JSON roundtrip failed - values differ\n"
73
73
| Error msg -> printf "✗ Id JSON parsing failed: %s\n" msg)
74
74
| Error msg -> printf "✗ Failed to create test Id: %s\n" msg);
75
75
76
76
(* Test UInt JSON roundtrip *)
77
-
(match Jmap.UInt.of_int 100 with
77
+
(match Jmap.Types.UInt.of_int 100 with
78
78
| Ok uint ->
79
-
let json = Jmap.UInt.to_json uint in
80
-
let parsed = Jmap.UInt.of_json json in
79
+
let json = Jmap.Types.UInt.to_json uint in
80
+
let parsed = Jmap.Types.UInt.of_json json in
81
81
(match parsed with
82
-
| Ok parsed_uint when Jmap.UInt.equal uint parsed_uint ->
82
+
| Ok parsed_uint when Jmap.Types.UInt.equal uint parsed_uint ->
83
83
printf "✓ UInt JSON roundtrip successful\n"
84
84
| Ok _ -> printf "✗ UInt JSON roundtrip failed - values differ\n"
85
85
| Error msg -> printf "✗ UInt JSON parsing failed: %s\n" msg)