this repo has no description
more
+1004
-8
+8
-8
jmap/bin/fastmail_connect.ml
+8
-8
jmap/bin/fastmail_connect.ml
···
115
115
116
116
let test_id = match Jmap.Id.of_string "test-id-123" with
117
117
| Ok id ->
118
-
printf "✓ Jmap.Id creation: %s\n" (Jmap.Id.to_string id);
118
+
Format.printf "✓ Jmap.Id creation: %a\n" Jmap.Id.pp id;
119
119
true
120
120
| Error e ->
121
121
printf "✗ Jmap.Id creation failed: %s\n" e;
···
131
131
132
132
let test_uint = match Jmap.UInt.of_int 42 with
133
133
| Ok uint ->
134
-
printf "✓ Jmap.UInt creation: %d\n" (Jmap.UInt.to_int uint);
134
+
Format.printf "✓ Jmap.UInt creation: %a\n" Jmap.UInt.pp uint;
135
135
true
136
136
| Error e ->
137
137
printf "✗ Jmap.UInt creation failed: %s\n" e;
···
184
184
(match fetch_recent_emails env ctx session with
185
185
| Ok () -> printf "✓ Email fetch completed successfully\n"
186
186
| Error error ->
187
-
printf "⚠ Email fetch failed: %s\n"
188
-
(Jmap.Protocol.Error.error_to_string error));
187
+
Format.printf "⚠ Email fetch failed: %a\n"
188
+
Jmap.Protocol.Error.pp error);
189
189
190
190
(* Close connection *)
191
191
printf "\nClosing connection...\n";
192
192
(match Jmap_unix.close ctx with
193
193
| Ok () -> printf "✓ Connection closed successfully\n"
194
194
| Error error ->
195
-
printf "⚠ Error closing connection: %s\n"
196
-
(Jmap.Protocol.Error.error_to_string error));
195
+
Format.printf "⚠ Error closing connection: %a\n"
196
+
Jmap.Protocol.Error.pp error);
197
197
198
198
printf "\nOverall: ALL TESTS PASSED\n"
199
199
200
200
| Error error ->
201
-
eprintf "✗ Connection failed: %s\n"
202
-
(Jmap.Protocol.Error.error_to_string error);
201
+
Format.eprintf "✗ Connection failed: %a\n"
202
+
Jmap.Protocol.Error.pp error;
203
203
eprintf "\nThis could be due to:\n";
204
204
eprintf " - Invalid API key\n";
205
205
eprintf " - Network connectivity issues\n";
+134
jmap/jmap-email/jmap_email_batch.mli
+134
jmap/jmap-email/jmap_email_batch.mli
···
1
+
(** Batch operations for JMAP Email.
2
+
3
+
This module provides efficient batch operations for common
4
+
email management tasks, minimizing round-trips to the server.
5
+
6
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.6> RFC 8621 Section 4.6 *)
7
+
8
+
(** {1 Batch Operations} *)
9
+
10
+
(** Batch operation builder *)
11
+
type t
12
+
13
+
(** Create a new batch operation *)
14
+
val create : unit -> t
15
+
16
+
(** {2 Email Operations} *)
17
+
18
+
(** Mark emails as read *)
19
+
val mark_read : Jmap.Id.t list -> t -> t
20
+
21
+
(** Mark emails as unread *)
22
+
val mark_unread : Jmap.Id.t list -> t -> t
23
+
24
+
(** Add flag/star to emails *)
25
+
val add_flag : Jmap.Id.t list -> t -> t
26
+
27
+
(** Remove flag/star from emails *)
28
+
val remove_flag : Jmap.Id.t list -> t -> t
29
+
30
+
(** Add custom keyword to emails *)
31
+
val add_keyword : string -> Jmap.Id.t list -> t -> t
32
+
33
+
(** Remove custom keyword from emails *)
34
+
val remove_keyword : string -> Jmap.Id.t list -> t -> t
35
+
36
+
(** Move emails to a mailbox *)
37
+
val move_to_mailbox : mailbox_id:string -> Jmap.Id.t list -> t -> t
38
+
39
+
(** Copy emails to a mailbox *)
40
+
val copy_to_mailbox : mailbox_id:string -> Jmap.Id.t list -> t -> t
41
+
42
+
(** Remove emails from a mailbox *)
43
+
val remove_from_mailbox : mailbox_id:string -> Jmap.Id.t list -> t -> t
44
+
45
+
(** Move emails to trash *)
46
+
val move_to_trash : Jmap.Id.t list -> t -> t
47
+
48
+
(** Permanently delete emails *)
49
+
val delete : Jmap.Id.t list -> t -> t
50
+
51
+
(** Archive emails (remove from inbox, keep in other mailboxes) *)
52
+
val archive : Jmap.Id.t list -> t -> t
53
+
54
+
(** {2 Mailbox Operations} *)
55
+
56
+
(** Create a new mailbox *)
57
+
val create_mailbox :
58
+
name:string ->
59
+
?parent_id:string ->
60
+
?role:string ->
61
+
t -> t
62
+
63
+
(** Rename a mailbox *)
64
+
val rename_mailbox : Jmap.Id.t -> string -> t -> t
65
+
66
+
(** Delete a mailbox *)
67
+
val delete_mailbox : Jmap.Id.t -> t -> t
68
+
69
+
(** {2 Execution} *)
70
+
71
+
(** Batch operation result *)
72
+
type result = {
73
+
created : (string * Jmap.Id.t) list; (** Temporary ID -> Server ID mapping *)
74
+
updated : Jmap.Id.t list; (** Successfully updated IDs *)
75
+
destroyed : Jmap.Id.t list; (** Successfully destroyed IDs *)
76
+
not_created : (string * Jmap.Protocol.Error.Set_error.t) list;
77
+
not_updated : (Jmap.Id.t * Jmap.Protocol.Error.Set_error.t) list;
78
+
not_destroyed : (Jmap.Id.t * Jmap.Protocol.Error.Set_error.t) list;
79
+
}
80
+
81
+
(** Execute batch operations *)
82
+
val execute :
83
+
env:Eio_unix.Stdenv.base ->
84
+
ctx:Jmap_unix.context ->
85
+
session:Jmap.Protocol.Session.Session.t ->
86
+
?account_id:string ->
87
+
t ->
88
+
(result, Jmap.Protocol.Error.error) result
89
+
90
+
(** {1 Common Workflows} *)
91
+
92
+
(** Process inbox - mark as read and archive *)
93
+
val process_inbox :
94
+
env:Eio_unix.Stdenv.base ->
95
+
ctx:Jmap_unix.context ->
96
+
session:Jmap.Protocol.Session.Session.t ->
97
+
email_ids:Jmap.Id.t list ->
98
+
(result, Jmap.Protocol.Error.error) result
99
+
100
+
(** Bulk delete spam/trash emails older than N days *)
101
+
val cleanup_old_emails :
102
+
env:Eio_unix.Stdenv.base ->
103
+
ctx:Jmap_unix.context ->
104
+
session:Jmap.Protocol.Session.Session.t ->
105
+
mailbox_role:string -> (* "spam" or "trash" *)
106
+
older_than_days:int ->
107
+
(result, Jmap.Protocol.Error.error) result
108
+
109
+
(** Organize emails by sender into mailboxes *)
110
+
val organize_by_sender :
111
+
env:Eio_unix.Stdenv.base ->
112
+
ctx:Jmap_unix.context ->
113
+
session:Jmap.Protocol.Session.Session.t ->
114
+
rules:(string * string) list -> (* sender email -> mailbox name *)
115
+
(result, Jmap.Protocol.Error.error) result
116
+
117
+
(** {1 Progress Tracking} *)
118
+
119
+
(** Progress callback for long operations *)
120
+
type progress = {
121
+
current : int;
122
+
total : int;
123
+
message : string;
124
+
}
125
+
126
+
(** Execute with progress reporting *)
127
+
val execute_with_progress :
128
+
env:Eio_unix.Stdenv.base ->
129
+
ctx:Jmap_unix.context ->
130
+
session:Jmap.Protocol.Session.Session.t ->
131
+
?account_id:string ->
132
+
progress_fn:(progress -> unit) ->
133
+
t ->
134
+
(result, Jmap.Protocol.Error.error) result
+199
jmap/jmap-email/jmap_email_methods.mli
+199
jmap/jmap-email/jmap_email_methods.mli
···
1
+
(** JMAP Email method names and builders.
2
+
3
+
This module provides type-safe method names and high-level
4
+
builders for JMAP Email methods.
5
+
6
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html> RFC 8621 *)
7
+
8
+
(** {1 Method Names} *)
9
+
10
+
(** Email method names as a polymorphic variant type *)
11
+
type t = [
12
+
| `Email_get
13
+
| `Email_query
14
+
| `Email_queryChanges
15
+
| `Email_set
16
+
| `Email_copy
17
+
| `Email_import
18
+
| `Email_parse
19
+
| `EmailSubmission_get
20
+
| `EmailSubmission_query
21
+
| `EmailSubmission_queryChanges
22
+
| `EmailSubmission_set
23
+
| `Thread_get
24
+
| `Thread_query
25
+
| `Mailbox_get
26
+
| `Mailbox_query
27
+
| `Mailbox_queryChanges
28
+
| `Mailbox_set
29
+
| `Identity_get
30
+
| `Identity_query
31
+
| `Identity_set
32
+
| `VacationResponse_get
33
+
| `VacationResponse_set
34
+
]
35
+
36
+
(** Convert method name to string for wire protocol *)
37
+
val to_string : t -> string
38
+
39
+
(** Parse method name from string *)
40
+
val of_string : string -> t option
41
+
42
+
(** Pretty-print a method name *)
43
+
val pp : Format.formatter -> t -> unit
44
+
45
+
(** {1 Method Call ID Management} *)
46
+
47
+
(** Method call ID generator *)
48
+
module CallId : sig
49
+
type t
50
+
51
+
(** Create a call ID generator *)
52
+
val create : unit -> t
53
+
54
+
(** Generate next call ID with optional prefix *)
55
+
val next : ?prefix:string -> t -> string
56
+
57
+
(** Reset the generator *)
58
+
val reset : t -> unit
59
+
end
60
+
61
+
(** {1 Request Builders} *)
62
+
63
+
(** High-level request builder that manages method chaining *)
64
+
module RequestBuilder : sig
65
+
type t
66
+
67
+
(** Create a new request builder *)
68
+
val create : Jmap_unix.context -> t
69
+
70
+
(** Add Email/query method *)
71
+
val email_query :
72
+
?account_id:string ->
73
+
?filter:Jmap_email_query.Filter.t ->
74
+
?sort:Jmap_email_query.Sort.t list ->
75
+
?limit:int ->
76
+
?position:int ->
77
+
t -> t
78
+
79
+
(** Add Email/get method with automatic result reference *)
80
+
val email_get :
81
+
?account_id:string ->
82
+
?ids:Jmap.Id.t list ->
83
+
?properties:Jmap_email_query.property list ->
84
+
?reference_from:string -> (* Call ID to reference *)
85
+
t -> t
86
+
87
+
(** Add Email/set method *)
88
+
val email_set :
89
+
?account_id:string ->
90
+
?create:(string * Jmap_email.t) list ->
91
+
?update:(Jmap.Id.t * Jmap.Patch.t) list ->
92
+
?destroy:Jmap.Id.t list ->
93
+
t -> t
94
+
95
+
(** Add Thread/get method *)
96
+
val thread_get :
97
+
?account_id:string ->
98
+
?ids:Jmap.Id.t list ->
99
+
t -> t
100
+
101
+
(** Add Mailbox/query method *)
102
+
val mailbox_query :
103
+
?account_id:string ->
104
+
?filter:Yojson.Safe.t ->
105
+
?sort:Jmap.Methods.Comparator.t list ->
106
+
t -> t
107
+
108
+
(** Add Mailbox/get method *)
109
+
val mailbox_get :
110
+
?account_id:string ->
111
+
?ids:Jmap.Id.t list ->
112
+
t -> t
113
+
114
+
(** Execute the built request *)
115
+
val execute :
116
+
env:Eio_unix.Stdenv.base ->
117
+
session:Jmap.Protocol.Session.Session.t ->
118
+
t ->
119
+
(Jmap.Protocol.Response.t, Jmap.Protocol.Error.error) result
120
+
121
+
(** Get specific method response by type *)
122
+
val get_response :
123
+
method_:t ->
124
+
?call_id:string ->
125
+
Jmap.Protocol.Response.t ->
126
+
(Yojson.Safe.t, Jmap.Protocol.Error.error) result
127
+
end
128
+
129
+
(** {1 Response Parsers} *)
130
+
131
+
(** Type-safe response extraction *)
132
+
module Response : sig
133
+
(** Extract and parse Email/query response *)
134
+
val parse_email_query :
135
+
?call_id:string ->
136
+
Jmap.Protocol.Response.t ->
137
+
(Jmap_email_query.query_result, Jmap.Protocol.Error.error) result
138
+
139
+
(** Extract and parse Email/get response *)
140
+
val parse_email_get :
141
+
?call_id:string ->
142
+
Jmap.Protocol.Response.t ->
143
+
(Jmap_email.t list, Jmap.Protocol.Error.error) result
144
+
145
+
(** Extract and parse Thread/get response *)
146
+
val parse_thread_get :
147
+
?call_id:string ->
148
+
Jmap.Protocol.Response.t ->
149
+
(Jmap_thread.t list, Jmap.Protocol.Error.error) result
150
+
151
+
(** Extract and parse Mailbox/get response *)
152
+
val parse_mailbox_get :
153
+
?call_id:string ->
154
+
Jmap.Protocol.Response.t ->
155
+
(Jmap_mailbox.t list, Jmap.Protocol.Error.error) result
156
+
end
157
+
158
+
(** {1 Common Patterns} *)
159
+
160
+
(** Execute Email/query and automatically chain Email/get *)
161
+
val query_and_fetch :
162
+
env:Eio_unix.Stdenv.base ->
163
+
ctx:Jmap_unix.context ->
164
+
session:Jmap.Protocol.Session.Session.t ->
165
+
?account_id:string ->
166
+
?filter:Jmap_email_query.Filter.t ->
167
+
?sort:Jmap_email_query.Sort.t list ->
168
+
?limit:int ->
169
+
?properties:Jmap_email_query.property list ->
170
+
unit ->
171
+
(Jmap_email.t list, Jmap.Protocol.Error.error) result
172
+
173
+
(** Get emails by IDs *)
174
+
val get_emails_by_ids :
175
+
env:Eio_unix.Stdenv.base ->
176
+
ctx:Jmap_unix.context ->
177
+
session:Jmap.Protocol.Session.Session.t ->
178
+
?account_id:string ->
179
+
?properties:Jmap_email_query.property list ->
180
+
Jmap.Id.t list ->
181
+
(Jmap_email.t list, Jmap.Protocol.Error.error) result
182
+
183
+
(** Get all mailboxes *)
184
+
val get_mailboxes :
185
+
env:Eio_unix.Stdenv.base ->
186
+
ctx:Jmap_unix.context ->
187
+
session:Jmap.Protocol.Session.Session.t ->
188
+
?account_id:string ->
189
+
unit ->
190
+
(Jmap_mailbox.t list, Jmap.Protocol.Error.error) result
191
+
192
+
(** Find mailbox by role (e.g., "inbox", "sent", "drafts") *)
193
+
val find_mailbox_by_role :
194
+
env:Eio_unix.Stdenv.base ->
195
+
ctx:Jmap_unix.context ->
196
+
session:Jmap.Protocol.Session.Session.t ->
197
+
?account_id:string ->
198
+
string ->
199
+
(Jmap_mailbox.t option, Jmap.Protocol.Error.error) result
+378
jmap/jmap-email/jmap_email_query.ml
+378
jmap/jmap-email/jmap_email_query.ml
···
1
+
(** High-level Email query implementation *)
2
+
3
+
type property = [
4
+
| `Id | `BlobId | `ThreadId | `MailboxIds | `Keywords | `Size
5
+
| `ReceivedAt | `MessageId | `InReplyTo | `References | `Sender
6
+
| `From | `To | `Cc | `Bcc | `ReplyTo | `Subject | `SentAt
7
+
| `HasAttachment | `Preview | `BodyStructure | `BodyValues
8
+
| `TextBody | `HtmlBody | `Attachments
9
+
]
10
+
11
+
let property_to_string = function
12
+
| `Id -> "id"
13
+
| `BlobId -> "blobId"
14
+
| `ThreadId -> "threadId"
15
+
| `MailboxIds -> "mailboxIds"
16
+
| `Keywords -> "keywords"
17
+
| `Size -> "size"
18
+
| `ReceivedAt -> "receivedAt"
19
+
| `MessageId -> "messageId"
20
+
| `InReplyTo -> "inReplyTo"
21
+
| `References -> "references"
22
+
| `Sender -> "sender"
23
+
| `From -> "from"
24
+
| `To -> "to"
25
+
| `Cc -> "cc"
26
+
| `Bcc -> "bcc"
27
+
| `ReplyTo -> "replyTo"
28
+
| `Subject -> "subject"
29
+
| `SentAt -> "sentAt"
30
+
| `HasAttachment -> "hasAttachment"
31
+
| `Preview -> "preview"
32
+
| `BodyStructure -> "bodyStructure"
33
+
| `BodyValues -> "bodyValues"
34
+
| `TextBody -> "textBody"
35
+
| `HtmlBody -> "htmlBody"
36
+
| `Attachments -> "attachments"
37
+
38
+
module PropertySets = struct
39
+
let list_view = [`Id; `Subject; `From; `ReceivedAt; `Preview; `Keywords]
40
+
let preview = [`Id; `Subject; `From; `To; `ReceivedAt; `Preview; `HasAttachment]
41
+
let full = [`Id; `BlobId; `ThreadId; `MailboxIds; `Keywords; `Size;
42
+
`ReceivedAt; `From; `To; `Cc; `Bcc; `Subject; `Preview;
43
+
`TextBody; `HtmlBody; `HasAttachment; `Attachments]
44
+
let threading = [`Id; `ThreadId; `Subject; `From; `ReceivedAt]
45
+
end
46
+
47
+
module Sort = struct
48
+
type t = Jmap.Methods.Comparator.t
49
+
50
+
let by_date_desc = Jmap.Methods.Comparator.v ~property:"receivedAt" ~is_ascending:false ()
51
+
let by_date_asc = Jmap.Methods.Comparator.v ~property:"receivedAt" ~is_ascending:true ()
52
+
let by_size_desc = Jmap.Methods.Comparator.v ~property:"size" ~is_ascending:false ()
53
+
let by_from = Jmap.Methods.Comparator.v ~property:"from" ~is_ascending:true ()
54
+
let by_subject = Jmap.Methods.Comparator.v ~property:"subject" ~is_ascending:true ()
55
+
56
+
let custom ~property ~is_ascending =
57
+
Jmap.Methods.Comparator.v ~property ~is_ascending ()
58
+
59
+
let combine sorts = sorts
60
+
end
61
+
62
+
module Filter = struct
63
+
type operator =
64
+
| And of t * t
65
+
| Or of t * t
66
+
| Not of t
67
+
| Condition of string * Yojson.Safe.t
68
+
and t = operator
69
+
70
+
let in_mailbox mailbox_id =
71
+
Condition ("inMailbox", `String mailbox_id)
72
+
73
+
let in_mailbox_role role =
74
+
Condition ("inMailboxOtherThan", `List [`String role])
75
+
76
+
let unread =
77
+
Condition ("hasKeyword", `String "$seen")
78
+
|> fun c -> Not c
79
+
80
+
let flagged =
81
+
Condition ("hasKeyword", `String "$flagged")
82
+
83
+
let has_attachment =
84
+
Condition ("hasAttachment", `Bool true)
85
+
86
+
let from email =
87
+
Condition ("from", `String email)
88
+
89
+
let to_ email =
90
+
Condition ("to", `String email)
91
+
92
+
let subject_contains text =
93
+
Condition ("subject", `String text)
94
+
95
+
let body_contains text =
96
+
Condition ("text", `String text)
97
+
98
+
let after date =
99
+
Condition ("after", `String (Jmap.Date.to_rfc3339 date))
100
+
101
+
let before date =
102
+
Condition ("before", `String (Jmap.Date.to_rfc3339 date))
103
+
104
+
let between start end_ =
105
+
And (after start, before end_)
106
+
107
+
let min_size bytes =
108
+
Condition ("minSize", `Int bytes)
109
+
110
+
let max_size bytes =
111
+
Condition ("maxSize", `Int bytes)
112
+
113
+
let and_ a b = And (a, b)
114
+
let or_ a b = Or (a, b)
115
+
let not_ a = Not a
116
+
117
+
let rec to_json = function
118
+
| And (a, b) ->
119
+
`Assoc [("operator", `String "AND");
120
+
("conditions", `List [to_json a; to_json b])]
121
+
| Or (a, b) ->
122
+
`Assoc [("operator", `String "OR");
123
+
("conditions", `List [to_json a; to_json b])]
124
+
| Not a ->
125
+
`Assoc [("operator", `String "NOT");
126
+
("condition", to_json a)]
127
+
| Condition (field, value) ->
128
+
`Assoc [(field, value)]
129
+
end
130
+
131
+
type query_builder = {
132
+
account_id : string option;
133
+
filter : Filter.t option;
134
+
sort : Sort.t list;
135
+
limit_count : int option;
136
+
position : int option;
137
+
properties : property list;
138
+
collapse_threads : bool;
139
+
}
140
+
141
+
let query () = {
142
+
account_id = None;
143
+
filter = None;
144
+
sort = [Sort.by_date_desc];
145
+
limit_count = None;
146
+
position = None;
147
+
properties = PropertySets.list_view;
148
+
collapse_threads = false;
149
+
}
150
+
151
+
let with_account account_id builder =
152
+
{ builder with account_id = Some account_id }
153
+
154
+
let where filter builder =
155
+
{ builder with filter = Some filter }
156
+
157
+
let order_by sort builder =
158
+
{ builder with sort = [sort] }
159
+
160
+
let limit n builder =
161
+
{ builder with limit_count = Some n }
162
+
163
+
let offset n builder =
164
+
{ builder with position = Some n }
165
+
166
+
let select properties builder =
167
+
{ builder with properties }
168
+
169
+
let select_preset preset builder =
170
+
let properties = match preset with
171
+
| `ListV -> PropertySets.list_view
172
+
| `Preview -> PropertySets.preview
173
+
| `Full -> PropertySets.full
174
+
| `Threading -> PropertySets.threading
175
+
in
176
+
{ builder with properties }
177
+
178
+
let collapse_threads value builder =
179
+
{ builder with collapse_threads = value }
180
+
181
+
type query_result = {
182
+
ids : Jmap.Id.t list;
183
+
total : int option;
184
+
position : int;
185
+
can_calculate_changes : bool;
186
+
}
187
+
188
+
type fetch_result = {
189
+
emails : Jmap_email.t list;
190
+
total : int option;
191
+
}
192
+
193
+
(* Helper to get account_id from session if not specified *)
194
+
let resolve_account_id builder session =
195
+
match builder.account_id with
196
+
| Some id -> id
197
+
| None -> Jmap_unix.Session_utils.get_primary_mail_account session
198
+
199
+
let execute_query ~env ~ctx ~session builder =
200
+
let open Jmap.Protocol.Error in
201
+
try
202
+
let account_id = resolve_account_id builder session in
203
+
204
+
(* Build the request *)
205
+
let req_builder = Jmap_unix.build ctx in
206
+
let req_builder = Jmap_unix.using req_builder [`Core; `Mail] in
207
+
208
+
(* Create query arguments *)
209
+
let query_args =
210
+
let base = Jmap.Methods.Query_args.v ~account_id ~sort:builder.sort () in
211
+
let base = match builder.filter with
212
+
| Some f -> base (* TODO: Add filter support to Query_args *)
213
+
| None -> base
214
+
in
215
+
let base = match builder.limit_count with
216
+
| Some n -> Jmap.Methods.Query_args.v ~account_id ~sort:builder.sort ~limit:n ()
217
+
| None -> base
218
+
in
219
+
base
220
+
in
221
+
222
+
let query_json = Jmap.Methods.Query_args.to_json query_args in
223
+
let req_builder = Jmap_unix.add_method_call req_builder "Email/query" query_json "q1" in
224
+
225
+
(* Execute and parse response *)
226
+
match Jmap_unix.execute env req_builder with
227
+
| Ok response ->
228
+
(match Jmap_unix.Response.extract_method ~method_name:"Email/query" ~method_call_id:"q1" response with
229
+
| Ok json ->
230
+
(match Jmap.Methods.Query_response.of_json json with
231
+
| Ok qr ->
232
+
Ok {
233
+
ids = Jmap.Methods.Query_response.ids qr;
234
+
total = Jmap.Methods.Query_response.total qr;
235
+
position = Jmap.Methods.Query_response.position qr;
236
+
can_calculate_changes = Jmap.Methods.Query_response.can_calculate_changes qr;
237
+
}
238
+
| Error e -> Error (Protocol e))
239
+
| Error e -> Error e)
240
+
| Error e -> Error e
241
+
with exn ->
242
+
Error (Protocol (Printf.sprintf "Query execution failed: %s" (Printexc.to_string exn)))
243
+
244
+
let execute_with_fetch ~env ~ctx ~session builder =
245
+
let open Jmap.Protocol.Error in
246
+
try
247
+
let account_id = resolve_account_id builder session in
248
+
249
+
(* Build the chained request *)
250
+
let req_builder = Jmap_unix.build ctx in
251
+
let req_builder = Jmap_unix.using req_builder [`Core; `Mail] in
252
+
253
+
(* Add Email/query *)
254
+
let query_args =
255
+
let base = Jmap.Methods.Query_args.v ~account_id ~sort:builder.sort () in
256
+
let base = match builder.limit_count with
257
+
| Some n -> Jmap.Methods.Query_args.v ~account_id ~sort:builder.sort ~limit:n ()
258
+
| None -> base
259
+
in
260
+
base
261
+
in
262
+
263
+
let query_json = Jmap.Methods.Query_args.to_json query_args in
264
+
let req_builder = Jmap_unix.add_method_call req_builder "Email/query" query_json "q1" in
265
+
266
+
(* Add Email/get with result reference *)
267
+
let properties = List.map property_to_string builder.properties in
268
+
let get_args = Jmap.Methods.Get_args.v ~account_id ~properties () in
269
+
let (get_args_with_ref, result_ref_json) = Jmap.Methods.Get_args.with_result_reference
270
+
get_args
271
+
~result_of:"q1"
272
+
~name:"Email/query"
273
+
~path:"/ids"
274
+
in
275
+
let get_json = Jmap.Methods.Get_args.to_json ~result_reference_ids:(Some result_ref_json) get_args_with_ref in
276
+
let req_builder = Jmap_unix.add_method_call req_builder "Email/get" get_json "g1" in
277
+
278
+
(* Execute and parse response *)
279
+
match Jmap_unix.execute env req_builder with
280
+
| Ok response ->
281
+
(* Extract query response for total count *)
282
+
let total =
283
+
match Jmap_unix.Response.extract_method ~method_name:"Email/query" ~method_call_id:"q1" response with
284
+
| Ok json ->
285
+
(match Jmap.Methods.Query_response.of_json json with
286
+
| Ok qr -> Jmap.Methods.Query_response.total qr
287
+
| Error _ -> None)
288
+
| Error _ -> None
289
+
in
290
+
291
+
(* Extract email data *)
292
+
(match Jmap_unix.Response.extract_method ~method_name:"Email/get" ~method_call_id:"g1" response with
293
+
| Ok json ->
294
+
let email_from_json j =
295
+
match Jmap_email.of_json j with
296
+
| Ok e -> e
297
+
| Error err -> failwith err
298
+
in
299
+
(match Jmap.Methods.Get_response.of_json ~from_json:email_from_json json with
300
+
| Ok gr ->
301
+
Ok {
302
+
emails = Jmap.Methods.Get_response.list gr;
303
+
total = total;
304
+
}
305
+
| Error e -> Error (Protocol e))
306
+
| Error e -> Error e)
307
+
| Error e -> Error e
308
+
with exn ->
309
+
Error (Protocol (Printf.sprintf "Fetch execution failed: %s" (Printexc.to_string exn)))
310
+
311
+
(* Common query builders *)
312
+
let inbox ?limit () =
313
+
let q = query () |> where (Filter.in_mailbox_role "inbox") in
314
+
match limit with
315
+
| Some n -> limit n q
316
+
| None -> q
317
+
318
+
let unread ?limit () =
319
+
let q = query () |> where Filter.unread in
320
+
match limit with
321
+
| Some n -> limit n q
322
+
| None -> q
323
+
324
+
let recent ?limit () =
325
+
let yesterday = Jmap.Date.of_timestamp (Unix.time () -. 86400.) in
326
+
let q = query () |> where (Filter.after yesterday) in
327
+
match limit with
328
+
| Some n -> limit n q
329
+
| None -> q
330
+
331
+
let from_sender sender ?limit () =
332
+
let q = query () |> where (Filter.from sender) in
333
+
match limit with
334
+
| Some n -> limit n q
335
+
| None -> q
336
+
337
+
let search text ?limit () =
338
+
let q = query () |> where (Filter.or_
339
+
(Filter.subject_contains text)
340
+
(Filter.body_contains text)) in
341
+
match limit with
342
+
| Some n -> limit n q
343
+
| None -> q
344
+
345
+
let flagged ?limit () =
346
+
let q = query () |> where Filter.flagged in
347
+
match limit with
348
+
| Some n -> limit n q
349
+
| None -> q
350
+
351
+
let with_attachments ?limit () =
352
+
let q = query () |> where Filter.has_attachment in
353
+
match limit with
354
+
| Some n -> limit n q
355
+
| None -> q
356
+
357
+
(* Pretty printing *)
358
+
let pp_email ppf email =
359
+
let open Format in
360
+
fprintf ppf "@[<v 2>Email:@,";
361
+
(match Jmap_email.subject email with
362
+
| Some s -> fprintf ppf "Subject: %s@," s
363
+
| None -> ());
364
+
(match Jmap_email.from email with
365
+
| Some addrs when addrs <> [] ->
366
+
let addr = List.hd addrs in
367
+
fprintf ppf "From: %s@," (Jmap_email.Email_address.email addr)
368
+
| _ -> ());
369
+
(match Jmap_email.received_at email with
370
+
| Some ts ->
371
+
let date = Jmap.Date.of_timestamp ts in
372
+
fprintf ppf "Date: %s@," (Jmap.Date.to_rfc3339 date)
373
+
| None -> ());
374
+
fprintf ppf "@]"
375
+
376
+
let pp_email_list ppf emails =
377
+
Format.fprintf ppf "@[<v>%a@]"
378
+
(Format.pp_print_list ~pp_sep:Format.pp_print_cut pp_email) emails
+226
jmap/jmap-email/jmap_email_query.mli
+226
jmap/jmap-email/jmap_email_query.mli
···
1
+
(** High-level Email query interface for JMAP Email.
2
+
3
+
This module provides a fluent, type-safe API for constructing
4
+
and executing Email queries with automatic result chaining.
5
+
6
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.4> RFC 8621 Section 4.4 *)
7
+
8
+
(** {1 Email Properties} *)
9
+
10
+
(** Type-safe email property selectors *)
11
+
type property = [
12
+
| `Id
13
+
| `BlobId
14
+
| `ThreadId
15
+
| `MailboxIds
16
+
| `Keywords
17
+
| `Size
18
+
| `ReceivedAt
19
+
| `MessageId
20
+
| `InReplyTo
21
+
| `References
22
+
| `Sender
23
+
| `From
24
+
| `To
25
+
| `Cc
26
+
| `Bcc
27
+
| `ReplyTo
28
+
| `Subject
29
+
| `SentAt
30
+
| `HasAttachment
31
+
| `Preview
32
+
| `BodyStructure
33
+
| `BodyValues
34
+
| `TextBody
35
+
| `HtmlBody
36
+
| `Attachments
37
+
]
38
+
39
+
(** Convert property to its string representation *)
40
+
val property_to_string : property -> string
41
+
42
+
(** Standard property sets for common use cases *)
43
+
module PropertySets : sig
44
+
(** Minimal properties for list views *)
45
+
val list_view : property list
46
+
47
+
(** Properties for email preview *)
48
+
val preview : property list
49
+
50
+
(** Properties for full email display *)
51
+
val full : property list
52
+
53
+
(** Properties for threading *)
54
+
val threading : property list
55
+
end
56
+
57
+
(** {1 Sort Options} *)
58
+
59
+
(** Common sort configurations *)
60
+
module Sort : sig
61
+
type t
62
+
63
+
(** Sort by received date, newest first *)
64
+
val by_date_desc : t
65
+
66
+
(** Sort by received date, oldest first *)
67
+
val by_date_asc : t
68
+
69
+
(** Sort by size, largest first *)
70
+
val by_size_desc : t
71
+
72
+
(** Sort by sender name *)
73
+
val by_from : t
74
+
75
+
(** Sort by subject *)
76
+
val by_subject : t
77
+
78
+
(** Create custom sort *)
79
+
val custom : property:string -> is_ascending:bool -> t
80
+
81
+
(** Combine multiple sort criteria *)
82
+
val combine : t list -> t list
83
+
end
84
+
85
+
(** {1 Query Filters} *)
86
+
87
+
(** Email filter conditions *)
88
+
module Filter : sig
89
+
type t
90
+
91
+
(** Filter by mailbox *)
92
+
val in_mailbox : string -> t
93
+
94
+
(** Filter by mailbox role (e.g., "inbox", "sent", "drafts") *)
95
+
val in_mailbox_role : string -> t
96
+
97
+
(** Filter for unread emails *)
98
+
val unread : t
99
+
100
+
(** Filter for flagged/starred emails *)
101
+
val flagged : t
102
+
103
+
(** Filter for emails with attachments *)
104
+
val has_attachment : t
105
+
106
+
(** Filter by sender *)
107
+
val from : string -> t
108
+
109
+
(** Filter by recipient (to, cc, or bcc) *)
110
+
val to_ : string -> t
111
+
112
+
(** Filter by subject containing text *)
113
+
val subject_contains : string -> t
114
+
115
+
(** Filter by body text *)
116
+
val body_contains : string -> t
117
+
118
+
(** Filter by date range *)
119
+
val after : Jmap.Date.t -> t
120
+
val before : Jmap.Date.t -> t
121
+
val between : Jmap.Date.t -> Jmap.Date.t -> t
122
+
123
+
(** Filter by size *)
124
+
val min_size : int -> t
125
+
val max_size : int -> t
126
+
127
+
(** Combine filters *)
128
+
val and_ : t -> t -> t
129
+
val or_ : t -> t -> t
130
+
val not_ : t -> t
131
+
end
132
+
133
+
(** {1 Query Builder} *)
134
+
135
+
(** Fluent query builder *)
136
+
type query_builder
137
+
138
+
(** Create a new query builder *)
139
+
val query : unit -> query_builder
140
+
141
+
(** Set the account ID (uses primary mail account if not set) *)
142
+
val with_account : string -> query_builder -> query_builder
143
+
144
+
(** Add a filter condition *)
145
+
val where : Filter.t -> query_builder -> query_builder
146
+
147
+
(** Set sort order *)
148
+
val order_by : Sort.t -> query_builder -> query_builder
149
+
150
+
(** Limit the number of results *)
151
+
val limit : int -> query_builder -> query_builder
152
+
153
+
(** Set position/offset for pagination *)
154
+
val offset : int -> query_builder -> query_builder
155
+
156
+
(** Select which properties to fetch *)
157
+
val select : property list -> query_builder -> query_builder
158
+
159
+
(** Use a predefined property set *)
160
+
val select_preset : [`ListV | `Preview | `Full | `Threading] -> query_builder -> query_builder
161
+
162
+
(** Enable thread collapsing *)
163
+
val collapse_threads : bool -> query_builder -> query_builder
164
+
165
+
(** {1 Execution} *)
166
+
167
+
(** Query result containing email IDs *)
168
+
type query_result = {
169
+
ids : Jmap.Id.t list;
170
+
total : int option;
171
+
position : int;
172
+
can_calculate_changes : bool;
173
+
}
174
+
175
+
(** Execute just the query (returns IDs only) *)
176
+
val execute_query :
177
+
env:Eio_unix.Stdenv.base ->
178
+
ctx:Jmap_unix.context ->
179
+
session:Jmap.Protocol.Session.Session.t ->
180
+
query_builder ->
181
+
(query_result, Jmap.Protocol.Error.error) result
182
+
183
+
(** Query result with full email data *)
184
+
type fetch_result = {
185
+
emails : Jmap_email.t list;
186
+
total : int option;
187
+
}
188
+
189
+
(** Execute query and automatically fetch email data *)
190
+
val execute_with_fetch :
191
+
env:Eio_unix.Stdenv.base ->
192
+
ctx:Jmap_unix.context ->
193
+
session:Jmap.Protocol.Session.Session.t ->
194
+
query_builder ->
195
+
(fetch_result, Jmap.Protocol.Error.error) result
196
+
197
+
(** {1 Common Queries} *)
198
+
199
+
(** Inbox emails, newest first *)
200
+
val inbox : ?limit:int -> unit -> query_builder
201
+
202
+
(** Unread emails across all mailboxes *)
203
+
val unread : ?limit:int -> unit -> query_builder
204
+
205
+
(** Recent emails (last 24 hours) *)
206
+
val recent : ?limit:int -> unit -> query_builder
207
+
208
+
(** Emails from a specific sender *)
209
+
val from_sender : string -> ?limit:int -> unit -> query_builder
210
+
211
+
(** Search emails by text across subject and body *)
212
+
val search : string -> ?limit:int -> unit -> query_builder
213
+
214
+
(** Flagged/starred emails *)
215
+
val flagged : ?limit:int -> unit -> query_builder
216
+
217
+
(** Emails with attachments *)
218
+
val with_attachments : ?limit:int -> unit -> query_builder
219
+
220
+
(** {1 Pretty Printing} *)
221
+
222
+
(** Pretty-print an email for display *)
223
+
val pp_email : Format.formatter -> Jmap_email.t -> unit
224
+
225
+
(** Pretty-print a list of emails as a summary *)
226
+
val pp_email_list : Format.formatter -> Jmap_email.t list -> unit
+2
jmap/jmap-unix/jmap_unix.ml
+2
jmap/jmap-unix/jmap_unix.ml
···
279
279
("methodCalls", `List method_calls_json);
280
280
] in
281
281
let request_body = Yojson.Safe.to_string request_json in
282
+
let pretty_request = Yojson.Safe.pretty_to_string request_json in
283
+
Format.printf "DEBUG: Sending JMAP request:\n%s\n%!" pretty_request;
282
284
283
285
let headers = [] in
284
286
(match http_request env builder.ctx ~meth:`POST ~uri:api_uri ~headers ~body:(Some request_body) with
+5
jmap/jmap/jmap_date.ml
+5
jmap/jmap/jmap_date.ml
···
102
102
103
103
let is_after date1 date2 = date1 > date2
104
104
105
+
let pp ppf date = Fmt.string ppf (to_rfc3339 date)
106
+
107
+
let pp_debug ppf date =
108
+
Fmt.pf ppf "Date(%s)" (to_rfc3339 date)
109
+
105
110
let to_string_debug date =
106
111
Printf.sprintf "Date(%s)" (to_rfc3339 date)
107
112
+10
jmap/jmap/jmap_date.mli
+10
jmap/jmap/jmap_date.mli
···
88
88
@return True if date1 is after date2. *)
89
89
val is_after : t -> t -> bool
90
90
91
+
(** Pretty-print a Date in RFC3339 format.
92
+
@param ppf The formatter.
93
+
@param date The Date to print. *)
94
+
val pp : Format.formatter -> t -> unit
95
+
96
+
(** Pretty-print a Date for debugging.
97
+
@param ppf The formatter.
98
+
@param date The Date to format. *)
99
+
val pp_debug : Format.formatter -> t -> unit
100
+
91
101
(** Convert a Date to a human-readable string for debugging.
92
102
@param date The Date to format.
93
103
@return A debug string representation. *)
+2
jmap/jmap/jmap_error.ml
+2
jmap/jmap/jmap_error.ml
+5
jmap/jmap/jmap_error.mli
+5
jmap/jmap/jmap_error.mli
···
321
321
(** Get a human-readable description of an error *)
322
322
val error_to_string : error -> string
323
323
324
+
(** Pretty-print an error.
325
+
@param ppf The formatter.
326
+
@param error The error to print. *)
327
+
val pp : Format.formatter -> error -> unit
328
+
324
329
(** {2 Result Handling} *)
325
330
326
331
(** Map an error with additional context *)
+4
jmap/jmap/jmap_id.ml
+4
jmap/jmap/jmap_id.ml
···
28
28
29
29
let to_string id = id
30
30
31
+
let pp ppf id = Fmt.string ppf id
32
+
31
33
let validate id =
32
34
if is_valid_string id then Ok ()
33
35
else Error "Invalid Id format"
···
35
37
let equal = String.equal
36
38
37
39
let compare = String.compare
40
+
41
+
let pp_debug ppf id = Fmt.pf ppf "Id(%s)" id
38
42
39
43
let to_string_debug id = Printf.sprintf "Id(%s)" id
40
44
+10
jmap/jmap/jmap_id.mli
+10
jmap/jmap/jmap_id.mli
···
38
38
@return The string representation. *)
39
39
val to_string : t -> string
40
40
41
+
(** Pretty-print an Id.
42
+
@param ppf The formatter.
43
+
@param id The Id to print. *)
44
+
val pp : Format.formatter -> t -> unit
45
+
41
46
(** {1 Validation} *)
42
47
43
48
(** Check if a string is a valid JMAP Id.
···
63
68
@param id2 Second Id.
64
69
@return Negative if id1 < id2, zero if equal, positive if id1 > id2. *)
65
70
val compare : t -> t -> int
71
+
72
+
(** Pretty-print an Id for debugging.
73
+
@param ppf The formatter.
74
+
@param id The Id to format. *)
75
+
val pp_debug : Format.formatter -> t -> unit
66
76
67
77
(** Convert an Id to a human-readable string for debugging.
68
78
@param id The Id to format.
+2
jmap/jmap/jmap_protocol.ml
+2
jmap/jmap/jmap_protocol.ml
···
30
30
| `Submission -> "urn:ietf:params:jmap:submission"
31
31
| `VacationResponse -> "urn:ietf:params:jmap:vacationresponse"
32
32
33
+
let pp ppf capability = Fmt.string ppf (to_string capability)
34
+
33
35
let of_string = function
34
36
| "urn:ietf:params:jmap:core" -> Some `Core
35
37
| "urn:ietf:params:jmap:mail" -> Some `Mail
+5
jmap/jmap/jmap_protocol.mli
+5
jmap/jmap/jmap_protocol.mli
···
93
93
@return The corresponding URN string *)
94
94
val to_string : t -> string
95
95
96
+
(** Pretty-print a capability.
97
+
@param ppf The formatter.
98
+
@param capability The capability to print. *)
99
+
val pp : Format.formatter -> t -> unit
100
+
96
101
(** Parse URN string to capability variant.
97
102
@param urn The URN string to parse
98
103
@return Some capability if recognized, None otherwise *)
+4
jmap/jmap/jmap_uint.ml
+4
jmap/jmap/jmap_uint.ml
···
24
24
25
25
let to_string uint = string_of_int uint
26
26
27
+
let pp ppf uint = Fmt.int ppf uint
28
+
27
29
(* Constants *)
28
30
let zero = 0
29
31
let one = 1
···
60
62
let min uint1 uint2 = if uint1 <= uint2 then uint1 else uint2
61
63
62
64
let max uint1 uint2 = if uint1 >= uint2 then uint1 else uint2
65
+
66
+
let pp_debug ppf uint = Fmt.pf ppf "UInt(%d)" uint
63
67
64
68
let to_string_debug uint = Printf.sprintf "UInt(%d)" uint
65
69
+10
jmap/jmap/jmap_uint.mli
+10
jmap/jmap/jmap_uint.mli
···
49
49
@return The string representation. *)
50
50
val to_string : t -> string
51
51
52
+
(** Pretty-print an UnsignedInt.
53
+
@param ppf The formatter.
54
+
@param uint The UnsignedInt to print. *)
55
+
val pp : Format.formatter -> t -> unit
56
+
52
57
(** {1 Constants} *)
53
58
54
59
(** Zero value. *)
···
117
122
@param uint2 Second UnsignedInt.
118
123
@return The larger value. *)
119
124
val max : t -> t -> t
125
+
126
+
(** Pretty-print an UnsignedInt for debugging.
127
+
@param ppf The formatter.
128
+
@param uint The UnsignedInt to format. *)
129
+
val pp_debug : Format.formatter -> t -> unit
120
130
121
131
(** Convert an UnsignedInt to a human-readable string for debugging.
122
132
@param uint The UnsignedInt to format.