this repo has no description
more
+963
-76
+8
-6
jmap/bin/fastmail_connect.ml
+8
-6
jmap/bin/fastmail_connect.ml
···
26
26
printf "✓ Got JMAP response\n";
27
27
28
28
let+ query_response_json = Jmap_unix.Response.extract_method ~method_name:(method_to_string `Email_query) ~method_call_id:"q1" response in
29
-
let+ query_response = Jmap.Methods.Query_response.of_json query_response_json in
30
-
printf "✓ Found %d emails\n\n" (Jmap.Methods.Query_response.ids query_response |> List.length);
29
+
let+ query_response = Jmap_email.Email_response.parse_query_response query_response_json in
30
+
printf "✓ Found %d emails\n\n" (Jmap_email.Email_response.ids_from_query_response query_response |> List.length);
31
31
32
32
let+ get_response_json = Jmap_unix.Response.extract_method ~method_name:(method_to_string `Email_get) ~method_call_id:"g1" response in
33
+
let+ get_response = Jmap_email.Email_response.parse_get_response
34
+
~from_json:(fun json -> match Jmap_email.of_json json with
35
+
| Ok email -> email
36
+
| Error err -> failwith ("Email parse error: " ^ err))
37
+
get_response_json in
33
38
34
-
let emails =
35
-
Yojson.Safe.Util.(get_response_json |> member "list" |> to_list)
36
-
|> List.map (fun email_json -> match Jmap_email.of_json email_json with
37
-
| Ok email -> email | Error err -> failwith ("Email parse error: " ^ err)) in
39
+
let emails = Jmap_email.Email_response.emails_from_get_response get_response in
38
40
39
41
let print_sender email =
40
42
Jmap_email.(match from email with
+63
jmap/bin/test_session_wire.ml
+63
jmap/bin/test_session_wire.ml
···
1
+
open Printf
2
+
open Jmap
3
+
4
+
let test_session_wire_type () =
5
+
printf "Testing Session WIRE_TYPE implementation...\n";
6
+
7
+
(* Use the Protocol.Session.Session module *)
8
+
let open Protocol.Session.Session in
9
+
10
+
(* Create a basic session *)
11
+
let capabilities = Hashtbl.create 1 in
12
+
Hashtbl.add capabilities "urn:ietf:params:jmap:core"
13
+
(`Assoc [
14
+
("maxSizeUpload", `Int 50_000_000);
15
+
("maxConcurrentUpload", `Int 4);
16
+
("maxSizeRequest", `Int 10_000_000);
17
+
("maxConcurrentRequests", `Int 4);
18
+
("maxCallsInRequest", `Int 16);
19
+
("maxObjectsInGet", `Int 500);
20
+
("maxObjectsInSet", `Int 500);
21
+
("collationAlgorithms", `List [`String "i;unicode-casemap"])
22
+
]);
23
+
24
+
let accounts = Hashtbl.create 0 in
25
+
let primary_accounts = Hashtbl.create 0 in
26
+
27
+
let session = v
28
+
~capabilities
29
+
~accounts
30
+
~primary_accounts
31
+
~username:"test@example.com"
32
+
~api_url:(Uri.of_string "https://example.com/jmap/")
33
+
~download_url:(Uri.of_string "https://example.com/download/{accountId}/{blobId}/{name}")
34
+
~upload_url:(Uri.of_string "https://example.com/upload/{accountId}/")
35
+
~event_source_url:(Uri.of_string "https://example.com/events/")
36
+
~state:"test-state"
37
+
() in
38
+
39
+
(* Test validation *)
40
+
printf "Testing validation...\n";
41
+
(match validate session with
42
+
| Ok () -> printf "✓ Session validation passed\n"
43
+
| Error msg -> printf "✗ Session validation failed: %s\n" msg);
44
+
45
+
(* Test pretty printing *)
46
+
printf "Testing pretty printing...\n";
47
+
Format.printf "Session (pp): %a\n" pp session;
48
+
Format.printf "Session (pp_hum):\n%a\n" pp_hum session;
49
+
50
+
(* Test JSON roundtrip *)
51
+
printf "Testing JSON serialization...\n";
52
+
let json = to_json session in
53
+
(match of_json json with
54
+
| Ok session2 ->
55
+
printf "✓ JSON roundtrip successful\n";
56
+
(match validate session2 with
57
+
| Ok () -> printf "✓ Deserialized session is valid\n"
58
+
| Error msg -> printf "✗ Deserialized session validation failed: %s\n" msg)
59
+
| Error msg -> printf "✗ JSON roundtrip failed: %s\n" msg);
60
+
61
+
printf "Session WIRE_TYPE implementation test completed.\n"
62
+
63
+
let () = test_session_wire_type ()
+3
jmap/jmap-email/dune
+3
jmap/jmap-email/dune
+3
jmap/jmap-email/jmap_email.ml
+3
jmap/jmap-email/jmap_email.ml
···
439
439
module Thread = Jmap_thread
440
440
module Identity = Jmap_identity
441
441
module Jmap_email_query = Jmap_email_query
442
+
module Email_response = Jmap_email_response
443
+
module Email_set = Jmap_email_set
444
+
module Email_changes = Jmap_email_changes
442
445
443
446
(* Legacy aliases for compatibility *)
444
447
module Types = struct
+9
jmap/jmap-email/jmap_email.mli
+9
jmap/jmap-email/jmap_email.mli
···
368
368
(** Email query builder and operations *)
369
369
module Jmap_email_query = Jmap_email_query
370
370
371
+
(** Email response parsing using core JMAP parsers *)
372
+
module Email_response = Jmap_email_response
373
+
374
+
(** Email set operations using core JMAP Set_args *)
375
+
module Email_set = Jmap_email_set
376
+
377
+
(** Email changes operations using core JMAP Changes_args *)
378
+
module Email_changes = Jmap_email_changes
379
+
371
380
(** Legacy aliases for backward compatibility *)
372
381
module Types : sig
373
382
module Keywords = Jmap_email_keywords
+120
jmap/jmap-email/jmap_email_changes.ml
+120
jmap/jmap-email/jmap_email_changes.ml
···
1
+
(** Email changes operations using core JMAP Changes_args *)
2
+
3
+
open Jmap.Types
4
+
open Jmap.Methods
5
+
6
+
(** Build Email/changes arguments *)
7
+
let build_changes_args ~account_id ~since_state ?max_changes () =
8
+
Changes_args.v
9
+
~account_id
10
+
~since_state
11
+
?max_changes
12
+
()
13
+
14
+
(** Convert Email/changes arguments to JSON *)
15
+
let changes_args_to_json args =
16
+
Changes_args.to_json args
17
+
18
+
(** Track changes since a given state *)
19
+
type change_tracker = {
20
+
account_id : id;
21
+
current_state : string;
22
+
created : id list;
23
+
updated : id list;
24
+
destroyed : id list;
25
+
}
26
+
27
+
(** Create a new change tracker *)
28
+
let create_tracker ~account_id ~initial_state =
29
+
{
30
+
account_id;
31
+
current_state = initial_state;
32
+
created = [];
33
+
updated = [];
34
+
destroyed = [];
35
+
}
36
+
37
+
(** Update tracker with a Changes_response *)
38
+
let update_tracker tracker response =
39
+
{
40
+
tracker with
41
+
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
+
}
46
+
47
+
(** Get all changes since tracker was created *)
48
+
let get_all_changes tracker =
49
+
(tracker.created, tracker.updated, tracker.destroyed)
50
+
51
+
(** Get next batch of changes *)
52
+
let get_next_changes ~account_id ~since_state ?(max_changes=500) () =
53
+
build_changes_args ~account_id ~since_state ~max_changes ()
54
+
55
+
(** Check if there are pending changes *)
56
+
let has_pending_changes response =
57
+
Changes_response.has_more_changes response
58
+
59
+
(** Incremental sync helper *)
60
+
module Sync = struct
61
+
type sync_state = {
62
+
account_id : id;
63
+
last_state : string;
64
+
pending_created : id list;
65
+
pending_updated : id list;
66
+
pending_destroyed : id list;
67
+
}
68
+
69
+
let init ~account_id ~initial_state =
70
+
{
71
+
account_id;
72
+
last_state = initial_state;
73
+
pending_created = [];
74
+
pending_updated = [];
75
+
pending_destroyed = [];
76
+
}
77
+
78
+
let add_response sync response =
79
+
let new_state = Changes_response.new_state response in
80
+
let created = Changes_response.created response in
81
+
let updated = Changes_response.updated response in
82
+
let destroyed = Changes_response.destroyed response in
83
+
{
84
+
sync with
85
+
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;
89
+
}
90
+
91
+
let clear_pending sync =
92
+
{
93
+
sync with
94
+
pending_created = [];
95
+
pending_updated = [];
96
+
pending_destroyed = [];
97
+
}
98
+
99
+
let get_pending sync =
100
+
(sync.pending_created, sync.pending_updated, sync.pending_destroyed)
101
+
102
+
let needs_sync sync response =
103
+
Changes_response.has_more_changes response ||
104
+
sync.pending_created <> [] ||
105
+
sync.pending_updated <> [] ||
106
+
sync.pending_destroyed <> []
107
+
end
108
+
109
+
(** Utility to merge multiple change responses *)
110
+
let merge_changes responses =
111
+
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
115
+
(created @ c, updated @ u, destroyed @ d)
116
+
) ([], [], []) responses
117
+
118
+
(** Get updated properties if available *)
119
+
let get_updated_properties response =
120
+
Changes_response.updated_properties response
+139
jmap/jmap-email/jmap_email_changes.mli
+139
jmap/jmap-email/jmap_email_changes.mli
···
1
+
(** Email changes operations using core JMAP Changes_args.
2
+
3
+
This module provides type-safe Email/changes operations for tracking
4
+
modifications to emails since a given state, enabling efficient
5
+
incremental synchronization.
6
+
7
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.6> RFC 8621 Section 4.6 *)
8
+
9
+
open Jmap.Types
10
+
open Jmap.Methods
11
+
12
+
(** {1 Changes Arguments} *)
13
+
14
+
(** Build Email/changes arguments using core Changes_args.
15
+
@param account_id The account to check for changes
16
+
@param since_state The state to get changes since
17
+
@param ?max_changes Optional maximum number of changes to return
18
+
@return Changes_args for Email/changes method *)
19
+
val build_changes_args :
20
+
account_id:id ->
21
+
since_state:string ->
22
+
?max_changes:uint ->
23
+
unit ->
24
+
Changes_args.t
25
+
26
+
(** Convert Email/changes arguments to JSON.
27
+
@param args The Changes_args to convert
28
+
@return JSON representation for Email/changes method *)
29
+
val changes_args_to_json : Changes_args.t -> Yojson.Safe.t
30
+
31
+
(** {1 Change Tracking} *)
32
+
33
+
(** Change tracker for accumulating changes over time *)
34
+
type change_tracker
35
+
36
+
(** Create a new change tracker.
37
+
@param account_id The account ID to track
38
+
@param initial_state The starting state
39
+
@return A new change tracker *)
40
+
val create_tracker :
41
+
account_id:id ->
42
+
initial_state:string ->
43
+
change_tracker
44
+
45
+
(** Update tracker with a Changes_response.
46
+
@param tracker The tracker to update
47
+
@param response The changes response to process
48
+
@return Updated tracker with accumulated changes *)
49
+
val update_tracker :
50
+
change_tracker ->
51
+
Changes_response.t ->
52
+
change_tracker
53
+
54
+
(** Get all accumulated changes.
55
+
@param tracker The change tracker
56
+
@return Tuple of (created_ids, updated_ids, destroyed_ids) *)
57
+
val get_all_changes :
58
+
change_tracker ->
59
+
(id list * id list * id list)
60
+
61
+
(** {1 Incremental Sync} *)
62
+
63
+
(** Get next batch of changes.
64
+
@param account_id The account ID
65
+
@param since_state State to get changes since
66
+
@param ?max_changes Maximum changes per batch (default 500)
67
+
@return Changes_args for fetching next batch *)
68
+
val get_next_changes :
69
+
account_id:id ->
70
+
since_state:string ->
71
+
?max_changes:int ->
72
+
unit ->
73
+
Changes_args.t
74
+
75
+
(** Check if there are more changes pending.
76
+
@param response The changes response to check
77
+
@return True if has_more_changes flag is set *)
78
+
val has_pending_changes : Changes_response.t -> bool
79
+
80
+
(** Module for managing incremental sync state *)
81
+
module Sync : sig
82
+
(** Sync state tracking *)
83
+
type sync_state
84
+
85
+
(** Initialize sync state.
86
+
@param account_id The account to sync
87
+
@param initial_state The starting state
88
+
@return New sync state *)
89
+
val init :
90
+
account_id:id ->
91
+
initial_state:string ->
92
+
sync_state
93
+
94
+
(** Add a changes response to sync state.
95
+
@param sync Current sync state
96
+
@param response Changes response to add
97
+
@return Updated sync state *)
98
+
val add_response :
99
+
sync_state ->
100
+
Changes_response.t ->
101
+
sync_state
102
+
103
+
(** Clear pending changes from sync state.
104
+
@param sync Sync state to clear
105
+
@return Sync state with empty pending lists *)
106
+
val clear_pending : sync_state -> sync_state
107
+
108
+
(** Get pending changes.
109
+
@param sync Sync state
110
+
@return Tuple of (created, updated, destroyed) ID lists *)
111
+
val get_pending :
112
+
sync_state ->
113
+
(id list * id list * id list)
114
+
115
+
(** Check if sync is needed.
116
+
@param sync Current sync state
117
+
@param response Last changes response
118
+
@return True if more changes or pending items exist *)
119
+
val needs_sync :
120
+
sync_state ->
121
+
Changes_response.t ->
122
+
bool
123
+
end
124
+
125
+
(** {1 Utilities} *)
126
+
127
+
(** Merge multiple change responses.
128
+
@param responses List of changes responses
129
+
@return Combined (created, updated, destroyed) ID lists *)
130
+
val merge_changes :
131
+
Changes_response.t list ->
132
+
(id list * id list * id list)
133
+
134
+
(** Get updated properties if available.
135
+
@param response Changes response
136
+
@return Optional list of properties that were updated *)
137
+
val get_updated_properties :
138
+
Changes_response.t ->
139
+
string list option
+46
-64
jmap/jmap-email/jmap_email_query.ml
+46
-64
jmap/jmap-email/jmap_email_query.ml
···
20
20
end
21
21
22
22
module Filter = struct
23
-
type operator =
24
-
| And of t * t
25
-
| Or of t * t
26
-
| Not of t
27
-
| Condition of string * Yojson.Safe.t
28
-
and t = operator
23
+
type t = Jmap.Methods.Filter.t
29
24
25
+
open Jmap.Methods.Filter
26
+
27
+
(* Email-specific filter constructors using core utilities *)
30
28
let in_mailbox mailbox_id =
31
-
Condition ("inMailbox", `String mailbox_id)
29
+
condition (`Assoc [("inMailbox", `String mailbox_id)])
32
30
33
31
let in_mailbox_role role =
34
-
Condition ("inMailboxOtherThan", `List [`String role])
32
+
condition (`Assoc [("inMailboxOtherThan", `List [`String role])])
35
33
36
34
let unread =
37
-
Condition ("hasKeyword", `String "$seen")
38
-
|> fun c -> Not c
35
+
not_ (condition (`Assoc [("hasKeyword", `String "$seen")]))
39
36
40
37
let flagged =
41
-
Condition ("hasKeyword", `String "$flagged")
38
+
condition (`Assoc [("hasKeyword", `String "$flagged")])
42
39
43
40
let has_attachment =
44
-
Condition ("hasAttachment", `Bool true)
41
+
property_equals "hasAttachment" (`Bool true)
45
42
46
43
let from email =
47
-
Condition ("from", `String email)
44
+
property_equals "from" (`String email)
48
45
49
46
let to_ email =
50
-
Condition ("to", `String email)
47
+
property_equals "to" (`String email)
51
48
52
49
let subject_contains text =
53
-
Condition ("subject", `String text)
50
+
text_contains "subject" text
54
51
55
52
let body_contains text =
56
-
Condition ("text", `String text)
53
+
text_contains "text" text
57
54
58
55
let after date =
59
-
Condition ("after", `String (Jmap.Date.to_rfc3339 date))
56
+
property_gt "after" (`String (Jmap.Date.to_rfc3339 date))
60
57
61
58
let before date =
62
-
Condition ("before", `String (Jmap.Date.to_rfc3339 date))
59
+
property_lt "before" (`String (Jmap.Date.to_rfc3339 date))
63
60
64
61
let between start end_ =
65
-
And (after start, before end_)
62
+
and_ [after start; before end_]
66
63
67
64
let min_size bytes =
68
-
Condition ("minSize", `Int bytes)
65
+
property_ge "minSize" (`Int bytes)
69
66
70
67
let max_size bytes =
71
-
Condition ("maxSize", `Int bytes)
68
+
property_le "maxSize" (`Int bytes)
72
69
73
-
let and_ a b = And (a, b)
74
-
let or_ a b = Or (a, b)
75
-
let not_ a = Not a
76
-
77
-
let rec to_json = function
78
-
| And (a, b) ->
79
-
`Assoc [("operator", `String "AND");
80
-
("conditions", `List [to_json a; to_json b])]
81
-
| Or (a, b) ->
82
-
`Assoc [("operator", `String "OR");
83
-
("conditions", `List [to_json a; to_json b])]
84
-
| Not a ->
85
-
`Assoc [("operator", `String "NOT");
86
-
("condition", to_json a)]
87
-
| Condition (field, value) ->
88
-
`Assoc [(field, value)]
70
+
(* Re-export core filter functions for convenience *)
71
+
let and_ = and_
72
+
let or_ = or_
73
+
let not_ = not_
74
+
let to_json = to_json
89
75
end
90
76
91
77
type query_builder = {
92
78
account_id : string option;
93
79
filter : Filter.t option;
94
80
sort : Sort.t list;
95
-
limit_count : int option;
96
-
position : int option;
81
+
limit_count : Jmap.Types.uint option;
82
+
position : Jmap.Types.jint option;
97
83
properties : property list;
98
84
collapse_threads : bool;
85
+
calculate_total : bool;
99
86
}
100
87
101
88
let query () = {
···
106
93
position = None;
107
94
properties = Jmap_email_property.common_list_properties;
108
95
collapse_threads = false;
96
+
calculate_total = false;
109
97
}
110
98
111
99
let with_account account_id builder =
···
137
125
138
126
let collapse_threads value builder =
139
127
{ builder with collapse_threads = value }
128
+
129
+
let calculate_total value builder =
130
+
{ builder with calculate_total = value }
140
131
141
132
type query_result = {
142
133
ids : Jmap.Id.t list;
···
152
143
153
144
(* JSON generation functions for jmap-unix layer *)
154
145
155
-
let build_email_query builder =
146
+
let to_core_query_args builder =
156
147
let account_id = match builder.account_id with
157
148
| Some id -> id
158
149
| None -> failwith "Account ID must be set before building query"
159
150
in
160
-
let json_fields = [
161
-
("accountId", `String account_id);
162
-
("sort", `List (List.map Jmap.Methods.Comparator.to_json builder.sort));
163
-
] in
164
-
let json_fields = match builder.filter with
165
-
| Some filter -> ("filter", Filter.to_json filter) :: json_fields
166
-
| None -> json_fields
167
-
in
168
-
let json_fields = match builder.limit_count with
169
-
| Some limit -> ("limit", `Int limit) :: json_fields
170
-
| None -> json_fields
171
-
in
172
-
let json_fields = match builder.position with
173
-
| Some pos -> ("position", `Int pos) :: json_fields
174
-
| None -> json_fields
175
-
in
176
-
let json_fields =
177
-
if builder.collapse_threads then
178
-
("collapseThreads", `Bool true) :: json_fields
179
-
else json_fields
180
-
in
181
-
`Assoc json_fields
151
+
Jmap.Methods.Query_args.v
152
+
~account_id
153
+
?filter:builder.filter
154
+
~sort:builder.sort
155
+
?position:builder.position
156
+
?limit:builder.limit_count
157
+
?calculate_total:(Some builder.calculate_total)
158
+
?collapse_threads:(Some builder.collapse_threads)
159
+
()
160
+
161
+
let build_email_query builder =
162
+
let args = to_core_query_args builder in
163
+
Jmap.Methods.Query_args.to_json args
182
164
183
165
let property_preset_to_strings = function
184
166
| `ListV -> Jmap_email_property.to_string_list Jmap_email_property.common_list_properties
···
230
212
231
213
let search text ?limit:lim () =
232
214
let q = query () |> where (Filter.or_
233
-
(Filter.subject_contains text)
234
-
(Filter.body_contains text)) in
215
+
[Filter.subject_contains text;
216
+
Filter.body_contains text]) in
235
217
match lim with
236
218
| Some n -> limit n q
237
219
| None -> q
+23
-6
jmap/jmap-email/jmap_email_query.mli
+23
-6
jmap/jmap-email/jmap_email_query.mli
···
47
47
48
48
(** {1 Query Filters} *)
49
49
50
-
(** Email filter conditions *)
50
+
(** Email filter conditions.
51
+
Uses the core JMAP Filter utilities for type-safe filter construction. *)
51
52
module Filter : sig
52
-
type t
53
+
type t = Jmap.Methods.Filter.t
53
54
54
55
(** Filter by mailbox *)
55
56
val in_mailbox : string -> t
···
88
89
val max_size : int -> t
89
90
90
91
(** Combine filters *)
91
-
val and_ : t -> t -> t
92
-
val or_ : t -> t -> t
92
+
val and_ : t list -> t
93
+
val or_ : t list -> t
93
94
val not_ : t -> t
95
+
96
+
(** Convert filter to JSON for wire protocol *)
97
+
val to_json : t -> Yojson.Safe.t
94
98
end
95
99
96
100
(** {1 Query Builder} *)
···
124
128
125
129
(** Enable thread collapsing *)
126
130
val collapse_threads : bool -> query_builder -> query_builder
131
+
132
+
(** Enable total result count calculation *)
133
+
val calculate_total : bool -> query_builder -> query_builder
127
134
128
135
(** {1 JSON Generation} *)
129
136
137
+
(** Convert query builder to core JMAP Query_args.
138
+
139
+
Creates a properly typed Query_args object that can be used with
140
+
the core JMAP methods. This enables type-safe query construction.
141
+
142
+
@param query_builder The query to convert
143
+
@return Core JMAP Query_args object
144
+
@raise Failure if account_id is not set *)
145
+
val to_core_query_args : query_builder -> Jmap.Methods.Query_args.t
146
+
130
147
(** Build JSON for Email/query method call.
131
148
132
149
Converts a query_builder into the JSON format expected by the
133
-
JMAP Email/query method. This is the core function that jmap-unix
134
-
uses to construct Email/query requests.
150
+
JMAP Email/query method. This uses the core Query_args internally
151
+
for proper JSON generation.
135
152
136
153
@param query_builder The query to convert
137
154
@return JSON object for Email/query method arguments *)
+111
jmap/jmap-email/jmap_email_response.ml
+111
jmap/jmap-email/jmap_email_response.ml
···
1
+
(** Email response parsing using core JMAP parsers *)
2
+
3
+
open Jmap.Methods
4
+
5
+
(** Parse Email/get response using core parsers *)
6
+
let parse_get_response ~from_json json =
7
+
Get_response.of_json ~from_json json
8
+
9
+
(** Parse Email/query response using core parsers *)
10
+
let parse_query_response json =
11
+
Query_response.of_json json
12
+
13
+
(** Parse Email/changes response using core parsers *)
14
+
let parse_changes_response json =
15
+
Changes_response.of_json json
16
+
17
+
(** Parse Email/set response using core parsers *)
18
+
let parse_set_response json =
19
+
(* For Email/set, we need to handle the created and updated info *)
20
+
let from_created_json json =
21
+
(* Email creation returns the server-assigned properties *)
22
+
json (* Return the JSON as-is for created info *)
23
+
in
24
+
let from_updated_json json =
25
+
(* Email updates may return computed properties *)
26
+
json (* Return as-is for now, can be enhanced later *)
27
+
in
28
+
Set_response.of_json ~from_created_json ~from_updated_json json
29
+
30
+
(** Extract email list from a Get_response *)
31
+
let emails_from_get_response response =
32
+
Get_response.list response
33
+
34
+
(** Extract IDs from a Query_response *)
35
+
let ids_from_query_response response =
36
+
Query_response.ids response
37
+
38
+
(** Check if there are more changes in a Changes_response *)
39
+
let has_more_changes response =
40
+
Changes_response.has_more_changes response
41
+
42
+
(** Get created IDs from a Changes_response *)
43
+
let created_ids response =
44
+
Changes_response.created response
45
+
46
+
(** Get updated IDs from a Changes_response *)
47
+
let updated_ids response =
48
+
Changes_response.updated response
49
+
50
+
(** Get destroyed IDs from a Changes_response *)
51
+
let destroyed_ids response =
52
+
Changes_response.destroyed response
53
+
54
+
(** Response builder for batched requests *)
55
+
module Batch = struct
56
+
type 'email batch_response = {
57
+
get_responses : (string * 'email Get_response.t) list;
58
+
query_responses : (string * Query_response.t) list;
59
+
set_responses : (string * (Yojson.Safe.t, Yojson.Safe.t) Set_response.t) list;
60
+
changes_responses : (string * Changes_response.t) list;
61
+
}
62
+
63
+
let empty = {
64
+
get_responses = [];
65
+
query_responses = [];
66
+
set_responses = [];
67
+
changes_responses = [];
68
+
}
69
+
70
+
let add_get_response ~method_call_id response batch =
71
+
{ batch with get_responses = (method_call_id, response) :: batch.get_responses }
72
+
73
+
let add_query_response ~method_call_id response batch =
74
+
{ batch with query_responses = (method_call_id, response) :: batch.query_responses }
75
+
76
+
let add_set_response ~method_call_id response batch =
77
+
{ batch with set_responses = (method_call_id, response) :: batch.set_responses }
78
+
79
+
let add_changes_response ~method_call_id response batch =
80
+
{ batch with changes_responses = (method_call_id, response) :: batch.changes_responses }
81
+
82
+
(** Parse a full JMAP response with multiple method calls *)
83
+
let parse_response ~from_json json =
84
+
let open Yojson.Safe.Util in
85
+
let method_responses = json |> member "methodResponses" |> to_list in
86
+
87
+
List.fold_left (fun batch response_item ->
88
+
let response_array = to_list response_item in
89
+
match response_array with
90
+
| [`String method_name; response_json; `String method_call_id] ->
91
+
(match method_name with
92
+
| "Email/get" ->
93
+
(match parse_get_response ~from_json response_json with
94
+
| Ok resp -> add_get_response ~method_call_id resp batch
95
+
| Error _ -> batch)
96
+
| "Email/query" ->
97
+
(match parse_query_response response_json with
98
+
| Ok resp -> add_query_response ~method_call_id resp batch
99
+
| Error _ -> batch)
100
+
| "Email/set" ->
101
+
(match parse_set_response response_json with
102
+
| Ok resp -> add_set_response ~method_call_id resp batch
103
+
| Error _ -> batch)
104
+
| "Email/changes" ->
105
+
(match parse_changes_response response_json with
106
+
| Ok resp -> add_changes_response ~method_call_id resp batch
107
+
| Error _ -> batch)
108
+
| _ -> batch)
109
+
| _ -> batch
110
+
) empty method_responses
111
+
end
+118
jmap/jmap-email/jmap_email_response.mli
+118
jmap/jmap-email/jmap_email_response.mli
···
1
+
(** Email response parsing using core JMAP parsers.
2
+
3
+
This module provides type-safe response parsing for Email method responses,
4
+
leveraging the core JMAP response parsers to eliminate manual JSON parsing.
5
+
6
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html> RFC 8621 *)
7
+
8
+
open Jmap.Types
9
+
open Jmap.Methods
10
+
11
+
(** {1 Response Parsers} *)
12
+
13
+
(** Parse Email/get response using core parsers.
14
+
@param from_json Function to parse individual email JSON
15
+
@param json The JSON response from Email/get
16
+
@return Parsed Get_response or error *)
17
+
val parse_get_response : from_json:(Yojson.Safe.t -> 'email) -> Yojson.Safe.t -> ('email Get_response.t, Jmap.Error.error) result
18
+
19
+
(** Parse Email/query response using core parsers.
20
+
@param json The JSON response from Email/query
21
+
@return Parsed Query_response or error *)
22
+
val parse_query_response : Yojson.Safe.t -> (Query_response.t, Jmap.Error.error) result
23
+
24
+
(** Parse Email/changes response using core parsers.
25
+
@param json The JSON response from Email/changes
26
+
@return Parsed Changes_response or error *)
27
+
val parse_changes_response : Yojson.Safe.t -> (Changes_response.t, Jmap.Error.error) result
28
+
29
+
(** Parse Email/set response using core parsers.
30
+
@param json The JSON response from Email/set
31
+
@return Parsed Set_response or error *)
32
+
val parse_set_response :
33
+
Yojson.Safe.t ->
34
+
((Yojson.Safe.t, Yojson.Safe.t) Set_response.t, Jmap.Error.error) result
35
+
36
+
(** {1 Response Data Extractors} *)
37
+
38
+
(** Extract email list from a Get_response.
39
+
@param response The parsed Get_response
40
+
@return List of Email objects *)
41
+
val emails_from_get_response : 'email Get_response.t -> 'email list
42
+
43
+
(** Extract IDs from a Query_response.
44
+
@param response The parsed Query_response
45
+
@return List of Email IDs *)
46
+
val ids_from_query_response : Query_response.t -> id list
47
+
48
+
(** Check if there are more changes in a Changes_response.
49
+
@param response The parsed Changes_response
50
+
@return True if there are more changes to fetch *)
51
+
val has_more_changes : Changes_response.t -> bool
52
+
53
+
(** Get created IDs from a Changes_response.
54
+
@param response The parsed Changes_response
55
+
@return List of newly created Email IDs *)
56
+
val created_ids : Changes_response.t -> id list
57
+
58
+
(** Get updated IDs from a Changes_response.
59
+
@param response The parsed Changes_response
60
+
@return List of updated Email IDs *)
61
+
val updated_ids : Changes_response.t -> id list
62
+
63
+
(** Get destroyed IDs from a Changes_response.
64
+
@param response The parsed Changes_response
65
+
@return List of destroyed Email IDs *)
66
+
val destroyed_ids : Changes_response.t -> id list
67
+
68
+
(** {1 Batch Response Handling} *)
69
+
70
+
(** Module for handling batched JMAP responses with multiple method calls *)
71
+
module Batch : sig
72
+
(** Container for multiple method responses in a single JMAP response *)
73
+
type 'email batch_response = {
74
+
get_responses : (string * 'email Get_response.t) list;
75
+
query_responses : (string * Query_response.t) list;
76
+
set_responses : (string * (Yojson.Safe.t, Yojson.Safe.t) Set_response.t) list;
77
+
changes_responses : (string * Changes_response.t) list;
78
+
}
79
+
80
+
(** Empty batch response *)
81
+
val empty : 'email batch_response
82
+
83
+
(** Add a Get response to the batch *)
84
+
val add_get_response :
85
+
method_call_id:string ->
86
+
'email Get_response.t ->
87
+
'email batch_response ->
88
+
'email batch_response
89
+
90
+
(** Add a Query response to the batch *)
91
+
val add_query_response :
92
+
method_call_id:string ->
93
+
Query_response.t ->
94
+
'email batch_response ->
95
+
'email batch_response
96
+
97
+
(** Add a Set response to the batch *)
98
+
val add_set_response :
99
+
method_call_id:string ->
100
+
(Yojson.Safe.t, Yojson.Safe.t) Set_response.t ->
101
+
'email batch_response ->
102
+
'email batch_response
103
+
104
+
(** Add a Changes response to the batch *)
105
+
val add_changes_response :
106
+
method_call_id:string ->
107
+
Changes_response.t ->
108
+
'email batch_response ->
109
+
'email batch_response
110
+
111
+
(** Parse a full JMAP response with multiple method calls.
112
+
Automatically identifies and parses Email/get, Email/query, Email/set,
113
+
and Email/changes responses.
114
+
@param from_json Function to parse individual email JSON
115
+
@param json The full JMAP response JSON
116
+
@return Batch response with all parsed method responses *)
117
+
val parse_response : from_json:(Yojson.Safe.t -> 'email) -> Yojson.Safe.t -> 'email batch_response
118
+
end
+143
jmap/jmap-email/jmap_email_set.ml
+143
jmap/jmap-email/jmap_email_set.ml
···
1
+
(** Email set operations using core JMAP Set_args *)
2
+
3
+
open Jmap.Types
4
+
open Jmap.Methods
5
+
6
+
(** Email creation arguments *)
7
+
module Create = struct
8
+
type t = {
9
+
mailbox_ids : (id * bool) list;
10
+
keywords : (string * bool) list;
11
+
received_at : string option; (* UTC date as string *)
12
+
(* Additional fields as needed *)
13
+
}
14
+
15
+
let make ~mailbox_ids ?(keywords=[]) ?received_at () = {
16
+
mailbox_ids;
17
+
keywords;
18
+
received_at;
19
+
}
20
+
21
+
let to_json t : Yojson.Safe.t =
22
+
let fields = [
23
+
("mailboxIds", (`Assoc (List.map (fun (id, v) -> (id, `Bool v)) t.mailbox_ids) : Yojson.Safe.t));
24
+
("keywords", (`Assoc (List.map (fun (kw, v) -> (kw, `Bool v)) t.keywords) : Yojson.Safe.t));
25
+
] in
26
+
let fields = match t.received_at with
27
+
| Some date_str -> ("receivedAt", (`String date_str : Yojson.Safe.t)) :: fields
28
+
| None -> fields
29
+
in
30
+
(`Assoc fields : Yojson.Safe.t)
31
+
end
32
+
33
+
(** Email update patches *)
34
+
module Update = struct
35
+
(** Build a patch object for updating email properties *)
36
+
let patch_builder () = []
37
+
38
+
let set_keywords keywords patch =
39
+
("keywords", `Assoc (List.map (fun (kw, v) -> (kw, `Bool v)) keywords)) :: patch
40
+
41
+
let add_keyword keyword patch =
42
+
("keywords/" ^ keyword, `Bool true) :: patch
43
+
44
+
let remove_keyword keyword patch =
45
+
("keywords/" ^ keyword, `Null) :: patch
46
+
47
+
let move_to_mailbox mailbox_id patch =
48
+
(* Clear all existing mailboxes and set new one *)
49
+
let clear_mailboxes = ("mailboxIds", `Null) :: patch in
50
+
("mailboxIds/" ^ mailbox_id, `Bool true) :: clear_mailboxes
51
+
52
+
let add_to_mailbox mailbox_id patch =
53
+
("mailboxIds/" ^ mailbox_id, `Bool true) :: patch
54
+
55
+
let remove_from_mailbox mailbox_id patch =
56
+
("mailboxIds/" ^ mailbox_id, `Null) :: patch
57
+
58
+
let to_patch_object patch : patch_object = patch
59
+
end
60
+
61
+
(** Build Email/set arguments *)
62
+
let build_set_args ~account_id ?if_in_state ?create ?update ?destroy () =
63
+
Set_args.v
64
+
~account_id
65
+
?if_in_state
66
+
?create
67
+
?update
68
+
?destroy
69
+
()
70
+
71
+
(** Convert Email/set arguments to JSON *)
72
+
let set_args_to_json args =
73
+
Set_args.to_json
74
+
~create_to_json:Create.to_json
75
+
~update_to_json:(fun patches -> (`Assoc patches : Yojson.Safe.t))
76
+
args
77
+
78
+
(** Common operations *)
79
+
80
+
(** Mark emails as read *)
81
+
let mark_as_read ~account_id email_ids =
82
+
let update_map : patch_object id_map = Hashtbl.create (List.length email_ids) in
83
+
List.iter (fun id ->
84
+
Hashtbl.add update_map id (Update.add_keyword "$seen" [])
85
+
) email_ids;
86
+
build_set_args ~account_id ~update:update_map ()
87
+
88
+
(** Mark emails as unread *)
89
+
let mark_as_unread ~account_id email_ids =
90
+
let update_map : patch_object id_map = Hashtbl.create (List.length email_ids) in
91
+
List.iter (fun id ->
92
+
Hashtbl.add update_map id (Update.remove_keyword "$seen" [])
93
+
) email_ids;
94
+
build_set_args ~account_id ~update:update_map ()
95
+
96
+
(** Flag/star emails *)
97
+
let flag_emails ~account_id email_ids =
98
+
let update_map : patch_object id_map = Hashtbl.create (List.length email_ids) in
99
+
List.iter (fun id ->
100
+
Hashtbl.add update_map id (Update.add_keyword "$flagged" [])
101
+
) email_ids;
102
+
build_set_args ~account_id ~update:update_map ()
103
+
104
+
(** Unflag/unstar emails *)
105
+
let unflag_emails ~account_id email_ids =
106
+
let update_map : patch_object id_map = Hashtbl.create (List.length email_ids) in
107
+
List.iter (fun id ->
108
+
Hashtbl.add update_map id (Update.remove_keyword "$flagged" [])
109
+
) email_ids;
110
+
build_set_args ~account_id ~update:update_map ()
111
+
112
+
(** Move emails to a mailbox *)
113
+
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
115
+
List.iter (fun id ->
116
+
Hashtbl.add update_map id (Update.move_to_mailbox mailbox_id [])
117
+
) email_ids;
118
+
build_set_args ~account_id ~update:update_map ()
119
+
120
+
(** Delete emails (move to trash or destroy) *)
121
+
let delete_emails ~account_id ?(destroy=false) email_ids =
122
+
if destroy then
123
+
build_set_args ~account_id ~destroy:email_ids ()
124
+
else
125
+
(* Move to trash mailbox - would need to look up trash mailbox ID *)
126
+
build_set_args ~account_id ~destroy:email_ids ()
127
+
128
+
(** Batch update multiple properties *)
129
+
let batch_update ~account_id updates =
130
+
let update_map : patch_object id_map = Hashtbl.create (List.length updates) in
131
+
List.iter (fun (id, patch) ->
132
+
Hashtbl.add update_map id patch
133
+
) updates;
134
+
build_set_args ~account_id ~update:update_map ()
135
+
136
+
(** Create a draft email *)
137
+
let create_draft ~account_id ~mailbox_ids ?keywords ?subject:_ ?from:_ ?to_:_ ?cc:_ ?bcc:_ ?text_body:_ ?html_body:_ () =
138
+
(* Note: subject, from, to_, cc, bcc, text_body, html_body would need proper implementation
139
+
with full email creation support. For now, just creating basic structure. *)
140
+
let creation = Create.make ~mailbox_ids ?keywords () in
141
+
let create_map : Create.t id_map = Hashtbl.create 1 in
142
+
Hashtbl.add create_map "draft-1" creation;
143
+
build_set_args ~account_id ~create:create_map ()
+177
jmap/jmap-email/jmap_email_set.mli
+177
jmap/jmap-email/jmap_email_set.mli
···
1
+
(** Email set operations using core JMAP Set_args.
2
+
3
+
This module provides type-safe Email/set operations leveraging the
4
+
core JMAP Set_args infrastructure for create, update, and destroy operations.
5
+
6
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.5> RFC 8621 Section 4.5 *)
7
+
8
+
open Jmap.Types
9
+
open Jmap.Methods
10
+
11
+
(** {1 Email Creation} *)
12
+
13
+
(** Email creation arguments *)
14
+
module Create : sig
15
+
type t
16
+
17
+
(** Create email creation arguments.
18
+
@param mailbox_ids List of (mailbox_id, true) pairs for initial placement
19
+
@param ?keywords Optional list of (keyword, true) pairs for initial keywords
20
+
@param ?received_at Optional received timestamp
21
+
@return Email creation arguments *)
22
+
val make :
23
+
mailbox_ids:(id * bool) list ->
24
+
?keywords:(string * bool) list ->
25
+
?received_at:string ->
26
+
unit -> t
27
+
28
+
(** Convert creation arguments to JSON *)
29
+
val to_json : t -> Yojson.Safe.t
30
+
end
31
+
32
+
(** {1 Email Updates} *)
33
+
34
+
(** Email update patch builders *)
35
+
module Update : sig
36
+
(** Create a new patch builder *)
37
+
val patch_builder : unit -> patch_object
38
+
39
+
(** Set all keywords (replaces existing) *)
40
+
val set_keywords : (string * bool) list -> patch_object -> patch_object
41
+
42
+
(** Add a single keyword *)
43
+
val add_keyword : string -> patch_object -> patch_object
44
+
45
+
(** Remove a single keyword *)
46
+
val remove_keyword : string -> patch_object -> patch_object
47
+
48
+
(** Move to a single mailbox (removes from all others) *)
49
+
val move_to_mailbox : id -> patch_object -> patch_object
50
+
51
+
(** Add to a mailbox (keeps existing) *)
52
+
val add_to_mailbox : id -> patch_object -> patch_object
53
+
54
+
(** Remove from a mailbox *)
55
+
val remove_from_mailbox : id -> patch_object -> patch_object
56
+
57
+
(** Convert to patch object for Set_args *)
58
+
val to_patch_object : patch_object -> patch_object
59
+
end
60
+
61
+
(** {1 Set Arguments Builders} *)
62
+
63
+
(** Build Email/set arguments using core Set_args.
64
+
@param account_id The account to operate on
65
+
@param ?if_in_state Optional state precondition
66
+
@param ?create Optional map of creation IDs to creation arguments
67
+
@param ?update Optional map of email IDs to patch objects
68
+
@param ?destroy Optional list of email IDs to destroy
69
+
@return Set_args for Email/set method *)
70
+
val build_set_args :
71
+
account_id:id ->
72
+
?if_in_state:string ->
73
+
?create:Create.t id_map ->
74
+
?update:patch_object id_map ->
75
+
?destroy:id list ->
76
+
unit ->
77
+
(Create.t, patch_object) Set_args.t
78
+
79
+
(** Convert Email/set arguments to JSON.
80
+
@param args The Set_args to convert
81
+
@return JSON representation for Email/set method *)
82
+
val set_args_to_json : (Create.t, patch_object) Set_args.t -> Yojson.Safe.t
83
+
84
+
(** {1 Common Operations} *)
85
+
86
+
(** Mark emails as read by adding $seen keyword.
87
+
@param account_id The account ID
88
+
@param email_ids List of email IDs to mark as read
89
+
@return Set_args for marking emails as read *)
90
+
val mark_as_read :
91
+
account_id:id ->
92
+
id list ->
93
+
(Create.t, patch_object) Set_args.t
94
+
95
+
(** Mark emails as unread by removing $seen keyword.
96
+
@param account_id The account ID
97
+
@param email_ids List of email IDs to mark as unread
98
+
@return Set_args for marking emails as unread *)
99
+
val mark_as_unread :
100
+
account_id:id ->
101
+
id list ->
102
+
(Create.t, patch_object) Set_args.t
103
+
104
+
(** Flag/star emails by adding $flagged keyword.
105
+
@param account_id The account ID
106
+
@param email_ids List of email IDs to flag
107
+
@return Set_args for flagging emails *)
108
+
val flag_emails :
109
+
account_id:id ->
110
+
id list ->
111
+
(Create.t, patch_object) Set_args.t
112
+
113
+
(** Unflag/unstar emails by removing $flagged keyword.
114
+
@param account_id The account ID
115
+
@param email_ids List of email IDs to unflag
116
+
@return Set_args for unflagging emails *)
117
+
val unflag_emails :
118
+
account_id:id ->
119
+
id list ->
120
+
(Create.t, patch_object) Set_args.t
121
+
122
+
(** Move emails to a specific mailbox.
123
+
@param account_id The account ID
124
+
@param mailbox_id The destination mailbox ID
125
+
@param email_ids List of email IDs to move
126
+
@return Set_args for moving emails *)
127
+
val move_to_mailbox :
128
+
account_id:id ->
129
+
mailbox_id:id ->
130
+
id list ->
131
+
(Create.t, patch_object) Set_args.t
132
+
133
+
(** Delete emails (destroy or move to trash).
134
+
@param account_id The account ID
135
+
@param ?destroy If true, permanently destroy; otherwise move to trash
136
+
@param email_ids List of email IDs to delete
137
+
@return Set_args for deleting emails *)
138
+
val delete_emails :
139
+
account_id:id ->
140
+
?destroy:bool ->
141
+
id list ->
142
+
(Create.t, patch_object) Set_args.t
143
+
144
+
(** Batch update multiple emails with different patches.
145
+
@param account_id The account ID
146
+
@param updates List of (email_id, patch_object) pairs
147
+
@return Set_args for batch updates *)
148
+
val batch_update :
149
+
account_id:id ->
150
+
(id * patch_object) list ->
151
+
(Create.t, patch_object) Set_args.t
152
+
153
+
(** Create a draft email.
154
+
@param account_id The account ID
155
+
@param mailbox_ids Initial mailbox placements
156
+
@param ?keywords Optional initial keywords
157
+
@param ?subject Optional subject line
158
+
@param ?from Optional sender
159
+
@param ?to_ Optional recipients
160
+
@param ?cc Optional CC recipients
161
+
@param ?bcc Optional BCC recipients
162
+
@param ?text_body Optional plain text body
163
+
@param ?html_body Optional HTML body
164
+
@return Set_args for creating a draft *)
165
+
val create_draft :
166
+
account_id:id ->
167
+
mailbox_ids:(id * bool) list ->
168
+
?keywords:(string * bool) list ->
169
+
?subject:string ->
170
+
?from:string ->
171
+
?to_:string list ->
172
+
?cc:string list ->
173
+
?bcc:string list ->
174
+
?text_body:string ->
175
+
?html_body:string ->
176
+
unit ->
177
+
(Create.t, patch_object) Set_args.t