this repo has no description
more
+2684
-4145
+9
-6
jmap/bin/fastmail_connect.ml
+9
-6
jmap/bin/fastmail_connect.ml
···
5
5
6
6
let fetch_recent_emails env ctx session =
7
7
try
8
-
let account_id = Jmap_unix.Session_utils.get_primary_mail_account session in
9
-
printf "Using account: %s\nBuilding JMAP request using type-safe capabilities...\n" account_id;
8
+
let account_id_str = Jmap_unix.Session_utils.get_primary_mail_account session in
9
+
let account_id = match Jmap.Id.of_string account_id_str with
10
+
| Ok id -> id
11
+
| Error err -> failwith ("Invalid account ID: " ^ err) in
12
+
printf "Using account: %s\nBuilding JMAP request using type-safe capabilities...\n" account_id_str;
10
13
11
14
let query_json =
12
15
Jmap_email.Query.(query () |> with_account account_id |> order_by Sort.by_date_desc |> limit 5 |> build_email_query) in
···
56
59
printf " Subject: %s\n" (Jmap_email.Email.subject email |> Option.value ~default:"(No Subject)");
57
60
print_sender email;
58
61
Jmap_email.Email.(received_at email |> Option.iter (fun t ->
59
-
printf " Date: %s\n" Jmap.Types.Date.(of_timestamp t |> to_rfc3339)));
62
+
printf " Date: %s\n" (Jmap.Date.to_rfc3339 t)));
60
63
print_preview email
61
64
) emails;
62
65
printf "━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━\n";
···
77
80
printf "Testing core JMAP modules...\n";
78
81
79
82
let test_modules = [
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
+
("Jmap.Id", Jmap.Id.(of_string "test-id-123" |> Result.map (Format.asprintf "%a" pp)));
84
+
("Jmap.Date", Ok (Jmap.Date.(Unix.time () |> of_timestamp |> to_timestamp |> Printf.sprintf "%.0f")));
85
+
("Jmap.UInt", Jmap.UInt.(of_int 42 |> Result.map (Format.asprintf "%a" pp)));
83
86
] in
84
87
85
88
let test_results = List.map (fun (name, result) -> match result with
+2
-2
jmap/examples/mailboxes_client.ml
+2
-2
jmap/examples/mailboxes_client.ml
···
53
53
~account_id
54
54
~name:"Revolutionary Test Folder"
55
55
~role:None () in
56
-
printf "✅ Created mailbox: %s\n\n" (Jmap.Types.Id.to_string test_mailbox_id);
56
+
printf "✅ Created mailbox: %s\n\n" (stringo_string test_mailbox_id);
57
57
58
58
(* Create child mailbox with hierarchy *)
59
59
printf "📂 Creating child mailbox...\n";
···
61
61
~account_id
62
62
~name:"Test Subfolder"
63
63
~parent_id:test_mailbox_id () in
64
-
printf "✅ Created child mailbox: %s\n\n" (Jmap.Types.Id.to_string child_mailbox_id);
64
+
printf "✅ Created child mailbox: %s\n\n" (stringo_string child_mailbox_id);
65
65
66
66
(* Query only user-created mailboxes *)
67
67
printf "🔍 Querying user-created mailboxes...\n";
+3
-3
jmap/examples/messages_client.ml
+3
-3
jmap/examples/messages_client.ml
···
56
56
in
57
57
58
58
let trash_id = inbox_id in (* Simplified - would normally find actual Trash *)
59
-
printf "✅ Found Inbox: %s\n" (Jmap.Types.Id.to_string inbox_id);
60
-
printf "✅ Found Trash: %s\n\n" (Jmap.Types.Id.to_string trash_id);
59
+
printf "✅ Found Inbox: %s\n" (stringo_string inbox_id);
60
+
printf "✅ Found Trash: %s\n\n" (stringo_string trash_id);
61
61
62
62
(* Import message - revolutionary single line *)
63
63
printf "📥 Importing test message...\n";
···
68
68
~keywords:["$draft"] () in
69
69
70
70
let email_id = Jmap_email.Email.id imported_email |> Option.get in
71
-
printf "✅ Imported email: %s\n\n" (Jmap.Types.Id.to_string email_id);
71
+
printf "✅ Imported email: %s\n\n" (stringo_string email_id);
72
72
73
73
(* Query for our test message - revolutionary filtering *)
74
74
printf "🔍 Querying for test messages...\n";
+3
-4
jmap/jmap-email/apple.ml
+3
-4
jmap/jmap-email/apple.ml
···
4
4
flag encoding defined in draft-ietf-mailmaint-messageflag.
5
5
*)
6
6
7
-
open Types
8
7
9
8
(** Apple Mail color flag enumeration *)
10
9
type color =
···
69
68
Jmap.Methods.Filter.operator `AND [bit0_filter; bit1_filter; bit2_filter]
70
69
| [single_keyword] ->
71
70
(* Single keyword filter *)
72
-
let keyword_str = Keywords.to_string single_keyword in
71
+
let keyword_str = Keywords.keyword_to_string single_keyword in
73
72
Jmap.Methods.Filter.condition (`Assoc [("hasKeyword", `String keyword_str)])
74
73
| multiple_keywords ->
75
74
(* Multiple keywords - create AND filter *)
76
75
let keyword_filters = List.map (fun kw ->
77
-
let keyword_str = Keywords.to_string kw in
76
+
let keyword_str = Keywords.keyword_to_string kw in
78
77
Jmap.Methods.Filter.condition (`Assoc [("hasKeyword", `String keyword_str)])
79
78
) multiple_keywords in
80
79
Jmap.Methods.Filter.operator `AND keyword_filters
···
88
87
] in
89
88
let color_keywords = color_keywords color in
90
89
let set_patches = List.map (fun kw ->
91
-
let keyword_str = Keywords.to_string kw in
90
+
let keyword_str = Keywords.keyword_to_string kw in
92
91
("keywords/" ^ keyword_str, `Bool true)
93
92
) color_keywords in
94
93
clear_patches @ set_patches
-1
jmap/jmap-email/apple.mli
-1
jmap/jmap-email/apple.mli
+12
-10
jmap/jmap-email/body.ml
+12
-10
jmap/jmap-email/body.ml
···
7
7
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1.4> RFC 8621, Section 4.1.4
8
8
*)
9
9
10
-
open Jmap.Types
11
-
12
10
type t = {
13
11
id : string option;
14
-
blob_id : id option;
15
-
size : uint;
12
+
blob_id : Jmap.Id.t option;
13
+
size : Jmap.UInt.t;
16
14
headers : Header.t list;
17
15
name : string option;
18
16
mime_type : string;
···
22
20
language : string list option;
23
21
location : string option;
24
22
sub_parts : t list option;
25
-
other_headers : Yojson.Safe.t string_map;
23
+
other_headers : (string, Yojson.Safe.t) Hashtbl.t;
26
24
}
27
25
28
26
let id t = t.id
···
118
116
119
117
let rec to_json t =
120
118
let fields = [
121
-
("size", `Int t.size);
119
+
("size", `Int (Jmap.UInt.to_int t.size));
122
120
("headers", Header.list_to_json t.headers);
123
121
("type", `String t.mime_type);
124
122
] in
···
131
129
| None -> fields
132
130
in
133
131
let fields = add_opt_string fields "partId" t.id in
134
-
let fields = add_opt_string fields "blobId" t.blob_id in
132
+
let fields = add_opt_string fields "blobId" (Option.map Jmap.Id.to_string t.blob_id) in
135
133
let fields = add_opt_string fields "name" t.name in
136
134
let fields = add_opt_string fields "charset" t.charset in
137
135
let fields = add_opt_string fields "disposition" t.disposition in
···
153
151
| `Assoc fields ->
154
152
(try
155
153
let size = match List.assoc_opt "size" fields with
156
-
| Some (`Int s) -> s
154
+
| Some (`Int s) -> (match Jmap.UInt.of_int s with
155
+
| Ok uint -> uint
156
+
| Error _ -> failwith ("Invalid size: " ^ string_of_int s))
157
157
| _ -> failwith "Missing or invalid size field"
158
158
in
159
159
let headers = match List.assoc_opt "headers" fields with
···
173
173
| _ -> failwith "Invalid partId field"
174
174
in
175
175
let blob_id = match List.assoc_opt "blobId" fields with
176
-
| Some (`String s) -> Some s
176
+
| Some (`String s) -> (match Jmap.Id.of_string s with
177
+
| Ok id_t -> Some id_t
178
+
| Error _ -> failwith ("Invalid blob_id: " ^ s))
177
179
| Some `Null | None -> None
178
180
| _ -> failwith "Invalid blobId field"
179
181
in
···
296
298
Format.fprintf fmt "BodyPart{id=%s;mime_type=%s;size=%d}"
297
299
(match t.id with Some s -> s | None -> "none")
298
300
t.mime_type
299
-
t.size
301
+
(Jmap.UInt.to_int t.size)
300
302
301
303
let pp_hum fmt t = pp fmt t
+12
-13
jmap/jmap-email/body.mli
+12
-13
jmap/jmap-email/body.mli
···
11
11
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1.4> RFC 8621, Section 4.1.4 - Email Body Structure
12
12
*)
13
13
14
-
open Jmap.Types
15
14
16
15
(** Email body part representation.
17
16
···
35
34
(** Get the blob ID for downloading the part content.
36
35
@param t The body part
37
36
@return Blob identifier for content access, or None for multipart types *)
38
-
val blob_id : t -> id option
37
+
val blob_id : t -> Jmap.Id.t option
39
38
40
39
(** Get the size of the part in bytes.
41
40
@param t The body part
42
41
@return Size in bytes of the decoded content *)
43
-
val size : t -> uint
42
+
val size : t -> Jmap.UInt.t
44
43
45
44
(** Get the list of MIME headers for this part.
46
45
@param t The body part
···
90
89
(** Get additional headers requested via header properties.
91
90
@param t The body part
92
91
@return Map of header names to their JSON values for extended header access *)
93
-
val other_headers : t -> Yojson.Safe.t string_map
92
+
val other_headers : t -> (string, Yojson.Safe.t) Hashtbl.t
94
93
95
94
(** Create a new body part object.
96
95
97
96
Creates a body part with validation of required fields and proper MIME structure.
98
-
Either id+blob_id (for leaf parts) or sub_parts (for multipart) should be provided,
97
+
Either Jmap.Id.t+blob_id (for leaf parts) or sub_parts (for multipart) should be provided,
99
98
but not both.
100
99
101
-
@param id Optional part identifier for leaf parts
100
+
@param Jmap.Id.t Optional part identifier for leaf parts
102
101
@param blob_id Optional blob ID for content access
103
102
@param size Size in bytes of decoded content
104
103
@param headers List of MIME headers for this part
···
114
113
@return Result containing new body part or validation error *)
115
114
val create :
116
115
?id:string ->
117
-
?blob_id:id ->
118
-
size:uint ->
116
+
?blob_id:Jmap.Id.t ->
117
+
size:Jmap.UInt.t ->
119
118
headers:Header.t list ->
120
119
?name:string ->
121
120
mime_type:string ->
···
125
124
?language:string list ->
126
125
?location:string ->
127
126
?sub_parts:t list ->
128
-
?other_headers:Yojson.Safe.t string_map ->
127
+
?other_headers:(string, Yojson.Safe.t) Hashtbl.t ->
129
128
unit -> (t, string) result
130
129
131
130
(** Create a new body part object without validation.
···
133
132
For use when body parts are known to be valid or come from trusted sources
134
133
like server responses.
135
134
136
-
@param id Optional part identifier for leaf parts
135
+
@param Jmap.Id.t Optional part identifier for leaf parts
137
136
@param blob_id Optional blob ID for content access
138
137
@param size Size in bytes of decoded content
139
138
@param headers List of MIME headers for this part
···
149
148
@return New body part object *)
150
149
val create_unsafe :
151
150
?id:string ->
152
-
?blob_id:id ->
153
-
size:uint ->
151
+
?blob_id:Jmap.Id.t ->
152
+
size:Jmap.UInt.t ->
154
153
headers:Header.t list ->
155
154
?name:string ->
156
155
mime_type:string ->
···
160
159
?language:string list ->
161
160
?location:string ->
162
161
?sub_parts:t list ->
163
-
?other_headers:Yojson.Safe.t string_map ->
162
+
?other_headers:(string, Yojson.Safe.t) Hashtbl.t ->
164
163
unit -> t
165
164
166
165
(** Check if body part is a multipart container.
+27
-21
jmap/jmap-email/changes.ml
+27
-21
jmap/jmap-email/changes.ml
···
1
1
(** Email changes operations using core JMAP Changes_args *)
2
2
3
-
open Jmap.Types
4
3
open Jmap.Methods
5
4
6
5
(** Build Email/changes arguments *)
7
6
let build_changes_args ~account_id ~since_state ?max_changes () =
7
+
let account_id_str = Jmap.Id.to_string account_id in
8
+
let max_changes_int = match max_changes with
9
+
| Some uint -> Some (Jmap.UInt.to_int uint)
10
+
| None -> None in
8
11
Changes_args.v
9
-
~account_id
12
+
~account_id:account_id_str
10
13
~since_state
11
-
?max_changes
14
+
?max_changes:max_changes_int
12
15
()
13
16
14
17
(** Convert Email/changes arguments to JSON *)
···
17
20
18
21
(** Track changes since a given state *)
19
22
type change_tracker = {
20
-
account_id : id;
23
+
account_id : Jmap.Id.t;
21
24
current_state : string;
22
-
created : id list;
23
-
updated : id list;
24
-
destroyed : id list;
25
+
created : Jmap.Id.t list;
26
+
updated : Jmap.Id.t list;
27
+
destroyed : Jmap.Id.t list;
25
28
}
26
29
27
30
(** Create a new change tracker *)
···
39
42
{
40
43
tracker with
41
44
current_state = Changes_response.new_state response;
42
-
created = tracker.created @ Changes_response.created response;
43
-
updated = tracker.updated @ Changes_response.updated response;
44
-
destroyed = tracker.destroyed @ Changes_response.destroyed response;
45
+
created = tracker.created @ (List.map (fun s -> match Jmap.Id.of_string s with Ok id -> id | Error e -> failwith e) (Changes_response.created response));
46
+
updated = tracker.updated @ (List.map (fun s -> match Jmap.Id.of_string s with Ok id -> id | Error e -> failwith e) (Changes_response.updated response));
47
+
destroyed = tracker.destroyed @ (List.map (fun s -> match Jmap.Id.of_string s with Ok id -> id | Error e -> failwith e) (Changes_response.destroyed response));
45
48
}
46
49
47
50
(** Get all changes since tracker was created *)
···
50
53
51
54
(** Get next batch of changes *)
52
55
let get_next_changes ~account_id ~since_state ?(max_changes=500) () =
53
-
build_changes_args ~account_id ~since_state ~max_changes ()
56
+
let max_changes_uint = match Jmap.UInt.of_int max_changes with
57
+
| Ok u -> u
58
+
| Error _ -> failwith ("Invalid max_changes: " ^ string_of_int max_changes) in
59
+
build_changes_args ~account_id ~since_state ~max_changes:max_changes_uint ()
54
60
55
61
(** Check if there are pending changes *)
56
62
let has_pending_changes response =
···
59
65
(** Incremental sync helper *)
60
66
module Sync = struct
61
67
type sync_state = {
62
-
account_id : id;
68
+
account_id : Jmap.Id.t;
63
69
last_state : string;
64
-
pending_created : id list;
65
-
pending_updated : id list;
66
-
pending_destroyed : id list;
70
+
pending_created : Jmap.Id.t list;
71
+
pending_updated : Jmap.Id.t list;
72
+
pending_destroyed : Jmap.Id.t list;
67
73
}
68
74
69
75
let init ~account_id ~initial_state =
···
83
89
{
84
90
sync with
85
91
last_state = new_state;
86
-
pending_created = sync.pending_created @ created;
87
-
pending_updated = sync.pending_updated @ updated;
88
-
pending_destroyed = sync.pending_destroyed @ destroyed;
92
+
pending_created = sync.pending_created @ (List.map (fun s -> match Jmap.Id.of_string s with Ok id -> id | Error e -> failwith e) created);
93
+
pending_updated = sync.pending_updated @ (List.map (fun s -> match Jmap.Id.of_string s with Ok id -> id | Error e -> failwith e) updated);
94
+
pending_destroyed = sync.pending_destroyed @ (List.map (fun s -> match Jmap.Id.of_string s with Ok id -> id | Error e -> failwith e) destroyed);
89
95
}
90
96
91
97
let clear_pending sync =
···
109
115
(** Utility to merge multiple change responses *)
110
116
let merge_changes responses =
111
117
List.fold_left (fun (created, updated, destroyed) response ->
112
-
let c = Changes_response.created response in
113
-
let u = Changes_response.updated response in
114
-
let d = Changes_response.destroyed response in
118
+
let c = List.map (fun id -> match Jmap.Id.of_string id with | Ok id_t -> id_t | Error _ -> failwith ("Invalid ID: " ^ id)) (Changes_response.created response) in
119
+
let u = List.map (fun id -> match Jmap.Id.of_string id with | Ok id_t -> id_t | Error _ -> failwith ("Invalid ID: " ^ id)) (Changes_response.updated response) in
120
+
let d = List.map (fun id -> match Jmap.Id.of_string id with | Ok id_t -> id_t | Error _ -> failwith ("Invalid ID: " ^ id)) (Changes_response.destroyed response) in
115
121
(created @ c, updated @ u, destroyed @ d)
116
122
) ([], [], []) responses
117
123
+8
-9
jmap/jmap-email/changes.mli
+8
-9
jmap/jmap-email/changes.mli
···
6
6
7
7
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.6> RFC 8621 Section 4.6 *)
8
8
9
-
open Jmap.Types
10
9
open Jmap.Methods
11
10
12
11
(** {1 Changes Arguments} *)
···
17
16
@param ?max_changes Optional maximum number of changes to return
18
17
@return Changes_args for Email/changes method *)
19
18
val build_changes_args :
20
-
account_id:id ->
19
+
account_id:Jmap.Id.t ->
21
20
since_state:string ->
22
-
?max_changes:uint ->
21
+
?max_changes:Jmap.UInt.t ->
23
22
unit ->
24
23
Changes_args.t
25
24
···
38
37
@param initial_state The starting state
39
38
@return A new change tracker *)
40
39
val create_tracker :
41
-
account_id:id ->
40
+
account_id:Jmap.Id.t ->
42
41
initial_state:string ->
43
42
change_tracker
44
43
···
56
55
@return Tuple of (created_ids, updated_ids, destroyed_ids) *)
57
56
val get_all_changes :
58
57
change_tracker ->
59
-
(id list * id list * id list)
58
+
(Jmap.Id.t list * Jmap.Id.t list * Jmap.Id.t list)
60
59
61
60
(** {1 Incremental Sync} *)
62
61
···
66
65
@param ?max_changes Maximum changes per batch (default 500)
67
66
@return Changes_args for fetching next batch *)
68
67
val get_next_changes :
69
-
account_id:id ->
68
+
account_id:Jmap.Id.t ->
70
69
since_state:string ->
71
70
?max_changes:int ->
72
71
unit ->
···
87
86
@param initial_state The starting state
88
87
@return New sync state *)
89
88
val init :
90
-
account_id:id ->
89
+
account_id:Jmap.Id.t ->
91
90
initial_state:string ->
92
91
sync_state
93
92
···
110
109
@return Tuple of (created, updated, destroyed) ID lists *)
111
110
val get_pending :
112
111
sync_state ->
113
-
(id list * id list * id list)
112
+
(Jmap.Id.t list * Jmap.Id.t list * Jmap.Id.t list)
114
113
115
114
(** Check if sync is needed.
116
115
@param sync Current sync state
···
129
128
@return Combined (created, updated, destroyed) ID lists *)
130
129
val merge_changes :
131
130
Changes_response.t list ->
132
-
(id list * id list * id list)
131
+
(Jmap.Id.t list * Jmap.Id.t list * Jmap.Id.t list)
133
132
134
133
(** Get updated properties if available.
135
134
@param response Changes response
-1
jmap/jmap-email/dune
-1
jmap/jmap-email/dune
+66
-39
jmap/jmap-email/email.ml
+66
-39
jmap/jmap-email/email.ml
···
9
9
10
10
[@@@warning "-32"] (* Suppress unused value warnings for interface-required functions *)
11
11
12
-
open Jmap.Types
13
-
14
12
(** JSON parsing combinators for cleaner field extraction *)
15
13
module Json = struct
16
14
(** Extract a field from JSON object fields list *)
···
47
45
let string_list (name : string) (fields : (string * Yojson.Safe.t) list) : string list option =
48
46
list (function `String s -> Some s | _ -> None) name fields
49
47
50
-
(** Parse ISO 8601 date field to Unix timestamp *)
48
+
(** Parse ISO 8601 Jmap.Date.t field to Unix timestamp *)
51
49
let iso_date (name : string) (fields : (string * Yojson.Safe.t) list) : float option =
52
50
match string name fields with
53
51
| Some s ->
···
101
99
end
102
100
103
101
type t = {
104
-
id : id option;
105
-
blob_id : id option;
106
-
thread_id : id option;
107
-
mailbox_ids : bool id_map option;
102
+
id : Jmap.Id.t option;
103
+
blob_id : Jmap.Id.t option;
104
+
thread_id : Jmap.Id.t option;
105
+
mailbox_ids : (Jmap.Id.t, bool) Hashtbl.t option;
108
106
keywords : Keywords.t option;
109
-
size : uint option;
110
-
received_at : date option;
107
+
size : Jmap.UInt.t option;
108
+
received_at : Jmap.Date.t option;
111
109
message_id : string list option;
112
110
in_reply_to : string list option;
113
111
references : string list option;
···
118
116
bcc : Address.t list option;
119
117
reply_to : Address.t list option;
120
118
subject : string option;
121
-
sent_at : date option;
119
+
sent_at : Jmap.Date.t option;
122
120
has_attachment : bool option;
123
121
preview : string option;
124
122
body_structure : Body.t option;
125
-
body_values : Body.Value.t string_map option;
123
+
body_values : (string, Body.Value.t) Hashtbl.t option;
126
124
text_body : Body.t list option;
127
125
html_body : Body.t list option;
128
126
attachments : Body.t list option;
129
-
headers : string string_map option;
130
-
other_properties : Yojson.Safe.t string_map;
127
+
headers : (string, string) Hashtbl.t option;
128
+
other_properties : (string, Yojson.Safe.t) Hashtbl.t;
131
129
}
132
130
133
131
(* Accessor functions *)
···
180
178
181
179
(* Get list of all valid property names for Email objects *)
182
180
let valid_properties () = [
183
-
"id"; "blobId"; "threadId"; "mailboxIds"; "keywords"; "size"; "receivedAt";
181
+
"Jmap.Id.t"; "blobId"; "threadId"; "mailboxIds"; "keywords"; "size"; "receivedAt";
184
182
"messageId"; "inReplyTo"; "references"; "sender"; "from"; "to"; "cc"; "bcc";
185
183
"replyTo"; "subject"; "sentAt"; "hasAttachment"; "preview"; "bodyStructure";
186
184
"bodyValues"; "textBody"; "htmlBody"; "attachments"; "headers"
···
189
187
(* Serialize to JSON with only specified properties *)
190
188
let to_json_with_properties ~properties t =
191
189
let all_fields = [
192
-
("id", (match t.id with Some s -> `String s | None -> `Null));
193
-
("blobId", (match t.blob_id with Some s -> `String s | None -> `Null));
194
-
("threadId", (match t.thread_id with Some s -> `String s | None -> `Null));
190
+
("id", (match t.id with Some id_t -> `String (Jmap.Id.to_string id_t) | None -> `Null));
191
+
("blobId", (match t.blob_id with Some id_t -> `String (Jmap.Id.to_string id_t) | None -> `Null));
192
+
("threadId", (match t.thread_id with Some id_t -> `String (Jmap.Id.to_string id_t) | None -> `Null));
195
193
("subject", (match t.subject with Some s -> `String s | None -> `Null));
196
194
("size", (match t.size with Some i -> `Int i | None -> `Null));
197
195
(* Add more fields as needed - this is a simplified implementation *)
···
269
267
| _ -> "(No subject)"
270
268
in
271
269
let date_str = match t.received_at with
272
-
| Some date -> Printf.sprintf "%.0f" date
270
+
| Some date -> Printf.sprintf "%.0f" (Jmap.Date.to_timestamp date)
273
271
| None -> match t.sent_at with
274
-
| Some date -> Printf.sprintf "%.0f" date
275
-
| None -> "Unknown date"
272
+
| Some date -> Printf.sprintf "%.0f" (Jmap.Date.to_timestamp date)
273
+
| None -> "Unknown Jmap.Date.t"
276
274
in
277
275
Printf.sprintf "%s: %s (%s)" sender_str subject_str date_str
278
276
279
277
(* PRINTABLE interface implementation *)
280
278
let pp ppf t =
281
-
let id_str = match t.id with Some id -> id | None -> "no-id" in
279
+
let id_str = match t.id with Some id -> Jmap.Id.to_string id | None -> "no-id" in
282
280
let subject_str = match t.subject with Some s -> s | None -> "(no subject)" in
283
281
Format.fprintf ppf "Email{id=%s; subject=%s}" id_str subject_str
284
282
···
330
328
in
331
329
let add_opt_bool_map fields name map_opt = match map_opt with
332
330
| Some map ->
333
-
let assoc_list = Hashtbl.fold (fun k v acc -> (k, `Bool v) :: acc) map [] in
331
+
let assoc_list = Hashtbl.fold (fun k v acc -> (Jmap.Id.to_string k, `Bool v) :: acc) map [] in
334
332
(name, `Assoc assoc_list) :: fields
335
333
| None -> fields
336
334
in
···
342
340
in
343
341
344
342
(* Add all email fields *)
345
-
let fields = add_opt_string fields "id" t.id in
346
-
let fields = add_opt_string fields "blobId" t.blob_id in
347
-
let fields = add_opt_string fields "threadId" t.thread_id in
343
+
let fields = add_opt_string fields "id" (Option.map Jmap.Id.to_string t.id) in
344
+
let fields = add_opt_string fields "blobId" (Option.map Jmap.Id.to_string t.blob_id) in
345
+
let fields = add_opt_string fields "threadId" (Option.map Jmap.Id.to_string t.thread_id) in
348
346
let fields = add_opt_bool_map fields "mailboxIds" t.mailbox_ids in
349
347
let fields = match t.keywords with
350
348
| Some kw -> ("keywords", Keywords.to_json kw) :: fields
351
349
| None -> fields
352
350
in
353
-
let fields = add_opt_int fields "size" t.size in
354
-
let fields = add_opt_date fields "receivedAt" t.received_at in
351
+
let fields = add_opt_int fields "size" (Option.map Jmap.UInt.to_int t.size) in
352
+
let fields = add_opt_date fields "receivedAt" (Option.map Jmap.Date.to_timestamp t.received_at) in
355
353
let fields = add_opt_string_list fields "messageId" t.message_id in
356
354
let fields = add_opt_string_list fields "inReplyTo" t.in_reply_to in
357
355
let fields = add_opt_string_list fields "references" t.references in
···
365
363
let fields = add_opt_address_list fields "bcc" t.bcc in
366
364
let fields = add_opt_address_list fields "replyTo" t.reply_to in
367
365
let fields = add_opt_string fields "subject" t.subject in
368
-
let fields = add_opt_date fields "sentAt" t.sent_at in
366
+
let fields = add_opt_date fields "sentAt" (Option.map Jmap.Date.to_timestamp t.sent_at) in
369
367
let fields = add_opt_bool fields "hasAttachment" t.has_attachment in
370
368
let fields = add_opt_string fields "preview" t.preview in
371
369
let fields = match t.body_structure with
···
392
390
| `Assoc fields ->
393
391
(try
394
392
(* Parse all email fields using combinators *)
395
-
let id = Json.string "id" fields in
396
-
let blob_id = Json.string "blobId" fields in
397
-
let thread_id = Json.string "threadId" fields in
398
-
let mailbox_ids = Json.bool_map "mailboxIds" fields in
393
+
let id = match Json.string "Jmap.Id.t" fields with
394
+
| Some id_str -> (match Jmap.Id.of_string id_str with
395
+
| Ok jmap_id -> Some jmap_id
396
+
| Error _ -> None)
397
+
| None -> None in
398
+
let blob_id = match Json.string "blobId" fields with
399
+
| Some blob_id_str -> (match Jmap.Id.of_string blob_id_str with
400
+
| Ok jmap_id -> Some jmap_id
401
+
| Error _ -> None)
402
+
| None -> None in
403
+
let thread_id = match Json.string "threadId" fields with
404
+
| Some thread_id_str -> (match Jmap.Id.of_string thread_id_str with
405
+
| Ok jmap_id -> Some jmap_id
406
+
| Error _ -> None)
407
+
| None -> None in
408
+
let mailbox_ids = match Json.bool_map "mailboxIds" fields with
409
+
| Some string_map ->
410
+
let id_map = Hashtbl.create (Hashtbl.length string_map) in
411
+
Hashtbl.iter (fun str_key bool_val ->
412
+
match Jmap.Id.of_string str_key with
413
+
| Ok id_key -> Hashtbl.add id_map id_key bool_val
414
+
| Error _ -> () (* Skip invalid ids *)
415
+
) string_map;
416
+
Some id_map
417
+
| None -> None in
399
418
(* Parse keywords using the Keywords module *)
400
419
let keywords = match Json.field "keywords" fields with
401
420
| Some json ->
···
404
423
| Error _msg -> None (* Ignore parse errors for now *))
405
424
| None -> None
406
425
in
407
-
let size = Json.int "size" fields in
408
-
let received_at = Json.iso_date "receivedAt" fields in
426
+
let size = match Json.int "size" fields with
427
+
| Some int_val -> (match Jmap.UInt.of_int int_val with
428
+
| Ok uint_val -> Some uint_val
429
+
| Error _ -> None)
430
+
| None -> None in
431
+
let received_at = match Json.iso_date "receivedAt" fields with
432
+
| Some float_val -> Some (Jmap.Date.of_timestamp float_val)
433
+
| None -> None in
409
434
let message_id = Json.string_list "messageId" fields in
410
435
let in_reply_to = Json.string_list "inReplyTo" fields in
411
436
let references = Json.string_list "references" fields in
···
419
444
let bcc = Json.email_address_list "bcc" fields in
420
445
let reply_to = Json.email_address_list "replyTo" fields in
421
446
let subject = Json.string "subject" fields in
422
-
let sent_at = Json.iso_date "sentAt" fields in
447
+
let sent_at = match Json.iso_date "sentAt" fields with
448
+
| Some float_val -> Some (Jmap.Date.of_timestamp float_val)
449
+
| None -> None in
423
450
let has_attachment = Json.bool "hasAttachment" fields in
424
451
let preview = Json.string "preview" fields in
425
452
(* Parse body structure using the Body module *)
···
483
510
484
511
(* Collect any unrecognized fields into other_properties *)
485
512
let known_fields = [
486
-
"id"; "blobId"; "threadId"; "mailboxIds"; "keywords"; "size"; "receivedAt";
513
+
"Jmap.Id.t"; "blobId"; "threadId"; "mailboxIds"; "keywords"; "size"; "receivedAt";
487
514
"messageId"; "inReplyTo"; "references"; "sender"; "from"; "to"; "cc"; "bcc";
488
515
"replyTo"; "subject"; "sentAt"; "hasAttachment"; "preview"; "bodyStructure";
489
516
"bodyValues"; "textBody"; "htmlBody"; "attachments"; "headers"
···
508
535
(* Pretty printing implementation for PRINTABLE signature *)
509
536
let pp ppf t =
510
537
let id_str = match t.id with
511
-
| Some id -> id
538
+
| Some id -> Jmap.Id.to_string id
512
539
| None -> "<no-id>"
513
540
in
514
541
let subject_str = match t.subject with
···
519
546
| Some addr -> Address.email addr
520
547
| None -> "<unknown-sender>"
521
548
in
522
-
Format.fprintf ppf "Email{id=%s; from=%s; subject=%s}"
549
+
Format.fprintf ppf "Email{Jmap.Id.t=%s; from=%s; subject=%s}"
523
550
id_str sender_str subject_str
524
551
525
552
(* Alias for pp following Fmt conventions *)
···
567
594
module Email_address = Address
568
595
module Email = struct
569
596
type nonrec t = t (* Alias the main email type *)
570
-
let id = id
597
+
let id t = t.id
571
598
let received_at = received_at
572
599
let subject = subject
573
600
let from = from
+28
-31
jmap/jmap-email/email.mli
+28
-31
jmap/jmap-email/email.mli
···
11
11
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1> RFC 8621, Section 4.1 - Email Object
12
12
*)
13
13
14
-
open Jmap.Types
15
-
16
14
(** Email object type.
17
15
18
16
Represents a complete email message as defined in RFC 8621 Section 4.1.
···
27
25
(** Pretty printing interface *)
28
26
include Jmap_sigs.PRINTABLE with type t := t
29
27
30
-
(** JMAP object interface with property selection support *)
31
-
include Jmap_sigs.JMAP_OBJECT with type t := t and type id_type := id
28
+
(** JMAP object interface with property selection support - implemented manually *)
32
29
33
30
(** Get the server-assigned email identifier.
34
31
@param t The email object
35
32
@return Email ID if present in the object *)
36
-
val id : t -> id option
33
+
val id : t -> Jmap.Id.t option
37
34
38
35
(** Get the blob ID for downloading the complete raw message.
39
36
@param t The email object
40
37
@return Blob identifier for RFC 5322 message access *)
41
-
val blob_id : t -> id option
38
+
val blob_id : t -> Jmap.Id.t option
42
39
43
40
(** Get the thread identifier linking related messages.
44
41
@param t The email object
45
42
@return Thread ID for conversation grouping *)
46
-
val thread_id : t -> id option
43
+
val thread_id : t -> Jmap.Id.t option
47
44
48
45
(** Get the set of mailboxes containing this email.
49
46
@param t The email object
50
47
@return Map of mailbox IDs to boolean values (always true when present) *)
51
-
val mailbox_ids : t -> bool id_map option
48
+
val mailbox_ids : t -> (Jmap.Id.t, bool) Hashtbl.t option
52
49
53
50
(** Get the keywords/flags applied to this email.
54
51
@param t The email object
···
58
55
(** Get the total size of the raw message.
59
56
@param t The email object
60
57
@return Message size in octets *)
61
-
val size : t -> uint option
58
+
val size : t -> Jmap.UInt.t option
62
59
63
60
(** Get the server timestamp when the message was received.
64
61
@param t The email object
65
62
@return Reception timestamp *)
66
-
val received_at : t -> date option
63
+
val received_at : t -> Jmap.Date.t option
67
64
68
65
(** Get the Message-ID header values.
69
66
@param t The email object
···
118
115
(** Get the Date header timestamp (when message was sent).
119
116
@param t The email object
120
117
@return Send timestamp if the SentAt property was requested *)
121
-
val sent_at : t -> date option
118
+
val sent_at : t -> Jmap.Date.t option
122
119
123
120
(** Check if the email has non-inline attachments.
124
121
@param t The email object
···
138
135
(** Get decoded content of requested text body parts.
139
136
@param t The email object
140
137
@return Map of part IDs to decoded content if BodyValues was requested *)
141
-
val body_values : t -> Body.Value.t string_map option
138
+
val body_values : t -> (string, Body.Value.t) Hashtbl.t option
142
139
143
140
(** Get text/plain body parts suitable for display.
144
141
@param t The email object
···
172
169
173
170
@param t The email object
174
171
@return Map of property names to JSON values for extended properties *)
175
-
val other_properties : t -> Yojson.Safe.t string_map
172
+
val other_properties : t -> (string, Yojson.Safe.t) Hashtbl.t
176
173
177
174
(** Create a detailed Email object with all properties.
178
175
···
180
177
setting all email properties at once. Used primarily for constructing Email
181
178
objects from server responses or for testing purposes.
182
179
183
-
@param id Server-assigned unique identifier
180
+
@param Jmap.Id.t Server-assigned unique identifier
184
181
@param blob_id Blob ID for raw message access
185
182
@param thread_id Thread identifier for conversation grouping
186
183
@param mailbox_ids Set of mailboxes containing this email
···
209
206
@param other_properties Extended/custom properties
210
207
@return New email object *)
211
208
val create_full :
212
-
?id:id ->
213
-
?blob_id:id ->
214
-
?thread_id:id ->
215
-
?mailbox_ids:bool id_map ->
209
+
?id:Jmap.Id.t ->
210
+
?blob_id:Jmap.Id.t ->
211
+
?thread_id:Jmap.Id.t ->
212
+
?mailbox_ids:(Jmap.Id.t, bool) Hashtbl.t ->
216
213
?keywords:Keywords.t ->
217
-
?size:uint ->
218
-
?received_at:date ->
214
+
?size:Jmap.UInt.t ->
215
+
?received_at:Jmap.Date.t ->
219
216
?message_id:string list ->
220
217
?in_reply_to:string list ->
221
218
?references:string list ->
···
226
223
?bcc:Address.t list ->
227
224
?reply_to:Address.t list ->
228
225
?subject:string ->
229
-
?sent_at:date ->
226
+
?sent_at:Jmap.Date.t ->
230
227
?has_attachment:bool ->
231
228
?preview:string ->
232
229
?body_structure:Body.t ->
233
-
?body_values:Body.Value.t string_map ->
230
+
?body_values:(string, Body.Value.t) Hashtbl.t ->
234
231
?text_body:Body.t list ->
235
232
?html_body:Body.t list ->
236
233
?attachments:Body.t list ->
237
-
?headers:string string_map ->
238
-
?other_properties:Yojson.Safe.t string_map ->
234
+
?headers:(string, string) Hashtbl.t ->
235
+
?other_properties:(string, Yojson.Safe.t) Hashtbl.t ->
239
236
unit -> t
240
237
241
238
(** Safely extract the email ID.
242
239
@param t The email object
243
240
@return Ok with the ID, or Error with message if not present *)
244
-
val get_id : t -> (id, string) result
241
+
val get_id : t -> (Jmap.Id.t, string) result
245
242
246
243
(** Extract the email ID, raising an exception if not present.
247
244
@param t The email object
248
245
@return The email ID *)
249
-
val take_id : t -> id
246
+
val take_id : t -> Jmap.Id.t
250
247
251
248
(** Check if the email is unread.
252
249
···
315
312
val create :
316
313
?add_keywords:Keywords.t ->
317
314
?remove_keywords:Keywords.t ->
318
-
?add_mailboxes:id list ->
319
-
?remove_mailboxes:id list ->
315
+
?add_mailboxes:Jmap.Id.t list ->
316
+
?remove_mailboxes:Jmap.Id.t list ->
320
317
unit -> Yojson.Safe.t
321
318
322
319
(** Mark email as read by adding $seen keyword.
···
339
336
340
337
@param mailbox_ids List of target mailbox IDs
341
338
@return Patch object to set email mailbox membership *)
342
-
val move_to_mailboxes : id list -> Yojson.Safe.t
339
+
val move_to_mailboxes : Jmap.Id.t list -> Yojson.Safe.t
343
340
end
344
341
345
342
(** Module aliases for external access *)
···
383
380
module Email_address = Address
384
381
module Email : sig
385
382
type nonrec t = t
386
-
val id : t -> id option
387
-
val received_at : t -> date option
383
+
val id : t -> Jmap.Id.t option
384
+
val received_at : t -> Jmap.Date.t option
388
385
val subject : t -> string option
389
386
val from : t -> Address.t list option
390
387
val keywords : t -> Keywords.t option
+115
-88
jmap/jmap-email/identity.ml
+115
-88
jmap/jmap-email/identity.ml
···
7
7
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-6> RFC 8621, Section 6: Identity
8
8
*)
9
9
10
-
open Jmap.Types
11
10
open Jmap.Method_names
12
11
open Jmap.Error
13
12
14
13
(** Identity object *)
15
14
type t = {
16
-
id : id option;
15
+
id : Jmap.Id.t option;
17
16
name : string;
18
17
email : string;
19
-
reply_to : Types.Email_address.t list option;
20
-
bcc : Types.Email_address.t list option;
18
+
reply_to : Address.t list option;
19
+
bcc : Address.t list option;
21
20
text_signature : string;
22
21
html_signature : string;
23
22
may_delete : bool;
···
46
45
47
46
let to_json t =
48
47
let fields = [
49
-
("id", (match t.id with Some id -> `String id | None -> `Null));
48
+
("id", (match t.id with Some id -> `String (Jmap.Id.to_string id) | None -> `Null));
50
49
("name", `String t.name);
51
50
("email", `String t.email);
52
51
("textSignature", `String t.text_signature);
···
55
54
] in
56
55
let fields = match t.reply_to with
57
56
| None -> ("replyTo", `Null) :: fields
58
-
| Some addrs -> ("replyTo", `List (List.map Types.Email_address.to_json addrs)) :: fields
57
+
| Some addrs -> ("replyTo", `List (List.map Address.to_json addrs)) :: fields
59
58
in
60
59
let fields = match t.bcc with
61
60
| None -> ("bcc", `Null) :: fields
62
-
| Some addrs -> ("bcc", `List (List.map Types.Email_address.to_json addrs)) :: fields
61
+
| Some addrs -> ("bcc", `List (List.map Address.to_json addrs)) :: fields
63
62
in
64
63
`Assoc (List.rev fields)
65
64
66
65
(* JMAP_OBJECT implementation *)
67
66
let create ?id () =
68
-
{ id; name = ""; email = ""; reply_to = None; bcc = None;
67
+
let id_opt = match id with
68
+
| None -> None
69
+
| Some id_str ->
70
+
(match Jmap.Id.of_string id_str with
71
+
| Ok jmap_id -> Some jmap_id
72
+
| Error _ -> failwith ("Invalid identity id: " ^ id_str)) in
73
+
{ id = id_opt; name = ""; email = ""; reply_to = None; bcc = None;
69
74
text_signature = ""; html_signature = ""; may_delete = true }
70
75
71
76
let to_json_with_properties ~properties t =
72
77
let all_fields = [
73
-
("id", (match t.id with Some id -> `String id | None -> `Null));
78
+
("id", (match t.id with Some id -> `String (Jmap.Id.to_string id) | None -> `Null));
74
79
("name", `String t.name);
75
80
("email", `String t.email);
76
81
("replyTo", (match t.reply_to with
77
82
| None -> `Null
78
-
| Some addrs -> `List (List.map Types.Email_address.to_json addrs)));
83
+
| Some addrs -> `List (List.map Address.to_json addrs)));
79
84
("bcc", (match t.bcc with
80
85
| None -> `Null
81
-
| Some addrs -> `List (List.map Types.Email_address.to_json addrs)));
86
+
| Some addrs -> `List (List.map Address.to_json addrs)));
82
87
("textSignature", `String t.text_signature);
83
88
("htmlSignature", `String t.html_signature);
84
89
("mayDelete", `Bool t.may_delete);
···
89
94
`Assoc filtered_fields
90
95
91
96
let valid_properties () = [
92
-
"id"; "name"; "email"; "replyTo"; "bcc"; "textSignature"; "htmlSignature"; "mayDelete"
97
+
"Id.t"; "name"; "email"; "replyTo"; "bcc"; "textSignature"; "htmlSignature"; "mayDelete"
93
98
] (* TODO: Use Property.to_string_list Property.all_properties when module ordering is fixed *)
94
99
95
100
let of_json json =
···
114
119
let rec process_addresses acc = function
115
120
| [] -> Some (List.rev acc)
116
121
| addr :: rest ->
117
-
(match Types.Email_address.of_json addr with
122
+
(match Address.of_json addr with
118
123
| Ok a -> process_addresses (a :: acc) rest
119
124
| Error _ -> failwith ("Invalid address in " ^ key ^ " field"))
120
125
in
···
126
131
let email = get_string "email" "" in
127
132
if email = "" then failwith "Missing required 'email' field in Identity";
128
133
Ok {
129
-
id = (if id = "" then None else Some id);
134
+
id = (if id = "" then None else match Jmap.Id.of_string id with
135
+
| Ok id_t -> Some id_t
136
+
| Error _ -> failwith ("Invalid ID: " ^ id));
130
137
name = get_string "name" "";
131
138
email;
132
139
reply_to = get_addresses "replyTo";
···
143
150
(* Pretty printing implementation for PRINTABLE signature *)
144
151
let pp ppf t =
145
152
let name_str = if t.name = "" then "<no-name>" else t.name in
146
-
let id_str = match t.id with Some id -> id | None -> "(no-id)" in
153
+
let id_str = match t.id with Some id -> Jmap.Id.to_string id | None -> "(no-id)" in
147
154
Format.fprintf ppf "Identity{id=%s; name=%s; email=%s; may_delete=%b}"
148
155
id_str name_str t.email t.may_delete
149
156
···
155
162
type t = {
156
163
name : string option;
157
164
email : string;
158
-
reply_to : Types.Email_address.t list option;
159
-
bcc : Types.Email_address.t list option;
165
+
reply_to : Address.t list option;
166
+
bcc : Address.t list option;
160
167
text_signature : string option;
161
168
html_signature : string option;
162
169
}
···
185
192
in
186
193
let fields = match t.reply_to with
187
194
| None -> fields
188
-
| Some addrs -> ("replyTo", `List (List.map Types.Email_address.to_json addrs)) :: fields
195
+
| Some addrs -> ("replyTo", `List (List.map Address.to_json addrs)) :: fields
189
196
in
190
197
let fields = match t.bcc with
191
198
| None -> fields
192
-
| Some addrs -> ("bcc", `List (List.map Types.Email_address.to_json addrs)) :: fields
199
+
| Some addrs -> ("bcc", `List (List.map Address.to_json addrs)) :: fields
193
200
in
194
201
let fields = match t.text_signature with
195
202
| None -> fields
···
217
224
let rec process_addresses acc = function
218
225
| [] -> Some (List.rev acc)
219
226
| addr :: rest ->
220
-
(match Types.Email_address.of_json addr with
227
+
(match Address.of_json addr with
221
228
| Ok a -> process_addresses (a :: acc) rest
222
229
| Error _ -> failwith ("Invalid address in " ^ key ^ " field"))
223
230
in
···
245
252
(** Server response with info about the created identity *)
246
253
module Response = struct
247
254
type t = {
248
-
id : id;
255
+
id : Jmap.Id.t;
249
256
may_delete : bool;
250
257
}
251
258
···
259
266
260
267
let to_json t =
261
268
`Assoc [
262
-
("id", `String t.id);
269
+
("id", `String (Jmap.Id.to_string t.id));
263
270
("mayDelete", `Bool t.may_delete);
264
271
]
265
272
···
267
274
try
268
275
match json with
269
276
| `Assoc fields ->
270
-
let id = match List.assoc_opt "id" fields with
271
-
| Some (`String s) -> s
272
-
| _ -> failwith "Missing required 'id' field in Identity creation response"
277
+
let id = match List.assoc_opt "Id.t" fields with
278
+
| Some (`String s) -> (match Jmap.Id.of_string s with
279
+
| Ok id -> id
280
+
| Error _ -> failwith ("Invalid id: " ^ s))
281
+
| _ -> failwith "Missing required 'Id.t' field in Identity creation response"
273
282
in
274
283
let may_delete = match List.assoc_opt "mayDelete" fields with
275
284
| Some (`Bool b) -> b
···
287
296
module Update = struct
288
297
type t = {
289
298
name : string option;
290
-
reply_to : Types.Email_address.t list option option;
291
-
bcc : Types.Email_address.t list option option;
299
+
reply_to : Address.t list option option;
300
+
bcc : Address.t list option option;
292
301
text_signature : string option;
293
302
html_signature : string option;
294
303
}
···
359
368
let fields = match t.reply_to with
360
369
| None -> fields
361
370
| Some None -> ("replyTo", `Null) :: fields
362
-
| Some (Some addrs) -> ("replyTo", `List (List.map Types.Email_address.to_json addrs)) :: fields
371
+
| Some (Some addrs) -> ("replyTo", `List (List.map Address.to_json addrs)) :: fields
363
372
in
364
373
let fields = match t.bcc with
365
374
| None -> fields
366
375
| Some None -> ("bcc", `Null) :: fields
367
-
| Some (Some addrs) -> ("bcc", `List (List.map Types.Email_address.to_json addrs)) :: fields
376
+
| Some (Some addrs) -> ("bcc", `List (List.map Address.to_json addrs)) :: fields
368
377
in
369
378
let fields = match t.text_signature with
370
379
| None -> fields
···
393
402
let rec process_addresses acc = function
394
403
| [] -> Some (Some (List.rev acc))
395
404
| addr :: rest ->
396
-
(match Types.Email_address.of_json addr with
405
+
(match Address.of_json addr with
397
406
| Ok a -> process_addresses (a :: acc) rest
398
407
| Error _ -> failwith ("Invalid address in " ^ key ^ " field"))
399
408
in
···
452
461
(** Arguments for Identity/get method *)
453
462
module Get_args = struct
454
463
type t = {
455
-
account_id : id;
456
-
ids : id list option;
464
+
account_id : Jmap.Id.t;
465
+
ids : Jmap.Id.t list option;
457
466
properties : string list option;
458
467
}
459
468
···
465
474
{ account_id; ids; properties }
466
475
467
476
let to_json t =
468
-
let fields = [("accountId", `String t.account_id)] in
477
+
let fields = [("accountId", `String (Jmap.Id.to_string t.account_id))] in
469
478
let fields = match t.ids with
470
479
| None -> fields
471
-
| Some ids -> ("ids", `List (List.map (fun id -> `String id) ids)) :: fields
480
+
| Some ids -> ("ids", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) ids)) :: fields
472
481
in
473
482
let fields = match t.properties with
474
483
| None -> fields
···
481
490
match json with
482
491
| `Assoc fields ->
483
492
let account_id = match List.assoc_opt "accountId" fields with
484
-
| Some (`String s) -> s
493
+
| Some (`String s) -> (match Jmap.Id.of_string s with
494
+
| Ok id -> id | Error err -> failwith ("Invalid accountId: " ^ err))
485
495
| _ -> failwith "Missing required 'accountId' field in Identity/get arguments"
486
496
in
487
497
let ids = match List.assoc_opt "ids" fields with
488
-
| Some (`List ids) -> Some (List.map (function `String s -> s | _ -> failwith "Invalid ID in 'ids' list") ids)
498
+
| Some (`List ids) -> Some (List.map (function `String s -> (match Jmap.Id.of_string s with Ok id -> id | Error err -> failwith ("Invalid ID: " ^ err)) | _ -> failwith "Invalid ID in 'ids' list") ids)
489
499
| Some `Null | None -> None
490
500
| _ -> failwith "Invalid 'ids' field in Identity/get arguments"
491
501
in
···
502
512
503
513
let pp fmt t =
504
514
Format.fprintf fmt "Identity.Get_args{account=%s;ids=%s}"
505
-
t.account_id
515
+
(Jmap.Id.to_string t.account_id)
506
516
(match t.ids with Some ids -> string_of_int (List.length ids) | None -> "all")
507
517
508
518
let pp_hum fmt t = pp fmt t
···
516
526
(** Arguments for Identity/set method *)
517
527
module Set_args = struct
518
528
type t = {
519
-
account_id : id;
529
+
account_id : Jmap.Id.t;
520
530
if_in_state : string option;
521
-
create : Create.t id_map option;
522
-
update : Update.t id_map option;
523
-
destroy : id list option;
531
+
create : (string, Create.t) Hashtbl.t option;
532
+
update : (string, Update.t) Hashtbl.t option;
533
+
destroy : Jmap.Id.t list option;
524
534
}
525
535
526
536
let account_id t = t.account_id
···
533
543
{ account_id; if_in_state; create; update; destroy }
534
544
535
545
let to_json t =
536
-
let fields = [("accountId", `String t.account_id)] in
546
+
let fields = [("accountId", `String (Jmap.Id.to_string t.account_id))] in
537
547
let fields = match t.if_in_state with
538
548
| None -> fields
539
549
| Some state -> ("ifInState", `String state) :: fields
···
556
566
in
557
567
let fields = match t.destroy with
558
568
| None -> fields
559
-
| Some ids -> ("destroy", `List (List.map (fun id -> `String id) ids)) :: fields
569
+
| Some ids -> ("destroy", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) ids)) :: fields
560
570
in
561
571
`Assoc (List.rev fields)
562
572
···
565
575
match json with
566
576
| `Assoc fields ->
567
577
let account_id = match List.assoc_opt "accountId" fields with
568
-
| Some (`String s) -> s
578
+
| Some (`String s) -> (match Jmap.Id.of_string s with
579
+
| Ok id -> id
580
+
| Error _ -> failwith ("Invalid accountId: " ^ s))
569
581
| _ -> failwith "Missing required 'accountId' field in Identity/set arguments"
570
582
in
571
583
let if_in_state = match List.assoc_opt "ifInState" fields with
···
600
612
| _ -> failwith "Invalid 'update' field in Identity/set arguments"
601
613
in
602
614
let destroy = match List.assoc_opt "destroy" fields with
603
-
| Some (`List ids) -> Some (List.map (function `String s -> s | _ -> failwith "Invalid ID in 'destroy' list") ids)
615
+
| Some (`List ids) -> Some (List.map (function `String s -> (match Jmap.Id.of_string s with Ok id -> id | Error _ -> failwith ("Invalid ID in 'destroy' list: " ^ s)) | _ -> failwith "Invalid ID in 'destroy' list") ids)
604
616
| Some `Null | None -> None
605
617
| _ -> failwith "Invalid 'destroy' field in Identity/set arguments"
606
618
in
···
611
623
| exn -> Error ("Identity/set JSON parsing exception: " ^ Printexc.to_string exn)
612
624
613
625
let pp fmt t =
614
-
Format.fprintf fmt "Identity.Set_args{account=%s}" t.account_id
626
+
Format.fprintf fmt "Identity.Set_args{account=%s}" (Jmap.Id.to_string t.account_id)
615
627
616
628
let pp_hum fmt t = pp fmt t
617
629
···
623
635
(** Response for Identity/set method *)
624
636
module Set_response = struct
625
637
type t = {
626
-
account_id : id;
638
+
account_id : Jmap.Id.t;
627
639
old_state : string;
628
640
new_state : string;
629
-
created : Create.Response.t id_map;
630
-
updated : Update.Response.t id_map;
631
-
destroyed : id list;
632
-
not_created : Set_error.t id_map;
633
-
not_updated : Set_error.t id_map;
634
-
not_destroyed : Set_error.t id_map;
641
+
created : (string, Create.Response.t) Hashtbl.t;
642
+
updated : (string, Update.Response.t) Hashtbl.t;
643
+
destroyed : Jmap.Id.t list;
644
+
not_created : (string, Set_error.t) Hashtbl.t;
645
+
not_updated : (string, Set_error.t) Hashtbl.t;
646
+
not_destroyed : (string, Set_error.t) Hashtbl.t;
635
647
}
636
648
637
649
let account_id t = t.account_id
···
656
668
Hashtbl.fold (fun k v acc -> (k, to_json_fn v) :: acc) tbl []
657
669
in
658
670
`Assoc [
659
-
("accountId", `String t.account_id);
671
+
("accountId", `String (Jmap.Id.to_string t.account_id));
660
672
("oldState", `String t.old_state);
661
673
("newState", `String t.new_state);
662
674
("created", `Assoc (hashtbl_to_assoc Create.Response.to_json t.created));
663
675
("updated", `Assoc (hashtbl_to_assoc Update.Response.to_json t.updated));
664
-
("destroyed", `List (List.map (fun id -> `String id) t.destroyed));
676
+
("destroyed", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) t.destroyed));
665
677
("notCreated", `Assoc (hashtbl_to_assoc (fun _ -> `String "placeholder") t.not_created));
666
678
("notUpdated", `Assoc (hashtbl_to_assoc (fun _ -> `String "placeholder") t.not_updated));
667
679
("notDestroyed", `Assoc (hashtbl_to_assoc (fun _ -> `String "placeholder") t.not_destroyed));
···
672
684
match json with
673
685
| `Assoc fields ->
674
686
let account_id = match List.assoc_opt "accountId" fields with
675
-
| Some (`String s) -> s
687
+
| Some (`String s) -> (match Jmap.Id.of_string s with
688
+
| Ok id -> id
689
+
| Error _ -> failwith ("Invalid accountId: " ^ s))
676
690
| _ -> failwith "Missing required 'accountId' field in Identity/set response"
677
691
in
678
692
let old_state = match List.assoc_opt "oldState" fields with
···
701
715
| _ -> Hashtbl.create 0
702
716
in
703
717
let destroyed = match List.assoc_opt "destroyed" fields with
704
-
| Some (`List ids) -> List.map (function `String s -> s | _ -> failwith "Invalid ID in 'destroyed' list") ids
718
+
| Some (`List ids) -> List.map (function `String s -> (match Jmap.Id.of_string s with Ok id -> id | Error _ -> failwith ("Invalid ID in 'destroyed' list: " ^ s)) | _ -> failwith "Invalid ID in 'destroyed' list") ids
705
719
| _ -> []
706
720
in
707
721
let not_created = match List.assoc_opt "notCreated" fields with
···
727
741
(** Arguments for Identity/changes method *)
728
742
module Changes_args = struct
729
743
type t = {
730
-
account_id : id;
744
+
account_id : Jmap.Id.t;
731
745
since_state : string;
732
746
max_changes : int option;
733
747
}
···
741
755
742
756
let to_json t =
743
757
let fields = [
744
-
("accountId", `String t.account_id);
758
+
("accountId", `String (Jmap.Id.to_string t.account_id));
745
759
("sinceState", `String t.since_state);
746
760
] in
747
761
let fields = match t.max_changes with
···
755
769
match json with
756
770
| `Assoc fields ->
757
771
let account_id = match List.assoc_opt "accountId" fields with
758
-
| Some (`String s) -> s
772
+
| Some (`String s) -> (match Jmap.Id.of_string s with
773
+
| Ok id -> id
774
+
| Error _ -> failwith ("Invalid accountId: " ^ s))
759
775
| _ -> failwith "Missing required 'accountId' field in Identity/changes arguments"
760
776
in
761
777
let since_state = match List.assoc_opt "sinceState" fields with
···
775
791
776
792
let pp fmt t =
777
793
Format.fprintf fmt "Identity.Changes_args{account=%s;since=%s}"
778
-
t.account_id t.since_state
794
+
(Jmap.Id.to_string t.account_id) t.since_state
779
795
780
796
let pp_hum fmt t = pp fmt t
781
797
···
787
803
(** Response for Identity/changes method *)
788
804
module Changes_response = struct
789
805
type t = {
790
-
account_id : id;
806
+
account_id : Jmap.Id.t;
791
807
old_state : string;
792
808
new_state : string;
793
809
has_more_changes : bool;
794
-
created : id list;
795
-
updated : id list;
796
-
destroyed : id list;
810
+
created : Jmap.Id.t list;
811
+
updated : Jmap.Id.t list;
812
+
destroyed : Jmap.Id.t list;
797
813
}
798
814
799
815
let account_id t = t.account_id
···
811
827
812
828
let to_json t =
813
829
`Assoc [
814
-
("accountId", `String t.account_id);
830
+
("accountId", `String (Jmap.Id.to_string t.account_id));
815
831
("oldState", `String t.old_state);
816
832
("newState", `String t.new_state);
817
833
("hasMoreChanges", `Bool t.has_more_changes);
818
-
("created", `List (List.map (fun id -> `String id) t.created));
819
-
("updated", `List (List.map (fun id -> `String id) t.updated));
820
-
("destroyed", `List (List.map (fun id -> `String id) t.destroyed));
834
+
("created", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) t.created));
835
+
("updated", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) t.updated));
836
+
("destroyed", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) t.destroyed));
821
837
]
822
838
823
839
let of_json json =
···
825
841
match json with
826
842
| `Assoc fields ->
827
843
let account_id = match List.assoc_opt "accountId" fields with
828
-
| Some (`String s) -> s
844
+
| Some (`String s) -> (match Jmap.Id.of_string s with
845
+
| Ok id -> id
846
+
| Error _ -> failwith ("Invalid accountId: " ^ s))
829
847
| _ -> failwith "Missing required 'accountId' field in Identity/changes response"
830
848
in
831
849
let old_state = match List.assoc_opt "oldState" fields with
···
842
860
in
843
861
let get_id_list key =
844
862
match List.assoc_opt key fields with
845
-
| Some (`List ids) -> List.map (function `String s -> s | _ -> failwith ("Invalid ID in '" ^ key ^ "' list")) ids
863
+
| Some (`List ids) -> List.map (function `String s -> (match Jmap.Id.of_string s with Ok id -> id | Error _ -> failwith ("Invalid ID in '" ^ key ^ "' list: " ^ s)) | _ -> failwith ("Invalid ID in '" ^ key ^ "' list")) ids
846
864
| Some `Null | None -> []
847
865
| _ -> failwith ("Invalid '" ^ key ^ "' field in Identity/changes response")
848
866
in
···
860
878
module Get_response = struct
861
879
(* Use the outer module's type *)
862
880
type identity = {
863
-
id : id;
881
+
id : Jmap.Id.t;
864
882
name : string;
865
883
email : string;
866
-
reply_to : Types.Email_address.t list option;
867
-
bcc : Types.Email_address.t list option;
884
+
reply_to : Address.t list option;
885
+
bcc : Address.t list option;
868
886
text_signature : string;
869
887
html_signature : string;
870
888
may_delete : bool;
871
889
}
872
890
873
891
type t = {
874
-
account_id : id;
892
+
account_id : Jmap.Id.t;
875
893
state : string;
876
894
list : identity list;
877
-
not_found : id list;
895
+
not_found : Jmap.Id.t list;
878
896
}
879
897
880
898
let account_id t = t.account_id
···
887
905
888
906
let identity_to_json identity =
889
907
let fields = [
890
-
("id", `String identity.id);
908
+
("Id.t", `String (Jmap.Id.to_string identity.id));
891
909
("name", `String identity.name);
892
910
("email", `String identity.email);
893
911
("textSignature", `String identity.text_signature);
···
896
914
] in
897
915
let fields = match identity.reply_to with
898
916
| None -> ("replyTo", `Null) :: fields
899
-
| Some addrs -> ("replyTo", `List (List.map Types.Email_address.to_json addrs)) :: fields
917
+
| Some addrs -> ("replyTo", `List (List.map Address.to_json addrs)) :: fields
900
918
in
901
919
let fields = match identity.bcc with
902
920
| None -> ("bcc", `Null) :: fields
903
-
| Some addrs -> ("bcc", `List (List.map Types.Email_address.to_json addrs)) :: fields
921
+
| Some addrs -> ("bcc", `List (List.map Address.to_json addrs)) :: fields
904
922
in
905
923
`Assoc (List.rev fields)
906
924
···
925
943
let rec process_addresses acc = function
926
944
| [] -> Some (List.rev acc)
927
945
| addr :: rest ->
928
-
(match Types.Email_address.of_json addr with
946
+
(match Address.of_json addr with
929
947
| Ok a -> process_addresses (a :: acc) rest
930
948
| Error _ -> failwith ("Invalid address in " ^ key ^ " field"))
931
949
in
···
933
951
| Some `Null | None -> None
934
952
| _ -> failwith ("Invalid " ^ key ^ " field in Identity")
935
953
in
936
-
let id = get_string "id" "" in
937
-
if id = "" then failwith "Missing required 'id' field in Identity";
954
+
let id_str = get_string "Id.t" "" in
955
+
if id_str = "" then failwith "Missing required 'id' field in Identity";
956
+
let id = match Jmap.Id.of_string id_str with
957
+
| Ok id -> id
958
+
| Error _ -> failwith ("Invalid id: " ^ id_str) in
938
959
let email = get_string "email" "" in
939
960
if email = "" then failwith "Missing required 'email' field in Identity";
940
961
{
···
951
972
952
973
let to_json t =
953
974
`Assoc [
954
-
("accountId", `String t.account_id);
975
+
("accountId", `String (Jmap.Id.to_string t.account_id));
955
976
("state", `String t.state);
956
977
("list", `List (List.map identity_to_json t.list));
957
-
("notFound", `List (List.map (fun id -> `String id) t.not_found));
978
+
("notFound", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) t.not_found));
958
979
]
959
980
960
981
let of_json json =
···
962
983
match json with
963
984
| `Assoc fields ->
964
985
let account_id = match List.assoc_opt "accountId" fields with
965
-
| Some (`String s) -> s
986
+
| Some (`String s) -> (match Jmap.Id.of_string s with
987
+
| Ok id -> id
988
+
| Error _ -> failwith ("Invalid accountId: " ^ s))
966
989
| _ -> failwith "Missing required 'accountId' field in Identity/get response"
967
990
in
968
991
let state = match List.assoc_opt "state" fields with
···
974
997
| _ -> failwith "Missing required 'list' field in Identity/get response"
975
998
in
976
999
let not_found = match List.assoc_opt "notFound" fields with
977
-
| Some (`List ids) -> List.map (function `String s -> s | _ -> failwith "Invalid ID in 'notFound' list") ids
1000
+
| Some (`List ids) -> List.filter_map (function
1001
+
| `String s -> (match Jmap.Id.of_string s with
1002
+
| Ok id -> Some id
1003
+
| Error _ -> None)
1004
+
| _ -> None) ids
978
1005
| _ -> failwith "Missing required 'notFound' field in Identity/get response"
979
1006
in
980
1007
Ok { account_id; state; list; not_found }
···
997
1024
]
998
1025
999
1026
let to_string = function
1000
-
| `Id -> "id"
1027
+
| `Id -> "Id.t"
1001
1028
| `Name -> "name"
1002
1029
| `Email -> "email"
1003
1030
| `ReplyTo -> "replyTo"
···
1007
1034
| `MayDelete -> "mayDelete"
1008
1035
1009
1036
let of_string = function
1010
-
| "id" -> Some `Id
1037
+
| "Id.t" -> Some `Id
1011
1038
| "name" -> Some `Name
1012
1039
| "email" -> Some `Email
1013
1040
| "replyTo" -> Some `ReplyTo
+63
-64
jmap/jmap-email/identity.mli
+63
-64
jmap/jmap-email/identity.mli
···
12
12
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-6> RFC 8621, Section 6: Identity
13
13
*)
14
14
15
-
open Jmap.Types
16
15
open Jmap.Error
17
16
18
17
(** Complete identity object representation.
···
31
30
include Jmap_sigs.PRINTABLE with type t := t
32
31
33
32
(** JMAP object interface for property selection and object creation *)
34
-
include Jmap_sigs.JMAP_OBJECT with type t := t and type id_type := id
33
+
include Jmap_sigs.JMAP_OBJECT with type t := t and type id_type := string
35
34
36
35
(** Get the server-assigned identity identifier.
37
36
@return Immutable unique ID (Some for all persisted identities, None only for unsaved objects) *)
38
-
val id : t -> id option
37
+
val id : t -> Jmap.Id.t option
39
38
40
39
(** Get the display name for this identity.
41
40
@return Human-readable name, empty string if not set *)
···
47
46
48
47
(** Get the default Reply-To addresses for this identity.
49
48
@return List of reply-to addresses, or None if not specified *)
50
-
val reply_to : t -> Types.Email_address.t list option
49
+
val reply_to : t -> Address.t list option
51
50
52
51
(** Get the default Bcc addresses for this identity.
53
52
@return List of addresses to always Bcc, or None if not specified *)
54
-
val bcc : t -> Types.Email_address.t list option
53
+
val bcc : t -> Address.t list option
55
54
56
55
(** Get the plain text email signature.
57
56
@return Text signature to append to plain text messages *)
···
66
65
val may_delete : t -> bool
67
66
68
67
(** Create a new identity object.
69
-
@param id Server-assigned identity identifier
68
+
@param Jmap.Id.t Server-assigned identity identifier
70
69
@param name Optional display name (defaults to empty string)
71
70
@param email Required email address for sending
72
71
@param reply_to Optional default Reply-To addresses
···
76
75
@param may_delete Server permission for deletion
77
76
@return New identity object *)
78
77
val v :
79
-
id:id ->
78
+
id:Jmap.Id.t ->
80
79
?name:string ->
81
80
email:string ->
82
-
?reply_to:Types.Email_address.t list ->
83
-
?bcc:Types.Email_address.t list ->
81
+
?reply_to:Address.t list ->
82
+
?bcc:Address.t list ->
84
83
?text_signature:string ->
85
84
?html_signature:string ->
86
85
may_delete:bool ->
···
110
109
111
110
(** Get the Reply-To addresses for creation.
112
111
@return Optional list of reply-to addresses *)
113
-
val reply_to : t -> Types.Email_address.t list option
112
+
val reply_to : t -> Address.t list option
114
113
115
114
(** Get the Bcc addresses for creation.
116
115
@return Optional list of default Bcc addresses *)
117
-
val bcc : t -> Types.Email_address.t list option
116
+
val bcc : t -> Address.t list option
118
117
119
118
(** Get the plain text signature for creation.
120
119
@return Optional text signature *)
···
135
134
val v :
136
135
?name:string ->
137
136
email:string ->
138
-
?reply_to:Types.Email_address.t list ->
139
-
?bcc:Types.Email_address.t list ->
137
+
?reply_to:Address.t list ->
138
+
?bcc:Address.t list ->
140
139
?text_signature:string ->
141
140
?html_signature:string ->
142
141
unit -> t
···
156
155
157
156
(** Get the server-assigned ID for the created identity.
158
157
@return Unique identifier assigned by the server *)
159
-
val id : t -> id
158
+
val id : t -> Jmap.Id.t
160
159
161
160
(** Check if the created identity may be deleted.
162
161
@return Server-computed permission for future deletion *)
163
162
val may_delete : t -> bool
164
163
165
164
(** Create an identity creation response.
166
-
@param id Server-assigned identity ID
165
+
@param Jmap.Id.t Server-assigned identity ID
167
166
@param may_delete Whether the identity can be deleted
168
167
@return Creation response object *)
169
168
val v :
170
-
id:id ->
169
+
id:Jmap.Id.t ->
171
170
may_delete:bool ->
172
171
unit -> t
173
172
end
···
201
200
(** Create an update that sets the Reply-To addresses.
202
201
@param reply_to New Reply-To addresses (None to clear)
203
202
@return Update patch object *)
204
-
val set_reply_to : Types.Email_address.t list option -> t
203
+
val set_reply_to : Address.t list option -> t
205
204
206
205
(** Create an update that sets the Bcc addresses.
207
206
@param bcc New default Bcc addresses (None to clear)
208
207
@return Update patch object *)
209
-
val set_bcc : Types.Email_address.t list option -> t
208
+
val set_bcc : Address.t list option -> t
210
209
211
210
(** Create an update that sets the plain text signature.
212
211
@param text_signature New text signature (empty string to clear)
···
272
271
include Jmap_sigs.JSONABLE with type t := t
273
272
274
273
(** JMAP method arguments interface *)
275
-
include Jmap_sigs.METHOD_ARGS with type t := t and type account_id := id
274
+
include Jmap_sigs.METHOD_ARGS with type t := t and type account_id := string
276
275
277
276
(** Get the account ID for the operation.
278
277
@return Account identifier where identities will be retrieved *)
279
-
val account_id : t -> id
278
+
val account_id : t -> Jmap.Id.t
280
279
281
280
(** Validate get arguments according to JMAP method constraints.
282
281
@param t Get arguments to validate
···
289
288
290
289
(** Get the specific identity IDs to retrieve.
291
290
@return List of identity IDs, or None to retrieve all identities *)
292
-
val ids : t -> id list option
291
+
val ids : t -> Jmap.Id.t list option
293
292
294
293
(** Get the properties to include in the response.
295
294
@return List of property names, or None for all properties *)
···
301
300
@param properties Optional list of properties to include
302
301
@return Identity/get arguments object *)
303
302
val v :
304
-
account_id:id ->
305
-
?ids:id list ->
303
+
account_id:Jmap.Id.t ->
304
+
?ids:Jmap.Id.t list ->
306
305
?properties:string list ->
307
306
unit -> t
308
307
end
···
317
316
module Get_response : sig
318
317
(** Identity type for response lists *)
319
318
type identity = {
320
-
id : id;
319
+
id : Jmap.Id.t;
321
320
name : string;
322
321
email : string;
323
-
reply_to : Types.Email_address.t list option;
324
-
bcc : Types.Email_address.t list option;
322
+
reply_to : Address.t list option;
323
+
bcc : Address.t list option;
325
324
text_signature : string;
326
325
html_signature : string;
327
326
may_delete : bool;
···
334
333
335
334
(** Get the account ID from the response.
336
335
@return Account identifier where identities were retrieved *)
337
-
val account_id : t -> id
336
+
val account_id : t -> Jmap.Id.t
338
337
339
338
(** Get the current state string for change tracking.
340
339
@return State string for use in Identity/changes *)
···
346
345
347
346
(** Get the list of identity IDs that were not found.
348
347
@return List of requested IDs that don't exist *)
349
-
val not_found : t -> id list
348
+
val not_found : t -> Jmap.Id.t list
350
349
351
350
(** Create Identity/get response.
352
351
@param account_id Account where identities were retrieved
···
355
354
@param not_found IDs that were not found
356
355
@return Identity/get response object *)
357
356
val v :
358
-
account_id:id ->
357
+
account_id:Jmap.Id.t ->
359
358
state:string ->
360
359
list:identity list ->
361
-
not_found:id list ->
360
+
not_found:Jmap.Id.t list ->
362
361
unit -> t
363
362
end
364
363
···
375
374
include Jmap_sigs.JSONABLE with type t := t
376
375
377
376
(** JMAP method arguments interface *)
378
-
include Jmap_sigs.METHOD_ARGS with type t := t and type account_id := id
377
+
include Jmap_sigs.METHOD_ARGS with type t := t and type account_id := string
379
378
380
379
(** Get the account ID for the operation.
381
380
@return Account identifier where identities will be modified *)
382
-
val account_id : t -> id
381
+
val account_id : t -> Jmap.Id.t
383
382
384
383
(** Validate set arguments according to JMAP method constraints.
385
384
@param t Set arguments to validate
···
396
395
397
396
(** Get the identities to create.
398
397
@return Map of creation IDs to creation objects *)
399
-
val create : t -> Create.t id_map option
398
+
val create : t -> (string, Create.t) Hashtbl.t option
400
399
401
400
(** Get the identities to update.
402
401
@return Map of identity IDs to update patch objects *)
403
-
val update : t -> Update.t id_map option
402
+
val update : t -> (string, Update.t) Hashtbl.t option
404
403
405
404
(** Get the identity IDs to destroy.
406
405
@return List of identity IDs to delete *)
407
-
val destroy : t -> id list option
406
+
val destroy : t -> Jmap.Id.t list option
408
407
409
408
(** Create Identity/set arguments.
410
409
@param account_id Account where identities will be modified
···
414
413
@param destroy Optional list of identity IDs to delete
415
414
@return Identity/set arguments object *)
416
415
val v :
417
-
account_id:id ->
416
+
account_id:Jmap.Id.t ->
418
417
?if_in_state:string ->
419
-
?create:Create.t id_map ->
420
-
?update:Update.t id_map ->
421
-
?destroy:id list ->
418
+
?create:(string, Create.t) Hashtbl.t ->
419
+
?update:(string, Update.t) Hashtbl.t ->
420
+
?destroy:Jmap.Id.t list ->
422
421
unit -> t
423
422
end
424
423
···
437
436
438
437
(** Get the account ID from the response.
439
438
@return Account identifier where identities were modified *)
440
-
val account_id : t -> id
439
+
val account_id : t -> Jmap.Id.t
441
440
442
441
(** Get the old state string.
443
442
@return State string before the operations were applied *)
···
449
448
450
449
(** Get the successfully created identities.
451
450
@return Map of creation IDs to creation response objects *)
452
-
val created : t -> Create.Response.t id_map
451
+
val created : t -> (string, Create.Response.t) Hashtbl.t
453
452
454
453
(** Get the successfully updated identities.
455
454
@return Map of identity IDs to update response objects *)
456
-
val updated : t -> Update.Response.t id_map
455
+
val updated : t -> (string, Update.Response.t) Hashtbl.t
457
456
458
457
(** Get the successfully destroyed identity IDs.
459
458
@return List of identity IDs that were successfully deleted *)
460
-
val destroyed : t -> id list
459
+
val destroyed : t -> Jmap.Id.t list
461
460
462
461
(** Get the identities that could not be created.
463
462
@return Map of creation IDs to error objects *)
464
-
val not_created : t -> Set_error.t id_map
463
+
val not_created : t -> (string, Set_error.t) Hashtbl.t
465
464
466
465
(** Get the identities that could not be updated.
467
466
@return Map of identity IDs to error objects *)
468
-
val not_updated : t -> Set_error.t id_map
467
+
val not_updated : t -> (string, Set_error.t) Hashtbl.t
469
468
470
469
(** Get the identities that could not be destroyed.
471
470
@return Map of identity IDs to error objects *)
472
-
val not_destroyed : t -> Set_error.t id_map
471
+
val not_destroyed : t -> (string, Set_error.t) Hashtbl.t
473
472
474
473
(** Create Identity/set response.
475
474
@param account_id Account where identities were modified
···
483
482
@param not_destroyed Identities that could not be destroyed
484
483
@return Identity/set response object *)
485
484
val v :
486
-
account_id:id ->
485
+
account_id:Jmap.Id.t ->
487
486
old_state:string ->
488
487
new_state:string ->
489
-
?created:Create.Response.t id_map ->
490
-
?updated:Update.Response.t id_map ->
491
-
?destroyed:id list ->
492
-
?not_created:Set_error.t id_map ->
493
-
?not_updated:Set_error.t id_map ->
494
-
?not_destroyed:Set_error.t id_map ->
488
+
?created:(string, Create.Response.t) Hashtbl.t ->
489
+
?updated:(string, Update.Response.t) Hashtbl.t ->
490
+
?destroyed:Jmap.Id.t list ->
491
+
?not_created:(string, Set_error.t) Hashtbl.t ->
492
+
?not_updated:(string, Set_error.t) Hashtbl.t ->
493
+
?not_destroyed:(string, Set_error.t) Hashtbl.t ->
495
494
unit -> t
496
495
end
497
496
···
509
508
include Jmap_sigs.JSONABLE with type t := t
510
509
511
510
(** JMAP method arguments interface *)
512
-
include Jmap_sigs.METHOD_ARGS with type t := t and type account_id := id
511
+
include Jmap_sigs.METHOD_ARGS with type t := t and type account_id := string
513
512
514
513
(** Get the account ID for the operation.
515
514
@return Account identifier where changes will be retrieved *)
516
-
val account_id : t -> id
515
+
val account_id : t -> Jmap.Id.t
517
516
518
517
(** Validate changes arguments according to JMAP method constraints.
519
518
@param t Changes arguments to validate
···
538
537
@param max_changes Optional limit on number of changes
539
538
@return Identity/changes arguments object *)
540
539
val v :
541
-
account_id:id ->
540
+
account_id:Jmap.Id.t ->
542
541
since_state:string ->
543
542
?max_changes:int ->
544
543
unit -> t
···
559
558
560
559
(** Get the account ID from the response.
561
560
@return Account identifier where changes were retrieved *)
562
-
val account_id : t -> id
561
+
val account_id : t -> Jmap.Id.t
563
562
564
563
(** Get the old state string.
565
564
@return State string that was passed in since_state *)
···
575
574
576
575
(** Get the list of created or updated identity IDs.
577
576
@return List of identity IDs that have been created or updated *)
578
-
val created : t -> id list
577
+
val created : t -> Jmap.Id.t list
579
578
580
579
(** Get the list of updated identity IDs.
581
580
@return List of identity IDs that have been updated *)
582
-
val updated : t -> id list
581
+
val updated : t -> Jmap.Id.t list
583
582
584
583
(** Get the list of destroyed identity IDs.
585
584
@return List of identity IDs that have been destroyed *)
586
-
val destroyed : t -> id list
585
+
val destroyed : t -> Jmap.Id.t list
587
586
588
587
(** Create Identity/changes response.
589
588
@param account_id Account where changes were retrieved
···
595
594
@param destroyed List of destroyed identity IDs
596
595
@return Identity/changes response object *)
597
596
val v :
598
-
account_id:id ->
597
+
account_id:Jmap.Id.t ->
599
598
old_state:string ->
600
599
new_state:string ->
601
600
has_more_changes:bool ->
602
-
?created:id list ->
603
-
?updated:id list ->
604
-
?destroyed:id list ->
601
+
?created:Jmap.Id.t list ->
602
+
?updated:Jmap.Id.t list ->
603
+
?destroyed:Jmap.Id.t list ->
605
604
unit -> t
606
605
end
607
606
+365
-191
jmap/jmap-email/mailbox.ml
+365
-191
jmap/jmap-email/mailbox.ml
···
9
9
10
10
[@@@warning "-32"] (* Suppress unused value warnings for interface-required functions *)
11
11
12
-
open Jmap.Types
13
12
open Jmap.Method_names
14
13
open Jmap.Methods
15
14
···
42
41
43
42
(* Main mailbox type with all properties *)
44
43
type t = {
45
-
mailbox_id : id;
44
+
mailbox_id : Jmap.Id.t;
46
45
name : string;
47
-
parent_id : id option;
46
+
parent_id : Jmap.Id.t option;
48
47
role : role option;
49
-
sort_order : uint;
50
-
total_emails : uint;
51
-
unread_emails : uint;
52
-
total_threads : uint;
53
-
unread_threads : uint;
48
+
sort_order : Jmap.UInt.t;
49
+
total_emails : Jmap.UInt.t;
50
+
unread_emails : Jmap.UInt.t;
51
+
total_threads : Jmap.UInt.t;
52
+
unread_threads : Jmap.UInt.t;
54
53
my_rights : rights;
55
54
is_subscribed : bool;
56
55
}
···
86
85
may_set_seen = false; may_set_keywords = false; may_create_child = false;
87
86
may_rename = false; may_delete = false; may_submit = false;
88
87
} in
88
+
let id_result = match Jmap.Id.of_string id with
89
+
| Ok id -> id
90
+
| Error e -> failwith ("Invalid mailbox ID: " ^ e) in
91
+
let sort_order = match Jmap.UInt.of_int 0 with
92
+
| Ok n -> n
93
+
| Error e -> failwith ("Invalid sort_order: " ^ e) in
94
+
let total_emails = match Jmap.UInt.of_int 0 with
95
+
| Ok n -> n
96
+
| Error e -> failwith ("Invalid total_emails: " ^ e) in
97
+
let unread_emails = match Jmap.UInt.of_int 0 with
98
+
| Ok n -> n
99
+
| Error e -> failwith ("Invalid unread_emails: " ^ e) in
89
100
{
90
-
mailbox_id = id;
101
+
mailbox_id = id_result;
91
102
name = "Untitled";
92
103
parent_id = None;
93
104
role = None;
94
-
sort_order = 0;
95
-
total_emails = 0;
96
-
unread_emails = 0;
97
-
total_threads = 0;
98
-
unread_threads = 0;
105
+
sort_order;
106
+
total_emails;
107
+
unread_emails;
108
+
total_threads = (match Jmap.UInt.of_int 0 with Ok n -> n | Error e -> failwith ("Invalid total_threads: " ^ e));
109
+
unread_threads = (match Jmap.UInt.of_int 0 with Ok n -> n | Error e -> failwith ("Invalid unread_threads: " ^ e));
99
110
my_rights = default_rights;
100
111
is_subscribed = true;
101
112
}
102
113
103
114
(* Get list of all valid property names for Mailbox objects *)
104
115
let valid_properties () = [
105
-
"id"; "name"; "parentId"; "role"; "sortOrder";
116
+
"Jmap.Id.t"; "name"; "parentId"; "role"; "sortOrder";
106
117
"totalEmails"; "unreadEmails"; "totalThreads"; "unreadThreads";
107
118
"myRights"; "isSubscribed"
108
119
]
109
120
110
121
111
122
(* Extended constructor with validation - renamed from create *)
112
-
let create_full ~id ~name ?parent_id ?role ?(sort_order=0) ~total_emails ~unread_emails
123
+
let create_full ~id ~name ?parent_id ?role ?(sort_order=(match Jmap.UInt.of_int 0 with Ok u -> u | Error _ -> failwith "Invalid default sort_order")) ~total_emails ~unread_emails
113
124
~total_threads ~unread_threads ~my_rights ~is_subscribed () =
114
125
if String.length name = 0 then
115
126
Error "Mailbox name cannot be empty"
116
-
else if total_emails < unread_emails then
127
+
else if Jmap.UInt.to_int total_emails < Jmap.UInt.to_int unread_emails then
117
128
Error "Unread emails cannot exceed total emails"
118
-
else if total_threads < unread_threads then
129
+
else if Jmap.UInt.to_int total_threads < Jmap.UInt.to_int unread_threads then
119
130
Error "Unread threads cannot exceed total threads"
120
131
else
132
+
let sort_order_uint = sort_order in
121
133
Ok {
122
134
mailbox_id = id;
123
135
name;
124
136
parent_id;
125
137
role;
126
-
sort_order;
138
+
sort_order = sort_order_uint;
127
139
total_emails;
128
140
unread_emails;
129
141
total_threads;
···
210
222
| Some r -> Role.to_string r
211
223
| None -> "none"
212
224
in
213
-
Format.fprintf ppf "Mailbox{id=%s; name=%s; role=%s}" t.mailbox_id t.name role_str
225
+
Format.fprintf ppf "Mailbox{id=%s; name=%s; role=%s}" (Jmap.Id.to_string t.mailbox_id) t.name role_str
214
226
215
227
let pp_hum = pp
216
228
···
232
244
("maySubmit", `Bool rights.may_submit);
233
245
] in
234
246
let all_fields = [
235
-
("id", `String t.mailbox_id);
247
+
("id", `String (Jmap.Id.to_string t.mailbox_id));
236
248
("name", `String t.name);
237
-
("parentId", (match t.parent_id with Some p -> `String p | None -> `Null));
249
+
("parentId", (match t.parent_id with Some p -> `String (Jmap.Id.to_string p) | None -> `Null));
238
250
("role", role_to_json t.role);
239
-
("sortOrder", `Int t.sort_order);
240
-
("totalEmails", `Int t.total_emails);
241
-
("unreadEmails", `Int t.unread_emails);
242
-
("totalThreads", `Int t.total_threads);
243
-
("unreadThreads", `Int t.unread_threads);
251
+
("sortOrder", `Int (Jmap.UInt.to_int t.sort_order));
252
+
("totalEmails", `Int (Jmap.UInt.to_int t.total_emails));
253
+
("unreadEmails", `Int (Jmap.UInt.to_int t.unread_emails));
254
+
("totalThreads", `Int (Jmap.UInt.to_int t.total_threads));
255
+
("unreadThreads", `Int (Jmap.UInt.to_int t.unread_threads));
244
256
("myRights", rights_to_json t.my_rights);
245
257
("isSubscribed", `Bool t.is_subscribed);
246
258
] in
···
386
398
let other s = Other s
387
399
388
400
let to_string = function
389
-
| Id -> "id"
401
+
| Id -> "Jmap.Id.t"
390
402
| Name -> "name"
391
403
| ParentId -> "parentId"
392
404
| Role -> "role"
···
400
412
| Other s -> s
401
413
402
414
let of_string = function
403
-
| "id" -> Ok Id
415
+
| "Jmap.Id.t" -> Ok Id
404
416
| "name" -> Ok Name
405
417
| "parentId" -> Ok ParentId
406
418
| "role" -> Ok Role
···
443
455
module Create = struct
444
456
type t = {
445
457
create_name : string;
446
-
create_parent_id : id option;
458
+
create_parent_id : Jmap.Id.t option;
447
459
create_role : role option;
448
-
create_sort_order : uint option;
460
+
create_sort_order : Jmap.UInt.t option;
449
461
create_is_subscribed : bool option;
450
462
}
451
463
···
473
485
("name", `String create_req.create_name);
474
486
] in
475
487
let base = match create_req.create_parent_id with
476
-
| Some pid -> ("parentId", `String pid) :: base
488
+
| Some pid -> ("parentId", `String (Jmap.Id.to_string pid)) :: base
477
489
| None -> base
478
490
in
479
491
let base = match create_req.create_role with
···
481
493
| None -> base
482
494
in
483
495
let base = match create_req.create_sort_order with
484
-
| Some so -> ("sortOrder", `Int so) :: base
496
+
| Some so -> ("sortOrder", `Int (Jmap.UInt.to_int so)) :: base
485
497
| None -> base
486
498
in
487
499
let base = match create_req.create_is_subscribed with
···
494
506
try
495
507
let open Yojson.Safe.Util in
496
508
let name = json |> member "name" |> to_string in
497
-
let parent_id = json |> member "parentId" |> to_string_option in
509
+
let parent_id = match json |> member "parentId" |> to_string_option with
510
+
| None -> None
511
+
| Some s -> Some (match Jmap.Id.of_string s with
512
+
| Ok id -> id
513
+
| Error err -> failwith ("Invalid parentId: " ^ err)) in
498
514
let role_opt : (role option, string) result = match json |> member "role" with
499
515
| `Null -> Ok None
500
516
| role_json ->
···
502
518
| Ok r -> Ok (Some r)
503
519
| Error e -> Error e
504
520
in
505
-
let sort_order = json |> member "sortOrder" |> to_int_option in
521
+
let sort_order = match json |> member "sortOrder" |> to_int_option with
522
+
| None -> None
523
+
| Some i -> Some (match Jmap.UInt.of_int i with
524
+
| Ok uint -> uint
525
+
| Error err -> failwith ("Invalid sortOrder: " ^ err)) in
506
526
let is_subscribed = json |> member "isSubscribed" |> to_bool_option in
507
527
match role_opt with
508
528
| Ok role ->
···
520
540
521
541
module Response = struct
522
542
type t = {
523
-
response_id : id;
543
+
response_id : Jmap.Id.t;
524
544
response_role : role option;
525
-
response_sort_order : uint;
526
-
response_total_emails : uint;
527
-
response_unread_emails : uint;
528
-
response_total_threads : uint;
529
-
response_unread_threads : uint;
545
+
response_sort_order : Jmap.UInt.t;
546
+
response_total_emails : Jmap.UInt.t;
547
+
response_unread_emails : Jmap.UInt.t;
548
+
response_total_threads : Jmap.UInt.t;
549
+
response_unread_threads : Jmap.UInt.t;
530
550
response_my_rights : rights;
531
551
response_is_subscribed : bool;
532
552
}
···
544
564
(* JSON serialization *)
545
565
let to_json response =
546
566
let base = [
547
-
("id", `String response.response_id);
548
-
("sortOrder", `Int response.response_sort_order);
549
-
("totalEmails", `Int response.response_total_emails);
550
-
("unreadEmails", `Int response.response_unread_emails);
551
-
("totalThreads", `Int response.response_total_threads);
552
-
("unreadThreads", `Int response.response_unread_threads);
567
+
("Jmap.Id.t", `String (Jmap.Id.to_string response.response_id));
568
+
("sortOrder", `Int (Jmap.UInt.to_int response.response_sort_order));
569
+
("totalEmails", `Int (Jmap.UInt.to_int response.response_total_emails));
570
+
("unreadEmails", `Int (Jmap.UInt.to_int response.response_unread_emails));
571
+
("totalThreads", `Int (Jmap.UInt.to_int response.response_total_threads));
572
+
("unreadThreads", `Int (Jmap.UInt.to_int response.response_unread_threads));
553
573
("myRights", Rights.to_json response.response_my_rights);
554
574
("isSubscribed", `Bool response.response_is_subscribed);
555
575
] in
···
562
582
let of_json json =
563
583
try
564
584
let open Yojson.Safe.Util in
565
-
let id = json |> member "id" |> to_string in
585
+
let id_str = json |> member "id" |> to_string in
586
+
let id = match Jmap.Id.of_string id_str with
587
+
| Ok id_val -> id_val
588
+
| Error e -> failwith ("Invalid mailbox ID: " ^ id_str ^ " - " ^ e)
589
+
in
566
590
let role_opt : (role option, string) result = match json |> member "role" with
567
591
| `Null -> Ok None
568
592
| role_json ->
···
570
594
| Ok r -> Ok (Some r)
571
595
| Error e -> Error e
572
596
in
573
-
let sort_order = json |> member "sortOrder" |> to_int in
574
-
let total_emails = json |> member "totalEmails" |> to_int in
575
-
let unread_emails = json |> member "unreadEmails" |> to_int in
576
-
let total_threads = json |> member "totalThreads" |> to_int in
577
-
let unread_threads = json |> member "unreadThreads" |> to_int in
597
+
let sort_order_int = json |> member "sortOrder" |> to_int in
598
+
let sort_order = match Jmap.UInt.of_int sort_order_int with
599
+
| Ok uint -> uint
600
+
| Error _ -> failwith ("Invalid sortOrder: " ^ string_of_int sort_order_int) in
601
+
let total_emails_int = json |> member "totalEmails" |> to_int in
602
+
let total_emails = match Jmap.UInt.of_int total_emails_int with
603
+
| Ok uint -> uint
604
+
| Error _ -> failwith ("Invalid totalEmails: " ^ string_of_int total_emails_int) in
605
+
let unread_emails_int = json |> member "unreadEmails" |> to_int in
606
+
let unread_emails = match Jmap.UInt.of_int unread_emails_int with
607
+
| Ok uint -> uint
608
+
| Error _ -> failwith ("Invalid unreadEmails: " ^ string_of_int unread_emails_int) in
609
+
let total_threads_int = json |> member "totalThreads" |> to_int in
610
+
let total_threads = match Jmap.UInt.of_int total_threads_int with
611
+
| Ok uint -> uint
612
+
| Error _ -> failwith ("Invalid totalThreads: " ^ string_of_int total_threads_int) in
613
+
let unread_threads_int = json |> member "unreadThreads" |> to_int in
614
+
let unread_threads = match Jmap.UInt.of_int unread_threads_int with
615
+
| Ok uint -> uint
616
+
| Error _ -> failwith ("Invalid unreadThreads: " ^ string_of_int unread_threads_int) in
578
617
let my_rights_result = json |> member "myRights" |> Rights.of_json in
579
618
let is_subscribed = json |> member "isSubscribed" |> to_bool in
580
619
match role_opt, my_rights_result with
···
599
638
end
600
639
601
640
module Update = struct
602
-
type t = patch_object
641
+
type t = Jmap.Methods.patch_object
603
642
604
643
let create ?name ?parent_id ?role ?sort_order ?is_subscribed () =
605
644
let patches = [] in
···
608
647
| None -> patches
609
648
in
610
649
let patches = match parent_id with
611
-
| Some (Some id) -> ("/parentId", `String id) :: patches
650
+
| Some (Some id) -> ("/parentId", `String (Jmap.Id.to_string id)) :: patches
612
651
| Some None -> ("/parentId", `Null) :: patches
613
652
| None -> patches
614
653
in
···
618
657
| None -> patches
619
658
in
620
659
let patches = match sort_order with
621
-
| Some n -> ("/sortOrder", `Int n) :: patches
660
+
| Some n -> ("/sortOrder", `Int (Jmap.UInt.to_int n)) :: patches
622
661
| None -> patches
623
662
in
624
663
let patches = match is_subscribed with
···
648
687
| Some mailbox ->
649
688
(* Create complete JSON representation inline *)
650
689
let base = [
651
-
("id", `String mailbox.mailbox_id);
690
+
("Jmap.Id.t", `String (Jmap.Id.to_string mailbox.mailbox_id));
652
691
("name", `String mailbox.name);
653
-
("sortOrder", `Int mailbox.sort_order);
654
-
("totalEmails", `Int mailbox.total_emails);
655
-
("unreadEmails", `Int mailbox.unread_emails);
656
-
("totalThreads", `Int mailbox.total_threads);
657
-
("unreadThreads", `Int mailbox.unread_threads);
692
+
("sortOrder", `Int (Jmap.UInt.to_int mailbox.sort_order));
693
+
("totalEmails", `Int (Jmap.UInt.to_int mailbox.total_emails));
694
+
("unreadEmails", `Int (Jmap.UInt.to_int mailbox.unread_emails));
695
+
("totalThreads", `Int (Jmap.UInt.to_int mailbox.total_threads));
696
+
("unreadThreads", `Int (Jmap.UInt.to_int mailbox.unread_threads));
658
697
("myRights", Rights.to_json mailbox.my_rights);
659
698
("isSubscribed", `Bool mailbox.is_subscribed);
660
699
] in
661
700
let base = match mailbox.parent_id with
662
-
| Some pid -> ("parentId", `String pid) :: base
701
+
| Some pid -> ("parentId", `String (Jmap.Id.to_string pid)) :: base
663
702
| None -> base
664
703
in
665
704
let base = match mailbox.role with
···
681
720
(* Stub implementations for method modules - these would be implemented based on actual JMAP method signatures *)
682
721
module Query_args = struct
683
722
type t = {
684
-
account_id : id;
723
+
account_id : Jmap.Id.t;
685
724
filter : Filter.t option;
686
725
sort : Comparator.t list option;
687
-
position : uint option;
688
-
limit : uint option;
726
+
position : Jmap.UInt.t option;
727
+
limit : Jmap.UInt.t option;
689
728
calculate_total : bool option;
690
729
}
691
730
···
700
739
let calculate_total args = args.calculate_total
701
740
702
741
let to_json args =
703
-
let fields = [("accountId", `String args.account_id)] in
742
+
let fields = [("accountId", `String (Jmap.Id.to_string args.account_id))] in
704
743
let fields = match args.filter with
705
744
| None -> fields
706
-
| Some filter -> ("filter", Filter.to_json filter) :: fields
745
+
| Some _filter -> ("filter", `Null) :: fields (* Filter serialization needs implementation *)
707
746
in
708
747
let fields = match args.sort with
709
748
| None -> fields
···
711
750
in
712
751
let fields = match args.position with
713
752
| None -> fields
714
-
| Some pos -> ("position", `Int pos) :: fields
753
+
| Some pos -> ("position", `Int (Jmap.UInt.to_int pos)) :: fields
715
754
in
716
755
let fields = match args.limit with
717
756
| None -> fields
718
-
| Some lim -> ("limit", `Int lim) :: fields
757
+
| Some lim -> ("limit", `Int (Jmap.UInt.to_int lim)) :: fields
719
758
in
720
759
let fields = match args.calculate_total with
721
760
| None -> fields
···
728
767
match json with
729
768
| `Assoc fields ->
730
769
let account_id = match List.assoc "accountId" fields with
731
-
| `String s -> s
770
+
| `String s -> (match Jmap.Id.of_string s with
771
+
| Ok id -> id
772
+
| Error _ -> failwith ("Invalid accountId: " ^ s))
732
773
| _ -> failwith "Expected string for accountId"
733
774
in
734
775
let filter : Filter.t option = match List.assoc_opt "filter" fields with
···
745
786
) sort_list)
746
787
| Some _ -> failwith "Expected list for sort"
747
788
in
748
-
let position : uint option = match List.assoc_opt "position" fields with
789
+
let position : Jmap.UInt.t option = match List.assoc_opt "position" fields with
749
790
| None -> None
750
-
| Some (`Int i) when i >= 0 -> Some i
791
+
| Some (`Int i) when i >= 0 -> (match Jmap.UInt.of_int i with
792
+
| Ok uint -> Some uint
793
+
| Error _ -> failwith ("Invalid position: " ^ string_of_int i))
751
794
| Some (`Int _) -> failwith "Position must be non-negative"
752
795
| Some _ -> failwith "Expected int for position"
753
796
in
754
-
let limit : uint option = match List.assoc_opt "limit" fields with
797
+
let limit : Jmap.UInt.t option = match List.assoc_opt "limit" fields with
755
798
| None -> None
756
-
| Some (`Int i) when i >= 0 -> Some i
799
+
| Some (`Int i) when i >= 0 -> (match Jmap.UInt.of_int i with
800
+
| Ok uint -> Some uint
801
+
| Error _ -> failwith ("Invalid limit: " ^ string_of_int i))
757
802
| Some (`Int _) -> failwith "Limit must be non-negative"
758
803
| Some _ -> failwith "Expected int for limit"
759
804
in
···
770
815
| exn -> Error ("Query_args JSON parsing exception: " ^ Printexc.to_string exn)
771
816
772
817
let pp fmt t =
773
-
Format.fprintf fmt "Mailbox.Query_args{account=%s}" t.account_id
818
+
Format.fprintf fmt "Mailbox.Query_args{account=%s}" (Jmap.Id.to_string t.account_id)
774
819
775
820
let pp_hum fmt t = pp fmt t
776
821
···
781
826
782
827
module Query_response = struct
783
828
type t = {
784
-
account_id : id;
829
+
account_id : Jmap.Id.t;
785
830
query_state : string;
786
831
can_calculate_changes : bool;
787
-
position : uint;
788
-
total : uint option;
789
-
ids : id list;
832
+
position : Jmap.UInt.t;
833
+
total : Jmap.UInt.t option;
834
+
ids : Jmap.Id.t list;
790
835
}
791
836
792
837
let account_id resp = resp.account_id
···
805
850
@return JSON object with accountId, queryState, canCalculateChanges, position, ids, and optional total *)
806
851
let to_json resp =
807
852
let base = [
808
-
("accountId", `String resp.account_id);
853
+
("accountId", `String (Jmap.Id.to_string resp.account_id));
809
854
("queryState", `String resp.query_state);
810
855
("canCalculateChanges", `Bool resp.can_calculate_changes);
811
-
("position", `Int resp.position);
812
-
("ids", `List (List.map (fun id -> `String id) resp.ids));
856
+
("position", `Int (Jmap.UInt.to_int resp.position));
857
+
("ids", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) resp.ids));
813
858
] in
814
859
let base = match resp.total with
815
-
| Some total -> ("total", `Int total) :: base
860
+
| Some total -> ("total", `Int (Jmap.UInt.to_int total)) :: base
816
861
| None -> base
817
862
in
818
863
`Assoc base
···
827
872
let of_json json =
828
873
try
829
874
let open Yojson.Safe.Util in
830
-
let account_id = json |> member "accountId" |> to_string in
875
+
let account_id_str = json |> member "accountId" |> to_string in
876
+
let account_id = match Jmap.Id.of_string account_id_str with
877
+
| Ok id -> id
878
+
| Error _ -> failwith ("Invalid accountId: " ^ account_id_str) in
831
879
let query_state = json |> member "queryState" |> to_string in
832
880
let can_calculate_changes = json |> member "canCalculateChanges" |> to_bool in
833
-
let position = json |> member "position" |> to_int in
834
-
let ids = json |> member "ids" |> to_list |> List.map to_string in
835
-
let total = json |> member "total" |> to_int_option in
881
+
let position_int = json |> member "position" |> to_int in
882
+
let position = match Jmap.UInt.of_int position_int with
883
+
| Ok uint -> uint
884
+
| Error _ -> failwith ("Invalid position: " ^ string_of_int position_int) in
885
+
let ids_strings = json |> member "ids" |> to_list |> List.map to_string in
886
+
let ids = List.filter_map (fun s -> match Jmap.Id.of_string s with
887
+
| Ok id -> Some id
888
+
| Error _ -> None) ids_strings in
889
+
let total_opt = json |> member "total" |> to_int_option in
890
+
let total = match total_opt with
891
+
| None -> None
892
+
| Some total_int -> (match Jmap.UInt.of_int total_int with
893
+
| Ok uint -> Some uint
894
+
| Error _ -> None) in
836
895
Ok {
837
896
account_id;
838
897
query_state;
···
847
906
848
907
let pp fmt t =
849
908
Format.fprintf fmt "Mailbox.Query_response{account=%s;total=%s}"
850
-
t.account_id
851
-
(match t.total with Some n -> string_of_int n | None -> "unknown")
909
+
(Jmap.Id.to_string t.account_id)
910
+
(match t.total with Some n -> string_of_int (Jmap.UInt.to_int n) | None -> "unknown")
852
911
853
912
let pp_hum fmt t = pp fmt t
854
913
···
859
918
860
919
module Get_args = struct
861
920
type t = {
862
-
account_id : id;
863
-
ids : id list option;
921
+
account_id : Jmap.Id.t;
922
+
ids : Jmap.Id.t list option;
864
923
properties : Property.t list option;
865
924
}
866
925
···
879
938
@param args The get arguments to serialize
880
939
@return JSON object with accountId, and optional ids and properties *)
881
940
let to_json args =
882
-
let base = [("accountId", `String args.account_id)] in
941
+
let base = [("accountId", `String (Jmap.Id.to_string args.account_id))] in
883
942
let base = match args.ids with
884
943
| None -> base
885
-
| Some ids -> ("ids", `List (List.map (fun id -> `String id) ids)) :: base
944
+
| Some ids -> ("ids", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) ids)) :: base
886
945
in
887
946
let base = match args.properties with
888
947
| None -> base
889
948
| Some props ->
890
949
let prop_strings = List.map Property.to_string props in
891
-
("properties", `List (List.map (fun s -> `String s) prop_strings)) :: base
950
+
("properties", (`List (List.map (fun s -> `String s) prop_strings) : Yojson.Safe.t)) :: base
892
951
in
893
952
`Assoc base
894
953
···
901
960
@return Result with parsed get arguments or error message *)
902
961
let of_json json =
903
962
try
904
-
let account_id = Yojson.Safe.Util.(json |> member "accountId" |> to_string) in
963
+
let account_id = match Jmap.Id.of_string (Yojson.Safe.Util.(json |> member "accountId" |> to_string)) with
964
+
| Ok id -> id
965
+
| Error _ -> failwith "Invalid accountId in Get_args JSON" in
905
966
let ids = match Yojson.Safe.Util.(json |> member "ids") with
906
967
| `Null -> None
907
-
| `List id_list -> Some (List.map Yojson.Safe.Util.to_string id_list)
968
+
| `List id_list -> Some (List.map (fun id_json ->
969
+
match Jmap.Id.of_string (Yojson.Safe.Util.to_string id_json) with
970
+
| Ok id -> id
971
+
| Error _ -> failwith ("Invalid id in Get_args ids list: " ^ Yojson.Safe.Util.to_string id_json)
972
+
) id_list)
908
973
| _ -> failwith "Expected array or null for ids"
909
974
in
910
975
let properties = match Yojson.Safe.Util.(json |> member "properties") with
···
925
990
| exn -> Error ("Get_args JSON parse error: " ^ Printexc.to_string exn)
926
991
927
992
let pp fmt t =
928
-
Format.fprintf fmt "Mailbox.Get_args{account=%s}" t.account_id
993
+
Format.fprintf fmt "Mailbox.Get_args{account=%s}" (Jmap.Id.to_string t.account_id)
929
994
930
995
let pp_hum fmt t = pp fmt t
931
996
···
936
1001
937
1002
module Get_response = struct
938
1003
type t = {
939
-
account_id : id;
1004
+
account_id : Jmap.Id.t;
940
1005
state : string;
941
1006
list : mailbox_t list;
942
-
not_found : id list;
1007
+
not_found : Jmap.Id.t list;
943
1008
}
944
1009
945
1010
let account_id resp = resp.account_id
···
957
1022
let to_json resp =
958
1023
(* Helper to serialize a single mailbox - duplicated locally to avoid forward reference *)
959
1024
let mailbox_to_json mailbox =
960
-
let base = [
961
-
("id", `String mailbox.mailbox_id);
1025
+
let base : (string * Yojson.Safe.t) list = [
1026
+
("Jmap.Id.t", `String (Jmap.Id.to_string mailbox.mailbox_id));
962
1027
("name", `String mailbox.name);
963
-
("sortOrder", `Int mailbox.sort_order);
964
-
("totalEmails", `Int mailbox.total_emails);
965
-
("unreadEmails", `Int mailbox.unread_emails);
966
-
("totalThreads", `Int mailbox.total_threads);
967
-
("unreadThreads", `Int mailbox.unread_threads);
1028
+
("sortOrder", `Int (Jmap.UInt.to_int mailbox.sort_order));
1029
+
("totalEmails", `Int (Jmap.UInt.to_int mailbox.total_emails));
1030
+
("unreadEmails", `Int (Jmap.UInt.to_int mailbox.unread_emails));
1031
+
("totalThreads", `Int (Jmap.UInt.to_int mailbox.total_threads));
1032
+
("unreadThreads", `Int (Jmap.UInt.to_int mailbox.unread_threads));
968
1033
("myRights", Rights.to_json mailbox.my_rights);
969
1034
("isSubscribed", `Bool mailbox.is_subscribed);
970
1035
] in
971
1036
let base = match mailbox.parent_id with
972
-
| Some pid -> ("parentId", `String pid) :: base
1037
+
| Some pid -> ("parentId", `String (Jmap.Id.to_string pid)) :: base
973
1038
| None -> base
974
1039
in
975
1040
let base = match mailbox.role with
···
979
1044
`Assoc base
980
1045
in
981
1046
`Assoc [
982
-
("accountId", `String resp.account_id);
1047
+
("accountId", `String (Jmap.Id.to_string resp.account_id));
983
1048
("state", `String resp.state);
984
1049
("list", `List (List.map mailbox_to_json resp.list));
985
-
("notFound", `List (List.map (fun id -> `String id) resp.not_found));
1050
+
("notFound", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) resp.not_found));
986
1051
]
987
1052
988
1053
(** Parse Mailbox/get response from JSON.
···
995
1060
let of_json json =
996
1061
try
997
1062
let open Yojson.Safe.Util in
998
-
let account_id = json |> member "accountId" |> to_string in
1063
+
let account_id_str = json |> member "accountId" |> to_string in
1064
+
let account_id = match Jmap.Id.of_string account_id_str with Ok id -> id | Error _ -> failwith ("Invalid account_id: " ^ account_id_str) in
999
1065
let state = json |> member "state" |> to_string in
1000
1066
let list_json = json |> member "list" |> to_list in
1001
1067
(* Helper to parse a single mailbox - duplicated locally to avoid forward reference *)
1002
1068
let mailbox_of_json json =
1003
-
let id = json |> member "id" |> to_string in
1069
+
let id_str = json |> member "Jmap.Id.t" |> to_string in
1070
+
let id = match Jmap.Id.of_string id_str with Ok id -> id | Error _ -> failwith ("Invalid id: " ^ id_str) in
1004
1071
let name = json |> member "name" |> to_string in
1005
-
let parent_id = json |> member "parentId" |> to_string_option in
1072
+
let parent_id = match json |> member "parentId" |> to_string_option with
1073
+
| Some s -> (match Jmap.Id.of_string s with Ok id -> Some id | Error _ -> failwith ("Invalid parent_id: " ^ s))
1074
+
| None -> None in
1006
1075
let role_opt : (role option, string) result = match json |> member "role" with
1007
1076
| `Null -> Ok None
1008
1077
| role_json ->
···
1010
1079
| Ok r -> Ok (Some r)
1011
1080
| Error e -> Error e
1012
1081
in
1013
-
let sort_order = json |> member "sortOrder" |> to_int in
1014
-
let total_emails = json |> member "totalEmails" |> to_int in
1015
-
let unread_emails = json |> member "unreadEmails" |> to_int in
1016
-
let total_threads = json |> member "totalThreads" |> to_int in
1017
-
let unread_threads = json |> member "unreadThreads" |> to_int in
1082
+
let sort_order_int = json |> member "sortOrder" |> to_int in
1083
+
let sort_order = match Jmap.UInt.of_int sort_order_int with
1084
+
| Ok uint -> uint
1085
+
| Error _ -> failwith ("Invalid sortOrder: " ^ string_of_int sort_order_int) in
1086
+
let total_emails_int = json |> member "totalEmails" |> to_int in
1087
+
let total_emails = match Jmap.UInt.of_int total_emails_int with
1088
+
| Ok uint -> uint
1089
+
| Error _ -> failwith ("Invalid totalEmails: " ^ string_of_int total_emails_int) in
1090
+
let unread_emails_int = json |> member "unreadEmails" |> to_int in
1091
+
let unread_emails = match Jmap.UInt.of_int unread_emails_int with
1092
+
| Ok uint -> uint
1093
+
| Error _ -> failwith ("Invalid unreadEmails: " ^ string_of_int unread_emails_int) in
1094
+
let total_threads_int = json |> member "totalThreads" |> to_int in
1095
+
let total_threads = match Jmap.UInt.of_int total_threads_int with
1096
+
| Ok uint -> uint
1097
+
| Error _ -> failwith ("Invalid totalThreads: " ^ string_of_int total_threads_int) in
1098
+
let unread_threads_int = json |> member "unreadThreads" |> to_int in
1099
+
let unread_threads = match Jmap.UInt.of_int unread_threads_int with
1100
+
| Ok uint -> uint
1101
+
| Error _ -> failwith ("Invalid unreadThreads: " ^ string_of_int unread_threads_int) in
1018
1102
let my_rights_result = json |> member "myRights" |> Rights.of_json in
1019
1103
let is_subscribed = json |> member "isSubscribed" |> to_bool in
1020
1104
match role_opt, my_rights_result with
1021
1105
| Ok role, Ok my_rights ->
1022
-
create_full ~id ~name ?parent_id ?role ~sort_order ~total_emails
1023
-
~unread_emails ~total_threads ~unread_threads ~my_rights ~is_subscribed ()
1106
+
create_full ~id ~name ?parent_id ?role
1107
+
~sort_order
1108
+
~total_emails ~unread_emails ~total_threads ~unread_threads
1109
+
~my_rights ~is_subscribed ()
1024
1110
| Error e, _ -> Error e
1025
1111
| _, Error e -> Error e
1026
1112
in
···
1032
1118
| Ok mailbox -> Ok (mailbox :: mailboxes)
1033
1119
| Error e -> Error e
1034
1120
) (Ok []) list_json in
1035
-
let not_found = json |> member "notFound" |> to_list |> List.map to_string in
1121
+
let not_found = json |> member "notFound" |> to_list |> List.map (fun id_json ->
1122
+
let id_str = to_string id_json in
1123
+
match Jmap.Id.of_string id_str with Ok id -> id | Error _ -> failwith ("Invalid not_found id: " ^ id_str)) in
1036
1124
match list_result with
1037
1125
| Ok list ->
1038
1126
Ok {
···
1048
1136
1049
1137
let pp fmt t =
1050
1138
Format.fprintf fmt "Mailbox.Get_response{account=%s;mailboxes=%d}"
1051
-
t.account_id (List.length t.list)
1139
+
(Jmap.Id.to_string t.account_id) (List.length t.list)
1052
1140
1053
1141
let pp_hum fmt t = pp fmt t
1054
1142
···
1057
1145
1058
1146
module Set_args = struct
1059
1147
type t = {
1060
-
account_id : id;
1148
+
account_id : Jmap.Id.t;
1061
1149
if_in_state : string option;
1062
1150
create : (string * Create.t) list;
1063
-
update : (id * Update.t) list;
1064
-
destroy : id list;
1151
+
update : (Jmap.Id.t * Update.t) list;
1152
+
destroy : Jmap.Id.t list;
1065
1153
}
1066
1154
1067
1155
let account_id args = args.account_id
···
1078
1166
@param args The set arguments to serialize
1079
1167
@return JSON object with accountId, ifInState, create, update, destroy *)
1080
1168
let to_json args =
1081
-
let base = [("accountId", `String args.account_id)] in
1169
+
let base = [("accountId", `String (Jmap.Id.to_string args.account_id))] in
1082
1170
let base = match args.if_in_state with
1083
1171
| None -> base
1084
1172
| Some state -> ("ifInState", `String state) :: base
···
1095
1183
if List.length args.update = 0 then base
1096
1184
else
1097
1185
let update_map = List.map (fun (id, update_obj) ->
1098
-
(id, Update.to_json update_obj)
1186
+
(Jmap.Id.to_string id, Update.to_json update_obj)
1099
1187
) args.update in
1100
1188
("update", `Assoc update_map) :: base
1101
1189
in
1102
1190
let base =
1103
1191
if List.length args.destroy = 0 then base
1104
1192
else
1105
-
("destroy", `List (List.map (fun id -> `String id) args.destroy)) :: base
1193
+
("destroy", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) args.destroy)) :: base
1106
1194
in
1107
1195
`Assoc base
1108
1196
···
1116
1204
let of_json json =
1117
1205
try
1118
1206
let open Yojson.Safe.Util in
1119
-
let account_id = json |> member "accountId" |> to_string in
1207
+
let account_id_str = json |> member "accountId" |> to_string in
1208
+
let account_id = match Jmap.Id.of_string account_id_str with
1209
+
| Ok id -> id
1210
+
| Error e -> failwith ("Invalid account ID: " ^ e)
1211
+
in
1120
1212
let if_in_state = json |> member "ifInState" |> to_string_option in
1121
1213
let create = match json |> member "create" with
1122
1214
| `Null -> []
···
1133
1225
| `Assoc update_assoc ->
1134
1226
List.fold_left (fun acc (id, update_json) ->
1135
1227
match Update.of_json update_json with
1136
-
| Ok update_obj -> (id, update_obj) :: acc
1228
+
| Ok update_obj ->
1229
+
let id_t = match Jmap.Id.of_string id with
1230
+
| Ok id_val -> id_val
1231
+
| Error e -> failwith ("Invalid update ID: " ^ id ^ " - " ^ e)
1232
+
in
1233
+
(id_t, update_obj) :: acc
1137
1234
| Error _ -> failwith ("Invalid update object for: " ^ id)
1138
1235
) [] update_assoc
1139
1236
| _ -> failwith "Expected object or null for update"
1140
1237
in
1141
1238
let destroy = match json |> member "destroy" with
1142
1239
| `Null -> []
1143
-
| `List destroy_list -> List.map to_string destroy_list
1240
+
| `List destroy_list -> List.map (fun id_json ->
1241
+
let id_str = to_string id_json in
1242
+
match Jmap.Id.of_string id_str with
1243
+
| Ok id -> id
1244
+
| Error e -> failwith ("Invalid destroy ID: " ^ id_str ^ " - " ^ e)
1245
+
) destroy_list
1144
1246
| _ -> failwith "Expected array or null for destroy"
1145
1247
in
1146
1248
Ok {
···
1156
1258
| exn -> Error ("Set_args JSON parse error: " ^ Printexc.to_string exn)
1157
1259
1158
1260
let pp fmt t =
1159
-
Format.fprintf fmt "Mailbox.Set_args{account=%s}" t.account_id
1261
+
Format.fprintf fmt "Mailbox.Set_args{account=%s}" (Jmap.Id.to_string t.account_id)
1160
1262
1161
1263
let pp_hum fmt t = pp fmt t
1162
1264
···
1167
1269
1168
1270
module Set_response = struct
1169
1271
type t = {
1170
-
account_id : id;
1272
+
account_id : Jmap.Id.t;
1171
1273
old_state : string option;
1172
1274
new_state : string;
1173
1275
created : (string * Create.Response.t) list;
1174
-
updated : (id * Update.Response.t) list;
1175
-
destroyed : id list;
1276
+
updated : (Jmap.Id.t * Update.Response.t) list;
1277
+
destroyed : Jmap.Id.t list;
1176
1278
not_created : (string * Jmap.Error.Set_error.t) list;
1177
-
not_updated : (id * Jmap.Error.Set_error.t) list;
1178
-
not_destroyed : (id * Jmap.Error.Set_error.t) list;
1279
+
not_updated : (Jmap.Id.t * Jmap.Error.Set_error.t) list;
1280
+
not_destroyed : (Jmap.Id.t * Jmap.Error.Set_error.t) list;
1179
1281
}
1180
1282
1181
1283
let account_id resp = resp.account_id
···
1197
1299
@return JSON object with accountId, states, created, updated, destroyed, and error maps *)
1198
1300
let to_json resp =
1199
1301
let base = [
1200
-
("accountId", `String resp.account_id);
1302
+
("accountId", `String (Jmap.Id.to_string resp.account_id));
1201
1303
("newState", `String resp.new_state);
1202
1304
] in
1203
1305
let base = match resp.old_state with
···
1216
1318
if List.length resp.updated = 0 then base
1217
1319
else
1218
1320
let updated_map = List.map (fun (id, update_resp) ->
1219
-
(id, Update.Response.to_json update_resp)
1321
+
(Jmap.Id.to_string id, Update.Response.to_json update_resp)
1220
1322
) resp.updated in
1221
1323
("updated", `Assoc updated_map) :: base
1222
1324
in
1223
1325
let base =
1224
1326
if List.length resp.destroyed = 0 then base
1225
1327
else
1226
-
("destroyed", `List (List.map (fun id -> `String id) resp.destroyed)) :: base
1328
+
("destroyed", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) resp.destroyed)) :: base
1227
1329
in
1228
1330
let base =
1229
1331
if List.length resp.not_created = 0 then base
···
1237
1339
if List.length resp.not_updated = 0 then base
1238
1340
else
1239
1341
let not_updated_map = List.map (fun (id, error) ->
1240
-
(id, Jmap.Error.Set_error.to_json error)
1342
+
(Jmap.Id.to_string id, Jmap.Error.Set_error.to_json error)
1241
1343
) resp.not_updated in
1242
1344
("notUpdated", `Assoc not_updated_map) :: base
1243
1345
in
···
1245
1347
if List.length resp.not_destroyed = 0 then base
1246
1348
else
1247
1349
let not_destroyed_map = List.map (fun (id, error) ->
1248
-
(id, Jmap.Error.Set_error.to_json error)
1350
+
(Jmap.Id.to_string id, Jmap.Error.Set_error.to_json error)
1249
1351
) resp.not_destroyed in
1250
1352
("notDestroyed", `Assoc not_destroyed_map) :: base
1251
1353
in
···
1261
1363
let of_json json =
1262
1364
try
1263
1365
let open Yojson.Safe.Util in
1264
-
let account_id = json |> member "accountId" |> to_string in
1366
+
let account_id_str = json |> member "accountId" |> to_string in
1367
+
let account_id = match Jmap.Id.of_string account_id_str with
1368
+
| Ok id -> id
1369
+
| Error e -> failwith ("Invalid account ID: " ^ e)
1370
+
in
1265
1371
let old_state = json |> member "oldState" |> to_string_option in
1266
1372
let new_state = json |> member "newState" |> to_string in
1267
1373
let created = match json |> member "created" with
···
1279
1385
| `Assoc updated_assoc ->
1280
1386
List.fold_left (fun acc (id, resp_json) ->
1281
1387
match Update.Response.of_json resp_json with
1282
-
| Ok resp -> (id, resp) :: acc
1388
+
| Ok resp ->
1389
+
let id_t = match Jmap.Id.of_string id with
1390
+
| Ok id_val -> id_val
1391
+
| Error e -> failwith ("Invalid updated ID: " ^ id ^ " - " ^ e)
1392
+
in
1393
+
(id_t, resp) :: acc
1283
1394
| Error _ -> failwith ("Invalid updated response for: " ^ id)
1284
1395
) [] updated_assoc
1285
1396
| _ -> failwith "Expected object or null for updated"
1286
1397
in
1287
1398
let destroyed = match json |> member "destroyed" with
1288
1399
| `Null -> []
1289
-
| `List destroyed_list -> List.map to_string destroyed_list
1400
+
| `List destroyed_list -> List.map (fun id_json ->
1401
+
let id_str = to_string id_json in
1402
+
match Jmap.Id.of_string id_str with
1403
+
| Ok id -> id
1404
+
| Error e -> failwith ("Invalid destroyed ID: " ^ id_str ^ " - " ^ e)
1405
+
) destroyed_list
1290
1406
| _ -> failwith "Expected array or null for destroyed"
1291
1407
in
1292
1408
let not_created = match json |> member "notCreated" with
···
1304
1420
| `Assoc not_updated_assoc ->
1305
1421
List.fold_left (fun acc (id, error_json) ->
1306
1422
match Jmap.Error.Set_error.of_json error_json with
1307
-
| Ok error -> (id, error) :: acc
1423
+
| Ok error ->
1424
+
let id_t = match Jmap.Id.of_string id with
1425
+
| Ok id_val -> id_val
1426
+
| Error e -> failwith ("Invalid notUpdated ID: " ^ id ^ " - " ^ e)
1427
+
in
1428
+
(id_t, error) :: acc
1308
1429
| Error _ -> failwith ("Invalid notUpdated error for: " ^ id)
1309
1430
) [] not_updated_assoc
1310
1431
| _ -> failwith "Expected object or null for notUpdated"
···
1314
1435
| `Assoc not_destroyed_assoc ->
1315
1436
List.fold_left (fun acc (id, error_json) ->
1316
1437
match Jmap.Error.Set_error.of_json error_json with
1317
-
| Ok error -> (id, error) :: acc
1438
+
| Ok error ->
1439
+
let id_t = match Jmap.Id.of_string id with
1440
+
| Ok id_val -> id_val
1441
+
| Error e -> failwith ("Invalid notDestroyed ID: " ^ id ^ " - " ^ e)
1442
+
in
1443
+
(id_t, error) :: acc
1318
1444
| Error _ -> failwith ("Invalid notDestroyed error for: " ^ id)
1319
1445
) [] not_destroyed_assoc
1320
1446
| _ -> failwith "Expected object or null for notDestroyed"
···
1336
1462
| exn -> Error ("Set_response JSON parse error: " ^ Printexc.to_string exn)
1337
1463
1338
1464
let pp fmt t =
1339
-
Format.fprintf fmt "Mailbox.Set_response{account=%s}" t.account_id
1465
+
Format.fprintf fmt "Mailbox.Set_response{account=%s}" (Jmap.Id.to_string t.account_id)
1340
1466
1341
1467
let pp_hum fmt t = pp fmt t
1342
1468
···
1347
1473
1348
1474
module Changes_args = struct
1349
1475
type t = {
1350
-
account_id : id;
1476
+
account_id : Jmap.Id.t;
1351
1477
since_state : string;
1352
-
max_changes : uint option;
1478
+
max_changes : Jmap.UInt.t option;
1353
1479
}
1354
1480
1355
1481
let create ~account_id ~since_state ?max_changes () =
···
1368
1494
@return JSON object with accountId, sinceState, and optional maxChanges *)
1369
1495
let to_json args =
1370
1496
let base = [
1371
-
("accountId", `String args.account_id);
1497
+
("accountId", `String (Jmap.Id.to_string args.account_id));
1372
1498
("sinceState", `String args.since_state);
1373
1499
] in
1374
1500
let base = match args.max_changes with
1375
1501
| None -> base
1376
-
| Some max_changes -> ("maxChanges", `Int max_changes) :: base
1502
+
| Some max_changes -> ("maxChanges", `Int (Jmap.UInt.to_int max_changes)) :: base
1377
1503
in
1378
1504
`Assoc base
1379
1505
···
1387
1513
let of_json json =
1388
1514
try
1389
1515
let open Yojson.Safe.Util in
1390
-
let account_id = json |> member "accountId" |> to_string in
1516
+
let account_id_str = json |> member "accountId" |> to_string in
1517
+
let account_id = match Jmap.Id.of_string account_id_str with
1518
+
| Ok id -> id
1519
+
| Error e -> failwith ("Invalid account ID: " ^ e)
1520
+
in
1391
1521
let since_state = json |> member "sinceState" |> to_string in
1392
-
let max_changes = json |> member "maxChanges" |> to_int_option in
1522
+
let max_changes = json |> member "maxChanges" |> to_int_option |>
1523
+
Option.map (fun i -> match Jmap.UInt.of_int i with
1524
+
| Ok u -> u
1525
+
| Error e -> failwith ("Invalid maxChanges: " ^ e)) in
1393
1526
Ok { account_id; since_state; max_changes }
1394
1527
with
1395
1528
| Yojson.Safe.Util.Type_error (msg, _) -> Error ("Changes_args JSON parse error: " ^ msg)
1396
1529
| exn -> Error ("Changes_args JSON parse error: " ^ Printexc.to_string exn)
1397
1530
1398
1531
let pp fmt t =
1399
-
Format.fprintf fmt "Mailbox.Changes_args{account=%s}" t.account_id
1532
+
Format.fprintf fmt "Mailbox.Changes_args{account=%s}" (Jmap.Id.to_string t.account_id)
1400
1533
1401
1534
let pp_hum fmt t = pp fmt t
1402
1535
···
1407
1540
1408
1541
module Changes_response = struct
1409
1542
type t = {
1410
-
account_id : id;
1543
+
account_id : Jmap.Id.t;
1411
1544
old_state : string;
1412
1545
new_state : string;
1413
1546
has_more_changes : bool;
1414
-
created : id list;
1415
-
updated : id list;
1416
-
destroyed : id list;
1547
+
created : Jmap.Id.t list;
1548
+
updated : Jmap.Id.t list;
1549
+
destroyed : Jmap.Id.t list;
1417
1550
}
1418
1551
1419
1552
let account_id resp = resp.account_id
···
1433
1566
@return JSON object with accountId, states, hasMoreChanges, and change arrays *)
1434
1567
let to_json resp =
1435
1568
`Assoc [
1436
-
("accountId", `String resp.account_id);
1569
+
("accountId", `String (Jmap.Id.to_string resp.account_id));
1437
1570
("oldState", `String resp.old_state);
1438
1571
("newState", `String resp.new_state);
1439
1572
("hasMoreChanges", `Bool resp.has_more_changes);
1440
-
("created", `List (List.map (fun id -> `String id) resp.created));
1441
-
("updated", `List (List.map (fun id -> `String id) resp.updated));
1442
-
("destroyed", `List (List.map (fun id -> `String id) resp.destroyed));
1573
+
("created", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) resp.created));
1574
+
("updated", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) resp.updated));
1575
+
("destroyed", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) resp.destroyed));
1443
1576
]
1444
1577
1445
1578
(** Parse Mailbox/changes response from JSON.
···
1452
1585
let of_json json =
1453
1586
try
1454
1587
let open Yojson.Safe.Util in
1455
-
let account_id = json |> member "accountId" |> to_string in
1588
+
let account_id_str = json |> member "accountId" |> to_string in
1589
+
let account_id = match Jmap.Id.of_string account_id_str with
1590
+
| Ok id -> id
1591
+
| Error e -> failwith ("Invalid account ID: " ^ e)
1592
+
in
1456
1593
let old_state = json |> member "oldState" |> to_string in
1457
1594
let new_state = json |> member "newState" |> to_string in
1458
1595
let has_more_changes = json |> member "hasMoreChanges" |> to_bool in
1459
-
let created = json |> member "created" |> to_list |> List.map to_string in
1460
-
let updated = json |> member "updated" |> to_list |> List.map to_string in
1461
-
let destroyed = json |> member "destroyed" |> to_list |> List.map to_string in
1596
+
let created = json |> member "created" |> to_list |> List.map (fun id_json ->
1597
+
let id_str = to_string id_json in
1598
+
match Jmap.Id.of_string id_str with
1599
+
| Ok id -> id
1600
+
| Error e -> failwith ("Invalid created ID: " ^ id_str ^ " - " ^ e)
1601
+
) in
1602
+
let updated = json |> member "updated" |> to_list |> List.map (fun id_json ->
1603
+
let id_str = to_string id_json in
1604
+
match Jmap.Id.of_string id_str with
1605
+
| Ok id -> id
1606
+
| Error e -> failwith ("Invalid updated ID: " ^ id_str ^ " - " ^ e)
1607
+
) in
1608
+
let destroyed = json |> member "destroyed" |> to_list |> List.map (fun id_json ->
1609
+
let id_str = to_string id_json in
1610
+
match Jmap.Id.of_string id_str with
1611
+
| Ok id -> id
1612
+
| Error e -> failwith ("Invalid destroyed ID: " ^ id_str ^ " - " ^ e)
1613
+
) in
1462
1614
Ok {
1463
1615
account_id;
1464
1616
old_state;
···
1473
1625
| exn -> Error ("Changes_response JSON parse error: " ^ Printexc.to_string exn)
1474
1626
1475
1627
let pp fmt t =
1476
-
Format.fprintf fmt "Mailbox.Changes_response{account=%s}" t.account_id
1628
+
Format.fprintf fmt "Mailbox.Changes_response{account=%s}" (Jmap.Id.to_string t.account_id)
1477
1629
1478
1630
let pp_hum fmt t = pp fmt t
1479
1631
···
1485
1637
(* JSON serialization for main mailbox type *)
1486
1638
let to_json mailbox =
1487
1639
let base = [
1488
-
("id", `String mailbox.mailbox_id);
1640
+
("id", `String (Jmap.Id.to_string mailbox.mailbox_id));
1489
1641
("name", `String mailbox.name);
1490
-
("sortOrder", `Int mailbox.sort_order);
1491
-
("totalEmails", `Int mailbox.total_emails);
1492
-
("unreadEmails", `Int mailbox.unread_emails);
1493
-
("totalThreads", `Int mailbox.total_threads);
1494
-
("unreadThreads", `Int mailbox.unread_threads);
1642
+
("sortOrder", `Int (Jmap.UInt.to_int mailbox.sort_order));
1643
+
("totalEmails", `Int (Jmap.UInt.to_int mailbox.total_emails));
1644
+
("unreadEmails", `Int (Jmap.UInt.to_int mailbox.unread_emails));
1645
+
("totalThreads", `Int (Jmap.UInt.to_int mailbox.total_threads));
1646
+
("unreadThreads", `Int (Jmap.UInt.to_int mailbox.unread_threads));
1495
1647
("myRights", Rights.to_json mailbox.my_rights);
1496
1648
("isSubscribed", `Bool mailbox.is_subscribed);
1497
1649
] in
1498
1650
let base = match mailbox.parent_id with
1499
-
| Some pid -> ("parentId", `String pid) :: base
1651
+
| Some pid -> ("parentId", `String (Jmap.Id.to_string pid)) :: base
1500
1652
| None -> base
1501
1653
in
1502
1654
let base = match mailbox.role with
···
1508
1660
let of_json json =
1509
1661
try
1510
1662
let open Yojson.Safe.Util in
1511
-
let id = json |> member "id" |> to_string in
1663
+
let id_str = json |> member "id" |> to_string in
1664
+
let id = match Jmap.Id.of_string id_str with
1665
+
| Ok id_val -> id_val
1666
+
| Error e -> failwith ("Invalid mailbox ID: " ^ id_str ^ " - " ^ e)
1667
+
in
1512
1668
let name = json |> member "name" |> to_string in
1513
-
let parent_id = json |> member "parentId" |> to_string_option in
1669
+
let parent_id = json |> member "parentId" |> to_string_option |>
1670
+
Option.map (fun pid_str -> match Jmap.Id.of_string pid_str with
1671
+
| Ok pid -> pid
1672
+
| Error e -> failwith ("Invalid parentId: " ^ pid_str ^ " - " ^ e)) in
1514
1673
let role_opt : (role option, string) result = match json |> member "role" with
1515
1674
| `Null -> Ok None
1516
1675
| role_json ->
···
1518
1677
| Ok r -> Ok (Some r)
1519
1678
| Error e -> Error e
1520
1679
in
1521
-
let sort_order = json |> member "sortOrder" |> to_int in
1522
-
let total_emails = json |> member "totalEmails" |> to_int in
1523
-
let unread_emails = json |> member "unreadEmails" |> to_int in
1524
-
let total_threads = json |> member "totalThreads" |> to_int in
1525
-
let unread_threads = json |> member "unreadThreads" |> to_int in
1680
+
let sort_order = json |> member "sortOrder" |> to_int |> (fun i ->
1681
+
match Jmap.UInt.of_int i with
1682
+
| Ok u -> u
1683
+
| Error e -> failwith ("Invalid sortOrder: " ^ e)) in
1684
+
let total_emails = json |> member "totalEmails" |> to_int |> (fun i ->
1685
+
match Jmap.UInt.of_int i with
1686
+
| Ok u -> u
1687
+
| Error e -> failwith ("Invalid totalEmails: " ^ e)) in
1688
+
let unread_emails = json |> member "unreadEmails" |> to_int |> (fun i ->
1689
+
match Jmap.UInt.of_int i with
1690
+
| Ok u -> u
1691
+
| Error e -> failwith ("Invalid unreadEmails: " ^ e)) in
1692
+
let total_threads = json |> member "totalThreads" |> to_int |> (fun i ->
1693
+
match Jmap.UInt.of_int i with
1694
+
| Ok u -> u
1695
+
| Error e -> failwith ("Invalid totalThreads: " ^ e)) in
1696
+
let unread_threads = json |> member "unreadThreads" |> to_int |> (fun i ->
1697
+
match Jmap.UInt.of_int i with
1698
+
| Ok u -> u
1699
+
| Error e -> failwith ("Invalid unreadThreads: " ^ e)) in
1526
1700
let my_rights_result = json |> member "myRights" |> Rights.of_json in
1527
1701
let is_subscribed = json |> member "isSubscribed" |> to_bool in
1528
1702
match role_opt, my_rights_result with
···
1541
1715
| Some r -> Role.to_string r
1542
1716
| None -> "none"
1543
1717
in
1544
-
Format.fprintf fmt "Mailbox{id=%s; name=%s; role=%s; total=%d}"
1545
-
mailbox.mailbox_id
1718
+
Format.fprintf fmt "Mailbox{Jmap.Id.t=%s; name=%s; role=%s; total=%d}"
1719
+
(Jmap.Id.to_string mailbox.mailbox_id)
1546
1720
mailbox.name
1547
1721
role_str
1548
-
mailbox.total_emails
1722
+
(Jmap.UInt.to_int mailbox.total_emails)
1549
1723
1550
1724
let pp_hum fmt mailbox =
1551
1725
let role_str = match mailbox.role with
···
1553
1727
| None -> "none"
1554
1728
in
1555
1729
let parent_str = match mailbox.parent_id with
1556
-
| Some pid -> Printf.sprintf " (parent: %s)" pid
1730
+
| Some pid -> Printf.sprintf " (parent: %s)" (Jmap.Id.to_string pid)
1557
1731
| None -> ""
1558
1732
in
1559
1733
Format.fprintf fmt "Mailbox \"%s\" [%s]: %d emails (%d unread), %d threads (%d unread)%s"
1560
1734
mailbox.name
1561
1735
role_str
1562
-
mailbox.total_emails
1563
-
mailbox.unread_emails
1564
-
mailbox.total_threads
1565
-
mailbox.unread_threads
1736
+
(Jmap.UInt.to_int mailbox.total_emails)
1737
+
(Jmap.UInt.to_int mailbox.unread_emails)
1738
+
(Jmap.UInt.to_int mailbox.total_threads)
1739
+
(Jmap.UInt.to_int mailbox.unread_threads)
1566
1740
parent_str
1567
1741
1568
1742
(* Filter construction helpers *)
···
1573
1747
Filter.property_equals "role" `Null
1574
1748
1575
1749
let filter_has_parent parent_id =
1576
-
Filter.property_equals "parentId" (`String parent_id)
1750
+
Filter.property_equals "parentId" (`String (Jmap.Id.to_string parent_id))
1577
1751
1578
1752
let filter_is_root () =
1579
1753
Filter.property_equals "parentId" `Null
+70
-71
jmap/jmap-email/mailbox.mli
+70
-71
jmap/jmap-email/mailbox.mli
···
12
12
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-2> RFC 8621, Section 2: Mailboxes
13
13
*)
14
14
15
-
open Jmap.Types
16
15
open Jmap.Methods
17
16
18
17
(** Mailbox role identifiers.
···
73
72
include Jmap_sigs.PRINTABLE with type t := t
74
73
75
74
(** JMAP object interface with property selection support *)
76
-
include Jmap_sigs.JMAP_OBJECT with type t := t and type id_type := id
75
+
include Jmap_sigs.JMAP_OBJECT with type t := t and type id_type := string
77
76
78
77
(** {1 Property Accessors} *)
79
78
80
79
(** Get the server-assigned mailbox identifier.
81
80
@param mailbox The mailbox object
82
81
@return Immutable server-assigned identifier (always Some for valid mailboxes) *)
83
-
val id : t -> id option
82
+
val id : t -> Jmap.Id.t option
84
83
85
84
(** Get the server-assigned mailbox identifier directly.
86
85
@param mailbox The mailbox object
87
86
@return Immutable server-assigned identifier (guaranteed present) *)
88
-
val mailbox_id : t -> id
87
+
val mailbox_id : t -> Jmap.Id.t
89
88
90
89
(** Get the display name for the mailbox.
91
90
@param mailbox The mailbox object
···
95
94
(** Get the parent mailbox ID for hierarchical organization.
96
95
@param mailbox The mailbox object
97
96
@return Parent mailbox ID (None for root level) *)
98
-
val parent_id : t -> id option
97
+
val parent_id : t -> Jmap.Id.t option
99
98
100
99
(** Get the functional role identifier for the mailbox.
101
100
@param mailbox The mailbox object
···
105
104
(** Get the numeric sort order for display positioning.
106
105
@param mailbox The mailbox object
107
106
@return Display order hint (default: 0) *)
108
-
val sort_order : t -> uint
107
+
val sort_order : t -> Jmap.UInt.t
109
108
110
109
(** Get the total email count (server-computed).
111
110
@param mailbox The mailbox object
112
111
@return Total email count *)
113
-
val total_emails : t -> uint
112
+
val total_emails : t -> Jmap.UInt.t
114
113
115
114
(** Get the unread email count (server-computed).
116
115
@param mailbox The mailbox object
117
116
@return Unread email count *)
118
-
val unread_emails : t -> uint
117
+
val unread_emails : t -> Jmap.UInt.t
119
118
120
119
(** Get the total thread count (server-computed).
121
120
@param mailbox The mailbox object
122
121
@return Total thread count *)
123
-
val total_threads : t -> uint
122
+
val total_threads : t -> Jmap.UInt.t
124
123
125
124
(** Get the unread thread count (server-computed).
126
125
@param mailbox The mailbox object
127
126
@return Unread thread count *)
128
-
val unread_threads : t -> uint
127
+
val unread_threads : t -> Jmap.UInt.t
129
128
130
129
(** Get the user's access permissions (server-set).
131
130
@param mailbox The mailbox object
···
145
144
setting all mailbox properties including server-computed values. Used for
146
145
constructing complete Mailbox objects from server responses.
147
146
148
-
@param id Server-assigned identifier
147
+
@param Jmap.Id.t Server-assigned identifier
149
148
@param name Display name
150
149
@param parent_id Optional parent mailbox
151
150
@param role Optional functional role
···
158
157
@param is_subscribed Subscription status
159
158
@return Ok with mailbox object, or Error with validation message *)
160
159
val create_full :
161
-
id:id ->
160
+
id:Jmap.Id.t ->
162
161
name:string ->
163
-
?parent_id:id ->
162
+
?parent_id:Jmap.Id.t ->
164
163
?role:role ->
165
-
?sort_order:uint ->
166
-
total_emails:uint ->
167
-
unread_emails:uint ->
168
-
total_threads:uint ->
169
-
unread_threads:uint ->
164
+
?sort_order:Jmap.UInt.t ->
165
+
total_emails:Jmap.UInt.t ->
166
+
unread_emails:Jmap.UInt.t ->
167
+
total_threads:Jmap.UInt.t ->
168
+
unread_threads:Jmap.UInt.t ->
170
169
my_rights:rights ->
171
170
is_subscribed:bool ->
172
171
unit -> (t, string) result
···
421
420
@return Ok with creation object, or Error with validation message *)
422
421
val create :
423
422
name:string ->
424
-
?parent_id:id ->
423
+
?parent_id:Jmap.Id.t ->
425
424
?role:role ->
426
-
?sort_order:uint ->
425
+
?sort_order:Jmap.UInt.t ->
427
426
?is_subscribed:bool ->
428
427
unit -> (t, string) result
429
428
···
435
434
(** Get the parent mailbox ID.
436
435
@param create_req The creation request
437
436
@return Optional parent mailbox *)
438
-
val parent_id : t -> id option
437
+
val parent_id : t -> Jmap.Id.t option
439
438
440
439
(** Get the role assignment.
441
440
@param create_req The creation request
···
445
444
(** Get the sort order.
446
445
@param create_req The creation request
447
446
@return Optional sort order (None means server default) *)
448
-
val sort_order : t -> uint option
447
+
val sort_order : t -> Jmap.UInt.t option
449
448
450
449
(** Get the subscription status.
451
450
@param create_req The creation request
···
467
466
(** Get the server-assigned mailbox ID.
468
467
@param response The creation response
469
468
@return Server-assigned mailbox ID *)
470
-
val id : t -> id
469
+
val id : t -> Jmap.Id.t
471
470
472
471
(** Get the role if default was applied.
473
472
@param response The creation response
···
477
476
(** Get the sort order if default was applied.
478
477
@param response The creation response
479
478
@return Sort order if default was applied *)
480
-
val sort_order : t -> uint
479
+
val sort_order : t -> Jmap.UInt.t
481
480
482
481
(** Get the initial email count (typically 0).
483
482
@param response The creation response
484
483
@return Initial email count *)
485
-
val total_emails : t -> uint
484
+
val total_emails : t -> Jmap.UInt.t
486
485
487
486
(** Get the initial unread count (typically 0).
488
487
@param response The creation response
489
488
@return Initial unread count *)
490
-
val unread_emails : t -> uint
489
+
val unread_emails : t -> Jmap.UInt.t
491
490
492
491
(** Get the initial thread count (typically 0).
493
492
@param response The creation response
494
493
@return Initial thread count *)
495
-
val total_threads : t -> uint
494
+
val total_threads : t -> Jmap.UInt.t
496
495
497
496
(** Get the initial unread thread count (typically 0).
498
497
@param response The creation response
499
498
@return Initial unread thread count *)
500
-
val unread_threads : t -> uint
499
+
val unread_threads : t -> Jmap.UInt.t
501
500
502
501
(** Get the computed access rights for the user.
503
502
@param response The creation response
···
533
532
@return JSON Patch operations for Mailbox/set *)
534
533
val create :
535
534
?name:string ->
536
-
?parent_id:id option ->
535
+
?parent_id:Jmap.Id.t option ->
537
536
?role:role option ->
538
-
?sort_order:uint ->
537
+
?sort_order:Jmap.UInt.t ->
539
538
?is_subscribed:bool ->
540
539
unit -> (t, string) result
541
540
···
574
573
include Jmap_sigs.JSONABLE with type t := t
575
574
576
575
(** JMAP method arguments interface *)
577
-
include Jmap_sigs.METHOD_ARGS with type t := t and type account_id := id
576
+
include Jmap_sigs.METHOD_ARGS with type t := t and type account_id := string
578
577
579
578
(** Create query arguments for mailboxes.
580
579
@param account_id Account to query in
···
585
584
@param calculate_total Whether to calculate total count
586
585
@return Ok with query arguments, or Error with validation message *)
587
586
val create :
588
-
account_id:id ->
587
+
account_id:Jmap.Id.t ->
589
588
?filter:Filter.t ->
590
589
?sort:Comparator.t list ->
591
-
?position:uint ->
592
-
?limit:uint ->
590
+
?position:Jmap.UInt.t ->
591
+
?limit:Jmap.UInt.t ->
593
592
?calculate_total:bool ->
594
593
unit -> (t, string) result
595
594
596
595
(** Get the account ID.
597
596
@param args Query arguments
598
597
@return Account identifier where mailboxes will be queried *)
599
-
val account_id : t -> id
598
+
val account_id : t -> Jmap.Id.t
600
599
601
600
(** Validate query arguments according to JMAP method constraints.
602
601
@param t Query arguments to validate
···
620
619
(** Get the starting position.
621
620
@param args Query arguments
622
621
@return Starting position (0-based) *)
623
-
val position : t -> uint option
622
+
val position : t -> Jmap.UInt.t option
624
623
625
624
(** Get the result limit.
626
625
@param args Query arguments
627
626
@return Maximum results to return *)
628
-
val limit : t -> uint option
627
+
val limit : t -> Jmap.UInt.t option
629
628
630
629
(** Check if total count should be calculated.
631
630
@param args Query arguments
···
644
643
include Jmap_sigs.JSONABLE with type t := t
645
644
646
645
(** JMAP method response interface *)
647
-
include Jmap_sigs.METHOD_RESPONSE with type t := t and type account_id := id and type state := string
646
+
include Jmap_sigs.METHOD_RESPONSE with type t := t and type account_id := string and type state := string
648
647
649
648
(** Get the account ID from the response.
650
649
@param response Query response
651
650
@return Account identifier where mailboxes were queried *)
652
-
val account_id : t -> id
651
+
val account_id : t -> Jmap.Id.t
653
652
654
653
(** Get the query state for change tracking.
655
654
@param response Query response
···
674
673
(** Get the starting position of results.
675
674
@param response Query response
676
675
@return 0-based position of the first returned result *)
677
-
val position : t -> uint
676
+
val position : t -> Jmap.UInt.t
678
677
679
678
(** Get the total count if requested.
680
679
@param response Query response
681
680
@return Total matching results if calculateTotal was true *)
682
-
val total : t -> uint option
681
+
val total : t -> Jmap.UInt.t option
683
682
684
683
(** Get the matched mailbox IDs.
685
684
@param response Query response
686
685
@return List of mailbox IDs that matched the query *)
687
-
val ids : t -> id list
686
+
val ids : t -> Jmap.Id.t list
688
687
end
689
688
690
689
module Get_args : sig
···
698
697
include Jmap_sigs.JSONABLE with type t := t
699
698
700
699
(** JMAP method arguments interface *)
701
-
include Jmap_sigs.METHOD_ARGS with type t := t and type account_id := id
700
+
include Jmap_sigs.METHOD_ARGS with type t := t and type account_id := string
702
701
703
702
(** Create get arguments for mailboxes.
704
703
@param account_id Account to get from
···
706
705
@param properties Optional properties to return (None = all properties)
707
706
@return Ok with get arguments, or Error with validation message *)
708
707
val create :
709
-
account_id:id ->
710
-
?ids:id list ->
708
+
account_id:Jmap.Id.t ->
709
+
?ids:Jmap.Id.t list ->
711
710
?properties:Property.t list ->
712
711
unit -> (t, string) result
713
712
714
713
(** Get the account ID.
715
714
@param args Get arguments
716
715
@return Account identifier where mailboxes will be retrieved from *)
717
-
val account_id : t -> id
716
+
val account_id : t -> Jmap.Id.t
718
717
719
718
(** Validate get arguments according to JMAP method constraints.
720
719
@param t Get arguments to validate
···
728
727
(** Get the specific IDs to retrieve.
729
728
@param args Get arguments
730
729
@return Optional list of mailbox IDs (None = all mailboxes) *)
731
-
val ids : t -> id list option
730
+
val ids : t -> Jmap.Id.t list option
732
731
733
732
(** Get the properties to return.
734
733
@param args Get arguments
···
747
746
include Jmap_sigs.JSONABLE with type t := t
748
747
749
748
(** JMAP method response interface *)
750
-
include Jmap_sigs.METHOD_RESPONSE with type t := t and type account_id := id and type state := string
749
+
include Jmap_sigs.METHOD_RESPONSE with type t := t and type account_id := string and type state := string
751
750
752
751
(** Get the account ID from the response.
753
752
@param response Get response
754
753
@return Account identifier where mailboxes were retrieved from *)
755
-
val account_id : t -> id
754
+
val account_id : t -> Jmap.Id.t
756
755
757
756
(** Get the state for change tracking.
758
757
@param response Get response
···
772
771
(** Get the IDs that were not found.
773
772
@param response Get response
774
773
@return List of requested IDs that were not found *)
775
-
val not_found : t -> id list
774
+
val not_found : t -> Jmap.Id.t list
776
775
end
777
776
778
777
module Set_args : sig
···
786
785
include Jmap_sigs.JSONABLE with type t := t
787
786
788
787
(** JMAP method arguments interface *)
789
-
include Jmap_sigs.METHOD_ARGS with type t := t and type account_id := id
788
+
include Jmap_sigs.METHOD_ARGS with type t := t and type account_id := string
790
789
791
790
(** Create set arguments for mailboxes.
792
791
@param account_id Account to modify
···
799
798
(** Get the account ID.
800
799
@param args Set arguments
801
800
@return Account identifier where mailboxes will be modified *)
802
-
val account_id : t -> id
801
+
val account_id : t -> Jmap.Id.t
803
802
804
803
(** Validate set arguments according to JMAP method constraints.
805
804
@param t Set arguments to validate
···
823
822
(** Get the mailboxes to update.
824
823
@param args Set arguments
825
824
@return Map of mailbox IDs to update objects *)
826
-
val update : t -> (id * Update.t) list
825
+
val update : t -> (Jmap.Id.t * Update.t) list
827
826
828
827
(** Get the mailboxes to destroy.
829
828
@param args Set arguments
830
829
@return List of mailbox IDs to destroy *)
831
-
val destroy : t -> id list
830
+
val destroy : t -> Jmap.Id.t list
832
831
end
833
832
834
833
module Set_response : sig
···
842
841
include Jmap_sigs.JSONABLE with type t := t
843
842
844
843
(** JMAP method response interface *)
845
-
include Jmap_sigs.METHOD_RESPONSE with type t := t and type account_id := id and type state := string
844
+
include Jmap_sigs.METHOD_RESPONSE with type t := t and type account_id := string and type state := string
846
845
847
846
(** Get the account ID from the response.
848
847
@param response Set response
849
848
@return Account identifier where mailboxes were modified *)
850
-
val account_id : t -> id
849
+
val account_id : t -> Jmap.Id.t
851
850
852
851
(** Get the old state before modifications.
853
852
@param response Set response
···
877
876
(** Get the successfully updated mailboxes.
878
877
@param response Set response
879
878
@return Map of mailbox IDs to update response objects *)
880
-
val updated : t -> (id * Update.Response.t) list
879
+
val updated : t -> (Jmap.Id.t * Update.Response.t) list
881
880
882
881
(** Get the successfully destroyed mailbox IDs.
883
882
@param response Set response
884
883
@return List of mailbox IDs that were destroyed *)
885
-
val destroyed : t -> id list
884
+
val destroyed : t -> Jmap.Id.t list
886
885
887
886
(** Get the creation failures.
888
887
@param response Set response
···
892
891
(** Get the update failures.
893
892
@param response Set response
894
893
@return Map of mailbox IDs to error objects *)
895
-
val not_updated : t -> (id * Jmap.Error.Set_error.t) list
894
+
val not_updated : t -> (Jmap.Id.t * Jmap.Error.Set_error.t) list
896
895
897
896
(** Get the destruction failures.
898
897
@param response Set response
899
898
@return Map of mailbox IDs to error objects *)
900
-
val not_destroyed : t -> (id * Jmap.Error.Set_error.t) list
899
+
val not_destroyed : t -> (Jmap.Id.t * Jmap.Error.Set_error.t) list
901
900
end
902
901
903
902
module Changes_args : sig
···
911
910
include Jmap_sigs.JSONABLE with type t := t
912
911
913
912
(** JMAP method arguments interface *)
914
-
include Jmap_sigs.METHOD_ARGS with type t := t and type account_id := id
913
+
include Jmap_sigs.METHOD_ARGS with type t := t and type account_id := string
915
914
916
915
(** Create changes arguments for mailboxes.
917
916
@param account_id Account to check for changes
···
919
918
@param max_changes Maximum number of changed IDs to return
920
919
@return Ok with changes arguments, or Error with validation message *)
921
920
val create :
922
-
account_id:id ->
921
+
account_id:Jmap.Id.t ->
923
922
since_state:string ->
924
-
?max_changes:uint ->
923
+
?max_changes:Jmap.UInt.t ->
925
924
unit -> (t, string) result
926
925
927
926
(** Get the account ID.
928
927
@param args Changes arguments
929
928
@return Account identifier to check for changes *)
930
-
val account_id : t -> id
929
+
val account_id : t -> Jmap.Id.t
931
930
932
931
(** Validate changes arguments according to JMAP method constraints.
933
932
@param t Changes arguments to validate
···
946
945
(** Get the maximum changes limit.
947
946
@param args Changes arguments
948
947
@return Maximum number of changed IDs to return *)
949
-
val max_changes : t -> uint option
948
+
val max_changes : t -> Jmap.UInt.t option
950
949
end
951
950
952
951
module Changes_response : sig
···
960
959
include Jmap_sigs.JSONABLE with type t := t
961
960
962
961
(** JMAP method response interface *)
963
-
include Jmap_sigs.METHOD_RESPONSE with type t := t and type account_id := id and type state := string
962
+
include Jmap_sigs.METHOD_RESPONSE with type t := t and type account_id := string and type state := string
964
963
965
964
(** Get the account ID from the response.
966
965
@param response Changes response
967
966
@return Account identifier where changes were checked *)
968
-
val account_id : t -> id
967
+
val account_id : t -> Jmap.Id.t
969
968
970
969
(** Get the old state.
971
970
@param response Changes response
···
995
994
(** Get the created mailbox IDs.
996
995
@param response Changes response
997
996
@return List of mailbox IDs that were created *)
998
-
val created : t -> id list
997
+
val created : t -> Jmap.Id.t list
999
998
1000
999
(** Get the updated mailbox IDs.
1001
1000
@param response Changes response
1002
1001
@return List of mailbox IDs that were updated *)
1003
-
val updated : t -> id list
1002
+
val updated : t -> Jmap.Id.t list
1004
1003
1005
1004
(** Get the destroyed mailbox IDs.
1006
1005
@param response Changes response
1007
1006
@return List of mailbox IDs that were destroyed *)
1008
-
val destroyed : t -> id list
1007
+
val destroyed : t -> Jmap.Id.t list
1009
1008
end
1010
1009
1011
1010
(** {1 Filter Construction}
···
1025
1024
(** Create a filter to match child mailboxes of a specific parent.
1026
1025
@param parent_id The parent mailbox ID to match
1027
1026
@return Filter condition for mailboxes with the specified parent *)
1028
-
val filter_has_parent : id -> Filter.t
1027
+
val filter_has_parent : Jmap.Id.t -> Filter.t
1029
1028
1030
1029
(** Create a filter to match root-level mailboxes.
1031
1030
@return Filter condition matching mailboxes where parentId is null *)
+11
-9
jmap/jmap-email/query.ml
+11
-9
jmap/jmap-email/query.ml
···
25
25
open Jmap.Methods.Filter
26
26
27
27
(* Email-specific filter constructors using core utilities *)
28
-
let in_mailbox (mailbox_id : Jmap.Types.id) =
29
-
condition (`Assoc [("inMailbox", `String mailbox_id)])
28
+
let in_mailbox (mailbox_id : Jmap.Id.t) =
29
+
condition (`Assoc [("inMailbox", `String (Jmap.Id.to_string mailbox_id))])
30
30
31
31
let in_mailbox_role role =
32
32
condition (`Assoc [("inMailboxOtherThan", `List [`String role])])
···
75
75
end
76
76
77
77
type query_builder = {
78
-
account_id : Jmap.Types.id option;
78
+
account_id : string option;
79
79
filter : Filter.t option;
80
80
sort : Sort.t list;
81
-
limit_count : Jmap.Types.uint option;
82
-
position : Jmap.Types.jint option;
81
+
limit_count : Jmap.UInt.t option;
82
+
position : int option;
83
83
properties : property list;
84
84
collapse_threads : bool;
85
85
calculate_total : bool;
···
97
97
}
98
98
99
99
let with_account account_id builder =
100
-
{ builder with account_id = Some account_id }
100
+
{ builder with account_id = Some (Jmap.Id.to_string account_id) }
101
101
102
102
let where filter builder =
103
103
{ builder with filter = Some filter }
···
106
106
{ builder with sort = [sort] }
107
107
108
108
let limit n builder =
109
-
{ builder with limit_count = Some n }
109
+
match Jmap.UInt.of_int n with
110
+
| Ok uint -> { builder with limit_count = Some uint }
111
+
| Error _ -> failwith ("Invalid limit value: " ^ string_of_int n)
110
112
111
113
let offset n builder =
112
114
{ builder with position = Some n }
···
153
155
?filter:builder.filter
154
156
~sort:builder.sort
155
157
?position:builder.position
156
-
?limit:builder.limit_count
158
+
?limit:(Option.map Jmap.UInt.to_int builder.limit_count)
157
159
?calculate_total:(Some builder.calculate_total)
158
160
?collapse_threads:(Some builder.collapse_threads)
159
161
()
···
171
173
let build_email_get_with_ref ~account_id ~properties ~result_of =
172
174
let property_strings = Property.to_string_list properties in
173
175
`Assoc [
174
-
("accountId", `String account_id);
176
+
("accountId", `String (Jmap.Id.to_string account_id));
175
177
("properties", `List (List.map (fun s -> `String s) property_strings));
176
178
("#ids", `Assoc [
177
179
("resultOf", `String result_of);
+3
-3
jmap/jmap-email/query.mli
+3
-3
jmap/jmap-email/query.mli
···
53
53
type t = Jmap.Methods.Filter.t
54
54
55
55
(** Filter by mailbox *)
56
-
val in_mailbox : Jmap.Types.id -> t
56
+
val in_mailbox : Jmap.Id.t -> t
57
57
58
58
(** Filter by mailbox role (e.g., "inbox", "sent", "drafts") *)
59
59
val in_mailbox_role : string -> t
···
106
106
val query : unit -> query_builder
107
107
108
108
(** Set the account ID (uses primary mail account if not set) *)
109
-
val with_account : Jmap.Types.id -> query_builder -> query_builder
109
+
val with_account : Jmap.Id.t -> query_builder -> query_builder
110
110
111
111
(** Add a filter condition *)
112
112
val where : Filter.t -> query_builder -> query_builder
···
174
174
@param result_of Method call ID to reference (e.g., "q1")
175
175
@return JSON object for Email/get method arguments *)
176
176
val build_email_get_with_ref :
177
-
account_id:Jmap.Types.id ->
177
+
account_id:Jmap.Id.t ->
178
178
properties:property list ->
179
179
result_of:string ->
180
180
Yojson.Safe.t
+4
-4
jmap/jmap-email/response.ml
+4
-4
jmap/jmap-email/response.ml
···
33
33
34
34
(** Extract IDs from a Query_response *)
35
35
let ids_from_query_response response =
36
-
Query_response.ids response
36
+
List.map (fun s -> match Jmap.Id.of_string s with Ok id -> id | Error e -> failwith e) (Query_response.ids response)
37
37
38
38
(** Check if there are more changes in a Changes_response *)
39
39
let has_more_changes response =
···
41
41
42
42
(** Get created IDs from a Changes_response *)
43
43
let created_ids response =
44
-
Changes_response.created response
44
+
List.map (fun s -> match Jmap.Id.of_string s with Ok id -> id | Error e -> failwith e) (Changes_response.created response)
45
45
46
46
(** Get updated IDs from a Changes_response *)
47
47
let updated_ids response =
48
-
Changes_response.updated response
48
+
List.map (fun s -> match Jmap.Id.of_string s with Ok id -> id | Error e -> failwith e) (Changes_response.updated response)
49
49
50
50
(** Get destroyed IDs from a Changes_response *)
51
51
let destroyed_ids response =
52
-
Changes_response.destroyed response
52
+
List.map (fun s -> match Jmap.Id.of_string s with Ok id -> id | Error e -> failwith e) (Changes_response.destroyed response)
53
53
54
54
(** Response builder for batched requests *)
55
55
module Batch = struct
+4
-5
jmap/jmap-email/response.mli
+4
-5
jmap/jmap-email/response.mli
···
5
5
6
6
@see <https://www.rfc-editor.org/rfc/rfc8621.html> RFC 8621 *)
7
7
8
-
open Jmap.Types
9
8
open Jmap.Methods
10
9
11
10
(** {1 Response Parsers} *)
···
43
42
(** Extract IDs from a Query_response.
44
43
@param response The parsed Query_response
45
44
@return List of Email IDs *)
46
-
val ids_from_query_response : Query_response.t -> id list
45
+
val ids_from_query_response : Query_response.t -> Jmap.Id.t list
47
46
48
47
(** Check if there are more changes in a Changes_response.
49
48
@param response The parsed Changes_response
···
53
52
(** Get created IDs from a Changes_response.
54
53
@param response The parsed Changes_response
55
54
@return List of newly created Email IDs *)
56
-
val created_ids : Changes_response.t -> id list
55
+
val created_ids : Changes_response.t -> Jmap.Id.t list
57
56
58
57
(** Get updated IDs from a Changes_response.
59
58
@param response The parsed Changes_response
60
59
@return List of updated Email IDs *)
61
-
val updated_ids : Changes_response.t -> id list
60
+
val updated_ids : Changes_response.t -> Jmap.Id.t list
62
61
63
62
(** Get destroyed IDs from a Changes_response.
64
63
@param response The parsed Changes_response
65
64
@return List of destroyed Email IDs *)
66
-
val destroyed_ids : Changes_response.t -> id list
65
+
val destroyed_ids : Changes_response.t -> Jmap.Id.t list
67
66
68
67
(** {1 Batch Response Handling} *)
69
68
+31
-21
jmap/jmap-email/search.ml
+31
-21
jmap/jmap-email/search.ml
···
7
7
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-5> RFC 8621, Section 5: SearchSnippet
8
8
*)
9
9
10
-
open Jmap.Types
11
10
open Jmap.Methods
12
11
13
12
(** SearchSnippet object *)
14
13
module SearchSnippet = struct
15
14
type t = {
16
-
email_id : id;
15
+
email_id : Jmap.Id.t;
17
16
subject : string option;
18
17
preview : string option;
19
18
}
···
30
29
31
30
let to_json t =
32
31
let fields = [
33
-
("emailId", `String t.email_id);
32
+
("emailId", `String (Jmap.Id.to_string t.email_id));
34
33
] in
35
34
let fields = match t.subject with
36
35
| Some s -> ("subject", `String s) :: fields
···
45
44
let of_json = function
46
45
| `Assoc fields ->
47
46
(match List.assoc_opt "emailId" fields with
48
-
| Some (`String email_id) ->
47
+
| Some (`String email_id_str) ->
48
+
let email_id = match Jmap.Id.of_string email_id_str with
49
+
| Ok id -> id
50
+
| Error _ -> failwith ("Invalid email ID: " ^ email_id_str) in
49
51
let subject = match List.assoc_opt "subject" fields with
50
52
| Some (`String s) -> Some s
51
53
| Some `Null | None -> None
···
62
64
63
65
let pp ppf t =
64
66
Format.fprintf ppf "SearchSnippet{emailId=%s; subject=%s; preview=%s}"
65
-
t.email_id
67
+
(Jmap.Id.to_string t.email_id)
66
68
(match t.subject with Some s -> "\"" ^ s ^ "\"" | None -> "None")
67
-
(match t.preview with Some p -> "\"" ^ String.sub p 0 (min 50 (String.length p)) ^ "...\"" | None -> "None")
69
+
(match t.preview with Some p -> "\"" ^ String.sub p 0 (Int.min 50 (String.length p)) ^ "...\"" | None -> "None")
68
70
69
71
let pp_hum = pp
70
72
end
···
72
74
(** Arguments for SearchSnippet/get *)
73
75
module Get_args = struct
74
76
type t = {
75
-
account_id : id;
77
+
account_id : Jmap.Id.t;
76
78
filter : Filter.t;
77
-
email_ids : id list option;
79
+
email_ids : Jmap.Id.t list option;
78
80
}
79
81
80
82
let account_id t = t.account_id
···
89
91
90
92
let to_json t =
91
93
let fields = [
92
-
("accountId", `String t.account_id);
94
+
("accountId", `String (Jmap.Id.to_string t.account_id));
93
95
("filter", Filter.to_json t.filter);
94
96
] in
95
97
let fields = match t.email_ids with
96
-
| Some ids -> ("emailIds", `List (List.map (fun id -> `String id) ids)) :: fields
98
+
| Some ids -> ("emailIds", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) ids)) :: fields
97
99
| None -> fields
98
100
in
99
101
`Assoc fields
···
103
105
match json with
104
106
| `Assoc fields ->
105
107
let account_id = match List.assoc_opt "accountId" fields with
106
-
| Some (`String id) -> id
108
+
| Some (`String id) -> (match Jmap.Id.of_string id with
109
+
| Ok id -> id
110
+
| Error err -> failwith ("Invalid accountId: " ^ err))
107
111
| _ -> failwith "Missing or invalid accountId"
108
112
in
109
113
let filter = match List.assoc_opt "filter" fields with
···
111
115
| _ -> failwith "Missing or invalid filter"
112
116
in
113
117
let email_ids = match List.assoc_opt "emailIds" fields with
114
-
| Some (`List ids) -> Some (List.map (function `String id -> id | _ -> failwith "Invalid email ID") ids)
118
+
| Some (`List ids) -> Some (List.map (function `String id -> (match Jmap.Id.of_string id with Ok id -> id | Error err -> failwith ("Invalid email ID: " ^ err)) | _ -> failwith "Invalid email ID") ids)
115
119
| Some `Null | None -> None
116
120
| _ -> failwith "Invalid emailIds field"
117
121
in
···
123
127
124
128
let pp fmt t =
125
129
Format.fprintf fmt "SearchSnippet.Get_args{account=%s;emails=%s}"
126
-
t.account_id
130
+
(Jmap.Id.to_string t.account_id)
127
131
(match t.email_ids with Some ids -> string_of_int (List.length ids) | None -> "all")
128
132
129
133
let pp_hum fmt t = pp fmt t
···
132
136
(** Response for SearchSnippet/get *)
133
137
module Get_response = struct
134
138
type t = {
135
-
account_id : id;
136
-
list : SearchSnippet.t id_map;
137
-
not_found : id list;
139
+
account_id : Jmap.Id.t;
140
+
list : (string, SearchSnippet.t) Hashtbl.t;
141
+
not_found : Jmap.Id.t list;
138
142
}
139
143
140
144
let account_id t = t.account_id
···
149
153
150
154
let to_json t =
151
155
`Assoc [
152
-
("accountId", `String t.account_id);
156
+
("accountId", `String (Jmap.Id.to_string t.account_id));
153
157
("list", `Assoc (Hashtbl.fold (fun k v acc -> (k, SearchSnippet.to_json v) :: acc) t.list []));
154
-
("notFound", `List (List.map (fun id -> `String id) t.not_found));
158
+
("notFound", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) t.not_found));
155
159
]
156
160
157
161
let of_json json =
···
159
163
match json with
160
164
| `Assoc fields ->
161
165
let account_id = match List.assoc_opt "accountId" fields with
162
-
| Some (`String id) -> id
166
+
| Some (`String id_str) -> (match Jmap.Id.of_string id_str with
167
+
| Ok id -> id
168
+
| Error _ -> failwith ("Invalid account ID: " ^ id_str))
163
169
| _ -> failwith "Missing or invalid accountId"
164
170
in
165
171
let list = Hashtbl.create 16 in
166
172
let not_found = match List.assoc_opt "notFound" fields with
167
-
| Some (`List ids) -> List.map (function `String id -> id | _ -> failwith "Invalid not found ID") ids
173
+
| Some (`List ids) -> List.map (function
174
+
| `String id_str -> (match Jmap.Id.of_string id_str with
175
+
| Ok id -> id
176
+
| Error _ -> failwith ("Invalid ID: " ^ id_str))
177
+
| _ -> failwith "Invalid not found ID") ids
168
178
| Some `Null | None -> []
169
179
| _ -> failwith "Invalid notFound field"
170
180
in
···
176
186
177
187
let pp fmt t =
178
188
Format.fprintf fmt "SearchSnippet.Get_response{account=%s;found=%d;not_found=%d}"
179
-
t.account_id
189
+
(Jmap.Id.to_string t.account_id)
180
190
(Hashtbl.length t.list)
181
191
(List.length t.not_found)
182
192
+12
-13
jmap/jmap-email/search.mli
+12
-13
jmap/jmap-email/search.mli
···
12
12
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-5> RFC 8621, Section 5: SearchSnippet
13
13
*)
14
14
15
-
open Jmap.Types
16
15
open Jmap.Methods
17
16
18
17
(** SearchSnippet object representation.
···
38
37
39
38
(** Get the email ID this snippet corresponds to.
40
39
@return ID of the email that contains the matching content *)
41
-
val email_id : t -> id
40
+
val email_id : t -> Jmap.Id.t
42
41
43
42
(** Get the highlighted subject snippet.
44
43
@return Optional highlighted subject text with search matches marked *)
···
54
53
@param preview Optional highlighted body/preview text
55
54
@return New SearchSnippet object *)
56
55
val v :
57
-
email_id:id ->
56
+
email_id:Jmap.Id.t ->
58
57
?subject:string ->
59
58
?preview:string ->
60
59
unit -> t
···
86
85
87
86
(** Get the account ID for the search operation.
88
87
@return Account where emails will be searched for snippets *)
89
-
val account_id : t -> id
88
+
val account_id : t -> Jmap.Id.t
90
89
91
90
(** Get the search filter defining what to search for.
92
91
@return Filter condition that will generate the highlighted snippets *)
···
94
93
95
94
(** Get the specific email IDs to generate snippets for.
96
95
@return Optional list of email IDs, or None to include all matching emails *)
97
-
val email_ids : t -> id list option
96
+
val email_ids : t -> Jmap.Id.t list option
98
97
99
98
(** Create SearchSnippet/get arguments.
100
99
@param account_id Account to search within
···
102
101
@param email_ids Optional specific email IDs to generate snippets for
103
102
@return SearchSnippet/get arguments *)
104
103
val v :
105
-
account_id:id ->
104
+
account_id:Jmap.Id.t ->
106
105
filter:Filter.t ->
107
-
?email_ids:id list ->
106
+
?email_ids:Jmap.Id.t list ->
108
107
unit -> t
109
108
end
110
109
···
127
126
128
127
(** Get the account ID from the response.
129
128
@return Account where snippets were generated *)
130
-
val account_id : t -> id
129
+
val account_id : t -> Jmap.Id.t
131
130
132
131
(** Get the map of email IDs to their search snippets.
133
132
@return Map containing SearchSnippet objects keyed by email ID *)
134
-
val list : t -> SearchSnippet.t id_map
133
+
val list : t -> (string, SearchSnippet.t) Hashtbl.t
135
134
136
135
(** Get the list of email IDs that were not found.
137
136
@return List of requested email IDs that don't exist or don't match the filter *)
138
-
val not_found : t -> id list
137
+
val not_found : t -> Jmap.Id.t list
139
138
140
139
(** Create SearchSnippet/get response.
141
140
@param account_id Account where snippets were generated
···
143
142
@param not_found List of email IDs that were not found
144
143
@return SearchSnippet/get response *)
145
144
val v :
146
-
account_id:id ->
147
-
list:SearchSnippet.t id_map ->
148
-
not_found:id list ->
145
+
account_id:Jmap.Id.t ->
146
+
list:(string, SearchSnippet.t) Hashtbl.t ->
147
+
not_found:Jmap.Id.t list ->
149
148
unit -> t
150
149
end
151
150
+29
-23
jmap/jmap-email/set.ml
+29
-23
jmap/jmap-email/set.ml
···
1
1
(** Email set operations using core JMAP Set_args *)
2
2
3
-
open Jmap.Types
4
3
open Jmap.Methods
5
4
6
5
(** Email creation arguments *)
7
6
module Create = struct
8
7
type t = {
9
-
mailbox_ids : (id * bool) list;
8
+
mailbox_ids : (Jmap.Id.t * bool) list;
10
9
keywords : (Keywords.keyword * bool) list;
11
-
received_at : Jmap.Types.utc_date option;
10
+
received_at : Jmap.Date.t option;
12
11
(* Additional fields as needed *)
13
12
}
14
13
···
20
19
21
20
let to_json t : Yojson.Safe.t =
22
21
let fields = [
23
-
("mailboxIds", (`Assoc (List.map (fun (id, v) -> (id, `Bool v)) t.mailbox_ids) : Yojson.Safe.t));
22
+
("mailboxIds", (`Assoc (List.map (fun (id, v) -> (Jmap.Id.to_string id, `Bool v)) t.mailbox_ids) : Yojson.Safe.t));
24
23
("keywords", (`Assoc (List.map (fun (kw, v) -> (Keywords.keyword_to_string kw, `Bool v)) t.keywords) : Yojson.Safe.t));
25
24
] in
26
25
let fields = match t.received_at with
27
-
| Some timestamp -> ("receivedAt", (`String (Jmap.Date.of_timestamp timestamp |> Jmap.Date.to_rfc3339) : Yojson.Safe.t)) :: fields
26
+
| Some timestamp -> ("receivedAt", (Jmap.Date.to_json timestamp : Yojson.Safe.t)) :: fields
28
27
| None -> fields
29
28
in
30
29
(`Assoc fields : Yojson.Safe.t)
···
46
45
47
46
let move_to_mailbox mailbox_id patch =
48
47
(* Clear all existing mailboxes and set new one *)
48
+
let mailbox_id_str = Jmap.Id.to_string mailbox_id in
49
49
let clear_mailboxes = ("mailboxIds", `Null) :: patch in
50
-
("mailboxIds/" ^ mailbox_id, `Bool true) :: clear_mailboxes
50
+
("mailboxIds/" ^ mailbox_id_str, `Bool true) :: clear_mailboxes
51
51
52
52
let add_to_mailbox mailbox_id patch =
53
-
("mailboxIds/" ^ mailbox_id, `Bool true) :: patch
53
+
let mailbox_id_str = Jmap.Id.to_string mailbox_id in
54
+
("mailboxIds/" ^ mailbox_id_str, `Bool true) :: patch
54
55
55
56
let remove_from_mailbox mailbox_id patch =
56
-
("mailboxIds/" ^ mailbox_id, `Null) :: patch
57
+
let mailbox_id_str = Jmap.Id.to_string mailbox_id in
58
+
("mailboxIds/" ^ mailbox_id_str, `Null) :: patch
57
59
58
60
let to_patch_object patch : patch_object = patch
59
61
end
60
62
61
63
(** Build Email/set arguments *)
62
64
let build_set_args ~account_id ?if_in_state ?create ?update ?destroy () =
65
+
let account_id_str = Jmap.Id.to_string account_id in
66
+
let destroy_str_list = match destroy with
67
+
| Some id_list -> Some (List.map Jmap.Id.to_string id_list)
68
+
| None -> None in
63
69
Set_args.v
64
-
~account_id
70
+
~account_id:account_id_str
65
71
?if_in_state
66
72
?create
67
73
?update
68
-
?destroy
74
+
?destroy:destroy_str_list
69
75
()
70
76
71
77
(** Convert Email/set arguments to JSON *)
···
79
85
80
86
(** Mark emails as read *)
81
87
let mark_as_read ~account_id email_ids =
82
-
let update_map : patch_object id_map = Hashtbl.create (List.length email_ids) in
88
+
let update_map : (string, patch_object) Hashtbl.t = Hashtbl.create (List.length email_ids) in
83
89
List.iter (fun id ->
84
-
Hashtbl.add update_map id (Update.add_keyword Keywords.Seen [])
90
+
Hashtbl.add update_map (Jmap.Id.to_string id) (Update.add_keyword Keywords.Seen [])
85
91
) email_ids;
86
92
build_set_args ~account_id ~update:update_map ()
87
93
88
94
(** Mark emails as unread *)
89
95
let mark_as_unread ~account_id email_ids =
90
-
let update_map : patch_object id_map = Hashtbl.create (List.length email_ids) in
96
+
let update_map : (string, patch_object) Hashtbl.t = Hashtbl.create (List.length email_ids) in
91
97
List.iter (fun id ->
92
-
Hashtbl.add update_map id (Update.remove_keyword Keywords.Seen [])
98
+
Hashtbl.add update_map (Jmap.Id.to_string id) (Update.remove_keyword Keywords.Seen [])
93
99
) email_ids;
94
100
build_set_args ~account_id ~update:update_map ()
95
101
96
102
(** Flag/star emails *)
97
103
let flag_emails ~account_id email_ids =
98
-
let update_map : patch_object id_map = Hashtbl.create (List.length email_ids) in
104
+
let update_map : (string, patch_object) Hashtbl.t = Hashtbl.create (List.length email_ids) in
99
105
List.iter (fun id ->
100
-
Hashtbl.add update_map id (Update.add_keyword Keywords.Flagged [])
106
+
Hashtbl.add update_map (Jmap.Id.to_string id) (Update.add_keyword Keywords.Flagged [])
101
107
) email_ids;
102
108
build_set_args ~account_id ~update:update_map ()
103
109
104
110
(** Unflag/unstar emails *)
105
111
let unflag_emails ~account_id email_ids =
106
-
let update_map : patch_object id_map = Hashtbl.create (List.length email_ids) in
112
+
let update_map : (string, patch_object) Hashtbl.t = Hashtbl.create (List.length email_ids) in
107
113
List.iter (fun id ->
108
-
Hashtbl.add update_map id (Update.remove_keyword Keywords.Flagged [])
114
+
Hashtbl.add update_map (Jmap.Id.to_string id) (Update.remove_keyword Keywords.Flagged [])
109
115
) email_ids;
110
116
build_set_args ~account_id ~update:update_map ()
111
117
112
118
(** Move emails to a mailbox *)
113
119
let move_to_mailbox ~account_id ~mailbox_id email_ids =
114
-
let update_map : patch_object id_map = Hashtbl.create (List.length email_ids) in
120
+
let update_map : (string, patch_object) Hashtbl.t = Hashtbl.create (List.length email_ids) in
115
121
List.iter (fun id ->
116
-
Hashtbl.add update_map id (Update.move_to_mailbox mailbox_id [])
122
+
Hashtbl.add update_map (Jmap.Id.to_string id) (Update.move_to_mailbox mailbox_id [])
117
123
) email_ids;
118
124
build_set_args ~account_id ~update:update_map ()
119
125
···
127
133
128
134
(** Batch update multiple properties *)
129
135
let batch_update ~account_id updates =
130
-
let update_map : patch_object id_map = Hashtbl.create (List.length updates) in
136
+
let update_map : (string, patch_object) Hashtbl.t = Hashtbl.create (List.length updates) in
131
137
List.iter (fun (id, patch) ->
132
-
Hashtbl.add update_map id patch
138
+
Hashtbl.add update_map (Jmap.Id.to_string id) patch
133
139
) updates;
134
140
build_set_args ~account_id ~update:update_map ()
135
141
···
138
144
(* Note: subject, from, to_, cc, bcc, text_body, html_body would need proper implementation
139
145
with full email creation support. For now, just creating basic structure. *)
140
146
let creation = Create.make ~mailbox_ids ?keywords () in
141
-
let create_map : Create.t id_map = Hashtbl.create 1 in
147
+
let create_map : (string, Create.t) Hashtbl.t = Hashtbl.create 1 in
142
148
Hashtbl.add create_map "draft-1" creation;
143
149
build_set_args ~account_id ~create:create_map ()
+26
-27
jmap/jmap-email/set.mli
+26
-27
jmap/jmap-email/set.mli
···
5
5
6
6
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.5> RFC 8621 Section 4.5 *)
7
7
8
-
open Jmap.Types
9
8
open Jmap.Methods
10
9
11
10
(** {1 Email Creation} *)
···
20
19
@param ?received_at Optional received timestamp
21
20
@return Email creation arguments *)
22
21
val make :
23
-
mailbox_ids:(id * bool) list ->
22
+
mailbox_ids:(Jmap.Id.t * bool) list ->
24
23
?keywords:(Keywords.keyword * bool) list ->
25
-
?received_at:Jmap.Types.utc_date ->
24
+
?received_at:Jmap.Date.t ->
26
25
unit -> t
27
26
28
27
(** Convert creation arguments to JSON *)
···
46
45
val remove_keyword : Keywords.keyword -> patch_object -> patch_object
47
46
48
47
(** Move to a single mailbox (removes from all others) *)
49
-
val move_to_mailbox : id -> patch_object -> patch_object
48
+
val move_to_mailbox : Jmap.Id.t -> patch_object -> patch_object
50
49
51
50
(** Add to a mailbox (keeps existing) *)
52
-
val add_to_mailbox : id -> patch_object -> patch_object
51
+
val add_to_mailbox : Jmap.Id.t -> patch_object -> patch_object
53
52
54
53
(** Remove from a mailbox *)
55
-
val remove_from_mailbox : id -> patch_object -> patch_object
54
+
val remove_from_mailbox : Jmap.Id.t -> patch_object -> patch_object
56
55
57
56
(** Convert to patch object for Set_args *)
58
57
val to_patch_object : patch_object -> patch_object
···
68
67
@param ?destroy Optional list of email IDs to destroy
69
68
@return Set_args for Email/set method *)
70
69
val build_set_args :
71
-
account_id:id ->
70
+
account_id:Jmap.Id.t ->
72
71
?if_in_state:string ->
73
-
?create:Create.t id_map ->
74
-
?update:patch_object id_map ->
75
-
?destroy:id list ->
72
+
?create:(string, Create.t) Hashtbl.t ->
73
+
?update:(string, patch_object) Hashtbl.t ->
74
+
?destroy:Jmap.Id.t list ->
76
75
unit ->
77
76
(Create.t, patch_object) Set_args.t
78
77
···
88
87
@param email_ids List of email IDs to mark as read
89
88
@return Set_args for marking emails as read *)
90
89
val mark_as_read :
91
-
account_id:id ->
92
-
id list ->
90
+
account_id:Jmap.Id.t ->
91
+
Jmap.Id.t list ->
93
92
(Create.t, patch_object) Set_args.t
94
93
95
94
(** Mark emails as unread by removing $seen keyword.
···
97
96
@param email_ids List of email IDs to mark as unread
98
97
@return Set_args for marking emails as unread *)
99
98
val mark_as_unread :
100
-
account_id:id ->
101
-
id list ->
99
+
account_id:Jmap.Id.t ->
100
+
Jmap.Id.t list ->
102
101
(Create.t, patch_object) Set_args.t
103
102
104
103
(** Flag/star emails by adding $flagged keyword.
···
106
105
@param email_ids List of email IDs to flag
107
106
@return Set_args for flagging emails *)
108
107
val flag_emails :
109
-
account_id:id ->
110
-
id list ->
108
+
account_id:Jmap.Id.t ->
109
+
Jmap.Id.t list ->
111
110
(Create.t, patch_object) Set_args.t
112
111
113
112
(** Unflag/unstar emails by removing $flagged keyword.
···
115
114
@param email_ids List of email IDs to unflag
116
115
@return Set_args for unflagging emails *)
117
116
val unflag_emails :
118
-
account_id:id ->
119
-
id list ->
117
+
account_id:Jmap.Id.t ->
118
+
Jmap.Id.t list ->
120
119
(Create.t, patch_object) Set_args.t
121
120
122
121
(** Move emails to a specific mailbox.
···
125
124
@param email_ids List of email IDs to move
126
125
@return Set_args for moving emails *)
127
126
val move_to_mailbox :
128
-
account_id:id ->
129
-
mailbox_id:id ->
130
-
id list ->
127
+
account_id:Jmap.Id.t ->
128
+
mailbox_id:Jmap.Id.t ->
129
+
Jmap.Id.t list ->
131
130
(Create.t, patch_object) Set_args.t
132
131
133
132
(** Delete emails (destroy or move to trash).
···
136
135
@param email_ids List of email IDs to delete
137
136
@return Set_args for deleting emails *)
138
137
val delete_emails :
139
-
account_id:id ->
138
+
account_id:Jmap.Id.t ->
140
139
?destroy:bool ->
141
-
id list ->
140
+
Jmap.Id.t list ->
142
141
(Create.t, patch_object) Set_args.t
143
142
144
143
(** Batch update multiple emails with different patches.
···
146
145
@param updates List of (email_id, patch_object) pairs
147
146
@return Set_args for batch updates *)
148
147
val batch_update :
149
-
account_id:id ->
150
-
(id * patch_object) list ->
148
+
account_id:Jmap.Id.t ->
149
+
(Jmap.Id.t * patch_object) list ->
151
150
(Create.t, patch_object) Set_args.t
152
151
153
152
(** Create a draft email.
···
163
162
@param ?html_body Optional HTML body
164
163
@return Set_args for creating a draft *)
165
164
val create_draft :
166
-
account_id:id ->
167
-
mailbox_ids:(id * bool) list ->
165
+
account_id:Jmap.Id.t ->
166
+
mailbox_ids:(Jmap.Id.t * bool) list ->
168
167
?keywords:(Keywords.keyword * bool) list ->
169
168
?subject:string ->
170
169
?from:string ->
+104
-85
jmap/jmap-email/submission.ml
+104
-85
jmap/jmap-email/submission.ml
···
7
7
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-7> RFC 8621, Section 7: EmailSubmission
8
8
*)
9
9
10
-
open Jmap.Types
11
10
12
11
(** {1 Internal Type Representations} *)
13
12
14
13
(** Internal EmailSubmission representation *)
15
14
type submission_data = {
16
-
id : id;
17
-
identity_id : id;
18
-
email_id : id;
19
-
thread_id : id;
15
+
id : Jmap.Id.t;
16
+
identity_id : Jmap.Id.t;
17
+
email_id : Jmap.Id.t;
18
+
thread_id : Jmap.Id.t;
20
19
envelope : envelope_data option;
21
-
send_at : utc_date;
20
+
send_at : Jmap.Date.t;
22
21
undo_status : [`Pending | `Final | `Canceled];
23
-
delivery_status : delivery_status_data string_map option;
24
-
dsn_blob_ids : id list;
25
-
mdn_blob_ids : id list;
22
+
delivery_status : (string, delivery_status_data) Hashtbl.t option;
23
+
dsn_blob_ids : Jmap.Id.t list;
24
+
mdn_blob_ids : Jmap.Id.t list;
26
25
}
27
26
28
27
(** Internal envelope representation *)
···
34
33
(** Internal envelope address representation *)
35
34
and envelope_address_data = {
36
35
email : string;
37
-
parameters : Yojson.Safe.t string_map option;
36
+
parameters : (string, Yojson.Safe.t) Hashtbl.t option;
38
37
}
39
38
40
39
(** Internal delivery status representation *)
···
227
226
(** Convert submission to JSON *)
228
227
let to_json submission =
229
228
let base = [
230
-
("id", `String submission.id);
231
-
("identityId", `String submission.identity_id);
232
-
("emailId", `String submission.email_id);
233
-
("threadId", `String submission.thread_id);
234
-
("sendAt", `Float submission.send_at);
229
+
("id", `String (Jmap.Id.to_string submission.id));
230
+
("identityId", `String (Jmap.Id.to_string submission.identity_id));
231
+
("emailId", `String (Jmap.Id.to_string submission.email_id));
232
+
("threadId", `String (Jmap.Id.to_string submission.thread_id));
233
+
("sendAt", `Float (Jmap.Date.to_timestamp submission.send_at));
235
234
("undoStatus", `String (undo_status_to_string submission.undo_status));
236
-
("dsnBlobIds", `List (List.map (fun id -> `String id) submission.dsn_blob_ids));
237
-
("mdnBlobIds", `List (List.map (fun id -> `String id) submission.mdn_blob_ids));
235
+
("dsnBlobIds", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) submission.dsn_blob_ids));
236
+
("mdnBlobIds", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) submission.mdn_blob_ids));
238
237
] in
239
238
let fields = match submission.envelope with
240
239
| Some _env -> ("envelope", `Null) :: base (* Envelope serialization not implemented *)
···
251
250
252
251
(** Format EmailSubmission for debugging *)
253
252
let pp ppf submission =
254
-
let send_at_str = Printf.sprintf "%.0f" submission.send_at in
253
+
let send_at_str = Printf.sprintf "%.0f" (Jmap.Date.to_timestamp submission.send_at) in
255
254
let undo_status_str = undo_status_to_string submission.undo_status in
256
-
Format.fprintf ppf "EmailSubmission{id=%s; email_id=%s; thread_id=%s; identity_id=%s; send_at=%s; undo_status=%s}"
257
-
submission.id
258
-
submission.email_id
259
-
submission.thread_id
260
-
submission.identity_id
255
+
Format.fprintf ppf "EmailSubmission{Id.t=%s; email_id=%s; thread_id=%s; identity_id=%s; send_at=%s; undo_status=%s}"
256
+
(Jmap.Id.to_string submission.id)
257
+
(Jmap.Id.to_string submission.email_id)
258
+
(Jmap.Id.to_string submission.thread_id)
259
+
(Jmap.Id.to_string submission.identity_id)
261
260
send_at_str
262
261
undo_status_str
263
262
264
263
(** Format EmailSubmission for human reading *)
265
264
let pp_hum ppf submission =
266
-
let send_at_str = Printf.sprintf "%.0f" submission.send_at in
265
+
let send_at_str = Printf.sprintf "%.0f" (Jmap.Date.to_timestamp submission.send_at) in
267
266
let undo_status_str = undo_status_to_string submission.undo_status in
268
267
let envelope_str = match submission.envelope with
269
268
| None -> "none"
···
273
272
| None -> "none"
274
273
| Some tbl -> Printf.sprintf "%d recipients" (Hashtbl.length tbl)
275
274
in
276
-
Format.fprintf ppf "EmailSubmission {\n id: %s\n email_id: %s\n thread_id: %s\n identity_id: %s\n send_at: %s\n undo_status: %s\n envelope: %s\n delivery_status: %s\n dsn_blob_ids: %d\n mdn_blob_ids: %d\n}"
277
-
submission.id
278
-
submission.email_id
279
-
submission.thread_id
280
-
submission.identity_id
275
+
Format.fprintf ppf "EmailSubmission {\n Id.t: %s\n email_id: %s\n thread_id: %s\n identity_id: %s\n send_at: %s\n undo_status: %s\n envelope: %s\n delivery_status: %s\n dsn_blob_ids: %d\n mdn_blob_ids: %d\n}"
276
+
(Jmap.Id.to_string submission.id)
277
+
(Jmap.Id.to_string submission.email_id)
278
+
(Jmap.Id.to_string submission.thread_id)
279
+
(Jmap.Id.to_string submission.identity_id)
281
280
send_at_str
282
281
undo_status_str
283
282
envelope_str
···
305
304
in
306
305
let get_optional_field name = try Some (get_field name) with Not_found -> None in
307
306
308
-
let id = get_string_field "id" in
309
-
let identity_id = get_string_field "identityId" in
310
-
let email_id = get_string_field "emailId" in
311
-
let thread_id = get_string_field "threadId" in
312
-
let send_at = get_float_field "sendAt" in
307
+
let id = match Jmap.Id.of_string (get_string_field "id") with
308
+
| Ok id -> id | Error err -> failwith ("Invalid id: " ^ err) in
309
+
let identity_id = match Jmap.Id.of_string (get_string_field "identityId") with
310
+
| Ok id -> id | Error err -> failwith ("Invalid identityId: " ^ err) in
311
+
let email_id = match Jmap.Id.of_string (get_string_field "emailId") with
312
+
| Ok id -> id | Error err -> failwith ("Invalid emailId: " ^ err) in
313
+
let thread_id = match Jmap.Id.of_string (get_string_field "threadId") with
314
+
| Ok id -> id | Error err -> failwith ("Invalid threadId: " ^ err) in
315
+
let send_at = Jmap.Date.of_timestamp (get_float_field "sendAt") in
313
316
let undo_status = undo_status_of_string (get_string_field "undoStatus") in
314
317
let dsn_blob_ids = List.map (function
315
-
| `String s -> s
318
+
| `String s -> (match Jmap.Id.of_string s with Ok id -> id | Error err -> failwith ("Invalid dsnBlobId: " ^ err))
316
319
| _ -> failwith "Expected string in dsnBlobIds"
317
320
) (get_list_field "dsnBlobIds") in
318
321
let mdn_blob_ids = List.map (function
319
-
| `String s -> s
322
+
| `String s -> (match Jmap.Id.of_string s with Ok id -> id | Error err -> failwith ("Invalid mdnBlobId: " ^ err))
320
323
| _ -> failwith "Expected string in mdnBlobIds"
321
324
) (get_list_field "mdnBlobIds") in
322
325
···
361
364
(** Serialize to JSON with only specified properties *)
362
365
let to_json_with_properties ~properties submission =
363
366
let all_fields = [
364
-
("id", `String submission.id);
365
-
("identityId", `String submission.identity_id);
366
-
("emailId", `String submission.email_id);
367
-
("threadId", `String submission.thread_id);
368
-
("sendAt", `Float submission.send_at);
367
+
("id", `String (Jmap.Id.to_string submission.id));
368
+
("identityId", `String (Jmap.Id.to_string submission.identity_id));
369
+
("emailId", `String (Jmap.Id.to_string submission.email_id));
370
+
("threadId", `String (Jmap.Id.to_string submission.thread_id));
371
+
("sendAt", `Float (Jmap.Date.to_timestamp submission.send_at));
369
372
("undoStatus", `String (undo_status_to_string submission.undo_status));
370
-
("dsnBlobIds", `List (List.map (fun id -> `String id) submission.dsn_blob_ids));
371
-
("mdnBlobIds", `List (List.map (fun id -> `String id) submission.mdn_blob_ids));
373
+
("dsnBlobIds", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) submission.dsn_blob_ids));
374
+
("mdnBlobIds", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) submission.mdn_blob_ids));
372
375
(* TODO: Add envelope and deliveryStatus when implemented *)
373
376
("envelope", match submission.envelope with Some _ -> `Null | None -> `Null);
374
377
("deliveryStatus", match submission.delivery_status with Some _ -> `Null | None -> `Null);
···
418
421
module Create = struct
419
422
420
423
type create_data = {
421
-
identity_id : id;
422
-
email_id : id;
424
+
identity_id : Jmap.Id.t;
425
+
email_id : Jmap.Id.t;
423
426
envelope : envelope_data option;
424
427
}
425
428
···
427
430
428
431
let to_json create =
429
432
let base = [
430
-
("identityId", `String create.identity_id);
431
-
("emailId", `String create.email_id);
433
+
("identityId", `String (Jmap.Id.to_string create.identity_id));
434
+
("emailId", `String (Jmap.Id.to_string create.email_id));
432
435
] in
433
436
let fields = match create.envelope with
434
437
| Some _env -> ("envelope", `Null) :: base (* Envelope serialization not implemented *)
···
443
446
let get_field name = List.assoc name fields in
444
447
let get_optional_field name = try Some (get_field name) with Not_found -> None in
445
448
let identity_id = match get_field "identityId" with
446
-
| `String s -> s
449
+
| `String s -> (match Jmap.Id.of_string s with
450
+
| Ok id -> id
451
+
| Error _ -> failwith ("Invalid identityId: " ^ s))
447
452
| _ -> failwith "Expected string for identityId"
448
453
in
449
454
let email_id = match get_field "emailId" with
450
-
| `String s -> s
455
+
| `String s -> (match Jmap.Id.of_string s with
456
+
| Ok id -> id
457
+
| Error _ -> failwith ("Invalid emailId: " ^ s))
451
458
| _ -> failwith "Expected string for emailId"
452
459
in
453
460
let envelope = match get_optional_field "envelope" with
···
472
479
module Response = struct
473
480
474
481
type response_data = {
475
-
id : id;
476
-
thread_id : id;
477
-
send_at : utc_date;
482
+
id : Jmap.Id.t;
483
+
thread_id : Jmap.Id.t;
484
+
send_at : Jmap.Date.t;
478
485
}
479
486
480
487
type t = response_data
481
488
482
489
let to_json response =
483
490
`Assoc [
484
-
("id", `String response.id);
485
-
("threadId", `String response.thread_id);
486
-
("sendAt", `Float response.send_at);
491
+
("id", `String (Jmap.Id.to_string response.id));
492
+
("threadId", `String (Jmap.Id.to_string response.thread_id));
493
+
("sendAt", `Float (Jmap.Date.to_timestamp response.send_at));
487
494
]
488
495
489
496
let of_json json =
···
492
499
| `Assoc fields ->
493
500
let get_field name = List.assoc name fields in
494
501
let id = match get_field "id" with
495
-
| `String s -> s
502
+
| `String s -> (match Jmap.Id.of_string s with
503
+
| Ok id -> id
504
+
| Error _ -> failwith ("Invalid id: " ^ s))
496
505
| _ -> failwith "Expected string for id"
497
506
in
498
507
let thread_id = match get_field "threadId" with
499
-
| `String s -> s
508
+
| `String s -> (match Jmap.Id.of_string s with
509
+
| Ok id -> id
510
+
| Error _ -> failwith ("Invalid threadId: " ^ s))
500
511
| _ -> failwith "Expected string for threadId"
501
512
in
502
513
let send_at = match get_field "sendAt" with
503
-
| `Float f -> f
514
+
| `Float f -> Jmap.Date.of_timestamp f
504
515
| _ -> failwith "Expected float for sendAt"
505
516
in
506
517
Ok { id; thread_id; send_at }
···
548
559
module Get_args = struct
549
560
550
561
type get_args_data = {
551
-
account_id : id;
552
-
ids : id list option;
562
+
account_id : Jmap.Id.t;
563
+
ids : Jmap.Id.t list option;
553
564
properties : string list option;
554
565
}
555
566
556
567
type t = get_args_data
557
568
558
569
let to_json args =
559
-
let base = [("accountId", `String args.account_id)] in
570
+
let base = [("accountId", `String (Jmap.Id.to_string args.account_id))] in
560
571
let fields = match args.ids with
561
-
| Some ids -> ("ids", `List (List.map (fun id -> `String id) ids)) :: base
572
+
| Some ids -> ("ids", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) ids)) :: base
562
573
| None -> base
563
574
in
564
575
let fields = match args.properties with
···
574
585
let get_field name = List.assoc name fields in
575
586
let get_optional_field name = try Some (get_field name) with Not_found -> None in
576
587
let account_id = match get_field "accountId" with
577
-
| `String s -> s
588
+
| `String s -> (match Jmap.Id.of_string s with
589
+
| Ok id -> id
590
+
| Error _ -> failwith ("Invalid accountId: " ^ s))
578
591
| _ -> failwith "Expected string for accountId"
579
592
in
580
593
let ids = match get_optional_field "ids" with
581
594
| Some (`List id_list) -> Some (List.map (function
582
-
| `String s -> s
595
+
| `String s -> (match Jmap.Id.of_string s with
596
+
| Ok id -> id
597
+
| Error _ -> failwith ("Invalid id: " ^ s))
583
598
| _ -> failwith "Expected string in ids"
584
599
) id_list)
585
600
| Some _ -> failwith "Expected list for ids"
···
607
622
module Get_response = struct
608
623
609
624
type get_response_data = {
610
-
account_id : id;
625
+
account_id : Jmap.Id.t;
611
626
state : string;
612
627
list : email_submission_t list;
613
-
not_found : id list;
628
+
not_found : Jmap.Id.t list;
614
629
}
615
630
616
631
type t = get_response_data
617
632
618
633
let to_json response =
619
634
`Assoc [
620
-
("accountId", `String response.account_id);
635
+
("accountId", `String (Jmap.Id.to_string response.account_id));
621
636
("state", `String response.state);
622
-
("list", `List (List.map to_json response.list));
623
-
("notFound", `List (List.map (fun id -> `String id) response.not_found));
637
+
("list", `List (List.map (fun submission -> to_json submission) response.list));
638
+
("notFound", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) response.not_found));
624
639
]
625
640
626
641
let of_json json =
···
629
644
| `Assoc fields ->
630
645
let get_field name = List.assoc name fields in
631
646
let account_id = match get_field "accountId" with
632
-
| `String s -> s
647
+
| `String s -> (match Jmap.Id.of_string s with
648
+
| Ok id -> id
649
+
| Error _ -> failwith ("Invalid accountId: " ^ s))
633
650
| _ -> failwith "Expected string for accountId"
634
651
in
635
652
let state = match get_field "state" with
···
639
656
let list = match get_field "list" with
640
657
| `List submission_list ->
641
658
List.filter_map (fun item ->
642
-
match of_json item with
659
+
match (of_json : Yojson.Safe.t -> (email_submission_t, string) result) item with
643
660
| Ok submission -> Some submission
644
661
| Error _ -> None (* Skip entries that fail to parse *)
645
662
) submission_list
646
663
| _ -> failwith "Expected list for list"
647
664
in
648
665
let not_found = match get_field "notFound" with
649
-
| `List id_list -> List.map (function
650
-
| `String s -> s
651
-
| _ -> failwith "Expected string in notFound"
666
+
| `List id_list -> List.filter_map (function
667
+
| `String s -> (match Jmap.Id.of_string s with
668
+
| Ok id -> Some id
669
+
| Error _ -> None)
670
+
| _ -> None
652
671
) id_list
653
672
| _ -> failwith "Expected list for notFound"
654
673
in
···
681
700
type t = unit (* Not implemented *)
682
701
let to_json _ = `Assoc []
683
702
let of_json _ = Ok ()
684
-
let account_id _ = ""
703
+
let account_id _ = match Jmap.Id.of_string "stub-account-id" with Ok id -> id | Error _ -> failwith "Invalid stub id"
685
704
let old_state _ = ""
686
705
let new_state _ = ""
687
706
let has_more_changes _ = false
···
701
720
type t = unit (* Not implemented *)
702
721
let to_json _ = `Assoc []
703
722
let of_json _ = Ok ()
704
-
let account_id _ = ""
723
+
let account_id _ = match Jmap.Id.of_string "stub-account-id" with Ok id -> id | Error _ -> failwith "Invalid stub id"
705
724
let query_state _ = ""
706
725
let can_calculate_changes _ = false
707
-
let position _ = 0
726
+
let position _ = match Jmap.UInt.of_int 0 with Ok v -> v | Error _ -> failwith "Invalid position"
708
727
let total _ = None
709
728
let ids _ = []
710
729
end
···
720
739
type t = unit (* Not implemented *)
721
740
let to_json _ = `Assoc []
722
741
let of_json _ = Ok ()
723
-
let account_id _ = ""
742
+
let account_id _ = match Jmap.Id.of_string "stub-set-response-account-id" with Ok id -> id | Error _ -> failwith "Invalid stub id"
724
743
let old_state _ = None
725
744
let new_state _ = ""
726
745
let created _ = Hashtbl.create 0
···
736
755
module Filter = struct
737
756
738
757
let identity_ids ids =
739
-
let id_values = List.map (fun id -> `String id) ids in
758
+
let id_values = List.map (fun id -> `String (Jmap.Id.to_string id)) ids in
740
759
Jmap.Methods.Filter.property_in "identityId" id_values
741
760
742
761
let email_ids ids =
743
-
let id_values = List.map (fun id -> `String id) ids in
762
+
let id_values = List.map (fun id -> `String (Jmap.Id.to_string id)) ids in
744
763
Jmap.Methods.Filter.property_in "emailId" id_values
745
764
746
765
let thread_ids ids =
747
-
let id_values = List.map (fun id -> `String id) ids in
766
+
let id_values = List.map (fun id -> `String (Jmap.Id.to_string id)) ids in
748
767
Jmap.Methods.Filter.property_in "threadId" id_values
749
768
750
769
let undo_status status =
···
752
771
Jmap.Methods.Filter.property_equals "undoStatus" status_value
753
772
754
773
let before date =
755
-
Jmap.Methods.Filter.property_lt "sendAt" (`Float date)
774
+
Jmap.Methods.Filter.property_lt "sendAt" (`Float (Jmap.Date.to_timestamp date))
756
775
757
776
let after date =
758
-
Jmap.Methods.Filter.property_gt "sendAt" (`Float date)
777
+
Jmap.Methods.Filter.property_gt "sendAt" (`Float (Jmap.Date.to_timestamp date))
759
778
760
779
let date_range ~after_date ~before_date =
761
780
Jmap.Methods.Filter.and_ [
···
802
821
]
803
822
804
823
let to_string = function
805
-
| `Id -> "id"
824
+
| `Id -> "Id.t"
806
825
| `IdentityId -> "identityId"
807
826
| `EmailId -> "emailId"
808
827
| `ThreadId -> "threadId"
···
814
833
| `MdnBlobIds -> "mdnBlobIds"
815
834
816
835
let of_string = function
817
-
| "id" -> Some `Id
836
+
| "Id.t" -> Some `Id
818
837
| "identityId" -> Some `IdentityId
819
838
| "emailId" -> Some `EmailId
820
839
| "threadId" -> Some `ThreadId
+76
-79
jmap/jmap-email/submission.mli
+76
-79
jmap/jmap-email/submission.mli
···
12
12
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-7> RFC 8621, Section 7: EmailSubmission
13
13
*)
14
14
15
-
open Jmap.Types
16
-
17
-
18
15
(** {1 Supporting Types} *)
19
16
20
17
(** SMTP envelope address representation.
···
40
37
(** Get the optional SMTP parameters.
41
38
@param address The envelope address object
42
39
@return Optional SMTP parameters *)
43
-
val parameters : t -> Yojson.Safe.t string_map option
40
+
val parameters : t -> (string, Yojson.Safe.t) Hashtbl.t option
44
41
45
42
(** Create an envelope address.
46
43
@param email Email address for SMTP envelope
···
48
45
@return Ok with address object, or Error with validation message *)
49
46
val create :
50
47
email:string ->
51
-
?parameters:Yojson.Safe.t string_map ->
48
+
?parameters:(string, Yojson.Safe.t) Hashtbl.t ->
52
49
unit -> (t, string) result
53
50
end
54
51
···
149
146
include Jmap_sigs.PRINTABLE with type t := t
150
147
151
148
(** JMAP object interface for property-based operations *)
152
-
include Jmap_sigs.JMAP_OBJECT with type t := t and type id_type := id
149
+
include Jmap_sigs.JMAP_OBJECT with type t := t and type id_type := string
153
150
154
151
(** {1 Property Accessors} *)
155
152
156
153
(** Get the server-assigned submission identifier.
157
154
@param submission The email submission object
158
155
@return Immutable server-assigned submission ID *)
159
-
val id : t -> id option
156
+
val id : t -> Jmap.Id.t option
160
157
161
158
(** Get the identity used for sending this email.
162
159
@param submission The email submission object
163
160
@return Immutable identity ID used for sending *)
164
-
val identity_id : t -> id
161
+
val identity_id : t -> Jmap.Id.t
165
162
166
163
(** Get the email being submitted.
167
164
@param submission The email submission object
168
165
@return Immutable email ID being submitted *)
169
-
val email_id : t -> id
166
+
val email_id : t -> Jmap.Id.t
170
167
171
168
(** Get the thread this email belongs to.
172
169
@param submission The email submission object
173
170
@return Immutable thread ID (server-set) *)
174
-
val thread_id : t -> id
171
+
val thread_id : t -> Jmap.Id.t
175
172
176
173
(** Get the SMTP envelope override.
177
174
@param submission The email submission object
···
181
178
(** Get the scheduled send time.
182
179
@param submission The email submission object
183
180
@return Immutable scheduled send time (server-set) *)
184
-
val send_at : t -> utc_date
181
+
val send_at : t -> Jmap.Date.t
185
182
186
183
(** Get the current undo/cancellation status.
187
184
@param submission The email submission object
···
191
188
(** Get the per-recipient delivery status.
192
189
@param submission The email submission object
193
190
@return Per-recipient delivery status (server-set) *)
194
-
val delivery_status : t -> DeliveryStatus.t string_map option
191
+
val delivery_status : t -> (string, DeliveryStatus.t) Hashtbl.t option
195
192
196
193
(** Get the delivery status notification blob IDs.
197
194
@param submission The email submission object
198
195
@return Delivery status notification blobs (server-set) *)
199
-
val dsn_blob_ids : t -> id list
196
+
val dsn_blob_ids : t -> Jmap.Id.t list
200
197
201
198
(** Get the message disposition notification blob IDs.
202
199
@param submission The email submission object
203
200
@return Message disposition notification blobs (server-set) *)
204
-
val mdn_blob_ids : t -> id list
201
+
val mdn_blob_ids : t -> Jmap.Id.t list
205
202
206
203
(** {1 Smart Constructors} *)
207
204
208
205
(** Create an EmailSubmission object from all properties.
209
-
@param id Server-assigned submission ID
206
+
@param Jmap.Id.t Server-assigned submission ID
210
207
@param identity_id Identity used for sending
211
208
@param email_id Email being submitted
212
209
@param thread_id Thread ID (server-set)
···
218
215
@param mdn_blob_ids Message disposition notification blobs (server-set)
219
216
@return Ok with submission object, or Error with validation message *)
220
217
val create :
221
-
id:id ->
222
-
identity_id:id ->
223
-
email_id:id ->
224
-
thread_id:id ->
218
+
id:Jmap.Id.t ->
219
+
identity_id:Jmap.Id.t ->
220
+
email_id:Jmap.Id.t ->
221
+
thread_id:Jmap.Id.t ->
225
222
?envelope:Envelope.t ->
226
-
send_at:utc_date ->
223
+
send_at:Jmap.Date.t ->
227
224
undo_status:[`Pending | `Final | `Canceled] ->
228
-
?delivery_status:DeliveryStatus.t string_map ->
229
-
?dsn_blob_ids:id list ->
230
-
?mdn_blob_ids:id list ->
225
+
?delivery_status:(string, DeliveryStatus.t) Hashtbl.t ->
226
+
?dsn_blob_ids:Jmap.Id.t list ->
227
+
?mdn_blob_ids:Jmap.Id.t list ->
231
228
unit -> (t, string) result
232
229
233
230
(** {1 JMAP Method Operations} *)
···
250
247
(** Get the identity to use for sending.
251
248
@param create The creation object
252
249
@return Identity to use for sending *)
253
-
val identity_id : t -> id
250
+
val identity_id : t -> Jmap.Id.t
254
251
255
252
(** Get the email object to submit.
256
253
@param create The creation object
257
254
@return Email object to submit *)
258
-
val email_id : t -> id
255
+
val email_id : t -> Jmap.Id.t
259
256
260
257
(** Get the optional envelope override.
261
258
@param create The creation object
···
268
265
@param envelope Optional envelope override
269
266
@return Ok with creation object, or Error with validation message *)
270
267
val create :
271
-
identity_id:id ->
272
-
email_id:id ->
268
+
identity_id:Jmap.Id.t ->
269
+
email_id:Jmap.Id.t ->
273
270
?envelope:Envelope.t ->
274
271
unit -> (t, string) result
275
272
···
290
287
(** Get the server-assigned submission ID.
291
288
@param response The creation response object
292
289
@return Server-assigned submission ID *)
293
-
val id : t -> id
290
+
val id : t -> Jmap.Id.t
294
291
295
292
(** Get the thread ID the email belongs to.
296
293
@param response The creation response object
297
294
@return Thread ID the email belongs to *)
298
-
val thread_id : t -> id
295
+
val thread_id : t -> Jmap.Id.t
299
296
300
297
(** Get the actual/scheduled send timestamp.
301
298
@param response The creation response object
302
299
@return Actual/scheduled send timestamp *)
303
-
val send_at : t -> utc_date
300
+
val send_at : t -> Jmap.Date.t
304
301
305
302
(** Create a creation response.
306
-
@param id Server-assigned submission ID
303
+
@param Jmap.Id.t Server-assigned submission ID
307
304
@param thread_id Thread ID the email belongs to
308
305
@param send_at Actual/scheduled send timestamp
309
306
@return Ok with response object, or Error with validation message *)
310
307
val create :
311
-
id:id ->
312
-
thread_id:id ->
313
-
send_at:utc_date ->
308
+
id:Jmap.Id.t ->
309
+
thread_id:Jmap.Id.t ->
310
+
send_at:Jmap.Date.t ->
314
311
(t, string) result
315
312
end
316
313
end
···
383
380
@param properties Properties to include (None for all)
384
381
@return Ok with get arguments, or Error with validation message *)
385
382
val create :
386
-
account_id:id ->
387
-
?ids:id list ->
383
+
account_id:Jmap.Id.t ->
384
+
?ids:Jmap.Id.t list ->
388
385
?properties:string list ->
389
386
unit -> (t, string) result
390
387
end
···
406
403
(** Get the account ID.
407
404
@param response The get response object
408
405
@return Account ID *)
409
-
val account_id : t -> id
406
+
val account_id : t -> Jmap.Id.t
410
407
411
408
(** Get the current state string.
412
409
@param response The get response object
···
421
418
(** Get the list of submission IDs not found.
422
419
@param response The get response object
423
420
@return List of submission IDs not found *)
424
-
val not_found : t -> id list
421
+
val not_found : t -> Jmap.Id.t list
425
422
end
426
423
427
424
(** Arguments for EmailSubmission/changes method.
···
444
441
@param max_changes Maximum number of changes to return
445
442
@return Ok with changes arguments, or Error with validation message *)
446
443
val create :
447
-
account_id:id ->
444
+
account_id:Jmap.Id.t ->
448
445
since_state:string ->
449
-
?max_changes:uint ->
446
+
?max_changes:Jmap.UInt.t ->
450
447
unit -> (t, string) result
451
448
end
452
449
···
467
464
(** Get the account ID.
468
465
@param response The changes response object
469
466
@return Account ID *)
470
-
val account_id : t -> id
467
+
val account_id : t -> Jmap.Id.t
471
468
472
469
(** Get the old state string.
473
470
@param response The changes response object
···
487
484
(** Get the list of created submission IDs.
488
485
@param response The changes response object
489
486
@return List of created submission IDs *)
490
-
val created : t -> id list
487
+
val created : t -> Jmap.Id.t list
491
488
492
489
(** Get the list of updated submission IDs.
493
490
@param response The changes response object
494
491
@return List of updated submission IDs *)
495
-
val updated : t -> id list
492
+
val updated : t -> Jmap.Id.t list
496
493
497
494
(** Get the list of destroyed submission IDs.
498
495
@param response The changes response object
499
496
@return List of destroyed submission IDs *)
500
-
val destroyed : t -> id list
497
+
val destroyed : t -> Jmap.Id.t list
501
498
end
502
499
503
500
(** Arguments for EmailSubmission/query method.
···
525
522
@param calculate_total Whether to calculate total count
526
523
@return Ok with query arguments, or Error with validation message *)
527
524
val create :
528
-
account_id:id ->
525
+
account_id:Jmap.Id.t ->
529
526
?filter:Jmap.Methods.Filter.t ->
530
527
?sort:Jmap.Methods.Comparator.t list ->
531
-
?position:uint ->
532
-
?anchor:id ->
528
+
?position:Jmap.UInt.t ->
529
+
?anchor:Jmap.Id.t ->
533
530
?anchor_offset:int ->
534
-
?limit:uint ->
531
+
?limit:Jmap.UInt.t ->
535
532
?calculate_total:bool ->
536
533
unit -> (t, string) result
537
534
end
···
553
550
(** Get the account ID.
554
551
@param response The query response object
555
552
@return Account ID *)
556
-
val account_id : t -> id
553
+
val account_id : t -> Jmap.Id.t
557
554
558
555
(** Get the query state string.
559
556
@param response The query response object
···
568
565
(** Get the starting position of results.
569
566
@param response The query response object
570
567
@return Starting position of results *)
571
-
val position : t -> uint
568
+
val position : t -> Jmap.UInt.t
572
569
573
570
(** Get the total number of matching objects.
574
571
@param response The query response object
575
572
@return Total number of matching objects (if calculated) *)
576
-
val total : t -> uint option
573
+
val total : t -> Jmap.UInt.t option
577
574
578
575
(** Get the list of matching submission IDs.
579
576
@param response The query response object
580
577
@return List of matching submission IDs *)
581
-
val ids : t -> id list
578
+
val ids : t -> Jmap.Id.t list
582
579
end
583
580
584
581
(** Arguments for EmailSubmission/set method.
···
605
602
@param on_success_destroy_email Emails to destroy after successful submission
606
603
@return Ok with set arguments, or Error with validation message *)
607
604
val create :
608
-
account_id:id ->
605
+
account_id:Jmap.Id.t ->
609
606
?if_in_state:string ->
610
-
?create:(id * Create.t) list ->
611
-
?update:(id * Update.t) list ->
612
-
?destroy:id list ->
613
-
?on_success_destroy_email:id list ->
607
+
?create:(Jmap.Id.t * Create.t) list ->
608
+
?update:(Jmap.Id.t * Update.t) list ->
609
+
?destroy:Jmap.Id.t list ->
610
+
?on_success_destroy_email:Jmap.Id.t list ->
614
611
unit -> (t, string) result
615
612
end
616
613
···
632
629
(** Get the account ID.
633
630
@param response The set response object
634
631
@return Account ID *)
635
-
val account_id : t -> id
632
+
val account_id : t -> Jmap.Id.t
636
633
637
634
(** Get the old state string.
638
635
@param response The set response object
···
647
644
(** Get the created submissions with server-computed properties.
648
645
@param response The set response object
649
646
@return Created submissions with server-computed properties *)
650
-
val created : t -> Create.Response.t id_map
647
+
val created : t -> (string, Create.Response.t) Hashtbl.t
651
648
652
649
(** Get the updated submissions with server-computed properties.
653
650
@param response The set response object
654
651
@return Updated submissions with server-computed properties *)
655
-
val updated : t -> Update.Response.t id_map option
652
+
val updated : t -> (string, Update.Response.t) Hashtbl.t option
656
653
657
654
(** Get the destroyed submission IDs.
658
655
@param response The set response object
659
656
@return Destroyed submission IDs *)
660
-
val destroyed : t -> id list option
657
+
val destroyed : t -> Jmap.Id.t list option
661
658
662
659
(** Get the submission IDs that could not be created.
663
660
@param response The set response object
664
661
@return Submission IDs that could not be created *)
665
-
val not_created : t -> Jmap.Error.Set_error.t id_map option
662
+
val not_created : t -> (string, Jmap.Error.Set_error.t) Hashtbl.t option
666
663
667
664
(** Get the submission IDs that could not be updated.
668
665
@param response The set response object
669
666
@return Submission IDs that could not be updated *)
670
-
val not_updated : t -> Jmap.Error.Set_error.t id_map option
667
+
val not_updated : t -> (string, Jmap.Error.Set_error.t) Hashtbl.t option
671
668
672
669
(** Get the submission IDs that could not be destroyed.
673
670
@param response The set response object
674
671
@return Submission IDs that could not be destroyed *)
675
-
val not_destroyed : t -> Jmap.Error.Set_error.t id_map option
672
+
val not_destroyed : t -> (string, Jmap.Error.Set_error.t) Hashtbl.t option
676
673
end
677
674
678
675
(** {1 Filter Helper Functions} *)
···
688
685
(** Create filter for specific identity IDs.
689
686
@param ids List of identity IDs to match
690
687
@return Filter that matches submissions using any of these identities *)
691
-
val identity_ids : id list -> Jmap.Methods.Filter.t
688
+
val identity_ids : Jmap.Id.t list -> Jmap.Methods.Filter.t
692
689
693
690
(** Create filter for specific email IDs.
694
691
@param ids List of email IDs to match
695
692
@return Filter that matches submissions for any of these emails *)
696
-
val email_ids : id list -> Jmap.Methods.Filter.t
693
+
val email_ids : Jmap.Id.t list -> Jmap.Methods.Filter.t
697
694
698
695
(** Create filter for specific thread IDs.
699
696
@param ids List of thread IDs to match
700
697
@return Filter that matches submissions in any of these threads *)
701
-
val thread_ids : id list -> Jmap.Methods.Filter.t
698
+
val thread_ids : Jmap.Id.t list -> Jmap.Methods.Filter.t
702
699
703
700
(** Create filter for undo status.
704
701
@param status Undo status to match
705
702
@return Filter that matches submissions with this undo status *)
706
703
val undo_status : [`Pending | `Final | `Canceled] -> Jmap.Methods.Filter.t
707
704
708
-
(** Create filter for submissions sent before a specific date.
709
-
@param date UTC timestamp to compare against
710
-
@return Filter that matches submissions sent before this date *)
711
-
val before : utc_date -> Jmap.Methods.Filter.t
705
+
(** Create filter for submissions sent before a specific Date.t.
706
+
@param Date.t UTC timestamp to compare against
707
+
@return Filter that matches submissions sent before this Date.t *)
708
+
val before : Jmap.Date.t -> Jmap.Methods.Filter.t
712
709
713
-
(** Create filter for submissions sent after a specific date.
714
-
@param date UTC timestamp to compare against
715
-
@return Filter that matches submissions sent after this date *)
716
-
val after : utc_date -> Jmap.Methods.Filter.t
710
+
(** Create filter for submissions sent after a specific Date.t.
711
+
@param Date.t UTC timestamp to compare against
712
+
@return Filter that matches submissions sent after this Date.t *)
713
+
val after : Jmap.Date.t -> Jmap.Methods.Filter.t
717
714
718
-
(** Create filter for submissions sent within a date range.
719
-
@param after_date Start of date range
720
-
@param before_date End of date range
715
+
(** Create filter for submissions sent within a Date.t range.
716
+
@param after_date Start of Date.t range
717
+
@param before_date End of Date.t range
721
718
@return Filter that matches submissions sent within this range *)
722
-
val date_range : after_date:utc_date -> before_date:utc_date -> Jmap.Methods.Filter.t
719
+
val date_range : after_date:Jmap.Date.t -> before_date:Jmap.Date.t -> Jmap.Methods.Filter.t
723
720
end
724
721
725
722
(** {1 Sort Helper Functions} *)
+99
-67
jmap/jmap-email/thread.ml
+99
-67
jmap/jmap-email/thread.ml
···
7
7
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-3> RFC 8621, Section 3: Threads
8
8
*)
9
9
10
-
open Jmap.Types
11
10
open Jmap.Method_names
12
11
open Jmap.Methods
13
12
14
13
module Thread = struct
15
14
type t = {
16
-
id : id option;
17
-
email_ids : id list;
15
+
id : Jmap.Id.t option;
16
+
email_ids : Jmap.Id.t list;
18
17
}
19
18
20
19
let id t = t.id
···
25
24
26
25
(* JMAP_OBJECT implementation *)
27
26
let create ?id () =
28
-
{ id; email_ids = [] }
27
+
let id_opt = match id with
28
+
| None -> None
29
+
| Some id_str ->
30
+
(match Jmap.Id.of_string id_str with
31
+
| Ok jmap_id -> Some jmap_id
32
+
| Error _ -> failwith ("Invalid thread id: " ^ id_str)) in
33
+
{ id = id_opt; email_ids = [] }
29
34
30
35
let to_json_with_properties ~properties t =
31
36
let all_fields = [
32
-
("id", (match t.id with Some id -> `String id | None -> `Null));
33
-
("emailIds", `List (List.map (fun id -> `String id) t.email_ids));
37
+
("id", (match t.id with Some id -> `String (Jmap.Id.to_string id) | None -> `Null));
38
+
("emailIds", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) t.email_ids));
34
39
] in
35
40
let filtered_fields = List.filter (fun (name, _) ->
36
41
List.mem name properties
···
42
47
(* JSONABLE implementation *)
43
48
let to_json t =
44
49
`Assoc [
45
-
("id", (match t.id with Some id -> `String id | None -> `Null));
46
-
("emailIds", `List (List.map (fun id -> `String id) t.email_ids));
50
+
("id", (match t.id with Some id -> `String (Jmap.Id.to_string id) | None -> `Null));
51
+
("emailIds", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) t.email_ids));
47
52
]
48
53
49
54
let of_json json =
···
65
70
in
66
71
let id_str = get_string "id" "" in
67
72
let email_ids = get_string_list "emailIds" in
73
+
let id = if id_str = "" then None else (match Jmap.Id.of_string id_str with Ok id -> Some id | Error e -> failwith e) in
74
+
let email_ids = List.map (fun s -> match Jmap.Id.of_string s with Ok id -> id | Error e -> failwith e) email_ids in
68
75
Ok {
69
-
id = (if id_str = "" then None else Some id_str);
76
+
id;
70
77
email_ids;
71
78
}
72
79
| _ -> Error "Thread must be a JSON object"
···
79
86
let email_ids_str = match t.email_ids with
80
87
| [] -> "[]"
81
88
| ids when List.length ids <= 3 ->
82
-
"[" ^ String.concat "; " ids ^ "]"
89
+
"[" ^ String.concat "; " (List.map Jmap.Id.to_string ids) ^ "]"
83
90
| a :: b :: c :: _ ->
84
-
"[" ^ String.concat "; " [a; b; c] ^ "; ...]"
91
+
"[" ^ String.concat "; " (List.map Jmap.Id.to_string [a; b; c]) ^ "; ...]"
85
92
| ids ->
86
-
"[" ^ String.concat "; " ids ^ "]"
93
+
"[" ^ String.concat "; " (List.map Jmap.Id.to_string ids) ^ "]"
87
94
in
88
-
let id_str = match t.id with Some id -> id | None -> "(no-id)" in
95
+
let id_str = match t.id with Some id -> Jmap.Id.to_string id | None -> "(no-id)" in
89
96
Format.fprintf ppf "Thread{id=%s; emails=%d; email_ids=%s}"
90
97
id_str email_count email_ids_str
91
98
···
100
107
]
101
108
102
109
let to_string = function
103
-
| `Id -> "id"
110
+
| `Id -> "Jmap.Id.t"
104
111
| `EmailIds -> "emailIds"
105
112
106
113
let of_string = function
107
-
| "id" -> Some `Id
114
+
| "Jmap.Id.t" -> Some `Id
108
115
| "emailIds" -> Some `EmailIds
109
116
| _ -> None
110
117
···
118
125
119
126
module Query_args = struct
120
127
type t = {
121
-
account_id : id;
128
+
account_id : Jmap.Id.t;
122
129
filter : Filter.t option;
123
130
sort : Comparator.t list option;
124
131
position : int option;
125
-
anchor : id option;
132
+
anchor : Jmap.Id.t option;
126
133
anchor_offset : int option;
127
-
limit : uint option;
134
+
limit : Jmap.UInt.t option;
128
135
calculate_total : bool option;
129
136
}
130
137
···
144
151
145
152
let to_json t =
146
153
let json_fields = [
147
-
("accountId", `String t.account_id);
154
+
("accountId", `String (Jmap.Id.to_string t.account_id));
148
155
] in
149
156
let json_fields = match t.filter with
150
157
| None -> json_fields
···
160
167
in
161
168
let json_fields = match t.anchor with
162
169
| None -> json_fields
163
-
| Some anchor -> ("anchor", `String anchor) :: json_fields
170
+
| Some anchor -> ("anchor", `String (Jmap.Id.to_string anchor)) :: json_fields
164
171
in
165
172
let json_fields = match t.anchor_offset with
166
173
| None -> json_fields
···
168
175
in
169
176
let json_fields = match t.limit with
170
177
| None -> json_fields
171
-
| Some limit -> ("limit", `Int limit) :: json_fields
178
+
| Some limit -> ("limit", `Int (Jmap.UInt.to_int limit)) :: json_fields
172
179
in
173
180
let json_fields = match t.calculate_total with
174
181
| None -> json_fields
···
181
188
match json with
182
189
| `Assoc fields ->
183
190
let account_id = match List.assoc_opt "accountId" fields with
184
-
| Some (`String id) -> id
191
+
| Some (`String id) -> (match Jmap.Id.of_string id with
192
+
| Ok id -> id
193
+
| Error err -> failwith ("Invalid accountId: " ^ err))
185
194
| _ -> failwith "Missing or invalid accountId"
186
195
in
187
196
let filter = match List.assoc_opt "filter" fields with
···
197
206
| exn -> Error (Printexc.to_string exn)
198
207
199
208
let pp fmt t =
200
-
Format.fprintf fmt "Thread.Query_args{account=%s}" t.account_id
209
+
Format.fprintf fmt "Thread.Query_args{account=%s}" (Jmap.Id.to_string t.account_id)
201
210
202
211
let pp_hum fmt t = pp fmt t
203
212
···
208
217
209
218
module Query_response = struct
210
219
type t = {
211
-
account_id : id;
220
+
account_id : Jmap.Id.t;
212
221
query_state : string;
213
222
can_calculate_changes : bool;
214
223
position : int;
215
-
ids : id list;
216
-
total : uint option;
217
-
limit : uint option;
224
+
ids : Jmap.Id.t list;
225
+
total : Jmap.UInt.t option;
226
+
limit : Jmap.UInt.t option;
218
227
}
219
228
220
229
let account_id t = t.account_id
···
232
241
233
242
let to_json t =
234
243
let fields = [
235
-
("accountId", `String t.account_id);
244
+
("accountId", `String (Jmap.Id.to_string t.account_id));
236
245
("queryState", `String t.query_state);
237
246
("canCalculateChanges", `Bool t.can_calculate_changes);
238
247
("position", `Int t.position);
239
-
("ids", `List (List.map (fun id -> `String id) t.ids));
248
+
("ids", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) t.ids));
240
249
] in
241
250
let fields = match t.total with
242
-
| Some total -> ("total", `Int total) :: fields
251
+
| Some total -> ("total", `Int (Jmap.UInt.to_int total)) :: fields
243
252
| None -> fields
244
253
in
245
254
let fields = match t.limit with
246
-
| Some limit -> ("limit", `Int limit) :: fields
255
+
| Some limit -> ("limit", `Int (Jmap.UInt.to_int limit)) :: fields
247
256
| None -> fields
248
257
in
249
258
`Assoc fields
···
253
262
match json with
254
263
| `Assoc fields ->
255
264
let account_id = match List.assoc_opt "accountId" fields with
256
-
| Some (`String id) -> id
265
+
| Some (`String id_str) -> (match Jmap.Id.of_string id_str with
266
+
| Ok id -> id
267
+
| Error _ -> failwith ("Invalid accountId: " ^ id_str))
257
268
| _ -> failwith "Missing or invalid accountId"
258
269
in
259
270
Ok { account_id; query_state = ""; can_calculate_changes = false;
···
265
276
266
277
let pp fmt t =
267
278
Format.fprintf fmt "Thread.Query_response{account=%s;ids=%d}"
268
-
t.account_id (List.length t.ids)
279
+
(Jmap.Id.to_string t.account_id) (List.length t.ids)
269
280
270
281
let pp_hum fmt t = pp fmt t
271
282
···
276
287
277
288
module Get_args = struct
278
289
type t = {
279
-
account_id : id;
280
-
ids : id list option;
290
+
account_id : Jmap.Id.t;
291
+
ids : Jmap.Id.t list option;
281
292
properties : string list option;
282
293
}
283
294
···
290
301
291
302
let to_json t =
292
303
let json_fields = [
293
-
("accountId", `String t.account_id);
304
+
("accountId", `String (Jmap.Id.to_string t.account_id));
294
305
] in
295
306
let json_fields = match t.ids with
296
307
| None -> json_fields
297
-
| Some ids -> ("ids", `List (List.map (fun id -> `String id) ids)) :: json_fields
308
+
| Some ids -> ("ids", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) ids)) :: json_fields
298
309
in
299
310
let json_fields = match t.properties with
300
311
| None -> json_fields
···
307
318
match json with
308
319
| `Assoc fields ->
309
320
let account_id = match List.assoc_opt "accountId" fields with
310
-
| Some (`String id) -> id
321
+
| Some (`String id_str) -> (match Jmap.Id.of_string id_str with
322
+
| Ok id -> id
323
+
| Error _ -> failwith ("Invalid accountId: " ^ id_str))
311
324
| _ -> failwith "Missing or invalid accountId"
312
325
in
313
326
Ok { account_id; ids = None; properties = None }
···
317
330
| exn -> Error (Printexc.to_string exn)
318
331
319
332
let pp fmt t =
320
-
Format.fprintf fmt "Thread.Get_args{account=%s}" t.account_id
333
+
Format.fprintf fmt "Thread.Get_args{account=%s}" (Jmap.Id.to_string t.account_id)
321
334
322
335
let pp_hum fmt t = pp fmt t
323
336
···
328
341
329
342
module Get_response = struct
330
343
type t = {
331
-
account_id : id;
344
+
account_id : Jmap.Id.t;
332
345
state : string;
333
346
list : Thread.t list;
334
-
not_found : id list;
347
+
not_found : Jmap.Id.t list;
335
348
}
336
349
337
350
let account_id t = t.account_id
···
344
357
345
358
let to_json t =
346
359
`Assoc [
347
-
("accountId", `String t.account_id);
360
+
("accountId", `String (Jmap.Id.to_string t.account_id));
348
361
("state", `String t.state);
349
362
("list", `List (List.map Thread.to_json t.list));
350
-
("notFound", `List (List.map (fun id -> `String id) t.not_found));
363
+
("notFound", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) t.not_found));
351
364
]
352
365
353
366
let of_json json =
···
355
368
match json with
356
369
| `Assoc fields ->
357
370
let account_id = match List.assoc_opt "accountId" fields with
358
-
| Some (`String id) -> id
371
+
| Some (`String id_str) -> (match Jmap.Id.of_string id_str with
372
+
| Ok id -> id
373
+
| Error _ -> failwith ("Invalid accountId: " ^ id_str))
359
374
| _ -> failwith "Missing or invalid accountId"
360
375
in
361
376
Ok { account_id; state = ""; list = []; not_found = [] }
···
366
381
367
382
let pp fmt t =
368
383
Format.fprintf fmt "Thread.Get_response{account=%s;threads=%d}"
369
-
t.account_id (List.length t.list)
384
+
(Jmap.Id.to_string t.account_id) (List.length t.list)
370
385
371
386
let pp_hum fmt t = pp fmt t
372
387
···
375
390
376
391
module Changes_args = struct
377
392
type t = {
378
-
account_id : id;
393
+
account_id : Jmap.Id.t;
379
394
since_state : string;
380
-
max_changes : uint option;
395
+
max_changes : Jmap.UInt.t option;
381
396
}
382
397
383
398
let account_id t = t.account_id
···
388
403
{ account_id; since_state; max_changes }
389
404
390
405
let to_json t =
391
-
let fields = [("accountId", `String t.account_id); ("sinceState", `String t.since_state)] in
406
+
let fields = [("accountId", `String (Jmap.Id.to_string t.account_id)); ("sinceState", `String t.since_state)] in
392
407
let fields = match t.max_changes with
393
408
| None -> fields
394
-
| Some n -> ("maxChanges", `Int n) :: fields
409
+
| Some n -> ("maxChanges", `Int (Jmap.UInt.to_int n)) :: fields
395
410
in
396
411
`Assoc fields
397
412
···
400
415
match json with
401
416
| `Assoc fields ->
402
417
let account_id = match List.assoc_opt "accountId" fields with
403
-
| Some (`String id) -> id
418
+
| Some (`String id_str) -> (match Jmap.Id.of_string id_str with
419
+
| Ok id -> id
420
+
| Error _ -> failwith ("Invalid accountId: " ^ id_str))
404
421
| _ -> failwith "Missing or invalid accountId"
405
422
in
406
423
Ok { account_id; since_state = ""; max_changes = None }
···
411
428
412
429
let pp fmt t =
413
430
Format.fprintf fmt "Thread.Changes_args{account=%s;since=%s}"
414
-
t.account_id t.since_state
431
+
(Jmap.Id.to_string t.account_id) t.since_state
415
432
416
433
let pp_hum fmt t = pp fmt t
417
434
···
422
439
423
440
module Changes_response = struct
424
441
type t = {
425
-
account_id : id;
442
+
account_id : Jmap.Id.t;
426
443
old_state : string;
427
444
new_state : string;
428
445
has_more_changes : bool;
429
-
created : id list;
430
-
updated : id list;
431
-
destroyed : id list;
446
+
created : Jmap.Id.t list;
447
+
updated : Jmap.Id.t list;
448
+
destroyed : Jmap.Id.t list;
432
449
}
433
450
434
451
let account_id t = t.account_id
···
453
470
@return JSON object with accountId, states, hasMoreChanges, and change arrays *)
454
471
let to_json t =
455
472
`Assoc [
456
-
("accountId", `String t.account_id);
473
+
("accountId", `String (Jmap.Id.to_string t.account_id));
457
474
("oldState", `String t.old_state);
458
475
("newState", `String t.new_state);
459
476
("hasMoreChanges", `Bool t.has_more_changes);
460
-
("created", `List (List.map (fun id -> `String id) t.created));
461
-
("updated", `List (List.map (fun id -> `String id) t.updated));
462
-
("destroyed", `List (List.map (fun id -> `String id) t.destroyed));
477
+
("created", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) t.created));
478
+
("updated", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) t.updated));
479
+
("destroyed", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) t.destroyed));
463
480
]
464
481
465
482
(** Parse Thread/changes response from JSON.
···
472
489
let of_json json =
473
490
try
474
491
let open Yojson.Safe.Util in
475
-
let account_id = json |> member "accountId" |> to_string in
492
+
let account_id_str = json |> member "accountId" |> to_string in
493
+
let account_id = match Jmap.Id.of_string account_id_str with
494
+
| Ok id -> id
495
+
| Error _ -> failwith ("Invalid accountId: " ^ account_id_str) in
476
496
let old_state = json |> member "oldState" |> to_string in
477
497
let new_state = json |> member "newState" |> to_string in
478
498
let has_more_changes = json |> member "hasMoreChanges" |> to_bool in
479
-
let created = json |> member "created" |> to_list |> List.map to_string in
480
-
let updated = json |> member "updated" |> to_list |> List.map to_string in
481
-
let destroyed = json |> member "destroyed" |> to_list |> List.map to_string in
499
+
let created = json |> member "created" |> to_list |> List.map (fun item ->
500
+
let id_str = to_string item in
501
+
match Jmap.Id.of_string id_str with
502
+
| Ok id -> id
503
+
| Error _ -> failwith ("Invalid created id: " ^ id_str)) in
504
+
let updated = json |> member "updated" |> to_list |> List.map (fun item ->
505
+
let id_str = to_string item in
506
+
match Jmap.Id.of_string id_str with
507
+
| Ok id -> id
508
+
| Error _ -> failwith ("Invalid updated id: " ^ id_str)) in
509
+
let destroyed = json |> member "destroyed" |> to_list |> List.map (fun item ->
510
+
let id_str = to_string item in
511
+
match Jmap.Id.of_string id_str with
512
+
| Ok id -> id
513
+
| Error _ -> failwith ("Invalid destroyed id: " ^ id_str)) in
482
514
Ok {
483
515
account_id;
484
516
old_state;
···
493
525
| exn -> Error ("Thread Changes_response JSON parse error: " ^ Printexc.to_string exn)
494
526
495
527
let pp fmt t =
496
-
Format.fprintf fmt "Thread.Changes_response{account=%s}" t.account_id
528
+
Format.fprintf fmt "Thread.Changes_response{account=%s}" (Jmap.Id.to_string t.account_id)
497
529
498
530
let pp_hum fmt t = pp fmt t
499
531
···
503
535
end
504
536
505
537
let filter_has_email email_id =
506
-
Filter.property_equals "emailIds" (`String email_id)
538
+
Filter.property_equals "emailIds" (`String (Jmap.Id.to_string email_id))
507
539
508
540
let filter_from sender =
509
541
Filter.text_contains "from" sender
···
515
547
Filter.text_contains "subject" subject
516
548
517
549
let filter_before date =
518
-
Filter.property_lt "receivedAt" (`Float date)
550
+
Filter.property_lt "receivedAt" (`Float (Jmap.Date.to_timestamp date))
519
551
520
552
let filter_after date =
521
-
Filter.property_gt "receivedAt" (`Float date)
553
+
Filter.property_gt "receivedAt" (`Float (Jmap.Date.to_timestamp date))
+54
-55
jmap/jmap-email/thread.mli
+54
-55
jmap/jmap-email/thread.mli
···
12
12
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-3> RFC 8621, Section 3: Threads
13
13
*)
14
14
15
-
open Jmap.Types
16
15
open Jmap.Methods
17
16
18
17
(** Thread object representation.
···
35
34
include Jmap_sigs.PRINTABLE with type t := t
36
35
37
36
(** JMAP object interface for property selection and object creation *)
38
-
include Jmap_sigs.JMAP_OBJECT with type t := t and type id_type := id
37
+
include Jmap_sigs.JMAP_OBJECT with type t := t and type id_type := string
39
38
40
39
(** Get the server-assigned thread identifier.
41
40
@return Unique thread ID (Some for all persisted threads, None only for unsaved objects) *)
42
-
val id : t -> id option
41
+
val id : t -> Jmap.Id.t option
43
42
44
43
(** Get the list of email IDs belonging to this thread.
45
44
@return List of email IDs in conversation order *)
46
-
val email_ids : t -> id list
45
+
val email_ids : t -> Jmap.Id.t list
47
46
48
47
(** Create a new Thread object.
49
-
@param id Server-assigned thread identifier
48
+
@param Jmap.Id.t Server-assigned thread identifier
50
49
@param email_ids List of email IDs in the thread
51
50
@return New thread object *)
52
-
val v : id:id -> email_ids:id list -> t
51
+
val v : id:Jmap.Id.t -> email_ids:Jmap.Id.t list -> t
53
52
end
54
53
55
54
···
76
75
include Jmap_sigs.JSONABLE with type t := t
77
76
78
77
(** JMAP method arguments interface *)
79
-
include Jmap_sigs.METHOD_ARGS with type t := t and type account_id := id
78
+
include Jmap_sigs.METHOD_ARGS with type t := t and type account_id := string
80
79
81
80
(** Get the account ID for the operation.
82
81
@return Account identifier where threads will be queried *)
83
-
val account_id : t -> id
82
+
val account_id : t -> Jmap.Id.t
84
83
85
84
(** Validate query arguments according to JMAP method constraints.
86
85
@param t Query arguments to validate
···
105
104
106
105
(** Get the anchor thread ID for relative positioning.
107
106
@return Thread ID to anchor results from, or None *)
108
-
val anchor : t -> id option
107
+
val anchor : t -> Jmap.Id.t option
109
108
110
109
(** Get the offset from the anchor position.
111
110
@return Number of positions to offset from anchor *)
···
113
112
114
113
(** Get the maximum number of results to return.
115
114
@return Result limit, or None for server default *)
116
-
val limit : t -> uint option
115
+
val limit : t -> Jmap.UInt.t option
117
116
118
117
(** Check if total count should be calculated.
119
118
@return true to calculate total result count *)
···
130
129
@param calculate_total Optional flag to calculate totals
131
130
@return Thread/query arguments object *)
132
131
val v :
133
-
account_id:id ->
132
+
account_id:Jmap.Id.t ->
134
133
?filter:Filter.t ->
135
134
?sort:Comparator.t list ->
136
135
?position:int ->
137
-
?anchor:id ->
136
+
?anchor:Jmap.Id.t ->
138
137
?anchor_offset:int ->
139
-
?limit:uint ->
138
+
?limit:Jmap.UInt.t ->
140
139
?calculate_total:bool ->
141
140
unit -> t
142
141
···
161
160
include Jmap_sigs.JSONABLE with type t := t
162
161
163
162
(** JMAP method response interface *)
164
-
include Jmap_sigs.METHOD_RESPONSE with type t := t and type account_id := id and type state := string
163
+
include Jmap_sigs.METHOD_RESPONSE with type t := t and type account_id := string and type state := string
165
164
166
165
(** Get the account ID from the response.
167
166
@return Account identifier where threads were queried *)
168
-
val account_id : t -> id
167
+
val account_id : t -> Jmap.Id.t
169
168
170
169
(** Get the query state string for change tracking.
171
170
@return State string for use in queryChanges *)
···
189
188
190
189
(** Get the list of matching thread IDs.
191
190
@return Ordered list of thread IDs matching the query *)
192
-
val ids : t -> id list
191
+
val ids : t -> Jmap.Id.t list
193
192
194
193
(** Get the total number of matching threads.
195
194
@return Total result count if calculateTotal was requested *)
196
-
val total : t -> uint option
195
+
val total : t -> Jmap.UInt.t option
197
196
198
197
(** Get the limit that was applied to the results.
199
198
@return Number of results returned, or None if no limit *)
200
-
val limit : t -> uint option
199
+
val limit : t -> Jmap.UInt.t option
201
200
202
201
(** Create Thread/query response.
203
202
@param account_id Account where threads were queried
···
209
208
@param limit Optional result limit applied
210
209
@return Thread/query response object *)
211
210
val v :
212
-
account_id:id ->
211
+
account_id:Jmap.Id.t ->
213
212
query_state:string ->
214
213
can_calculate_changes:bool ->
215
214
position:int ->
216
-
ids:id list ->
217
-
?total:uint ->
218
-
?limit:uint ->
215
+
ids:Jmap.Id.t list ->
216
+
?total:Jmap.UInt.t ->
217
+
?limit:Jmap.UInt.t ->
219
218
unit -> t
220
219
end
221
220
···
234
233
include Jmap_sigs.JSONABLE with type t := t
235
234
236
235
(** JMAP method arguments interface *)
237
-
include Jmap_sigs.METHOD_ARGS with type t := t and type account_id := id
236
+
include Jmap_sigs.METHOD_ARGS with type t := t and type account_id := string
238
237
239
238
(** Get the account ID for the operation.
240
239
@return Account identifier where threads will be retrieved *)
241
-
val account_id : t -> id
240
+
val account_id : t -> Jmap.Id.t
242
241
243
242
(** Validate get arguments according to JMAP method constraints.
244
243
@param t Get arguments to validate
···
251
250
252
251
(** Get the specific thread IDs to retrieve.
253
252
@return List of thread IDs, or None to retrieve all threads *)
254
-
val ids : t -> id list option
253
+
val ids : t -> Jmap.Id.t list option
255
254
256
255
(** Get the properties to include in the response.
257
256
@return List of property names, or None for all properties *)
···
263
262
@param properties Optional list of properties to include
264
263
@return Thread/get arguments object *)
265
264
val v :
266
-
account_id:id ->
267
-
?ids:id list ->
265
+
account_id:Jmap.Id.t ->
266
+
?ids:Jmap.Id.t list ->
268
267
?properties:string list ->
269
268
unit -> t
270
269
···
289
288
include Jmap_sigs.JSONABLE with type t := t
290
289
291
290
(** JMAP method response interface *)
292
-
include Jmap_sigs.METHOD_RESPONSE with type t := t and type account_id := id and type state := string
291
+
include Jmap_sigs.METHOD_RESPONSE with type t := t and type account_id := string and type state := string
293
292
294
293
(** Get the account ID from the response.
295
294
@return Account identifier where threads were retrieved *)
296
-
val account_id : t -> id
295
+
val account_id : t -> Jmap.Id.t
297
296
298
297
(** Get the current state string for change tracking.
299
298
@return State string for use in Thread/changes *)
···
309
308
310
309
(** Get the list of thread IDs that were not found.
311
310
@return List of requested IDs that don't exist *)
312
-
val not_found : t -> id list
311
+
val not_found : t -> Jmap.Id.t list
313
312
314
313
(** Create Thread/get response.
315
314
@param account_id Account where threads were retrieved
···
318
317
@param not_found IDs that were not found
319
318
@return Thread/get response object *)
320
319
val v :
321
-
account_id:id ->
320
+
account_id:Jmap.Id.t ->
322
321
state:string ->
323
322
list:Thread.t list ->
324
-
not_found:id list ->
323
+
not_found:Jmap.Id.t list ->
325
324
unit -> t
326
325
end
327
326
···
341
340
include Jmap_sigs.JSONABLE with type t := t
342
341
343
342
(** JMAP method arguments interface *)
344
-
include Jmap_sigs.METHOD_ARGS with type t := t and type account_id := id
343
+
include Jmap_sigs.METHOD_ARGS with type t := t and type account_id := string
345
344
346
345
(** Get the account ID for the operation.
347
346
@return Account identifier where thread changes are tracked *)
348
-
val account_id : t -> id
347
+
val account_id : t -> Jmap.Id.t
349
348
350
349
(** Validate changes arguments according to JMAP method constraints.
351
350
@param t Changes arguments to validate
···
362
361
363
362
(** Get the maximum number of changes to return.
364
363
@return Change limit, or None for server default *)
365
-
val max_changes : t -> uint option
364
+
val max_changes : t -> Jmap.UInt.t option
366
365
367
366
(** Create Thread/changes arguments.
368
367
@param account_id Account where thread changes are tracked
···
370
369
@param max_changes Optional limit on number of changes returned
371
370
@return Thread/changes arguments object *)
372
371
val v :
373
-
account_id:id ->
372
+
account_id:Jmap.Id.t ->
374
373
since_state:string ->
375
-
?max_changes:uint ->
374
+
?max_changes:Jmap.UInt.t ->
376
375
unit -> t
377
376
end
378
377
···
392
391
include Jmap_sigs.JSONABLE with type t := t
393
392
394
393
(** JMAP method response interface *)
395
-
include Jmap_sigs.METHOD_RESPONSE with type t := t and type account_id := id and type state := string
394
+
include Jmap_sigs.METHOD_RESPONSE with type t := t and type account_id := string and type state := string
396
395
397
396
(** Get the account ID from the response.
398
397
@return Account identifier where changes occurred *)
399
-
val account_id : t -> id
398
+
val account_id : t -> Jmap.Id.t
400
399
401
400
(** Get the old state string that was compared against.
402
401
@return The since_state parameter from the request *)
···
420
419
421
420
(** Get the list of newly created thread IDs.
422
421
@return Thread IDs that were created since the old state *)
423
-
val created : t -> id list
422
+
val created : t -> Jmap.Id.t list
424
423
425
424
(** Get the list of updated thread IDs.
426
425
@return Thread IDs whose email lists changed since the old state *)
427
-
val updated : t -> id list
426
+
val updated : t -> Jmap.Id.t list
428
427
429
428
(** Get the list of destroyed thread IDs.
430
429
@return Thread IDs that were deleted since the old state *)
431
-
val destroyed : t -> id list
430
+
val destroyed : t -> Jmap.Id.t list
432
431
433
432
(** Create Thread/changes response.
434
433
@param account_id Account where changes occurred
···
440
439
@param destroyed List of destroyed thread IDs
441
440
@return Thread/changes response object *)
442
441
val v :
443
-
account_id:id ->
442
+
account_id:Jmap.Id.t ->
444
443
old_state:string ->
445
444
new_state:string ->
446
445
has_more_changes:bool ->
447
-
created:id list ->
448
-
updated:id list ->
449
-
destroyed:id list ->
446
+
created:Jmap.Id.t list ->
447
+
updated:Jmap.Id.t list ->
448
+
destroyed:Jmap.Id.t list ->
450
449
unit -> t
451
450
end
452
451
···
461
460
(** Create a filter to find threads containing a specific email.
462
461
@param email_id The email ID to search for in threads
463
462
@return Filter condition for Email/query to find related emails *)
464
-
val filter_has_email : id -> Filter.t
463
+
val filter_has_email : Jmap.Id.t -> Filter.t
465
464
466
465
(** Create a filter to find threads containing emails from a sender.
467
466
@param sender Email address or name to search for in From fields
···
478
477
@return Filter condition for finding threads containing the subject text *)
479
478
val filter_subject : string -> Filter.t
480
479
481
-
(** Create a filter to find threads with emails received before a date.
482
-
@param date Cutoff date for filtering
483
-
@return Filter condition for threads with emails before the date *)
484
-
val filter_before : date -> Filter.t
480
+
(** Create a filter to find threads with emails received before a Date.t.
481
+
@param Date.t Cutoff Date.t for filtering
482
+
@return Filter condition for threads with emails before the Date.t *)
483
+
val filter_before : Jmap.Date.t -> Filter.t
485
484
486
-
(** Create a filter to find threads with emails received after a date.
487
-
@param date Start date for filtering
488
-
@return Filter condition for threads with emails after the date *)
489
-
val filter_after : date -> Filter.t
485
+
(** Create a filter to find threads with emails received after a Date.t.
486
+
@param Date.t Start Date.t for filtering
487
+
@return Filter condition for threads with emails after the Date.t *)
488
+
val filter_after : Jmap.Date.t -> Filter.t
490
489
491
490
(** {1 Property System} *)
492
491
-807
jmap/jmap-email/types.ml
-807
jmap/jmap-email/types.ml
···
1
-
(** JMAP Mail Types Implementation.
2
-
3
-
This module implements the common types for JMAP Mail as specified in RFC 8621.
4
-
It provides concrete implementations of email addresses, body parts, keywords,
5
-
and email objects with their associated operations.
6
-
7
-
@see <https://www.rfc-editor.org/rfc/rfc8621.html> RFC 8621: JMAP for Mail
8
-
*)
9
-
10
-
open Jmap.Types
11
-
12
-
module Email_address = struct
13
-
type t = {
14
-
name : string option;
15
-
email : string;
16
-
}
17
-
18
-
let name t = t.name
19
-
let email t = t.email
20
-
21
-
let v ?name ~email () = { name; email }
22
-
23
-
let to_json t =
24
-
let fields = [("email", `String t.email)] in
25
-
let fields = match t.name with
26
-
| Some name -> ("name", `String name) :: fields
27
-
| None -> fields
28
-
in
29
-
`Assoc fields
30
-
31
-
let of_json json =
32
-
try
33
-
match json with
34
-
| `Assoc fields ->
35
-
let email = match List.assoc_opt "email" fields with
36
-
| Some (`String email) -> email
37
-
| _ -> failwith "Email_address.of_json: missing or invalid email field"
38
-
in
39
-
let name = match List.assoc_opt "name" fields with
40
-
| Some (`String name) -> Some name
41
-
| Some `Null | None -> None
42
-
| _ -> failwith "Email_address.of_json: invalid name field"
43
-
in
44
-
Ok { name; email }
45
-
| _ -> failwith "Email_address.of_json: expected JSON object"
46
-
with
47
-
| Failure msg -> Error msg
48
-
| exn -> Error (Printexc.to_string exn)
49
-
50
-
let pp fmt t =
51
-
match t.name with
52
-
| Some name -> Format.fprintf fmt "%s <%s>" name t.email
53
-
| None -> Format.fprintf fmt "%s" t.email
54
-
55
-
let pp_hum fmt t = pp fmt t
56
-
end
57
-
58
-
module Email_address_group = struct
59
-
type t = {
60
-
name : string option;
61
-
addresses : Email_address.t list;
62
-
}
63
-
64
-
let name t = t.name
65
-
let addresses t = t.addresses
66
-
67
-
let v ?name ~addresses () = { name; addresses }
68
-
end
69
-
70
-
module Email_header = struct
71
-
type t = {
72
-
name : string;
73
-
value : string;
74
-
}
75
-
76
-
let name t = t.name
77
-
let value t = t.value
78
-
79
-
let v ~name ~value () = { name; value }
80
-
81
-
let to_json t =
82
-
`Assoc [
83
-
("name", `String t.name);
84
-
("value", `String t.value);
85
-
]
86
-
87
-
let of_json = function
88
-
| `Assoc fields ->
89
-
let name = match List.assoc_opt "name" fields with
90
-
| Some (`String name) -> name
91
-
| _ -> failwith "Email_header.of_json: missing or invalid name field"
92
-
in
93
-
let value = match List.assoc_opt "value" fields with
94
-
| Some (`String value) -> value
95
-
| _ -> failwith "Email_header.of_json: missing or invalid value field"
96
-
in
97
-
{ name; value }
98
-
| _ -> failwith "Email_header.of_json: expected JSON object"
99
-
end
100
-
101
-
module Email_body_part = struct
102
-
type t = {
103
-
id : string option;
104
-
blob_id : id option;
105
-
size : uint;
106
-
headers : Email_header.t list;
107
-
name : string option;
108
-
mime_type : string;
109
-
charset : string option;
110
-
disposition : string option;
111
-
cid : string option;
112
-
language : string list option;
113
-
location : string option;
114
-
sub_parts : t list option;
115
-
other_headers : Yojson.Safe.t string_map;
116
-
}
117
-
118
-
let id t = t.id
119
-
let blob_id t = t.blob_id
120
-
let size t = t.size
121
-
let headers t = t.headers
122
-
let name t = t.name
123
-
let mime_type t = t.mime_type
124
-
let charset t = t.charset
125
-
let disposition t = t.disposition
126
-
let cid t = t.cid
127
-
let language t = t.language
128
-
let location t = t.location
129
-
let sub_parts t = t.sub_parts
130
-
let other_headers t = t.other_headers
131
-
132
-
let v ?id ?blob_id ~size ~headers ?name ~mime_type ?charset
133
-
?disposition ?cid ?language ?location ?sub_parts
134
-
?(other_headers = Hashtbl.create 0) () =
135
-
{ id; blob_id; size; headers; name; mime_type; charset;
136
-
disposition; cid; language; location; sub_parts; other_headers }
137
-
138
-
let rec to_json t =
139
-
let fields = [
140
-
("size", `Int t.size);
141
-
("headers", `List (List.map Email_header.to_json t.headers));
142
-
("type", `String t.mime_type);
143
-
] in
144
-
let fields = match t.id with
145
-
| Some id -> ("partId", `String id) :: fields
146
-
| None -> fields
147
-
in
148
-
let fields = match t.blob_id with
149
-
| Some blob_id -> ("blobId", `String blob_id) :: fields
150
-
| None -> fields
151
-
in
152
-
let fields = match t.name with
153
-
| Some name -> ("name", `String name) :: fields
154
-
| None -> fields
155
-
in
156
-
let fields = match t.charset with
157
-
| Some charset -> ("charset", `String charset) :: fields
158
-
| None -> fields
159
-
in
160
-
let fields = match t.disposition with
161
-
| Some disposition -> ("disposition", `String disposition) :: fields
162
-
| None -> fields
163
-
in
164
-
let fields = match t.cid with
165
-
| Some cid -> ("cid", `String cid) :: fields
166
-
| None -> fields
167
-
in
168
-
let fields = match t.language with
169
-
| Some langs -> ("language", `List (List.map (fun l -> `String l) langs)) :: fields
170
-
| None -> fields
171
-
in
172
-
let fields = match t.location with
173
-
| Some location -> ("location", `String location) :: fields
174
-
| None -> fields
175
-
in
176
-
let fields = match t.sub_parts with
177
-
| Some sub_parts -> ("subParts", `List (List.map to_json sub_parts)) :: fields
178
-
| None -> fields
179
-
in
180
-
let fields = Hashtbl.fold (fun k v acc -> (k, v) :: acc) t.other_headers fields in
181
-
`Assoc fields
182
-
183
-
let rec of_json json =
184
-
match json with
185
-
| `Assoc fields ->
186
-
let size = match List.assoc_opt "size" fields with
187
-
| Some (`Int size) -> size
188
-
| _ -> failwith "Email_body_part.of_json: missing or invalid size field"
189
-
in
190
-
let mime_type = match List.assoc_opt "type" fields with
191
-
| Some (`String mime_type) -> mime_type
192
-
| _ -> failwith "Email_body_part.of_json: missing or invalid type field"
193
-
in
194
-
let headers = match List.assoc_opt "headers" fields with
195
-
| Some (`List header_list) -> List.map Email_header.of_json header_list
196
-
| _ -> failwith "Email_body_part.of_json: missing or invalid headers field"
197
-
in
198
-
let id = match List.assoc_opt "partId" fields with
199
-
| Some (`String id) -> Some id
200
-
| Some `Null | None -> None
201
-
| _ -> failwith "Email_body_part.of_json: invalid partId field"
202
-
in
203
-
let blob_id = match List.assoc_opt "blobId" fields with
204
-
| Some (`String blob_id) -> Some blob_id
205
-
| Some `Null | None -> None
206
-
| _ -> failwith "Email_body_part.of_json: invalid blobId field"
207
-
in
208
-
let name = match List.assoc_opt "name" fields with
209
-
| Some (`String name) -> Some name
210
-
| Some `Null | None -> None
211
-
| _ -> failwith "Email_body_part.of_json: invalid name field"
212
-
in
213
-
let charset = match List.assoc_opt "charset" fields with
214
-
| Some (`String charset) -> Some charset
215
-
| Some `Null | None -> None
216
-
| _ -> failwith "Email_body_part.of_json: invalid charset field"
217
-
in
218
-
let disposition = match List.assoc_opt "disposition" fields with
219
-
| Some (`String disposition) -> Some disposition
220
-
| Some `Null | None -> None
221
-
| _ -> failwith "Email_body_part.of_json: invalid disposition field"
222
-
in
223
-
let cid = match List.assoc_opt "cid" fields with
224
-
| Some (`String cid) -> Some cid
225
-
| Some `Null | None -> None
226
-
| _ -> failwith "Email_body_part.of_json: invalid cid field"
227
-
in
228
-
let language = match List.assoc_opt "language" fields with
229
-
| Some (`List lang_list) ->
230
-
Some (List.map (function
231
-
| `String l -> l
232
-
| _ -> failwith "Email_body_part.of_json: invalid language list item"
233
-
) lang_list)
234
-
| Some `Null | None -> None
235
-
| _ -> failwith "Email_body_part.of_json: invalid language field"
236
-
in
237
-
let location = match List.assoc_opt "location" fields with
238
-
| Some (`String location) -> Some location
239
-
| Some `Null | None -> None
240
-
| _ -> failwith "Email_body_part.of_json: invalid location field"
241
-
in
242
-
let sub_parts = match List.assoc_opt "subParts" fields with
243
-
| Some (`List sub_part_list) -> Some (List.map of_json sub_part_list)
244
-
| Some `Null | None -> None
245
-
| _ -> failwith "Email_body_part.of_json: invalid subParts field"
246
-
in
247
-
let other_headers = Hashtbl.create 0 in
248
-
let standard_fields = [
249
-
"partId"; "blobId"; "size"; "headers"; "name"; "type";
250
-
"charset"; "disposition"; "cid"; "language"; "location"; "subParts"
251
-
] in
252
-
List.iter (fun (k, v) ->
253
-
if not (List.mem k standard_fields) then
254
-
Hashtbl.add other_headers k v
255
-
) fields;
256
-
{ id; blob_id; size; headers; name; mime_type; charset;
257
-
disposition; cid; language; location; sub_parts; other_headers }
258
-
| _ -> failwith "Email_body_part.of_json: expected JSON object"
259
-
end
260
-
261
-
module Email_body_value = struct
262
-
type t = {
263
-
value : string;
264
-
has_encoding_problem : bool;
265
-
is_truncated : bool;
266
-
}
267
-
268
-
let value t = t.value
269
-
let has_encoding_problem t = t.has_encoding_problem
270
-
let is_truncated t = t.is_truncated
271
-
272
-
let v ~value ?(encoding_problem = false) ?(truncated = false) () =
273
-
{ value; has_encoding_problem = encoding_problem; is_truncated = truncated }
274
-
end
275
-
276
-
module Keywords = struct
277
-
type keyword =
278
-
| Draft
279
-
| Seen
280
-
| Flagged
281
-
| Answered
282
-
| Forwarded
283
-
| Phishing
284
-
| Junk
285
-
| NotJunk
286
-
| Notify
287
-
| Muted
288
-
| Followed
289
-
| Memo
290
-
| HasMemo
291
-
| Autosent
292
-
| Unsubscribed
293
-
| CanUnsubscribe
294
-
| Imported
295
-
| IsTrusted
296
-
| MaskedEmail
297
-
| New
298
-
| MailFlagBit0
299
-
| MailFlagBit1
300
-
| MailFlagBit2
301
-
| Custom of string
302
-
303
-
type t = keyword list
304
-
305
-
let is_draft t = List.mem Draft t
306
-
let is_seen t = List.mem Seen t
307
-
let is_unread t = not (is_seen t) && not (is_draft t)
308
-
let is_flagged t = List.mem Flagged t
309
-
let is_answered t = List.mem Answered t
310
-
let is_forwarded t = List.mem Forwarded t
311
-
let is_phishing t = List.mem Phishing t
312
-
let is_junk t = List.mem Junk t
313
-
let is_not_junk t = List.mem NotJunk t
314
-
315
-
let has_keyword t kw =
316
-
List.exists (function Custom k -> k = kw | _ -> false) t
317
-
318
-
let custom_keywords t =
319
-
List.filter_map (function Custom k -> Some k | _ -> None) t
320
-
321
-
let add t kw =
322
-
if List.mem kw t then t else kw :: t
323
-
324
-
let remove t kw =
325
-
List.filter (fun k -> k <> kw) t
326
-
327
-
let empty () = []
328
-
329
-
let of_list kws = kws
330
-
331
-
let to_string = function
332
-
| Draft -> "$draft"
333
-
| Seen -> "$seen"
334
-
| Flagged -> "$flagged"
335
-
| Answered -> "$answered"
336
-
| Forwarded -> "$forwarded"
337
-
| Phishing -> "$phishing"
338
-
| Junk -> "$junk"
339
-
| NotJunk -> "$notjunk"
340
-
| Notify -> "$notify"
341
-
| Muted -> "$muted"
342
-
| Followed -> "$followed"
343
-
| Memo -> "$memo"
344
-
| HasMemo -> "$hasmemo"
345
-
| Autosent -> "$autosent"
346
-
| Unsubscribed -> "$unsubscribed"
347
-
| CanUnsubscribe -> "$canunsubscribe"
348
-
| Imported -> "$imported"
349
-
| IsTrusted -> "$istrusted"
350
-
| MaskedEmail -> "$maskedemail"
351
-
| New -> "$new"
352
-
| MailFlagBit0 -> "$MailFlagBit0"
353
-
| MailFlagBit1 -> "$MailFlagBit1"
354
-
| MailFlagBit2 -> "$MailFlagBit2"
355
-
| Custom s -> s
356
-
357
-
let of_string = function
358
-
| "$draft" -> Draft
359
-
| "$seen" -> Seen
360
-
| "$flagged" -> Flagged
361
-
| "$answered" -> Answered
362
-
| "$forwarded" -> Forwarded
363
-
| "$phishing" -> Phishing
364
-
| "$junk" -> Junk
365
-
| "$notjunk" -> NotJunk
366
-
| "$notify" -> Notify
367
-
| "$muted" -> Muted
368
-
| "$followed" -> Followed
369
-
| "$memo" -> Memo
370
-
| "$hasmemo" -> HasMemo
371
-
| "$autosent" -> Autosent
372
-
| "$unsubscribed" -> Unsubscribed
373
-
| "$canunsubscribe" -> CanUnsubscribe
374
-
| "$imported" -> Imported
375
-
| "$istrusted" -> IsTrusted
376
-
| "$maskedemail" -> MaskedEmail
377
-
| "$new" -> New
378
-
| "$MailFlagBit0" -> MailFlagBit0
379
-
| "$MailFlagBit1" -> MailFlagBit1
380
-
| "$MailFlagBit2" -> MailFlagBit2
381
-
| s -> Custom s
382
-
383
-
let to_map t =
384
-
let map = Hashtbl.create (List.length t) in
385
-
List.iter (fun kw -> Hashtbl.add map (to_string kw) true) t;
386
-
map
387
-
388
-
let to_json t =
389
-
let map_json = to_map t in
390
-
let assoc_list = Hashtbl.fold (fun k v acc -> (k, `Bool v) :: acc) map_json [] in
391
-
`Assoc assoc_list
392
-
393
-
let of_json = function
394
-
| `Assoc fields ->
395
-
List.fold_left (fun acc (key, value) ->
396
-
match value with
397
-
| `Bool true -> (of_string key) :: acc
398
-
| `Bool false -> acc (* Keywords with false value are not present *)
399
-
| _ -> failwith ("Keywords.of_json: invalid keyword value for " ^ key)
400
-
) [] fields
401
-
| _ -> failwith "Keywords.of_json: expected JSON object"
402
-
end
403
-
404
-
405
-
module Email = struct
406
-
type t = {
407
-
id : id option;
408
-
blob_id : id option;
409
-
thread_id : id option;
410
-
mailbox_ids : bool id_map option;
411
-
keywords : Keywords.t option;
412
-
size : uint option;
413
-
received_at : date option;
414
-
subject : string option;
415
-
preview : string option;
416
-
from : Email_address.t list option;
417
-
to_ : Email_address.t list option;
418
-
cc : Email_address.t list option;
419
-
message_id : string list option;
420
-
has_attachment : bool option;
421
-
text_body : Email_body_part.t list option;
422
-
html_body : Email_body_part.t list option;
423
-
attachments : Email_body_part.t list option;
424
-
}
425
-
426
-
let id t = t.id
427
-
let blob_id t = t.blob_id
428
-
let thread_id t = t.thread_id
429
-
let mailbox_ids t = t.mailbox_ids
430
-
let keywords t = t.keywords
431
-
let size t = t.size
432
-
let received_at t = t.received_at
433
-
let subject t = t.subject
434
-
let preview t = t.preview
435
-
let from t = t.from
436
-
let to_ t = t.to_
437
-
let cc t = t.cc
438
-
let message_id t = t.message_id
439
-
let has_attachment t = t.has_attachment
440
-
let text_body t = t.text_body
441
-
let html_body t = t.html_body
442
-
let attachments t = t.attachments
443
-
444
-
let create ?id ?blob_id ?thread_id ?mailbox_ids ?keywords ?size
445
-
?received_at ?subject ?preview ?from ?to_ ?cc ?message_id
446
-
?has_attachment ?text_body ?html_body ?attachments () =
447
-
{ id; blob_id; thread_id; mailbox_ids; keywords; size;
448
-
received_at; subject; preview; from; to_; cc; message_id;
449
-
has_attachment; text_body; html_body; attachments }
450
-
451
-
let make_patch ?add_keywords ?remove_keywords ?add_mailboxes ?remove_mailboxes () =
452
-
let patches = [] in
453
-
let patches = match add_keywords with
454
-
| Some kws ->
455
-
List.fold_left (fun acc kw ->
456
-
("/keywords/" ^ Keywords.to_string kw, `Bool true) :: acc
457
-
) patches kws
458
-
| None -> patches
459
-
in
460
-
let patches = match remove_keywords with
461
-
| Some kws ->
462
-
List.fold_left (fun acc kw ->
463
-
("/keywords/" ^ Keywords.to_string kw, `Null) :: acc
464
-
) patches kws
465
-
| None -> patches
466
-
in
467
-
let patches = match add_mailboxes with
468
-
| Some ids ->
469
-
List.fold_left (fun acc id ->
470
-
("/mailboxIds/" ^ id, `Bool true) :: acc
471
-
) patches ids
472
-
| None -> patches
473
-
in
474
-
let patches = match remove_mailboxes with
475
-
| Some ids ->
476
-
List.fold_left (fun acc id ->
477
-
("/mailboxIds/" ^ id, `Null) :: acc
478
-
) patches ids
479
-
| None -> patches
480
-
in
481
-
patches
482
-
483
-
let get_id t =
484
-
match t.id with
485
-
| Some id -> Ok id
486
-
| None -> Error "Email has no ID"
487
-
488
-
let take_id t =
489
-
match t.id with
490
-
| Some id -> id
491
-
| None -> failwith "Email has no ID"
492
-
493
-
(* Helper function to convert mailbox ID map to JSON *)
494
-
let mailbox_ids_to_json mailbox_ids =
495
-
let assoc_list = Hashtbl.fold (fun k v acc -> (k, `Bool v) :: acc) mailbox_ids [] in
496
-
`Assoc assoc_list
497
-
498
-
(* Helper function to parse mailbox ID map from JSON *)
499
-
let mailbox_ids_of_json = function
500
-
| `Assoc fields ->
501
-
let map = Hashtbl.create (List.length fields) in
502
-
List.iter (fun (k, v) ->
503
-
match v with
504
-
| `Bool b -> Hashtbl.add map k b
505
-
| _ -> failwith ("Email.mailbox_ids_of_json: invalid mailbox ID value for " ^ k)
506
-
) fields;
507
-
map
508
-
| _ -> failwith "Email.mailbox_ids_of_json: expected JSON object"
509
-
510
-
let to_json t =
511
-
let fields = [] in
512
-
let fields = match t.id with
513
-
| Some id -> ("id", `String id) :: fields
514
-
| None -> fields
515
-
in
516
-
let fields = match t.blob_id with
517
-
| Some blob_id -> ("blobId", `String blob_id) :: fields
518
-
| None -> fields
519
-
in
520
-
let fields = match t.thread_id with
521
-
| Some thread_id -> ("threadId", `String thread_id) :: fields
522
-
| None -> fields
523
-
in
524
-
let fields = match t.mailbox_ids with
525
-
| Some mailbox_ids -> ("mailboxIds", mailbox_ids_to_json mailbox_ids) :: fields
526
-
| None -> fields
527
-
in
528
-
let fields = match t.keywords with
529
-
| Some keywords -> ("keywords", Keywords.to_json keywords) :: fields
530
-
| None -> fields
531
-
in
532
-
let fields = match t.size with
533
-
| Some size -> ("size", `Int size) :: fields
534
-
| None -> fields
535
-
in
536
-
let fields = match t.received_at with
537
-
| Some date -> ("receivedAt", `Float date) :: fields
538
-
| None -> fields
539
-
in
540
-
let fields = match t.subject with
541
-
| Some subject -> ("subject", `String subject) :: fields
542
-
| None -> fields
543
-
in
544
-
let fields = match t.preview with
545
-
| Some preview -> ("preview", `String preview) :: fields
546
-
| None -> fields
547
-
in
548
-
let fields = match t.from with
549
-
| Some from -> ("from", `List (List.map Email_address.to_json from)) :: fields
550
-
| None -> fields
551
-
in
552
-
let fields = match t.to_ with
553
-
| Some to_ -> ("to", `List (List.map Email_address.to_json to_)) :: fields
554
-
| None -> fields
555
-
in
556
-
let fields = match t.cc with
557
-
| Some cc -> ("cc", `List (List.map Email_address.to_json cc)) :: fields
558
-
| None -> fields
559
-
in
560
-
let fields = match t.message_id with
561
-
| Some message_ids -> ("messageId", `List (List.map (fun s -> `String s) message_ids)) :: fields
562
-
| None -> fields
563
-
in
564
-
let fields = match t.has_attachment with
565
-
| Some has_attachment -> ("hasAttachment", `Bool has_attachment) :: fields
566
-
| None -> fields
567
-
in
568
-
let fields = match t.text_body with
569
-
| Some text_body -> ("textBody", `List (List.map Email_body_part.to_json text_body)) :: fields
570
-
| None -> fields
571
-
in
572
-
let fields = match t.html_body with
573
-
| Some html_body -> ("htmlBody", `List (List.map Email_body_part.to_json html_body)) :: fields
574
-
| None -> fields
575
-
in
576
-
let fields = match t.attachments with
577
-
| Some attachments -> ("attachments", `List (List.map Email_body_part.to_json attachments)) :: fields
578
-
| None -> fields
579
-
in
580
-
`Assoc fields
581
-
582
-
let of_json json =
583
-
match json with
584
-
| `Assoc fields ->
585
-
let id = match List.assoc_opt "id" fields with
586
-
| Some (`String id) -> Some id
587
-
| Some `Null | None -> None
588
-
| _ -> failwith "Email.of_json: invalid id field"
589
-
in
590
-
let blob_id = match List.assoc_opt "blobId" fields with
591
-
| Some (`String blob_id) -> Some blob_id
592
-
| Some `Null | None -> None
593
-
| _ -> failwith "Email.of_json: invalid blobId field"
594
-
in
595
-
let thread_id = match List.assoc_opt "threadId" fields with
596
-
| Some (`String thread_id) -> Some thread_id
597
-
| Some `Null | None -> None
598
-
| _ -> failwith "Email.of_json: invalid threadId field"
599
-
in
600
-
let mailbox_ids = match List.assoc_opt "mailboxIds" fields with
601
-
| Some json_obj -> Some (mailbox_ids_of_json json_obj)
602
-
| None -> None
603
-
in
604
-
let keywords = match List.assoc_opt "keywords" fields with
605
-
| Some json_obj -> Some (Keywords.of_json json_obj)
606
-
| None -> None
607
-
in
608
-
let size = match List.assoc_opt "size" fields with
609
-
| Some (`Int size) -> Some size
610
-
| Some `Null | None -> None
611
-
| _ -> failwith "Email.of_json: invalid size field"
612
-
in
613
-
let received_at = match List.assoc_opt "receivedAt" fields with
614
-
| Some (`Float date) -> Some date
615
-
| Some (`String date_str) ->
616
-
(* Parse ISO 8601 date string to Unix timestamp *)
617
-
(try
618
-
(* Simple ISO 8601 parser for "YYYY-MM-DDTHH:MM:SSZ" format *)
619
-
let parse_iso8601 s =
620
-
if String.length s >= 19 && s.[10] = 'T' then
621
-
let year = int_of_string (String.sub s 0 4) in
622
-
let month = int_of_string (String.sub s 5 2) in
623
-
let day = int_of_string (String.sub s 8 2) in
624
-
let hour = int_of_string (String.sub s 11 2) in
625
-
let minute = int_of_string (String.sub s 14 2) in
626
-
let second = int_of_string (String.sub s 17 2) in
627
-
(* Convert to Unix timestamp - approximate conversion *)
628
-
let days_since_epoch =
629
-
(year - 1970) * 365 + (year - 1969) / 4 - (year - 1901) / 100 + (year - 1601) / 400 +
630
-
[|0; 31; 59; 90; 120; 151; 181; 212; 243; 273; 304; 334|].(month - 1) + day - 1 in
631
-
let seconds_in_day = hour * 3600 + minute * 60 + second in
632
-
float_of_int (days_since_epoch * 86400 + seconds_in_day)
633
-
else
634
-
failwith "Invalid ISO 8601 format"
635
-
in
636
-
Some (parse_iso8601 date_str)
637
-
with _ -> failwith "Email.of_json: invalid receivedAt date format")
638
-
| Some `Null | None -> None
639
-
| _ -> failwith "Email.of_json: invalid receivedAt field"
640
-
in
641
-
let subject = match List.assoc_opt "subject" fields with
642
-
| Some (`String subject) -> Some subject
643
-
| Some `Null | None -> None
644
-
| _ -> failwith "Email.of_json: invalid subject field"
645
-
in
646
-
let preview = match List.assoc_opt "preview" fields with
647
-
| Some (`String preview) -> Some preview
648
-
| Some `Null | None -> None
649
-
| _ -> failwith "Email.of_json: invalid preview field"
650
-
in
651
-
let from = match List.assoc_opt "from" fields with
652
-
| Some (`List from_list) ->
653
-
let rec process_addresses acc = function
654
-
| [] -> Some (List.rev acc)
655
-
| addr :: rest ->
656
-
(match Email_address.of_json addr with
657
-
| Ok a -> process_addresses (a :: acc) rest
658
-
| Error _ -> failwith "Email.of_json: invalid address in from field")
659
-
in
660
-
process_addresses [] from_list
661
-
| Some `Null | None -> None
662
-
| _ -> failwith "Email.of_json: invalid from field"
663
-
in
664
-
let to_ = match List.assoc_opt "to" fields with
665
-
| Some (`List to_list) ->
666
-
let rec process_addresses acc = function
667
-
| [] -> Some (List.rev acc)
668
-
| addr :: rest ->
669
-
(match Email_address.of_json addr with
670
-
| Ok a -> process_addresses (a :: acc) rest
671
-
| Error _ -> failwith "Email.of_json: invalid address in to field")
672
-
in
673
-
process_addresses [] to_list
674
-
| Some `Null | None -> None
675
-
| _ -> failwith "Email.of_json: invalid to field"
676
-
in
677
-
let cc = match List.assoc_opt "cc" fields with
678
-
| Some (`List cc_list) ->
679
-
let rec process_addresses acc = function
680
-
| [] -> Some (List.rev acc)
681
-
| addr :: rest ->
682
-
(match Email_address.of_json addr with
683
-
| Ok a -> process_addresses (a :: acc) rest
684
-
| Error _ -> failwith "Email.of_json: invalid address in cc field")
685
-
in
686
-
process_addresses [] cc_list
687
-
| Some `Null | None -> None
688
-
| _ -> failwith "Email.of_json: invalid cc field"
689
-
in
690
-
let message_id = match List.assoc_opt "messageId" fields with
691
-
| Some (`List msg_id_list) ->
692
-
Some (List.map (function
693
-
| `String s -> s
694
-
| _ -> failwith "Email.of_json: invalid messageId list item"
695
-
) msg_id_list)
696
-
| Some `Null | None -> None
697
-
| _ -> failwith "Email.of_json: invalid messageId field"
698
-
in
699
-
let has_attachment = match List.assoc_opt "hasAttachment" fields with
700
-
| Some (`Bool has_attachment) -> Some has_attachment
701
-
| Some `Null | None -> None
702
-
| _ -> failwith "Email.of_json: invalid hasAttachment field"
703
-
in
704
-
let text_body = match List.assoc_opt "textBody" fields with
705
-
| Some (`List body_list) -> Some (List.map Email_body_part.of_json body_list)
706
-
| Some `Null | None -> None
707
-
| _ -> failwith "Email.of_json: invalid textBody field"
708
-
in
709
-
let html_body = match List.assoc_opt "htmlBody" fields with
710
-
| Some (`List body_list) -> Some (List.map Email_body_part.of_json body_list)
711
-
| Some `Null | None -> None
712
-
| _ -> failwith "Email.of_json: invalid htmlBody field"
713
-
in
714
-
let attachments = match List.assoc_opt "attachments" fields with
715
-
| Some (`List att_list) -> Some (List.map Email_body_part.of_json att_list)
716
-
| Some `Null | None -> None
717
-
| _ -> failwith "Email.of_json: invalid attachments field"
718
-
in
719
-
{ id; blob_id; thread_id; mailbox_ids; keywords; size;
720
-
received_at; subject; preview; from; to_; cc; message_id;
721
-
has_attachment; text_body; html_body; attachments }
722
-
| _ -> failwith "Email.of_json: expected JSON object"
723
-
end
724
-
725
-
module Import = struct
726
-
type args = {
727
-
account_id : id;
728
-
blob_ids : id list;
729
-
mailbox_ids : id id_map;
730
-
keywords : Keywords.t option;
731
-
received_at : date option;
732
-
}
733
-
734
-
let create_args ~account_id ~blob_ids ~mailbox_ids ?keywords ?received_at () =
735
-
{ account_id; blob_ids; mailbox_ids; keywords; received_at }
736
-
737
-
type email_import_result = {
738
-
blob_id : id;
739
-
email : Email.t;
740
-
}
741
-
742
-
let create_result ~blob_id ~email () = { blob_id; email }
743
-
744
-
type response = {
745
-
account_id : id;
746
-
created : email_import_result id_map;
747
-
not_created : Jmap.Error.Set_error.t id_map;
748
-
}
749
-
750
-
let create_response ~account_id ~created ~not_created () =
751
-
{ account_id; created; not_created }
752
-
end
753
-
754
-
module Parse = struct
755
-
type args = {
756
-
account_id : id;
757
-
blob_ids : id list;
758
-
properties : string list option;
759
-
}
760
-
761
-
let create_args ~account_id ~blob_ids ?properties () =
762
-
{ account_id; blob_ids; properties }
763
-
764
-
type email_parse_result = {
765
-
blob_id : id;
766
-
parsed : Email.t;
767
-
}
768
-
769
-
let create_result ~blob_id ~parsed () = { blob_id; parsed }
770
-
771
-
type response = {
772
-
account_id : id;
773
-
parsed : email_parse_result id_map;
774
-
not_parsed : string id_map;
775
-
}
776
-
777
-
let create_response ~account_id ~parsed ~not_parsed () =
778
-
{ account_id; parsed; not_parsed }
779
-
end
780
-
781
-
782
-
module Copy = struct
783
-
type args = {
784
-
from_account_id : id;
785
-
account_id : id;
786
-
create : (id * id id_map) id_map;
787
-
on_success_destroy_original : bool option;
788
-
destroy_from_if_in_state : string option;
789
-
}
790
-
791
-
let create_args ~from_account_id ~account_id ~create
792
-
?on_success_destroy_original ?destroy_from_if_in_state () =
793
-
{ from_account_id; account_id; create;
794
-
on_success_destroy_original; destroy_from_if_in_state }
795
-
796
-
type response = {
797
-
from_account_id : id;
798
-
account_id : id;
799
-
created : Email.t id_map option;
800
-
not_created : Jmap.Error.Set_error.t id_map option;
801
-
}
802
-
803
-
let create_response ~from_account_id ~account_id ?created ?not_created () =
804
-
{ from_account_id; account_id; created; not_created }
805
-
end
806
-
807
-
-764
jmap/jmap-email/types.mli
-764
jmap/jmap-email/types.mli
···
1
-
(** Common types for JMAP Mail (RFC 8621).
2
-
3
-
This module defines the core data types and structures used throughout the JMAP Mail
4
-
specification. These types represent email objects, addresses, body parts, keywords,
5
-
and methods for importing, parsing, and copying email messages.
6
-
7
-
All types follow the JMAP specification for immutable, server-synchronized objects
8
-
with appropriate property access patterns.
9
-
10
-
@see <https://www.rfc-editor.org/rfc/rfc8621.html> RFC 8621: The JSON Meta Application Protocol (JMAP) for Mail
11
-
*)
12
-
13
-
open Jmap.Types
14
-
15
-
(** Email address representation.
16
-
17
-
Represents an email address as specified in RFC 8621 Section 4.1.2.3.
18
-
An email address consists of an email field (required) and an optional
19
-
name field for display purposes. This follows the standard format used
20
-
in email headers like "From", "To", "Cc", etc.
21
-
22
-
The email field MUST be a valid RFC 5322 addr-spec and the name field,
23
-
if present, provides a human-readable display name.
24
-
25
-
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1.2.3> RFC 8621, Section 4.1.2.3
26
-
*)
27
-
module Email_address : sig
28
-
type t
29
-
30
-
(** JSON serialization interface *)
31
-
include Jmap_sigs.JSONABLE with type t := t
32
-
33
-
(** Pretty-printing interface *)
34
-
include Jmap_sigs.PRINTABLE with type t := t
35
-
36
-
(** Get the display name for the address.
37
-
@return The human-readable display name, or None if not set *)
38
-
val name : t -> string option
39
-
40
-
(** Get the actual email address.
41
-
@return The RFC 5322 addr-spec email address *)
42
-
val email : t -> string
43
-
44
-
(** Create a new email address object.
45
-
@param name Optional human-readable display name
46
-
@param email Required RFC 5322 addr-spec email address
47
-
@return New email address object *)
48
-
val v :
49
-
?name:string ->
50
-
email:string ->
51
-
unit -> t
52
-
53
-
end
54
-
55
-
(** Email address group representation.
56
-
57
-
Represents a named group of email addresses as specified in RFC 8621 Section 4.1.2.4.
58
-
This corresponds to RFC 5322 group syntax in email headers, allowing multiple
59
-
addresses to be grouped under a common name.
60
-
61
-
Groups are used in headers like "To", "Cc", and "Bcc" when addresses need to be
62
-
organized or when mailing list functionality is involved.
63
-
64
-
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1.2.4> RFC 8621, Section 4.1.2.4
65
-
*)
66
-
module Email_address_group : sig
67
-
type t
68
-
69
-
(** Get the name of the address group.
70
-
@return The group name, or None if not set *)
71
-
val name : t -> string option
72
-
73
-
(** Get the list of email addresses in the group.
74
-
@return List of email addresses belonging to this group *)
75
-
val addresses : t -> Email_address.t list
76
-
77
-
(** Create a new email address group.
78
-
@param name Optional group name
79
-
@param addresses List of email addresses in the group
80
-
@return New address group object *)
81
-
val v :
82
-
?name:string ->
83
-
addresses:Email_address.t list ->
84
-
unit -> t
85
-
end
86
-
87
-
(** Email header field representation.
88
-
89
-
Represents a single email header field as specified in RFC 8621 Section 4.1.3.
90
-
Each header consists of a field name and its raw, unprocessed value as it
91
-
appears in the original email message.
92
-
93
-
Header fields follow RFC 5322 syntax and are used to provide access to
94
-
both standard headers (Subject, From, To, etc.) and custom headers that
95
-
may not be parsed into specific Email object properties.
96
-
97
-
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1.3> RFC 8621, Section 4.1.3
98
-
*)
99
-
module Email_header : sig
100
-
type t
101
-
102
-
(** Get the header field name.
103
-
@return The header field name (e.g., "Subject", "X-Custom-Header") *)
104
-
val name : t -> string
105
-
106
-
(** Get the raw header field value.
107
-
@return The unprocessed header value as it appears in the message *)
108
-
val value : t -> string
109
-
110
-
(** Create a new header field.
111
-
@param name The header field name
112
-
@param value The raw header field value
113
-
@return New header field object *)
114
-
val v :
115
-
name:string ->
116
-
value:string ->
117
-
unit -> t
118
-
119
-
(** Convert header field to JSON representation.
120
-
@param t The header field to convert
121
-
@return JSON object with 'name' and 'value' fields *)
122
-
val to_json : t -> Yojson.Safe.t
123
-
124
-
(** Parse header field from JSON representation.
125
-
@param json JSON object with 'name' and 'value' fields
126
-
@return Parsed header field object
127
-
@raise Failure if JSON structure is invalid *)
128
-
val of_json : Yojson.Safe.t -> t
129
-
end
130
-
131
-
(** Email body part representation.
132
-
133
-
Represents a single part within an email's MIME structure as specified in
134
-
RFC 8621 Section 4.1.4. Each body part can be either a leaf part containing
135
-
actual content or a multipart container holding sub-parts.
136
-
137
-
Body parts include information about MIME type, encoding, disposition,
138
-
size, and other RFC 2045-2047 MIME attributes. For multipart types,
139
-
the sub_parts field contains nested body parts.
140
-
141
-
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1.4> RFC 8621, Section 4.1.4
142
-
*)
143
-
module Email_body_part : sig
144
-
type t
145
-
146
-
(** Get the part ID for referencing this specific part.
147
-
@return Part identifier, or None for multipart container types *)
148
-
val id : t -> string option
149
-
150
-
(** Get the blob ID for downloading the part content.
151
-
@return Blob identifier for content access, or None for multipart types *)
152
-
val blob_id : t -> id option
153
-
154
-
(** Get the size of the part in bytes.
155
-
@return Size in bytes of the decoded content *)
156
-
val size : t -> uint
157
-
158
-
(** Get the list of MIME headers for this part.
159
-
@return List of header fields specific to this body part *)
160
-
val headers : t -> Email_header.t list
161
-
162
-
(** Get the filename parameter from Content-Disposition or Content-Type.
163
-
@return Filename if present, None otherwise *)
164
-
val name : t -> string option
165
-
166
-
(** Get the MIME content type.
167
-
@return MIME type (e.g., "text/plain", "image/jpeg") *)
168
-
val mime_type : t -> string
169
-
170
-
(** Get the character set parameter.
171
-
@return Character encoding (e.g., "utf-8", "iso-8859-1"), None if not specified *)
172
-
val charset : t -> string option
173
-
174
-
(** Get the Content-Disposition header value.
175
-
@return Disposition type (e.g., "attachment", "inline"), None if not specified *)
176
-
val disposition : t -> string option
177
-
178
-
(** Get the Content-ID header value for referencing within HTML content.
179
-
@return Content identifier for inline references, None if not specified *)
180
-
val cid : t -> string option
181
-
182
-
(** Get the Content-Language header values.
183
-
@return List of language codes (e.g., ["en"; "fr"]), None if not specified *)
184
-
val language : t -> string list option
185
-
186
-
(** Get the Content-Location header value.
187
-
@return URI reference for content location, None if not specified *)
188
-
val location : t -> string option
189
-
190
-
(** Get nested parts for multipart content types.
191
-
@return List of sub-parts for multipart types, None for leaf parts *)
192
-
val sub_parts : t -> t list option
193
-
194
-
(** Get additional headers requested via header properties.
195
-
@return Map of header names to their JSON values for extended header access *)
196
-
val other_headers : t -> Yojson.Safe.t string_map
197
-
198
-
(** Create a new body part object.*)
199
-
val v :
200
-
?id:string ->
201
-
?blob_id:id ->
202
-
size:uint ->
203
-
headers:Email_header.t list ->
204
-
?name:string ->
205
-
mime_type:string ->
206
-
?charset:string ->
207
-
?disposition:string ->
208
-
?cid:string ->
209
-
?language:string list ->
210
-
?location:string ->
211
-
?sub_parts:t list ->
212
-
?other_headers:Yojson.Safe.t string_map ->
213
-
unit -> t
214
-
215
-
(** Convert body part to JSON representation.
216
-
@param t The body part to convert
217
-
@return JSON object with all body part fields *)
218
-
val to_json : t -> Yojson.Safe.t
219
-
220
-
(** Parse body part from JSON representation.
221
-
@param json JSON object representing a body part
222
-
@return Parsed body part object
223
-
@raise Failure if JSON structure is invalid *)
224
-
val of_json : Yojson.Safe.t -> t
225
-
end
226
-
227
-
(** Decoded email body content.
228
-
229
-
Represents the decoded text content of a body part as specified in RFC 8621
230
-
Section 4.1.4. This provides access to the actual text content after MIME
231
-
decoding, along with metadata about potential encoding issues or truncation.
232
-
233
-
Used primarily for text/plain and text/html parts where the decoded content
234
-
is needed for display or processing.
235
-
236
-
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1.4> RFC 8621, Section 4.1.4
237
-
*)
238
-
module Email_body_value : sig
239
-
type t
240
-
241
-
(** Get the decoded text content.
242
-
@return The decoded text content of the body part *)
243
-
val value : t -> string
244
-
245
-
(** Check if there was an encoding problem during decoding.
246
-
@return true if encoding issues were encountered during decoding *)
247
-
val has_encoding_problem : t -> bool
248
-
249
-
(** Check if the content was truncated by the server.
250
-
@return true if the content was truncated to fit size limits *)
251
-
val is_truncated : t -> bool
252
-
253
-
(** Create a new body value object.
254
-
@param value The decoded text content
255
-
@param encoding_problem Whether encoding problems were encountered (default: false)
256
-
@param truncated Whether the content was truncated (default: false)
257
-
@return New body value object *)
258
-
val v :
259
-
value:string ->
260
-
?encoding_problem:bool ->
261
-
?truncated:bool ->
262
-
unit -> t
263
-
end
264
-
265
-
(** Email keywords and flags system.
266
-
267
-
Represents the JMAP email keywords system as specified in RFC 8621 Section 4.1.1.
268
-
Keywords are used to store message flags and labels, providing compatibility with
269
-
IMAP flags while extending functionality for modern email clients.
270
-
271
-
The system supports standard IMAP system flags ($seen, $draft, etc.) as well as
272
-
vendor extensions (particularly Apple Mail extensions) and custom user-defined
273
-
keywords. Keywords are stored as a set and provide both boolean checks and
274
-
conversion functions for protocol serialization.
275
-
276
-
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1.1> RFC 8621, Section 4.1.1
277
-
@see <https://datatracker.ietf.org/doc/draft-ietf-mailmaint-messageflag-mailboxattribute/> Draft for vendor extensions
278
-
*)
279
-
module Keywords : sig
280
-
(** Keyword type representing various email flags and labels.
281
-
282
-
Covers standard IMAP system flags, common extensions, vendor-specific
283
-
flags (particularly Apple Mail), and custom user-defined keywords.
284
-
*)
285
-
type keyword =
286
-
| Draft (** "$draft": Email is a draft being composed by the user *)
287
-
| Seen (** "$seen": Email has been read/viewed by the user *)
288
-
| Flagged (** "$flagged": Email has been flagged for urgent or special attention *)
289
-
| Answered (** "$answered": Email has been replied to *)
290
-
291
-
(* Common extension keywords from RFC 5788 and others *)
292
-
| Forwarded (** "$forwarded": Email has been forwarded to others *)
293
-
| Phishing (** "$phishing": Email is flagged as potential phishing attempt *)
294
-
| Junk (** "$junk": Email is classified as spam/junk mail *)
295
-
| NotJunk (** "$notjunk": Email is explicitly marked as legitimate (not spam) *)
296
-
297
-
(* Apple Mail and other vendor extension keywords *)
298
-
| Notify (** "$notify": User requests notification when email receives replies *)
299
-
| Muted (** "$muted": Email thread is muted (notifications disabled) *)
300
-
| Followed (** "$followed": Email thread is followed for special notifications *)
301
-
| Memo (** "$memo": Email has an associated memo or note *)
302
-
| HasMemo (** "$hasmemo": Email contains memo, annotation or note properties *)
303
-
| Autosent (** "$autosent": Email was automatically generated or sent *)
304
-
| Unsubscribed (** "$unsubscribed": User has unsubscribed from this sender *)
305
-
| CanUnsubscribe (** "$canunsubscribe": Email contains unsubscribe links/information *)
306
-
| Imported (** "$imported": Email was imported from another email system *)
307
-
| IsTrusted (** "$istrusted": Email sender is verified/trusted *)
308
-
| MaskedEmail (** "$maskedemail": Email uses masked/anonymous addressing *)
309
-
| New (** "$new": Email was recently delivered to the mailbox *)
310
-
311
-
(* Apple Mail color flag bit system for visual categorization *)
312
-
| MailFlagBit0 (** "$MailFlagBit0": First color flag bit (used for red) *)
313
-
| MailFlagBit1 (** "$MailFlagBit1": Second color flag bit (used for orange) *)
314
-
| MailFlagBit2 (** "$MailFlagBit2": Third color flag bit (used for yellow) *)
315
-
| Custom of string (** Custom user-defined keyword with arbitrary name *)
316
-
317
-
(** A set of keywords applied to an email.
318
-
319
-
Represents the collection of all flags and labels associated with a specific
320
-
email message. Keywords are stored as a list but logically represent a set
321
-
(duplicates are handled appropriately by the manipulation functions).
322
-
*)
323
-
type t = keyword list
324
-
325
-
(** Check if email is marked as a draft.
326
-
@return true if the Draft keyword is present *)
327
-
val is_draft : t -> bool
328
-
329
-
(** Check if email has been read.
330
-
@return true if the Seen keyword is present *)
331
-
val is_seen : t -> bool
332
-
333
-
(** Check if email is unread (not seen and not a draft).
334
-
@return true if email is neither seen nor a draft *)
335
-
val is_unread : t -> bool
336
-
337
-
(** Check if email is flagged for attention.
338
-
@return true if the Flagged keyword is present *)
339
-
val is_flagged : t -> bool
340
-
341
-
(** Check if email has been replied to.
342
-
@return true if the Answered keyword is present *)
343
-
val is_answered : t -> bool
344
-
345
-
(** Check if email has been forwarded.
346
-
@return true if the Forwarded keyword is present *)
347
-
val is_forwarded : t -> bool
348
-
349
-
(** Check if email is flagged as potential phishing.
350
-
@return true if the Phishing keyword is present *)
351
-
val is_phishing : t -> bool
352
-
353
-
(** Check if email is classified as junk/spam.
354
-
@return true if the Junk keyword is present *)
355
-
val is_junk : t -> bool
356
-
357
-
(** Check if email is explicitly marked as legitimate.
358
-
@return true if the NotJunk keyword is present *)
359
-
val is_not_junk : t -> bool
360
-
361
-
(** Check if a specific custom keyword is present.
362
-
@param keywords The keyword set to check
363
-
@param keyword The custom keyword string to look for
364
-
@return true if the custom keyword is present *)
365
-
val has_keyword : t -> string -> bool
366
-
367
-
(** Get all custom keywords, excluding standard system keywords.
368
-
@return List of custom keyword strings *)
369
-
val custom_keywords : t -> string list
370
-
371
-
(** Add a keyword to the set (avoiding duplicates).
372
-
@param keywords The current keyword set
373
-
@param keyword The keyword to add
374
-
@return New keyword set with the keyword added *)
375
-
val add : t -> keyword -> t
376
-
377
-
(** Remove a keyword from the set.
378
-
@param keywords The current keyword set
379
-
@param keyword The keyword to remove
380
-
@return New keyword set with the keyword removed *)
381
-
val remove : t -> keyword -> t
382
-
383
-
(** Create an empty keyword set.
384
-
@return Empty keyword set *)
385
-
val empty : unit -> t
386
-
387
-
(** Create a keyword set from a list of keywords.
388
-
@param keywords List of keywords to include
389
-
@return New keyword set containing the specified keywords *)
390
-
val of_list : keyword list -> t
391
-
392
-
(** Convert a keyword to its JMAP protocol string representation.
393
-
@param keyword The keyword to convert
394
-
@return JMAP protocol string (e.g., "$seen", "$draft") *)
395
-
val to_string : keyword -> string
396
-
397
-
(** Parse a JMAP protocol string into a keyword.
398
-
@param str The protocol string to parse
399
-
@return Corresponding keyword variant *)
400
-
val of_string : string -> keyword
401
-
402
-
(** Convert keyword set to JMAP wire format (string -> bool map).
403
-
@param keywords The keyword set to convert
404
-
@return Hash table mapping keyword strings to true values *)
405
-
val to_map : t -> bool string_map
406
-
407
-
(** Convert keyword set to JSON representation.
408
-
@param t The keyword set to convert
409
-
@return JSON object mapping keyword strings to boolean values *)
410
-
val to_json : t -> Yojson.Safe.t
411
-
412
-
(** Parse keyword set from JSON representation.
413
-
@param json JSON object mapping keyword strings to boolean values
414
-
@return Parsed keyword set
415
-
@raise Failure if JSON structure is invalid *)
416
-
val of_json : Yojson.Safe.t -> t
417
-
end
418
-
419
-
420
-
(** Email object representation and operations.
421
-
422
-
The Email object represents a single email message as defined in RFC 8621
423
-
Section 4.1. It provides access to message metadata, headers, body structure,
424
-
and content through a property-based API that supports partial object loading.
425
-
426
-
Email objects are immutable and server-controlled. All modifications must
427
-
be performed through the Email/set method using patch objects.
428
-
429
-
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1> RFC 8621, Section 4.1
430
-
*)
431
-
module Email : sig
432
-
(** Immutable email object type *)
433
-
type t
434
-
435
-
(** Get the server-assigned email identifier.
436
-
@return Email ID if present in the object *)
437
-
val id : t -> id option
438
-
439
-
(** Get the blob ID for downloading the complete raw message.
440
-
@return Blob identifier for RFC 5322 message access *)
441
-
val blob_id : t -> id option
442
-
443
-
(** Get the thread identifier linking related messages.
444
-
@return Thread ID for conversation grouping *)
445
-
val thread_id : t -> id option
446
-
447
-
(** Get the set of mailboxes containing this email.
448
-
@return Map of mailbox IDs to boolean values (always true when present) *)
449
-
val mailbox_ids : t -> bool id_map option
450
-
451
-
(** Get the keywords/flags applied to this email.
452
-
@return Set of keywords if included in the retrieved properties *)
453
-
val keywords : t -> Keywords.t option
454
-
455
-
(** Get the total size of the raw message.
456
-
@return Message size in octets *)
457
-
val size : t -> uint option
458
-
459
-
(** Get the server timestamp when the message was received.
460
-
@return Reception timestamp *)
461
-
val received_at : t -> date option
462
-
463
-
(** Get the email subject line.
464
-
@return Subject text if the Subject property was requested *)
465
-
val subject : t -> string option
466
-
467
-
(** Get the server-generated preview text for display.
468
-
@return Preview text if the Preview property was requested *)
469
-
val preview : t -> string option
470
-
471
-
(** Get the From header addresses.
472
-
@return List of sender addresses if the From property was requested *)
473
-
val from : t -> Email_address.t list option
474
-
475
-
(** Get the To header addresses.
476
-
@return List of primary recipient addresses if the To property was requested *)
477
-
val to_ : t -> Email_address.t list option
478
-
479
-
(** Get the Cc header addresses.
480
-
@return List of carbon copy addresses if the Cc property was requested *)
481
-
val cc : t -> Email_address.t list option
482
-
483
-
(** Get the Message-ID header values.
484
-
@return List of message identifiers if the MessageId property was requested *)
485
-
val message_id : t -> string list option
486
-
487
-
(** Check if the email has non-inline attachments.
488
-
@return true if attachments are present, if the HasAttachment property was requested *)
489
-
val has_attachment : t -> bool option
490
-
491
-
(** Get text/plain body parts suitable for display.
492
-
@return List of text body parts if the TextBody property was requested *)
493
-
val text_body : t -> Email_body_part.t list option
494
-
495
-
(** Get text/html body parts suitable for display.
496
-
@return List of HTML body parts if the HtmlBody property was requested *)
497
-
val html_body : t -> Email_body_part.t list option
498
-
499
-
(** Get attachment body parts.
500
-
@return List of attachment parts if the Attachments property was requested *)
501
-
val attachments : t -> Email_body_part.t list option
502
-
503
-
(** Create a new Email object.
504
-
505
-
Used primarily for constructing Email objects from server responses or
506
-
for testing purposes. In normal operation, Email objects are returned
507
-
by Email/get and related methods.
508
-
*)
509
-
val create :
510
-
?id:id ->
511
-
?blob_id:id ->
512
-
?thread_id:id ->
513
-
?mailbox_ids:bool id_map ->
514
-
?keywords:Keywords.t ->
515
-
?size:uint ->
516
-
?received_at:date ->
517
-
?subject:string ->
518
-
?preview:string ->
519
-
?from:Email_address.t list ->
520
-
?to_:Email_address.t list ->
521
-
?cc:Email_address.t list ->
522
-
?message_id:string list ->
523
-
?has_attachment:bool ->
524
-
?text_body:Email_body_part.t list ->
525
-
?html_body:Email_body_part.t list ->
526
-
?attachments:Email_body_part.t list ->
527
-
unit -> t
528
-
529
-
(** Create a patch object for Email/set operations.
530
-
531
-
Generates JSON Patch operations for modifying email properties.
532
-
Only keywords and mailbox membership can be modified after creation.
533
-
534
-
@param add_keywords Keywords to add to the email
535
-
@param remove_keywords Keywords to remove from the email
536
-
@param add_mailboxes Mailboxes to add the email to
537
-
@param remove_mailboxes Mailboxes to remove the email from
538
-
@return JSON Patch operations for Email/set
539
-
*)
540
-
val make_patch :
541
-
?add_keywords:Keywords.t ->
542
-
?remove_keywords:Keywords.t ->
543
-
?add_mailboxes:id list ->
544
-
?remove_mailboxes:id list ->
545
-
unit -> Jmap.Methods.patch_object
546
-
547
-
(** Safely extract the email ID.
548
-
@return Ok with the ID, or Error with message if not present *)
549
-
val get_id : t -> (id, string) result
550
-
551
-
(** Extract the email ID, raising an exception if not present.
552
-
@return The email ID
553
-
@raise Failure if the email has no ID *)
554
-
val take_id : t -> id
555
-
556
-
(** Convert email to JSON representation.
557
-
@param t The email to convert
558
-
@return JSON object with all email fields that are present *)
559
-
val to_json : t -> Yojson.Safe.t
560
-
561
-
(** Parse email from JSON representation.
562
-
@param json JSON object representing an email
563
-
@return Parsed email object
564
-
@raise Failure if JSON structure is invalid *)
565
-
val of_json : Yojson.Safe.t -> t
566
-
end
567
-
568
-
(** Email import functionality.
569
-
570
-
Provides types and operations for the Email/import method as specified in
571
-
RFC 8621 Section 4.8. This method allows importing email messages from
572
-
blob storage (typically uploaded via the Blob/upload method) into mailboxes
573
-
as Email objects.
574
-
575
-
The import process converts raw RFC 5322 message data into structured
576
-
Email objects with appropriate metadata and places them in specified mailboxes.
577
-
578
-
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.8> RFC 8621, Section 4.8
579
-
*)
580
-
module Import : sig
581
-
(** Arguments for Email/import method. *)
582
-
type args = {
583
-
account_id : id; (** Account where emails will be imported *)
584
-
blob_ids : id list; (** List of blob IDs containing RFC 5322 messages *)
585
-
mailbox_ids : id id_map; (** Map specifying target mailboxes for each blob *)
586
-
keywords : Keywords.t option; (** Default keywords to apply to imported emails *)
587
-
received_at : date option; (** Override timestamp for import (default: current time) *)
588
-
}
589
-
590
-
(** Create Email/import arguments.
591
-
@param account_id Target account for the import
592
-
@param blob_ids List of blob IDs containing message data
593
-
@param mailbox_ids Mapping of blob IDs to target mailbox sets
594
-
@param keywords Optional default keywords to apply
595
-
@param received_at Optional timestamp override
596
-
@return Import arguments object *)
597
-
val create_args :
598
-
account_id:id ->
599
-
blob_ids:id list ->
600
-
mailbox_ids:id id_map ->
601
-
?keywords:Keywords.t ->
602
-
?received_at:date ->
603
-
unit -> args
604
-
605
-
(** Result for a single successfully imported email. *)
606
-
type email_import_result = {
607
-
blob_id : id; (** Original blob ID that was imported *)
608
-
email : Email.t; (** Created Email object with server-assigned properties *)
609
-
}
610
-
611
-
(** Create an import result object.
612
-
@param blob_id The blob ID that was successfully imported
613
-
@param email The created Email object
614
-
@return Import result object *)
615
-
val create_result :
616
-
blob_id:id ->
617
-
email:Email.t ->
618
-
unit -> email_import_result
619
-
620
-
(** Complete response for Email/import method. *)
621
-
type response = {
622
-
account_id : id; (** Account where import was attempted *)
623
-
created : email_import_result id_map; (** Successfully imported emails by blob ID *)
624
-
not_created : Jmap.Error.Set_error.t id_map; (** Failed imports with error details *)
625
-
}
626
-
627
-
(** Create an import response object.
628
-
@param account_id Account where import was performed
629
-
@param created Map of successfully imported results
630
-
@param not_created Map of failed imports with errors
631
-
@return Import response object *)
632
-
val create_response :
633
-
account_id:id ->
634
-
created:email_import_result id_map ->
635
-
not_created:Jmap.Error.Set_error.t id_map ->
636
-
unit -> response
637
-
end
638
-
639
-
(** Email parsing functionality.
640
-
641
-
Provides types and operations for the Email/parse method as specified in
642
-
RFC 8621 Section 4.9. This method parses RFC 5322 message data from
643
-
blob storage into Email objects without importing them into mailboxes.
644
-
645
-
Parsing allows inspection of message structure and properties before
646
-
deciding whether to import messages, and provides access to Email object
647
-
properties for messages that may not be stored in the account.
648
-
649
-
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.9> RFC 8621, Section 4.9
650
-
*)
651
-
module Parse : sig
652
-
(** Arguments for Email/parse method. *)
653
-
type args = {
654
-
account_id : id; (** Account context for parsing *)
655
-
blob_ids : id list; (** List of blob IDs to parse *)
656
-
properties : string list option; (** Email properties to include in results *)
657
-
}
658
-
659
-
(** Create Email/parse arguments.
660
-
@param account_id Account context for the parsing operation
661
-
@param blob_ids List of blob IDs containing RFC 5322 messages
662
-
@param properties Optional list of Email properties to include
663
-
@return Parse arguments object *)
664
-
val create_args :
665
-
account_id:id ->
666
-
blob_ids:id list ->
667
-
?properties:string list ->
668
-
unit -> args
669
-
670
-
(** Result for a single successfully parsed email. *)
671
-
type email_parse_result = {
672
-
blob_id : id; (** Original blob ID that was parsed *)
673
-
parsed : Email.t; (** Parsed Email object (not stored in any mailbox) *)
674
-
}
675
-
676
-
(** Create a parse result object.
677
-
@param blob_id The blob ID that was successfully parsed
678
-
@param parsed The parsed Email object
679
-
@return Parse result object *)
680
-
val create_result :
681
-
blob_id:id ->
682
-
parsed:Email.t ->
683
-
unit -> email_parse_result
684
-
685
-
(** Complete response for Email/parse method. *)
686
-
type response = {
687
-
account_id : id; (** Account where parsing was performed *)
688
-
parsed : email_parse_result id_map; (** Successfully parsed emails by blob ID *)
689
-
not_parsed : string id_map; (** Failed parses with error messages *)
690
-
}
691
-
692
-
(** Create a parse response object.
693
-
@param account_id Account where parsing was performed
694
-
@param parsed Map of successfully parsed results
695
-
@param not_parsed Map of failed parses with error messages
696
-
@return Parse response object *)
697
-
val create_response :
698
-
account_id:id ->
699
-
parsed:email_parse_result id_map ->
700
-
not_parsed:string id_map ->
701
-
unit -> response
702
-
end
703
-
704
-
705
-
(** Email copying functionality.
706
-
707
-
Provides types and operations for the Email/copy method as specified in
708
-
RFC 8621 Section 4.7. This method allows copying existing Email objects
709
-
from one account to another, with optional mailbox placement and the
710
-
ability to destroy originals on success (for move operations).
711
-
712
-
Cross-account copying maintains email content and properties while
713
-
assigning new IDs in the target account.
714
-
715
-
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.7> RFC 8621, Section 4.7
716
-
*)
717
-
module Copy : sig
718
-
(** Arguments for Email/copy method. *)
719
-
type args = {
720
-
from_account_id : id; (** Source account containing emails to copy *)
721
-
account_id : id; (** Destination account for copied emails *)
722
-
create : (id * id id_map) id_map; (** Map of creation IDs to (email ID, mailbox set) pairs *)
723
-
on_success_destroy_original : bool option; (** Whether to destroy originals after successful copy *)
724
-
destroy_from_if_in_state : string option; (** Only destroy if source account is in this state *)
725
-
}
726
-
727
-
(** Create Email/copy arguments.
728
-
@param from_account_id Source account ID
729
-
@param account_id Destination account ID
730
-
@param create Map of creation IDs to (source email ID, target mailboxes)
731
-
@param on_success_destroy_original Whether to destroy originals (move operation)
732
-
@param destroy_from_if_in_state Only destroy if source state matches
733
-
@return Copy arguments object *)
734
-
val create_args :
735
-
from_account_id:id ->
736
-
account_id:id ->
737
-
create:(id * id id_map) id_map ->
738
-
?on_success_destroy_original:bool ->
739
-
?destroy_from_if_in_state:string ->
740
-
unit -> args
741
-
742
-
(** Complete response for Email/copy method. *)
743
-
type response = {
744
-
from_account_id : id; (** Source account ID *)
745
-
account_id : id; (** Destination account ID *)
746
-
created : Email.t id_map option; (** Successfully created emails by creation ID *)
747
-
not_created : Jmap.Error.Set_error.t id_map option; (** Failed copies with error details *)
748
-
}
749
-
750
-
(** Create a copy response object.
751
-
@param from_account_id Source account ID
752
-
@param account_id Destination account ID
753
-
@param created Optional map of successfully copied emails
754
-
@param not_created Optional map of failed copies with errors
755
-
@return Copy response object *)
756
-
val create_response :
757
-
from_account_id:id ->
758
-
account_id:id ->
759
-
?created:Email.t id_map ->
760
-
?not_created:Jmap.Error.Set_error.t id_map ->
761
-
unit -> response
762
-
end
763
-
764
-
+87
-62
jmap/jmap-email/vacation.ml
+87
-62
jmap/jmap-email/vacation.ml
···
1
1
(** JMAP Vacation Response Implementation.
2
2
3
3
This module implements the JMAP VacationResponse singleton data type
4
-
for managing automatic out-of-office email replies with date ranges,
4
+
for managing automatic out-of-office email replies with Date.t ranges,
5
5
custom messages, and enable/disable functionality.
6
6
7
7
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-8> RFC 8621, Section 8: VacationResponse
8
8
*)
9
9
10
-
open Jmap.Types
11
10
open Jmap.Error
12
11
open Yojson.Safe.Util
13
12
···
16
15
17
16
(** VacationResponse object *)
18
17
type t = {
19
-
id : id;
18
+
id : Jmap.Id.t;
20
19
is_enabled : bool;
21
-
from_date : utc_date option;
22
-
to_date : utc_date option;
20
+
from_date : Jmap.Date.t option;
21
+
to_date : Jmap.Date.t option;
23
22
subject : string option;
24
23
text_body : string option;
25
24
html_body : string option;
···
36
35
(** Create a minimal VacationResponse object.
37
36
VacationResponse always has ID "singleton" per JMAP spec *)
38
37
let create ?id () =
39
-
let actual_id = match id with Some id -> id | None -> Jmap.Types.Constants.vacation_response_id in
38
+
let actual_id = match id with Some id -> id | None -> "singleton" in
39
+
let id_result = match Jmap.Id.of_string actual_id with
40
+
| Ok id -> id
41
+
| Error e -> failwith ("Invalid vacation response ID: " ^ e) in
40
42
{
41
-
id = actual_id;
43
+
id = id_result;
42
44
is_enabled = false;
43
45
from_date = None;
44
46
to_date = None;
···
50
52
(** Serialize to JSON with only specified properties *)
51
53
let to_json_with_properties ~properties t =
52
54
let all_fields = [
53
-
("id", `String t.id);
55
+
("id", `String (Jmap.Id.to_string t.id));
54
56
("isEnabled", `Bool t.is_enabled);
55
-
("fromDate", match t.from_date with Some date -> `Float date | None -> `Null);
56
-
("toDate", match t.to_date with Some date -> `Float date | None -> `Null);
57
+
("fromDate", match t.from_date with Some date -> Jmap.Date.to_json date | None -> `Null);
58
+
("toDate", match t.to_date with Some date -> Jmap.Date.to_json date | None -> `Null);
57
59
("subject", match t.subject with Some subj -> `String subj | None -> `Null);
58
60
("textBody", match t.text_body with Some text -> `String text | None -> `Null);
59
61
("htmlBody", match t.html_body with Some html -> `String html | None -> `Null);
···
63
65
64
66
(** Get list of all valid property names *)
65
67
let valid_properties () = [
66
-
"id"; "isEnabled"; "fromDate"; "toDate"; "subject"; "textBody"; "htmlBody"
68
+
"Id.t"; "isEnabled"; "fromDate"; "toDate"; "subject"; "textBody"; "htmlBody"
67
69
] (* TODO: Use Property.to_string_list Property.all_properties when module ordering is fixed *)
68
70
69
71
(** {1 Property Accessors} *)
···
88
90
(* JSON serialization for VacationResponse *)
89
91
let to_json t =
90
92
let json_fields = [
91
-
("id", `String t.id);
93
+
("id", `String (Jmap.Id.to_string t.id));
92
94
("isEnabled", `Bool t.is_enabled);
93
95
] in
94
96
let json_fields = match t.from_date with
95
97
| None -> json_fields
96
-
| Some date -> ("fromDate", `Float date) :: json_fields
98
+
| Some date -> ("fromDate", `Float (Jmap.Date.to_timestamp date)) :: json_fields
97
99
in
98
100
let json_fields = match t.to_date with
99
101
| None -> json_fields
100
-
| Some date -> ("toDate", `Float date) :: json_fields
102
+
| Some date -> ("toDate", `Float (Jmap.Date.to_timestamp date)) :: json_fields
101
103
in
102
104
let json_fields = match t.subject with
103
105
| None -> json_fields
···
120
122
let enabled_str = string_of_bool vacation.is_enabled in
121
123
let from_date_str = match vacation.from_date with
122
124
| None -> "none"
123
-
| Some date -> Printf.sprintf "%.0f" date
125
+
| Some date -> Printf.sprintf "%.0f" (Jmap.Date.to_timestamp date)
124
126
in
125
127
let to_date_str = match vacation.to_date with
126
128
| None -> "none"
127
-
| Some date -> Printf.sprintf "%.0f" date
129
+
| Some date -> Printf.sprintf "%.0f" (Jmap.Date.to_timestamp date)
128
130
in
129
131
let subject_str = match vacation.subject with
130
132
| None -> "default"
131
133
| Some subj -> Printf.sprintf "\"%s\"" (String.sub subj 0 (min 20 (String.length subj)))
132
134
in
133
135
Format.fprintf ppf "VacationResponse{id=%s; is_enabled=%s; from_date=%s; to_date=%s; subject=%s}"
134
-
vacation.id
136
+
(Jmap.Id.to_string vacation.id)
135
137
enabled_str
136
138
from_date_str
137
139
to_date_str
···
142
144
let enabled_str = string_of_bool vacation.is_enabled in
143
145
let from_date_str = match vacation.from_date with
144
146
| None -> "none"
145
-
| Some date -> Printf.sprintf "%.0f" date
147
+
| Some date -> Printf.sprintf "%.0f" (Jmap.Date.to_timestamp date)
146
148
in
147
149
let to_date_str = match vacation.to_date with
148
150
| None -> "none"
149
-
| Some date -> Printf.sprintf "%.0f" date
151
+
| Some date -> Printf.sprintf "%.0f" (Jmap.Date.to_timestamp date)
150
152
in
151
153
let subject_str = match vacation.subject with
152
154
| None -> "default subject"
···
161
163
| Some html -> Printf.sprintf "%d chars" (String.length html)
162
164
in
163
165
Format.fprintf ppf "VacationResponse {\n id: %s\n is_enabled: %s\n from_date: %s\n to_date: %s\n subject: %s\n text_body: %s\n html_body: %s\n}"
164
-
vacation.id
166
+
(Jmap.Id.to_string vacation.id)
165
167
enabled_str
166
168
from_date_str
167
169
to_date_str
···
172
174
(* JSON deserialization for VacationResponse *)
173
175
let of_json json =
174
176
try
175
-
let id = json |> member "id" |> to_string in
177
+
let id = match Jmap.Id.of_string (json |> member "id" |> to_string) with
178
+
| Ok id -> id
179
+
| Error err -> failwith ("Invalid ID: " ^ err) in
176
180
let is_enabled = json |> member "isEnabled" |> to_bool in
177
181
let from_date =
178
182
match json |> member "fromDate" with
179
-
| `Float date -> Some date
183
+
| `Float date -> Some (Jmap.Date.of_timestamp date)
180
184
| `String date_str ->
181
-
(* Parse ISO 8601 date string to Unix timestamp - simplified *)
182
-
(try Some (float_of_string date_str)
185
+
(* Parse ISO 8601 Date.t string to Unix timestamp - simplified *)
186
+
(try Some (Jmap.Date.of_timestamp (float_of_string date_str))
183
187
with _ -> None)
184
188
| `Null | _ -> None
185
189
in
186
190
let to_date =
187
191
match json |> member "toDate" with
188
-
| `Float date -> Some date
192
+
| `Float date -> Some (Jmap.Date.of_timestamp date)
189
193
| `String date_str ->
190
-
(* Parse ISO 8601 date string to Unix timestamp - simplified *)
191
-
(try Some (float_of_string date_str)
194
+
(* Parse ISO 8601 Date.t string to Unix timestamp - simplified *)
195
+
(try Some (Jmap.Date.of_timestamp (float_of_string date_str))
192
196
with _ -> None)
193
197
| `Null | _ -> None
194
198
in
···
204
208
module Update = struct
205
209
type t = {
206
210
is_enabled : bool option;
207
-
from_date : utc_date option option;
208
-
to_date : utc_date option option;
211
+
from_date : Jmap.Date.t option option;
212
+
to_date : Jmap.Date.t option option;
209
213
subject : string option option;
210
214
text_body : string option option;
211
215
html_body : string option option;
···
255
259
let json_fields = match t.from_date with
256
260
| None -> json_fields
257
261
| Some None -> ("fromDate", `Null) :: json_fields
258
-
| Some (Some date) -> ("fromDate", `Float date) :: json_fields
262
+
| Some (Some date) -> ("fromDate", `Float (Jmap.Date.to_timestamp date)) :: json_fields
259
263
in
260
264
let json_fields = match t.to_date with
261
265
| None -> json_fields
262
266
| Some None -> ("toDate", `Null) :: json_fields
263
-
| Some (Some date) -> ("toDate", `Float date) :: json_fields
267
+
| Some (Some date) -> ("toDate", `Float (Jmap.Date.to_timestamp date)) :: json_fields
264
268
in
265
269
let json_fields = match t.subject with
266
270
| None -> json_fields
···
290
294
let from_date =
291
295
match json |> member "fromDate" with
292
296
| `Null -> Some None
293
-
| `Float date -> Some (Some date)
294
-
| `String date_str -> Some (Some (try float_of_string date_str with _ -> 0.0))
297
+
| `Float date -> Some (Some (Jmap.Date.of_timestamp date))
298
+
| `String date_str -> Some (Some (try Jmap.Date.of_timestamp (float_of_string date_str) with _ -> Jmap.Date.of_timestamp 0.0))
295
299
| _ -> None
296
300
in
297
301
let to_date =
298
302
match json |> member "toDate" with
299
303
| `Null -> Some None
300
-
| `Float date -> Some (Some date)
301
-
| `String date_str -> Some (Some (try float_of_string date_str with _ -> 0.0))
304
+
| `Float date -> Some (Some (Jmap.Date.of_timestamp date))
305
+
| `String date_str -> Some (Some (try Jmap.Date.of_timestamp (float_of_string date_str) with _ -> Jmap.Date.of_timestamp 0.0))
302
306
| _ -> None
303
307
in
304
308
let subject =
···
328
332
(** Arguments for VacationResponse/get method *)
329
333
module Get_args = struct
330
334
type t = {
331
-
account_id : id;
332
-
ids : id list option;
335
+
account_id : Jmap.Id.t;
336
+
ids : Jmap.Id.t list option;
333
337
properties : string list option;
334
338
}
335
339
···
341
345
{ account_id; ids; properties }
342
346
343
347
let singleton ~account_id ?properties () =
344
-
{ account_id; ids = Some [Jmap.Types.Constants.vacation_response_id]; properties }
348
+
{ account_id; ids = Some [Jmap.Id.of_string "singleton" |> Result.get_ok]; properties }
345
349
346
350
let to_json t =
347
351
let json_fields = [
348
-
("accountId", `String t.account_id);
352
+
("accountId", `String (Jmap.Id.to_string t.account_id));
349
353
] in
350
354
let json_fields = match t.ids with
351
355
| None -> json_fields
352
-
| Some ids -> ("ids", `List (List.map (fun id -> `String id) ids)) :: json_fields
356
+
| Some ids -> ("ids", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) ids)) :: json_fields
353
357
in
354
358
let json_fields = match t.properties with
355
359
| None -> json_fields
···
359
363
360
364
let of_json json =
361
365
try
362
-
let account_id = json |> member "accountId" |> to_string in
366
+
let account_id_str = json |> member "accountId" |> to_string in
367
+
let account_id = match Jmap.Id.of_string account_id_str with
368
+
| Ok id -> id
369
+
| Error _ -> failwith ("Invalid accountId: " ^ account_id_str) in
363
370
let ids =
364
371
match json |> member "ids" with
365
-
| `List items -> Some (List.map (fun item -> to_string item) items)
372
+
| `List items ->
373
+
Some (List.map (fun item ->
374
+
let id_str = to_string item in
375
+
match Jmap.Id.of_string id_str with
376
+
| Ok id -> id
377
+
| Error _ -> failwith ("Invalid id: " ^ id_str)) items)
366
378
| _ -> None
367
379
in
368
380
let properties =
···
381
393
type vacation_response = t
382
394
383
395
type t = {
384
-
account_id : id;
396
+
account_id : Jmap.Id.t;
385
397
state : string;
386
398
list : vacation_response list;
387
-
not_found : id list;
399
+
not_found : Jmap.Id.t list;
388
400
}
389
401
390
402
let account_id t = t.account_id
···
401
413
402
414
let to_json t =
403
415
`Assoc [
404
-
("accountId", `String t.account_id);
416
+
("accountId", `String (Jmap.Id.to_string t.account_id));
405
417
("state", `String t.state);
406
418
("list", `List (List.map (fun item -> (to_json item : Yojson.Safe.t)) t.list));
407
-
("notFound", `List (List.map (fun id -> `String id) t.not_found));
419
+
("notFound", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) t.not_found));
408
420
]
409
421
410
422
let of_json json =
411
423
try
412
-
let account_id = json |> member "accountId" |> to_string in
424
+
let account_id_str = json |> member "accountId" |> to_string in
425
+
let account_id = match Jmap.Id.of_string account_id_str with
426
+
| Ok id -> id
427
+
| Error _ -> failwith ("Invalid accountId: " ^ account_id_str) in
413
428
let state = json |> member "state" |> to_string in
414
429
let list_json = json |> member "list" |> to_list in
415
430
let list =
···
419
434
| Error _ -> acc (* Skip invalid items *)
420
435
) [] list_json |> List.rev
421
436
in
422
-
let not_found = json |> member "notFound" |> to_list |> List.map to_string in
437
+
let not_found = json |> member "notFound" |> to_list |> List.filter_map (fun item ->
438
+
let str = to_string item in
439
+
match Jmap.Id.of_string str with
440
+
| Ok id -> Some id
441
+
| Error _ -> None) in
423
442
Ok { account_id; state; list; not_found }
424
443
with
425
444
| Type_error (msg, _) -> Error ("Invalid VacationResponse/get response JSON: " ^ msg)
···
429
448
(** VacationResponse/set: Args type *)
430
449
module Set_args = struct
431
450
type t = {
432
-
account_id : id;
451
+
account_id : Jmap.Id.t;
433
452
if_in_state : string option;
434
-
update : Update.t id_map option;
453
+
update : (string, Update.t) Hashtbl.t option;
435
454
}
436
455
437
456
let account_id t = t.account_id
···
447
466
let singleton ~account_id ?if_in_state ~update () = {
448
467
account_id;
449
468
if_in_state;
450
-
update = Some (Hashtbl.create 1 |> fun tbl -> Hashtbl.add tbl Jmap.Types.Constants.vacation_response_id update; tbl);
469
+
update = Some (Hashtbl.create 1 |> fun tbl -> Hashtbl.add tbl "singleton" update; tbl);
451
470
}
452
471
453
472
let to_json t =
454
473
let json_fields = [
455
-
("accountId", `String t.account_id);
474
+
("accountId", `String (Jmap.Id.to_string t.account_id));
456
475
] in
457
476
let json_fields = match t.if_in_state with
458
477
| None -> json_fields
···
468
487
469
488
let of_json json =
470
489
try
471
-
let account_id = json |> member "accountId" |> to_string in
490
+
let account_id_str = json |> member "accountId" |> to_string in
491
+
let account_id = match Jmap.Id.of_string account_id_str with
492
+
| Ok id -> id
493
+
| Error _ -> failwith ("Invalid accountId: " ^ account_id_str) in
472
494
let if_in_state = json |> member "ifInState" |> to_string_option in
473
495
let update =
474
496
match json |> member "update" with
···
493
515
type vacation_response = t
494
516
495
517
type t = {
496
-
account_id : id;
518
+
account_id : Jmap.Id.t;
497
519
old_state : string option;
498
520
new_state : string;
499
-
updated : vacation_response option id_map option;
500
-
not_updated : Set_error.t id_map option;
521
+
updated : (string, vacation_response option) Hashtbl.t option;
522
+
not_updated : (string, Set_error.t) Hashtbl.t option;
501
523
}
502
524
503
525
let account_id t = t.account_id
···
510
532
match t.updated with
511
533
| None -> None
512
534
| Some updated_map ->
513
-
try Hashtbl.find updated_map Jmap.Types.Constants.vacation_response_id
535
+
try Hashtbl.find updated_map "singleton"
514
536
with Not_found -> None
515
537
516
538
let singleton_error t =
517
539
match t.not_updated with
518
540
| None -> None
519
541
| Some error_map ->
520
-
try Some (Hashtbl.find error_map Jmap.Types.Constants.vacation_response_id)
542
+
try Some (Hashtbl.find error_map "singleton")
521
543
with Not_found -> None
522
544
523
545
let v ~account_id ?old_state ~new_state ?updated ?not_updated () = {
···
530
552
531
553
let to_json t =
532
554
let json_fields = [
533
-
("accountId", `String t.account_id);
555
+
("accountId", `String (Jmap.Id.to_string t.account_id));
534
556
("newState", `String t.new_state);
535
557
] in
536
558
let json_fields = match t.old_state with
···
559
581
560
582
let of_json json =
561
583
try
562
-
let account_id = json |> member "accountId" |> to_string in
584
+
let account_id_str = json |> member "accountId" |> to_string in
585
+
let account_id = match Jmap.Id.of_string account_id_str with
586
+
| Ok id -> id
587
+
| Error _ -> failwith ("Invalid accountId: " ^ account_id_str) in
563
588
let old_state = json |> member "oldState" |> to_string_option in
564
589
let new_state = json |> member "newState" |> to_string in
565
590
let updated =
···
608
633
]
609
634
610
635
let to_string = function
611
-
| `Id -> "id"
636
+
| `Id -> "Id.t"
612
637
| `IsEnabled -> "isEnabled"
613
638
| `FromDate -> "fromDate"
614
639
| `ToDate -> "toDate"
···
617
642
| `HtmlBody -> "htmlBody"
618
643
619
644
let of_string = function
620
-
| "id" -> Some `Id
645
+
| "Id.t" -> Some `Id
621
646
| "isEnabled" -> Some `IsEnabled
622
647
| "fromDate" -> Some `FromDate
623
648
| "toDate" -> Some `ToDate
+51
-52
jmap/jmap-email/vacation.mli
+51
-52
jmap/jmap-email/vacation.mli
···
12
12
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-8> RFC 8621, Section 8: VacationResponse
13
13
*)
14
14
15
-
open Jmap.Types
16
15
open Jmap.Error
17
16
18
17
(** Complete VacationResponse object representation.
···
22
21
exactly one VacationResponse per account.
23
22
24
23
The vacation response can be enabled/disabled and configured with
25
-
date ranges, custom subject, and message content in both text and HTML.
24
+
Date.t ranges, custom subject, and message content in both text and HTML.
26
25
27
26
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-8> RFC 8621, Section 8
28
27
*)
···
38
37
include Jmap_sigs.PRINTABLE with type t := t
39
38
40
39
(** JMAP object interface for property-based operations *)
41
-
include Jmap_sigs.JMAP_OBJECT with type t := t and type id_type := id
40
+
include Jmap_sigs.JMAP_OBJECT with type t := t and type id_type := string
42
41
43
42
(** Get the vacation response ID.
44
43
@return Always returns "singleton" for VacationResponse objects *)
45
-
val id : t -> id option
44
+
val id : t -> Jmap.Id.t option
46
45
47
46
(** Check if the vacation response is currently enabled.
48
47
@return true if auto-replies are active *)
49
48
val is_enabled : t -> bool
50
49
51
-
(** Get the start date for the vacation period.
52
-
@return Optional start date, None means no start constraint *)
53
-
val from_date : t -> utc_date option
50
+
(** Get the start Date.t for the vacation period.
51
+
@return Optional start Date.t, None means no start constraint *)
52
+
val from_date : t -> Jmap.Date.t option
54
53
55
-
(** Get the end date for the vacation period.
56
-
@return Optional end date, None means no end constraint *)
57
-
val to_date : t -> utc_date option
54
+
(** Get the end Date.t for the vacation period.
55
+
@return Optional end Date.t, None means no end constraint *)
56
+
val to_date : t -> Jmap.Date.t option
58
57
59
58
(** Get the custom subject line for vacation replies.
60
59
@return Optional subject override, None uses default subject *)
···
69
68
val html_body : t -> string option
70
69
71
70
(** Create a VacationResponse object.
72
-
@param id Must be "singleton" for VacationResponse objects
71
+
@param Jmap.Id.t Must be "singleton" for VacationResponse objects
73
72
@param is_enabled Whether vacation replies are active
74
-
@param from_date Optional start date for vacation period
75
-
@param to_date Optional end date for vacation period
73
+
@param from_date Optional start Date.t for vacation period
74
+
@param to_date Optional end Date.t for vacation period
76
75
@param subject Optional custom subject line
77
76
@param text_body Optional plain text message content
78
77
@param html_body Optional HTML message content
79
78
@return New VacationResponse object *)
80
79
val v :
81
-
id:id ->
80
+
id:Jmap.Id.t ->
82
81
is_enabled:bool ->
83
-
?from_date:utc_date ->
84
-
?to_date:utc_date ->
82
+
?from_date:Jmap.Date.t ->
83
+
?to_date:Jmap.Date.t ->
85
84
?subject:string ->
86
85
?text_body:string ->
87
86
?html_body:string ->
···
108
107
@return Optional enabled flag for update *)
109
108
val is_enabled : t -> bool option
110
109
111
-
(** Get the start date update.
112
-
@return Optional start date change *)
113
-
val from_date : t -> utc_date option option
110
+
(** Get the start Date.t update.
111
+
@return Optional start Date.t change *)
112
+
val from_date : t -> Jmap.Date.t option option
114
113
115
-
(** Get the end date update.
116
-
@return Optional end date change *)
117
-
val to_date : t -> utc_date option option
114
+
(** Get the end Date.t update.
115
+
@return Optional end Date.t change *)
116
+
val to_date : t -> Jmap.Date.t option option
118
117
119
118
(** Get the subject line update.
120
119
@return Optional subject change *)
···
130
129
131
130
(** Create VacationResponse update parameters.
132
131
@param is_enabled Optional enabled flag update
133
-
@param from_date Optional start date update
134
-
@param to_date Optional end date update
132
+
@param from_date Optional start Date.t update
133
+
@param to_date Optional end Date.t update
135
134
@param subject Optional subject update
136
135
@param text_body Optional text body update
137
136
@param html_body Optional HTML body update
138
137
@return Update parameters *)
139
138
val v :
140
139
?is_enabled:bool ->
141
-
?from_date:utc_date option ->
142
-
?to_date:utc_date option ->
140
+
?from_date:Jmap.Date.t option ->
141
+
?to_date:Jmap.Date.t option ->
143
142
?subject:string option ->
144
143
?text_body:string option ->
145
144
?html_body:string option ->
146
145
unit -> t
147
146
148
147
(** Create an update to enable vacation responses.
149
-
@param from_date Optional start date for vacation period
150
-
@param to_date Optional end date for vacation period
148
+
@param from_date Optional start Date.t for vacation period
149
+
@param to_date Optional end Date.t for vacation period
151
150
@param subject Optional custom subject line
152
151
@param text_body Optional text message content
153
152
@param html_body Optional HTML message content
154
153
@return Update to enable vacation with specified settings *)
155
154
val enable :
156
-
?from_date:utc_date ->
157
-
?to_date:utc_date ->
155
+
?from_date:Jmap.Date.t ->
156
+
?to_date:Jmap.Date.t ->
158
157
?subject:string ->
159
158
?text_body:string ->
160
159
?html_body:string ->
···
188
187
189
188
(** Get the account ID for the operation.
190
189
@return Account identifier where vacation response will be retrieved *)
191
-
val account_id : t -> id
190
+
val account_id : t -> Jmap.Id.t
192
191
193
192
(** Get the specific vacation response IDs to retrieve.
194
193
@return List should be ["singleton"] or None for the singleton object *)
195
-
val ids : t -> id list option
194
+
val ids : t -> Jmap.Id.t list option
196
195
197
196
(** Get the properties to include in the response.
198
197
@return List of property names, or None for all properties *)
···
204
203
@param properties Optional list of properties to retrieve
205
204
@return VacationResponse/get arguments *)
206
205
val v :
207
-
account_id:id ->
208
-
?ids:id list ->
206
+
account_id:Jmap.Id.t ->
207
+
?ids:Jmap.Id.t list ->
209
208
?properties:string list ->
210
209
unit -> t
211
210
···
214
213
@param properties Optional list of properties to retrieve
215
214
@return Arguments configured for singleton retrieval *)
216
215
val singleton :
217
-
account_id:id ->
216
+
account_id:Jmap.Id.t ->
218
217
?properties:string list ->
219
218
unit -> t
220
219
end
···
235
234
236
235
(** Get the account ID from the response.
237
236
@return Account identifier where vacation response was retrieved *)
238
-
val account_id : t -> id
237
+
val account_id : t -> Jmap.Id.t
239
238
240
239
(** Get the current state string for change tracking.
241
240
@return State string for use in VacationResponse/set *)
···
247
246
248
247
(** Get the list of vacation response IDs that were not found.
249
248
@return List of requested IDs that don't exist *)
250
-
val not_found : t -> id list
249
+
val not_found : t -> Jmap.Id.t list
251
250
252
251
(** Create VacationResponse/get response.
253
252
@param account_id Account where vacation response was retrieved
···
256
255
@param not_found List of requested IDs that were not found
257
256
@return VacationResponse/get response *)
258
257
val v :
259
-
account_id:id ->
258
+
account_id:Jmap.Id.t ->
260
259
state:string ->
261
260
list:vacation_response list ->
262
-
not_found:id list ->
261
+
not_found:Jmap.Id.t list ->
263
262
unit -> t
264
263
265
264
(** Get the singleton vacation response if present.
···
283
282
284
283
(** Get the account ID for the set operation.
285
284
@return Account where vacation response will be updated *)
286
-
val account_id : t -> id
285
+
val account_id : t -> Jmap.Id.t
287
286
288
287
(** Get the conditional state for the update.
289
288
@return Optional state string for conditional updates *)
···
291
290
292
291
(** Get the update operations to perform.
293
292
@return Map of "singleton" to update patch object *)
294
-
val update : t -> Update.t id_map option
293
+
val update : t -> (string, Update.t) Hashtbl.t option
295
294
296
295
(** Create VacationResponse/set arguments.
297
296
@param account_id Account where vacation response will be updated
···
299
298
@param update Map containing "singleton" -> update object
300
299
@return VacationResponse/set arguments *)
301
300
val v :
302
-
account_id:id ->
301
+
account_id:Jmap.Id.t ->
303
302
?if_in_state:string ->
304
-
?update:Update.t id_map ->
303
+
?update:(string, Update.t) Hashtbl.t ->
305
304
unit ->
306
305
t
307
306
···
311
310
@param update Update parameters for the singleton
312
311
@return Arguments configured for singleton update *)
313
312
val singleton :
314
-
account_id:id ->
313
+
account_id:Jmap.Id.t ->
315
314
?if_in_state:string ->
316
315
update:Update.t ->
317
316
unit -> t
···
333
332
334
333
(** Get the account ID from the response.
335
334
@return Account where vacation response was updated *)
336
-
val account_id : t -> id
335
+
val account_id : t -> Jmap.Id.t
337
336
338
337
(** Get the old state string.
339
338
@return Previous state if available *)
···
345
344
346
345
(** Get the successfully updated VacationResponse objects.
347
346
@return Map of "singleton" to updated VacationResponse (if successful) *)
348
-
val updated : t -> vacation_response option id_map option
347
+
val updated : t -> (string, vacation_response option) Hashtbl.t option
349
348
350
349
(** Get the vacation responses that failed to update.
351
350
@return Map of IDs to error information for failed updates *)
352
-
val not_updated : t -> Set_error.t id_map option
351
+
val not_updated : t -> (string, Set_error.t) Hashtbl.t option
353
352
354
353
(** Create VacationResponse/set response.
355
354
@param account_id Account where vacation response was updated
···
359
358
@param not_updated Map of failed updates with errors
360
359
@return VacationResponse/set response *)
361
360
val v :
362
-
account_id:id ->
361
+
account_id:Jmap.Id.t ->
363
362
?old_state:string ->
364
363
new_state:string ->
365
-
?updated:vacation_response option id_map ->
366
-
?not_updated:Set_error.t id_map ->
364
+
?updated:(string, vacation_response option) Hashtbl.t ->
365
+
?not_updated:(string, Set_error.t) Hashtbl.t ->
367
366
unit ->
368
367
t
369
368
···
395
394
type t = [
396
395
| `Id (** Server-assigned unique identifier (always "singleton") (immutable, server-set) *)
397
396
| `IsEnabled (** Whether vacation response is currently active *)
398
-
| `FromDate (** Start date for vacation response activation *)
399
-
| `ToDate (** End date for vacation response activation *)
397
+
| `FromDate (** Start Date.t for vacation response activation *)
398
+
| `ToDate (** End Date.t for vacation response activation *)
400
399
| `Subject (** Subject line for vacation response messages *)
401
400
| `TextBody (** Plain text body for vacation responses *)
402
401
| `HtmlBody (** HTML body for vacation responses *)
+11
-11
jmap/jmap-unix/client.mli
+11
-11
jmap/jmap-unix/client.mli
···
119
119
val get_emails :
120
120
t ->
121
121
?account_id:string ->
122
-
Jmap.Types.id list ->
122
+
string list ->
123
123
?properties:Jmap_email.Property.t list ->
124
124
unit ->
125
125
(Jmap_email.Email.t list, Jmap.Error.error) result
···
137
137
t ->
138
138
account_id:string ->
139
139
raw_message:bytes ->
140
-
mailbox_ids:Jmap.Types.id list ->
140
+
mailbox_ids:string list ->
141
141
?keywords:string list ->
142
142
?received_at:Jmap.Types.date ->
143
143
unit ->
···
152
152
val destroy_email :
153
153
t ->
154
154
account_id:string ->
155
-
email_id:Jmap.Types.id ->
155
+
email_id:string ->
156
156
(unit, Jmap.Error.error) result
157
157
158
158
(** Set email keywords (flags) - replaces all existing keywords.
···
165
165
val set_email_keywords :
166
166
t ->
167
167
account_id:string ->
168
-
email_id:Jmap.Types.id ->
168
+
email_id:string ->
169
169
keywords:string list ->
170
170
(unit, Jmap.Error.error) result
171
171
···
179
179
val set_email_mailboxes :
180
180
t ->
181
181
account_id:string ->
182
-
email_id:Jmap.Types.id ->
183
-
mailbox_ids:Jmap.Types.id list ->
182
+
email_id:string ->
183
+
mailbox_ids:string list ->
184
184
(unit, Jmap.Error.error) result
185
185
186
186
(** {1 Mailbox Operations} *)
···
212
212
t ->
213
213
account_id:string ->
214
214
name:string ->
215
-
?parent_id:Jmap.Types.id ->
215
+
?parent_id:string ->
216
216
?role:Jmap_email.Mailbox.Role.t ->
217
217
unit ->
218
-
(Jmap.Types.id, Jmap.Error.error) result
218
+
(string, Jmap.Error.error) result
219
219
220
220
(** Destroy mailbox.
221
221
···
227
227
val destroy_mailbox :
228
228
t ->
229
229
account_id:string ->
230
-
mailbox_id:Jmap.Types.id ->
230
+
mailbox_id:string ->
231
231
?on_destroy_remove_emails:bool ->
232
232
unit ->
233
233
(unit, Jmap.Error.error) result
···
262
262
?sort:Jmap_email.Query.Sort.t list ->
263
263
?limit:int ->
264
264
unit ->
265
-
Jmap.Types.id list batch_operation
265
+
string list batch_operation
266
266
267
267
(** Add email get operation using result reference from query *)
268
268
val get_emails_ref :
269
269
batch_builder ->
270
-
Jmap.Types.id list batch_operation ->
270
+
string list batch_operation ->
271
271
?properties:Jmap_email.Property.t list ->
272
272
unit ->
273
273
Jmap_email.Email.t list batch_operation
+32
-22
jmap/jmap-unix/jmap_unix.ml
+32
-22
jmap/jmap-unix/jmap_unix.ml
···
138
138
let all_headers =
139
139
let base_headers = [
140
140
("Host", host);
141
-
("User-Agent", Option.value ctx.config.user_agent ~default:Jmap.Types.Constants.User_agent.eio_client);
142
-
("Accept", Jmap.Types.Constants.Content_type.json);
143
-
("Content-Type", Jmap.Types.Constants.Content_type.json);
141
+
("User-Agent", Option.value ctx.config.user_agent ~default:"jmap-eio-client/1.0");
142
+
("Accept", "application/json");
143
+
("Content-Type", "application/json");
144
144
] in
145
145
let auth_hdrs = auth_headers ctx.auth in
146
146
List.rev_append auth_hdrs (List.rev_append headers base_headers)
···
362
362
| Ok _response_body ->
363
363
(* Simple response construction - in a real implementation would parse JSON *)
364
364
let response = Jmap.Binary.Upload_response.v
365
-
~account_id
366
-
~blob_id:("blob-" ^ account_id ^ "-" ^ string_of_int (Random.int 1000000))
365
+
~account_string:account_id
366
+
~blob_string:("blob-" ^ account_id ^ "-" ^ string_of_int (Random.int 1000000))
367
367
~type_:content_type
368
368
~size:1000
369
369
()
···
411
411
let copied = Hashtbl.create (List.length blob_ids) in
412
412
List.iter (fun id -> Hashtbl.add copied id id) blob_ids;
413
413
let copy_response = Jmap.Binary.Blob_copy_response.v
414
-
~from_account_id
415
-
~account_id
414
+
~from_account_string:from_account_id
415
+
~account_string:account_id
416
416
~copied
417
417
()
418
418
in
419
419
Ok copy_response
420
420
| Error e -> Error e)
421
421
422
-
let connect_event_source env ctx ?(types=[]) ?(close_after=`No) ?(ping=30) () =
422
+
let connect_event_source env ctx ?(types=[]) ?(close_after=`No) ?(ping=(match Jmap.UInt.of_int 30 with Ok v -> v | Error _ -> failwith "Invalid default ping")) () =
423
423
let _ = ignore env in
424
424
let _ = ignore ctx in
425
425
let _ = ignore types in
···
543
543
(* Bridge to jmap-email query functionality *)
544
544
module Query_args = struct
545
545
type t = {
546
-
account_id : Jmap.Types.id;
546
+
account_id : string;
547
547
filter : Jmap.Methods.Filter.t option;
548
548
sort : Jmap.Methods.Comparator.t list option;
549
549
position : int option;
550
-
limit : Jmap.Types.uint option;
550
+
limit : Jmap.UInt.t option;
551
551
calculate_total : bool option;
552
552
collapse_threads : bool option;
553
553
}
···
574
574
| None -> args
575
575
in
576
576
let args = match t.limit with
577
-
| Some lim -> ("limit", `Int lim) :: args
577
+
| Some lim -> ("limit", `Int (Jmap.UInt.to_int lim)) :: args
578
578
| None -> args
579
579
in
580
580
let args = match t.calculate_total with
···
590
590
591
591
module Get_args = struct
592
592
type ids_source =
593
-
| Specific_ids of Jmap.Types.id list
593
+
| Specific_ids of string list
594
594
| Result_reference of {
595
595
result_of : string;
596
596
name : string;
···
598
598
}
599
599
600
600
type t = {
601
-
account_id : Jmap.Types.id;
601
+
account_id : string;
602
602
ids_source : ids_source;
603
603
properties : string list option;
604
604
}
···
665
665
| None -> `Bool false);
666
666
]) s)
667
667
| None -> `Null);
668
-
("limit", match limit with Some l -> `Int l | None -> `Null);
668
+
("limit", match limit with Some l -> `Int (Jmap.UInt.to_int l) | None -> `Null);
669
669
("position", match position with Some p -> `Int p | None -> `Null);
670
670
] in
671
671
let builder = build ctx
···
729
729
| Error e -> Error e
730
730
731
731
let move_emails env ctx ~account_id ~email_ids ~mailbox_id ?remove_from_mailboxes () =
732
+
(* Convert string IDs to Jmap.Id.t *)
733
+
let mailbox_id_t = match Jmap.Id.of_string mailbox_id with Ok id -> id | Error _ -> failwith ("Invalid mailbox_id: " ^ mailbox_id) in
734
+
let remove_from_mailboxes_t = match remove_from_mailboxes with
735
+
| Some mailbox_ids -> Some (List.map (fun id_str -> match Jmap.Id.of_string id_str with Ok id -> id | Error _ -> failwith ("Invalid remove_from_mailboxes id: " ^ id_str)) mailbox_ids)
736
+
| None -> None
737
+
in
732
738
(* Create Email/set request with mailbox patches *)
733
-
let patch = match remove_from_mailboxes with
739
+
let patch = match remove_from_mailboxes_t with
734
740
| Some mailbox_ids_to_remove ->
735
741
(* Move to new mailbox and remove from specified ones *)
736
742
JmapEmail.Email.Patch.create
737
-
~add_mailboxes:[mailbox_id]
743
+
~add_mailboxes:[mailbox_id_t]
738
744
~remove_mailboxes:mailbox_ids_to_remove
739
745
()
740
746
| None ->
741
747
(* Move to single mailbox (replace all existing) *)
742
-
JmapEmail.Email.Patch.move_to_mailboxes [mailbox_id]
748
+
JmapEmail.Email.Patch.move_to_mailboxes [mailbox_id_t]
743
749
in
744
750
let updates = List.fold_left (fun acc email_id ->
745
751
(email_id, patch) :: acc
···
779
785
| Error e -> Error e
780
786
781
787
let import_email env ctx ~account_id ~rfc822 ~mailbox_ids ?keywords ?received_at () =
782
-
let _ = ignore rfc822 in
788
+
let _rfc822_content = (rfc822 : string) in
783
789
let blob_id = "blob-" ^ account_id ^ "-" ^ string_of_int (Random.int 1000000) in
784
790
(* Note: Email/import uses different argument structure, keeping manual for now *)
785
791
let args = `Assoc [
···
787
793
("blobIds", `List [`String blob_id]);
788
794
("mailboxIds", `Assoc (List.map (fun id -> (id, `String id)) mailbox_ids));
789
795
("keywords", match keywords with
790
-
| Some _kws -> `Assoc [] (* Simplified for now *)
796
+
| Some kws -> Jmap_email.Keywords.to_json kws
791
797
| None -> `Null);
792
798
("receivedAt", match received_at with
793
-
| Some d -> `Float d
799
+
| Some d -> `Float (Jmap.Date.to_timestamp d)
794
800
| None -> `Null);
795
801
] in
796
802
let builder = build ctx
···
933
939
| None -> args
934
940
in
935
941
let args = match limit with
936
-
| Some l -> ("limit", `Int l) :: args
942
+
| Some l -> ("limit", `Int (Jmap.UInt.to_int l)) :: args
937
943
| None -> args
938
944
in
939
945
let args = match position with
···
1002
1008
end
1003
1009
1004
1010
let email_query ?account_id ?filter ?sort ?limit ?position builder =
1005
-
let args = EmailQuery.build_args ?account_id ?filter ?sort ?limit ?position () in
1011
+
let limit_uint = match limit with
1012
+
| Some i -> Some (match Jmap.UInt.of_int i with Ok u -> u | Error _ -> failwith ("Invalid limit: " ^ string_of_int i))
1013
+
| None -> None
1014
+
in
1015
+
let args = EmailQuery.build_args ?account_id ?filter ?sort ?limit:limit_uint ?position () in
1006
1016
let call_id = "email-query-" ^ string_of_int (Random.int 10000) in
1007
1017
{ builder with methods = (Jmap.Method_names.method_to_string `Email_query, args, call_id) :: builder.methods }
1008
1018
+54
-54
jmap/jmap-unix/jmap_unix.mli
+54
-54
jmap/jmap-unix/jmap_unix.mli
···
140
140
val upload :
141
141
< net : 'a Eio.Net.t ; .. > ->
142
142
context ->
143
-
account_id:Jmap.Types.id ->
143
+
account_id:string ->
144
144
content_type:string ->
145
145
data_stream:string Seq.t ->
146
146
Jmap.Binary.Upload_response.t Jmap.Error.result
···
157
157
val download :
158
158
< net : 'a Eio.Net.t ; .. > ->
159
159
context ->
160
-
account_id:Jmap.Types.id ->
161
-
blob_id:Jmap.Types.id ->
160
+
account_id:string ->
161
+
blob_id:string ->
162
162
?content_type:string ->
163
163
?name:string ->
164
164
unit ->
···
175
175
val copy_blobs :
176
176
< net : 'a Eio.Net.t ; .. > ->
177
177
context ->
178
-
from_account_id:Jmap.Types.id ->
179
-
account_id:Jmap.Types.id ->
180
-
blob_ids:Jmap.Types.id list ->
178
+
from_account_id:string ->
179
+
account_id:string ->
180
+
blob_ids:string list ->
181
181
Jmap.Binary.Blob_copy_response.t Jmap.Error.result
182
182
183
183
(** Connect to the EventSource for push notifications.
···
193
193
context ->
194
194
?types:string list ->
195
195
?close_after:[`State | `No] ->
196
-
?ping:Jmap.Types.uint ->
196
+
?ping:Jmap.UInt.t ->
197
197
unit ->
198
198
(event_source_connection *
199
199
([`State of Jmap.Push.State_change.t | `Ping of Jmap.Push.Event_source_ping_data.t ] Seq.t)) Jmap.Error.result
···
246
246
< net : 'a Eio.Net.t ; .. > ->
247
247
context ->
248
248
method_name:Jmap.Method_names.jmap_method ->
249
-
account_id:Jmap.Types.id ->
250
-
object_id:Jmap.Types.id ->
249
+
account_id:string ->
250
+
object_id:string ->
251
251
?properties:string list ->
252
252
unit ->
253
253
Yojson.Safe.t Jmap.Error.result
···
333
333
val add_get_with_reference :
334
334
t ->
335
335
method_name:Jmap.Method_names.jmap_method ->
336
-
account_id:Jmap.Types.id ->
336
+
account_id:string ->
337
337
result_reference:Jmap.Wire.Result_reference.t ->
338
338
?properties:string list ->
339
339
method_call_id:string ->
···
370
370
@param ?collapse_threads Whether to collapse threads (None = false)
371
371
@return Email query arguments object *)
372
372
val create :
373
-
account_id:Jmap.Types.id ->
373
+
account_id:string ->
374
374
?filter:Jmap.Methods.Filter.t ->
375
375
?sort:Jmap.Methods.Comparator.t list ->
376
376
?position:int ->
377
-
?limit:Jmap.Types.uint ->
377
+
?limit:Jmap.UInt.t ->
378
378
?calculate_total:bool ->
379
379
?collapse_threads:bool ->
380
380
unit ->
···
401
401
@param ?properties Optional list of properties to return (None = all properties)
402
402
@return Email get arguments object *)
403
403
val create :
404
-
account_id:Jmap.Types.id ->
405
-
ids:Jmap.Types.id list ->
404
+
account_id:string ->
405
+
ids:string list ->
406
406
?properties:string list ->
407
407
unit ->
408
408
t
···
416
416
@param ?properties Optional list of properties to return (None = all properties)
417
417
@return Email get arguments object *)
418
418
val create_with_reference :
419
-
account_id:Jmap.Types.id ->
419
+
account_id:string ->
420
420
result_of:string ->
421
421
name:string ->
422
422
path:string ->
···
441
441
val get_email :
442
442
< net : 'a Eio.Net.t ; .. > ->
443
443
context ->
444
-
account_id:Jmap.Types.id ->
445
-
email_id:Jmap.Types.id ->
444
+
account_id:string ->
445
+
email_id:string ->
446
446
?properties:string list ->
447
447
unit ->
448
448
Jmap_email.Email.t Jmap.Error.result
···
460
460
val search_emails :
461
461
< net : 'a Eio.Net.t ; .. > ->
462
462
context ->
463
-
account_id:Jmap.Types.id ->
463
+
account_id:string ->
464
464
filter:Jmap.Methods.Filter.t ->
465
465
?sort:Jmap.Methods.Comparator.t list ->
466
-
?limit:Jmap.Types.uint ->
466
+
?limit:Jmap.UInt.t ->
467
467
?position:int ->
468
468
?properties:string list ->
469
469
unit ->
470
-
(Jmap.Types.id list * Jmap_email.Email.t list option) Jmap.Error.result
470
+
(string list * Jmap_email.Email.t list option) Jmap.Error.result
471
471
472
472
(** Mark multiple emails with a keyword
473
473
@param env The Eio environment for network operations
···
480
480
val mark_emails :
481
481
< net : 'a Eio.Net.t ; .. > ->
482
482
context ->
483
-
account_id:Jmap.Types.id ->
484
-
email_ids:Jmap.Types.id list ->
483
+
account_id:string ->
484
+
email_ids:string list ->
485
485
keyword:Jmap_email.Keywords.keyword ->
486
486
unit ->
487
487
unit Jmap.Error.result
···
496
496
val mark_as_seen :
497
497
< net : 'a Eio.Net.t ; .. > ->
498
498
context ->
499
-
account_id:Jmap.Types.id ->
500
-
email_ids:Jmap.Types.id list ->
499
+
account_id:string ->
500
+
email_ids:string list ->
501
501
unit ->
502
502
unit Jmap.Error.result
503
503
···
511
511
val mark_as_unseen :
512
512
< net : 'a Eio.Net.t ; .. > ->
513
513
context ->
514
-
account_id:Jmap.Types.id ->
515
-
email_ids:Jmap.Types.id list ->
514
+
account_id:string ->
515
+
email_ids:string list ->
516
516
unit ->
517
517
unit Jmap.Error.result
518
518
···
528
528
val move_emails :
529
529
< net : 'a Eio.Net.t ; .. > ->
530
530
context ->
531
-
account_id:Jmap.Types.id ->
532
-
email_ids:Jmap.Types.id list ->
533
-
mailbox_id:Jmap.Types.id ->
534
-
?remove_from_mailboxes:Jmap.Types.id list ->
531
+
account_id:string ->
532
+
email_ids:string list ->
533
+
mailbox_id:string ->
534
+
?remove_from_mailboxes:string list ->
535
535
unit ->
536
536
unit Jmap.Error.result
537
537
···
548
548
val import_email :
549
549
< net : 'a Eio.Net.t ; .. > ->
550
550
context ->
551
-
account_id:Jmap.Types.id ->
551
+
account_id:string ->
552
552
rfc822:string ->
553
-
mailbox_ids:Jmap.Types.id list ->
553
+
mailbox_ids:string list ->
554
554
?keywords:Jmap_email.Keywords.t ->
555
-
?received_at:Jmap.Types.date ->
555
+
?received_at:Jmap.Date.t ->
556
556
unit ->
557
-
Jmap.Types.id Jmap.Error.result
557
+
string Jmap.Error.result
558
558
559
559
(** {2 JSON Parsing Functions} *)
560
560
···
611
611
Falls back to the first available account if no primary mail account is found.
612
612
@param session The JMAP session
613
613
@return The account ID to use for mail operations *)
614
-
val get_primary_mail_account : Jmap.Session.Session.t -> Jmap.Types.id
614
+
val get_primary_mail_account : Jmap.Session.Session.t -> string
615
615
end
616
616
617
617
(** Response utilities for extracting data from JMAP responses *)
···
651
651
652
652
(** Add Email/query method *)
653
653
val email_query :
654
-
?account_id:Jmap.Types.id ->
654
+
?account_id:string ->
655
655
?filter:Yojson.Safe.t ->
656
656
?sort:Jmap.Methods.Comparator.t list ->
657
657
?limit:int ->
···
660
660
661
661
(** Add Email/get method with automatic result reference *)
662
662
val email_get :
663
-
?account_id:Jmap.Types.id ->
664
-
?ids:Jmap.Types.Id.t list ->
663
+
?account_id:string ->
664
+
?ids:Jmap.Id.t list ->
665
665
?properties:string list ->
666
666
?reference_from:string -> (* Call ID to reference *)
667
667
t -> t
668
668
669
669
(** Add Email/set method *)
670
670
val email_set :
671
-
?account_id:Jmap.Types.id ->
671
+
?account_id:string ->
672
672
?create:(string * Yojson.Safe.t) list ->
673
-
?update:(Jmap.Types.Id.t * Jmap.Types.Patch.t) list ->
674
-
?destroy:Jmap.Types.Id.t list ->
673
+
?update:(Jmap.Id.t * Jmap.Patch.t) list ->
674
+
?destroy:Jmap.Id.t list ->
675
675
t -> t
676
676
677
677
(** Add Thread/get method *)
678
678
val thread_get :
679
-
?account_id:Jmap.Types.id ->
680
-
?ids:Jmap.Types.Id.t list ->
679
+
?account_id:string ->
680
+
?ids:Jmap.Id.t list ->
681
681
t -> t
682
682
683
683
(** Add Mailbox/query method *)
684
684
val mailbox_query :
685
-
?account_id:Jmap.Types.id ->
685
+
?account_id:string ->
686
686
?filter:Yojson.Safe.t ->
687
687
?sort:Jmap.Methods.Comparator.t list ->
688
688
t -> t
689
689
690
690
(** Add Mailbox/get method *)
691
691
val mailbox_get :
692
-
?account_id:Jmap.Types.id ->
693
-
?ids:Jmap.Types.Id.t list ->
692
+
?account_id:string ->
693
+
?ids:Jmap.Id.t list ->
694
694
t -> t
695
695
696
696
(** Execute the built request *)
···
742
742
< net : 'a Eio.Net.t ; .. > ->
743
743
ctx:context ->
744
744
session:Jmap.Session.Session.t ->
745
-
?account_id:Jmap.Types.id ->
745
+
?account_id:string ->
746
746
?filter:Yojson.Safe.t ->
747
747
?sort:Jmap.Methods.Comparator.t list ->
748
748
?limit:int ->
···
755
755
< net : 'a Eio.Net.t ; .. > ->
756
756
ctx:context ->
757
757
session:Jmap.Session.Session.t ->
758
-
?account_id:Jmap.Types.id ->
758
+
?account_id:string ->
759
759
?properties:string list ->
760
-
Jmap.Types.Id.t list ->
760
+
Jmap.Id.t list ->
761
761
(Yojson.Safe.t list, Jmap.Error.error) result
762
762
763
763
(** Get all mailboxes *)
···
765
765
< net : 'a Eio.Net.t ; .. > ->
766
766
ctx:context ->
767
767
session:Jmap.Session.Session.t ->
768
-
?account_id:Jmap.Types.id ->
768
+
?account_id:string ->
769
769
unit ->
770
770
(Yojson.Safe.t list, Jmap.Error.error) result
771
771
···
774
774
< net : 'a Eio.Net.t ; .. > ->
775
775
ctx:context ->
776
776
session:Jmap.Session.Session.t ->
777
-
?account_id:Jmap.Types.id ->
777
+
?account_id:string ->
778
778
string ->
779
779
(Yojson.Safe.t option, Jmap.Error.error) result
780
780
end
···
812
812
< net : 'a Eio.Net.t ; .. > ->
813
813
ctx:context ->
814
814
session:Jmap.Session.Session.t ->
815
-
?account_id:Jmap.Types.id ->
815
+
?account_id:string ->
816
816
Yojson.Safe.t ->
817
817
(Yojson.Safe.t, Jmap.Error.error) result
818
818
···
823
823
< net : 'a Eio.Net.t ; .. > ->
824
824
ctx:context ->
825
825
session:Jmap.Session.Session.t ->
826
-
email_ids:Jmap.Types.Id.t list ->
826
+
email_ids:Jmap.Id.t list ->
827
827
(Yojson.Safe.t, Jmap.Error.error) result
828
828
829
829
(** Bulk delete spam/trash emails older than N days *)
···
855
855
< net : 'a Eio.Net.t ; .. > ->
856
856
ctx:context ->
857
857
session:Jmap.Session.Session.t ->
858
-
?account_id:Jmap.Types.id ->
858
+
?account_id:string ->
859
859
progress_fn:(progress -> unit) ->
860
860
Yojson.Safe.t ->
861
861
(Yojson.Safe.t, Jmap.Error.error) result
+122
jmap/jmap/date.ml
+122
jmap/jmap/date.ml
···
1
+
(** JMAP Date 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 = Format.fprintf ppf "%s" (to_rfc3339 date)
106
+
107
+
let pp_hum ppf date = Format.fprintf ppf "Date(%s)" (to_rfc3339 date)
108
+
109
+
let pp_debug ppf date =
110
+
Format.fprintf 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/date.mli
+98
jmap/jmap/date.mli
···
1
+
(** JMAP Date data type with RFC 3339 support and JSON serialization.
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
+
(** {2 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
+
(** {2 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
+
(** {2 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
+4
-1
jmap/jmap/dune
+4
-1
jmap/jmap/dune
+7
-7
jmap/jmap/error.ml
+7
-7
jmap/jmap/error.ml
···
1
-
open Types
1
+
(* Use underlying types directly to avoid circular dependency with Jmap module *)
2
2
open Yojson.Safe.Util
3
3
4
4
type method_error_type = [
···
101
101
| `Network_error of network_error_kind * string * bool (** kind * message * retryable *)
102
102
| `Parse_error of parse_error_kind * string (** kind * context *)
103
103
| `Method_error of string * string * method_error_type * string option (** method_name * call_id * type * description *)
104
-
| `Set_error of string * id * set_error_type * string option (** method_name * object_id * type * description *)
104
+
| `Set_error of string * string * set_error_type * string option (** method_name * object_id * type * description *)
105
105
| `Auth_error of auth_error_kind * string (** kind * message *)
106
106
| `Server_error of server_error_kind * string (** kind * message *)
107
107
| `Timeout_error of timeout_context * string (** context * message *)
···
243
243
status : int option;
244
244
detail : string option;
245
245
limit : string option;
246
-
other_fields : Yojson.Safe.t string_map;
246
+
other_fields : (string, Yojson.Safe.t) Hashtbl.t;
247
247
}
248
248
249
249
let problem_type t = t.problem_type
···
377
377
type_ : set_error_type;
378
378
description : string option;
379
379
properties : string list option;
380
-
existing_id : id option;
381
-
max_recipients : uint option;
380
+
existing_id : string option;
381
+
max_recipients : int option;
382
382
invalid_recipients : string list option;
383
-
max_size : uint option;
384
-
not_found_blob_ids : id list option;
383
+
max_size : int option;
384
+
not_found_blob_ids : string list option;
385
385
}
386
386
387
387
let type_ t = t.type_
+14
-14
jmap/jmap/error.mli
+14
-14
jmap/jmap/error.mli
···
6
6
7
7
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.6> RFC 8620, Section 3.6 *)
8
8
9
-
open Types
9
+
(* Use underlying types directly to avoid circular dependency with Jmap module *)
10
10
11
11
(** {1 Method-Level Error Types} *)
12
12
···
223
223
| `Network_error of network_error_kind * string * bool (** kind * message * retryable *)
224
224
| `Parse_error of parse_error_kind * string (** kind * context *)
225
225
| `Method_error of string * string * method_error_type * string option (** method_name * call_id * type * description *)
226
-
| `Set_error of string * id * set_error_type * string option (** method_name * object_id * type * description *)
226
+
| `Set_error of string * string * set_error_type * string option (** method_name * object_id * type * description *)
227
227
| `Auth_error of auth_error_kind * string (** kind * message *)
228
228
| `Server_error of server_error_kind * string (** kind * message *)
229
229
| `Timeout_error of timeout_context * string (** context * message *)
···
296
296
val status : t -> int option
297
297
val detail : t -> string option
298
298
val limit : t -> string option
299
-
val other_fields : t -> Yojson.Safe.t string_map
299
+
val other_fields : t -> (string, Yojson.Safe.t) Hashtbl.t
300
300
301
301
val v :
302
302
?status:int ->
303
303
?detail:string ->
304
304
?limit:string ->
305
-
?other_fields:Yojson.Safe.t string_map ->
305
+
?other_fields:(string, Yojson.Safe.t) Hashtbl.t ->
306
306
string ->
307
307
t
308
308
end
···
348
348
val type_ : t -> set_error_type
349
349
val description : t -> string option
350
350
val properties : t -> string list option
351
-
val existing_id : t -> id option
352
-
val max_recipients : t -> uint option
351
+
val existing_id : t -> string option
352
+
val max_recipients : t -> int option
353
353
val invalid_recipients : t -> string list option
354
-
val max_size : t -> uint option
355
-
val not_found_blob_ids : t -> id list option
354
+
val max_size : t -> int option
355
+
val not_found_blob_ids : t -> string list option
356
356
357
357
val v :
358
358
?description:string ->
359
359
?properties:string list ->
360
-
?existing_id:id ->
361
-
?max_recipients:uint ->
360
+
?existing_id:string ->
361
+
?max_recipients:int ->
362
362
?invalid_recipients:string list ->
363
-
?max_size:uint ->
364
-
?not_found_blob_ids:id list ->
363
+
?max_size:int ->
364
+
?not_found_blob_ids:string list ->
365
365
set_error_type ->
366
366
t
367
367
···
400
400
val method_error : ?description:string -> method_error_type -> error
401
401
402
402
(** Create a SetItem error *)
403
-
val set_item_error : id -> ?description:string -> set_error_type -> error
403
+
val set_item_error : string -> ?description:string -> set_error_type -> error
404
404
405
405
(** Create an auth error *)
406
406
val auth_error : string -> error
···
412
412
val of_method_error : Method_error.t -> error
413
413
414
414
(** Convert a Set_error.t to error for a specific ID *)
415
-
val of_set_error : id -> Set_error.t -> error
415
+
val of_set_error : string -> Set_error.t -> error
416
416
417
417
(** Create a parse error (alias) *)
418
418
val parse : string -> error
+55
jmap/jmap/id.ml
+55
jmap/jmap/id.ml
···
1
+
(** JMAP Id Implementation *)
2
+
3
+
type t = string
4
+
type id = t
5
+
6
+
let is_base64url_char c =
7
+
(c >= 'A' && c <= 'Z') ||
8
+
(c >= 'a' && c <= 'z') ||
9
+
(c >= '0' && c <= '9') ||
10
+
c = '-' || c = '_'
11
+
12
+
let is_valid_string str =
13
+
let len = String.length str in
14
+
len > 0 && len <= 255 &&
15
+
let rec check i =
16
+
if i >= len then true
17
+
else if is_base64url_char str.[i] then check (i + 1)
18
+
else false
19
+
in
20
+
check 0
21
+
22
+
let of_string str =
23
+
if is_valid_string str then Ok str
24
+
else
25
+
let len = String.length str in
26
+
if len = 0 then Error "Id cannot be empty"
27
+
else if len > 255 then Error "Id cannot be longer than 255 octets"
28
+
else Error "Id contains invalid characters (must be base64url alphabet only)"
29
+
30
+
let to_string id = id
31
+
32
+
let pp ppf id = Format.fprintf ppf "%s" id
33
+
34
+
let pp_hum ppf id = Format.fprintf ppf "Id(%s)" id
35
+
36
+
let validate id =
37
+
if is_valid_string id then Ok ()
38
+
else Error "Invalid Id format"
39
+
40
+
let equal = String.equal
41
+
42
+
let compare = String.compare
43
+
44
+
let pp_debug ppf id = Format.fprintf ppf "Id(%s)" id
45
+
46
+
let to_string_debug id = Printf.sprintf "Id(%s)" id
47
+
48
+
(* JSON serialization *)
49
+
let to_json id = `String id
50
+
51
+
let of_json = function
52
+
| `String str -> of_string str
53
+
| json ->
54
+
let json_str = Yojson.Safe.to_string json in
55
+
Error (Printf.sprintf "Expected JSON string for Id, got: %s" json_str)
+75
jmap/jmap/id.mli
+75
jmap/jmap/id.mli
···
1
+
(** JMAP Id data type with validation and JSON serialization.
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
+
type id = 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
+
(** {2 Construction and Access} *)
25
+
26
+
(** Create a new Id from a string.
27
+
@param str The string representation.
28
+
@return Ok with the created Id, or Error if the string violates Id constraints. *)
29
+
val of_string : string -> (t, string) result
30
+
31
+
(** Convert an Id to its string representation.
32
+
@param id The Id to convert.
33
+
@return The string representation. *)
34
+
val to_string : t -> string
35
+
36
+
(** Pretty-print an Id.
37
+
@param ppf The formatter.
38
+
@param id The Id to print. *)
39
+
val pp : Format.formatter -> t -> unit
40
+
41
+
(** {2 Validation} *)
42
+
43
+
(** Check if a string is a valid JMAP Id.
44
+
@param str The string to validate.
45
+
@return True if the string meets Id requirements, false otherwise. *)
46
+
val is_valid_string : string -> bool
47
+
48
+
(** Validate an Id according to JMAP constraints.
49
+
@param id The Id to validate.
50
+
@return Ok () if valid, Error with description if invalid. *)
51
+
val validate : t -> (unit, string) result
52
+
53
+
(** {2 Comparison and Utilities} *)
54
+
55
+
(** Compare two Ids for equality.
56
+
@param id1 First Id.
57
+
@param id2 Second Id.
58
+
@return True if equal, false otherwise. *)
59
+
val equal : t -> t -> bool
60
+
61
+
(** Compare two Ids lexicographically.
62
+
@param id1 First Id.
63
+
@param id2 Second Id.
64
+
@return Negative if id1 < id2, zero if equal, positive if id1 > id2. *)
65
+
val compare : t -> t -> int
66
+
67
+
(** Pretty-print an Id for debugging.
68
+
@param ppf The formatter.
69
+
@param id The Id to format. *)
70
+
val pp_debug : Format.formatter -> t -> unit
71
+
72
+
(** Convert an Id to a human-readable string for debugging.
73
+
@param id The Id to format.
74
+
@return A debug string representation. *)
75
+
val to_string_debug : t -> string
+5
-7
jmap/jmap/jmap.ml
+5
-7
jmap/jmap/jmap.ml
···
1
-
module Types = Types
2
-
3
-
(* Backwards compatibility aliases *)
4
-
module Id = Types.Id
5
-
module Date = Types.Date
6
-
module UInt = Types.UInt
7
-
module Patch = Types.Patch
1
+
(* Core type modules *)
2
+
module Id = Id
3
+
module Date = Date
4
+
module UInt = Uint
5
+
module Patch = Patch
8
6
9
7
module Capability = Jmap_capability
10
8
+10
-19
jmap/jmap/jmap.mli
+10
-19
jmap/jmap/jmap.mli
···
25
25
26
26
(** {1 Core Types and Methods} *)
27
27
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
28
+
(** {2 Core Type Modules} *)
36
29
37
-
(** {2 Backwards Compatibility Aliases} *)
38
-
39
-
(** JMAP Id data type (alias to Types.Id)
30
+
(** JMAP Id data type with validation and JSON serialization
40
31
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.2> RFC 8620, Section 1.2 *)
41
-
module Id = Types.Id
32
+
module Id = Id
42
33
43
-
(** JMAP Date data type (alias to Types.Date)
34
+
(** JMAP Date data type with RFC 3339 support and JSON serialization
44
35
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.4> RFC 8620, Section 1.4 *)
45
-
module Date = Types.Date
36
+
module Date = Date
46
37
47
-
(** JMAP UnsignedInt data type (alias to Types.UInt)
38
+
(** JMAP UnsignedInt data type with range validation and JSON serialization
48
39
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.3> RFC 8620, Section 1.3 *)
49
-
module UInt = Types.UInt
40
+
module UInt = Uint
50
41
51
-
(** JMAP Patch Object (alias to Types.Patch)
42
+
(** JMAP Patch Object for property updates with JSON serialization
52
43
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.3> RFC 8620, Section 5.3 *)
53
-
module Patch = Types.Patch
44
+
module Patch = Patch
54
45
55
46
(** JMAP Capability management (alias to Jmap_capability)
56
47
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-2> RFC 8620, Section 2 *)
···
124
115
{[
125
116
(* OCaml 5.1 required for Eio *)
126
117
open Jmap
127
-
open Jmap.Types
118
+
open Jmap.Id
128
119
open Jmap.Wire
129
120
open Jmap.Methods
130
121
+24
-24
jmap/jmap/jmap_binary.ml
+24
-24
jmap/jmap/jmap_binary.ml
···
1
-
open Types
1
+
(* Use underlying types directly to avostring circular dependency with Jmap module *)
2
2
3
3
module Upload_response = struct
4
4
type t = {
5
-
account_id : id;
6
-
blob_id : id;
5
+
account_string : string;
6
+
blob_string : string;
7
7
type_ : string;
8
-
size : uint;
8
+
size : int;
9
9
}
10
10
11
-
let account_id t = t.account_id
12
-
let blob_id t = t.blob_id
11
+
let account_string t = t.account_string
12
+
let blob_string t = t.blob_string
13
13
let type_ t = t.type_
14
14
let size t = t.size
15
15
16
-
let v ~account_id ~blob_id ~type_ ~size () =
17
-
{ account_id; blob_id; type_; size }
16
+
let v ~account_string ~blob_string ~type_ ~size () =
17
+
{ account_string; blob_string; type_; size }
18
18
end
19
19
20
20
module Blob_copy_args = struct
21
21
type t = {
22
-
from_account_id : id;
23
-
account_id : id;
24
-
blob_ids : id list;
22
+
from_account_string : string;
23
+
account_string : string;
24
+
blob_strings : string list;
25
25
}
26
26
27
-
let from_account_id t = t.from_account_id
28
-
let account_id t = t.account_id
29
-
let blob_ids t = t.blob_ids
27
+
let from_account_string t = t.from_account_string
28
+
let account_string t = t.account_string
29
+
let blob_strings t = t.blob_strings
30
30
31
-
let v ~from_account_id ~account_id ~blob_ids () =
32
-
{ from_account_id; account_id; blob_ids }
31
+
let v ~from_account_string ~account_string ~blob_strings () =
32
+
{ from_account_string; account_string; blob_strings }
33
33
end
34
34
35
35
module Blob_copy_response = struct
36
36
type t = {
37
-
from_account_id : id;
38
-
account_id : id;
39
-
copied : id id_map option;
40
-
not_copied : Error.Set_error.t id_map option;
37
+
from_account_string : string;
38
+
account_string : string;
39
+
copied : (string, string) Hashtbl.t option;
40
+
not_copied : (string, Error.Set_error.t) Hashtbl.t option;
41
41
}
42
42
43
-
let from_account_id t = t.from_account_id
44
-
let account_id t = t.account_id
43
+
let from_account_string t = t.from_account_string
44
+
let account_string t = t.account_string
45
45
let copied t = t.copied
46
46
let not_copied t = t.not_copied
47
47
48
-
let v ~from_account_id ~account_id ?copied ?not_copied () =
49
-
{ from_account_id; account_id; copied; not_copied }
48
+
let v ~from_account_string ~account_string ?copied ?not_copied () =
49
+
{ from_account_string; account_string; copied; not_copied }
50
50
end
+22
-22
jmap/jmap/jmap_binary.mli
+22
-22
jmap/jmap/jmap_binary.mli
···
1
1
(** JMAP Binary Data Handling.
2
2
3
-
This module provides types for handling binary data (blobs) in JMAP.
3
+
This module provstringes types for handling binary data (blobs) in JMAP.
4
4
Binary data is uploaded and downloaded separately from regular JMAP
5
5
method calls, using dedicated HTTP endpoints.
6
6
···
12
12
13
13
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-6> RFC 8620, Section 6 *)
14
14
15
-
open Types
15
+
(* Use underlying types directly to avostring circular dependency with Jmap module *)
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 *)
19
19
module Upload_response : sig
20
20
type t
21
21
22
-
val account_id : t -> id
23
-
val blob_id : t -> id
22
+
val account_string : t -> string
23
+
val blob_string : t -> string
24
24
val type_ : t -> string
25
-
val size : t -> uint
25
+
val size : t -> int
26
26
27
27
val v :
28
-
account_id:id ->
29
-
blob_id:id ->
28
+
account_string:string ->
29
+
blob_string:string ->
30
30
type_:string ->
31
-
size:uint ->
31
+
size:int ->
32
32
unit ->
33
33
t
34
34
end
···
38
38
module Blob_copy_args : sig
39
39
type t
40
40
41
-
val from_account_id : t -> id
42
-
val account_id : t -> id
43
-
val blob_ids : t -> id list
41
+
val from_account_string : t -> string
42
+
val account_string : t -> string
43
+
val blob_strings : t -> string list
44
44
45
45
val v :
46
-
from_account_id:id ->
47
-
account_id:id ->
48
-
blob_ids:id list ->
46
+
from_account_string:string ->
47
+
account_string:string ->
48
+
blob_strings:string list ->
49
49
unit ->
50
50
t
51
51
end
···
55
55
module Blob_copy_response : sig
56
56
type t
57
57
58
-
val from_account_id : t -> id
59
-
val account_id : t -> id
60
-
val copied : t -> id id_map option
61
-
val not_copied : t -> Error.Set_error.t id_map option
58
+
val from_account_string : t -> string
59
+
val account_string : t -> string
60
+
val copied : t -> (string, string) Hashtbl.t option
61
+
val not_copied : t -> (string, Error.Set_error.t) Hashtbl.t option
62
62
63
63
val v :
64
-
from_account_id:id ->
65
-
account_id:id ->
66
-
?copied:id id_map ->
67
-
?not_copied:Error.Set_error.t id_map ->
64
+
from_account_string:string ->
65
+
account_string:string ->
66
+
?copied:(string, string) Hashtbl.t ->
67
+
?not_copied:(string, Error.Set_error.t) Hashtbl.t ->
68
68
unit ->
69
69
t
70
70
end
+8
-8
jmap/jmap/jmap_client.mli
+8
-8
jmap/jmap/jmap_client.mli
···
6
6
7
7
@see <https://www.rfc-editor.org/rfc/rfc8620.html> RFC 8620: Core JMAP *)
8
8
9
-
open Types
9
+
(* Use underlying types directly to avoid circular dependency with Jmap module *)
10
10
open Jmap_protocol
11
11
12
12
(** {1 Client Type} *)
···
117
117
@return The blob ID or an error. *)
118
118
val upload_blob :
119
119
t ->
120
-
account_id:id ->
120
+
account_id:string ->
121
121
data:string ->
122
122
?content_type:string ->
123
123
unit ->
124
-
(id, error) result
124
+
(string, error) result
125
125
126
126
(** Download binary data from the server.
127
127
@param t The client instance.
···
131
131
@return The binary data or an error. *)
132
132
val download_blob :
133
133
t ->
134
-
account_id:id ->
135
-
blob_id:id ->
134
+
account_id:string ->
135
+
blob_id:string ->
136
136
?name:string ->
137
137
unit ->
138
138
(string, error) result
···
148
148
@return The download URL. *)
149
149
val get_download_url :
150
150
t ->
151
-
account_id:id ->
152
-
blob_id:id ->
151
+
account_id:string ->
152
+
blob_id:string ->
153
153
?name:string ->
154
154
?content_type:string ->
155
155
unit ->
···
159
159
@param t The client instance.
160
160
@param account_id The account ID.
161
161
@return The upload URL. *)
162
-
val get_upload_url : t -> account_id:id -> Uri.t
162
+
val get_upload_url : t -> account_id:string -> Uri.t
163
163
164
164
(** {1 Utilities} *)
165
165
+53
-53
jmap/jmap/jmap_methods.ml
+53
-53
jmap/jmap/jmap_methods.ml
···
1
-
open Types
1
+
(* Use underlying types directly to avoid circular dependency with Jmap module *)
2
2
open Jmap_method_names
3
3
4
4
type generic_record
5
5
6
6
module Get_args = struct
7
7
type 'record t = {
8
-
account_id : id;
9
-
ids : id list option;
8
+
account_id : string;
9
+
ids : string list option;
10
10
properties : string list option;
11
11
}
12
12
···
33
33
| Some ref_json -> ("#ids", ref_json) :: base_fields
34
34
| None ->
35
35
match t.ids with
36
-
| Some id_list -> ("ids", (`List (List.map (fun id -> `String id) id_list) : Yojson.Safe.t)) :: base_fields
36
+
| Some id_list -> ("ids", (`List (List.map (fun string -> `String string) id_list) : Yojson.Safe.t)) :: base_fields
37
37
| None -> base_fields
38
38
in
39
39
let fields = match t.properties with
···
45
45
46
46
module Get_response = struct
47
47
type 'record t = {
48
-
account_id : id;
48
+
account_id : string;
49
49
state : string;
50
50
list : 'record list;
51
-
not_found : id list;
51
+
not_found : string list;
52
52
}
53
53
54
54
let account_id t = t.account_id
···
81
81
82
82
module Changes_args = struct
83
83
type t = {
84
-
account_id : id;
84
+
account_id : string;
85
85
since_state : string;
86
-
max_changes : uint option;
86
+
max_changes : int option;
87
87
}
88
88
89
89
let account_id t = t.account_id
···
107
107
108
108
module Changes_response = struct
109
109
type t = {
110
-
account_id : id;
110
+
account_id : string;
111
111
old_state : string;
112
112
new_state : string;
113
113
has_more_changes : bool;
114
-
created : id list;
115
-
updated : id list;
116
-
destroyed : id list;
114
+
created : string list;
115
+
updated : string list;
116
+
destroyed : string list;
117
117
updated_properties : string list option;
118
118
}
119
119
···
157
157
| exn -> Error (Error.parse_error ("Changes_response parse error: " ^ Printexc.to_string exn))
158
158
end
159
159
160
-
type patch_object = (json_pointer * Yojson.Safe.t) list
160
+
type patch_object = (string * Yojson.Safe.t) list
161
161
162
162
module Set_args = struct
163
163
type ('create_record, 'update_record) t = {
164
-
account_id : id;
164
+
account_id : string;
165
165
if_in_state : string option;
166
-
create : 'create_record id_map option;
167
-
update : 'update_record id_map option;
168
-
destroy : id list option;
166
+
create : (string, 'create_record) Hashtbl.t option;
167
+
update : (string, 'update_record) Hashtbl.t option;
168
+
destroy : string list option;
169
169
on_success_destroy_original : bool option;
170
170
destroy_from_if_in_state : string option;
171
171
on_destroy_remove_emails : bool option;
···
212
212
| None -> fields
213
213
in
214
214
let fields = match t.destroy with
215
-
| Some destroy_list -> ("destroy", (`List (List.map (fun id -> `String id) destroy_list) : Yojson.Safe.t)) :: fields
215
+
| Some destroy_list -> ("destroy", (`List (List.map (fun string -> `String string) destroy_list) : Yojson.Safe.t)) :: fields
216
216
| None -> fields
217
217
in
218
218
let fields = match t.on_success_destroy_original with
···
232
232
233
233
module Set_response = struct
234
234
type ('created_record_info, 'updated_record_info) t = {
235
-
account_id : id;
235
+
account_id : string;
236
236
old_state : string option;
237
237
new_state : string;
238
-
created : 'created_record_info id_map option;
239
-
updated : 'updated_record_info option id_map option;
240
-
destroyed : id list 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;
238
+
created : (string, 'created_record_info) Hashtbl.t option;
239
+
updated : (string, 'updated_record_info option) Hashtbl.t option;
240
+
destroyed : string list option;
241
+
not_created : (string, Error.Set_error.t) Hashtbl.t option;
242
+
not_updated : (string, Error.Set_error.t) Hashtbl.t option;
243
+
not_destroyed : (string, Error.Set_error.t) Hashtbl.t option;
244
244
}
245
245
246
246
let account_id t = t.account_id
···
356
356
357
357
module Copy_args = struct
358
358
type 'copy_record_override t = {
359
-
from_account_id : id;
359
+
from_account_id : string;
360
360
if_from_in_state : string option;
361
-
account_id : id;
361
+
account_id : string;
362
362
if_in_state : string option;
363
-
create : 'copy_record_override id_map;
363
+
create : (string, 'copy_record_override) Hashtbl.t;
364
364
on_success_destroy_original : bool;
365
365
destroy_from_if_in_state : string option;
366
366
}
···
382
382
383
383
module Copy_response = struct
384
384
type 'created_record_info t = {
385
-
from_account_id : id;
386
-
account_id : id;
385
+
from_account_id : string;
386
+
account_id : string;
387
387
old_state : string option;
388
388
new_state : string;
389
-
created : 'created_record_info id_map option;
390
-
not_created : Error.Set_error.t id_map option;
389
+
created : (string, 'created_record_info) Hashtbl.t option;
390
+
not_created : (string, Error.Set_error.t) Hashtbl.t option;
391
391
}
392
392
393
393
let from_account_id t = t.from_account_id
···
465
465
is_ascending : bool option;
466
466
collation : string option;
467
467
keyword : string option;
468
-
other_fields : Yojson.Safe.t string_map;
468
+
other_fields : (string, Yojson.Safe.t) Hashtbl.t;
469
469
}
470
470
471
471
let property t = t.property
···
537
537
538
538
module Query_args = struct
539
539
type t = {
540
-
account_id : id;
540
+
account_id : string;
541
541
filter : Filter.t option;
542
542
sort : Comparator.t list option;
543
-
position : jint option;
544
-
anchor : id option;
545
-
anchor_offset : jint option;
546
-
limit : uint option;
543
+
position : int option;
544
+
anchor : string option;
545
+
anchor_offset : int option;
546
+
limit : int option;
547
547
calculate_total : bool option;
548
548
collapse_threads : bool option;
549
549
sort_as_tree : bool option;
···
618
618
619
619
module Query_response = struct
620
620
type t = {
621
-
account_id : id;
621
+
account_id : string;
622
622
query_state : string;
623
623
can_calculate_changes : bool;
624
-
position : uint;
625
-
ids : id list;
626
-
total : uint option;
627
-
limit : uint option;
624
+
position : int;
625
+
ids : string list;
626
+
total : int option;
627
+
limit : int option;
628
628
}
629
629
630
630
let account_id t = t.account_id
···
669
669
670
670
module Added_item = struct
671
671
type t = {
672
-
id : id;
673
-
index : uint;
672
+
string : string;
673
+
index : int;
674
674
}
675
675
676
-
let id t = t.id
676
+
let string t = t.string
677
677
let index t = t.index
678
678
679
-
let v ~id ~index () = { id; index }
679
+
let v ~string ~index () = { string; index }
680
680
end
681
681
682
682
module Query_changes_args = struct
683
683
type t = {
684
-
account_id : id;
684
+
account_id : string;
685
685
filter : Filter.t option;
686
686
sort : Comparator.t list option;
687
687
since_query_state : string;
688
-
max_changes : uint option;
689
-
up_to_id : id option;
688
+
max_changes : int option;
689
+
up_to_id : string option;
690
690
calculate_total : bool option;
691
691
collapse_threads : bool option;
692
692
}
···
708
708
709
709
module Query_changes_response = struct
710
710
type t = {
711
-
account_id : id;
711
+
account_id : string;
712
712
old_query_state : string;
713
713
new_query_state : string;
714
-
total : uint option;
715
-
removed : id list;
714
+
total : int option;
715
+
removed : string list;
716
716
added : Added_item.t list;
717
717
}
718
718
+102
-102
jmap/jmap/jmap_methods.mli
+102
-102
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 Types
22
+
(* Use underlying types directly to avoid circular dependency with Jmap module *)
23
23
24
24
(** {1 Generic Types} *)
25
25
···
54
54
55
55
(** Get the account ID for this request.
56
56
@return The account ID to retrieve objects from *)
57
-
val account_id : 'record t -> id
57
+
val account_id : 'record t -> string
58
58
59
59
(** Get the list of object IDs to retrieve.
60
60
@return Specific IDs to fetch, or None for all objects *)
61
-
val ids : 'record t -> id list option
61
+
val ids : 'record t -> string list option
62
62
63
63
(** Get the list of properties to return.
64
64
@return Specific properties to include, or None for all properties *)
···
70
70
@param ?properties Optional list of properties to return (None = all properties)
71
71
@return New get arguments object *)
72
72
val v :
73
-
account_id:id ->
74
-
?ids:id list ->
73
+
account_id:string ->
74
+
?ids:string list ->
75
75
?properties:string list ->
76
76
unit ->
77
77
'record t
···
109
109
(** Response for /get methods.
110
110
111
111
The /get method response contains the retrieved objects along with
112
-
metadata about the current state and any objects that weren't found.
112
+
metadata about the current state and any objects that werent found.
113
113
114
114
The response includes:
115
115
- Retrieved objects in the same order as requested (or arbitrary order if all objects)
116
116
- Current state string for change tracking
117
-
- List of IDs that weren't found
117
+
- List of IDs that werent found
118
118
119
119
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.1> RFC 8620, Section 5.1 *)
120
120
module Get_response : sig
···
122
122
123
123
(** Get the account ID for this response.
124
124
@return The account ID the objects were retrieved from *)
125
-
val account_id : 'record t -> id
125
+
val account_id : 'record t -> string
126
126
127
127
(** Get the current state string for the object type.
128
128
@return State string for change tracking *)
···
132
132
@return List of objects in requested order (or arbitrary order if all) *)
133
133
val list : 'record t -> 'record list
134
134
135
-
(** Get the list of IDs that weren't found.
136
-
@return IDs that don't exist or are not accessible *)
137
-
val not_found : 'record t -> id list
135
+
(** Get the list of IDs that werent found.
136
+
@return IDs that dont exist or are not accessible *)
137
+
val not_found : 'record t -> string list
138
138
139
139
(** Create a new get response.
140
140
@param account_id The account ID
141
141
@param state Current state string
142
142
@param list Retrieved objects
143
-
@param not_found IDs that weren't found
143
+
@param not_found IDs that werent found
144
144
@return New get response object *)
145
145
val v :
146
-
account_id:id ->
146
+
account_id:string ->
147
147
state:string ->
148
148
list:'record list ->
149
-
not_found:id list ->
149
+
not_found:string list ->
150
150
unit ->
151
151
'record t
152
152
···
171
171
module Changes_args : sig
172
172
type t
173
173
174
-
val account_id : t -> id
174
+
val account_id : t -> string
175
175
val since_state : t -> string
176
-
val max_changes : t -> uint option
176
+
val max_changes : t -> int option
177
177
178
178
val v :
179
-
account_id:id ->
179
+
account_id:string ->
180
180
since_state:string ->
181
-
?max_changes:uint ->
181
+
?max_changes:int ->
182
182
unit ->
183
183
t
184
184
···
193
193
module Changes_response : sig
194
194
type t
195
195
196
-
val account_id : t -> id
196
+
val account_id : t -> string
197
197
val old_state : t -> string
198
198
val new_state : t -> string
199
199
val has_more_changes : t -> bool
200
-
val created : t -> id list
201
-
val updated : t -> id list
202
-
val destroyed : t -> id list
200
+
val created : t -> string list
201
+
val updated : t -> string list
202
+
val destroyed : t -> string list
203
203
val updated_properties : t -> string list option
204
204
205
205
val v :
206
-
account_id:id ->
206
+
account_id:string ->
207
207
old_state:string ->
208
208
new_state:string ->
209
209
has_more_changes:bool ->
210
-
created:id list ->
211
-
updated:id list ->
212
-
destroyed:id list ->
210
+
created:string list ->
211
+
updated:string list ->
212
+
destroyed:string list ->
213
213
?updated_properties:string list ->
214
214
unit ->
215
215
t
···
231
231
(** Patch object for /set update.
232
232
A list of (JSON Pointer path, value) pairs.
233
233
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.3> RFC 8620, Section 5.3 *)
234
-
type patch_object = (json_pointer * Yojson.Safe.t) list
234
+
type patch_object = (string * Yojson.Safe.t) list
235
235
236
236
(** Arguments for /set methods.
237
237
['create_record] is the record type without server-set/immutable fields.
···
240
240
module Set_args : sig
241
241
type ('create_record, 'update_record) t
242
242
243
-
val account_id : ('a, 'b) t -> id
243
+
val account_id : ('a, 'b) t -> string
244
244
val if_in_state : ('a, 'b) t -> string option
245
-
val create : ('a, 'b) t -> 'a id_map option
246
-
val update : ('a, 'b) t -> 'b id_map option
247
-
val destroy : ('a, 'b) t -> id list option
245
+
val create : ('a, 'b) t -> (string, 'a) Hashtbl.t option
246
+
val update : ('a, 'b) t -> (string, 'b) Hashtbl.t option
247
+
val destroy : ('a, 'b) t -> string list option
248
248
val on_success_destroy_original : ('a, 'b) t -> bool option
249
249
val destroy_from_if_in_state : ('a, 'b) t -> string option
250
250
val on_destroy_remove_emails : ('a, 'b) t -> bool option
251
251
252
252
val v :
253
-
account_id:id ->
253
+
account_id:string ->
254
254
?if_in_state:string ->
255
-
?create:'a id_map ->
256
-
?update:'b id_map ->
257
-
?destroy:id list ->
255
+
?create:(string, 'a) Hashtbl.t ->
256
+
?update:(string, 'b) Hashtbl.t ->
257
+
?destroy:string list ->
258
258
?on_success_destroy_original:bool ->
259
259
?destroy_from_if_in_state:string ->
260
260
?on_destroy_remove_emails:bool ->
···
281
281
module Set_response : sig
282
282
type ('created_record_info, 'updated_record_info) t
283
283
284
-
val account_id : ('a, 'b) t -> id
284
+
val account_id : ('a, 'b) t -> string
285
285
val old_state : ('a, 'b) t -> string option
286
286
val new_state : ('a, 'b) t -> string
287
-
val created : ('a, 'b) t -> 'a id_map option
288
-
val updated : ('a, 'b) t -> 'b option id_map option
289
-
val destroyed : ('a, 'b) t -> id list 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
287
+
val created : ('a, 'b) t -> (string, 'a) Hashtbl.t option
288
+
val updated : ('a, 'b) t -> (string, 'b option) Hashtbl.t option
289
+
val destroyed : ('a, 'b) t -> string list option
290
+
val not_created : ('a, 'b) t -> (string, Error.Set_error.t) Hashtbl.t option
291
+
val not_updated : ('a, 'b) t -> (string, Error.Set_error.t) Hashtbl.t option
292
+
val not_destroyed : ('a, 'b) t -> (string, Error.Set_error.t) Hashtbl.t option
293
293
294
294
val v :
295
-
account_id:id ->
295
+
account_id:string ->
296
296
?old_state:string ->
297
297
new_state:string ->
298
-
?created:'a id_map ->
299
-
?updated:'b option id_map ->
300
-
?destroyed:id list ->
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 ->
298
+
?created:(string, 'a) Hashtbl.t ->
299
+
?updated:(string, 'b option) Hashtbl.t ->
300
+
?destroyed:string list ->
301
+
?not_created:(string, Error.Set_error.t) Hashtbl.t ->
302
+
?not_updated:(string, Error.Set_error.t) Hashtbl.t ->
303
+
?not_destroyed:(string, Error.Set_error.t) Hashtbl.t ->
304
304
unit ->
305
305
('a, 'b) t
306
306
···
323
323
end
324
324
325
325
(** Arguments for /copy methods.
326
-
['copy_record_override] contains the record id and override properties.
326
+
['copy_record_override] contains the record string and override properties.
327
327
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.4> RFC 8620, Section 5.4 *)
328
328
module Copy_args : sig
329
329
type 'copy_record_override t
330
330
331
-
val from_account_id : 'a t -> id
331
+
val from_account_id : 'a t -> string
332
332
val if_from_in_state : 'a t -> string option
333
-
val account_id : 'a t -> id
333
+
val account_id : 'a t -> string
334
334
val if_in_state : 'a t -> string option
335
-
val create : 'a t -> 'a id_map
335
+
val create : 'a t -> (string, 'a) Hashtbl.t
336
336
val on_success_destroy_original : 'a t -> bool
337
337
val destroy_from_if_in_state : 'a t -> string option
338
338
339
339
val v :
340
-
from_account_id:id ->
340
+
from_account_id:string ->
341
341
?if_from_in_state:string ->
342
-
account_id:id ->
342
+
account_id:string ->
343
343
?if_in_state:string ->
344
-
create:'a id_map ->
344
+
create:(string, 'a) Hashtbl.t ->
345
345
?on_success_destroy_original:bool ->
346
346
?destroy_from_if_in_state:string ->
347
347
unit ->
···
354
354
module Copy_response : sig
355
355
type 'created_record_info t
356
356
357
-
val from_account_id : 'a t -> id
358
-
val account_id : 'a t -> id
357
+
val from_account_id : 'a t -> string
358
+
val account_id : 'a t -> string
359
359
val old_state : 'a t -> string option
360
360
val new_state : 'a t -> string
361
-
val created : 'a t -> 'a id_map option
362
-
val not_created : 'a t -> Error.Set_error.t id_map option
361
+
val created : 'a t -> (string, 'a) Hashtbl.t option
362
+
val not_created : 'a t -> (string, Error.Set_error.t) Hashtbl.t option
363
363
364
364
val v :
365
-
from_account_id:id ->
366
-
account_id:id ->
365
+
from_account_id:string ->
366
+
account_id:string ->
367
367
?old_state:string ->
368
368
new_state:string ->
369
-
?created:'a id_map ->
370
-
?not_created:Error.Set_error.t id_map ->
369
+
?created:(string, 'a) Hashtbl.t ->
370
+
?not_created:(string, Error.Set_error.t) Hashtbl.t ->
371
371
unit ->
372
372
'a t
373
373
end
···
478
478
val is_ascending : t -> bool option
479
479
val collation : t -> string option
480
480
val keyword : t -> string option
481
-
val other_fields : t -> Yojson.Safe.t string_map
481
+
val other_fields : t -> (string, Yojson.Safe.t) Hashtbl.t
482
482
483
483
val v :
484
484
property:string ->
485
485
?is_ascending:bool ->
486
486
?collation:string ->
487
487
?keyword:string ->
488
-
?other_fields:Yojson.Safe.t string_map ->
488
+
?other_fields:(string, Yojson.Safe.t) Hashtbl.t ->
489
489
unit ->
490
490
t
491
491
···
505
505
module Query_args : sig
506
506
type t
507
507
508
-
val account_id : t -> id
508
+
val account_id : t -> string
509
509
val filter : t -> Filter.t option
510
510
val sort : t -> Comparator.t list option
511
-
val position : t -> jint option
512
-
val anchor : t -> id option
513
-
val anchor_offset : t -> jint option
514
-
val limit : t -> uint option
511
+
val position : t -> int option
512
+
val anchor : t -> string option
513
+
val anchor_offset : t -> int option
514
+
val limit : t -> int option
515
515
val calculate_total : t -> bool option
516
516
val collapse_threads : t -> bool option
517
517
val sort_as_tree : t -> bool option
518
518
val filter_as_tree : t -> bool option
519
519
520
520
val v :
521
-
account_id:id ->
521
+
account_id:string ->
522
522
?filter:Filter.t ->
523
523
?sort:Comparator.t list ->
524
-
?position:jint ->
525
-
?anchor:id ->
526
-
?anchor_offset:jint ->
527
-
?limit:uint ->
524
+
?position:int ->
525
+
?anchor:string ->
526
+
?anchor_offset:int ->
527
+
?limit:int ->
528
528
?calculate_total:bool ->
529
529
?collapse_threads:bool ->
530
530
?sort_as_tree:bool ->
···
543
543
module Query_response : sig
544
544
type t
545
545
546
-
val account_id : t -> id
546
+
val account_id : t -> string
547
547
val query_state : t -> string
548
548
val can_calculate_changes : t -> bool
549
-
val position : t -> uint
550
-
val ids : t -> id list
551
-
val total : t -> uint option
552
-
val limit : t -> uint option
549
+
val position : t -> int
550
+
val ids : t -> string list
551
+
val total : t -> int option
552
+
val limit : t -> int option
553
553
554
554
val v :
555
-
account_id:id ->
555
+
account_id:string ->
556
556
query_state:string ->
557
557
can_calculate_changes:bool ->
558
-
position:uint ->
559
-
ids:id list ->
560
-
?total:uint ->
561
-
?limit:uint ->
558
+
position:int ->
559
+
ids:string list ->
560
+
?total:int ->
561
+
?limit:int ->
562
562
unit ->
563
563
t
564
564
···
581
581
module Added_item : sig
582
582
type t
583
583
584
-
val id : t -> id
585
-
val index : t -> uint
584
+
val string : t -> string
585
+
val index : t -> int
586
586
587
587
val v :
588
-
id:id ->
589
-
index:uint ->
588
+
string:string ->
589
+
index:int ->
590
590
unit ->
591
591
t
592
592
end
···
596
596
module Query_changes_args : sig
597
597
type t
598
598
599
-
val account_id : t -> id
599
+
val account_id : t -> string
600
600
val filter : t -> Filter.t option
601
601
val sort : t -> Comparator.t list option
602
602
val since_query_state : t -> string
603
-
val max_changes : t -> uint option
604
-
val up_to_id : t -> id option
603
+
val max_changes : t -> int option
604
+
val up_to_id : t -> string option
605
605
val calculate_total : t -> bool option
606
606
val collapse_threads : t -> bool option
607
607
608
608
val v :
609
-
account_id:id ->
609
+
account_id:string ->
610
610
?filter:Filter.t ->
611
611
?sort:Comparator.t list ->
612
612
since_query_state:string ->
613
-
?max_changes:uint ->
614
-
?up_to_id:id ->
613
+
?max_changes:int ->
614
+
?up_to_id:string ->
615
615
?calculate_total:bool ->
616
616
?collapse_threads:bool ->
617
617
unit ->
···
623
623
module Query_changes_response : sig
624
624
type t
625
625
626
-
val account_id : t -> id
626
+
val account_id : t -> string
627
627
val old_query_state : t -> string
628
628
val new_query_state : t -> string
629
-
val total : t -> uint option
630
-
val removed : t -> id list
629
+
val total : t -> int option
630
+
val removed : t -> string list
631
631
val added : t -> Added_item.t list
632
632
633
633
val v :
634
-
account_id:id ->
634
+
account_id:string ->
635
635
old_query_state:string ->
636
636
new_query_state:string ->
637
-
?total:uint ->
638
-
removed:id list ->
637
+
?total:int ->
638
+
removed:string list ->
639
639
added:Added_item.t list ->
640
640
unit ->
641
641
t
+1
-1
jmap/jmap/jmap_protocol.mli
+1
-1
jmap/jmap/jmap_protocol.mli
···
182
182
@param session The session object.
183
183
@param capability The capability.
184
184
@return The account ID or an error if not found. *)
185
-
val get_primary_account : session -> Jmap_capability.t -> (Types.id, error) result
185
+
val get_primary_account : session -> Jmap_capability.t -> (string, error) result
186
186
187
187
(** Find a method response by its call ID.
188
188
@param response The response object.
+27
-27
jmap/jmap/jmap_push.ml
+27
-27
jmap/jmap/jmap_push.ml
···
1
-
open Types
1
+
(* Use underlying types directly to avoid circular dependency with Jmap module *)
2
2
open Jmap_methods
3
3
4
-
type type_state = string string_map
4
+
type type_state = (string, string) Hashtbl.t
5
5
6
6
module State_change = struct
7
7
type t = {
8
-
changed : type_state id_map;
8
+
changed : (string, type_state) Hashtbl.t;
9
9
}
10
10
11
11
let changed t = t.changed
···
27
27
28
28
module Push_subscription = struct
29
29
type t = {
30
-
id : id;
30
+
string : string;
31
31
device_client_id : string;
32
32
url : Uri.t;
33
33
keys : Push_encryption_keys.t option;
34
34
verification_code : string option;
35
-
expires : utc_date option;
35
+
expires : string option;
36
36
types : string list option;
37
37
}
38
38
39
-
let id t = t.id
39
+
let string t = t.string
40
40
let device_client_id t = t.device_client_id
41
41
let url t = t.url
42
42
let keys t = t.keys
···
44
44
let expires t = t.expires
45
45
let types t = t.types
46
46
47
-
let v ~id ~device_client_id ~url ?keys ?verification_code ?expires ?types () =
48
-
{ id; device_client_id; url; keys; verification_code; expires; types }
47
+
let v ~string ~device_client_id ~url ?keys ?verification_code ?expires ?types () =
48
+
{ string; device_client_id; url; keys; verification_code; expires; types }
49
49
end
50
50
51
51
module Push_subscription_create = struct
···
53
53
device_client_id : string;
54
54
url : Uri.t;
55
55
keys : Push_encryption_keys.t option;
56
-
expires : utc_date option;
56
+
expires : string option;
57
57
types : string list option;
58
58
}
59
59
···
71
71
72
72
module Push_subscription_get_args = struct
73
73
type t = {
74
-
ids : id list option;
74
+
ids : string list option;
75
75
properties : string list option;
76
76
}
77
77
···
84
84
module Push_subscription_get_response = struct
85
85
type t = {
86
86
list : Push_subscription.t list;
87
-
not_found : id list;
87
+
not_found : string list;
88
88
}
89
89
90
90
let list t = t.list
···
95
95
96
96
module Push_subscription_set_args = struct
97
97
type t = {
98
-
create : Push_subscription_create.t id_map option;
99
-
update : push_subscription_update id_map option;
100
-
destroy : id list option;
98
+
create : (string, Push_subscription_create.t) Hashtbl.t option;
99
+
update : (string, push_subscription_update) Hashtbl.t option;
100
+
destroy : string list option;
101
101
}
102
102
103
103
let create t = t.create
···
109
109
110
110
module Push_subscription_created_info = struct
111
111
type t = {
112
-
id : id;
113
-
expires : utc_date option;
112
+
string : string;
113
+
expires : string option;
114
114
}
115
115
116
-
let id t = t.id
116
+
let string t = t.string
117
117
let expires t = t.expires
118
118
119
-
let v ~id ?expires () = { id; expires }
119
+
let v ~string ?expires () = { string; expires }
120
120
end
121
121
122
122
module Push_subscription_updated_info = struct
123
123
type t = {
124
-
expires : utc_date option;
124
+
expires : string option;
125
125
}
126
126
127
127
let expires t = t.expires
···
131
131
132
132
module Push_subscription_set_response = struct
133
133
type t = {
134
-
created : Push_subscription_created_info.t id_map option;
135
-
updated : Push_subscription_updated_info.t option id_map option;
136
-
destroyed : id list 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;
134
+
created : (string, Push_subscription_created_info.t) Hashtbl.t option;
135
+
updated : (string, Push_subscription_updated_info.t option) Hashtbl.t option;
136
+
destroyed : string list option;
137
+
not_created : (string, Error.Set_error.t) Hashtbl.t option;
138
+
not_updated : (string, Error.Set_error.t) Hashtbl.t option;
139
+
not_destroyed : (string, Error.Set_error.t) Hashtbl.t option;
140
140
}
141
141
142
142
let created t = t.created
···
152
152
153
153
module Push_verification = struct
154
154
type t = {
155
-
push_subscription_id : id;
155
+
push_subscription_id : string;
156
156
verification_code : string;
157
157
}
158
158
···
165
165
166
166
module Event_source_ping_data = struct
167
167
type t = {
168
-
interval : uint;
168
+
interval : int;
169
169
}
170
170
171
171
let interval t = t.interval
+43
-43
jmap/jmap/jmap_push.mli
+43
-43
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 Types
4
+
(* Use underlying types directly to avoid circular dependency with Jmap module *)
5
5
open Jmap_methods
6
6
7
7
(** TypeState object map (TypeName -> StateString).
8
8
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.1> RFC 8620, Section 7.1 *)
9
-
type type_state = string string_map
9
+
type type_state = (string, string) Hashtbl.t
10
10
11
11
(** StateChange object.
12
12
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.1> RFC 8620, Section 7.1 *)
13
13
module State_change : sig
14
14
type t
15
15
16
-
val changed : t -> type_state id_map
16
+
val changed : t -> (string, type_state) Hashtbl.t
17
17
18
18
val v :
19
-
changed:type_state id_map ->
19
+
changed:(string, type_state) Hashtbl.t ->
20
20
unit ->
21
21
t
22
22
end
···
45
45
type t
46
46
47
47
(** Id of the subscription (server-set, immutable) *)
48
-
val id : t -> id
48
+
val string : t -> string
49
49
50
-
(** Device client id (immutable) *)
50
+
(** Device client string (immutable) *)
51
51
val device_client_id : t -> string
52
52
53
53
(** Notification URL (immutable) *)
···
56
56
(** Encryption keys (immutable) *)
57
57
val keys : t -> Push_encryption_keys.t option
58
58
val verification_code : t -> string option
59
-
val expires : t -> utc_date option
59
+
val expires : t -> string option
60
60
val types : t -> string list option
61
61
62
62
val v :
63
-
id:id ->
63
+
string:string ->
64
64
device_client_id:string ->
65
65
url:Uri.t ->
66
66
?keys:Push_encryption_keys.t ->
67
67
?verification_code:string ->
68
-
?expires:utc_date ->
68
+
?expires:string ->
69
69
?types:string list ->
70
70
unit ->
71
71
t
···
79
79
val device_client_id : t -> string
80
80
val url : t -> Uri.t
81
81
val keys : t -> Push_encryption_keys.t option
82
-
val expires : t -> utc_date option
82
+
val expires : t -> string option
83
83
val types : t -> string list option
84
84
85
85
val v :
86
86
device_client_id:string ->
87
87
url:Uri.t ->
88
88
?keys:Push_encryption_keys.t ->
89
-
?expires:utc_date ->
89
+
?expires:string ->
90
90
?types:string list ->
91
91
unit ->
92
92
t
···
104
104
module Push_subscription_get_args : sig
105
105
type t
106
106
107
-
val ids : t -> id list option
107
+
val ids : t -> string list option
108
108
val properties : t -> string list option
109
109
110
110
val v :
111
-
?ids:id list ->
111
+
?ids:string list ->
112
112
?properties:string list ->
113
113
unit ->
114
114
t
···
121
121
type t
122
122
123
123
val list : t -> Push_subscription.t list
124
-
val not_found : t -> id list
124
+
val not_found : t -> string list
125
125
126
126
val v :
127
127
list:Push_subscription.t list ->
128
-
not_found:id list ->
128
+
not_found:string list ->
129
129
unit ->
130
130
t
131
131
end
···
136
136
module Push_subscription_set_args : sig
137
137
type t
138
138
139
-
val create : t -> Push_subscription_create.t id_map option
140
-
val update : t -> push_subscription_update id_map option
141
-
val destroy : t -> id list option
139
+
val create : t -> (string, Push_subscription_create.t) Hashtbl.t option
140
+
val update : t -> (string, push_subscription_update) Hashtbl.t option
141
+
val destroy : t -> string list option
142
142
143
143
val v :
144
-
?create:Push_subscription_create.t id_map ->
145
-
?update:push_subscription_update id_map ->
146
-
?destroy:id list ->
144
+
?create:(string, Push_subscription_create.t) Hashtbl.t ->
145
+
?update:(string, push_subscription_update) Hashtbl.t ->
146
+
?destroy:string list ->
147
147
unit ->
148
148
t
149
149
end
···
153
153
module Push_subscription_created_info : sig
154
154
type t
155
155
156
-
val id : t -> id
157
-
val expires : t -> utc_date option
156
+
val string : t -> string
157
+
val expires : t -> string option
158
158
159
159
val v :
160
-
id:id ->
161
-
?expires:utc_date ->
160
+
string:string ->
161
+
?expires:string ->
162
162
unit ->
163
163
t
164
164
end
···
168
168
module Push_subscription_updated_info : sig
169
169
type t
170
170
171
-
val expires : t -> utc_date option
171
+
val expires : t -> string option
172
172
173
173
val v :
174
-
?expires:utc_date ->
174
+
?expires:string ->
175
175
unit ->
176
176
t
177
177
end
···
182
182
module Push_subscription_set_response : sig
183
183
type t
184
184
185
-
val created : t -> Push_subscription_created_info.t id_map option
186
-
val updated : t -> Push_subscription_updated_info.t option id_map option
187
-
val destroyed : t -> id list 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
185
+
val created : t -> (string, Push_subscription_created_info.t) Hashtbl.t option
186
+
val updated : t -> (string, Push_subscription_updated_info.t option) Hashtbl.t option
187
+
val destroyed : t -> string list option
188
+
val not_created : t -> (string, Error.Set_error.t) Hashtbl.t option
189
+
val not_updated : t -> (string, Error.Set_error.t) Hashtbl.t option
190
+
val not_destroyed : t -> (string, Error.Set_error.t) Hashtbl.t option
191
191
192
192
val v :
193
-
?created:Push_subscription_created_info.t id_map ->
194
-
?updated:Push_subscription_updated_info.t option id_map ->
195
-
?destroyed:id list ->
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 ->
193
+
?created:(string, Push_subscription_created_info.t) Hashtbl.t ->
194
+
?updated:(string, Push_subscription_updated_info.t option) Hashtbl.t ->
195
+
?destroyed:string list ->
196
+
?not_created:(string, Error.Set_error.t) Hashtbl.t ->
197
+
?not_updated:(string, Error.Set_error.t) Hashtbl.t ->
198
+
?not_destroyed:(string, Error.Set_error.t) Hashtbl.t ->
199
199
unit ->
200
200
t
201
201
end
···
205
205
module Push_verification : sig
206
206
type t
207
207
208
-
val push_subscription_id : t -> id
208
+
val push_subscription_id : t -> string
209
209
val verification_code : t -> string
210
210
211
211
val v :
212
-
push_subscription_id:id ->
212
+
push_subscription_id:string ->
213
213
verification_code:string ->
214
214
unit ->
215
215
t
···
220
220
module Event_source_ping_data : sig
221
221
type t
222
222
223
-
val interval : t -> uint
223
+
val interval : t -> int
224
224
225
225
val v :
226
-
interval:uint ->
226
+
interval:int ->
227
227
unit ->
228
228
t
229
229
end
+6
-6
jmap/jmap/jmap_request.ml
+6
-6
jmap/jmap/jmap_request.ml
···
1
1
(** Implementation of type-safe JMAP request building and management. *)
2
2
3
-
open Types
3
+
(* Use underlying types directly to avoid circular dependency with Jmap module *)
4
4
5
5
(** Internal representation of a JMAP request under construction *)
6
6
type t = {
7
7
using: string list;
8
8
methods: (Jmap_method.t * string) list; (* (method, call_id) pairs *)
9
-
created_ids: (string) id_map option;
9
+
created_ids: (string, string) Hashtbl.t option;
10
10
call_id_counter: int;
11
11
}
12
12
···
45
45
let rec find_index methods index =
46
46
match methods with
47
47
| [] -> None
48
-
| (_, id) :: _ when id = call_id -> Some index
48
+
| (_, string) :: _ when string = call_id -> Some index
49
49
| _ :: rest -> find_index rest (index + 1)
50
50
in
51
51
find_index (List.rev t.methods) 0 (* Reverse to maintain insertion order *)
···
54
54
55
55
let add_method t method_call =
56
56
let call_id = match Jmap_method.call_id method_call with
57
-
| Some id -> id
57
+
| Some string -> string
58
58
| None ->
59
-
let (id, _) = generate_call_id t in
60
-
id
59
+
let (string, _) = generate_call_id t in
60
+
string
61
61
in
62
62
let method_with_id = Jmap_method.with_call_id method_call call_id in
63
63
let (final_call_id, updated_t) = if Jmap_method.call_id method_with_id = Some call_id then
+3
-3
jmap/jmap/jmap_request.mli
+3
-3
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 Types
25
+
(* Use underlying types directly to avoid circular dependency with Jmap module *)
26
26
27
27
(** {1 Request Types} *)
28
28
···
47
47
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.3> RFC 8620, Section 3.3 *)
48
48
val create :
49
49
using:string list ->
50
-
?created_ids:(string) id_map ->
50
+
?created_ids:(string, string) Hashtbl.t ->
51
51
unit ->
52
52
t
53
53
···
65
65
@return A new request with standard capabilities *)
66
66
val create_with_standard_capabilities :
67
67
?additional_capabilities:string list ->
68
-
?created_ids:(string) id_map ->
68
+
?created_ids:(string, string) Hashtbl.t ->
69
69
unit ->
70
70
t
71
71
+13
-13
jmap/jmap/jmap_response.mli
+13
-13
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 Types
28
+
(* Use underlying types directly to avoid circular dependency with Jmap module *)
29
29
30
30
(** {1 Response Types} *)
31
31
···
142
142
val query_state : t -> string
143
143
144
144
(** Extract total count from response *)
145
-
val total : t -> uint option
145
+
val total : t -> int option
146
146
147
147
(** Extract current position from response *)
148
-
val position : t -> uint
148
+
val position : t -> int
149
149
end
150
150
151
151
(** Email/get response - implements METHOD_RESPONSE for get operations *)
···
164
164
include Jmap_sigs.METHOD_RESPONSE with type t = (Yojson.Safe.t, Yojson.Safe.t) Jmap_methods.Set_response.t
165
165
166
166
(** Extract created emails from response *)
167
-
val created : t -> Yojson.Safe.t id_map option
167
+
val created : t -> (string, Yojson.Safe.t) Hashtbl.t option
168
168
169
169
(** Extract updated emails from response *)
170
-
val updated : t -> Yojson.Safe.t option id_map option
170
+
val updated : t -> (string, Yojson.Safe.t option) Hashtbl.t option
171
171
172
172
(** Extract destroyed email IDs from response *)
173
173
val destroyed : t -> string list option
···
214
214
include Jmap_sigs.METHOD_RESPONSE with type t = (Yojson.Safe.t, Yojson.Safe.t) Jmap_methods.Set_response.t
215
215
216
216
(** Extract created mailboxes from response *)
217
-
val created : t -> Yojson.Safe.t id_map option
217
+
val created : t -> (string, Yojson.Safe.t) Hashtbl.t option
218
218
219
219
(** Extract updated mailboxes from response *)
220
-
val updated : t -> Yojson.Safe.t option id_map option
220
+
val updated : t -> (string, Yojson.Safe.t option) Hashtbl.t option
221
221
222
222
(** Extract destroyed mailbox IDs from response *)
223
223
val destroyed : t -> string list option
···
281
281
include Jmap_sigs.METHOD_RESPONSE with type t = (Yojson.Safe.t, Yojson.Safe.t) Jmap_methods.Set_response.t
282
282
283
283
(** Extract created identities from response *)
284
-
val created : t -> Yojson.Safe.t id_map option
284
+
val created : t -> (string, Yojson.Safe.t) Hashtbl.t option
285
285
286
286
(** Extract updated identities from response *)
287
-
val updated : t -> Yojson.Safe.t option id_map option
287
+
val updated : t -> (string, Yojson.Safe.t option) Hashtbl.t option
288
288
289
289
(** Extract destroyed identity IDs from response *)
290
290
val destroyed : t -> string list option
···
323
323
include Jmap_sigs.METHOD_RESPONSE with type t = (Yojson.Safe.t, Yojson.Safe.t) Jmap_methods.Set_response.t
324
324
325
325
(** Extract created email submissions from response *)
326
-
val created : t -> Yojson.Safe.t id_map option
326
+
val created : t -> (string, Yojson.Safe.t) Hashtbl.t option
327
327
328
328
(** Extract updated email submissions from response *)
329
-
val updated : t -> Yojson.Safe.t option id_map option
329
+
val updated : t -> (string, Yojson.Safe.t option) Hashtbl.t option
330
330
331
331
(** Extract destroyed email submission IDs from response *)
332
332
val destroyed : t -> string list option
···
373
373
include Jmap_sigs.METHOD_RESPONSE with type t = (Yojson.Safe.t, Yojson.Safe.t) Jmap_methods.Set_response.t
374
374
375
375
(** Extract created vacation responses from response *)
376
-
val created : t -> Yojson.Safe.t id_map option
376
+
val created : t -> (string, Yojson.Safe.t) Hashtbl.t option
377
377
378
378
(** Extract updated vacation responses from response *)
379
-
val updated : t -> Yojson.Safe.t option id_map option
379
+
val updated : t -> (string, Yojson.Safe.t option) Hashtbl.t option
380
380
381
381
(** Extract destroyed vacation response IDs from response *)
382
382
val destroyed : t -> string list option
+132
jmap/jmap/patch.ml
+132
jmap/jmap/patch.ml
···
1
+
(* Internal representation as a hash table for efficient operations *)
2
+
type t = (string, Yojson.Safe.t) Hashtbl.t
3
+
4
+
(* JSON Pointer validation - simplified but covers common cases *)
5
+
let is_valid_property_path path =
6
+
let len = String.length path in
7
+
if len = 0 then true (* empty path is valid root *)
8
+
else if path.[0] <> '/' then true (* simple property names are valid *)
9
+
else
10
+
(* Check for valid JSON Pointer format *)
11
+
let rec check_escaping i =
12
+
if i >= len then true
13
+
else match path.[i] with
14
+
| '~' when i + 1 < len ->
15
+
(match path.[i + 1] with
16
+
| '0' | '1' -> check_escaping (i + 2)
17
+
| _ -> false)
18
+
| '/' -> check_escaping (i + 1)
19
+
| _ -> check_escaping (i + 1)
20
+
in
21
+
check_escaping 0
22
+
23
+
let empty = Hashtbl.create 8
24
+
25
+
let of_operations operations =
26
+
let patch = Hashtbl.create (List.length operations) in
27
+
let rec process = function
28
+
| [] -> Ok patch
29
+
| (property, value) :: rest ->
30
+
if is_valid_property_path property then (
31
+
Hashtbl.replace patch property value;
32
+
process rest
33
+
) else
34
+
Error ("Invalid property path: " ^ property)
35
+
in
36
+
process operations
37
+
38
+
let to_operations patch =
39
+
Hashtbl.fold (fun property value acc ->
40
+
(property, value) :: acc
41
+
) patch []
42
+
43
+
let of_json_object = function
44
+
| `Assoc pairs -> of_operations pairs
45
+
| json ->
46
+
let json_str = Yojson.Safe.to_string json in
47
+
Error (Printf.sprintf "Expected JSON object for Patch, got: %s" json_str)
48
+
49
+
let to_json_object patch =
50
+
let pairs = to_operations patch in
51
+
`Assoc pairs
52
+
53
+
let set_property patch property value =
54
+
if is_valid_property_path property then (
55
+
let new_patch = Hashtbl.copy patch in
56
+
Hashtbl.replace new_patch property value;
57
+
Ok new_patch
58
+
) else
59
+
Error ("Invalid property path: " ^ property)
60
+
61
+
let remove_property patch property =
62
+
set_property patch property `Null
63
+
64
+
let has_property patch property =
65
+
Hashtbl.mem patch property
66
+
67
+
let get_property patch property =
68
+
try Some (Hashtbl.find patch property)
69
+
with Not_found -> None
70
+
71
+
let merge patch1 patch2 =
72
+
let result = Hashtbl.copy patch1 in
73
+
Hashtbl.iter (fun property value ->
74
+
Hashtbl.replace result property value
75
+
) patch2;
76
+
result
77
+
78
+
let is_empty patch =
79
+
Hashtbl.length patch = 0
80
+
81
+
let size patch =
82
+
Hashtbl.length patch
83
+
84
+
let validate patch =
85
+
(* Validate all property paths *)
86
+
try
87
+
Hashtbl.iter (fun property _value ->
88
+
if not (is_valid_property_path property) then
89
+
failwith ("Invalid property path: " ^ property)
90
+
) patch;
91
+
Ok ()
92
+
with
93
+
| Failure msg -> Error msg
94
+
95
+
let equal patch1 patch2 =
96
+
if Hashtbl.length patch1 <> Hashtbl.length patch2 then false
97
+
else
98
+
try
99
+
Hashtbl.iter (fun property value1 ->
100
+
match get_property patch2 property with
101
+
| None -> failwith "Property not found"
102
+
| Some value2 when Yojson.Safe.equal value1 value2 -> ()
103
+
| Some _ -> failwith "Property values differ"
104
+
) patch1;
105
+
true
106
+
with
107
+
| Failure _ -> false
108
+
109
+
let pp ppf patch =
110
+
Format.fprintf ppf "%s" (Yojson.Safe.to_string (to_json_object patch))
111
+
112
+
let pp_hum ppf patch =
113
+
let operations = to_operations patch in
114
+
let op_count = List.length operations in
115
+
let key_list = List.map fst operations in
116
+
let key_str = match key_list with
117
+
| [] -> "none"
118
+
| keys -> String.concat ", " keys
119
+
in
120
+
Format.fprintf ppf "Patch{operations=%d; keys=[%s]}" op_count key_str
121
+
122
+
let to_string_debug patch =
123
+
let operations = to_operations patch in
124
+
let op_strings = List.map (fun (prop, value) ->
125
+
Printf.sprintf "%s: %s" prop (Yojson.Safe.to_string value)
126
+
) operations in
127
+
Printf.sprintf "Patch({%s})" (String.concat "; " op_strings)
128
+
129
+
(* JSON serialization *)
130
+
let to_json patch = to_json_object patch
131
+
132
+
let of_json json = of_json_object json
+122
jmap/jmap/patch.mli
+122
jmap/jmap/patch.mli
···
1
+
(** JMAP Patch Object for property updates with JSON serialization.
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
+
(** {2 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
+
(** {2 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
+
(** {2 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
+
(** {2 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
+
(** {2 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
+13
-13
jmap/jmap/session.ml
+13
-13
jmap/jmap/session.ml
···
1
-
open Types
1
+
(* Use underlying types directly to avoid circular dependency with Jmap module *)
2
2
3
3
type account_capability_value = Yojson.Safe.t
4
4
···
11
11
12
12
module Core_capability = struct
13
13
type t = {
14
-
max_size_upload : uint;
15
-
max_concurrent_upload : uint;
16
-
max_size_request : uint;
17
-
max_concurrent_requests : uint;
18
-
max_calls_in_request : uint;
19
-
max_objects_in_get : uint;
20
-
max_objects_in_set : uint;
14
+
max_size_upload : int;
15
+
max_concurrent_upload : int;
16
+
max_size_request : int;
17
+
max_concurrent_requests : int;
18
+
max_calls_in_request : int;
19
+
max_objects_in_get : int;
20
+
max_objects_in_set : int;
21
21
collation_algorithms : string list;
22
22
}
23
23
···
75
75
name : string;
76
76
is_personal : bool;
77
77
is_read_only : bool;
78
-
account_capabilities : account_capability_value string_map;
78
+
account_capabilities : (string, account_capability_value) Hashtbl.t;
79
79
}
80
80
81
81
let name t = t.name
···
116
116
117
117
module Session = struct
118
118
type t = {
119
-
capabilities : server_capability_value string_map;
120
-
accounts : Account.t id_map;
121
-
primary_accounts : id string_map;
119
+
capabilities : (string, server_capability_value) Hashtbl.t;
120
+
accounts : (string, Account.t) Hashtbl.t;
121
+
primary_accounts : (string, string) Hashtbl.t;
122
122
username : string;
123
123
api_url : Uri.t;
124
124
download_url : Uri.t;
···
429
429
| No_auth -> []
430
430
431
431
let make_request ~url ~auth =
432
-
let headers = ("Accept", Types.Constants.Content_type.json) :: ("User-Agent", Types.Constants.User_agent.ocaml_jmap) :: (auth_headers auth) in
432
+
let headers = ("Accept", "application/json") :: ("User-Agent", "ocaml-jmap/1.0") :: (auth_headers auth) in
433
433
try
434
434
let response_json = `Assoc [
435
435
("capabilities", `Assoc [
+27
-27
jmap/jmap/session.mli
+27
-27
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 Types
14
+
(* Use underlying types directly to avoid circular dependency with Jmap module *)
15
15
16
16
(** {1 Capability Types} *)
17
17
···
57
57
58
58
(** Maximum size in bytes for a single blob upload.
59
59
@return Maximum upload size (typically 50MB or similar) *)
60
-
val max_size_upload : t -> uint
60
+
val max_size_upload : t -> int
61
61
62
62
(** Maximum number of concurrent blob uploads allowed.
63
63
@return Maximum concurrent uploads (typically 4-10) *)
64
-
val max_concurrent_upload : t -> uint
64
+
val max_concurrent_upload : t -> int
65
65
66
66
(** Maximum size in bytes for a single JMAP request.
67
67
@return Maximum request size (typically 10MB or similar) *)
68
-
val max_size_request : t -> uint
68
+
val max_size_request : t -> int
69
69
70
70
(** Maximum number of concurrent JMAP requests allowed.
71
71
@return Maximum concurrent requests (typically 4-10) *)
72
-
val max_concurrent_requests : t -> uint
72
+
val max_concurrent_requests : t -> int
73
73
74
74
(** Maximum number of method calls allowed in a single request.
75
75
@return Maximum method calls per request (typically 16-64) *)
76
-
val max_calls_in_request : t -> uint
76
+
val max_calls_in_request : t -> int
77
77
78
78
(** Maximum number of objects that can be requested in a single /get call.
79
79
@return Maximum objects per /get (typically 500-1000) *)
80
-
val max_objects_in_get : t -> uint
80
+
val max_objects_in_get : t -> int
81
81
82
82
(** Maximum number of objects that can be processed in a single /set call.
83
83
@return Maximum objects per /set (typically 500-1000) *)
84
-
val max_objects_in_set : t -> uint
84
+
val max_objects_in_set : t -> int
85
85
86
86
(** List of supported collation algorithms for sorting.
87
87
@return List of collation algorithm names (e.g., ["i;ascii-casemap", "i;unicode-casemap"]) *)
···
98
98
@param collation_algorithms Supported collation algorithms
99
99
@return A new core capability object *)
100
100
val v :
101
-
max_size_upload:uint ->
102
-
max_concurrent_upload:uint ->
103
-
max_size_request:uint ->
104
-
max_concurrent_requests:uint ->
105
-
max_calls_in_request:uint ->
106
-
max_objects_in_get:uint ->
107
-
max_objects_in_set:uint ->
101
+
max_size_upload:int ->
102
+
max_concurrent_upload:int ->
103
+
max_size_request:int ->
104
+
max_concurrent_requests:int ->
105
+
max_calls_in_request:int ->
106
+
max_objects_in_get:int ->
107
+
max_objects_in_set:int ->
108
108
collation_algorithms:string list ->
109
109
unit ->
110
110
t
···
149
149
150
150
(** Get the account-specific capability information.
151
151
@return Map of capability URIs to their account-specific metadata *)
152
-
val account_capabilities : t -> account_capability_value string_map
152
+
val account_capabilities : t -> (string, account_capability_value) Hashtbl.t
153
153
154
154
(** Create a new account object.
155
155
@param name Human-readable account name
···
161
161
name:string ->
162
162
?is_personal:bool ->
163
163
?is_read_only:bool ->
164
-
?account_capabilities:account_capability_value string_map ->
164
+
?account_capabilities:(string, account_capability_value) Hashtbl.t ->
165
165
unit ->
166
166
t
167
167
···
198
198
199
199
(** Get the server capabilities.
200
200
@return Map of capability URIs to server-specific capability metadata *)
201
-
val capabilities : t -> server_capability_value string_map
201
+
val capabilities : t -> (string, server_capability_value) Hashtbl.t
202
202
203
203
(** Get all accounts accessible to the authenticated user.
204
204
@return Map of account IDs to account objects *)
205
-
val accounts : t -> Account.t id_map
205
+
val accounts : t -> (string, Account.t) Hashtbl.t
206
206
207
207
(** Get the primary account ID for each capability.
208
208
@return Map from capability URI to primary account ID for that capability *)
209
-
val primary_accounts : t -> id string_map
209
+
val primary_accounts : t -> (string, string) Hashtbl.t
210
210
211
211
(** Get the authenticated username.
212
212
@return Username or email address of the authenticated user *)
···
244
244
@param state Current session state string
245
245
@return A new session object *)
246
246
val v :
247
-
capabilities:server_capability_value string_map ->
248
-
accounts:Account.t id_map ->
249
-
primary_accounts:id string_map ->
247
+
capabilities:(string, server_capability_value) Hashtbl.t ->
248
+
accounts:(string, Account.t) Hashtbl.t ->
249
+
primary_accounts:(string, string) Hashtbl.t ->
250
250
username:string ->
251
251
api_url:Uri.t ->
252
252
download_url:Uri.t ->
···
272
272
(** Get the primary account ID for a given capability.
273
273
@param capability The capability
274
274
@return Primary account ID if found, None otherwise *)
275
-
val get_primary_account : t -> Jmap_capability.t -> id option
275
+
val get_primary_account : t -> Jmap_capability.t -> string option
276
276
277
277
(** Get account information by account ID.
278
278
@param account_id The account ID to look up
279
279
@return Account object if found, None otherwise *)
280
-
val get_account : t -> id -> Account.t option
280
+
val get_account : t -> string -> Account.t option
281
281
282
282
(** Get all personal accounts for the authenticated user.
283
283
@return List of (account_id, account) pairs for personal accounts *)
284
-
val get_personal_accounts : t -> (id * Account.t) list
284
+
val get_personal_accounts : t -> (string * Account.t) list
285
285
286
286
(** Get all accounts that support a given capability.
287
287
@param capability The capability
288
288
@return List of (account_id, account) pairs that support the capability *)
289
-
val get_capability_accounts : t -> Jmap_capability.t -> (id * Account.t) list
289
+
val get_capability_accounts : t -> Jmap_capability.t -> (string * Account.t) list
290
290
end
291
291
292
292
(** {1 Session Discovery and Retrieval} *)
-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
+85
jmap/jmap/uint.ml
+85
jmap/jmap/uint.ml
···
1
+
(** JMAP UnsignedInt 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 = Format.fprintf ppf "%d" uint
28
+
29
+
let pp_hum ppf uint = Format.fprintf 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 = Format.fprintf 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/uint.mli
+128
jmap/jmap/uint.mli
···
1
+
(** JMAP UnsignedInt data type with range validation and JSON serialization.
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
+
(** {2 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
+
(** {2 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
+
(** {2 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
+
(** {2 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
+
(** {2 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
+4
-4
jmap/jmap/wire.ml
+4
-4
jmap/jmap/wire.ml
···
1
-
open Types
1
+
(* Use underlying types directly to avoid circular dependency with Jmap module *)
2
2
3
3
module Invocation = struct
4
4
type t = {
···
23
23
type t = {
24
24
result_of : string;
25
25
name : string;
26
-
path : json_pointer;
26
+
path : string;
27
27
}
28
28
29
29
let result_of t = t.result_of
···
38
38
type t = {
39
39
using : string list;
40
40
method_calls : Invocation.t list;
41
-
created_ids : id id_map option;
41
+
created_ids : (string, string) Hashtbl.t option;
42
42
}
43
43
44
44
let using t = t.using
···
52
52
module Response = struct
53
53
type t = {
54
54
method_responses : response_invocation list;
55
-
created_ids : id id_map option;
55
+
created_ids : (string, string) Hashtbl.t option;
56
56
session_state : string;
57
57
}
58
58
+7
-7
jmap/jmap/wire.mli
+7
-7
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 Types
15
+
(* Use underlying types directly to avoid circular dependency with Jmap module *)
16
16
17
17
(** {1 Method Invocations} *)
18
18
···
119
119
120
120
(** Get the JSON Pointer path within the referenced property.
121
121
@return The JSON Pointer path (e.g., "/0", "/items/5/id") *)
122
-
val path : t -> json_pointer
122
+
val path : t -> string
123
123
124
124
(** Create a new result reference.
125
125
@param result_of The method call ID to reference
···
129
129
val v :
130
130
result_of:string ->
131
131
name:string ->
132
-
path:json_pointer ->
132
+
path:string ->
133
133
unit ->
134
134
t
135
135
end
···
173
173
174
174
(** Get the optional createdIds map.
175
175
@return Map from client IDs to server IDs, if present *)
176
-
val created_ids : t -> id id_map option
176
+
val created_ids : t -> (string, string) Hashtbl.t option
177
177
178
178
(** Create a new request object.
179
179
@param using List of capability URIs required for this request
···
183
183
val v :
184
184
using:string list ->
185
185
method_calls:Invocation.t list ->
186
-
?created_ids:id id_map ->
186
+
?created_ids:(string, string) Hashtbl.t ->
187
187
unit ->
188
188
t
189
189
end
···
222
222
223
223
(** Get the optional createdIds map.
224
224
@return Map from client IDs to server IDs, if present *)
225
-
val created_ids : t -> id id_map option
225
+
val created_ids : t -> (string, string) Hashtbl.t option
226
226
227
227
(** Get the current session state.
228
228
@return Session state string for subsequent requests *)
···
235
235
@return A new response object *)
236
236
val v :
237
237
method_responses:response_invocation list ->
238
-
?created_ids:id id_map ->
238
+
?created_ids:(string, string) Hashtbl.t ->
239
239
session_state:string ->
240
240
unit ->
241
241
t
+3
-3
jmap/test_method.ml
+3
-3
jmap/test_method.ml
···
8
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.Types.Id.to_string id);
12
-
printf "✓ Debug representation: %s\n" (Jmap.Types.Id.to_string_debug id)
11
+
printf "✓ Created valid ID: %s\n" (stringo_string id);
12
+
printf "✓ Debug representation: %s\n" (stringo_string_debug id)
13
13
| Error msg ->
14
14
printf "✗ Failed to create valid ID: %s\n" msg
15
15
···
64
64
(* Test Id JSON roundtrip *)
65
65
(match Jmap.Types.Id.of_string "test123" with
66
66
| Ok id ->
67
-
let json = Jmap.Types.Id.to_json id in
67
+
let json = stringo_json id in
68
68
let parsed = Jmap.Types.Id.of_json json in
69
69
(match parsed with
70
70
| Ok parsed_id when Jmap.Types.Id.equal id parsed_id ->