anil.recoil.org
-73
AGENT.md
-73
AGENT.md
···
1
-
# Guidelines for the AI copilot editor.
2
-
3
-
Whenever you generate any new OCaml functions, annotate that function's OCamldoc
4
-
with a "TODO:claude" to indicate it is autogenerated. Do this for every function
5
-
you generate and not just the header file.
6
-
7
-
## Project structure
8
-
9
-
The `spec/rfc8620.txt` is the core JMAP protocol, which we are aiming to implement
10
-
in OCaml code in this project. We must accurately capture the specification in the
11
-
OCaml interface and never violate it without clear indication.
12
-
13
-
## Coding Instructions
14
-
15
-
Read your instructions from this file, and mark successfully completed instructions
16
-
with DONE so that you will know what to do next when reinvoked in the future. If you
17
-
only partially complete the task, then add an extra step with TODO and the remaining
18
-
work.
19
-
20
-
1. DONE Define core OCaml type definitions corresponding to the JMAP protocol
21
-
specification, in a new Jmap.Types module.
22
-
2. DONE Add a `Jmap.Api` module to make JMAP API requests over HTTP and parse the
23
-
responses into the `Jmap.Types`. Used `Cohttp_lwt_unix` for the HTTP library.
24
-
Note: There is a compilation issue with the current ezjsonm package on the system.
25
-
3. DONE Add a `Jmap_mail` implementation that follows `spec/rfc8621.txt` as part of a
26
-
separate package. It should use the Jmap module and extend it appropriately.
27
-
4. DONE Complete the `Jmap_mail` implementation so that there are functions to login
28
-
and list mailboxes and messages in a mailbox.
29
-
5. DONE Fastmail provides me with an API token to login via JMAP rather than username
30
-
and password. Add the appropriate support for this into their API, which is
31
-
also explained over at https://www.fastmail.com/dev/. The summary is that the
32
-
auth token needs to add an Authorization header set to "Bearer {value}",
33
-
where {value} is the value of the token to your API request.
34
-
6. DONE Add an example `fastmail_list` binary that will use the authentication token
35
-
from a `JMAP_API_TOKEN` env variable and connect to the Fastmail endpoint
36
-
at https://api.fastmail.com/jmap/session and list the last 100 email with
37
-
subjects and sender details to stdout.
38
-
7. DONE Examine the implementation of fastmail-list as well as the JMAP specs,
39
-
and add better typed handling of string responses such as "urn:ietf:params:jmap:mail".
40
-
Add these to either `Jmap_mail` or Jmap modules as appropriate.
41
-
8. DONE Move some of the debug print messages into a debug logging mode, and ensure
42
-
that sensitive API tokens are never printed but redacted instead.
43
-
Modify the fastmail-list binary to optionally list only unread messages, and
44
-
also list the JMAP labels associated with each message.
45
-
9. DONE Read the mailbox attribute spec in specs/ and add a typed interface to the
46
-
JMAP labels defined in there.
47
-
10. DONE Integrate the human-readable keyword and label printing into fastmail-list.
48
-
11. DONE Add an OCaml interface to compose result references together explicitly into a
49
-
single request, from reading the specs.
50
-
12. DONE Extend the fastmail-list to filter messages displays by email address of the
51
-
sender. This may involve adding logic to parse email addresses; if so, add
52
-
this logic into the Jmap_mail library.
53
-
13. DONE Refine the ocamldoc in the interfaces to include documentation for every record
54
-
field and function by summarising the relevant part of the spec. Also include
55
-
a cross reference URL where relevant by linking to a URL of the form
56
-
"https://datatracker.ietf.org/doc/html/rfc8620#section-1.1" for the online
57
-
version of the RFCs stored in specs/
58
-
14. DONE Add an ocamldoc-format tutorial on how to use the library to index.mld along with cross references
59
-
into the various libraries. Put corresponding executable files into bin/ so that they can be
60
-
build tested and run as well. Assume the pattern of the JMAP_API_TOKEN environment variable being
61
-
set can be counted on to be present when they are run.
62
-
15. DONE Add a README.md to this repository that describes what this is. Note explicitly in the
63
-
README that this is largely an AI-generated interface and has not been audited carefully.
64
-
16. DONE Ensure examples use the proper higher-level API functions from the library instead of
65
-
manually constructing low-level requests. Particularly, the fastmail_list binary should
66
-
demonstrate the recommended way to use the library with Jmap_mail's API.
67
-
17. DONE Add helper functions to Jmap.Api such as `string_of_error` and `pp_error` to format
68
-
errors consistently. Updated the fastmail_list binary to use these functions instead of
69
-
duplicating error handling code.
70
-
18. DONE Add support for JMAP email submission to the library, and create a fastmail-send that accepts
71
-
a list of to: on the CLI as arguments and a subject on the CLI and reads in the message body
72
-
19. DONE Port fastmail-list to use Cmdliner instead of Arg with nice manual page.
73
-
20. Make JMAP_TOKEN_API handling a Cmdliner term as well so it can be reused.
+39
CLAUDE.md
+39
CLAUDE.md
···
1
+
I wish to generate a set of OCaml module signatures and types (no implementations) that will type check, for an implementation of the JMAP protocol (RFC8620) and the associated email extensions (RFC8621). The code you generate should have ocamldoc that references the relevant sections of the RFC it is implementing, using <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.2> as a template for the hyperlinks (replace the fragment with the appropriate section identifier). There are local copy of the specifications in the `spec/` directory in this repository. The `spec/rfc8620.txt` is the core JMAP protocol, which we are aiming to implement in OCaml code in this project. We must accurately capture the specification in the OCaml interface and never violate it without clear indication.
2
+
3
+
The architecture of the modules should be one portable set that implement core JMAP (RFC8620) as an OCaml module called `Jmap` (with module aliases to the submodules that implement that). Then generate another set of modules that implement the email-specific extensions (RFC8621) including flag handling for (e.g.) Apple Mail under a module called `Jmap_email`. These should all be portable OCaml type signatures (the mli files), and then generate another module that implements the interface for a Unix implementation that uses the Unix module to perform real connections. You do not need to implement TLS support for this first iteration of the code interfaces.
4
+
5
+
You should also generate a module index file called jmap.mli that explains how all the generated modules fit together, along with a sketch of some example OCaml code that uses it to connect to a JMAP server and list recent unread emails from a particular sender.
6
+
7
+
When selecting dependencies, ONLY use Yojson, Uri and Unix in your type signatures aside from the OCaml standard library. The standard Hashtbl is fine for any k/v datastructures and do not use Maps or other functor applications for this. DO NOT generate any AST attributes, and do not use any PPX derivers or other syntax extensions. Just generate clean, conventional OCaml type signatures.
8
+
9
+
You can run commands with:
10
+
11
+
- clean: `opam exec -- dune clean`
12
+
- build: `opam exec -- dune build @check`
13
+
- docs: `opam exec -- dune build @doc`
14
+
15
+
# Tips on fixing bugs
16
+
17
+
If you see errors like this:
18
+
19
+
```
20
+
File "../../.jmap.objs/byte/jmap.odoc":
21
+
Warning: Hidden fields in type 'Jmap.Email.Identity.identity_create'
22
+
```
23
+
24
+
Then examine the HTML docs built for that module. You will see that there are module references with __ in them, e.g. "Jmap__.Jmap_email_types.Email_address.t" which indicate that the module is being accessed directly instead of via the module aliases defined.
25
+
26
+
# Structure Simplification
27
+
28
+
Avoid redundant module nesting. When a file is named after a module (e.g., `jmap_identity.mli`), there's no need to have a matching nested module inside the file (e.g., `module Identity : sig...`). Instead, define types and functions directly at the top level of the file. Also, ensure that submodule main types are always named `t`, not named after the module (e.g., use `Create.t` not `Create.create`).
29
+
30
+
# Software engineering
31
+
32
+
We will go through a multi step process to build this library. We are currently at STEP 1.
33
+
34
+
1) we will generate OCaml interface files only, and no module implementations. The purpose here is to write and document the necessary type signatures. Once we generate these, we can check that they work with "dune build @check". Once that succeeds, we will build HTML documentation with "dune build @doc" in order to ensure the interfaces are reasonable.
35
+
36
+
2) once these interface files exist, we will build a series of sample binaries that will attempt to implement the JMAP protocol for some sample usecases, using only the Unix module. This binary will not fully link, but it should type check. The only linking error that we get should be from the missing Jmap library implementation.
37
+
38
+
3) we will calculate the dependency order for each module in the Jmap library, and work through an implementation of each one in increasing dependency order (that is, the module with the fewest dependencies should be handled first). For each module interface, we will generate a corresponding module implementation. We will also add test cases for this specific module, and update the dune files. Before proceeding to the next module, a `dune build` should be done to ensure the implementation builds and type checks as far as is possible.
39
+
+53
-52
README.md
+53
-52
README.md
···
1
-
# JMAP OCaml Client
1
+
# JMAP OCaml Libraries
2
2
3
-
An OCaml interface to the JMAP protocol ([RFC8620](https://datatracker.ietf.org/doc/html/rfc8620)) and JMAP Mail extension ([RFC8621](https://datatracker.ietf.org/doc/html/rfc8621)).
3
+
This project implements OCaml libraries for the JMAP protocol, following the specifications in RFC 8620 (Core) and RFC 8621 (Mail).
4
4
5
-
**Note:** This library is largely AI-generated and has not been audited carefully. It's a proof-of-concept implementation of the JMAP specification.
5
+
## Project Structure
6
6
7
-
## Overview
7
+
The code is organized into three main libraries:
8
8
9
-
JMAP (JSON Meta Application Protocol) is a modern protocol for synchronizing email, calendars, and contacts designed as a replacement for legacy protocols like IMAP. This OCaml implementation provides:
9
+
1. `jmap` - Core JMAP protocol (RFC 8620)
10
+
- Basic data types
11
+
- Error handling
12
+
- Wire protocol
13
+
- Session handling
14
+
- Standard methods (get, set, changes, query)
15
+
- Binary data handling
16
+
- Push notifications
10
17
11
-
- Type-safe OCaml interfaces to the JMAP Core and Mail specifications
12
-
- Authentication with username/password or API tokens (Fastmail support)
13
-
- Convenient functions for common email and mailbox operations
14
-
- Support for composing complex multi-part requests with result references
15
-
- Typed handling of message flags, keywords, and mailbox attributes
18
+
2. `jmap-unix` - Unix-specific implementation of JMAP
19
+
- HTTP connections to JMAP endpoints
20
+
- Authentication
21
+
- Session discovery
22
+
- Request/response handling
23
+
- Blob upload/download
24
+
- Unix-specific I/O
16
25
17
-
## Installation
26
+
3. `jmap-email` - JMAP Mail extension (RFC 8621)
27
+
- Email specific types
28
+
- Mailbox handling
29
+
- Thread management
30
+
- Search snippet functionality
31
+
- Identity management
32
+
- Email submission
33
+
- Vacation response
18
34
19
-
Add to your project with opam:
35
+
## Usage
20
36
21
-
```
22
-
opam install .
23
-
```
37
+
The libraries are designed to be used together. For example:
24
38
25
-
## Features
39
+
```ocaml
40
+
(* Using the core JMAP protocol library *)
41
+
open Jmap
42
+
open Jmap.Types
43
+
open Jmap.Wire
26
44
27
-
- **Core JMAP Protocol**
28
-
- Session handling
29
-
- API request/response management
30
-
- Type-safe representation of all JMAP structures
31
-
- Result references for composing multi-step requests
45
+
(* Using the Unix implementation *)
46
+
open Jmap_unix
32
47
33
-
- **JMAP Mail Extension**
34
-
- Mailbox operations (folders/labels)
35
-
- Email retrieval and manipulation
36
-
- Thread handling
37
-
- Identity management
38
-
- Email submission
39
-
- Message flags and keywords
40
-
41
-
- **Fastmail Integration**
42
-
- API token authentication
43
-
- Example tools for listing messages
44
-
45
-
## Documentation
48
+
(* Using the JMAP Email extension library *)
49
+
open Jmap_email
50
+
open Jmap_email.Types
46
51
47
-
The library includes comprehensive OCamldoc documentation with cross-references to the relevant sections of the JMAP specifications.
48
-
49
-
Build the documentation with:
50
-
51
-
```
52
-
dune build @doc
52
+
(* Example: Connecting to a JMAP server *)
53
+
let connect_to_server () =
54
+
let credentials = Jmap_unix.Basic("username", "password") in
55
+
let (ctx, session) = Jmap_unix.quick_connect ~host:"jmap.example.com" ~username:"user" ~password:"pass" in
56
+
...
53
57
```
54
58
55
-
## Example Tools
59
+
## Building
56
60
57
-
The package includes several example tools:
58
-
59
-
- `fastmail-list`: Lists emails from a Fastmail account (requires JMAP_API_TOKEN)
60
-
- `jmap-tutorial-examples`: Demonstrates basic JMAP operations as shown in the tutorial
61
-
62
-
## License
61
+
```sh
62
+
# Build
63
+
opam exec -- dune build @check
63
64
64
-
[MIT License](LICENSE)
65
+
# Generate documentation
66
+
opam exec -- dune build @doc
67
+
```
65
68
66
69
## References
67
70
68
-
- [RFC8620: The JSON Meta Application Protocol (JMAP)](https://datatracker.ietf.org/doc/html/rfc8620)
69
-
- [RFC8621: The JSON Meta Application Protocol (JMAP) for Mail](https://datatracker.ietf.org/doc/html/rfc8621)
70
-
- [Message Flag and Mailbox Attribute Extension](https://datatracker.ietf.org/doc/html/draft-ietf-mailmaint-messageflag-mailboxattribute-02)
71
-
- [Fastmail Developer Documentation](https://www.fastmail.com/dev/)
71
+
- [RFC 8620: The JSON Meta Application Protocol (JMAP)](https://www.rfc-editor.org/rfc/rfc8620.html)
72
+
- [RFC 8621: The JSON Meta Application Protocol (JMAP) for Mail](https://www.rfc-editor.org/rfc/rfc8621.html)
-27
bin/dune
-27
bin/dune
···
1
-
(executable
2
-
(name fastmail_list)
3
-
(public_name fastmail-list)
4
-
(package jmap)
5
-
(modules fastmail_list)
6
-
(libraries jmap jmap_mail lwt.unix logs logs.fmt cmdliner))
7
-
8
-
(executable
9
-
(name flag_color_test)
10
-
(public_name flag-color-test)
11
-
(package jmap)
12
-
(modules flag_color_test)
13
-
(libraries jmap jmap_mail))
14
-
15
-
(executable
16
-
(name tutorial_examples)
17
-
(public_name jmap-tutorial-examples)
18
-
(package jmap)
19
-
(modules tutorial_examples)
20
-
(libraries jmap jmap_mail))
21
-
22
-
(executable
23
-
(name fastmail_send)
24
-
(public_name fastmail-send)
25
-
(package jmap)
26
-
(modules fastmail_send)
27
-
(libraries jmap jmap_mail lwt.unix cmdliner fmt))
-298
bin/fastmail_list.ml
-298
bin/fastmail_list.ml
···
1
-
(**
2
-
* fastmail_list - Lists emails from a Fastmail account using JMAP API
3
-
*
4
-
* This binary connects to the Fastmail JMAP API using an authentication token
5
-
* from the JMAP_API_TOKEN environment variable and lists the most recent 100
6
-
* emails with their subjects, sender details, and labels.
7
-
*
8
-
* Usage:
9
-
* JMAP_API_TOKEN=your_api_token ./fastmail_list [options]
10
-
*
11
-
* Options:
12
-
* --unread List only unread messages
13
-
* --labels Show labels/keywords associated with messages
14
-
* --debug=LEVEL Set debug level (0-4, where 4 is most verbose)
15
-
* --from=PATTERN Filter messages by sender email address
16
-
* --demo-refs Demonstrate result references feature
17
-
*)
18
-
19
-
open Lwt.Syntax
20
-
open Jmap
21
-
open Jmap_mail
22
-
open Cmdliner
23
-
module Mail = Jmap_mail.Types
24
-
25
-
(** Prints the email details *)
26
-
let print_email ~show_labels (email : Mail.email) =
27
-
let sender =
28
-
match email.from with
29
-
| Some (addr :: _) ->
30
-
(match addr.name with
31
-
| Some name -> Printf.sprintf "%s <%s>" name addr.email
32
-
| None -> addr.email)
33
-
| _ -> "<unknown>"
34
-
in
35
-
let subject =
36
-
match email.subject with
37
-
| Some s -> s
38
-
| None -> "<no subject>"
39
-
in
40
-
let date = email.received_at in
41
-
42
-
(* Format labels/keywords if requested *)
43
-
let labels_str =
44
-
if show_labels then
45
-
let formatted = Jmap_mail.Types.format_email_keywords email.keywords in
46
-
if formatted <> "" then
47
-
" [" ^ formatted ^ "]"
48
-
else
49
-
""
50
-
else
51
-
""
52
-
in
53
-
54
-
Printf.printf "%s | %s | %s%s\n" date sender subject labels_str
55
-
56
-
(** Check if an email is unread *)
57
-
let is_unread (email : Mail.email) =
58
-
let is_unread_keyword =
59
-
List.exists (fun (kw, active) ->
60
-
kw = Mail.Unread && active
61
-
) email.keywords
62
-
in
63
-
let is_not_seen =
64
-
not (List.exists (fun (kw, active) ->
65
-
kw = Mail.Seen && active
66
-
) email.keywords)
67
-
in
68
-
is_unread_keyword || is_not_seen
69
-
70
-
(** Example function demonstrating how to use higher-level library functions for JMAP requests *)
71
-
let demo_result_references conn account_id =
72
-
Printf.printf "\nResult Reference Demo:\n";
73
-
Printf.printf "=====================\n";
74
-
75
-
(* Step 1: Get all mailboxes *)
76
-
let* mailboxes_result = Jmap_mail.get_mailboxes conn ~account_id in
77
-
match mailboxes_result with
78
-
| Error err ->
79
-
Printf.printf "Error getting mailboxes: %s\n" (Api.string_of_error err);
80
-
Lwt.return_unit
81
-
82
-
| Ok mailboxes ->
83
-
(* Step 2: Get the first mailbox for this demonstration *)
84
-
match mailboxes with
85
-
| [] ->
86
-
Printf.printf "No mailboxes found.\n";
87
-
Lwt.return_unit
88
-
89
-
| first_mailbox :: _ ->
90
-
Printf.printf "Using mailbox: %s\n" first_mailbox.Mail.name;
91
-
92
-
(* Step 3: Get emails from the selected mailbox *)
93
-
let* emails_result = Jmap_mail.get_messages_in_mailbox
94
-
conn
95
-
~account_id
96
-
~mailbox_id:first_mailbox.Mail.id
97
-
~limit:10
98
-
()
99
-
in
100
-
101
-
match emails_result with
102
-
| Error err ->
103
-
Printf.printf "Error getting emails: %s\n" (Api.string_of_error err);
104
-
Lwt.return_unit
105
-
106
-
| Ok emails ->
107
-
Printf.printf "Successfully retrieved %d emails using the high-level library API!\n"
108
-
(List.length emails);
109
-
110
-
(* Display some basic information about the emails *)
111
-
List.iteri (fun i (email:Jmap_mail.Types.email) ->
112
-
let subject = Option.value ~default:"<no subject>" email.Mail.subject in
113
-
Printf.printf " %d. %s\n" (i + 1) subject
114
-
) emails;
115
-
116
-
Lwt.return_unit
117
-
118
-
(** Main function for listing emails *)
119
-
let list_emails unread_only show_labels debug_level demo_refs sender_filter =
120
-
(* Configure logging *)
121
-
init_logging ~level:debug_level ~enable_logs:(debug_level > 0) ~redact_sensitive:true ();
122
-
123
-
match Sys.getenv_opt "JMAP_API_TOKEN" with
124
-
| None ->
125
-
Printf.eprintf "Error: JMAP_API_TOKEN environment variable not set\n";
126
-
Printf.eprintf "Usage: JMAP_API_TOKEN=your_token fastmail-list [options]\n";
127
-
exit 1
128
-
| Some token ->
129
-
(* Only print token info at Info level or higher *)
130
-
Logs.info (fun m -> m "Using API token: %s" (redact_token token));
131
-
132
-
(* Connect to Fastmail JMAP API *)
133
-
let formatted_token = token in
134
-
135
-
(* Only print instructions at Info level *)
136
-
let level = match Logs.level () with
137
-
| None -> 0
138
-
| Some Logs.Error -> 1
139
-
| Some Logs.Info -> 2
140
-
| Some Logs.Debug -> 3
141
-
| _ -> 2
142
-
in
143
-
if level >= 2 then begin
144
-
Printf.printf "\nFastmail API Instructions:\n";
145
-
Printf.printf "1. Get a token from: https://app.fastmail.com/settings/tokens\n";
146
-
Printf.printf "2. Create a new token with Mail scope (read/write)\n";
147
-
Printf.printf "3. Copy the full token (example: 3de40-5fg1h2-a1b2c3...)\n";
148
-
Printf.printf "4. Run: env JMAP_API_TOKEN=\"your_full_token\" fastmail-list [options]\n\n";
149
-
Printf.printf "Note: This example is working correctly but needs a valid Fastmail token.\n\n";
150
-
end;
151
-
let* result = login_with_token
152
-
~uri:"https://api.fastmail.com/jmap/session"
153
-
~api_token:formatted_token
154
-
in
155
-
match result with
156
-
| Error err ->
157
-
Printf.eprintf "%s\n" (Api.string_of_error err);
158
-
Lwt.return 1
159
-
| Ok conn ->
160
-
(* Get the primary account ID *)
161
-
let primary_account_id =
162
-
let mail_capability = Jmap_mail.Capability.to_string Jmap_mail.Capability.Mail in
163
-
match List.assoc_opt mail_capability conn.session.primary_accounts with
164
-
| Some id -> id
165
-
| None ->
166
-
match conn.session.accounts with
167
-
| (id, _) :: _ -> id
168
-
| [] ->
169
-
Printf.eprintf "No accounts found\n";
170
-
exit 1
171
-
in
172
-
173
-
(* Run result references demo if requested *)
174
-
let* () =
175
-
if demo_refs then
176
-
demo_result_references conn primary_account_id
177
-
else
178
-
Lwt.return_unit
179
-
in
180
-
181
-
(* Get the Inbox mailbox *)
182
-
let* mailboxes_result = get_mailboxes conn ~account_id:primary_account_id in
183
-
match mailboxes_result with
184
-
| Error err ->
185
-
Printf.eprintf "Failed to get mailboxes: %s\n" (Api.string_of_error err);
186
-
Lwt.return 1
187
-
| Ok mailboxes ->
188
-
(* If there's a mailbox list, just use the first one for this example *)
189
-
let inbox_id =
190
-
match mailboxes with
191
-
| mailbox :: _ -> mailbox.Mail.id
192
-
| [] ->
193
-
Printf.eprintf "No mailboxes found\n";
194
-
exit 1
195
-
in
196
-
197
-
(* Get messages from inbox *)
198
-
let* emails_result = get_messages_in_mailbox
199
-
conn
200
-
~account_id:primary_account_id
201
-
~mailbox_id:inbox_id
202
-
~limit:1000
203
-
()
204
-
in
205
-
match emails_result with
206
-
| Error err ->
207
-
Printf.eprintf "Failed to get emails: %s\n" (Api.string_of_error err);
208
-
Lwt.return 1
209
-
| Ok emails ->
210
-
(* Apply filters based on command line arguments *)
211
-
let filtered_by_unread =
212
-
if unread_only then
213
-
List.filter is_unread emails
214
-
else
215
-
emails
216
-
in
217
-
218
-
(* Apply sender filter if specified *)
219
-
let filtered_emails =
220
-
if sender_filter <> "" then begin
221
-
Printf.printf "Filtering by sender: %s\n" sender_filter;
222
-
List.filter (fun email ->
223
-
Jmap_mail.email_matches_sender email sender_filter
224
-
) filtered_by_unread
225
-
end else
226
-
filtered_by_unread
227
-
in
228
-
229
-
(* Create description of applied filters *)
230
-
let filter_description =
231
-
let parts = [] in
232
-
let parts = if unread_only then "unread" :: parts else parts in
233
-
let parts = if sender_filter <> "" then ("from \"" ^ sender_filter ^ "\"") :: parts else parts in
234
-
match parts with
235
-
| [] -> "the most recent"
236
-
| [p] -> p
237
-
| _ -> String.concat " and " parts
238
-
in
239
-
240
-
Printf.printf "Listing %s %d emails in your inbox:\n"
241
-
filter_description
242
-
(List.length filtered_emails);
243
-
Printf.printf "--------------------------------------------\n";
244
-
List.iter (print_email ~show_labels) filtered_emails;
245
-
Lwt.return 0
246
-
247
-
(** Command line interface *)
248
-
let unread_only =
249
-
let doc = "List only unread messages" in
250
-
Arg.(value & flag & info ["unread"] ~doc)
251
-
252
-
let show_labels =
253
-
let doc = "Show labels/keywords associated with messages" in
254
-
Arg.(value & flag & info ["labels"] ~doc)
255
-
256
-
let debug_level =
257
-
let doc = "Set debug level (0-4, where 4 is most verbose)" in
258
-
Arg.(value & opt int 0 & info ["debug"] ~docv:"LEVEL" ~doc)
259
-
260
-
let demo_refs =
261
-
let doc = "Demonstrate result references feature" in
262
-
Arg.(value & flag & info ["demo-refs"] ~doc)
263
-
264
-
let sender_filter =
265
-
let doc = "Filter messages by sender email address (supports wildcards: * and ?)" in
266
-
Arg.(value & opt string "" & info ["from"] ~docv:"PATTERN" ~doc)
267
-
268
-
let cmd =
269
-
let doc = "List emails from a Fastmail account using JMAP API" in
270
-
let man = [
271
-
`S Manpage.s_description;
272
-
`P "This program connects to the Fastmail JMAP API using an authentication token
273
-
from the JMAP_API_TOKEN environment variable and lists the most recent emails
274
-
with their subjects, sender details, and labels.";
275
-
`P "You must obtain a Fastmail API token from https://app.fastmail.com/settings/tokens
276
-
and set it in the JMAP_API_TOKEN environment variable.";
277
-
`S Manpage.s_environment;
278
-
`P "$(b,JMAP_API_TOKEN) The Fastmail API authentication token (required)";
279
-
`S Manpage.s_examples;
280
-
`P "List all emails:";
281
-
`P " $(mname) $(i,JMAP_API_TOKEN=your_token)";
282
-
`P "List only unread emails:";
283
-
`P " $(mname) $(i,JMAP_API_TOKEN=your_token) --unread";
284
-
`P "List emails from a specific sender:";
285
-
`P " $(mname) $(i,JMAP_API_TOKEN=your_token) --from=user@example.com";
286
-
`P "List unread emails with labels:";
287
-
`P " $(mname) $(i,JMAP_API_TOKEN=your_token) --unread --labels";
288
-
] in
289
-
let info = Cmd.info "fastmail-list" ~doc ~man in
290
-
Cmd.v info Term.(const (fun u l d r s ->
291
-
Lwt_main.run (list_emails u l d r s)
292
-
) $ unread_only $ show_labels $ debug_level $ demo_refs $ sender_filter)
293
-
294
-
(** Program entry point *)
295
-
let () = exit (Cmd.eval_value cmd |> function
296
-
| Ok (`Ok exit_code) -> exit_code
297
-
| Ok (`Version | `Help) -> 0
298
-
| Error _ -> 1)
-177
bin/fastmail_send.ml
-177
bin/fastmail_send.ml
···
1
-
(** JMAP email sending utility for Fastmail
2
-
3
-
This utility sends an email via JMAP to recipients specified on the command line.
4
-
The subject is provided as a command-line argument, and the message body is read
5
-
from standard input.
6
-
7
-
Usage:
8
-
fastmail_send --to=recipient@example.com [--to=another@example.com ...] --subject="Email subject"
9
-
10
-
Environment variables:
11
-
- JMAP_API_TOKEN: Required. The Fastmail API token for authentication.
12
-
- JMAP_FROM_EMAIL: Optional. The sender's email address. If not provided, uses the first identity.
13
-
14
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-7> RFC8621 Section 7
15
-
*)
16
-
17
-
open Lwt.Syntax
18
-
open Cmdliner
19
-
20
-
let log_error fmt = Fmt.epr ("\u{1b}[1;31mError: \u{1b}[0m" ^^ fmt ^^ "@.")
21
-
let log_info fmt = Fmt.pr ("\u{1b}[1;34mInfo: \u{1b}[0m" ^^ fmt ^^ "@.")
22
-
let log_success fmt = Fmt.pr ("\u{1b}[1;32mSuccess: \u{1b}[0m" ^^ fmt ^^ "@.")
23
-
24
-
(** Read the entire message body from stdin *)
25
-
let read_message_body () =
26
-
let buffer = Buffer.create 1024 in
27
-
let rec read_lines () =
28
-
try
29
-
let line = input_line stdin in
30
-
Buffer.add_string buffer line;
31
-
Buffer.add_char buffer '\n';
32
-
read_lines ()
33
-
with
34
-
| End_of_file -> Buffer.contents buffer
35
-
in
36
-
read_lines ()
37
-
38
-
(** Main function to send an email *)
39
-
let send_email to_addresses subject from_email =
40
-
(* Check for API token in environment *)
41
-
match Sys.getenv_opt "JMAP_API_TOKEN" with
42
-
| None ->
43
-
log_error "JMAP_API_TOKEN environment variable not set";
44
-
exit 1
45
-
| Some token ->
46
-
(* Read message body from stdin *)
47
-
log_info "Reading message body from stdin (press Ctrl+D when finished)...";
48
-
let message_body = read_message_body () in
49
-
if message_body = "" then
50
-
log_info "No message body entered, using a blank message";
51
-
52
-
(* Initialize JMAP connection *)
53
-
let fastmail_uri = "https://api.fastmail.com/jmap/session" in
54
-
Lwt_main.run begin
55
-
let* conn_result = Jmap_mail.login_with_token ~uri:fastmail_uri ~api_token:token in
56
-
match conn_result with
57
-
| Error err ->
58
-
let msg = Jmap.Api.string_of_error err in
59
-
log_error "Failed to connect to Fastmail: %s" msg;
60
-
Lwt.return 1
61
-
| Ok conn ->
62
-
(* Get primary account ID *)
63
-
let account_id =
64
-
(* Get the primary account - first personal account in the list *)
65
-
let (_, _account) = List.find (fun (_, acc) ->
66
-
acc.Jmap.Types.is_personal) conn.session.accounts in
67
-
(* Use the first account id as primary *)
68
-
(match conn.session.primary_accounts with
69
-
| (_, id) :: _ -> id
70
-
| [] ->
71
-
(* Fallback if no primary accounts defined *)
72
-
let (id, _) = List.hd conn.session.accounts in
73
-
id)
74
-
in
75
-
76
-
(* Determine sender email address *)
77
-
let* from_email_result = match from_email with
78
-
| Some email -> Lwt.return_ok email
79
-
| None ->
80
-
(* Get first available identity *)
81
-
let* identities_result = Jmap_mail.get_identities conn ~account_id in
82
-
match identities_result with
83
-
| Ok [] ->
84
-
log_error "No identities found for account";
85
-
Lwt.return_error "No identities found"
86
-
| Ok (identity :: _) -> Lwt.return_ok identity.email
87
-
| Error err ->
88
-
let msg = Jmap.Api.string_of_error err in
89
-
log_error "Failed to get identities: %s" msg;
90
-
Lwt.return_error msg
91
-
in
92
-
93
-
match from_email_result with
94
-
| Error _msg -> Lwt.return 1
95
-
| Ok from_email ->
96
-
(* Send the email *)
97
-
log_info "Sending email from %s to %s"
98
-
from_email
99
-
(String.concat ", " to_addresses);
100
-
101
-
let* submission_result =
102
-
Jmap_mail.create_and_submit_email
103
-
conn
104
-
~account_id
105
-
~from:from_email
106
-
~to_addresses
107
-
~subject
108
-
~text_body:message_body
109
-
()
110
-
in
111
-
112
-
match submission_result with
113
-
| Error err ->
114
-
let msg = Jmap.Api.string_of_error err in
115
-
log_error "Failed to send email: %s" msg;
116
-
Lwt.return 1
117
-
| Ok submission_id ->
118
-
log_success "Email sent successfully (Submission ID: %s)" submission_id;
119
-
(* Wait briefly then check submission status *)
120
-
let* () = Lwt_unix.sleep 1.0 in
121
-
let* status_result = Jmap_mail.get_submission_status
122
-
conn
123
-
~account_id
124
-
~submission_id
125
-
in
126
-
127
-
(match status_result with
128
-
| Ok status ->
129
-
let status_text = match status.Jmap_mail.Types.undo_status with
130
-
| Some `pending -> "Pending"
131
-
| Some `final -> "Final (delivered)"
132
-
| Some `canceled -> "Canceled"
133
-
| None -> "Unknown"
134
-
in
135
-
log_info "Submission status: %s" status_text;
136
-
137
-
(match status.Jmap_mail.Types.delivery_status with
138
-
| Some statuses ->
139
-
List.iter (fun (email, status) ->
140
-
let delivery = match status.Jmap_mail.Types.delivered with
141
-
| Some "yes" -> "Delivered"
142
-
| Some "no" -> "Failed"
143
-
| Some "queued" -> "Queued"
144
-
| Some s -> s
145
-
| None -> "Unknown"
146
-
in
147
-
log_info "Delivery to %s: %s" email delivery
148
-
) statuses
149
-
| None -> ());
150
-
Lwt.return 0
151
-
| Error _ ->
152
-
(* We don't fail if status check fails, as the email might still be sent *)
153
-
Lwt.return 0)
154
-
end
155
-
156
-
(** Command line interface *)
157
-
let to_addresses =
158
-
let doc = "Email address of the recipient (can be specified multiple times)" in
159
-
Arg.(value & opt_all string [] & info ["to"] ~docv:"EMAIL" ~doc)
160
-
161
-
let subject =
162
-
let doc = "Subject line for the email" in
163
-
Arg.(required & opt (some string) None & info ["subject"] ~docv:"SUBJECT" ~doc)
164
-
165
-
let from_email =
166
-
let doc = "Sender's email address (optional, defaults to primary identity)" in
167
-
Arg.(value & opt (some string) None & info ["from"] ~docv:"EMAIL" ~doc)
168
-
169
-
let cmd =
170
-
let doc = "Send an email via JMAP to Fastmail" in
171
-
let info = Cmd.info "fastmail_send" ~doc in
172
-
Cmd.v info Term.(const send_email $ to_addresses $ subject $ from_email)
173
-
174
-
let () = match Cmd.eval_value cmd with
175
-
| Ok (`Ok code) -> exit code
176
-
| Ok (`Version | `Help) -> exit 0
177
-
| Error _ -> exit 1
-114
bin/flag_color_test.ml
-114
bin/flag_color_test.ml
···
1
-
(** Demo of message flags and mailbox attributes functionality *)
2
-
3
-
open Jmap_mail.Types
4
-
5
-
(** Demonstrate flag color functionality *)
6
-
let demo_flag_colors () =
7
-
Printf.printf "Flag Color Demo:\n";
8
-
Printf.printf "================\n";
9
-
10
-
(* Show all flag colors and their bit patterns *)
11
-
let colors = [Red; Orange; Yellow; Green; Blue; Purple; Gray] in
12
-
List.iter (fun color ->
13
-
let (bit0, bit1, bit2) = bits_of_flag_color color in
14
-
Printf.printf "Color: %-7s Bits: %d%d%d\n"
15
-
(match color with
16
-
| Red -> "Red"
17
-
| Orange -> "Orange"
18
-
| Yellow -> "Yellow"
19
-
| Green -> "Green"
20
-
| Blue -> "Blue"
21
-
| Purple -> "Purple"
22
-
| Gray -> "Gray")
23
-
(if bit0 then 1 else 0)
24
-
(if bit1 then 1 else 0)
25
-
(if bit2 then 1 else 0)
26
-
) colors;
27
-
28
-
Printf.printf "\n"
29
-
30
-
(** Demonstrate message keyword functionality *)
31
-
let demo_message_keywords () =
32
-
Printf.printf "Message Keywords Demo:\n";
33
-
Printf.printf "=====================\n";
34
-
35
-
(* Show all standard message keywords and their string representations *)
36
-
let keywords = [
37
-
Notify; Muted; Followed; Memo; HasMemo; HasAttachment; HasNoAttachment;
38
-
AutoSent; Unsubscribed; CanUnsubscribe; Imported; IsTrusted;
39
-
MaskedEmail; New; MailFlagBit0; MailFlagBit1; MailFlagBit2
40
-
] in
41
-
42
-
List.iter (fun kw ->
43
-
Printf.printf "%-15s -> %s\n"
44
-
(match kw with
45
-
| Notify -> "Notify"
46
-
| Muted -> "Muted"
47
-
| Followed -> "Followed"
48
-
| Memo -> "Memo"
49
-
| HasMemo -> "HasMemo"
50
-
| HasAttachment -> "HasAttachment"
51
-
| HasNoAttachment -> "HasNoAttachment"
52
-
| AutoSent -> "AutoSent"
53
-
| Unsubscribed -> "Unsubscribed"
54
-
| CanUnsubscribe -> "CanUnsubscribe"
55
-
| Imported -> "Imported"
56
-
| IsTrusted -> "IsTrusted"
57
-
| MaskedEmail -> "MaskedEmail"
58
-
| New -> "New"
59
-
| MailFlagBit0 -> "MailFlagBit0"
60
-
| MailFlagBit1 -> "MailFlagBit1"
61
-
| MailFlagBit2 -> "MailFlagBit2"
62
-
| OtherKeyword s -> "Other: " ^ s)
63
-
(string_of_message_keyword kw)
64
-
) keywords;
65
-
66
-
Printf.printf "\n"
67
-
68
-
(** Demonstrate mailbox attribute functionality *)
69
-
let demo_mailbox_attributes () =
70
-
Printf.printf "Mailbox Attributes Demo:\n";
71
-
Printf.printf "=======================\n";
72
-
73
-
(* Show all standard mailbox attributes and their string representations *)
74
-
let attributes = [Snoozed; Scheduled; Memos] in
75
-
76
-
List.iter (fun attr ->
77
-
Printf.printf "%-10s -> %s\n"
78
-
(match attr with
79
-
| Snoozed -> "Snoozed"
80
-
| Scheduled -> "Scheduled"
81
-
| Memos -> "Memos"
82
-
| OtherAttribute s -> "Other: " ^ s)
83
-
(string_of_mailbox_attribute attr)
84
-
) attributes;
85
-
86
-
Printf.printf "\n"
87
-
88
-
(** Demonstrate formatting functionality *)
89
-
let demo_formatting () =
90
-
Printf.printf "Keyword Formatting Demo:\n";
91
-
Printf.printf "======================\n";
92
-
93
-
(* Create a sample email with various keywords *)
94
-
let sample_keywords = [
95
-
(Flagged, true); (* Standard flag *)
96
-
(Custom "$MailFlagBit0", true); (* Flag color bit *)
97
-
(Custom "$MailFlagBit2", true); (* Flag color bit *)
98
-
(Custom "$notify", true); (* Message keyword *)
99
-
(Custom "$followed", true); (* Message keyword *)
100
-
(Custom "$hasattachment", true); (* Message keyword *)
101
-
(Seen, false); (* Inactive keyword *)
102
-
(Custom "$random", true); (* Unknown keyword *)
103
-
] in
104
-
105
-
(* Test formatted output *)
106
-
let formatted = format_email_keywords sample_keywords in
107
-
Printf.printf "Formatted keywords: %s\n\n" formatted
108
-
109
-
(** Main entry point *)
110
-
let () =
111
-
demo_flag_colors ();
112
-
demo_message_keywords ();
113
-
demo_mailbox_attributes ();
114
-
demo_formatting ()
-164
bin/tutorial_examples.ml
-164
bin/tutorial_examples.ml
···
1
-
(* Examples from the tutorial *)
2
-
3
-
open Lwt.Syntax
4
-
open Jmap
5
-
open Jmap_mail
6
-
7
-
(* Example: Authentication *)
8
-
let auth_example () =
9
-
(* Using a Fastmail API token *)
10
-
let token = Sys.getenv_opt "JMAP_API_TOKEN" in
11
-
match token with
12
-
| None ->
13
-
Printf.eprintf "Error: JMAP_API_TOKEN environment variable not set\n";
14
-
Lwt.return_none
15
-
| Some token ->
16
-
let+ result = Jmap_mail.login_with_token
17
-
~uri:"https://api.fastmail.com/jmap/session"
18
-
~api_token:token
19
-
in
20
-
21
-
(* Handle the result *)
22
-
match result with
23
-
| Ok conn ->
24
-
(* Get the primary account ID *)
25
-
let account_id =
26
-
let mail_capability = Jmap_mail.Capability.to_string Jmap_mail.Capability.Mail in
27
-
match List.assoc_opt mail_capability conn.session.primary_accounts with
28
-
| Some id -> id
29
-
| None ->
30
-
match conn.session.accounts with
31
-
| (id, _) :: _ -> id
32
-
| [] -> failwith "No accounts found"
33
-
in
34
-
Printf.printf "Authenticated successfully with account ID: %s\n" account_id;
35
-
Some (conn, account_id)
36
-
| Error e ->
37
-
Printf.eprintf "Authentication error: %s\n"
38
-
(match e with
39
-
| Api.Connection_error msg -> "Connection error: " ^ msg
40
-
| Api.HTTP_error (code, body) -> Printf.sprintf "HTTP error %d: %s" code body
41
-
| Api.Parse_error msg -> "Parse error: " ^ msg
42
-
| Api.Authentication_error -> "Authentication error");
43
-
None
44
-
45
-
(* Example: Working with Mailboxes *)
46
-
let mailbox_example (conn, account_id) =
47
-
(* Get all mailboxes *)
48
-
let+ mailboxes_result = Jmap_mail.get_mailboxes conn ~account_id in
49
-
50
-
match mailboxes_result with
51
-
| Ok mailboxes ->
52
-
Printf.printf "Found %d mailboxes\n" (List.length mailboxes);
53
-
54
-
(* Find inbox - for simplicity, just use the first mailbox *)
55
-
let inbox = match mailboxes with
56
-
| first :: _ -> Some first
57
-
| [] -> None
58
-
in
59
-
60
-
(match inbox with
61
-
| Some m ->
62
-
Printf.printf "Inbox ID: %s, Name: %s\n"
63
-
m.Types.id
64
-
m.Types.name;
65
-
Some (conn, account_id, m.Types.id)
66
-
| None ->
67
-
Printf.printf "No inbox found\n";
68
-
None)
69
-
| Error e ->
70
-
Printf.eprintf "Error getting mailboxes: %s\n"
71
-
(match e with
72
-
| Api.Connection_error msg -> "Connection error: " ^ msg
73
-
| Api.HTTP_error (code, body) -> Printf.sprintf "HTTP error %d: %s" code body
74
-
| Api.Parse_error msg -> "Parse error: " ^ msg
75
-
| Api.Authentication_error -> "Authentication error");
76
-
None
77
-
78
-
(* Example: Working with Emails *)
79
-
let email_example (conn, account_id, mailbox_id) =
80
-
(* Get emails from mailbox *)
81
-
let+ emails_result = Jmap_mail.get_messages_in_mailbox
82
-
conn
83
-
~account_id
84
-
~mailbox_id
85
-
~limit:5
86
-
()
87
-
in
88
-
89
-
match emails_result with
90
-
| Ok emails -> begin
91
-
Printf.printf "Found %d emails\n" (List.length emails);
92
-
93
-
(* Display emails *)
94
-
List.iter (fun (email:Jmap_mail.Types.email) ->
95
-
(* Using explicit module path for Types to avoid ambiguity *)
96
-
let module Mail = Jmap_mail.Types in
97
-
98
-
(* Get sender info *)
99
-
let from = match email.Mail.from with
100
-
| None -> "Unknown"
101
-
| Some addrs ->
102
-
match addrs with
103
-
| [] -> "Unknown"
104
-
| addr :: _ ->
105
-
match addr.Mail.name with
106
-
| None -> addr.Mail.email
107
-
| Some name ->
108
-
Printf.sprintf "%s <%s>" name addr.Mail.email
109
-
in
110
-
111
-
(* Check for unread status *)
112
-
let is_unread =
113
-
List.exists (fun (kw, active) ->
114
-
match kw with
115
-
| Mail.Unread -> active
116
-
| Mail.Custom s when s = "$unread" -> active
117
-
| _ -> false
118
-
) email.Mail.keywords
119
-
in
120
-
121
-
(* Display email info *)
122
-
Printf.printf "[%s] %s - %s\n"
123
-
(if is_unread then "UNREAD" else "READ")
124
-
from
125
-
(Option.value ~default:"(No Subject)" email.Mail.subject)
126
-
) emails;
127
-
128
-
match emails with
129
-
| [] -> None
130
-
| hd::_ -> Some (conn, account_id, hd.Jmap_mail.Types.id)
131
-
end
132
-
| Error e ->
133
-
Printf.eprintf "Error getting emails: %s\n"
134
-
(match e with
135
-
| Api.Connection_error msg -> "Connection error: " ^ msg
136
-
| Api.HTTP_error (code, body) -> Printf.sprintf "HTTP error %d: %s" code body
137
-
| Api.Parse_error msg -> "Parse error: " ^ msg
138
-
| Api.Authentication_error -> "Authentication error");
139
-
None
140
-
141
-
(* Run examples with Lwt *)
142
-
let () =
143
-
(* Set up logging *)
144
-
Jmap.init_logging ~level:2 ~enable_logs:true ~redact_sensitive:true ();
145
-
146
-
(* Run the examples in sequence *)
147
-
let result = Lwt_main.run (
148
-
let* auth_result = auth_example () in
149
-
match auth_result with
150
-
| None -> Lwt.return 1
151
-
| Some conn_account ->
152
-
let* mailbox_result = mailbox_example conn_account in
153
-
match mailbox_result with
154
-
| None -> Lwt.return 1
155
-
| Some conn_account_mailbox ->
156
-
let* email_result = email_example conn_account_mailbox in
157
-
match email_result with
158
-
| None -> Lwt.return 1
159
-
| Some _ ->
160
-
Printf.printf "All examples completed successfully\n";
161
-
Lwt.return 0
162
-
) in
163
-
164
-
exit result
+1
-3
dune
+1
-3
dune
+1
-23
dune-project
+1
-23
dune-project
···
1
-
(lang dune 3.17)
2
-
3
-
(name jmap)
4
-
5
-
(source (github avsm/jmap))
6
-
(license ISC)
7
-
(authors "Anil Madhavapeddy")
8
-
(maintainers "anil@recoil.org")
9
-
10
-
(generate_opam_files true)
11
-
12
-
(package
13
-
(name jmap)
14
-
(synopsis "JMAP protocol")
15
-
(description "This is all still a work in progress")
16
-
(depends
17
-
(ocaml (>= "5.2.0"))
18
-
ptime
19
-
cohttp
20
-
cohttp-lwt-unix
21
-
ezjsonm
22
-
uri
23
-
lwt))
1
+
(lang dune 3.17)
-360
index.mld
-360
index.mld
···
1
-
{0 JMAP OCaml Client}
2
-
3
-
This library provides a type-safe OCaml interface to the JMAP protocol (RFC8620) and JMAP Mail extension (RFC8621).
4
-
5
-
{1 Overview}
6
-
7
-
JMAP (JSON Meta Application Protocol) is a modern protocol for synchronizing email, calendars, and contacts designed as a replacement for legacy protocols like IMAP. This OCaml implementation provides:
8
-
9
-
- Type-safe OCaml interfaces to the JMAP Core and Mail specifications
10
-
- Authentication with username/password or API tokens (Fastmail support)
11
-
- Convenient functions for common email and mailbox operations
12
-
- Support for composing complex multi-part requests with result references
13
-
- Typed handling of message flags, keywords, and mailbox attributes
14
-
15
-
{1 Getting Started}
16
-
17
-
{2 Core Modules}
18
-
19
-
The library is organized into two main packages:
20
-
21
-
- {!module:Jmap} - Core protocol functionality (RFC8620)
22
-
- {!module:Jmap_mail} - Mail-specific extensions (RFC8621)
23
-
24
-
{2 Authentication}
25
-
26
-
To begin working with JMAP, you first need to establish a session:
27
-
28
-
{[
29
-
(* Using username/password *)
30
-
let result = Jmap_mail.login
31
-
~uri:"https://jmap.example.com/jmap/session"
32
-
~credentials:{
33
-
username = "user@example.com";
34
-
password = "password";
35
-
}
36
-
37
-
(* Using a Fastmail API token *)
38
-
let token = Sys.getenv "JMAP_API_TOKEN" in
39
-
let result = Jmap_mail.login_with_token
40
-
~uri:"https://api.fastmail.com/jmap/session"
41
-
~api_token:token
42
-
()
43
-
44
-
(* Handle the result *)
45
-
match result with
46
-
| Ok conn ->
47
-
(* Get the primary account ID *)
48
-
let account_id =
49
-
let mail_capability = Jmap_mail.Capability.to_string Jmap_mail.Capability.Mail in
50
-
match List.assoc_opt mail_capability conn.session.primary_accounts with
51
-
| Some id -> id
52
-
| None -> (* Use first account or handle error *)
53
-
in
54
-
(* Use connection and account_id for further operations *)
55
-
| Error e -> (* Handle error *)
56
-
]}
57
-
58
-
{2 Working with Mailboxes}
59
-
60
-
Once authenticated, you can retrieve and manipulate mailboxes:
61
-
62
-
{[
63
-
(* Get all mailboxes *)
64
-
let get_mailboxes conn account_id =
65
-
Jmap_mail.get_mailboxes conn ~account_id
66
-
67
-
(* Find inbox by role *)
68
-
let find_inbox mailboxes =
69
-
List.find_opt
70
-
(fun m -> m.Jmap_mail.Types.role = Some Jmap_mail.Types.Inbox)
71
-
mailboxes
72
-
]}
73
-
74
-
{2 Working with Emails}
75
-
76
-
Retrieve and filter emails:
77
-
78
-
{[
79
-
(* Get emails from a mailbox *)
80
-
let get_emails conn account_id mailbox_id =
81
-
Jmap_mail.get_messages_in_mailbox
82
-
conn
83
-
~account_id
84
-
~mailbox_id
85
-
~limit:100
86
-
()
87
-
88
-
(* Get only unread emails *)
89
-
let is_unread email =
90
-
List.exists (fun (kw, active) ->
91
-
(kw = Jmap_mail.Types.Unread ||
92
-
kw = Jmap_mail.Types.Custom "$unread") && active
93
-
) email.Jmap_mail.Types.keywords
94
-
95
-
let get_unread_emails conn account_id mailbox_id =
96
-
let* result = get_emails conn account_id mailbox_id in
97
-
match result with
98
-
| Ok emails -> Lwt.return_ok (List.filter is_unread emails)
99
-
| Error e -> Lwt.return_error e
100
-
101
-
(* Filter by sender email *)
102
-
let filter_by_sender emails sender_pattern =
103
-
List.filter (fun email ->
104
-
Jmap_mail.email_matches_sender email sender_pattern
105
-
) emails
106
-
]}
107
-
108
-
{2 Message Flags and Keywords}
109
-
110
-
Work with email flags and keywords:
111
-
112
-
{[
113
-
(* Check if an email has a specific keyword *)
114
-
let has_keyword keyword email =
115
-
List.exists (fun (kw, active) ->
116
-
match kw, active with
117
-
| Jmap_mail.Types.Custom k, true when k = keyword -> true
118
-
| _ -> false
119
-
) email.Jmap_mail.Types.keywords
120
-
121
-
(* Add a keyword to an email *)
122
-
let add_keyword conn account_id email_id keyword =
123
-
(* This would typically involve creating an Email/set request
124
-
that updates the keywords property of the email *)
125
-
failwith "Not fully implemented in this example"
126
-
127
-
(* Get flag color *)
128
-
let get_flag_color email =
129
-
Jmap_mail.Types.get_flag_color email.Jmap_mail.Types.keywords
130
-
131
-
(* Set flag color *)
132
-
let set_flag_color conn account_id email_id color =
133
-
Jmap_mail.Types.set_flag_color conn account_id email_id color
134
-
]}
135
-
136
-
{2 Composing Requests with Result References}
137
-
138
-
JMAP allows composing multiple operations into a single request:
139
-
140
-
{[
141
-
(* Example demonstrating result references for chained requests *)
142
-
let demo_result_references conn account_id =
143
-
let open Jmap.Types in
144
-
145
-
(* Create method call IDs *)
146
-
let mailbox_get_id = "mailboxGet" in
147
-
let email_query_id = "emailQuery" in
148
-
let email_get_id = "emailGet" in
149
-
150
-
(* First call: Get mailboxes *)
151
-
let mailbox_get_call = {
152
-
name = "Mailbox/get";
153
-
arguments = `O [
154
-
("accountId", `String account_id);
155
-
];
156
-
method_call_id = mailbox_get_id;
157
-
} in
158
-
159
-
(* Second call: Query emails in the first mailbox using result reference *)
160
-
let mailbox_id_ref = Jmap.ResultReference.create
161
-
~result_of:mailbox_get_id
162
-
~name:"Mailbox/get"
163
-
~path:"/list/0/id" in
164
-
165
-
let (mailbox_id_ref_key, mailbox_id_ref_value) =
166
-
Jmap.ResultReference.reference_arg "inMailbox" mailbox_id_ref in
167
-
168
-
let email_query_call = {
169
-
name = "Email/query";
170
-
arguments = `O [
171
-
("accountId", `String account_id);
172
-
("filter", `O [
173
-
(mailbox_id_ref_key, mailbox_id_ref_value)
174
-
]);
175
-
("limit", `Float 10.0);
176
-
];
177
-
method_call_id = email_query_id;
178
-
} in
179
-
180
-
(* Third call: Get full email objects using the query result *)
181
-
let email_ids_ref = Jmap.ResultReference.create
182
-
~result_of:email_query_id
183
-
~name:"Email/query"
184
-
~path:"/ids" in
185
-
186
-
let (email_ids_ref_key, email_ids_ref_value) =
187
-
Jmap.ResultReference.reference_arg "ids" email_ids_ref in
188
-
189
-
let email_get_call = {
190
-
name = "Email/get";
191
-
arguments = `O [
192
-
("accountId", `String account_id);
193
-
(email_ids_ref_key, email_ids_ref_value)
194
-
];
195
-
method_call_id = email_get_id;
196
-
} in
197
-
198
-
(* Create the complete request with all three method calls *)
199
-
let request = {
200
-
using = [
201
-
Jmap.Capability.to_string Jmap.Capability.Core;
202
-
Jmap_mail.Capability.to_string Jmap_mail.Capability.Mail
203
-
];
204
-
method_calls = [
205
-
mailbox_get_call;
206
-
email_query_call;
207
-
email_get_call
208
-
];
209
-
created_ids = None;
210
-
} in
211
-
212
-
(* Execute the request *)
213
-
Jmap.Api.make_request conn.config request
214
-
]}
215
-
216
-
{1 Example: List Recent Emails}
217
-
218
-
Here's a complete example showing how to list recent emails from a mailbox:
219
-
220
-
{[
221
-
open Lwt.Syntax
222
-
open Jmap
223
-
open Jmap_mail
224
-
225
-
(* Main function that demonstrates JMAP functionality *)
226
-
let main () =
227
-
(* Initialize logging *)
228
-
Jmap.init_logging ~level:2 ~enable_logs:true ~redact_sensitive:true ();
229
-
230
-
(* Check for API token *)
231
-
match Sys.getenv_opt "JMAP_API_TOKEN" with
232
-
| None ->
233
-
Printf.eprintf "Error: JMAP_API_TOKEN environment variable not set\n";
234
-
Lwt.return 1
235
-
| Some token ->
236
-
(* Authentication example *)
237
-
let* login_result = Jmap_mail.login_with_token
238
-
~uri:"https://api.fastmail.com/jmap/session"
239
-
~api_token:token
240
-
in
241
-
242
-
match login_result with
243
-
| Error err ->
244
-
Printf.eprintf "Authentication failed\n";
245
-
Lwt.return 1
246
-
247
-
| Ok conn ->
248
-
(* Get primary account ID *)
249
-
let mail_capability = Jmap_mail.Capability.to_string Jmap_mail.Capability.Mail in
250
-
let account_id =
251
-
match List.assoc_opt mail_capability conn.session.primary_accounts with
252
-
| Some id -> id
253
-
| None ->
254
-
match conn.session.accounts with
255
-
| (id, _) :: _ -> id
256
-
| [] ->
257
-
Printf.eprintf "No accounts found\n";
258
-
exit 1
259
-
in
260
-
261
-
(* Get mailboxes example *)
262
-
let* mailboxes_result = Jmap_mail.get_mailboxes conn ~account_id in
263
-
264
-
match mailboxes_result with
265
-
| Error err ->
266
-
Printf.eprintf "Failed to get mailboxes\n";
267
-
Lwt.return 1
268
-
269
-
| Ok mailboxes ->
270
-
(* Use the first mailbox for simplicity *)
271
-
match mailboxes with
272
-
| [] ->
273
-
Printf.eprintf "No mailboxes found\n";
274
-
Lwt.return 1
275
-
276
-
| first_mailbox :: _ ->
277
-
(* Get emails example *)
278
-
let* emails_result = Jmap_mail.get_messages_in_mailbox
279
-
conn
280
-
~account_id
281
-
~mailbox_id:first_mailbox.Types.id
282
-
~limit:5
283
-
()
284
-
in
285
-
286
-
match emails_result with
287
-
| Error err ->
288
-
Printf.eprintf "Failed to get emails\n";
289
-
Lwt.return 1
290
-
291
-
| Ok emails ->
292
-
(* Display emails *)
293
-
List.iter (fun email ->
294
-
let module Mail = Jmap_mail.Types in
295
-
296
-
(* Get sender *)
297
-
let sender = match email.Mail.from with
298
-
| None -> "<unknown>"
299
-
| Some addrs ->
300
-
match addrs with
301
-
| [] -> "<unknown>"
302
-
| addr :: _ ->
303
-
match addr.Mail.name with
304
-
| None -> addr.Mail.email
305
-
| Some name ->
306
-
Printf.sprintf "%s <%s>" name addr.Mail.email
307
-
in
308
-
309
-
(* Get subject *)
310
-
let subject = match email.Mail.subject with
311
-
| None -> "<no subject>"
312
-
| Some s -> s
313
-
in
314
-
315
-
(* Is unread? *)
316
-
let is_unread = List.exists (fun (kw, active) ->
317
-
match kw with
318
-
| Mail.Unread -> active
319
-
| Mail.Custom s when s = "$unread" -> active
320
-
| _ -> false
321
-
) email.Mail.keywords in
322
-
323
-
(* Print email info *)
324
-
Printf.printf "[%s] %s - %s\n"
325
-
(if is_unread then "UNREAD" else "READ")
326
-
sender
327
-
subject
328
-
) emails;
329
-
330
-
Lwt.return 0
331
-
332
-
(* Program entry point *)
333
-
let () =
334
-
let exit_code = Lwt_main.run (main ()) in
335
-
exit exit_code
336
-
]}
337
-
338
-
{1 API Reference}
339
-
340
-
{2 Core Modules}
341
-
342
-
- {!module:Jmap} - Core JMAP protocol
343
-
- {!module:Jmap.Types} - Core type definitions
344
-
- {!module:Jmap.Api} - HTTP client and session handling
345
-
- {!module:Jmap.ResultReference} - Request composition utilities
346
-
- {!module:Jmap.Capability} - JMAP capability handling
347
-
348
-
{2 Mail Extension Modules}
349
-
350
-
- {!module:Jmap_mail} - JMAP Mail extension
351
-
- {!module:Jmap_mail.Types} - Mail-specific types
352
-
- Jmap_mail.Capability - Mail capability handling
353
-
- Jmap_mail.Json - JSON serialization
354
-
- Specialized operations for emails, mailboxes, threads, and identities
355
-
356
-
{1 References}
357
-
358
-
- {{:https://datatracker.ietf.org/doc/html/rfc8620}} RFC8620: The JSON Meta Application Protocol (JMAP)
359
-
- {{:https://datatracker.ietf.org/doc/html/rfc8621}} RFC8621: The JSON Meta Application Protocol (JMAP) for Mail
360
-
- {{:https://datatracker.ietf.org/doc/html/draft-ietf-mailmaint-messageflag-mailboxattribute-02}} Message Flag and Mailbox Attribute Extension
-35
jmap.opam
-35
jmap.opam
···
1
-
# This file is generated by dune, edit dune-project instead
2
-
opam-version: "2.0"
3
-
synopsis: "JMAP protocol"
4
-
description: "This is all still a work in progress"
5
-
maintainer: ["anil@recoil.org"]
6
-
authors: ["Anil Madhavapeddy"]
7
-
license: "ISC"
8
-
homepage: "https://github.com/avsm/jmap"
9
-
bug-reports: "https://github.com/avsm/jmap/issues"
10
-
depends: [
11
-
"dune" {>= "3.17"}
12
-
"ocaml" {>= "5.2.0"}
13
-
"ptime"
14
-
"cohttp"
15
-
"cohttp-lwt-unix"
16
-
"ezjsonm"
17
-
"uri"
18
-
"lwt"
19
-
"odoc" {with-doc}
20
-
]
21
-
build: [
22
-
["dune" "subst"] {dev}
23
-
[
24
-
"dune"
25
-
"build"
26
-
"-p"
27
-
name
28
-
"-j"
29
-
jobs
30
-
"@install"
31
-
"@runtest" {with-test}
32
-
"@doc" {with-doc}
33
-
]
34
-
]
35
-
dev-repo: "git+https://github.com/avsm/jmap.git"
-11
lib/dune
-11
lib/dune
-804
lib/jmap.ml
-804
lib/jmap.ml
···
1
-
(**
2
-
* JMAP protocol implementation based on RFC8620
3
-
* https://datatracker.ietf.org/doc/html/rfc8620
4
-
*)
5
-
6
-
(** Whether to redact sensitive information *)
7
-
let should_redact_sensitive = ref true
8
-
9
-
(** Initialize and configure logging for JMAP *)
10
-
let init_logging ?(level=2) ?(enable_logs=true) ?(redact_sensitive=true) () =
11
-
if enable_logs then begin
12
-
Logs.set_reporter (Logs.format_reporter ());
13
-
match level with
14
-
| 0 -> Logs.set_level None
15
-
| 1 -> Logs.set_level (Some Logs.Error)
16
-
| 2 -> Logs.set_level (Some Logs.Info)
17
-
| 3 -> Logs.set_level (Some Logs.Debug)
18
-
| _ -> Logs.set_level (Some Logs.Debug)
19
-
end else
20
-
Logs.set_level None;
21
-
should_redact_sensitive := redact_sensitive
22
-
23
-
(** Redact sensitive data like tokens *)
24
-
let redact_token ?(redact=true) token =
25
-
if redact && !should_redact_sensitive && String.length token > 8 then
26
-
let prefix = String.sub token 0 4 in
27
-
let suffix = String.sub token (String.length token - 4) 4 in
28
-
prefix ^ "..." ^ suffix
29
-
else
30
-
token
31
-
32
-
(** Redact sensitive headers like Authorization *)
33
-
let redact_headers headers =
34
-
List.map (fun (k, v) ->
35
-
if String.lowercase_ascii k = "authorization" then
36
-
if !should_redact_sensitive then
37
-
let parts = String.split_on_char ' ' v in
38
-
match parts with
39
-
| scheme :: token :: _ -> (k, scheme ^ " " ^ redact_token token)
40
-
| _ -> (k, v)
41
-
else (k, v)
42
-
else (k, v)
43
-
) headers
44
-
45
-
(* Initialize logging with defaults *)
46
-
let () = init_logging ()
47
-
48
-
(** Module for managing JMAP capability URIs and other constants *)
49
-
module Capability = struct
50
-
(** JMAP capability URI as specified in RFC8620 *)
51
-
let core_uri = "urn:ietf:params:jmap:core"
52
-
53
-
(** All JMAP capability types *)
54
-
type t =
55
-
| Core (** Core JMAP capability *)
56
-
| Extension of string (** Extension capabilities *)
57
-
58
-
(** Convert capability to URI string *)
59
-
let to_string = function
60
-
| Core -> core_uri
61
-
| Extension s -> s
62
-
63
-
(** Parse a string to a capability, returns Extension for non-core capabilities *)
64
-
let of_string s =
65
-
if s = core_uri then Core
66
-
else Extension s
67
-
68
-
(** Check if a capability matches a core capability *)
69
-
let is_core = function
70
-
| Core -> true
71
-
| Extension _ -> false
72
-
73
-
(** Check if a capability string is a core capability *)
74
-
let is_core_string s = s = core_uri
75
-
76
-
(** Create a list of capability strings *)
77
-
let strings_of_capabilities capabilities =
78
-
List.map to_string capabilities
79
-
end
80
-
81
-
module Types = struct
82
-
(** Id string as per Section 1.2 *)
83
-
type id = string
84
-
85
-
(** Int bounded within the range -2^53+1 to 2^53-1 as per Section 1.3 *)
86
-
type int_t = int
87
-
88
-
(** UnsignedInt bounded within the range 0 to 2^53-1 as per Section 1.3 *)
89
-
type unsigned_int = int
90
-
91
-
(** Date string in RFC3339 format as per Section 1.4 *)
92
-
type date = string
93
-
94
-
(** UTCDate is a Date with 'Z' time zone as per Section 1.4 *)
95
-
type utc_date = string
96
-
97
-
(** Error object as per Section 3.6.2 *)
98
-
type error = {
99
-
type_: string;
100
-
description: string option;
101
-
}
102
-
103
-
(** Set error object as per Section 5.3 *)
104
-
type set_error = {
105
-
type_: string;
106
-
description: string option;
107
-
properties: string list option;
108
-
(* Additional properties for specific error types *)
109
-
existing_id: id option; (* For alreadyExists error *)
110
-
}
111
-
112
-
(** Invocation object as per Section 3.2 *)
113
-
type 'a invocation = {
114
-
name: string;
115
-
arguments: 'a;
116
-
method_call_id: string;
117
-
}
118
-
119
-
(** ResultReference object as per Section 3.7 *)
120
-
type result_reference = {
121
-
result_of: string;
122
-
name: string;
123
-
path: string;
124
-
}
125
-
126
-
(** FilterOperator, FilterCondition and Filter as per Section 5.5 *)
127
-
type filter_operator = {
128
-
operator: string; (* "AND", "OR", "NOT" *)
129
-
conditions: filter list;
130
-
}
131
-
and filter_condition = (string * Ezjsonm.value) list
132
-
and filter =
133
-
| Operator of filter_operator
134
-
| Condition of filter_condition
135
-
136
-
(** Comparator object for sorting as per Section 5.5 *)
137
-
type comparator = {
138
-
property: string;
139
-
is_ascending: bool option; (* Optional, defaults to true *)
140
-
collation: string option; (* Optional, server-dependent default *)
141
-
}
142
-
143
-
(** PatchObject as per Section 5.3 *)
144
-
type patch_object = (string * Ezjsonm.value) list
145
-
146
-
(** AddedItem structure as per Section 5.6 *)
147
-
type added_item = {
148
-
id: id;
149
-
index: unsigned_int;
150
-
}
151
-
152
-
(** Account object as per Section 1.6.2 *)
153
-
type account = {
154
-
name: string;
155
-
is_personal: bool;
156
-
is_read_only: bool;
157
-
account_capabilities: (string * Ezjsonm.value) list;
158
-
}
159
-
160
-
(** Core capability object as per Section 2 *)
161
-
type core_capability = {
162
-
max_size_upload: unsigned_int;
163
-
max_concurrent_upload: unsigned_int;
164
-
max_size_request: unsigned_int;
165
-
max_concurrent_requests: unsigned_int;
166
-
max_calls_in_request: unsigned_int;
167
-
max_objects_in_get: unsigned_int;
168
-
max_objects_in_set: unsigned_int;
169
-
collation_algorithms: string list;
170
-
}
171
-
172
-
(** PushSubscription keys object as per Section 7.2 *)
173
-
type push_keys = {
174
-
p256dh: string;
175
-
auth: string;
176
-
}
177
-
178
-
(** Session object as per Section 2 *)
179
-
type session = {
180
-
capabilities: (string * Ezjsonm.value) list;
181
-
accounts: (id * account) list;
182
-
primary_accounts: (string * id) list;
183
-
username: string;
184
-
api_url: string;
185
-
download_url: string;
186
-
upload_url: string;
187
-
event_source_url: string option;
188
-
state: string;
189
-
}
190
-
191
-
(** TypeState for state changes as per Section 7.1 *)
192
-
type type_state = (string * string) list
193
-
194
-
(** StateChange object as per Section 7.1 *)
195
-
type state_change = {
196
-
changed: (id * type_state) list;
197
-
}
198
-
199
-
(** PushVerification object as per Section 7.2.2 *)
200
-
type push_verification = {
201
-
push_subscription_id: id;
202
-
verification_code: string;
203
-
}
204
-
205
-
(** PushSubscription object as per Section 7.2 *)
206
-
type push_subscription = {
207
-
id: id;
208
-
device_client_id: string;
209
-
url: string;
210
-
keys: push_keys option;
211
-
verification_code: string option;
212
-
expires: utc_date option;
213
-
types: string list option;
214
-
}
215
-
216
-
(** Request object as per Section 3.3 *)
217
-
type request = {
218
-
using: string list;
219
-
method_calls: Ezjsonm.value invocation list;
220
-
created_ids: (id * id) list option;
221
-
}
222
-
223
-
(** Response object as per Section 3.4 *)
224
-
type response = {
225
-
method_responses: Ezjsonm.value invocation list;
226
-
created_ids: (id * id) list option;
227
-
session_state: string;
228
-
}
229
-
230
-
(** Standard method arguments and responses *)
231
-
232
-
(** Arguments for Foo/get method as per Section 5.1 *)
233
-
type 'a get_arguments = {
234
-
account_id: id;
235
-
ids: id list option;
236
-
properties: string list option;
237
-
}
238
-
239
-
(** Response for Foo/get method as per Section 5.1 *)
240
-
type 'a get_response = {
241
-
account_id: id;
242
-
state: string;
243
-
list: 'a list;
244
-
not_found: id list;
245
-
}
246
-
247
-
(** Arguments for Foo/changes method as per Section 5.2 *)
248
-
type changes_arguments = {
249
-
account_id: id;
250
-
since_state: string;
251
-
max_changes: unsigned_int option;
252
-
}
253
-
254
-
(** Response for Foo/changes method as per Section 5.2 *)
255
-
type changes_response = {
256
-
account_id: id;
257
-
old_state: string;
258
-
new_state: string;
259
-
has_more_changes: bool;
260
-
created: id list;
261
-
updated: id list;
262
-
destroyed: id list;
263
-
}
264
-
265
-
(** Arguments for Foo/set method as per Section 5.3 *)
266
-
type 'a set_arguments = {
267
-
account_id: id;
268
-
if_in_state: string option;
269
-
create: (id * 'a) list option;
270
-
update: (id * patch_object) list option;
271
-
destroy: id list option;
272
-
}
273
-
274
-
(** Response for Foo/set method as per Section 5.3 *)
275
-
type 'a set_response = {
276
-
account_id: id;
277
-
old_state: string option;
278
-
new_state: string;
279
-
created: (id * 'a) list option;
280
-
updated: (id * 'a option) list option;
281
-
destroyed: id list option;
282
-
not_created: (id * set_error) list option;
283
-
not_updated: (id * set_error) list option;
284
-
not_destroyed: (id * set_error) list option;
285
-
}
286
-
287
-
(** Arguments for Foo/copy method as per Section 5.4 *)
288
-
type 'a copy_arguments = {
289
-
from_account_id: id;
290
-
if_from_in_state: string option;
291
-
account_id: id;
292
-
if_in_state: string option;
293
-
create: (id * 'a) list;
294
-
on_success_destroy_original: bool option;
295
-
destroy_from_if_in_state: string option;
296
-
}
297
-
298
-
(** Response for Foo/copy method as per Section 5.4 *)
299
-
type 'a copy_response = {
300
-
from_account_id: id;
301
-
account_id: id;
302
-
old_state: string option;
303
-
new_state: string;
304
-
created: (id * 'a) list option;
305
-
not_created: (id * set_error) list option;
306
-
}
307
-
308
-
(** Arguments for Foo/query method as per Section 5.5 *)
309
-
type query_arguments = {
310
-
account_id: id;
311
-
filter: filter option;
312
-
sort: comparator list option;
313
-
position: int_t option;
314
-
anchor: id option;
315
-
anchor_offset: int_t option;
316
-
limit: unsigned_int option;
317
-
calculate_total: bool option;
318
-
}
319
-
320
-
(** Response for Foo/query method as per Section 5.5 *)
321
-
type query_response = {
322
-
account_id: id;
323
-
query_state: string;
324
-
can_calculate_changes: bool;
325
-
position: unsigned_int;
326
-
ids: id list;
327
-
total: unsigned_int option;
328
-
limit: unsigned_int option;
329
-
}
330
-
331
-
(** Arguments for Foo/queryChanges method as per Section 5.6 *)
332
-
type query_changes_arguments = {
333
-
account_id: id;
334
-
filter: filter option;
335
-
sort: comparator list option;
336
-
since_query_state: string;
337
-
max_changes: unsigned_int option;
338
-
up_to_id: id option;
339
-
calculate_total: bool option;
340
-
}
341
-
342
-
(** Response for Foo/queryChanges method as per Section 5.6 *)
343
-
type query_changes_response = {
344
-
account_id: id;
345
-
old_query_state: string;
346
-
new_query_state: string;
347
-
total: unsigned_int option;
348
-
removed: id list;
349
-
added: added_item list option;
350
-
}
351
-
352
-
(** Arguments for Blob/copy method as per Section 6.3 *)
353
-
type blob_copy_arguments = {
354
-
from_account_id: id;
355
-
account_id: id;
356
-
blob_ids: id list;
357
-
}
358
-
359
-
(** Response for Blob/copy method as per Section 6.3 *)
360
-
type blob_copy_response = {
361
-
from_account_id: id;
362
-
account_id: id;
363
-
copied: (id * id) list option;
364
-
not_copied: (id * set_error) list option;
365
-
}
366
-
367
-
(** Upload response as per Section 6.1 *)
368
-
type upload_response = {
369
-
account_id: id;
370
-
blob_id: id;
371
-
type_: string;
372
-
size: unsigned_int;
373
-
}
374
-
375
-
(** Problem details object as per RFC7807 and Section 3.6.1 *)
376
-
type problem_details = {
377
-
type_: string;
378
-
status: int option;
379
-
detail: string option;
380
-
limit: string option; (* For "limit" error *)
381
-
}
382
-
end
383
-
384
-
(** Module for working with ResultReferences as described in Section 3.7 of RFC8620 *)
385
-
module ResultReference = struct
386
-
open Types
387
-
388
-
(** Create a reference to a previous method result *)
389
-
let create ~result_of ~name ~path =
390
-
{ result_of; name; path }
391
-
392
-
(** Create a JSON pointer path to access a specific property *)
393
-
let property_path property =
394
-
"/" ^ property
395
-
396
-
(** Create a JSON pointer path to access all items in an array with a specific property *)
397
-
let array_items_path ?(property="") array_property =
398
-
let base = "/" ^ array_property ^ "/*" in
399
-
if property = "" then base
400
-
else base ^ "/" ^ property
401
-
402
-
(** Create argument with result reference.
403
-
Returns string key prefixed with # and ResultReference value. *)
404
-
let reference_arg arg_name ref_obj =
405
-
(* Prefix argument name with # *)
406
-
let prefixed_name = "#" ^ arg_name in
407
-
408
-
(* Convert reference object to JSON *)
409
-
let json_value = `O [
410
-
("resultOf", `String ref_obj.result_of);
411
-
("name", `String ref_obj.name);
412
-
("path", `String ref_obj.path)
413
-
] in
414
-
415
-
(prefixed_name, json_value)
416
-
417
-
(** Create a reference to all IDs returned by a query method *)
418
-
let query_ids ~result_of =
419
-
create
420
-
~result_of
421
-
~name:"Foo/query"
422
-
~path:"/ids"
423
-
424
-
(** Create a reference to properties of objects returned by a get method *)
425
-
let get_property ~result_of ~property =
426
-
create
427
-
~result_of
428
-
~name:"Foo/get"
429
-
~path:("/list/*/" ^ property)
430
-
end
431
-
432
-
module Api = struct
433
-
open Lwt.Syntax
434
-
open Types
435
-
436
-
(** Error that may occur during API requests *)
437
-
type error =
438
-
| Connection_error of string
439
-
| HTTP_error of int * string
440
-
| Parse_error of string
441
-
| Authentication_error
442
-
443
-
(** Result type for API operations *)
444
-
type 'a result = ('a, error) Stdlib.result
445
-
446
-
(** Convert an error to a human-readable string *)
447
-
let string_of_error = function
448
-
| Connection_error msg -> "Connection error: " ^ msg
449
-
| HTTP_error (code, body) -> Printf.sprintf "HTTP error %d: %s" code body
450
-
| Parse_error msg -> "Parse error: " ^ msg
451
-
| Authentication_error -> "Authentication error"
452
-
453
-
(** Pretty-print an error to a formatter *)
454
-
let pp_error ppf err =
455
-
Format.fprintf ppf "%s" (string_of_error err)
456
-
457
-
(** Configuration for a JMAP API client *)
458
-
type config = {
459
-
api_uri: Uri.t;
460
-
username: string;
461
-
authentication_token: string;
462
-
}
463
-
464
-
(** Convert Ezjsonm.value to string *)
465
-
let json_to_string json =
466
-
Ezjsonm.value_to_string ~minify:false json
467
-
468
-
(** Parse response string as JSON value *)
469
-
let parse_json_string str =
470
-
try Ok (Ezjsonm.from_string str)
471
-
with e -> Error (Parse_error (Printexc.to_string e))
472
-
473
-
(** Parse JSON response as a JMAP response object *)
474
-
let parse_response json =
475
-
try
476
-
let method_responses =
477
-
match Ezjsonm.find json ["methodResponses"] with
478
-
| `A items ->
479
-
List.map (fun json ->
480
-
match json with
481
-
| `A [`String name; args; `String method_call_id] ->
482
-
{ name; arguments = args; method_call_id }
483
-
| _ -> raise (Invalid_argument "Invalid invocation format in response")
484
-
) items
485
-
| _ -> raise (Invalid_argument "methodResponses is not an array")
486
-
in
487
-
let created_ids_opt =
488
-
try
489
-
let obj = Ezjsonm.find json ["createdIds"] in
490
-
match obj with
491
-
| `O items -> Some (List.map (fun (k, v) ->
492
-
match v with
493
-
| `String id -> (k, id)
494
-
| _ -> raise (Invalid_argument "createdIds value is not a string")
495
-
) items)
496
-
| _ -> None
497
-
with Not_found -> None
498
-
in
499
-
let session_state =
500
-
match Ezjsonm.find json ["sessionState"] with
501
-
| `String s -> s
502
-
| _ -> raise (Invalid_argument "sessionState is not a string")
503
-
in
504
-
Ok { method_responses; created_ids = created_ids_opt; session_state }
505
-
with
506
-
| Not_found -> Error (Parse_error "Required field not found in response")
507
-
| Invalid_argument msg -> Error (Parse_error msg)
508
-
| e -> Error (Parse_error (Printexc.to_string e))
509
-
510
-
(** Serialize a JMAP request object to JSON *)
511
-
let serialize_request req =
512
-
let method_calls_json =
513
-
`A (List.map (fun (inv : 'a invocation) ->
514
-
`A [`String inv.name; inv.arguments; `String inv.method_call_id]
515
-
) req.method_calls)
516
-
in
517
-
let using_json = `A (List.map (fun s -> `String s) req.using) in
518
-
let json = `O [
519
-
("using", using_json);
520
-
("methodCalls", method_calls_json)
521
-
] in
522
-
let json = match req.created_ids with
523
-
| Some ids ->
524
-
let created_ids_json = `O (List.map (fun (k, v) -> (k, `String v)) ids) in
525
-
Ezjsonm.update json ["createdIds"] (Some created_ids_json)
526
-
| None -> json
527
-
in
528
-
json_to_string json
529
-
530
-
(** Make a raw HTTP request *)
531
-
let make_http_request ~method_ ~headers ~body uri =
532
-
let open Cohttp in
533
-
let open Cohttp_lwt_unix in
534
-
let headers = Header.add_list (Header.init ()) headers in
535
-
536
-
(* Print detailed request information to stderr for debugging *)
537
-
let header_list = Cohttp.Header.to_list headers in
538
-
let redacted_headers = redact_headers header_list in
539
-
Logs.info (fun m ->
540
-
m "\n===== HTTP REQUEST =====\n\
541
-
URI: %s\n\
542
-
METHOD: %s\n\
543
-
HEADERS:\n%s\n\
544
-
BODY:\n%s\n\
545
-
======================\n"
546
-
(Uri.to_string uri)
547
-
method_
548
-
(String.concat "\n" (List.map (fun (k, v) -> Printf.sprintf " %s: %s" k v) redacted_headers))
549
-
body);
550
-
551
-
(* Force printing to stderr for immediate debugging *)
552
-
Printf.eprintf "[DEBUG-REQUEST] URI: %s\n" (Uri.to_string uri);
553
-
Printf.eprintf "[DEBUG-REQUEST] METHOD: %s\n" method_;
554
-
Printf.eprintf "[DEBUG-REQUEST] BODY: %s\n%!" body;
555
-
556
-
Lwt.catch
557
-
(fun () ->
558
-
let* resp, body =
559
-
match method_ with
560
-
| "GET" -> Client.get ~headers uri
561
-
| "POST" -> Client.post ~headers ~body:(Cohttp_lwt.Body.of_string body) uri
562
-
| _ -> failwith (Printf.sprintf "Unsupported HTTP method: %s" method_)
563
-
in
564
-
let* body_str = Cohttp_lwt.Body.to_string body in
565
-
let status = Response.status resp |> Code.code_of_status in
566
-
567
-
(* Print detailed response information to stderr for debugging *)
568
-
let header_list = Cohttp.Header.to_list (Response.headers resp) in
569
-
let redacted_headers = redact_headers header_list in
570
-
Logs.info (fun m ->
571
-
m "\n===== HTTP RESPONSE =====\n\
572
-
STATUS: %d\n\
573
-
HEADERS:\n%s\n\
574
-
BODY:\n%s\n\
575
-
======================\n"
576
-
status
577
-
(String.concat "\n" (List.map (fun (k, v) -> Printf.sprintf " %s: %s" k v) redacted_headers))
578
-
body_str);
579
-
580
-
(* Force printing to stderr for immediate debugging *)
581
-
Printf.eprintf "[DEBUG-RESPONSE] STATUS: %d\n" status;
582
-
Printf.eprintf "[DEBUG-RESPONSE] BODY: %s\n%!" body_str;
583
-
584
-
if status >= 200 && status < 300 then
585
-
Lwt.return (Ok body_str)
586
-
else
587
-
Lwt.return (Error (HTTP_error (status, body_str))))
588
-
(fun e ->
589
-
let error_msg = Printexc.to_string e in
590
-
Printf.eprintf "[DEBUG-ERROR] %s\n%!" error_msg;
591
-
Logs.err (fun m -> m "%s" error_msg);
592
-
Lwt.return (Error (Connection_error error_msg)))
593
-
594
-
(** Make a raw JMAP API request
595
-
596
-
TODO:claude *)
597
-
let make_request config req =
598
-
let body = serialize_request req in
599
-
(* Choose appropriate authorization header based on whether it's a bearer token or basic auth *)
600
-
let auth_header =
601
-
if String.length config.username > 0 then
602
-
(* Standard username/password authentication *)
603
-
"Basic " ^ Base64.encode_string (config.username ^ ":" ^ config.authentication_token)
604
-
else
605
-
(* API token (bearer authentication) *)
606
-
"Bearer " ^ config.authentication_token
607
-
in
608
-
609
-
(* Log auth header at debug level with redaction *)
610
-
let redacted_header =
611
-
if String.length config.username > 0 then
612
-
"Basic " ^ redact_token (Base64.encode_string (config.username ^ ":" ^ config.authentication_token))
613
-
else
614
-
"Bearer " ^ redact_token config.authentication_token
615
-
in
616
-
Logs.debug (fun m -> m "Using authorization header: %s" redacted_header);
617
-
618
-
let headers = [
619
-
("Content-Type", "application/json");
620
-
("Content-Length", string_of_int (String.length body));
621
-
("Authorization", auth_header)
622
-
] in
623
-
let* result = make_http_request ~method_:"POST" ~headers ~body config.api_uri in
624
-
match result with
625
-
| Ok response_body ->
626
-
(match parse_json_string response_body with
627
-
| Ok json ->
628
-
Logs.debug (fun m -> m "Successfully parsed JSON response");
629
-
Lwt.return (parse_response json)
630
-
| Error e ->
631
-
let msg = match e with Parse_error m -> m | _ -> "unknown error" in
632
-
Logs.err (fun m -> m "Failed to parse response: %s" msg);
633
-
Lwt.return (Error e))
634
-
| Error e ->
635
-
(match e with
636
-
| Connection_error msg -> Logs.err (fun m -> m "Connection error: %s" msg)
637
-
| HTTP_error (code, _) -> Logs.err (fun m -> m "HTTP error %d" code)
638
-
| Parse_error msg -> Logs.err (fun m -> m "Parse error: %s" msg)
639
-
| Authentication_error -> Logs.err (fun m -> m "Authentication error"));
640
-
Lwt.return (Error e)
641
-
642
-
(** Parse a JSON object as a Session object *)
643
-
let parse_session_object json =
644
-
try
645
-
let capabilities =
646
-
match Ezjsonm.find json ["capabilities"] with
647
-
| `O items -> items
648
-
| _ -> raise (Invalid_argument "capabilities is not an object")
649
-
in
650
-
651
-
let accounts =
652
-
match Ezjsonm.find json ["accounts"] with
653
-
| `O items -> List.map (fun (id, json) ->
654
-
match json with
655
-
| `O _ ->
656
-
let name = Ezjsonm.get_string (Ezjsonm.find json ["name"]) in
657
-
let is_personal = Ezjsonm.get_bool (Ezjsonm.find json ["isPersonal"]) in
658
-
let is_read_only = Ezjsonm.get_bool (Ezjsonm.find json ["isReadOnly"]) in
659
-
let account_capabilities =
660
-
match Ezjsonm.find json ["accountCapabilities"] with
661
-
| `O items -> items
662
-
| _ -> raise (Invalid_argument "accountCapabilities is not an object")
663
-
in
664
-
(id, { name; is_personal; is_read_only; account_capabilities })
665
-
| _ -> raise (Invalid_argument "account value is not an object")
666
-
) items
667
-
| _ -> raise (Invalid_argument "accounts is not an object")
668
-
in
669
-
670
-
let primary_accounts =
671
-
match Ezjsonm.find_opt json ["primaryAccounts"] with
672
-
| Some (`O items) -> List.map (fun (k, v) ->
673
-
match v with
674
-
| `String id -> (k, id)
675
-
| _ -> raise (Invalid_argument "primaryAccounts value is not a string")
676
-
) items
677
-
| Some _ -> raise (Invalid_argument "primaryAccounts is not an object")
678
-
| None -> []
679
-
in
680
-
681
-
let username = Ezjsonm.get_string (Ezjsonm.find json ["username"]) in
682
-
let api_url = Ezjsonm.get_string (Ezjsonm.find json ["apiUrl"]) in
683
-
let download_url = Ezjsonm.get_string (Ezjsonm.find json ["downloadUrl"]) in
684
-
let upload_url = Ezjsonm.get_string (Ezjsonm.find json ["uploadUrl"]) in
685
-
let event_source_url =
686
-
try Some (Ezjsonm.get_string (Ezjsonm.find json ["eventSourceUrl"]))
687
-
with Not_found -> None
688
-
in
689
-
let state = Ezjsonm.get_string (Ezjsonm.find json ["state"]) in
690
-
691
-
Ok { capabilities; accounts; primary_accounts; username;
692
-
api_url; download_url; upload_url; event_source_url; state }
693
-
with
694
-
| Not_found -> Error (Parse_error "Required field not found in session object")
695
-
| Invalid_argument msg -> Error (Parse_error msg)
696
-
| e -> Error (Parse_error (Printexc.to_string e))
697
-
698
-
(** Fetch a Session object from a JMAP server
699
-
700
-
TODO:claude *)
701
-
let get_session uri ?username ?authentication_token ?api_token () =
702
-
let headers =
703
-
match (username, authentication_token, api_token) with
704
-
| (Some u, Some t, _) ->
705
-
let auth = "Basic " ^ Base64.encode_string (u ^ ":" ^ t) in
706
-
let redacted_auth = "Basic " ^ redact_token (Base64.encode_string (u ^ ":" ^ t)) in
707
-
Logs.info (fun m -> m "Session using Basic auth: %s" redacted_auth);
708
-
[
709
-
("Content-Type", "application/json");
710
-
("Authorization", auth)
711
-
]
712
-
| (_, _, Some token) ->
713
-
let auth = "Bearer " ^ token in
714
-
let redacted_token = redact_token token in
715
-
Logs.info (fun m -> m "Session using Bearer auth: %s" ("Bearer " ^ redacted_token));
716
-
[
717
-
("Content-Type", "application/json");
718
-
("Authorization", auth)
719
-
]
720
-
| _ -> [("Content-Type", "application/json")]
721
-
in
722
-
723
-
let* result = make_http_request ~method_:"GET" ~headers ~body:"" uri in
724
-
match result with
725
-
| Ok response_body ->
726
-
(match parse_json_string response_body with
727
-
| Ok json ->
728
-
Logs.debug (fun m -> m "Successfully parsed session response");
729
-
Lwt.return (parse_session_object json)
730
-
| Error e ->
731
-
let msg = match e with Parse_error m -> m | _ -> "unknown error" in
732
-
Logs.err (fun m -> m "Failed to parse session response: %s" msg);
733
-
Lwt.return (Error e))
734
-
| Error e ->
735
-
let err_msg = match e with
736
-
| Connection_error msg -> "Connection error: " ^ msg
737
-
| HTTP_error (code, _) -> Printf.sprintf "HTTP error %d" code
738
-
| Parse_error msg -> "Parse error: " ^ msg
739
-
| Authentication_error -> "Authentication error"
740
-
in
741
-
Logs.err (fun m -> m "Failed to get session: %s" err_msg);
742
-
Lwt.return (Error e)
743
-
744
-
(** Upload a binary blob to the server
745
-
746
-
TODO:claude *)
747
-
let upload_blob config ~account_id ~content_type data =
748
-
let upload_url_template = config.api_uri |> Uri.to_string in
749
-
(* Replace {accountId} with the actual account ID *)
750
-
let upload_url = Str.global_replace (Str.regexp "{accountId}") account_id upload_url_template in
751
-
let upload_uri = Uri.of_string upload_url in
752
-
753
-
let headers = [
754
-
("Content-Type", content_type);
755
-
("Content-Length", string_of_int (String.length data));
756
-
("Authorization", "Basic " ^ Base64.encode_string (config.username ^ ":" ^ config.authentication_token))
757
-
] in
758
-
759
-
let* result = make_http_request ~method_:"POST" ~headers ~body:data upload_uri in
760
-
match result with
761
-
| Ok response_body ->
762
-
(match parse_json_string response_body with
763
-
| Ok json ->
764
-
(try
765
-
let account_id = Ezjsonm.get_string (Ezjsonm.find json ["accountId"]) in
766
-
let blob_id = Ezjsonm.get_string (Ezjsonm.find json ["blobId"]) in
767
-
let type_ = Ezjsonm.get_string (Ezjsonm.find json ["type"]) in
768
-
let size = Ezjsonm.get_int (Ezjsonm.find json ["size"]) in
769
-
Lwt.return (Ok { account_id; blob_id; type_; size })
770
-
with
771
-
| Not_found -> Lwt.return (Error (Parse_error "Required field not found in upload response"))
772
-
| e -> Lwt.return (Error (Parse_error (Printexc.to_string e))))
773
-
| Error e -> Lwt.return (Error e))
774
-
| Error e -> Lwt.return (Error e)
775
-
776
-
(** Download a binary blob from the server
777
-
778
-
TODO:claude *)
779
-
let download_blob config ~account_id ~blob_id ?type_ ?name () =
780
-
let download_url_template = config.api_uri |> Uri.to_string in
781
-
782
-
(* Replace template variables with actual values *)
783
-
let url = Str.global_replace (Str.regexp "{accountId}") account_id download_url_template in
784
-
let url = Str.global_replace (Str.regexp "{blobId}") blob_id url in
785
-
786
-
let url = match type_ with
787
-
| Some t -> Str.global_replace (Str.regexp "{type}") (Uri.pct_encode t) url
788
-
| None -> Str.global_replace (Str.regexp "{type}") "" url
789
-
in
790
-
791
-
let url = match name with
792
-
| Some n -> Str.global_replace (Str.regexp "{name}") (Uri.pct_encode n) url
793
-
| None -> Str.global_replace (Str.regexp "{name}") "file" url
794
-
in
795
-
796
-
let download_uri = Uri.of_string url in
797
-
798
-
let headers = [
799
-
("Authorization", "Basic " ^ Base64.encode_string (config.username ^ ":" ^ config.authentication_token))
800
-
] in
801
-
802
-
let* result = make_http_request ~method_:"GET" ~headers ~body:"" download_uri in
803
-
Lwt.return result
804
-
end
-663
lib/jmap.mli
-663
lib/jmap.mli
···
1
-
(**
2
-
* JMAP protocol implementation based on RFC8620
3
-
* https://datatracker.ietf.org/doc/html/rfc8620
4
-
*
5
-
* This module implements the core JMAP protocol as defined in RFC8620, providing
6
-
* types and functions for making JMAP API requests and handling responses.
7
-
*)
8
-
9
-
(** Initialize and configure logging for JMAP
10
-
@param level Optional logging level (higher means more verbose)
11
-
@param enable_logs Whether to enable logging at all (default true)
12
-
@param redact_sensitive Whether to redact sensitive information like tokens (default true)
13
-
*)
14
-
val init_logging : ?level:int -> ?enable_logs:bool -> ?redact_sensitive:bool -> unit -> unit
15
-
16
-
(** Redact sensitive data like authentication tokens from logs
17
-
@param redact Whether to perform redaction (default true)
18
-
@param token The token string to redact
19
-
@return A redacted version of the token (with characters replaced by '*')
20
-
*)
21
-
val redact_token : ?redact:bool -> string -> string
22
-
23
-
(** Module for managing JMAP capability URIs and other constants
24
-
as defined in RFC8620 Section 1.8
25
-
@see <https://datatracker.ietf.org/doc/html/rfc8620#section-1.8> RFC8620 Section 1.8
26
-
*)
27
-
module Capability : sig
28
-
(** JMAP core capability URI as specified in RFC8620 Section 2
29
-
@see <https://datatracker.ietf.org/doc/html/rfc8620#section-2> RFC8620 Section 2
30
-
*)
31
-
val core_uri : string
32
-
33
-
(** All JMAP capability types as described in RFC8620 Section 1.8
34
-
@see <https://datatracker.ietf.org/doc/html/rfc8620#section-1.8> RFC8620 Section 1.8
35
-
*)
36
-
type t =
37
-
| Core (** Core JMAP capability *)
38
-
| Extension of string (** Extension capabilities with custom URIs *)
39
-
40
-
(** Convert capability to URI string
41
-
@param capability The capability to convert
42
-
@return The full URI string for the capability
43
-
*)
44
-
val to_string : t -> string
45
-
46
-
(** Parse a string to a capability, returns Extension for non-core capabilities
47
-
@param uri The capability URI string to parse
48
-
@return The parsed capability type
49
-
*)
50
-
val of_string : string -> t
51
-
52
-
(** Check if a capability matches the core capability
53
-
@param capability The capability to check
54
-
@return True if the capability is the core JMAP capability
55
-
@see <https://datatracker.ietf.org/doc/html/rfc8620#section-2>
56
-
*)
57
-
val is_core : t -> bool
58
-
59
-
(** Check if a capability string is the core capability URI
60
-
@param uri The capability URI string to check
61
-
@return True if the string represents the core JMAP capability
62
-
@see <https://datatracker.ietf.org/doc/html/rfc8620#section-2>
63
-
*)
64
-
val is_core_string : string -> bool
65
-
66
-
(** Create a list of capability URI strings
67
-
@param capabilities List of capability types
68
-
@return List of capability URI strings
69
-
*)
70
-
val strings_of_capabilities : t list -> string list
71
-
end
72
-
73
-
(** {1 Types}
74
-
Core types as defined in RFC8620
75
-
@see <https://datatracker.ietf.org/doc/html/rfc8620> RFC8620
76
-
*)
77
-
78
-
module Types : sig
79
-
(** Id string as defined in RFC8620 Section 1.2.
80
-
A string of at least 1 and maximum 255 octets, case-sensitive,
81
-
and does not begin with the '#' character.
82
-
@see <https://datatracker.ietf.org/doc/html/rfc8620#section-1.2>
83
-
*)
84
-
type id = string
85
-
86
-
(** Int type bounded within the range -2^53+1 to 2^53-1 as defined in RFC8620 Section 1.3.
87
-
Represented as JSON number where the value MUST be an integer and in the range.
88
-
@see <https://datatracker.ietf.org/doc/html/rfc8620#section-1.3>
89
-
*)
90
-
type int_t = int
91
-
92
-
(** UnsignedInt bounded within the range 0 to 2^53-1 as defined in RFC8620 Section 1.3.
93
-
Represented as JSON number where the value MUST be a non-negative integer and in the range.
94
-
@see <https://datatracker.ietf.org/doc/html/rfc8620#section-1.3>
95
-
*)
96
-
type unsigned_int = int
97
-
98
-
(** Date string in RFC3339 format as defined in RFC8620 Section 1.4.
99
-
Includes date, time and time zone offset information or UTC.
100
-
@see <https://datatracker.ietf.org/doc/html/rfc8620#section-1.4>
101
-
*)
102
-
type date = string
103
-
104
-
(** UTCDate is a Date with 'Z' time zone (UTC) as defined in RFC8620 Section 1.4.
105
-
Same format as Date type but always with UTC time zone (Z).
106
-
@see <https://datatracker.ietf.org/doc/html/rfc8620#section-1.4>
107
-
*)
108
-
type utc_date = string
109
-
110
-
(** Error object as defined in RFC8620 Section 3.6.2.
111
-
Used to represent standard error conditions in method responses.
112
-
@see <https://datatracker.ietf.org/doc/html/rfc8620#section-3.6.2>
113
-
*)
114
-
type error = {
115
-
type_: string; (** The type of error, e.g., "serverFail" *)
116
-
description: string option; (** Optional human-readable description of the error *)
117
-
}
118
-
119
-
(** Set error object as defined in RFC8620 Section 5.3.
120
-
Used for reporting errors in set operations.
121
-
@see <https://datatracker.ietf.org/doc/html/rfc8620#section-5.3>
122
-
*)
123
-
type set_error = {
124
-
type_: string; (** The type of error, e.g., "notFound" *)
125
-
description: string option; (** Optional human-readable description of the error *)
126
-
properties: string list option; (** Properties causing the error, if applicable *)
127
-
existing_id: id option; (** For "alreadyExists" error, the ID of the existing object *)
128
-
}
129
-
130
-
(** Invocation object as defined in RFC8620 Section 3.2.
131
-
Represents a method call in the JMAP protocol.
132
-
@see <https://datatracker.ietf.org/doc/html/rfc8620#section-3.2>
133
-
*)
134
-
type 'a invocation = {
135
-
name: string; (** The name of the method to call, e.g., "Mailbox/get" *)
136
-
arguments: 'a; (** The arguments for the method, type varies by method *)
137
-
method_call_id: string; (** Client-specified ID for referencing this call *)
138
-
}
139
-
140
-
(** ResultReference object as defined in RFC8620 Section 3.7.
141
-
Used to reference results from previous method calls.
142
-
@see <https://datatracker.ietf.org/doc/html/rfc8620#section-3.7>
143
-
*)
144
-
type result_reference = {
145
-
result_of: string; (** The method_call_id of the method to reference *)
146
-
name: string; (** Name of the response in the referenced result *)
147
-
path: string; (** JSON pointer path to the value being referenced *)
148
-
}
149
-
150
-
(** FilterOperator, FilterCondition and Filter as defined in RFC8620 Section 5.5.
151
-
Used for complex filtering in query methods.
152
-
@see <https://datatracker.ietf.org/doc/html/rfc8620#section-5.5>
153
-
*)
154
-
type filter_operator = {
155
-
operator: string; (** The operator: "AND", "OR", "NOT" *)
156
-
conditions: filter list; (** The conditions to apply the operator to *)
157
-
}
158
-
159
-
(** Property/value pairs for filtering *)
160
-
and filter_condition =
161
-
(string * Ezjsonm.value) list
162
-
163
-
and filter =
164
-
| Operator of filter_operator (** Logical operator combining conditions *)
165
-
| Condition of filter_condition (** Simple property-based condition *)
166
-
167
-
(** Comparator object for sorting as defined in RFC8620 Section 5.5.
168
-
Specifies how to sort query results.
169
-
@see <https://datatracker.ietf.org/doc/html/rfc8620#section-5.5>
170
-
*)
171
-
type comparator = {
172
-
property: string; (** The property to sort by *)
173
-
is_ascending: bool option; (** Sort order (true for ascending, false for descending) *)
174
-
collation: string option; (** Collation algorithm for string comparison *)
175
-
}
176
-
177
-
(** PatchObject as defined in RFC8620 Section 5.3.
178
-
Used to represent a set of updates to apply to an object.
179
-
@see <https://datatracker.ietf.org/doc/html/rfc8620#section-5.3>
180
-
*)
181
-
type patch_object = (string * Ezjsonm.value) list (** List of property/value pairs to update *)
182
-
183
-
(** AddedItem structure as defined in RFC8620 Section 5.6.
184
-
Represents an item added to a query result.
185
-
@see <https://datatracker.ietf.org/doc/html/rfc8620#section-5.6>
186
-
*)
187
-
type added_item = {
188
-
id: id; (** The ID of the added item *)
189
-
index: unsigned_int; (** The index in the result list where the item appears *)
190
-
}
191
-
192
-
(** Account object as defined in RFC8620 Section 1.6.2.
193
-
Represents a user account in JMAP.
194
-
@see <https://datatracker.ietf.org/doc/html/rfc8620#section-1.6.2>
195
-
*)
196
-
type account = {
197
-
name: string; (** User-friendly account name, e.g. "john@example.com" *)
198
-
is_personal: bool; (** Whether this account belongs to the authenticated user *)
199
-
is_read_only: bool; (** Whether this account can be modified *)
200
-
account_capabilities: (string * Ezjsonm.value) list; (** Capabilities available for this account *)
201
-
}
202
-
203
-
(** Core capability object as defined in RFC8620 Section 2.
204
-
Describes limits and features of the JMAP server.
205
-
@see <https://datatracker.ietf.org/doc/html/rfc8620#section-2>
206
-
*)
207
-
type core_capability = {
208
-
max_size_upload: unsigned_int; (** Maximum file size in octets for uploads *)
209
-
max_concurrent_upload: unsigned_int; (** Maximum number of concurrent uploads *)
210
-
max_size_request: unsigned_int; (** Maximum size in octets for a request *)
211
-
max_concurrent_requests: unsigned_int; (** Maximum number of concurrent requests *)
212
-
max_calls_in_request: unsigned_int; (** Maximum number of method calls in a request *)
213
-
max_objects_in_get: unsigned_int; (** Maximum number of objects in a get request *)
214
-
max_objects_in_set: unsigned_int; (** Maximum number of objects in a set request *)
215
-
collation_algorithms: string list; (** Supported string collation algorithms *)
216
-
}
217
-
218
-
(** PushSubscription keys object as defined in RFC8620 Section 7.2.
219
-
Contains encryption keys for web push subscriptions.
220
-
@see <https://datatracker.ietf.org/doc/html/rfc8620#section-7.2>
221
-
*)
222
-
type push_keys = {
223
-
p256dh: string; (** User agent public key (Base64url-encoded) *)
224
-
auth: string; (** Authentication secret (Base64url-encoded) *)
225
-
}
226
-
227
-
(** Session object as defined in RFC8620 Section 2.
228
-
Contains information about the server and user's accounts.
229
-
@see <https://datatracker.ietf.org/doc/html/rfc8620#section-2>
230
-
*)
231
-
type session = {
232
-
capabilities: (string * Ezjsonm.value) list; (** Server capabilities with their properties *)
233
-
accounts: (id * account) list; (** Map of account IDs to account objects *)
234
-
primary_accounts: (string * id) list; (** Map of capability URIs to primary account IDs *)
235
-
username: string; (** Username associated with this session *)
236
-
api_url: string; (** URL to use for JMAP API requests *)
237
-
download_url: string; (** URL endpoint to download files *)
238
-
upload_url: string; (** URL endpoint to upload files *)
239
-
event_source_url: string option; (** URL for Server-Sent Events notifications *)
240
-
state: string; (** String representing the state on the server *)
241
-
}
242
-
243
-
(** TypeState for state changes as defined in RFC8620 Section 7.1.
244
-
Maps data type names to the state string for that type.
245
-
@see <https://datatracker.ietf.org/doc/html/rfc8620#section-7.1>
246
-
*)
247
-
type type_state = (string * string) list (** (data type name, state string) pairs *)
248
-
249
-
(** StateChange object as defined in RFC8620 Section 7.1.
250
-
Represents changes to data types for different accounts.
251
-
@see <https://datatracker.ietf.org/doc/html/rfc8620#section-7.1>
252
-
*)
253
-
type state_change = {
254
-
changed: (id * type_state) list; (** Map of account IDs to type state changes *)
255
-
}
256
-
257
-
(** PushVerification object as defined in RFC8620 Section 7.2.2.
258
-
Used for verifying push subscription ownership.
259
-
@see <https://datatracker.ietf.org/doc/html/rfc8620#section-7.2.2>
260
-
*)
261
-
type push_verification = {
262
-
push_subscription_id: id; (** ID of the push subscription being verified *)
263
-
verification_code: string; (** Code the client must submit to verify ownership *)
264
-
}
265
-
266
-
(** PushSubscription object as defined in RFC8620 Section 7.2.
267
-
Represents a subscription for push notifications.
268
-
@see <https://datatracker.ietf.org/doc/html/rfc8620#section-7.2>
269
-
*)
270
-
type push_subscription = {
271
-
id: id; (** Server-assigned ID for the subscription *)
272
-
device_client_id: string; (** ID representing the client/device *)
273
-
url: string; (** URL to which events are pushed *)
274
-
keys: push_keys option; (** Encryption keys for web push, if any *)
275
-
verification_code: string option; (** Verification code if not yet verified *)
276
-
expires: utc_date option; (** When the subscription expires, if applicable *)
277
-
types: string list option; (** Types of changes to push, null means all *)
278
-
}
279
-
280
-
(** Request object as defined in RFC8620 Section 3.3.
281
-
Represents a JMAP request from client to server.
282
-
@see <https://datatracker.ietf.org/doc/html/rfc8620#section-3.3>
283
-
*)
284
-
type request = {
285
-
using: string list; (** Capabilities required for this request *)
286
-
method_calls: Ezjsonm.value invocation list; (** List of method calls to process *)
287
-
created_ids: (id * id) list option; (** Map of client-created IDs to server IDs *)
288
-
}
289
-
290
-
(** Response object as defined in RFC8620 Section 3.4.
291
-
Represents a JMAP response from server to client.
292
-
@see <https://datatracker.ietf.org/doc/html/rfc8620#section-3.4>
293
-
*)
294
-
type response = {
295
-
method_responses: Ezjsonm.value invocation list; (** List of method responses *)
296
-
created_ids: (id * id) list option; (** Map of client-created IDs to server IDs *)
297
-
session_state: string; (** Current session state on the server *)
298
-
}
299
-
300
-
(** {2 Standard method arguments and responses}
301
-
Standard method patterns defined in RFC8620 Section 5
302
-
@see <https://datatracker.ietf.org/doc/html/rfc8620#section-5>
303
-
*)
304
-
305
-
(** Arguments for Foo/get method as defined in RFC8620 Section 5.1.
306
-
Generic template for retrieving objects by ID.
307
-
@see <https://datatracker.ietf.org/doc/html/rfc8620#section-5.1>
308
-
*)
309
-
type 'a get_arguments = {
310
-
account_id: id; (** The account ID to operate on *)
311
-
ids: id list option; (** IDs to fetch, null means all *)
312
-
properties: string list option; (** Properties to return, null means all *)
313
-
}
314
-
315
-
(** Response for Foo/get method as defined in RFC8620 Section 5.1.
316
-
Generic template for returning requested objects.
317
-
@see <https://datatracker.ietf.org/doc/html/rfc8620#section-5.1>
318
-
*)
319
-
type 'a get_response = {
320
-
account_id: id; (** The account ID that was operated on *)
321
-
state: string; (** Server state for the type at the time of processing *)
322
-
list: 'a list; (** The list of requested objects *)
323
-
not_found: id list; (** IDs that could not be found *)
324
-
}
325
-
326
-
(** Arguments for Foo/changes method as defined in RFC8620 Section 5.2.
327
-
Generic template for getting state changes.
328
-
@see <https://datatracker.ietf.org/doc/html/rfc8620#section-5.2>
329
-
*)
330
-
type changes_arguments = {
331
-
account_id: id; (** The account ID to operate on *)
332
-
since_state: string; (** The last state seen by the client *)
333
-
max_changes: unsigned_int option; (** Maximum number of changes to return *)
334
-
}
335
-
336
-
(** Response for Foo/changes method as defined in RFC8620 Section 5.2.
337
-
Generic template for returning object changes.
338
-
@see <https://datatracker.ietf.org/doc/html/rfc8620#section-5.2>
339
-
*)
340
-
type changes_response = {
341
-
account_id: id; (** The account ID that was operated on *)
342
-
old_state: string; (** The state provided in the request *)
343
-
new_state: string; (** The current server state *)
344
-
has_more_changes: bool; (** True if more changes are available *)
345
-
created: id list; (** IDs of objects created since old_state *)
346
-
updated: id list; (** IDs of objects updated since old_state *)
347
-
destroyed: id list; (** IDs of objects destroyed since old_state *)
348
-
}
349
-
350
-
(** Arguments for Foo/set method as defined in RFC8620 Section 5.3.
351
-
Generic template for creating, updating, and destroying objects.
352
-
@see <https://datatracker.ietf.org/doc/html/rfc8620#section-5.3>
353
-
*)
354
-
type 'a set_arguments = {
355
-
account_id: id; (** The account ID to operate on *)
356
-
if_in_state: string option; (** Only apply changes if in this state *)
357
-
create: (id * 'a) list option; (** Map of creation IDs to objects to create *)
358
-
update: (id * patch_object) list option; (** Map of IDs to patches to apply *)
359
-
destroy: id list option; (** List of IDs to destroy *)
360
-
}
361
-
362
-
(** Response for Foo/set method as defined in RFC8620 Section 5.3.
363
-
Generic template for reporting create/update/destroy status.
364
-
@see <https://datatracker.ietf.org/doc/html/rfc8620#section-5.3>
365
-
*)
366
-
type 'a set_response = {
367
-
account_id: id; (** The account ID that was operated on *)
368
-
old_state: string option; (** The state before processing, if changed *)
369
-
new_state: string; (** The current server state *)
370
-
created: (id * 'a) list option; (** Map of creation IDs to created objects *)
371
-
updated: (id * 'a option) list option; (** Map of IDs to updated objects *)
372
-
destroyed: id list option; (** List of IDs successfully destroyed *)
373
-
not_created: (id * set_error) list option; (** Map of IDs to errors for failed creates *)
374
-
not_updated: (id * set_error) list option; (** Map of IDs to errors for failed updates *)
375
-
not_destroyed: (id * set_error) list option; (** Map of IDs to errors for failed destroys *)
376
-
}
377
-
378
-
(** Arguments for Foo/copy method as defined in RFC8620 Section 5.4.
379
-
Generic template for copying objects between accounts.
380
-
@see <https://datatracker.ietf.org/doc/html/rfc8620#section-5.4>
381
-
*)
382
-
type 'a copy_arguments = {
383
-
from_account_id: id; (** The account ID to copy from *)
384
-
if_from_in_state: string option; (** Only copy if source account in this state *)
385
-
account_id: id; (** The account ID to copy to *)
386
-
if_in_state: string option; (** Only copy if destination account in this state *)
387
-
create: (id * 'a) list; (** Map of creation IDs to objects to copy *)
388
-
on_success_destroy_original: bool option; (** Whether to destroy the original after copying *)
389
-
destroy_from_if_in_state: string option; (** Only destroy originals if in this state *)
390
-
}
391
-
392
-
(** Response for Foo/copy method as defined in RFC8620 Section 5.4.
393
-
Generic template for reporting copy operation status.
394
-
@see <https://datatracker.ietf.org/doc/html/rfc8620#section-5.4>
395
-
*)
396
-
type 'a copy_response = {
397
-
from_account_id: id; (** The account ID that was copied from *)
398
-
account_id: id; (** The account ID that was copied to *)
399
-
old_state: string option; (** The state before processing, if changed *)
400
-
new_state: string; (** The current server state *)
401
-
created: (id * 'a) list option; (** Map of creation IDs to created objects *)
402
-
not_created: (id * set_error) list option; (** Map of IDs to errors for failed copies *)
403
-
}
404
-
405
-
(** Arguments for Foo/query method as defined in RFC8620 Section 5.5.
406
-
Generic template for querying objects.
407
-
@see <https://datatracker.ietf.org/doc/html/rfc8620#section-5.5>
408
-
*)
409
-
type query_arguments = {
410
-
account_id: id; (** The account ID to operate on *)
411
-
filter: filter option; (** Filter to determine which objects are returned *)
412
-
sort: comparator list option; (** Sort order for returned objects *)
413
-
position: int_t option; (** Zero-based index of first result to return *)
414
-
anchor: id option; (** ID of object to use as reference point *)
415
-
anchor_offset: int_t option; (** Offset from anchor to start returning results *)
416
-
limit: unsigned_int option; (** Maximum number of results to return *)
417
-
calculate_total: bool option; (** Whether to calculate the total number of matching objects *)
418
-
}
419
-
420
-
(** Response for Foo/query method as defined in RFC8620 Section 5.5.
421
-
Generic template for returning query results.
422
-
@see <https://datatracker.ietf.org/doc/html/rfc8620#section-5.5>
423
-
*)
424
-
type query_response = {
425
-
account_id: id; (** The account ID that was operated on *)
426
-
query_state: string; (** State string for the query results *)
427
-
can_calculate_changes: bool; (** Whether queryChanges can be used with these results *)
428
-
position: unsigned_int; (** Zero-based index of the first result *)
429
-
ids: id list; (** The list of IDs for objects matching the query *)
430
-
total: unsigned_int option; (** Total number of matching objects, if calculated *)
431
-
limit: unsigned_int option; (** Limit enforced on the results, if requested *)
432
-
}
433
-
434
-
(** Arguments for Foo/queryChanges method as defined in RFC8620 Section 5.6.
435
-
Generic template for getting query result changes.
436
-
@see <https://datatracker.ietf.org/doc/html/rfc8620#section-5.6>
437
-
*)
438
-
type query_changes_arguments = {
439
-
account_id: id; (** The account ID to operate on *)
440
-
filter: filter option; (** Same filter as used in the original query *)
441
-
sort: comparator list option; (** Same sort as used in the original query *)
442
-
since_query_state: string; (** The query_state from previous results *)
443
-
max_changes: unsigned_int option; (** Maximum number of changes to return *)
444
-
up_to_id: id option; (** Only calculate changes until this ID is encountered *)
445
-
calculate_total: bool option; (** Whether to recalculate the total matches *)
446
-
}
447
-
448
-
(** Response for Foo/queryChanges method as defined in RFC8620 Section 5.6.
449
-
Generic template for returning query result changes.
450
-
@see <https://datatracker.ietf.org/doc/html/rfc8620#section-5.6>
451
-
*)
452
-
type query_changes_response = {
453
-
account_id: id; (** The account ID that was operated on *)
454
-
old_query_state: string; (** The query_state from the request *)
455
-
new_query_state: string; (** The current query_state on the server *)
456
-
total: unsigned_int option; (** Updated total number of matches, if calculated *)
457
-
removed: id list; (** IDs that were in the old results but not in the new *)
458
-
added: added_item list option; (** IDs that are in the new results but not the old *)
459
-
}
460
-
461
-
(** Arguments for Blob/copy method as defined in RFC8620 Section 6.3.
462
-
Used for copying binary data between accounts.
463
-
@see <https://datatracker.ietf.org/doc/html/rfc8620#section-6.3>
464
-
*)
465
-
type blob_copy_arguments = {
466
-
from_account_id: id; (** The account ID to copy blobs from *)
467
-
account_id: id; (** The account ID to copy blobs to *)
468
-
blob_ids: id list; (** IDs of blobs to copy *)
469
-
}
470
-
471
-
(** Response for Blob/copy method as defined in RFC8620 Section 6.3.
472
-
Reports the results of copying binary data.
473
-
@see <https://datatracker.ietf.org/doc/html/rfc8620#section-6.3>
474
-
*)
475
-
type blob_copy_response = {
476
-
from_account_id: id; (** The account ID that was copied from *)
477
-
account_id: id; (** The account ID that was copied to *)
478
-
copied: (id * id) list option; (** Map of source IDs to destination IDs *)
479
-
not_copied: (id * set_error) list option; (** Map of IDs to errors for failed copies *)
480
-
}
481
-
482
-
(** Upload response as defined in RFC8620 Section 6.1.
483
-
Contains information about an uploaded binary blob.
484
-
@see <https://datatracker.ietf.org/doc/html/rfc8620#section-6.1>
485
-
*)
486
-
type upload_response = {
487
-
account_id: id; (** The account ID the blob was uploaded to *)
488
-
blob_id: id; (** The ID for the uploaded blob *)
489
-
type_: string; (** Media type of the blob *)
490
-
size: unsigned_int; (** Size of the blob in octets *)
491
-
}
492
-
493
-
(** Problem details object as defined in RFC8620 Section 3.6.1 and RFC7807.
494
-
Used for HTTP error responses in the JMAP protocol.
495
-
@see <https://datatracker.ietf.org/doc/html/rfc8620#section-3.6.1>
496
-
@see <https://datatracker.ietf.org/doc/html/rfc7807>
497
-
*)
498
-
type problem_details = {
499
-
type_: string; (** URI that identifies the problem type *)
500
-
status: int option; (** HTTP status code for this problem *)
501
-
detail: string option; (** Human-readable explanation of the problem *)
502
-
limit: string option; (** For "limit" errors, which limit was exceeded *)
503
-
}
504
-
end
505
-
506
-
(** {1 API Client}
507
-
Modules for interacting with JMAP servers
508
-
*)
509
-
510
-
(** Module for working with ResultReferences as described in Section 3.7 of RFC8620.
511
-
Provides utilities to create and compose results from previous methods.
512
-
@see <https://datatracker.ietf.org/doc/html/rfc8620#section-3.7>
513
-
*)
514
-
module ResultReference : sig
515
-
(** Create a reference to a previous method result
516
-
@param result_of The methodCallId of the method call to reference
517
-
@param name The name in the response to reference (e.g., "list")
518
-
@param path JSON pointer path to the value being referenced
519
-
@return A result_reference object
520
-
@see <https://datatracker.ietf.org/doc/html/rfc8620#section-3.7>
521
-
*)
522
-
val create :
523
-
result_of:string ->
524
-
name:string ->
525
-
path:string ->
526
-
Types.result_reference
527
-
528
-
(** Create a JSON pointer path to access a specific property
529
-
@param property The property name to access
530
-
@return A JSON pointer path string
531
-
*)
532
-
val property_path : string -> string
533
-
534
-
(** Create a JSON pointer path to access all items in an array with a specific property
535
-
@param property Optional property to access within each array item
536
-
@param array_name The name of the array to access
537
-
@return A JSON pointer path string that references all items in the array
538
-
*)
539
-
val array_items_path : ?property:string -> string -> string
540
-
541
-
(** Create argument with result reference.
542
-
@param arg_name The name of the argument
543
-
@param reference The result reference to use
544
-
@return A tuple of string key (with # prefix) and ResultReference JSON value
545
-
*)
546
-
val reference_arg : string -> Types.result_reference -> string * Ezjsonm.value
547
-
548
-
(** Create a reference to all IDs returned by a query method
549
-
@param result_of The methodCallId of the query method call
550
-
@return A result_reference to the IDs returned by the query
551
-
*)
552
-
val query_ids :
553
-
result_of:string ->
554
-
Types.result_reference
555
-
556
-
(** Create a reference to properties of objects returned by a get method
557
-
@param result_of The methodCallId of the get method call
558
-
@param property The property to reference in the returned objects
559
-
@return A result_reference to the specified property in the get results
560
-
*)
561
-
val get_property :
562
-
result_of:string ->
563
-
property:string ->
564
-
Types.result_reference
565
-
end
566
-
567
-
(** Module for making JMAP API requests over HTTP.
568
-
Provides functionality to interact with JMAP servers according to RFC8620.
569
-
@see <https://datatracker.ietf.org/doc/html/rfc8620>
570
-
*)
571
-
module Api : sig
572
-
(** Error that may occur during API requests *)
573
-
type error =
574
-
| Connection_error of string (** Network-related errors *)
575
-
| HTTP_error of int * string (** HTTP errors with status code and message *)
576
-
| Parse_error of string (** JSON parsing errors *)
577
-
| Authentication_error (** Authentication failures *)
578
-
579
-
(** Result type for API operations *)
580
-
type 'a result = ('a, error) Stdlib.result
581
-
582
-
(** Convert an error to a human-readable string
583
-
@param err The error to convert
584
-
@return A string representation of the error
585
-
*)
586
-
val string_of_error : error -> string
587
-
588
-
(** Pretty-print an error to a formatter
589
-
@param ppf The formatter to print to
590
-
@param err The error to print
591
-
*)
592
-
val pp_error : Format.formatter -> error -> unit
593
-
594
-
(** Configuration for a JMAP API client as defined in RFC8620 Section 3.1
595
-
@see <https://datatracker.ietf.org/doc/html/rfc8620#section-3.1>
596
-
*)
597
-
type config = {
598
-
api_uri: Uri.t; (** The JMAP API endpoint URI *)
599
-
username: string; (** The username for authentication *)
600
-
authentication_token: string; (** The token for authentication *)
601
-
}
602
-
603
-
(** Make a raw JMAP API request as defined in RFC8620 Section 3.3
604
-
@param config The API client configuration
605
-
@param request The JMAP request to send
606
-
@return A result containing the JMAP response or an error
607
-
@see <https://datatracker.ietf.org/doc/html/rfc8620#section-3.3>
608
-
*)
609
-
val make_request :
610
-
config ->
611
-
Types.request ->
612
-
Types.response result Lwt.t
613
-
614
-
(** Fetch a Session object from a JMAP server as defined in RFC8620 Section 2
615
-
Can authenticate with either username/password or API token.
616
-
@param uri The URI of the JMAP session resource
617
-
@param username Optional username for authentication
618
-
@param authentication_token Optional password or token for authentication
619
-
@param api_token Optional API token for Bearer authentication
620
-
@return A result containing the session object or an error
621
-
@see <https://datatracker.ietf.org/doc/html/rfc8620#section-2>
622
-
*)
623
-
val get_session :
624
-
Uri.t ->
625
-
?username:string ->
626
-
?authentication_token:string ->
627
-
?api_token:string ->
628
-
unit ->
629
-
Types.session result Lwt.t
630
-
631
-
(** Upload a binary blob to the server as defined in RFC8620 Section 6.1
632
-
@param config The API client configuration
633
-
@param account_id The account ID to upload to
634
-
@param content_type The MIME type of the blob
635
-
@param data The blob data as a string
636
-
@return A result containing the upload response or an error
637
-
@see <https://datatracker.ietf.org/doc/html/rfc8620#section-6.1>
638
-
*)
639
-
val upload_blob :
640
-
config ->
641
-
account_id:Types.id ->
642
-
content_type:string ->
643
-
string ->
644
-
Types.upload_response result Lwt.t
645
-
646
-
(** Download a binary blob from the server as defined in RFC8620 Section 6.2
647
-
@param config The API client configuration
648
-
@param account_id The account ID that contains the blob
649
-
@param blob_id The ID of the blob to download
650
-
@param type_ Optional MIME type to require for the blob
651
-
@param name Optional name for the downloaded blob
652
-
@return A result containing the blob data as a string or an error
653
-
@see <https://datatracker.ietf.org/doc/html/rfc8620#section-6.2>
654
-
*)
655
-
val download_blob :
656
-
config ->
657
-
account_id:Types.id ->
658
-
blob_id:Types.id ->
659
-
?type_:string ->
660
-
?name:string ->
661
-
unit ->
662
-
string result Lwt.t
663
-
end
-2828
lib/jmap_mail.ml
-2828
lib/jmap_mail.ml
···
1
-
(** Implementation of the JMAP Mail extension, as defined in RFC8621 *)
2
-
3
-
(** Module for managing JMAP Mail-specific capability URIs *)
4
-
module Capability = struct
5
-
(** Mail capability URI *)
6
-
let mail_uri = "urn:ietf:params:jmap:mail"
7
-
8
-
(** Submission capability URI *)
9
-
let submission_uri = "urn:ietf:params:jmap:submission"
10
-
11
-
(** Vacation response capability URI *)
12
-
let vacation_response_uri = "urn:ietf:params:jmap:vacationresponse"
13
-
14
-
(** All mail extension capability types *)
15
-
type t =
16
-
| Mail (** Mail capability *)
17
-
| Submission (** Submission capability *)
18
-
| VacationResponse (** Vacation response capability *)
19
-
| Extension of string (** Custom extension *)
20
-
21
-
(** Convert capability to URI string *)
22
-
let to_string = function
23
-
| Mail -> mail_uri
24
-
| Submission -> submission_uri
25
-
| VacationResponse -> vacation_response_uri
26
-
| Extension s -> s
27
-
28
-
(** Parse a string to a capability *)
29
-
let of_string s =
30
-
if s = mail_uri then Mail
31
-
else if s = submission_uri then Submission
32
-
else if s = vacation_response_uri then VacationResponse
33
-
else Extension s
34
-
35
-
(** Check if a capability is a standard mail capability *)
36
-
let is_standard = function
37
-
| Mail | Submission | VacationResponse -> true
38
-
| Extension _ -> false
39
-
40
-
(** Check if a capability string is a standard mail capability *)
41
-
let is_standard_string s =
42
-
s = mail_uri || s = submission_uri || s = vacation_response_uri
43
-
44
-
(** Create a list of capability strings *)
45
-
let strings_of_capabilities capabilities =
46
-
List.map to_string capabilities
47
-
end
48
-
49
-
module Types = struct
50
-
open Jmap.Types
51
-
52
-
(** {1 Mail capabilities} *)
53
-
54
-
(** Capability URI for JMAP Mail*)
55
-
let capability_mail = Capability.mail_uri
56
-
57
-
(** Capability URI for JMAP Submission *)
58
-
let capability_submission = Capability.submission_uri
59
-
60
-
(** Capability URI for JMAP Vacation Response *)
61
-
let capability_vacation_response = Capability.vacation_response_uri
62
-
63
-
(** {1:mailbox Mailbox objects} *)
64
-
65
-
(** A role for a mailbox. See RFC8621 Section 2. *)
66
-
type mailbox_role =
67
-
| All (** All mail *)
68
-
| Archive (** Archived mail *)
69
-
| Drafts (** Draft messages *)
70
-
| Flagged (** Starred/flagged mail *)
71
-
| Important (** Important mail *)
72
-
| Inbox (** Inbox *)
73
-
| Junk (** Spam/Junk mail *)
74
-
| Sent (** Sent mail *)
75
-
| Trash (** Deleted/Trash mail *)
76
-
| Unknown of string (** Server-specific roles *)
77
-
78
-
(** A mailbox (folder) in a mail account. See RFC8621 Section 2. *)
79
-
type mailbox = {
80
-
id : id;
81
-
name : string;
82
-
parent_id : id option;
83
-
role : mailbox_role option;
84
-
sort_order : unsigned_int;
85
-
total_emails : unsigned_int;
86
-
unread_emails : unsigned_int;
87
-
total_threads : unsigned_int;
88
-
unread_threads : unsigned_int;
89
-
is_subscribed : bool;
90
-
my_rights : mailbox_rights;
91
-
}
92
-
93
-
(** Rights for a mailbox. See RFC8621 Section 2. *)
94
-
and mailbox_rights = {
95
-
may_read_items : bool;
96
-
may_add_items : bool;
97
-
may_remove_items : bool;
98
-
may_set_seen : bool;
99
-
may_set_keywords : bool;
100
-
may_create_child : bool;
101
-
may_rename : bool;
102
-
may_delete : bool;
103
-
may_submit : bool;
104
-
}
105
-
106
-
(** Filter condition for mailbox queries. See RFC8621 Section 2.3. *)
107
-
type mailbox_filter_condition = {
108
-
parent_id : id option;
109
-
name : string option;
110
-
role : string option;
111
-
has_any_role : bool option;
112
-
is_subscribed : bool option;
113
-
}
114
-
115
-
type mailbox_query_filter = [
116
-
| `And of mailbox_query_filter list
117
-
| `Or of mailbox_query_filter list
118
-
| `Not of mailbox_query_filter
119
-
| `Condition of mailbox_filter_condition
120
-
]
121
-
122
-
(** Mailbox/get request arguments. See RFC8621 Section 2.1. *)
123
-
type mailbox_get_arguments = {
124
-
account_id : id;
125
-
ids : id list option;
126
-
properties : string list option;
127
-
}
128
-
129
-
(** Mailbox/get response. See RFC8621 Section 2.1. *)
130
-
type mailbox_get_response = {
131
-
account_id : id;
132
-
state : string;
133
-
list : mailbox list;
134
-
not_found : id list;
135
-
}
136
-
137
-
(** Mailbox/changes request arguments. See RFC8621 Section 2.2. *)
138
-
type mailbox_changes_arguments = {
139
-
account_id : id;
140
-
since_state : string;
141
-
max_changes : unsigned_int option;
142
-
}
143
-
144
-
(** Mailbox/changes response. See RFC8621 Section 2.2. *)
145
-
type mailbox_changes_response = {
146
-
account_id : id;
147
-
old_state : string;
148
-
new_state : string;
149
-
has_more_changes : bool;
150
-
created : id list;
151
-
updated : id list;
152
-
destroyed : id list;
153
-
}
154
-
155
-
(** Mailbox/query request arguments. See RFC8621 Section 2.3. *)
156
-
type mailbox_query_arguments = {
157
-
account_id : id;
158
-
filter : mailbox_query_filter option;
159
-
sort : [ `name | `role | `sort_order ] list option;
160
-
limit : unsigned_int option;
161
-
}
162
-
163
-
(** Mailbox/query response. See RFC8621 Section 2.3. *)
164
-
type mailbox_query_response = {
165
-
account_id : id;
166
-
query_state : string;
167
-
can_calculate_changes : bool;
168
-
position : unsigned_int;
169
-
ids : id list;
170
-
total : unsigned_int option;
171
-
}
172
-
173
-
(** Mailbox/queryChanges request arguments. See RFC8621 Section 2.4. *)
174
-
type mailbox_query_changes_arguments = {
175
-
account_id : id;
176
-
filter : mailbox_query_filter option;
177
-
sort : [ `name | `role | `sort_order ] list option;
178
-
since_query_state : string;
179
-
max_changes : unsigned_int option;
180
-
up_to_id : id option;
181
-
}
182
-
183
-
(** Mailbox/queryChanges response. See RFC8621 Section 2.4. *)
184
-
type mailbox_query_changes_response = {
185
-
account_id : id;
186
-
old_query_state : string;
187
-
new_query_state : string;
188
-
total : unsigned_int option;
189
-
removed : id list;
190
-
added : mailbox_query_changes_added list;
191
-
}
192
-
193
-
and mailbox_query_changes_added = {
194
-
id : id;
195
-
index : unsigned_int;
196
-
}
197
-
198
-
(** Mailbox/set request arguments. See RFC8621 Section 2.5. *)
199
-
type mailbox_set_arguments = {
200
-
account_id : id;
201
-
if_in_state : string option;
202
-
create : (id * mailbox_creation) list option;
203
-
update : (id * mailbox_update) list option;
204
-
destroy : id list option;
205
-
}
206
-
207
-
and mailbox_creation = {
208
-
name : string;
209
-
parent_id : id option;
210
-
role : string option;
211
-
sort_order : unsigned_int option;
212
-
is_subscribed : bool option;
213
-
}
214
-
215
-
and mailbox_update = {
216
-
name : string option;
217
-
parent_id : id option;
218
-
role : string option;
219
-
sort_order : unsigned_int option;
220
-
is_subscribed : bool option;
221
-
}
222
-
223
-
(** Mailbox/set response. See RFC8621 Section 2.5. *)
224
-
type mailbox_set_response = {
225
-
account_id : id;
226
-
old_state : string option;
227
-
new_state : string;
228
-
created : (id * mailbox) list option;
229
-
updated : id list option;
230
-
destroyed : id list option;
231
-
not_created : (id * set_error) list option;
232
-
not_updated : (id * set_error) list option;
233
-
not_destroyed : (id * set_error) list option;
234
-
}
235
-
236
-
(** {1:thread Thread objects} *)
237
-
238
-
(** A thread in a mail account. See RFC8621 Section 3. *)
239
-
type thread = {
240
-
id : id;
241
-
email_ids : id list;
242
-
}
243
-
244
-
(** Thread/get request arguments. See RFC8621 Section 3.1. *)
245
-
type thread_get_arguments = {
246
-
account_id : id;
247
-
ids : id list option;
248
-
properties : string list option;
249
-
}
250
-
251
-
(** Thread/get response. See RFC8621 Section 3.1. *)
252
-
type thread_get_response = {
253
-
account_id : id;
254
-
state : string;
255
-
list : thread list;
256
-
not_found : id list;
257
-
}
258
-
259
-
(** Thread/changes request arguments. See RFC8621 Section 3.2. *)
260
-
type thread_changes_arguments = {
261
-
account_id : id;
262
-
since_state : string;
263
-
max_changes : unsigned_int option;
264
-
}
265
-
266
-
(** Thread/changes response. See RFC8621 Section 3.2. *)
267
-
type thread_changes_response = {
268
-
account_id : id;
269
-
old_state : string;
270
-
new_state : string;
271
-
has_more_changes : bool;
272
-
created : id list;
273
-
updated : id list;
274
-
destroyed : id list;
275
-
}
276
-
277
-
(** {1:email Email objects} *)
278
-
279
-
(** Addressing (mailbox) information. See RFC8621 Section 4.1.1. *)
280
-
type email_address = {
281
-
name : string option;
282
-
email : string;
283
-
parameters : (string * string) list;
284
-
}
285
-
286
-
(** Message header field. See RFC8621 Section 4.1.2. *)
287
-
type header = {
288
-
name : string;
289
-
value : string;
290
-
}
291
-
292
-
(** Email keyword (flag). See RFC8621 Section 4.3. *)
293
-
type keyword =
294
-
| Flagged
295
-
| Answered
296
-
| Draft
297
-
| Forwarded
298
-
| Phishing
299
-
| Junk
300
-
| NotJunk
301
-
| Seen
302
-
| Unread
303
-
| Custom of string
304
-
305
-
(** Email message. See RFC8621 Section 4. *)
306
-
type email = {
307
-
id : id;
308
-
blob_id : id;
309
-
thread_id : id;
310
-
mailbox_ids : (id * bool) list;
311
-
keywords : (keyword * bool) list;
312
-
size : unsigned_int;
313
-
received_at : utc_date;
314
-
message_id : string list;
315
-
in_reply_to : string list option;
316
-
references : string list option;
317
-
sender : email_address list option;
318
-
from : email_address list option;
319
-
to_ : email_address list option;
320
-
cc : email_address list option;
321
-
bcc : email_address list option;
322
-
reply_to : email_address list option;
323
-
subject : string option;
324
-
sent_at : utc_date option;
325
-
has_attachment : bool option;
326
-
preview : string option;
327
-
body_values : (string * string) list option;
328
-
text_body : email_body_part list option;
329
-
html_body : email_body_part list option;
330
-
attachments : email_body_part list option;
331
-
headers : header list option;
332
-
}
333
-
334
-
(** Email body part. See RFC8621 Section 4.1.4. *)
335
-
and email_body_part = {
336
-
part_id : string option;
337
-
blob_id : id option;
338
-
size : unsigned_int option;
339
-
headers : header list option;
340
-
name : string option;
341
-
type_ : string option;
342
-
charset : string option;
343
-
disposition : string option;
344
-
cid : string option;
345
-
language : string list option;
346
-
location : string option;
347
-
sub_parts : email_body_part list option;
348
-
header_parameter_name : string option;
349
-
header_parameter_value : string option;
350
-
}
351
-
352
-
(** Email query filter condition. See RFC8621 Section 4.4. *)
353
-
type email_filter_condition = {
354
-
in_mailbox : id option;
355
-
in_mailbox_other_than : id list option;
356
-
min_size : unsigned_int option;
357
-
max_size : unsigned_int option;
358
-
before : utc_date option;
359
-
after : utc_date option;
360
-
header : (string * string) option;
361
-
from : string option;
362
-
to_ : string option;
363
-
cc : string option;
364
-
bcc : string option;
365
-
subject : string option;
366
-
body : string option;
367
-
has_keyword : string option;
368
-
not_keyword : string option;
369
-
has_attachment : bool option;
370
-
text : string option;
371
-
}
372
-
373
-
type email_query_filter = [
374
-
| `And of email_query_filter list
375
-
| `Or of email_query_filter list
376
-
| `Not of email_query_filter
377
-
| `Condition of email_filter_condition
378
-
]
379
-
380
-
(** Email/get request arguments. See RFC8621 Section 4.5. *)
381
-
type email_get_arguments = {
382
-
account_id : id;
383
-
ids : id list option;
384
-
properties : string list option;
385
-
body_properties : string list option;
386
-
fetch_text_body_values : bool option;
387
-
fetch_html_body_values : bool option;
388
-
fetch_all_body_values : bool option;
389
-
max_body_value_bytes : unsigned_int option;
390
-
}
391
-
392
-
(** Email/get response. See RFC8621 Section 4.5. *)
393
-
type email_get_response = {
394
-
account_id : id;
395
-
state : string;
396
-
list : email list;
397
-
not_found : id list;
398
-
}
399
-
400
-
(** Email/changes request arguments. See RFC8621 Section 4.6. *)
401
-
type email_changes_arguments = {
402
-
account_id : id;
403
-
since_state : string;
404
-
max_changes : unsigned_int option;
405
-
}
406
-
407
-
(** Email/changes response. See RFC8621 Section 4.6. *)
408
-
type email_changes_response = {
409
-
account_id : id;
410
-
old_state : string;
411
-
new_state : string;
412
-
has_more_changes : bool;
413
-
created : id list;
414
-
updated : id list;
415
-
destroyed : id list;
416
-
}
417
-
418
-
(** Email/query request arguments. See RFC8621 Section 4.4. *)
419
-
type email_query_arguments = {
420
-
account_id : id;
421
-
filter : email_query_filter option;
422
-
sort : comparator list option;
423
-
collapse_threads : bool option;
424
-
position : unsigned_int option;
425
-
anchor : id option;
426
-
anchor_offset : int_t option;
427
-
limit : unsigned_int option;
428
-
calculate_total : bool option;
429
-
}
430
-
431
-
(** Email/query response. See RFC8621 Section 4.4. *)
432
-
type email_query_response = {
433
-
account_id : id;
434
-
query_state : string;
435
-
can_calculate_changes : bool;
436
-
position : unsigned_int;
437
-
ids : id list;
438
-
total : unsigned_int option;
439
-
thread_ids : id list option;
440
-
}
441
-
442
-
(** Email/queryChanges request arguments. See RFC8621 Section 4.7. *)
443
-
type email_query_changes_arguments = {
444
-
account_id : id;
445
-
filter : email_query_filter option;
446
-
sort : comparator list option;
447
-
collapse_threads : bool option;
448
-
since_query_state : string;
449
-
max_changes : unsigned_int option;
450
-
up_to_id : id option;
451
-
}
452
-
453
-
(** Email/queryChanges response. See RFC8621 Section 4.7. *)
454
-
type email_query_changes_response = {
455
-
account_id : id;
456
-
old_query_state : string;
457
-
new_query_state : string;
458
-
total : unsigned_int option;
459
-
removed : id list;
460
-
added : email_query_changes_added list;
461
-
}
462
-
463
-
and email_query_changes_added = {
464
-
id : id;
465
-
index : unsigned_int;
466
-
}
467
-
468
-
(** Email/set request arguments. See RFC8621 Section 4.8. *)
469
-
type email_set_arguments = {
470
-
account_id : id;
471
-
if_in_state : string option;
472
-
create : (id * email_creation) list option;
473
-
update : (id * email_update) list option;
474
-
destroy : id list option;
475
-
}
476
-
477
-
and email_creation = {
478
-
mailbox_ids : (id * bool) list;
479
-
keywords : (keyword * bool) list option;
480
-
received_at : utc_date option;
481
-
message_id : string list option;
482
-
in_reply_to : string list option;
483
-
references : string list option;
484
-
sender : email_address list option;
485
-
from : email_address list option;
486
-
to_ : email_address list option;
487
-
cc : email_address list option;
488
-
bcc : email_address list option;
489
-
reply_to : email_address list option;
490
-
subject : string option;
491
-
body_values : (string * string) list option;
492
-
text_body : email_body_part list option;
493
-
html_body : email_body_part list option;
494
-
attachments : email_body_part list option;
495
-
headers : header list option;
496
-
}
497
-
498
-
and email_update = {
499
-
keywords : (keyword * bool) list option;
500
-
mailbox_ids : (id * bool) list option;
501
-
}
502
-
503
-
(** Email/set response. See RFC8621 Section 4.8. *)
504
-
type email_set_response = {
505
-
account_id : id;
506
-
old_state : string option;
507
-
new_state : string;
508
-
created : (id * email) list option;
509
-
updated : id list option;
510
-
destroyed : id list option;
511
-
not_created : (id * set_error) list option;
512
-
not_updated : (id * set_error) list option;
513
-
not_destroyed : (id * set_error) list option;
514
-
}
515
-
516
-
(** Email/copy request arguments. See RFC8621 Section 4.9. *)
517
-
type email_copy_arguments = {
518
-
from_account_id : id;
519
-
account_id : id;
520
-
create : (id * email_creation) list;
521
-
on_success_destroy_original : bool option;
522
-
}
523
-
524
-
(** Email/copy response. See RFC8621 Section 4.9. *)
525
-
type email_copy_response = {
526
-
from_account_id : id;
527
-
account_id : id;
528
-
created : (id * email) list option;
529
-
not_created : (id * set_error) list option;
530
-
}
531
-
532
-
(** Email/import request arguments. See RFC8621 Section 4.10. *)
533
-
type email_import_arguments = {
534
-
account_id : id;
535
-
emails : (id * email_import) list;
536
-
}
537
-
538
-
and email_import = {
539
-
blob_id : id;
540
-
mailbox_ids : (id * bool) list;
541
-
keywords : (keyword * bool) list option;
542
-
received_at : utc_date option;
543
-
}
544
-
545
-
(** Email/import response. See RFC8621 Section 4.10. *)
546
-
type email_import_response = {
547
-
account_id : id;
548
-
created : (id * email) list option;
549
-
not_created : (id * set_error) list option;
550
-
}
551
-
552
-
(** {1:search_snippet Search snippets} *)
553
-
554
-
(** SearchSnippet/get request arguments. See RFC8621 Section 4.11. *)
555
-
type search_snippet_get_arguments = {
556
-
account_id : id;
557
-
email_ids : id list;
558
-
filter : email_filter_condition;
559
-
}
560
-
561
-
(** SearchSnippet/get response. See RFC8621 Section 4.11. *)
562
-
type search_snippet_get_response = {
563
-
account_id : id;
564
-
list : (id * search_snippet) list;
565
-
not_found : id list;
566
-
}
567
-
568
-
and search_snippet = {
569
-
subject : string option;
570
-
preview : string option;
571
-
}
572
-
573
-
(** {1:submission EmailSubmission objects} *)
574
-
575
-
(** EmailSubmission address. See RFC8621 Section 5.1. *)
576
-
type submission_address = {
577
-
email : string;
578
-
parameters : (string * string) list option;
579
-
}
580
-
581
-
(** Email submission object. See RFC8621 Section 5.1. *)
582
-
type email_submission = {
583
-
id : id;
584
-
identity_id : id;
585
-
email_id : id;
586
-
thread_id : id;
587
-
envelope : envelope option;
588
-
send_at : utc_date option;
589
-
undo_status : [
590
-
| `pending
591
-
| `final
592
-
| `canceled
593
-
] option;
594
-
delivery_status : (string * submission_status) list option;
595
-
dsn_blob_ids : (string * id) list option;
596
-
mdn_blob_ids : (string * id) list option;
597
-
}
598
-
599
-
(** Envelope for mail submission. See RFC8621 Section 5.1. *)
600
-
and envelope = {
601
-
mail_from : submission_address;
602
-
rcpt_to : submission_address list;
603
-
}
604
-
605
-
(** Delivery status for submitted email. See RFC8621 Section 5.1. *)
606
-
and submission_status = {
607
-
smtp_reply : string;
608
-
delivered : string option;
609
-
}
610
-
611
-
(** EmailSubmission/get request arguments. See RFC8621 Section 5.3. *)
612
-
type email_submission_get_arguments = {
613
-
account_id : id;
614
-
ids : id list option;
615
-
properties : string list option;
616
-
}
617
-
618
-
(** EmailSubmission/get response. See RFC8621 Section 5.3. *)
619
-
type email_submission_get_response = {
620
-
account_id : id;
621
-
state : string;
622
-
list : email_submission list;
623
-
not_found : id list;
624
-
}
625
-
626
-
(** EmailSubmission/changes request arguments. See RFC8621 Section 5.4. *)
627
-
type email_submission_changes_arguments = {
628
-
account_id : id;
629
-
since_state : string;
630
-
max_changes : unsigned_int option;
631
-
}
632
-
633
-
(** EmailSubmission/changes response. See RFC8621 Section 5.4. *)
634
-
type email_submission_changes_response = {
635
-
account_id : id;
636
-
old_state : string;
637
-
new_state : string;
638
-
has_more_changes : bool;
639
-
created : id list;
640
-
updated : id list;
641
-
destroyed : id list;
642
-
}
643
-
644
-
(** EmailSubmission/query filter condition. See RFC8621 Section 5.5. *)
645
-
type email_submission_filter_condition = {
646
-
identity_id : id option;
647
-
email_id : id option;
648
-
thread_id : id option;
649
-
before : utc_date option;
650
-
after : utc_date option;
651
-
subject : string option;
652
-
}
653
-
654
-
type email_submission_query_filter = [
655
-
| `And of email_submission_query_filter list
656
-
| `Or of email_submission_query_filter list
657
-
| `Not of email_submission_query_filter
658
-
| `Condition of email_submission_filter_condition
659
-
]
660
-
661
-
(** EmailSubmission/query request arguments. See RFC8621 Section 5.5. *)
662
-
type email_submission_query_arguments = {
663
-
account_id : id;
664
-
filter : email_submission_query_filter option;
665
-
sort : comparator list option;
666
-
position : unsigned_int option;
667
-
anchor : id option;
668
-
anchor_offset : int_t option;
669
-
limit : unsigned_int option;
670
-
calculate_total : bool option;
671
-
}
672
-
673
-
(** EmailSubmission/query response. See RFC8621 Section 5.5. *)
674
-
type email_submission_query_response = {
675
-
account_id : id;
676
-
query_state : string;
677
-
can_calculate_changes : bool;
678
-
position : unsigned_int;
679
-
ids : id list;
680
-
total : unsigned_int option;
681
-
}
682
-
683
-
(** EmailSubmission/set request arguments. See RFC8621 Section 5.6. *)
684
-
type email_submission_set_arguments = {
685
-
account_id : id;
686
-
if_in_state : string option;
687
-
create : (id * email_submission_creation) list option;
688
-
update : (id * email_submission_update) list option;
689
-
destroy : id list option;
690
-
on_success_update_email : (id * email_update) list option;
691
-
}
692
-
693
-
and email_submission_creation = {
694
-
email_id : id;
695
-
identity_id : id;
696
-
envelope : envelope option;
697
-
send_at : utc_date option;
698
-
}
699
-
700
-
and email_submission_update = {
701
-
email_id : id option;
702
-
identity_id : id option;
703
-
envelope : envelope option;
704
-
undo_status : [`canceled] option;
705
-
}
706
-
707
-
(** EmailSubmission/set response. See RFC8621 Section 5.6. *)
708
-
type email_submission_set_response = {
709
-
account_id : id;
710
-
old_state : string option;
711
-
new_state : string;
712
-
created : (id * email_submission) list option;
713
-
updated : id list option;
714
-
destroyed : id list option;
715
-
not_created : (id * set_error) list option;
716
-
not_updated : (id * set_error) list option;
717
-
not_destroyed : (id * set_error) list option;
718
-
}
719
-
720
-
(** {1:identity Identity objects} *)
721
-
722
-
(** Identity for sending mail. See RFC8621 Section 6. *)
723
-
type identity = {
724
-
id : id;
725
-
name : string;
726
-
email : string;
727
-
reply_to : email_address list option;
728
-
bcc : email_address list option;
729
-
text_signature : string option;
730
-
html_signature : string option;
731
-
may_delete : bool;
732
-
}
733
-
734
-
(** Identity/get request arguments. See RFC8621 Section 6.1. *)
735
-
type identity_get_arguments = {
736
-
account_id : id;
737
-
ids : id list option;
738
-
properties : string list option;
739
-
}
740
-
741
-
(** Identity/get response. See RFC8621 Section 6.1. *)
742
-
type identity_get_response = {
743
-
account_id : id;
744
-
state : string;
745
-
list : identity list;
746
-
not_found : id list;
747
-
}
748
-
749
-
(** Identity/changes request arguments. See RFC8621 Section 6.2. *)
750
-
type identity_changes_arguments = {
751
-
account_id : id;
752
-
since_state : string;
753
-
max_changes : unsigned_int option;
754
-
}
755
-
756
-
(** Identity/changes response. See RFC8621 Section 6.2. *)
757
-
type identity_changes_response = {
758
-
account_id : id;
759
-
old_state : string;
760
-
new_state : string;
761
-
has_more_changes : bool;
762
-
created : id list;
763
-
updated : id list;
764
-
destroyed : id list;
765
-
}
766
-
767
-
(** Identity/set request arguments. See RFC8621 Section 6.3. *)
768
-
type identity_set_arguments = {
769
-
account_id : id;
770
-
if_in_state : string option;
771
-
create : (id * identity_creation) list option;
772
-
update : (id * identity_update) list option;
773
-
destroy : id list option;
774
-
}
775
-
776
-
and identity_creation = {
777
-
name : string;
778
-
email : string;
779
-
reply_to : email_address list option;
780
-
bcc : email_address list option;
781
-
text_signature : string option;
782
-
html_signature : string option;
783
-
}
784
-
785
-
and identity_update = {
786
-
name : string option;
787
-
email : string option;
788
-
reply_to : email_address list option;
789
-
bcc : email_address list option;
790
-
text_signature : string option;
791
-
html_signature : string option;
792
-
}
793
-
794
-
(** Identity/set response. See RFC8621 Section 6.3. *)
795
-
type identity_set_response = {
796
-
account_id : id;
797
-
old_state : string option;
798
-
new_state : string;
799
-
created : (id * identity) list option;
800
-
updated : id list option;
801
-
destroyed : id list option;
802
-
not_created : (id * set_error) list option;
803
-
not_updated : (id * set_error) list option;
804
-
not_destroyed : (id * set_error) list option;
805
-
}
806
-
807
-
(** {1:vacation_response VacationResponse objects} *)
808
-
809
-
(** Vacation auto-reply setting. See RFC8621 Section 7. *)
810
-
type vacation_response = {
811
-
id : id;
812
-
is_enabled : bool;
813
-
from_date : utc_date option;
814
-
to_date : utc_date option;
815
-
subject : string option;
816
-
text_body : string option;
817
-
html_body : string option;
818
-
}
819
-
820
-
(** VacationResponse/get request arguments. See RFC8621 Section 7.2. *)
821
-
type vacation_response_get_arguments = {
822
-
account_id : id;
823
-
ids : id list option;
824
-
properties : string list option;
825
-
}
826
-
827
-
(** VacationResponse/get response. See RFC8621 Section 7.2. *)
828
-
type vacation_response_get_response = {
829
-
account_id : id;
830
-
state : string;
831
-
list : vacation_response list;
832
-
not_found : id list;
833
-
}
834
-
835
-
(** VacationResponse/set request arguments. See RFC8621 Section 7.3. *)
836
-
type vacation_response_set_arguments = {
837
-
account_id : id;
838
-
if_in_state : string option;
839
-
update : (id * vacation_response_update) list;
840
-
}
841
-
842
-
and vacation_response_update = {
843
-
is_enabled : bool option;
844
-
from_date : utc_date option;
845
-
to_date : utc_date option;
846
-
subject : string option;
847
-
text_body : string option;
848
-
html_body : string option;
849
-
}
850
-
851
-
(** VacationResponse/set response. See RFC8621 Section 7.3. *)
852
-
type vacation_response_set_response = {
853
-
account_id : id;
854
-
old_state : string option;
855
-
new_state : string;
856
-
updated : id list option;
857
-
not_updated : (id * set_error) list option;
858
-
}
859
-
860
-
(** {1:message_flags Message Flags and Mailbox Attributes} *)
861
-
862
-
(** Flag color defined by the combination of MailFlagBit0, MailFlagBit1, and MailFlagBit2 keywords *)
863
-
type flag_color =
864
-
| Red (** Bit pattern 000 *)
865
-
| Orange (** Bit pattern 100 *)
866
-
| Yellow (** Bit pattern 010 *)
867
-
| Green (** Bit pattern 111 *)
868
-
| Blue (** Bit pattern 001 *)
869
-
| Purple (** Bit pattern 101 *)
870
-
| Gray (** Bit pattern 011 *)
871
-
872
-
(** Standard message keywords as defined in draft-ietf-mailmaint-messageflag-mailboxattribute-02 *)
873
-
type message_keyword =
874
-
| Notify (** Indicate a notification should be shown for this message *)
875
-
| Muted (** User is not interested in future replies to this thread *)
876
-
| Followed (** User is particularly interested in future replies to this thread *)
877
-
| Memo (** Message is a note-to-self about another message in the same thread *)
878
-
| HasMemo (** Message has an associated memo with the $memo keyword *)
879
-
| HasAttachment (** Message has an attachment *)
880
-
| HasNoAttachment (** Message does not have an attachment *)
881
-
| AutoSent (** Message was sent automatically as a response due to a user rule *)
882
-
| Unsubscribed (** User has unsubscribed from the thread this message is in *)
883
-
| CanUnsubscribe (** Message has an RFC8058-compliant List-Unsubscribe header *)
884
-
| Imported (** Message was imported from another mailbox *)
885
-
| IsTrusted (** Server has verified authenticity of the from name and email *)
886
-
| MaskedEmail (** Message was received via an alias created for an individual sender *)
887
-
| New (** Message should be made more prominent due to a recent action *)
888
-
| MailFlagBit0 (** Bit 0 of the 3-bit flag color pattern *)
889
-
| MailFlagBit1 (** Bit 1 of the 3-bit flag color pattern *)
890
-
| MailFlagBit2 (** Bit 2 of the 3-bit flag color pattern *)
891
-
| OtherKeyword of string (** Other non-standard keywords *)
892
-
893
-
(** Special mailbox attribute names as defined in draft-ietf-mailmaint-messageflag-mailboxattribute-02 *)
894
-
type mailbox_attribute =
895
-
| Snoozed (** Mailbox containing messages that have been snoozed *)
896
-
| Scheduled (** Mailbox containing messages scheduled to be sent later *)
897
-
| Memos (** Mailbox containing messages with the $memo keyword *)
898
-
| OtherAttribute of string (** Other non-standard mailbox attributes *)
899
-
900
-
(** Functions for working with flag colors based on the specification in
901
-
draft-ietf-mailmaint-messageflag-mailboxattribute-02, section 3.1. *)
902
-
903
-
(** Convert bit pattern to flag color *)
904
-
let flag_color_of_bits bit0 bit1 bit2 =
905
-
match (bit0, bit1, bit2) with
906
-
| (false, false, false) -> Red (* 000 *)
907
-
| (true, false, false) -> Orange (* 100 *)
908
-
| (false, true, false) -> Yellow (* 010 *)
909
-
| (true, true, true) -> Green (* 111 *)
910
-
| (false, false, true) -> Blue (* 001 *)
911
-
| (true, false, true) -> Purple (* 101 *)
912
-
| (false, true, true) -> Gray (* 011 *)
913
-
| (true, true, false) -> Green (* 110 - not in spec, defaulting to green *)
914
-
915
-
(** Get bits for a flag color *)
916
-
let bits_of_flag_color = function
917
-
| Red -> (false, false, false)
918
-
| Orange -> (true, false, false)
919
-
| Yellow -> (false, true, false)
920
-
| Green -> (true, true, true)
921
-
| Blue -> (false, false, true)
922
-
| Purple -> (true, false, true)
923
-
| Gray -> (false, true, true)
924
-
925
-
(** Check if a keyword list contains a flag color *)
926
-
let has_flag_color keywords =
927
-
let has_bit0 = List.exists (function
928
-
| (Custom s, true) when s = "$MailFlagBit0" -> true
929
-
| _ -> false
930
-
) keywords in
931
-
932
-
let has_bit1 = List.exists (function
933
-
| (Custom s, true) when s = "$MailFlagBit1" -> true
934
-
| _ -> false
935
-
) keywords in
936
-
937
-
let has_bit2 = List.exists (function
938
-
| (Custom s, true) when s = "$MailFlagBit2" -> true
939
-
| _ -> false
940
-
) keywords in
941
-
942
-
has_bit0 || has_bit1 || has_bit2
943
-
944
-
(** Extract flag color from keywords if present *)
945
-
let get_flag_color keywords =
946
-
(* First check if the message has the \Flagged system flag *)
947
-
let is_flagged = List.exists (function
948
-
| (Flagged, true) -> true
949
-
| _ -> false
950
-
) keywords in
951
-
952
-
if not is_flagged then
953
-
None
954
-
else
955
-
(* Get values of each bit flag *)
956
-
let bit0 = List.exists (function
957
-
| (Custom s, true) when s = "$MailFlagBit0" -> true
958
-
| _ -> false
959
-
) keywords in
960
-
961
-
let bit1 = List.exists (function
962
-
| (Custom s, true) when s = "$MailFlagBit1" -> true
963
-
| _ -> false
964
-
) keywords in
965
-
966
-
let bit2 = List.exists (function
967
-
| (Custom s, true) when s = "$MailFlagBit2" -> true
968
-
| _ -> false
969
-
) keywords in
970
-
971
-
Some (flag_color_of_bits bit0 bit1 bit2)
972
-
973
-
(** Convert a message keyword to its string representation *)
974
-
let string_of_message_keyword = function
975
-
| Notify -> "$notify"
976
-
| Muted -> "$muted"
977
-
| Followed -> "$followed"
978
-
| Memo -> "$memo"
979
-
| HasMemo -> "$hasmemo"
980
-
| HasAttachment -> "$hasattachment"
981
-
| HasNoAttachment -> "$hasnoattachment"
982
-
| AutoSent -> "$autosent"
983
-
| Unsubscribed -> "$unsubscribed"
984
-
| CanUnsubscribe -> "$canunsubscribe"
985
-
| Imported -> "$imported"
986
-
| IsTrusted -> "$istrusted"
987
-
| MaskedEmail -> "$maskedemail"
988
-
| New -> "$new"
989
-
| MailFlagBit0 -> "$MailFlagBit0"
990
-
| MailFlagBit1 -> "$MailFlagBit1"
991
-
| MailFlagBit2 -> "$MailFlagBit2"
992
-
| OtherKeyword s -> s
993
-
994
-
(** Parse a string into a message keyword *)
995
-
let message_keyword_of_string = function
996
-
| "$notify" -> Notify
997
-
| "$muted" -> Muted
998
-
| "$followed" -> Followed
999
-
| "$memo" -> Memo
1000
-
| "$hasmemo" -> HasMemo
1001
-
| "$hasattachment" -> HasAttachment
1002
-
| "$hasnoattachment" -> HasNoAttachment
1003
-
| "$autosent" -> AutoSent
1004
-
| "$unsubscribed" -> Unsubscribed
1005
-
| "$canunsubscribe" -> CanUnsubscribe
1006
-
| "$imported" -> Imported
1007
-
| "$istrusted" -> IsTrusted
1008
-
| "$maskedemail" -> MaskedEmail
1009
-
| "$new" -> New
1010
-
| "$MailFlagBit0" -> MailFlagBit0
1011
-
| "$MailFlagBit1" -> MailFlagBit1
1012
-
| "$MailFlagBit2" -> MailFlagBit2
1013
-
| s -> OtherKeyword s
1014
-
1015
-
(** Convert a mailbox attribute to its string representation *)
1016
-
let string_of_mailbox_attribute = function
1017
-
| Snoozed -> "Snoozed"
1018
-
| Scheduled -> "Scheduled"
1019
-
| Memos -> "Memos"
1020
-
| OtherAttribute s -> s
1021
-
1022
-
(** Parse a string into a mailbox attribute *)
1023
-
let mailbox_attribute_of_string = function
1024
-
| "Snoozed" -> Snoozed
1025
-
| "Scheduled" -> Scheduled
1026
-
| "Memos" -> Memos
1027
-
| s -> OtherAttribute s
1028
-
1029
-
(** Get a human-readable representation of a flag color *)
1030
-
let human_readable_flag_color = function
1031
-
| Red -> "Red"
1032
-
| Orange -> "Orange"
1033
-
| Yellow -> "Yellow"
1034
-
| Green -> "Green"
1035
-
| Blue -> "Blue"
1036
-
| Purple -> "Purple"
1037
-
| Gray -> "Gray"
1038
-
1039
-
(** Get a human-readable representation of a message keyword *)
1040
-
let human_readable_message_keyword = function
1041
-
| Notify -> "Notify"
1042
-
| Muted -> "Muted"
1043
-
| Followed -> "Followed"
1044
-
| Memo -> "Memo"
1045
-
| HasMemo -> "Has Memo"
1046
-
| HasAttachment -> "Has Attachment"
1047
-
| HasNoAttachment -> "No Attachment"
1048
-
| AutoSent -> "Auto Sent"
1049
-
| Unsubscribed -> "Unsubscribed"
1050
-
| CanUnsubscribe -> "Can Unsubscribe"
1051
-
| Imported -> "Imported"
1052
-
| IsTrusted -> "Trusted"
1053
-
| MaskedEmail -> "Masked Email"
1054
-
| New -> "New"
1055
-
| MailFlagBit0 | MailFlagBit1 | MailFlagBit2 -> "Flag Bit"
1056
-
| OtherKeyword s -> s
1057
-
1058
-
(** Format email keywords into a human-readable string representation *)
1059
-
let format_email_keywords keywords =
1060
-
(* Get flag color if present *)
1061
-
let color_str =
1062
-
match get_flag_color keywords with
1063
-
| Some color -> human_readable_flag_color color
1064
-
| None -> ""
1065
-
in
1066
-
1067
-
(* Get standard JMAP keywords *)
1068
-
let standard_keywords = List.filter_map (fun (kw, active) ->
1069
-
if not active then None
1070
-
else match kw with
1071
-
| Flagged -> Some "Flagged"
1072
-
| Answered -> Some "Answered"
1073
-
| Draft -> Some "Draft"
1074
-
| Forwarded -> Some "Forwarded"
1075
-
| Phishing -> Some "Phishing"
1076
-
| Junk -> Some "Junk"
1077
-
| NotJunk -> Some "Not Junk"
1078
-
| Seen -> Some "Seen"
1079
-
| Unread -> Some "Unread"
1080
-
| _ -> None
1081
-
) keywords in
1082
-
1083
-
(* Get message keywords *)
1084
-
let message_keywords = List.filter_map (fun (kw, active) ->
1085
-
if not active then None
1086
-
else match kw with
1087
-
| Custom s ->
1088
-
(* Try to parse as message keyword *)
1089
-
let message_kw = message_keyword_of_string s in
1090
-
(match message_kw with
1091
-
| OtherKeyword _ -> None
1092
-
| MailFlagBit0 | MailFlagBit1 | MailFlagBit2 -> None
1093
-
| kw -> Some (human_readable_message_keyword kw))
1094
-
| _ -> None
1095
-
) keywords in
1096
-
1097
-
(* Combine all human-readable labels *)
1098
-
let all_parts =
1099
-
(if color_str <> "" then [color_str] else []) @
1100
-
standard_keywords @
1101
-
message_keywords
1102
-
in
1103
-
1104
-
String.concat ", " all_parts
1105
-
end
1106
-
1107
-
(** {1 JSON serialization} *)
1108
-
1109
-
module Json = struct
1110
-
open Types
1111
-
1112
-
(** {2 Helper functions for serialization} *)
1113
-
1114
-
let string_of_mailbox_role = function
1115
-
| All -> "all"
1116
-
| Archive -> "archive"
1117
-
| Drafts -> "drafts"
1118
-
| Flagged -> "flagged"
1119
-
| Important -> "important"
1120
-
| Inbox -> "inbox"
1121
-
| Junk -> "junk"
1122
-
| Sent -> "sent"
1123
-
| Trash -> "trash"
1124
-
| Unknown s -> s
1125
-
1126
-
let mailbox_role_of_string = function
1127
-
| "all" -> All
1128
-
| "archive" -> Archive
1129
-
| "drafts" -> Drafts
1130
-
| "flagged" -> Flagged
1131
-
| "important" -> Important
1132
-
| "inbox" -> Inbox
1133
-
| "junk" -> Junk
1134
-
| "sent" -> Sent
1135
-
| "trash" -> Trash
1136
-
| s -> Unknown s
1137
-
1138
-
let string_of_keyword = function
1139
-
| Flagged -> "$flagged"
1140
-
| Answered -> "$answered"
1141
-
| Draft -> "$draft"
1142
-
| Forwarded -> "$forwarded"
1143
-
| Phishing -> "$phishing"
1144
-
| Junk -> "$junk"
1145
-
| NotJunk -> "$notjunk"
1146
-
| Seen -> "$seen"
1147
-
| Unread -> "$unread"
1148
-
| Custom s -> s
1149
-
1150
-
let keyword_of_string = function
1151
-
| "$flagged" -> Flagged
1152
-
| "$answered" -> Answered
1153
-
| "$draft" -> Draft
1154
-
| "$forwarded" -> Forwarded
1155
-
| "$phishing" -> Phishing
1156
-
| "$junk" -> Junk
1157
-
| "$notjunk" -> NotJunk
1158
-
| "$seen" -> Seen
1159
-
| "$unread" -> Unread
1160
-
| s -> Custom s
1161
-
1162
-
(** {2 Mailbox serialization} *)
1163
-
1164
-
(** TODO:claude - Need to implement all JSON serialization functions
1165
-
for each type we've defined. This would be a substantial amount of
1166
-
code and likely require additional understanding of the ezjsonm API.
1167
-
1168
-
For a full implementation, we would need functions to convert between
1169
-
OCaml types and JSON for each of:
1170
-
- mailbox, mailbox_rights, mailbox query/update operations
1171
-
- thread operations
1172
-
- email, email_address, header, email_body_part
1173
-
- email query/update operations
1174
-
- submission operations
1175
-
- identity operations
1176
-
- vacation response operations
1177
-
*)
1178
-
end
1179
-
1180
-
(** {1 API functions} *)
1181
-
1182
-
open Lwt.Syntax
1183
-
open Jmap.Api
1184
-
open Jmap.Types
1185
-
1186
-
(** Authentication credentials for a JMAP server *)
1187
-
type credentials = {
1188
-
username: string;
1189
-
password: string;
1190
-
}
1191
-
1192
-
(** Connection to a JMAP mail server *)
1193
-
type connection = {
1194
-
session: Jmap.Types.session;
1195
-
config: Jmap.Api.config;
1196
-
}
1197
-
1198
-
(** Convert JSON mail object to OCaml type *)
1199
-
let mailbox_of_json json =
1200
-
try
1201
-
let open Ezjsonm in
1202
-
let id = get_string (find json ["id"]) in
1203
-
let name = get_string (find json ["name"]) in
1204
-
(* Handle parentId which can be null *)
1205
-
let parent_id =
1206
-
match find_opt json ["parentId"] with
1207
-
| Some (`Null) -> None
1208
-
| Some (`String s) -> Some s
1209
-
| None -> None
1210
-
| _ -> None
1211
-
in
1212
-
(* Handle role which might be null *)
1213
-
let role =
1214
-
match find_opt json ["role"] with
1215
-
| Some (`Null) -> None
1216
-
| Some (`String s) -> Some (Json.mailbox_role_of_string s)
1217
-
| None -> None
1218
-
| _ -> None
1219
-
in
1220
-
let sort_order = get_int (find json ["sortOrder"]) in
1221
-
let total_emails = get_int (find json ["totalEmails"]) in
1222
-
let unread_emails = get_int (find json ["unreadEmails"]) in
1223
-
let total_threads = get_int (find json ["totalThreads"]) in
1224
-
let unread_threads = get_int (find json ["unreadThreads"]) in
1225
-
let is_subscribed = get_bool (find json ["isSubscribed"]) in
1226
-
let rights_json = find json ["myRights"] in
1227
-
let my_rights = {
1228
-
Types.may_read_items = get_bool (find rights_json ["mayReadItems"]);
1229
-
may_add_items = get_bool (find rights_json ["mayAddItems"]);
1230
-
may_remove_items = get_bool (find rights_json ["mayRemoveItems"]);
1231
-
may_set_seen = get_bool (find rights_json ["maySetSeen"]);
1232
-
may_set_keywords = get_bool (find rights_json ["maySetKeywords"]);
1233
-
may_create_child = get_bool (find rights_json ["mayCreateChild"]);
1234
-
may_rename = get_bool (find rights_json ["mayRename"]);
1235
-
may_delete = get_bool (find rights_json ["mayDelete"]);
1236
-
may_submit = get_bool (find rights_json ["maySubmit"]);
1237
-
} in
1238
-
let result = {
1239
-
Types.id;
1240
-
name;
1241
-
parent_id;
1242
-
role;
1243
-
sort_order;
1244
-
total_emails;
1245
-
unread_emails;
1246
-
total_threads;
1247
-
unread_threads;
1248
-
is_subscribed;
1249
-
my_rights;
1250
-
} in
1251
-
Ok (result)
1252
-
with
1253
-
| Not_found ->
1254
-
Error (Parse_error "Required field not found in mailbox object")
1255
-
| Invalid_argument msg ->
1256
-
Error (Parse_error msg)
1257
-
| e ->
1258
-
Error (Parse_error (Printexc.to_string e))
1259
-
1260
-
(** Convert JSON email object to OCaml type *)
1261
-
let email_of_json json =
1262
-
try
1263
-
let open Ezjsonm in
1264
-
1265
-
let id = get_string (find json ["id"]) in
1266
-
let blob_id = get_string (find json ["blobId"]) in
1267
-
let thread_id = get_string (find json ["threadId"]) in
1268
-
1269
-
(* Process mailboxIds map *)
1270
-
let mailbox_ids_json = find json ["mailboxIds"] in
1271
-
let mailbox_ids = match mailbox_ids_json with
1272
-
| `O items -> List.map (fun (id, v) -> (id, get_bool v)) items
1273
-
| _ -> raise (Invalid_argument "mailboxIds is not an object")
1274
-
in
1275
-
1276
-
(* Process keywords map *)
1277
-
let keywords_json = find json ["keywords"] in
1278
-
let keywords = match keywords_json with
1279
-
| `O items -> List.map (fun (k, v) ->
1280
-
(Json.keyword_of_string k, get_bool v)) items
1281
-
| _ -> raise (Invalid_argument "keywords is not an object")
1282
-
in
1283
-
1284
-
let size = get_int (find json ["size"]) in
1285
-
let received_at = get_string (find json ["receivedAt"]) in
1286
-
1287
-
(* Handle messageId which might be an array or missing *)
1288
-
let message_id =
1289
-
match find_opt json ["messageId"] with
1290
-
| Some (`A ids) -> List.map (fun id ->
1291
-
match id with
1292
-
| `String s -> s
1293
-
| _ -> raise (Invalid_argument "messageId item is not a string")
1294
-
) ids
1295
-
| Some (`String s) -> [s] (* Handle single string case *)
1296
-
| None -> [] (* Handle missing case *)
1297
-
| _ -> raise (Invalid_argument "messageId has unexpected type")
1298
-
in
1299
-
1300
-
(* Parse optional fields *)
1301
-
let parse_email_addresses opt_json =
1302
-
match opt_json with
1303
-
| Some (`A items) ->
1304
-
Some (List.map (fun addr_json ->
1305
-
let name =
1306
-
match find_opt addr_json ["name"] with
1307
-
| Some (`String s) -> Some s
1308
-
| Some (`Null) -> None
1309
-
| None -> None
1310
-
| _ -> None
1311
-
in
1312
-
let email = get_string (find addr_json ["email"]) in
1313
-
let parameters =
1314
-
match find_opt addr_json ["parameters"] with
1315
-
| Some (`O items) -> List.map (fun (k, v) ->
1316
-
match v with
1317
-
| `String s -> (k, s)
1318
-
| _ -> (k, "")
1319
-
) items
1320
-
| _ -> []
1321
-
in
1322
-
{ Types.name; email; parameters }
1323
-
) items)
1324
-
| _ -> None
1325
-
in
1326
-
1327
-
(* Handle optional string arrays with null handling *)
1328
-
let parse_string_array_opt field_name =
1329
-
match find_opt json [field_name] with
1330
-
| Some (`A ids) ->
1331
-
Some (List.filter_map (function
1332
-
| `String s -> Some s
1333
-
| _ -> None
1334
-
) ids)
1335
-
| Some (`Null) -> None
1336
-
| None -> None
1337
-
| _ -> None
1338
-
in
1339
-
1340
-
let in_reply_to = parse_string_array_opt "inReplyTo" in
1341
-
let references = parse_string_array_opt "references" in
1342
-
1343
-
let sender = parse_email_addresses (find_opt json ["sender"]) in
1344
-
let from = parse_email_addresses (find_opt json ["from"]) in
1345
-
let to_ = parse_email_addresses (find_opt json ["to"]) in
1346
-
let cc = parse_email_addresses (find_opt json ["cc"]) in
1347
-
let bcc = parse_email_addresses (find_opt json ["bcc"]) in
1348
-
let reply_to = parse_email_addresses (find_opt json ["replyTo"]) in
1349
-
1350
-
(* Handle optional string fields with null handling *)
1351
-
let parse_string_opt field_name =
1352
-
match find_opt json [field_name] with
1353
-
| Some (`String s) -> Some s
1354
-
| Some (`Null) -> None
1355
-
| None -> None
1356
-
| _ -> None
1357
-
in
1358
-
1359
-
let subject = parse_string_opt "subject" in
1360
-
let sent_at = parse_string_opt "sentAt" in
1361
-
1362
-
(* Handle optional boolean fields with null handling *)
1363
-
let parse_bool_opt field_name =
1364
-
match find_opt json [field_name] with
1365
-
| Some (`Bool b) -> Some b
1366
-
| Some (`Null) -> None
1367
-
| None -> None
1368
-
| _ -> None
1369
-
in
1370
-
1371
-
let has_attachment = parse_bool_opt "hasAttachment" in
1372
-
let preview = parse_string_opt "preview" in
1373
-
1374
-
(* TODO Body parts parsing would go here - omitting for brevity *)
1375
-
Ok ({
1376
-
Types.id;
1377
-
blob_id;
1378
-
thread_id;
1379
-
mailbox_ids;
1380
-
keywords;
1381
-
size;
1382
-
received_at;
1383
-
message_id;
1384
-
in_reply_to;
1385
-
references;
1386
-
sender;
1387
-
from;
1388
-
to_;
1389
-
cc;
1390
-
bcc;
1391
-
reply_to;
1392
-
subject;
1393
-
sent_at;
1394
-
has_attachment;
1395
-
preview;
1396
-
body_values = None;
1397
-
text_body = None;
1398
-
html_body = None;
1399
-
attachments = None;
1400
-
headers = None;
1401
-
})
1402
-
with
1403
-
| Not_found ->
1404
-
Error (Parse_error "Required field not found in email object")
1405
-
| Invalid_argument msg ->
1406
-
Error (Parse_error msg)
1407
-
| e ->
1408
-
Error (Parse_error (Printexc.to_string e))
1409
-
1410
-
(** Login to a JMAP server and establish a connection
1411
-
@param uri The URI of the JMAP server
1412
-
@param credentials Authentication credentials
1413
-
@return A connection object if successful
1414
-
1415
-
TODO:claude *)
1416
-
let login ~uri ~credentials =
1417
-
let* session_result = get_session (Uri.of_string uri)
1418
-
~username:credentials.username
1419
-
~authentication_token:credentials.password
1420
-
() in
1421
-
match session_result with
1422
-
| Ok session ->
1423
-
let api_uri = Uri.of_string session.api_url in
1424
-
let config = {
1425
-
api_uri;
1426
-
username = credentials.username;
1427
-
authentication_token = credentials.password;
1428
-
} in
1429
-
Lwt.return (Ok { session; config })
1430
-
| Error e -> Lwt.return (Error e)
1431
-
1432
-
(** Login to a JMAP server using an API token
1433
-
@param uri The URI of the JMAP server
1434
-
@param api_token The API token for authentication
1435
-
@return A connection object if successful
1436
-
1437
-
TODO:claude *)
1438
-
let login_with_token ~uri ~api_token =
1439
-
let* session_result = get_session (Uri.of_string uri)
1440
-
~api_token
1441
-
() in
1442
-
match session_result with
1443
-
| Ok session ->
1444
-
let api_uri = Uri.of_string session.api_url in
1445
-
let config = {
1446
-
api_uri;
1447
-
username = ""; (* Empty username indicates we're using token auth *)
1448
-
authentication_token = api_token;
1449
-
} in
1450
-
Lwt.return (Ok { session; config })
1451
-
| Error e -> Lwt.return (Error e)
1452
-
1453
-
(** Get all mailboxes for an account
1454
-
@param conn The JMAP connection
1455
-
@param account_id The account ID to get mailboxes for
1456
-
@return A list of mailboxes if successful
1457
-
1458
-
TODO:claude *)
1459
-
let get_mailboxes conn ~account_id =
1460
-
let request = {
1461
-
using = [
1462
-
Jmap.Capability.to_string Jmap.Capability.Core;
1463
-
Capability.to_string Capability.Mail
1464
-
];
1465
-
method_calls = [
1466
-
{
1467
-
name = "Mailbox/get";
1468
-
arguments = `O [
1469
-
("accountId", `String account_id);
1470
-
];
1471
-
method_call_id = "m1";
1472
-
}
1473
-
];
1474
-
created_ids = None;
1475
-
} in
1476
-
1477
-
let* response_result = make_request conn.config request in
1478
-
match response_result with
1479
-
| Ok response ->
1480
-
let result =
1481
-
try
1482
-
let method_response = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) ->
1483
-
inv.name = "Mailbox/get") response.method_responses in
1484
-
let args = method_response.arguments in
1485
-
match Ezjsonm.find_opt args ["list"] with
1486
-
| Some (`A mailbox_list) ->
1487
-
let parse_results = List.map mailbox_of_json mailbox_list in
1488
-
let (successes, failures) = List.partition Result.is_ok parse_results in
1489
-
if List.length failures > 0 then
1490
-
Error (Parse_error "Failed to parse some mailboxes")
1491
-
else
1492
-
Ok (List.map Result.get_ok successes)
1493
-
| _ -> Error (Parse_error "Mailbox list not found in response")
1494
-
with
1495
-
| Not_found -> Error (Parse_error "Mailbox/get method response not found")
1496
-
| e -> Error (Parse_error (Printexc.to_string e))
1497
-
in
1498
-
Lwt.return result
1499
-
| Error e -> Lwt.return (Error e)
1500
-
1501
-
(** Get a specific mailbox by ID
1502
-
@param conn The JMAP connection
1503
-
@param account_id The account ID
1504
-
@param mailbox_id The mailbox ID to retrieve
1505
-
@return The mailbox if found
1506
-
1507
-
TODO:claude *)
1508
-
let get_mailbox conn ~account_id ~mailbox_id =
1509
-
let request = {
1510
-
using = [
1511
-
Jmap.Capability.to_string Jmap.Capability.Core;
1512
-
Capability.to_string Capability.Mail
1513
-
];
1514
-
method_calls = [
1515
-
{
1516
-
name = "Mailbox/get";
1517
-
arguments = `O [
1518
-
("accountId", `String account_id);
1519
-
("ids", `A [`String mailbox_id]);
1520
-
];
1521
-
method_call_id = "m1";
1522
-
}
1523
-
];
1524
-
created_ids = None;
1525
-
} in
1526
-
1527
-
let* response_result = make_request conn.config request in
1528
-
match response_result with
1529
-
| Ok response ->
1530
-
let result =
1531
-
try
1532
-
let method_response = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) ->
1533
-
inv.name = "Mailbox/get") response.method_responses in
1534
-
let args = method_response.arguments in
1535
-
match Ezjsonm.find_opt args ["list"] with
1536
-
| Some (`A [mailbox]) -> mailbox_of_json mailbox
1537
-
| Some (`A []) -> Error (Parse_error ("Mailbox not found: " ^ mailbox_id))
1538
-
| _ -> Error (Parse_error "Expected single mailbox in response")
1539
-
with
1540
-
| Not_found -> Error (Parse_error "Mailbox/get method response not found")
1541
-
| e -> Error (Parse_error (Printexc.to_string e))
1542
-
in
1543
-
Lwt.return result
1544
-
| Error e -> Lwt.return (Error e)
1545
-
1546
-
(** Get messages in a mailbox
1547
-
@param conn The JMAP connection
1548
-
@param account_id The account ID
1549
-
@param mailbox_id The mailbox ID to get messages from
1550
-
@param limit Optional limit on number of messages to return
1551
-
@return The list of email messages if successful
1552
-
1553
-
TODO:claude *)
1554
-
let get_messages_in_mailbox conn ~account_id ~mailbox_id ?limit () =
1555
-
(* First query the emails in the mailbox *)
1556
-
let query_request = {
1557
-
using = [
1558
-
Jmap.Capability.to_string Jmap.Capability.Core;
1559
-
Capability.to_string Capability.Mail
1560
-
];
1561
-
method_calls = [
1562
-
{
1563
-
name = "Email/query";
1564
-
arguments = `O ([
1565
-
("accountId", `String account_id);
1566
-
("filter", `O [("inMailbox", `String mailbox_id)]);
1567
-
("sort", `A [`O [("property", `String "receivedAt"); ("isAscending", `Bool false)]]);
1568
-
] @ (match limit with
1569
-
| Some l -> [("limit", `Float (float_of_int l))]
1570
-
| None -> []
1571
-
));
1572
-
method_call_id = "q1";
1573
-
}
1574
-
];
1575
-
created_ids = None;
1576
-
} in
1577
-
1578
-
let* query_result = make_request conn.config query_request in
1579
-
match query_result with
1580
-
| Ok query_response ->
1581
-
(try
1582
-
let query_method = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) ->
1583
-
inv.name = "Email/query") query_response.method_responses in
1584
-
let args = query_method.arguments in
1585
-
match Ezjsonm.find_opt args ["ids"] with
1586
-
| Some (`A ids) ->
1587
-
let email_ids = List.map (function
1588
-
| `String id -> id
1589
-
| _ -> raise (Invalid_argument "Email ID is not a string")
1590
-
) ids in
1591
-
1592
-
(* If we have IDs, fetch the actual email objects *)
1593
-
if List.length email_ids > 0 then
1594
-
let get_request = {
1595
-
using = [
1596
-
Jmap.Capability.to_string Jmap.Capability.Core;
1597
-
Capability.to_string Capability.Mail
1598
-
];
1599
-
method_calls = [
1600
-
{
1601
-
name = "Email/get";
1602
-
arguments = `O [
1603
-
("accountId", `String account_id);
1604
-
("ids", `A (List.map (fun id -> `String id) email_ids));
1605
-
];
1606
-
method_call_id = "g1";
1607
-
}
1608
-
];
1609
-
created_ids = None;
1610
-
} in
1611
-
1612
-
let* get_result = make_request conn.config get_request in
1613
-
match get_result with
1614
-
| Ok get_response ->
1615
-
(try
1616
-
let get_method = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) ->
1617
-
inv.name = "Email/get") get_response.method_responses in
1618
-
let args = get_method.arguments in
1619
-
match Ezjsonm.find_opt args ["list"] with
1620
-
| Some (`A email_list) ->
1621
-
let parse_results = List.map email_of_json email_list in
1622
-
let (successes, failures) = List.partition Result.is_ok parse_results in
1623
-
if List.length failures > 0 then
1624
-
Lwt.return (Error (Parse_error "Failed to parse some emails"))
1625
-
else
1626
-
Lwt.return (Ok (List.map Result.get_ok successes))
1627
-
| _ -> Lwt.return (Error (Parse_error "Email list not found in response"))
1628
-
with
1629
-
| Not_found -> Lwt.return (Error (Parse_error "Email/get method response not found"))
1630
-
| e -> Lwt.return (Error (Parse_error (Printexc.to_string e))))
1631
-
| Error e -> Lwt.return (Error e)
1632
-
else
1633
-
(* No emails in mailbox *)
1634
-
Lwt.return (Ok [])
1635
-
1636
-
| _ -> Lwt.return (Error (Parse_error "Email IDs not found in query response"))
1637
-
with
1638
-
| Not_found -> Lwt.return (Error (Parse_error "Email/query method response not found"))
1639
-
| Invalid_argument msg -> Lwt.return (Error (Parse_error msg))
1640
-
| e -> Lwt.return (Error (Parse_error (Printexc.to_string e))))
1641
-
| Error e -> Lwt.return (Error e)
1642
-
1643
-
(** Get a single email message by ID
1644
-
@param conn The JMAP connection
1645
-
@param account_id The account ID
1646
-
@param email_id The email ID to retrieve
1647
-
@return The email message if found
1648
-
1649
-
TODO:claude *)
1650
-
let get_email conn ~account_id ~email_id =
1651
-
let request = {
1652
-
using = [
1653
-
Jmap.Capability.to_string Jmap.Capability.Core;
1654
-
Capability.to_string Capability.Mail
1655
-
];
1656
-
method_calls = [
1657
-
{
1658
-
name = "Email/get";
1659
-
arguments = `O [
1660
-
("accountId", `String account_id);
1661
-
("ids", `A [`String email_id]);
1662
-
];
1663
-
method_call_id = "m1";
1664
-
}
1665
-
];
1666
-
created_ids = None;
1667
-
} in
1668
-
1669
-
let* response_result = make_request conn.config request in
1670
-
match response_result with
1671
-
| Ok response ->
1672
-
let result =
1673
-
try
1674
-
let method_response = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) ->
1675
-
inv.name = "Email/get") response.method_responses in
1676
-
let args = method_response.arguments in
1677
-
match Ezjsonm.find_opt args ["list"] with
1678
-
| Some (`A [email]) -> email_of_json email
1679
-
| Some (`A []) -> Error (Parse_error ("Email not found: " ^ email_id))
1680
-
| _ -> Error (Parse_error "Expected single email in response")
1681
-
with
1682
-
| Not_found -> Error (Parse_error "Email/get method response not found")
1683
-
| e -> Error (Parse_error (Printexc.to_string e))
1684
-
in
1685
-
Lwt.return result
1686
-
| Error e -> Lwt.return (Error e)
1687
-
1688
-
(** Helper functions for working with message flags and mailbox attributes *)
1689
-
1690
-
(** Check if an email has a specific message keyword
1691
-
@param email The email to check
1692
-
@param keyword The message keyword to look for
1693
-
@return true if the email has the keyword, false otherwise
1694
-
1695
-
TODO:claude *)
1696
-
let has_message_keyword (email:Types.email) keyword =
1697
-
let open Types in
1698
-
let keyword_string = string_of_message_keyword keyword in
1699
-
List.exists (function
1700
-
| (Custom s, true) when s = keyword_string -> true
1701
-
| _ -> false
1702
-
) email.keywords
1703
-
1704
-
(** Add a message keyword to an email
1705
-
@param conn The JMAP connection
1706
-
@param account_id The account ID
1707
-
@param email_id The email ID
1708
-
@param keyword The message keyword to add
1709
-
@return Success or error
1710
-
1711
-
TODO:claude *)
1712
-
let add_message_keyword conn ~account_id ~email_id ~keyword =
1713
-
let keyword_string = Types.string_of_message_keyword keyword in
1714
-
1715
-
let request = {
1716
-
using = [
1717
-
Jmap.Capability.to_string Jmap.Capability.Core;
1718
-
Capability.to_string Capability.Mail
1719
-
];
1720
-
method_calls = [
1721
-
{
1722
-
name = "Email/set";
1723
-
arguments = `O [
1724
-
("accountId", `String account_id);
1725
-
("update", `O [
1726
-
(email_id, `O [
1727
-
("keywords", `O [
1728
-
(keyword_string, `Bool true)
1729
-
])
1730
-
])
1731
-
]);
1732
-
];
1733
-
method_call_id = "m1";
1734
-
}
1735
-
];
1736
-
created_ids = None;
1737
-
} in
1738
-
1739
-
let* response_result = make_request conn.config request in
1740
-
match response_result with
1741
-
| Ok response ->
1742
-
let result =
1743
-
try
1744
-
let method_response = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) ->
1745
-
inv.name = "Email/set") response.method_responses in
1746
-
let args = method_response.arguments in
1747
-
match Ezjsonm.find_opt args ["updated"] with
1748
-
| Some (`A _ids) -> Ok ()
1749
-
| _ ->
1750
-
match Ezjsonm.find_opt args ["notUpdated"] with
1751
-
| Some (`O _errors) ->
1752
-
Error (Parse_error ("Failed to update email: " ^ email_id))
1753
-
| _ -> Error (Parse_error "Unexpected response format")
1754
-
with
1755
-
| Not_found -> Error (Parse_error "Email/set method response not found")
1756
-
| e -> Error (Parse_error (Printexc.to_string e))
1757
-
in
1758
-
Lwt.return result
1759
-
| Error e -> Lwt.return (Error e)
1760
-
1761
-
(** Set a flag color for an email
1762
-
@param conn The JMAP connection
1763
-
@param account_id The account ID
1764
-
@param email_id The email ID
1765
-
@param color The flag color to set
1766
-
@return Success or error
1767
-
1768
-
TODO:claude *)
1769
-
let set_flag_color conn ~account_id ~email_id ~color =
1770
-
(* Get the bit pattern for the color *)
1771
-
let (bit0, bit1, bit2) = Types.bits_of_flag_color color in
1772
-
1773
-
(* Build the keywords update object *)
1774
-
let keywords = [
1775
-
("$flagged", `Bool true);
1776
-
("$MailFlagBit0", `Bool bit0);
1777
-
("$MailFlagBit1", `Bool bit1);
1778
-
("$MailFlagBit2", `Bool bit2);
1779
-
] in
1780
-
1781
-
let request = {
1782
-
using = [
1783
-
Jmap.Capability.to_string Jmap.Capability.Core;
1784
-
Capability.to_string Capability.Mail
1785
-
];
1786
-
method_calls = [
1787
-
{
1788
-
name = "Email/set";
1789
-
arguments = `O [
1790
-
("accountId", `String account_id);
1791
-
("update", `O [
1792
-
(email_id, `O [
1793
-
("keywords", `O keywords)
1794
-
])
1795
-
]);
1796
-
];
1797
-
method_call_id = "m1";
1798
-
}
1799
-
];
1800
-
created_ids = None;
1801
-
} in
1802
-
1803
-
let* response_result = make_request conn.config request in
1804
-
match response_result with
1805
-
| Ok response ->
1806
-
let result =
1807
-
try
1808
-
let method_response = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) ->
1809
-
inv.name = "Email/set") response.method_responses in
1810
-
let args = method_response.arguments in
1811
-
match Ezjsonm.find_opt args ["updated"] with
1812
-
| Some (`A _ids) -> Ok ()
1813
-
| _ ->
1814
-
match Ezjsonm.find_opt args ["notUpdated"] with
1815
-
| Some (`O _errors) ->
1816
-
Error (Parse_error ("Failed to update email: " ^ email_id))
1817
-
| _ -> Error (Parse_error "Unexpected response format")
1818
-
with
1819
-
| Not_found -> Error (Parse_error "Email/set method response not found")
1820
-
| e -> Error (Parse_error (Printexc.to_string e))
1821
-
in
1822
-
Lwt.return result
1823
-
| Error e -> Lwt.return (Error e)
1824
-
1825
-
(** Convert an email's keywords to typed message_keyword list
1826
-
@param email The email to analyze
1827
-
@return List of message keywords
1828
-
1829
-
TODO:claude *)
1830
-
let get_message_keywords (email:Types.email) =
1831
-
let open Types in
1832
-
List.filter_map (function
1833
-
| (Custom s, true) -> Some (message_keyword_of_string s)
1834
-
| _ -> None
1835
-
) email.keywords
1836
-
1837
-
(** Get emails with a specific message keyword
1838
-
@param conn The JMAP connection
1839
-
@param account_id The account ID
1840
-
@param keyword The message keyword to search for
1841
-
@param limit Optional limit on number of emails to return
1842
-
@return List of emails with the keyword if successful
1843
-
1844
-
TODO:claude *)
1845
-
let get_emails_with_keyword conn ~account_id ~keyword ?limit () =
1846
-
let keyword_string = Types.string_of_message_keyword keyword in
1847
-
1848
-
(* Query for emails with the specified keyword *)
1849
-
let query_request = {
1850
-
using = [
1851
-
Jmap.Capability.to_string Jmap.Capability.Core;
1852
-
Capability.to_string Capability.Mail
1853
-
];
1854
-
method_calls = [
1855
-
{
1856
-
name = "Email/query";
1857
-
arguments = `O ([
1858
-
("accountId", `String account_id);
1859
-
("filter", `O [("hasKeyword", `String keyword_string)]);
1860
-
("sort", `A [`O [("property", `String "receivedAt"); ("isAscending", `Bool false)]]);
1861
-
] @ (match limit with
1862
-
| Some l -> [("limit", `Float (float_of_int l))]
1863
-
| None -> []
1864
-
));
1865
-
method_call_id = "q1";
1866
-
}
1867
-
];
1868
-
created_ids = None;
1869
-
} in
1870
-
1871
-
let* query_result = make_request conn.config query_request in
1872
-
match query_result with
1873
-
| Ok query_response ->
1874
-
(try
1875
-
let query_method = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) ->
1876
-
inv.name = "Email/query") query_response.method_responses in
1877
-
let args = query_method.arguments in
1878
-
match Ezjsonm.find_opt args ["ids"] with
1879
-
| Some (`A ids) ->
1880
-
let email_ids = List.map (function
1881
-
| `String id -> id
1882
-
| _ -> raise (Invalid_argument "Email ID is not a string")
1883
-
) ids in
1884
-
1885
-
(* If we have IDs, fetch the actual email objects *)
1886
-
if List.length email_ids > 0 then
1887
-
let get_request = {
1888
-
using = [
1889
-
Jmap.Capability.to_string Jmap.Capability.Core;
1890
-
Capability.to_string Capability.Mail
1891
-
];
1892
-
method_calls = [
1893
-
{
1894
-
name = "Email/get";
1895
-
arguments = `O [
1896
-
("accountId", `String account_id);
1897
-
("ids", `A (List.map (fun id -> `String id) email_ids));
1898
-
];
1899
-
method_call_id = "g1";
1900
-
}
1901
-
];
1902
-
created_ids = None;
1903
-
} in
1904
-
1905
-
let* get_result = make_request conn.config get_request in
1906
-
match get_result with
1907
-
| Ok get_response ->
1908
-
(try
1909
-
let get_method = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) ->
1910
-
inv.name = "Email/get") get_response.method_responses in
1911
-
let args = get_method.arguments in
1912
-
match Ezjsonm.find_opt args ["list"] with
1913
-
| Some (`A email_list) ->
1914
-
let parse_results = List.map email_of_json email_list in
1915
-
let (successes, failures) = List.partition Result.is_ok parse_results in
1916
-
if List.length failures > 0 then
1917
-
Lwt.return (Error (Parse_error "Failed to parse some emails"))
1918
-
else
1919
-
Lwt.return (Ok (List.map Result.get_ok successes))
1920
-
| _ -> Lwt.return (Error (Parse_error "Email list not found in response"))
1921
-
with
1922
-
| Not_found -> Lwt.return (Error (Parse_error "Email/get method response not found"))
1923
-
| e -> Lwt.return (Error (Parse_error (Printexc.to_string e))))
1924
-
| Error e -> Lwt.return (Error e)
1925
-
else
1926
-
(* No emails with the keyword *)
1927
-
Lwt.return (Ok [])
1928
-
1929
-
| _ -> Lwt.return (Error (Parse_error "Email IDs not found in query response"))
1930
-
with
1931
-
| Not_found -> Lwt.return (Error (Parse_error "Email/query method response not found"))
1932
-
| Invalid_argument msg -> Lwt.return (Error (Parse_error msg))
1933
-
| e -> Lwt.return (Error (Parse_error (Printexc.to_string e))))
1934
-
| Error e -> Lwt.return (Error e)
1935
-
1936
-
(** {1 Email Submission} *)
1937
-
1938
-
(** Create a new email draft
1939
-
@param conn The JMAP connection
1940
-
@param account_id The account ID
1941
-
@param mailbox_id The mailbox ID to store the draft in (usually "drafts")
1942
-
@param from The sender's email address
1943
-
@param to_addresses List of recipient email addresses
1944
-
@param subject The email subject line
1945
-
@param text_body Plain text message body
1946
-
@param html_body Optional HTML message body
1947
-
@return The created email ID if successful
1948
-
1949
-
TODO:claude
1950
-
*)
1951
-
let create_email_draft conn ~account_id ~mailbox_id ~from ~to_addresses ~subject ~text_body ?html_body () =
1952
-
(* Create email addresses *)
1953
-
let from_addr = {
1954
-
Types.name = None;
1955
-
email = from;
1956
-
parameters = [];
1957
-
} in
1958
-
1959
-
let to_addrs = List.map (fun addr -> {
1960
-
Types.name = None;
1961
-
email = addr;
1962
-
parameters = [];
1963
-
}) to_addresses in
1964
-
1965
-
(* Create text body part *)
1966
-
let text_part = {
1967
-
Types.part_id = Some "part1";
1968
-
blob_id = None;
1969
-
size = None;
1970
-
headers = None;
1971
-
name = None;
1972
-
type_ = Some "text/plain";
1973
-
charset = Some "utf-8";
1974
-
disposition = None;
1975
-
cid = None;
1976
-
language = None;
1977
-
location = None;
1978
-
sub_parts = None;
1979
-
header_parameter_name = None;
1980
-
header_parameter_value = None;
1981
-
} in
1982
-
1983
-
(* Create HTML body part if provided *)
1984
-
let html_part_opt = match html_body with
1985
-
| Some _html -> Some {
1986
-
Types.part_id = Some "part2";
1987
-
blob_id = None;
1988
-
size = None;
1989
-
headers = None;
1990
-
name = None;
1991
-
type_ = Some "text/html";
1992
-
charset = Some "utf-8";
1993
-
disposition = None;
1994
-
cid = None;
1995
-
language = None;
1996
-
location = None;
1997
-
sub_parts = None;
1998
-
header_parameter_name = None;
1999
-
header_parameter_value = None;
2000
-
}
2001
-
| None -> None
2002
-
in
2003
-
2004
-
(* Create body values *)
2005
-
let body_values = [
2006
-
("part1", text_body)
2007
-
] @ (match html_body with
2008
-
| Some html -> [("part2", html)]
2009
-
| None -> []
2010
-
) in
2011
-
2012
-
(* Create email *)
2013
-
let html_body_list = match html_part_opt with
2014
-
| Some part -> Some [part]
2015
-
| None -> None
2016
-
in
2017
-
2018
-
let _email_creation = {
2019
-
Types.mailbox_ids = [(mailbox_id, true)];
2020
-
keywords = Some [(Draft, true)];
2021
-
received_at = None; (* Server will set this *)
2022
-
message_id = None; (* Server will generate this *)
2023
-
in_reply_to = None;
2024
-
references = None;
2025
-
sender = None;
2026
-
from = Some [from_addr];
2027
-
to_ = Some to_addrs;
2028
-
cc = None;
2029
-
bcc = None;
2030
-
reply_to = None;
2031
-
subject = Some subject;
2032
-
body_values = Some body_values;
2033
-
text_body = Some [text_part];
2034
-
html_body = html_body_list;
2035
-
attachments = None;
2036
-
headers = None;
2037
-
} in
2038
-
2039
-
let request = {
2040
-
using = [
2041
-
Jmap.Capability.to_string Jmap.Capability.Core;
2042
-
Capability.to_string Capability.Mail
2043
-
];
2044
-
method_calls = [
2045
-
{
2046
-
name = "Email/set";
2047
-
arguments = `O [
2048
-
("accountId", `String account_id);
2049
-
("create", `O [
2050
-
("draft1", `O (
2051
-
[
2052
-
("mailboxIds", `O [(mailbox_id, `Bool true)]);
2053
-
("keywords", `O [("$draft", `Bool true)]);
2054
-
("from", `A [`O [("name", `Null); ("email", `String from)]]);
2055
-
("to", `A (List.map (fun addr ->
2056
-
`O [("name", `Null); ("email", `String addr)]
2057
-
) to_addresses));
2058
-
("subject", `String subject);
2059
-
("bodyStructure", `O [
2060
-
("type", `String "multipart/alternative");
2061
-
("subParts", `A [
2062
-
`O [
2063
-
("partId", `String "part1");
2064
-
("type", `String "text/plain")
2065
-
];
2066
-
`O [
2067
-
("partId", `String "part2");
2068
-
("type", `String "text/html")
2069
-
]
2070
-
])
2071
-
]);
2072
-
("bodyValues", `O ([
2073
-
("part1", `O [("value", `String text_body)])
2074
-
] @ (match html_body with
2075
-
| Some html -> [("part2", `O [("value", `String html)])]
2076
-
| None -> [("part2", `O [("value", `String ("<html><body>" ^ text_body ^ "</body></html>"))])]
2077
-
)))
2078
-
]
2079
-
))
2080
-
])
2081
-
];
2082
-
method_call_id = "m1";
2083
-
}
2084
-
];
2085
-
created_ids = None;
2086
-
} in
2087
-
2088
-
let* response_result = make_request conn.config request in
2089
-
match response_result with
2090
-
| Ok response ->
2091
-
let result =
2092
-
try
2093
-
let method_response = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) ->
2094
-
inv.name = "Email/set") response.method_responses in
2095
-
let args = method_response.arguments in
2096
-
match Ezjsonm.find_opt args ["created"] with
2097
-
| Some (`O created) ->
2098
-
let draft_created = List.find_opt (fun (id, _) -> id = "draft1") created in
2099
-
(match draft_created with
2100
-
| Some (_, json) ->
2101
-
let id = Ezjsonm.get_string (Ezjsonm.find json ["id"]) in
2102
-
Ok id
2103
-
| None -> Error (Parse_error "Created email not found in response"))
2104
-
| _ ->
2105
-
match Ezjsonm.find_opt args ["notCreated"] with
2106
-
| Some (`O errors) ->
2107
-
let error_msg = match List.find_opt (fun (id, _) -> id = "draft1") errors with
2108
-
| Some (_, err) ->
2109
-
let type_ = Ezjsonm.get_string (Ezjsonm.find err ["type"]) in
2110
-
let description =
2111
-
match Ezjsonm.find_opt err ["description"] with
2112
-
| Some (`String desc) -> desc
2113
-
| _ -> "Unknown error"
2114
-
in
2115
-
"Error type: " ^ type_ ^ ", Description: " ^ description
2116
-
| None -> "Unknown error"
2117
-
in
2118
-
Error (Parse_error ("Failed to create email: " ^ error_msg))
2119
-
| _ -> Error (Parse_error "Unexpected response format")
2120
-
with
2121
-
| Not_found -> Error (Parse_error "Email/set method response not found")
2122
-
| e -> Error (Parse_error (Printexc.to_string e))
2123
-
in
2124
-
Lwt.return result
2125
-
| Error e -> Lwt.return (Error e)
2126
-
2127
-
(** Get all identities for an account
2128
-
@param conn The JMAP connection
2129
-
@param account_id The account ID
2130
-
@return A list of identities if successful
2131
-
2132
-
TODO:claude
2133
-
*)
2134
-
let get_identities conn ~account_id =
2135
-
let request = {
2136
-
using = [
2137
-
Jmap.Capability.to_string Jmap.Capability.Core;
2138
-
Capability.to_string Capability.Submission
2139
-
];
2140
-
method_calls = [
2141
-
{
2142
-
name = "Identity/get";
2143
-
arguments = `O [
2144
-
("accountId", `String account_id);
2145
-
];
2146
-
method_call_id = "m1";
2147
-
}
2148
-
];
2149
-
created_ids = None;
2150
-
} in
2151
-
2152
-
let* response_result = make_request conn.config request in
2153
-
match response_result with
2154
-
| Ok response ->
2155
-
let result =
2156
-
try
2157
-
let method_response = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) ->
2158
-
inv.name = "Identity/get") response.method_responses in
2159
-
let args = method_response.arguments in
2160
-
match Ezjsonm.find_opt args ["list"] with
2161
-
| Some (`A identities) ->
2162
-
let parse_identity json =
2163
-
try
2164
-
let open Ezjsonm in
2165
-
let id = get_string (find json ["id"]) in
2166
-
let name = get_string (find json ["name"]) in
2167
-
let email = get_string (find json ["email"]) in
2168
-
2169
-
let parse_email_addresses field =
2170
-
match find_opt json [field] with
2171
-
| Some (`A items) ->
2172
-
Some (List.map (fun addr_json ->
2173
-
let name =
2174
-
match find_opt addr_json ["name"] with
2175
-
| Some (`String s) -> Some s
2176
-
| Some (`Null) -> None
2177
-
| None -> None
2178
-
| _ -> None
2179
-
in
2180
-
let email = get_string (find addr_json ["email"]) in
2181
-
let parameters =
2182
-
match find_opt addr_json ["parameters"] with
2183
-
| Some (`O items) -> List.map (fun (k, v) ->
2184
-
match v with
2185
-
| `String s -> (k, s)
2186
-
| _ -> (k, "")
2187
-
) items
2188
-
| _ -> []
2189
-
in
2190
-
{ Types.name; email; parameters }
2191
-
) items)
2192
-
| _ -> None
2193
-
in
2194
-
2195
-
let reply_to = parse_email_addresses "replyTo" in
2196
-
let bcc = parse_email_addresses "bcc" in
2197
-
2198
-
let text_signature =
2199
-
match find_opt json ["textSignature"] with
2200
-
| Some (`String s) -> Some s
2201
-
| _ -> None
2202
-
in
2203
-
2204
-
let html_signature =
2205
-
match find_opt json ["htmlSignature"] with
2206
-
| Some (`String s) -> Some s
2207
-
| _ -> None
2208
-
in
2209
-
2210
-
let may_delete =
2211
-
match find_opt json ["mayDelete"] with
2212
-
| Some (`Bool b) -> b
2213
-
| _ -> false
2214
-
in
2215
-
2216
-
(* Create our own identity record for simplicity *)
2217
-
let r : Types.identity = {
2218
-
id = id;
2219
-
name = name;
2220
-
email = email;
2221
-
reply_to = reply_to;
2222
-
bcc = bcc;
2223
-
text_signature = text_signature;
2224
-
html_signature = html_signature;
2225
-
may_delete = may_delete
2226
-
} in Ok r
2227
-
with
2228
-
| Not_found -> Error (Parse_error "Required field not found in identity object")
2229
-
| Invalid_argument msg -> Error (Parse_error msg)
2230
-
| e -> Error (Parse_error (Printexc.to_string e))
2231
-
in
2232
-
2233
-
let results = List.map parse_identity identities in
2234
-
let (successes, failures) = List.partition Result.is_ok results in
2235
-
if List.length failures > 0 then
2236
-
Error (Parse_error "Failed to parse some identity objects")
2237
-
else
2238
-
Ok (List.map Result.get_ok successes)
2239
-
| _ -> Error (Parse_error "Identity list not found in response")
2240
-
with
2241
-
| Not_found -> Error (Parse_error "Identity/get method response not found")
2242
-
| e -> Error (Parse_error (Printexc.to_string e))
2243
-
in
2244
-
Lwt.return result
2245
-
| Error e -> Lwt.return (Error e)
2246
-
2247
-
(** Find a suitable identity by email address
2248
-
@param conn The JMAP connection
2249
-
@param account_id The account ID
2250
-
@param email The email address to match
2251
-
@return The identity if found, otherwise Error
2252
-
2253
-
TODO:claude
2254
-
*)
2255
-
let find_identity_by_email conn ~account_id ~email =
2256
-
let* identities_result = get_identities conn ~account_id in
2257
-
match identities_result with
2258
-
| Ok identities -> begin
2259
-
let matching_identity = List.find_opt (fun (identity:Types.identity) ->
2260
-
(* Exact match *)
2261
-
if String.lowercase_ascii identity.email = String.lowercase_ascii email then
2262
-
true
2263
-
else
2264
-
(* Wildcard match (e.g., *@example.com) *)
2265
-
let parts = String.split_on_char '@' identity.email in
2266
-
if List.length parts = 2 && List.hd parts = "*" then
2267
-
let domain = List.nth parts 1 in
2268
-
let email_parts = String.split_on_char '@' email in
2269
-
if List.length email_parts = 2 then
2270
-
List.nth email_parts 1 = domain
2271
-
else
2272
-
false
2273
-
else
2274
-
false
2275
-
) identities in
2276
-
2277
-
match matching_identity with
2278
-
| Some identity -> Lwt.return (Ok identity)
2279
-
| None -> Lwt.return (Error (Parse_error "No matching identity found"))
2280
-
end
2281
-
| Error e -> Lwt.return (Error e)
2282
-
2283
-
(** Submit an email for delivery
2284
-
@param conn The JMAP connection
2285
-
@param account_id The account ID
2286
-
@param identity_id The identity ID to send from
2287
-
@param email_id The email ID to submit
2288
-
@param envelope Optional custom envelope
2289
-
@return The submission ID if successful
2290
-
2291
-
TODO:claude
2292
-
*)
2293
-
let submit_email conn ~account_id ~identity_id ~email_id ?envelope () =
2294
-
let request = {
2295
-
using = [
2296
-
Jmap.Capability.to_string Jmap.Capability.Core;
2297
-
Capability.to_string Capability.Mail;
2298
-
Capability.to_string Capability.Submission
2299
-
];
2300
-
method_calls = [
2301
-
{
2302
-
name = "EmailSubmission/set";
2303
-
arguments = `O [
2304
-
("accountId", `String account_id);
2305
-
("create", `O [
2306
-
("submission1", `O (
2307
-
[
2308
-
("emailId", `String email_id);
2309
-
("identityId", `String identity_id);
2310
-
] @ (match envelope with
2311
-
| Some env -> [
2312
-
("envelope", `O [
2313
-
("mailFrom", `O [
2314
-
("email", `String env.Types.mail_from.email);
2315
-
("parameters", match env.Types.mail_from.parameters with
2316
-
| Some params -> `O (List.map (fun (k, v) -> (k, `String v)) params)
2317
-
| None -> `O []
2318
-
)
2319
-
]);
2320
-
("rcptTo", `A (List.map (fun (rcpt:Types.submission_address) ->
2321
-
`O [
2322
-
("email", `String rcpt.Types.email);
2323
-
("parameters", match rcpt.Types.parameters with
2324
-
| Some params -> `O (List.map (fun (k, v) -> (k, `String v)) params)
2325
-
| None -> `O []
2326
-
)
2327
-
]
2328
-
) env.Types.rcpt_to))
2329
-
])
2330
-
]
2331
-
| None -> []
2332
-
)
2333
-
))
2334
-
]);
2335
-
("onSuccessUpdateEmail", `O [
2336
-
(email_id, `O [
2337
-
("keywords", `O [
2338
-
("$draft", `Bool false);
2339
-
("$sent", `Bool true);
2340
-
])
2341
-
])
2342
-
]);
2343
-
];
2344
-
method_call_id = "m1";
2345
-
}
2346
-
];
2347
-
created_ids = None;
2348
-
} in
2349
-
2350
-
let* response_result = make_request conn.config request in
2351
-
match response_result with
2352
-
| Ok response ->
2353
-
let result =
2354
-
try
2355
-
let method_response = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) ->
2356
-
inv.name = "EmailSubmission/set") response.method_responses in
2357
-
let args = method_response.arguments in
2358
-
match Ezjsonm.find_opt args ["created"] with
2359
-
| Some (`O created) ->
2360
-
let submission_created = List.find_opt (fun (id, _) -> id = "submission1") created in
2361
-
(match submission_created with
2362
-
| Some (_, json) ->
2363
-
let id = Ezjsonm.get_string (Ezjsonm.find json ["id"]) in
2364
-
Ok id
2365
-
| None -> Error (Parse_error "Created submission not found in response"))
2366
-
| _ ->
2367
-
match Ezjsonm.find_opt args ["notCreated"] with
2368
-
| Some (`O errors) ->
2369
-
let error_msg = match List.find_opt (fun (id, _) -> id = "submission1") errors with
2370
-
| Some (_, err) ->
2371
-
let type_ = Ezjsonm.get_string (Ezjsonm.find err ["type"]) in
2372
-
let description =
2373
-
match Ezjsonm.find_opt err ["description"] with
2374
-
| Some (`String desc) -> desc
2375
-
| _ -> "Unknown error"
2376
-
in
2377
-
"Error type: " ^ type_ ^ ", Description: " ^ description
2378
-
| None -> "Unknown error"
2379
-
in
2380
-
Error (Parse_error ("Failed to submit email: " ^ error_msg))
2381
-
| _ -> Error (Parse_error "Unexpected response format")
2382
-
with
2383
-
| Not_found -> Error (Parse_error "EmailSubmission/set method response not found")
2384
-
| e -> Error (Parse_error (Printexc.to_string e))
2385
-
in
2386
-
Lwt.return result
2387
-
| Error e -> Lwt.return (Error e)
2388
-
2389
-
(** Create and submit an email in one operation
2390
-
@param conn The JMAP connection
2391
-
@param account_id The account ID
2392
-
@param from The sender's email address
2393
-
@param to_addresses List of recipient email addresses
2394
-
@param subject The email subject line
2395
-
@param text_body Plain text message body
2396
-
@param html_body Optional HTML message body
2397
-
@return The submission ID if successful
2398
-
2399
-
TODO:claude
2400
-
*)
2401
-
let create_and_submit_email conn ~account_id ~from ~to_addresses ~subject ~text_body ?html_body:_ () =
2402
-
(* First get accounts to find the draft mailbox and identity in a single request *)
2403
-
let* initial_result =
2404
-
let request = {
2405
-
using = [
2406
-
Jmap.Capability.to_string Jmap.Capability.Core;
2407
-
Capability.to_string Capability.Mail;
2408
-
Capability.to_string Capability.Submission
2409
-
];
2410
-
method_calls = [
2411
-
{
2412
-
name = "Mailbox/get";
2413
-
arguments = `O [
2414
-
("accountId", `String account_id);
2415
-
];
2416
-
method_call_id = "m1";
2417
-
};
2418
-
{
2419
-
name = "Identity/get";
2420
-
arguments = `O [
2421
-
("accountId", `String account_id)
2422
-
];
2423
-
method_call_id = "m2";
2424
-
}
2425
-
];
2426
-
created_ids = None;
2427
-
} in
2428
-
make_request conn.config request
2429
-
in
2430
-
2431
-
match initial_result with
2432
-
| Ok initial_response -> begin
2433
-
(* Find drafts mailbox ID *)
2434
-
let find_drafts_result =
2435
-
try
2436
-
let method_response = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) ->
2437
-
inv.name = "Mailbox/get") initial_response.method_responses in
2438
-
let args = method_response.arguments in
2439
-
match Ezjsonm.find_opt args ["list"] with
2440
-
| Some (`A mailboxes) -> begin
2441
-
let draft_mailbox = List.find_opt (fun mailbox ->
2442
-
match Ezjsonm.find_opt mailbox ["role"] with
2443
-
| Some (`String role) -> role = "drafts"
2444
-
| _ -> false
2445
-
) mailboxes in
2446
-
2447
-
match draft_mailbox with
2448
-
| Some mb -> Ok (Ezjsonm.get_string (Ezjsonm.find mb ["id"]))
2449
-
| None -> Error (Parse_error "No drafts mailbox found")
2450
-
end
2451
-
| _ -> Error (Parse_error "Mailbox list not found in response")
2452
-
with
2453
-
| Not_found -> Error (Parse_error "Mailbox/get method response not found")
2454
-
| e -> Error (Parse_error (Printexc.to_string e))
2455
-
in
2456
-
2457
-
(* Find matching identity for from address *)
2458
-
let find_identity_result =
2459
-
try
2460
-
let method_response = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) ->
2461
-
inv.name = "Identity/get") initial_response.method_responses in
2462
-
let args = method_response.arguments in
2463
-
match Ezjsonm.find_opt args ["list"] with
2464
-
| Some (`A identities) -> begin
2465
-
let matching_identity = List.find_opt (fun identity ->
2466
-
match Ezjsonm.find_opt identity ["email"] with
2467
-
| Some (`String email) ->
2468
-
let email_lc = String.lowercase_ascii email in
2469
-
let from_lc = String.lowercase_ascii from in
2470
-
email_lc = from_lc || (* Exact match *)
2471
-
(* Wildcard domain match *)
2472
-
(let parts = String.split_on_char '@' email_lc in
2473
-
if List.length parts = 2 && List.hd parts = "*" then
2474
-
let domain = List.nth parts 1 in
2475
-
let from_parts = String.split_on_char '@' from_lc in
2476
-
if List.length from_parts = 2 then
2477
-
List.nth from_parts 1 = domain
2478
-
else false
2479
-
else false)
2480
-
| _ -> false
2481
-
) identities in
2482
-
2483
-
match matching_identity with
2484
-
| Some id ->
2485
-
let identity_id = Ezjsonm.get_string (Ezjsonm.find id ["id"]) in
2486
-
Ok identity_id
2487
-
| None -> Error (Parse_error ("No matching identity found for " ^ from))
2488
-
end
2489
-
| _ -> Error (Parse_error "Identity list not found in response")
2490
-
with
2491
-
| Not_found -> Error (Parse_error "Identity/get method response not found")
2492
-
| e -> Error (Parse_error (Printexc.to_string e))
2493
-
in
2494
-
2495
-
(* If we have both required IDs, create and submit the email in one request *)
2496
-
match (find_drafts_result, find_identity_result) with
2497
-
| (Ok drafts_id, Ok identity_id) -> begin
2498
-
(* Now create and submit the email in a single request *)
2499
-
let request = {
2500
-
using = [
2501
-
Jmap.Capability.to_string Jmap.Capability.Core;
2502
-
Capability.to_string Capability.Mail;
2503
-
Capability.to_string Capability.Submission
2504
-
];
2505
-
method_calls = [
2506
-
{
2507
-
name = "Email/set";
2508
-
arguments = `O [
2509
-
("accountId", `String account_id);
2510
-
("create", `O [
2511
-
("draft", `O (
2512
-
[
2513
-
("mailboxIds", `O [(drafts_id, `Bool true)]);
2514
-
("keywords", `O [("$draft", `Bool true)]);
2515
-
("from", `A [`O [("email", `String from)]]);
2516
-
("to", `A (List.map (fun addr ->
2517
-
`O [("email", `String addr)]
2518
-
) to_addresses));
2519
-
("subject", `String subject);
2520
-
("textBody", `A [`O [
2521
-
("partId", `String "body");
2522
-
("type", `String "text/plain")
2523
-
]]);
2524
-
("bodyValues", `O [
2525
-
("body", `O [
2526
-
("charset", `String "utf-8");
2527
-
("value", `String text_body)
2528
-
])
2529
-
])
2530
-
]
2531
-
))
2532
-
]);
2533
-
];
2534
-
method_call_id = "0";
2535
-
};
2536
-
{
2537
-
name = "EmailSubmission/set";
2538
-
arguments = `O [
2539
-
("accountId", `String account_id);
2540
-
("create", `O [
2541
-
("sendIt", `O [
2542
-
("emailId", `String "#draft");
2543
-
("identityId", `String identity_id)
2544
-
])
2545
-
])
2546
-
];
2547
-
method_call_id = "1";
2548
-
}
2549
-
];
2550
-
created_ids = None;
2551
-
} in
2552
-
2553
-
let* submit_result = make_request conn.config request in
2554
-
match submit_result with
2555
-
| Ok submit_response -> begin
2556
-
try
2557
-
let submission_method = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) ->
2558
-
inv.name = "EmailSubmission/set") submit_response.method_responses in
2559
-
let args = submission_method.arguments in
2560
-
2561
-
(* Check if email was created and submission was created *)
2562
-
match Ezjsonm.find_opt args ["created"] with
2563
-
| Some (`O created) -> begin
2564
-
(* Extract the submission ID *)
2565
-
let submission_created = List.find_opt (fun (id, _) -> id = "sendIt") created in
2566
-
match submission_created with
2567
-
| Some (_, json) ->
2568
-
let id = Ezjsonm.get_string (Ezjsonm.find json ["id"]) in
2569
-
Lwt.return (Ok id)
2570
-
| None -> begin
2571
-
(* Check if there was an error in creation *)
2572
-
match Ezjsonm.find_opt args ["notCreated"] with
2573
-
| Some (`O errors) ->
2574
-
let error_msg = match List.find_opt (fun (id, _) -> id = "sendIt") errors with
2575
-
| Some (_, err) ->
2576
-
let type_ = Ezjsonm.get_string (Ezjsonm.find err ["type"]) in
2577
-
let description =
2578
-
match Ezjsonm.find_opt err ["description"] with
2579
-
| Some (`String desc) -> desc
2580
-
| _ -> "Unknown error"
2581
-
in
2582
-
"Error type: " ^ type_ ^ ", Description: " ^ description
2583
-
| None -> "Unknown error"
2584
-
in
2585
-
Lwt.return (Error (Parse_error ("Failed to submit email: " ^ error_msg)))
2586
-
| Some _ -> Lwt.return (Error (Parse_error "Email submission not found in response"))
2587
-
| None -> Lwt.return (Error (Parse_error "Email submission not found in response"))
2588
-
end
2589
-
end
2590
-
| Some (`Null) -> Lwt.return (Error (Parse_error "No created submissions in response"))
2591
-
| Some _ -> Lwt.return (Error (Parse_error "Invalid response format for created submissions"))
2592
-
| None -> Lwt.return (Error (Parse_error "No created submissions in response"))
2593
-
with
2594
-
| Not_found -> Lwt.return (Error (Parse_error "EmailSubmission/set method response not found"))
2595
-
| e -> Lwt.return (Error (Parse_error (Printexc.to_string e)))
2596
-
end
2597
-
| Error e -> Lwt.return (Error e)
2598
-
end
2599
-
| (Error e, _) -> Lwt.return (Error e)
2600
-
| (_, Error e) -> Lwt.return (Error e)
2601
-
end
2602
-
| Error e -> Lwt.return (Error e)
2603
-
2604
-
(** Get status of an email submission
2605
-
@param conn The JMAP connection
2606
-
@param account_id The account ID
2607
-
@param submission_id The email submission ID
2608
-
@return The submission status if successful
2609
-
2610
-
TODO:claude
2611
-
*)
2612
-
let get_submission_status conn ~account_id ~submission_id =
2613
-
let request = {
2614
-
using = [
2615
-
Jmap.Capability.to_string Jmap.Capability.Core;
2616
-
Capability.to_string Capability.Submission
2617
-
];
2618
-
method_calls = [
2619
-
{
2620
-
name = "EmailSubmission/get";
2621
-
arguments = `O [
2622
-
("accountId", `String account_id);
2623
-
("ids", `A [`String submission_id]);
2624
-
];
2625
-
method_call_id = "m1";
2626
-
}
2627
-
];
2628
-
created_ids = None;
2629
-
} in
2630
-
2631
-
let* response_result = make_request conn.config request in
2632
-
match response_result with
2633
-
| Ok response ->
2634
-
let result =
2635
-
try
2636
-
let method_response = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) ->
2637
-
inv.name = "EmailSubmission/get") response.method_responses in
2638
-
let args = method_response.arguments in
2639
-
match Ezjsonm.find_opt args ["list"] with
2640
-
| Some (`A [submission]) ->
2641
-
let parse_submission json =
2642
-
try
2643
-
let open Ezjsonm in
2644
-
let id = get_string (find json ["id"]) in
2645
-
let identity_id = get_string (find json ["identityId"]) in
2646
-
let email_id = get_string (find json ["emailId"]) in
2647
-
let thread_id = get_string (find json ["threadId"]) in
2648
-
2649
-
let envelope =
2650
-
match find_opt json ["envelope"] with
2651
-
| Some (`O env) -> begin
2652
-
let parse_address addr_json =
2653
-
let email = get_string (find addr_json ["email"]) in
2654
-
let parameters =
2655
-
match find_opt addr_json ["parameters"] with
2656
-
| Some (`O params) ->
2657
-
Some (List.map (fun (k, v) -> (k, get_string v)) params)
2658
-
| _ -> None
2659
-
in
2660
-
{ Types.email; parameters }
2661
-
in
2662
-
2663
-
let mail_from = parse_address (find (`O env) ["mailFrom"]) in
2664
-
let rcpt_to =
2665
-
match find (`O env) ["rcptTo"] with
2666
-
| `A rcpts -> List.map parse_address rcpts
2667
-
| _ -> []
2668
-
in
2669
-
2670
-
Some { Types.mail_from; rcpt_to }
2671
-
end
2672
-
| _ -> None
2673
-
in
2674
-
2675
-
let send_at =
2676
-
match find_opt json ["sendAt"] with
2677
-
| Some (`String date) -> Some date
2678
-
| _ -> None
2679
-
in
2680
-
2681
-
let undo_status =
2682
-
match find_opt json ["undoStatus"] with
2683
-
| Some (`String "pending") -> Some `pending
2684
-
| Some (`String "final") -> Some `final
2685
-
| Some (`String "canceled") -> Some `canceled
2686
-
| _ -> None
2687
-
in
2688
-
2689
-
let parse_delivery_status deliveries =
2690
-
match deliveries with
2691
-
| `O statuses ->
2692
-
Some (List.map (fun (email, status_json) ->
2693
-
let smtp_reply = get_string (find status_json ["smtpReply"]) in
2694
-
let delivered =
2695
-
match find_opt status_json ["delivered"] with
2696
-
| Some (`String d) -> Some d
2697
-
| _ -> None
2698
-
in
2699
-
(email, { Types.smtp_reply; delivered })
2700
-
) statuses)
2701
-
| _ -> None
2702
-
in
2703
-
2704
-
let delivery_status =
2705
-
match find_opt json ["deliveryStatus"] with
2706
-
| Some status -> parse_delivery_status status
2707
-
| _ -> None
2708
-
in
2709
-
2710
-
let dsn_blob_ids =
2711
-
match find_opt json ["dsnBlobIds"] with
2712
-
| Some (`O ids) -> Some (List.map (fun (email, id) -> (email, get_string id)) ids)
2713
-
| _ -> None
2714
-
in
2715
-
2716
-
let mdn_blob_ids =
2717
-
match find_opt json ["mdnBlobIds"] with
2718
-
| Some (`O ids) -> Some (List.map (fun (email, id) -> (email, get_string id)) ids)
2719
-
| _ -> None
2720
-
in
2721
-
2722
-
Ok {
2723
-
Types.id;
2724
-
identity_id;
2725
-
email_id;
2726
-
thread_id;
2727
-
envelope;
2728
-
send_at;
2729
-
undo_status;
2730
-
delivery_status;
2731
-
dsn_blob_ids;
2732
-
mdn_blob_ids;
2733
-
}
2734
-
with
2735
-
| Not_found -> Error (Parse_error "Required field not found in submission object")
2736
-
| Invalid_argument msg -> Error (Parse_error msg)
2737
-
| e -> Error (Parse_error (Printexc.to_string e))
2738
-
in
2739
-
2740
-
parse_submission submission
2741
-
| Some (`A []) -> Error (Parse_error ("Submission not found: " ^ submission_id))
2742
-
| _ -> Error (Parse_error "Expected single submission in response")
2743
-
with
2744
-
| Not_found -> Error (Parse_error "EmailSubmission/get method response not found")
2745
-
| e -> Error (Parse_error (Printexc.to_string e))
2746
-
in
2747
-
Lwt.return result
2748
-
| Error e -> Lwt.return (Error e)
2749
-
2750
-
(** {1 Email Address Utilities} *)
2751
-
2752
-
(** Custom implementation of substring matching *)
2753
-
let contains_substring str sub =
2754
-
try
2755
-
let _ = Str.search_forward (Str.regexp_string sub) str 0 in
2756
-
true
2757
-
with Not_found -> false
2758
-
2759
-
(** Checks if a pattern with wildcards matches a string
2760
-
@param pattern Pattern string with * and ? wildcards
2761
-
@param str String to match against
2762
-
Based on simple recursive wildcard matching algorithm
2763
-
*)
2764
-
let matches_wildcard pattern str =
2765
-
let pattern_len = String.length pattern in
2766
-
let str_len = String.length str in
2767
-
2768
-
(* Convert both to lowercase for case-insensitive matching *)
2769
-
let pattern = String.lowercase_ascii pattern in
2770
-
let str = String.lowercase_ascii str in
2771
-
2772
-
(* If there are no wildcards, do a simple substring check *)
2773
-
if not (String.contains pattern '*' || String.contains pattern '?') then
2774
-
contains_substring str pattern
2775
-
else
2776
-
(* Classic recursive matching algorithm *)
2777
-
let rec match_from p_pos s_pos =
2778
-
(* Pattern matched to the end *)
2779
-
if p_pos = pattern_len then
2780
-
s_pos = str_len
2781
-
(* Star matches zero or more chars *)
2782
-
else if pattern.[p_pos] = '*' then
2783
-
match_from (p_pos + 1) s_pos || (* Match empty string *)
2784
-
(s_pos < str_len && match_from p_pos (s_pos + 1)) (* Match one more char *)
2785
-
(* If both have more chars and they match or ? wildcard *)
2786
-
else if s_pos < str_len &&
2787
-
(pattern.[p_pos] = '?' || pattern.[p_pos] = str.[s_pos]) then
2788
-
match_from (p_pos + 1) (s_pos + 1)
2789
-
else
2790
-
false
2791
-
in
2792
-
2793
-
match_from 0 0
2794
-
2795
-
(** Check if an email address matches a filter string
2796
-
@param email The email address to check
2797
-
@param pattern The filter pattern to match against
2798
-
@return True if the email address matches the filter
2799
-
*)
2800
-
let email_address_matches email pattern =
2801
-
matches_wildcard pattern email
2802
-
2803
-
(** Check if an email matches a sender filter
2804
-
@param email The email object to check
2805
-
@param pattern The sender filter pattern
2806
-
@return True if any sender address matches the filter
2807
-
*)
2808
-
let email_matches_sender (email : Types.email) pattern =
2809
-
(* Helper to extract emails from address list *)
2810
-
let addresses_match addrs =
2811
-
List.exists (fun (addr : Types.email_address) ->
2812
-
email_address_matches addr.email pattern
2813
-
) addrs
2814
-
in
2815
-
2816
-
(* Check From addresses first *)
2817
-
let from_match =
2818
-
match email.Types.from with
2819
-
| Some addrs -> addresses_match addrs
2820
-
| None -> false
2821
-
in
2822
-
2823
-
(* If no match in From, check Sender field *)
2824
-
if from_match then true
2825
-
else
2826
-
match email.Types.sender with
2827
-
| Some addrs -> addresses_match addrs
2828
-
| None -> false
-1655
lib/jmap_mail.mli
-1655
lib/jmap_mail.mli
···
1
-
(** Implementation of the JMAP Mail extension, as defined in RFC8621
2
-
@see <https://datatracker.ietf.org/doc/html/rfc8621> RFC8621
3
-
4
-
This module implements the JMAP Mail specification, providing types and
5
-
functions for working with emails, mailboxes, threads, and other mail-related
6
-
objects in the JMAP protocol.
7
-
*)
8
-
9
-
(** Module for managing JMAP Mail-specific capability URIs as defined in RFC8621 Section 1.3
10
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-1.3> RFC8621 Section 1.3
11
-
*)
12
-
module Capability : sig
13
-
(** Mail capability URI as defined in RFC8621 Section 1.3
14
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-1.3>
15
-
*)
16
-
val mail_uri : string
17
-
18
-
(** Submission capability URI as defined in RFC8621 Section 1.3
19
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-1.3>
20
-
*)
21
-
val submission_uri : string
22
-
23
-
(** Vacation response capability URI as defined in RFC8621 Section 1.3
24
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-1.3>
25
-
*)
26
-
val vacation_response_uri : string
27
-
28
-
(** All mail extension capability types as defined in RFC8621 Section 1.3
29
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-1.3>
30
-
*)
31
-
type t =
32
-
| Mail (** Mail capability for emails and mailboxes *)
33
-
| Submission (** Submission capability for sending emails *)
34
-
| VacationResponse (** Vacation response capability for auto-replies *)
35
-
| Extension of string (** Custom extension capabilities *)
36
-
37
-
(** Convert capability to URI string
38
-
@param capability The capability to convert
39
-
@return The full URI string for the capability
40
-
*)
41
-
val to_string : t -> string
42
-
43
-
(** Parse a string to a capability
44
-
@param uri The capability URI string to parse
45
-
@return The parsed capability type
46
-
*)
47
-
val of_string : string -> t
48
-
49
-
(** Check if a capability is a standard mail capability
50
-
@param capability The capability to check
51
-
@return True if the capability is a standard JMAP Mail capability
52
-
*)
53
-
val is_standard : t -> bool
54
-
55
-
(** Check if a capability string is a standard mail capability
56
-
@param uri The capability URI string to check
57
-
@return True if the string represents a standard JMAP Mail capability
58
-
*)
59
-
val is_standard_string : string -> bool
60
-
61
-
(** Create a list of capability strings
62
-
@param capabilities List of capability types
63
-
@return List of capability URI strings
64
-
*)
65
-
val strings_of_capabilities : t list -> string list
66
-
end
67
-
68
-
(** Types for the JMAP Mail extension as defined in RFC8621
69
-
@see <https://datatracker.ietf.org/doc/html/rfc8621>
70
-
*)
71
-
module Types : sig
72
-
open Jmap.Types
73
-
74
-
(** {1 Mail capabilities}
75
-
Capability URIs for JMAP Mail extension as defined in RFC8621 Section 1.3
76
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-1.3>
77
-
*)
78
-
79
-
(** Capability URI for JMAP Mail as defined in RFC8621 Section 1.3
80
-
Identifies support for the Mail data model
81
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-1.3>
82
-
*)
83
-
val capability_mail : string
84
-
85
-
(** Capability URI for JMAP Submission as defined in RFC8621 Section 1.3
86
-
Identifies support for email submission
87
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-1.3>
88
-
*)
89
-
val capability_submission : string
90
-
91
-
(** Capability URI for JMAP Vacation Response as defined in RFC8621 Section 1.3
92
-
Identifies support for vacation auto-reply functionality
93
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-1.3>
94
-
*)
95
-
val capability_vacation_response : string
96
-
97
-
(** {1:mailbox Mailbox objects}
98
-
Mailbox types as defined in RFC8621 Section 2
99
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-2>
100
-
*)
101
-
102
-
(** A role for a mailbox as defined in RFC8621 Section 2.
103
-
Standardized roles for special mailboxes like Inbox, Sent, etc.
104
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-2>
105
-
*)
106
-
type mailbox_role =
107
-
| All (** All mail mailbox *)
108
-
| Archive (** Archived mail mailbox *)
109
-
| Drafts (** Draft messages mailbox *)
110
-
| Flagged (** Starred/flagged mail mailbox *)
111
-
| Important (** Important mail mailbox *)
112
-
| Inbox (** Primary inbox mailbox *)
113
-
| Junk (** Spam/Junk mail mailbox *)
114
-
| Sent (** Sent mail mailbox *)
115
-
| Trash (** Deleted/Trash mail mailbox *)
116
-
| Unknown of string (** Server-specific custom roles *)
117
-
118
-
(** A mailbox (folder) in a mail account as defined in RFC8621 Section 2.
119
-
Represents an email folder or label in the account.
120
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-2>
121
-
*)
122
-
type mailbox = {
123
-
id : id; (** Server-assigned ID for the mailbox *)
124
-
name : string; (** User-visible name for the mailbox *)
125
-
parent_id : id option; (** ID of the parent mailbox, if any *)
126
-
role : mailbox_role option; (** The role of this mailbox, if it's a special mailbox *)
127
-
sort_order : unsigned_int; (** Position for mailbox in the UI *)
128
-
total_emails : unsigned_int; (** Total number of emails in the mailbox *)
129
-
unread_emails : unsigned_int; (** Number of unread emails in the mailbox *)
130
-
total_threads : unsigned_int; (** Total number of threads in the mailbox *)
131
-
unread_threads : unsigned_int; (** Number of threads with unread emails *)
132
-
is_subscribed : bool; (** Has the user subscribed to this mailbox *)
133
-
my_rights : mailbox_rights; (** Access rights for the user on this mailbox *)
134
-
}
135
-
136
-
(** Rights for a mailbox as defined in RFC8621 Section 2.
137
-
Determines the operations a user can perform on a mailbox.
138
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-2>
139
-
*)
140
-
and mailbox_rights = {
141
-
may_read_items : bool; (** Can the user read messages in this mailbox *)
142
-
may_add_items : bool; (** Can the user add messages to this mailbox *)
143
-
may_remove_items : bool; (** Can the user remove messages from this mailbox *)
144
-
may_set_seen : bool; (** Can the user mark messages as read/unread *)
145
-
may_set_keywords : bool; (** Can the user set keywords/flags on messages *)
146
-
may_create_child : bool; (** Can the user create child mailboxes *)
147
-
may_rename : bool; (** Can the user rename this mailbox *)
148
-
may_delete : bool; (** Can the user delete this mailbox *)
149
-
may_submit : bool; (** Can the user submit messages in this mailbox for delivery *)
150
-
}
151
-
152
-
(** Filter condition for mailbox queries as defined in RFC8621 Section 2.3.
153
-
Used to filter mailboxes in queries.
154
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-2.3>
155
-
*)
156
-
type mailbox_filter_condition = {
157
-
parent_id : id option; (** Only include mailboxes with this parent *)
158
-
name : string option; (** Only include mailboxes with this name (case-insensitive substring match) *)
159
-
role : string option; (** Only include mailboxes with this role *)
160
-
has_any_role : bool option; (** If true, only include mailboxes with a role, if false those without *)
161
-
is_subscribed : bool option; (** If true, only include subscribed mailboxes, if false unsubscribed *)
162
-
}
163
-
164
-
(** Filter for mailbox queries as defined in RFC8621 Section 2.3.
165
-
Complex filter for Mailbox/query method.
166
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-2.3>
167
-
*)
168
-
type mailbox_query_filter = [
169
-
| `And of mailbox_query_filter list (** Logical AND of filters *)
170
-
| `Or of mailbox_query_filter list (** Logical OR of filters *)
171
-
| `Not of mailbox_query_filter (** Logical NOT of a filter *)
172
-
| `Condition of mailbox_filter_condition (** Simple condition filter *)
173
-
]
174
-
175
-
(** Mailbox/get request arguments as defined in RFC8621 Section 2.1.
176
-
Used to fetch mailboxes by ID.
177
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-2.1>
178
-
*)
179
-
type mailbox_get_arguments = {
180
-
account_id : id; (** The account to fetch mailboxes from *)
181
-
ids : id list option; (** The IDs of mailboxes to fetch, null means all *)
182
-
properties : string list option; (** Properties to return, null means all *)
183
-
}
184
-
185
-
(** Mailbox/get response as defined in RFC8621 Section 2.1.
186
-
Contains requested mailboxes.
187
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-2.1>
188
-
*)
189
-
type mailbox_get_response = {
190
-
account_id : id; (** The account from which mailboxes were fetched *)
191
-
state : string; (** A string representing the state on the server *)
192
-
list : mailbox list; (** The list of mailboxes requested *)
193
-
not_found : id list; (** IDs requested that could not be found *)
194
-
}
195
-
196
-
(** Mailbox/changes request arguments as defined in RFC8621 Section 2.2.
197
-
Used to get mailbox changes since a previous state.
198
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-2.2>
199
-
*)
200
-
type mailbox_changes_arguments = {
201
-
account_id : id; (** The account to get changes for *)
202
-
since_state : string; (** The previous state to compare to *)
203
-
max_changes : unsigned_int option; (** Maximum number of changes to return *)
204
-
}
205
-
206
-
(** Mailbox/changes response as defined in RFC8621 Section 2.2.
207
-
Reports mailboxes that have changed since a previous state.
208
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-2.2>
209
-
*)
210
-
type mailbox_changes_response = {
211
-
account_id : id; (** The account changes are for *)
212
-
old_state : string; (** The state provided in the request *)
213
-
new_state : string; (** The current state on the server *)
214
-
has_more_changes : bool; (** If true, more changes are available *)
215
-
created : id list; (** IDs of mailboxes created since old_state *)
216
-
updated : id list; (** IDs of mailboxes updated since old_state *)
217
-
destroyed : id list; (** IDs of mailboxes destroyed since old_state *)
218
-
}
219
-
220
-
(** Mailbox/query request arguments as defined in RFC8621 Section 2.3.
221
-
Used to query mailboxes based on filter criteria.
222
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-2.3>
223
-
*)
224
-
type mailbox_query_arguments = {
225
-
account_id : id; (** The account to query *)
226
-
filter : mailbox_query_filter option; (** Filter to match mailboxes against *)
227
-
sort : [ `name | `role | `sort_order ] list option; (** Sort criteria *)
228
-
limit : unsigned_int option; (** Maximum number of results to return *)
229
-
}
230
-
231
-
(** Mailbox/query response as defined in RFC8621 Section 2.3.
232
-
Contains IDs of mailboxes matching the query.
233
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-2.3>
234
-
*)
235
-
type mailbox_query_response = {
236
-
account_id : id; (** The account that was queried *)
237
-
query_state : string; (** State string for the query results *)
238
-
can_calculate_changes : bool; (** Whether queryChanges can be used with these results *)
239
-
position : unsigned_int; (** Zero-based index of the first result *)
240
-
ids : id list; (** IDs of mailboxes matching the query *)
241
-
total : unsigned_int option; (** Total number of matches if requested *)
242
-
}
243
-
244
-
(** Mailbox/queryChanges request arguments as defined in RFC8621 Section 2.4.
245
-
Used to get changes to mailbox query results.
246
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-2.4>
247
-
*)
248
-
type mailbox_query_changes_arguments = {
249
-
account_id : id; (** The account to query *)
250
-
filter : mailbox_query_filter option; (** Same filter as the original query *)
251
-
sort : [ `name | `role | `sort_order ] list option; (** Same sort as the original query *)
252
-
since_query_state : string; (** The query_state from the previous result *)
253
-
max_changes : unsigned_int option; (** Maximum number of changes to return *)
254
-
up_to_id : id option; (** ID of the last mailbox to check for changes *)
255
-
}
256
-
257
-
(** Mailbox/queryChanges response as defined in RFC8621 Section 2.4.
258
-
Reports changes to a mailbox query since the previous state.
259
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-2.4>
260
-
*)
261
-
type mailbox_query_changes_response = {
262
-
account_id : id; (** The account that was queried *)
263
-
old_query_state : string; (** The query_state from the request *)
264
-
new_query_state : string; (** The current query_state on the server *)
265
-
total : unsigned_int option; (** Updated total number of matches, if requested *)
266
-
removed : id list; (** IDs that were in the old results but not the new *)
267
-
added : mailbox_query_changes_added list; (** IDs that are in the new results but not the old *)
268
-
}
269
-
270
-
(** Added item in mailbox query changes as defined in RFC8621 Section 2.4.
271
-
Represents a mailbox added to query results.
272
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-2.4>
273
-
*)
274
-
and mailbox_query_changes_added = {
275
-
id : id; (** ID of the added mailbox *)
276
-
index : unsigned_int; (** Zero-based index of the added mailbox in the results *)
277
-
}
278
-
279
-
(** Mailbox/set request arguments as defined in RFC8621 Section 2.5.
280
-
Used to create, update, and destroy mailboxes.
281
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-2.5>
282
-
*)
283
-
type mailbox_set_arguments = {
284
-
account_id : id; (** The account to make changes in *)
285
-
if_in_state : string option; (** Only apply changes if in this state *)
286
-
create : (id * mailbox_creation) list option; (** Map of creation IDs to mailboxes to create *)
287
-
update : (id * mailbox_update) list option; (** Map of IDs to update properties *)
288
-
destroy : id list option; (** List of IDs to destroy *)
289
-
}
290
-
291
-
(** Properties for mailbox creation as defined in RFC8621 Section 2.5.
292
-
Used to create new mailboxes.
293
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-2.5>
294
-
*)
295
-
and mailbox_creation = {
296
-
name : string; (** Name for the new mailbox *)
297
-
parent_id : id option; (** ID of the parent mailbox, if any *)
298
-
role : string option; (** Role for the mailbox, if it's a special-purpose mailbox *)
299
-
sort_order : unsigned_int option; (** Sort order, defaults to 0 *)
300
-
is_subscribed : bool option; (** Whether the mailbox is subscribed, defaults to true *)
301
-
}
302
-
303
-
(** Properties for mailbox update as defined in RFC8621 Section 2.5.
304
-
Used to update existing mailboxes.
305
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-2.5>
306
-
*)
307
-
and mailbox_update = {
308
-
name : string option; (** New name for the mailbox *)
309
-
parent_id : id option; (** New parent ID for the mailbox *)
310
-
role : string option; (** New role for the mailbox *)
311
-
sort_order : unsigned_int option; (** New sort order for the mailbox *)
312
-
is_subscribed : bool option; (** New subscription status for the mailbox *)
313
-
}
314
-
315
-
(** Mailbox/set response as defined in RFC8621 Section 2.5.
316
-
Reports the results of mailbox changes.
317
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-2.5>
318
-
*)
319
-
type mailbox_set_response = {
320
-
account_id : id; (** The account that was modified *)
321
-
old_state : string option; (** The state before processing, if changed *)
322
-
new_state : string; (** The current state on the server *)
323
-
created : (id * mailbox) list option; (** Map of creation IDs to created mailboxes *)
324
-
updated : id list option; (** List of IDs that were successfully updated *)
325
-
destroyed : id list option; (** List of IDs that were successfully destroyed *)
326
-
not_created : (id * set_error) list option; (** Map of IDs to errors for failed creates *)
327
-
not_updated : (id * set_error) list option; (** Map of IDs to errors for failed updates *)
328
-
not_destroyed : (id * set_error) list option; (** Map of IDs to errors for failed destroys *)
329
-
}
330
-
331
-
(** {1:thread Thread objects}
332
-
Thread types as defined in RFC8621 Section 3
333
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-3>
334
-
*)
335
-
336
-
(** A thread in a mail account as defined in RFC8621 Section 3.
337
-
Represents a group of related email messages.
338
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-3>
339
-
*)
340
-
type thread = {
341
-
id : id; (** Server-assigned ID for the thread *)
342
-
email_ids : id list; (** IDs of emails in the thread *)
343
-
}
344
-
345
-
(** Thread/get request arguments as defined in RFC8621 Section 3.1.
346
-
Used to fetch threads by ID.
347
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-3.1>
348
-
*)
349
-
type thread_get_arguments = {
350
-
account_id : id; (** The account to fetch threads from *)
351
-
ids : id list option; (** The IDs of threads to fetch, null means all *)
352
-
properties : string list option; (** Properties to return, null means all *)
353
-
}
354
-
355
-
(** Thread/get response as defined in RFC8621 Section 3.1.
356
-
Contains requested threads.
357
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-3.1>
358
-
*)
359
-
type thread_get_response = {
360
-
account_id : id; (** The account from which threads were fetched *)
361
-
state : string; (** A string representing the state on the server *)
362
-
list : thread list; (** The list of threads requested *)
363
-
not_found : id list; (** IDs requested that could not be found *)
364
-
}
365
-
366
-
(** Thread/changes request arguments as defined in RFC8621 Section 3.2.
367
-
Used to get thread changes since a previous state.
368
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-3.2>
369
-
*)
370
-
type thread_changes_arguments = {
371
-
account_id : id; (** The account to get changes for *)
372
-
since_state : string; (** The previous state to compare to *)
373
-
max_changes : unsigned_int option; (** Maximum number of changes to return *)
374
-
}
375
-
376
-
(** Thread/changes response as defined in RFC8621 Section 3.2.
377
-
Reports threads that have changed since a previous state.
378
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-3.2>
379
-
*)
380
-
type thread_changes_response = {
381
-
account_id : id; (** The account changes are for *)
382
-
old_state : string; (** The state provided in the request *)
383
-
new_state : string; (** The current state on the server *)
384
-
has_more_changes : bool; (** If true, more changes are available *)
385
-
created : id list; (** IDs of threads created since old_state *)
386
-
updated : id list; (** IDs of threads updated since old_state *)
387
-
destroyed : id list; (** IDs of threads destroyed since old_state *)
388
-
}
389
-
390
-
(** {1:email Email objects}
391
-
Email types as defined in RFC8621 Section 4
392
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-4>
393
-
*)
394
-
395
-
(** Addressing (mailbox) information as defined in RFC8621 Section 4.1.1.
396
-
Represents an email address with optional display name.
397
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.1.1>
398
-
*)
399
-
type email_address = {
400
-
name : string option; (** Display name of the mailbox (e.g., "John Doe") *)
401
-
email : string; (** The email address (e.g., "john@example.com") *)
402
-
parameters : (string * string) list; (** Additional parameters for the address *)
403
-
}
404
-
405
-
(** Message header field as defined in RFC8621 Section 4.1.2.
406
-
Represents an email header.
407
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.1.2>
408
-
*)
409
-
type header = {
410
-
name : string; (** Name of the header field (e.g., "Subject") *)
411
-
value : string; (** Value of the header field *)
412
-
}
413
-
414
-
(** Email keyword (flag) as defined in RFC8621 Section 4.3.
415
-
Represents a flag or tag on an email message.
416
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.3>
417
-
*)
418
-
type keyword =
419
-
| Flagged (** Message is flagged/starred *)
420
-
| Answered (** Message has been replied to *)
421
-
| Draft (** Message is a draft *)
422
-
| Forwarded (** Message has been forwarded *)
423
-
| Phishing (** Message has been reported as phishing *)
424
-
| Junk (** Message is spam/junk *)
425
-
| NotJunk (** Message is explicitly not spam *)
426
-
| Seen (** Message has been read *)
427
-
| Unread (** Message is unread (inverse of $seen) *)
428
-
| Custom of string (** Custom/non-standard keywords *)
429
-
430
-
(** Email message as defined in RFC8621 Section 4.
431
-
Represents an email message in a mail account.
432
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-4>
433
-
*)
434
-
type email = {
435
-
id : id; (** Server-assigned ID for the message *)
436
-
blob_id : id; (** ID of the raw message content blob *)
437
-
thread_id : id; (** ID of the thread this message belongs to *)
438
-
mailbox_ids : (id * bool) list; (** Map of mailbox IDs to boolean (whether message belongs to mailbox) *)
439
-
keywords : (keyword * bool) list; (** Map of keywords to boolean (whether message has keyword) *)
440
-
size : unsigned_int; (** Size of the message in octets *)
441
-
received_at : utc_date; (** When the message was received by the server *)
442
-
message_id : string list; (** Message-ID header values *)
443
-
in_reply_to : string list option; (** In-Reply-To header values *)
444
-
references : string list option; (** References header values *)
445
-
sender : email_address list option; (** Sender header addresses *)
446
-
from : email_address list option; (** From header addresses *)
447
-
to_ : email_address list option; (** To header addresses *)
448
-
cc : email_address list option; (** Cc header addresses *)
449
-
bcc : email_address list option; (** Bcc header addresses *)
450
-
reply_to : email_address list option; (** Reply-To header addresses *)
451
-
subject : string option; (** Subject header value *)
452
-
sent_at : utc_date option; (** Date header value as a date-time *)
453
-
has_attachment : bool option; (** Does the message have any attachments *)
454
-
preview : string option; (** Preview of the message (first bit of text) *)
455
-
body_values : (string * string) list option; (** Map of part IDs to text content *)
456
-
text_body : email_body_part list option; (** Plain text message body parts *)
457
-
html_body : email_body_part list option; (** HTML message body parts *)
458
-
attachments : email_body_part list option; (** Attachment parts in the message *)
459
-
headers : header list option; (** All headers in the message *)
460
-
}
461
-
462
-
(** Email body part as defined in RFC8621 Section 4.1.4.
463
-
Represents a MIME part in an email message.
464
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.1.4>
465
-
*)
466
-
and email_body_part = {
467
-
part_id : string option; (** Server-assigned ID for the MIME part *)
468
-
blob_id : id option; (** ID of the raw content for this part *)
469
-
size : unsigned_int option; (** Size of the part in octets *)
470
-
headers : header list option; (** Headers for this MIME part *)
471
-
name : string option; (** Filename of this part, if any *)
472
-
type_ : string option; (** MIME type of the part *)
473
-
charset : string option; (** Character set of the part, if applicable *)
474
-
disposition : string option; (** Content-Disposition value *)
475
-
cid : string option; (** Content-ID value *)
476
-
language : string list option; (** Content-Language values *)
477
-
location : string option; (** Content-Location value *)
478
-
sub_parts : email_body_part list option; (** Child MIME parts for multipart types *)
479
-
header_parameter_name : string option; (** Header parameter name (for headers with parameters) *)
480
-
header_parameter_value : string option; (** Header parameter value (for headers with parameters) *)
481
-
}
482
-
483
-
(** Email query filter condition as defined in RFC8621 Section 4.4.
484
-
Specifies conditions for filtering emails in queries.
485
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.4>
486
-
*)
487
-
type email_filter_condition = {
488
-
in_mailbox : id option; (** Only include emails in this mailbox *)
489
-
in_mailbox_other_than : id list option; (** Only include emails not in these mailboxes *)
490
-
min_size : unsigned_int option; (** Only include emails of at least this size in octets *)
491
-
max_size : unsigned_int option; (** Only include emails of at most this size in octets *)
492
-
before : utc_date option; (** Only include emails received before this date-time *)
493
-
after : utc_date option; (** Only include emails received after this date-time *)
494
-
header : (string * string) option; (** Only include emails with header matching value (name, value) *)
495
-
from : string option; (** Only include emails with From containing this text *)
496
-
to_ : string option; (** Only include emails with To containing this text *)
497
-
cc : string option; (** Only include emails with CC containing this text *)
498
-
bcc : string option; (** Only include emails with BCC containing this text *)
499
-
subject : string option; (** Only include emails with Subject containing this text *)
500
-
body : string option; (** Only include emails with body containing this text *)
501
-
has_keyword : string option; (** Only include emails with this keyword *)
502
-
not_keyword : string option; (** Only include emails without this keyword *)
503
-
has_attachment : bool option; (** If true, only include emails with attachments *)
504
-
text : string option; (** Only include emails with this text in headers or body *)
505
-
}
506
-
507
-
(** Filter for email queries as defined in RFC8621 Section 4.4.
508
-
Complex filter for Email/query method.
509
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.4>
510
-
*)
511
-
type email_query_filter = [
512
-
| `And of email_query_filter list (** Logical AND of filters *)
513
-
| `Or of email_query_filter list (** Logical OR of filters *)
514
-
| `Not of email_query_filter (** Logical NOT of a filter *)
515
-
| `Condition of email_filter_condition (** Simple condition filter *)
516
-
]
517
-
518
-
(** Email/get request arguments as defined in RFC8621 Section 4.5.
519
-
Used to fetch emails by ID.
520
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.5>
521
-
*)
522
-
type email_get_arguments = {
523
-
account_id : id; (** The account to fetch emails from *)
524
-
ids : id list option; (** The IDs of emails to fetch, null means all *)
525
-
properties : string list option; (** Properties to return, null means all *)
526
-
body_properties : string list option; (** Properties to return on body parts *)
527
-
fetch_text_body_values : bool option; (** Whether to fetch text body content *)
528
-
fetch_html_body_values : bool option; (** Whether to fetch HTML body content *)
529
-
fetch_all_body_values : bool option; (** Whether to fetch all body content *)
530
-
max_body_value_bytes : unsigned_int option; (** Maximum size of body values to return *)
531
-
}
532
-
533
-
(** Email/get response as defined in RFC8621 Section 4.5.
534
-
Contains requested emails.
535
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.5>
536
-
*)
537
-
type email_get_response = {
538
-
account_id : id; (** The account from which emails were fetched *)
539
-
state : string; (** A string representing the state on the server *)
540
-
list : email list; (** The list of emails requested *)
541
-
not_found : id list; (** IDs requested that could not be found *)
542
-
}
543
-
544
-
(** Email/changes request arguments as defined in RFC8621 Section 4.6.
545
-
Used to get email changes since a previous state.
546
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.6>
547
-
*)
548
-
type email_changes_arguments = {
549
-
account_id : id; (** The account to get changes for *)
550
-
since_state : string; (** The previous state to compare to *)
551
-
max_changes : unsigned_int option; (** Maximum number of changes to return *)
552
-
}
553
-
554
-
(** Email/changes response as defined in RFC8621 Section 4.6.
555
-
Reports emails that have changed since a previous state.
556
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.6>
557
-
*)
558
-
type email_changes_response = {
559
-
account_id : id; (** The account changes are for *)
560
-
old_state : string; (** The state provided in the request *)
561
-
new_state : string; (** The current state on the server *)
562
-
has_more_changes : bool; (** If true, more changes are available *)
563
-
created : id list; (** IDs of emails created since old_state *)
564
-
updated : id list; (** IDs of emails updated since old_state *)
565
-
destroyed : id list; (** IDs of emails destroyed since old_state *)
566
-
}
567
-
568
-
(** Email/query request arguments as defined in RFC8621 Section 4.4.
569
-
Used to query emails based on filter criteria.
570
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.4>
571
-
*)
572
-
type email_query_arguments = {
573
-
account_id : id; (** The account to query *)
574
-
filter : email_query_filter option; (** Filter to match emails against *)
575
-
sort : comparator list option; (** Sort criteria *)
576
-
collapse_threads : bool option; (** Whether to collapse threads in the results *)
577
-
position : unsigned_int option; (** Zero-based index of first result to return *)
578
-
anchor : id option; (** ID of email to use as reference point *)
579
-
anchor_offset : int_t option; (** Offset from anchor to start returning results *)
580
-
limit : unsigned_int option; (** Maximum number of results to return *)
581
-
calculate_total : bool option; (** Whether to calculate the total number of matching emails *)
582
-
}
583
-
584
-
(** Email/query response as defined in RFC8621 Section 4.4.
585
-
Contains IDs of emails matching the query.
586
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.4>
587
-
*)
588
-
type email_query_response = {
589
-
account_id : id; (** The account that was queried *)
590
-
query_state : string; (** State string for the query results *)
591
-
can_calculate_changes : bool; (** Whether queryChanges can be used with these results *)
592
-
position : unsigned_int; (** Zero-based index of the first result *)
593
-
ids : id list; (** IDs of emails matching the query *)
594
-
total : unsigned_int option; (** Total number of matches if requested *)
595
-
thread_ids : id list option; (** IDs of threads if collapse_threads was true *)
596
-
}
597
-
598
-
(** Email/queryChanges request arguments as defined in RFC8621 Section 4.7.
599
-
Used to get changes to email query results.
600
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.7>
601
-
*)
602
-
type email_query_changes_arguments = {
603
-
account_id : id; (** The account to query *)
604
-
filter : email_query_filter option; (** Same filter as the original query *)
605
-
sort : comparator list option; (** Same sort as the original query *)
606
-
collapse_threads : bool option; (** Same collapse_threads as the original query *)
607
-
since_query_state : string; (** The query_state from the previous result *)
608
-
max_changes : unsigned_int option; (** Maximum number of changes to return *)
609
-
up_to_id : id option; (** ID of the last email to check for changes *)
610
-
}
611
-
612
-
(** Email/queryChanges response as defined in RFC8621 Section 4.7.
613
-
Reports changes to an email query since the previous state.
614
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.7>
615
-
*)
616
-
type email_query_changes_response = {
617
-
account_id : id; (** The account that was queried *)
618
-
old_query_state : string; (** The query_state from the request *)
619
-
new_query_state : string; (** The current query_state on the server *)
620
-
total : unsigned_int option; (** Updated total number of matches, if requested *)
621
-
removed : id list; (** IDs that were in the old results but not the new *)
622
-
added : email_query_changes_added list; (** IDs that are in the new results but not the old *)
623
-
}
624
-
625
-
(** Added item in email query changes as defined in RFC8621 Section 4.7.
626
-
Represents an email added to query results.
627
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.7>
628
-
*)
629
-
and email_query_changes_added = {
630
-
id : id; (** ID of the added email *)
631
-
index : unsigned_int; (** Zero-based index of the added email in the results *)
632
-
}
633
-
634
-
(** Email/set request arguments as defined in RFC8621 Section 4.8.
635
-
Used to create, update, and destroy emails.
636
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.8>
637
-
*)
638
-
type email_set_arguments = {
639
-
account_id : id; (** The account to make changes in *)
640
-
if_in_state : string option; (** Only apply changes if in this state *)
641
-
create : (id * email_creation) list option; (** Map of creation IDs to emails to create *)
642
-
update : (id * email_update) list option; (** Map of IDs to update properties *)
643
-
destroy : id list option; (** List of IDs to destroy *)
644
-
}
645
-
646
-
(** Properties for email creation as defined in RFC8621 Section 4.8.
647
-
Used to create new emails.
648
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.8>
649
-
*)
650
-
and email_creation = {
651
-
mailbox_ids : (id * bool) list; (** Map of mailbox IDs to boolean (whether message belongs to mailbox) *)
652
-
keywords : (keyword * bool) list option; (** Map of keywords to boolean (whether message has keyword) *)
653
-
received_at : utc_date option; (** When the message was received by the server *)
654
-
message_id : string list option; (** Message-ID header values *)
655
-
in_reply_to : string list option; (** In-Reply-To header values *)
656
-
references : string list option; (** References header values *)
657
-
sender : email_address list option; (** Sender header addresses *)
658
-
from : email_address list option; (** From header addresses *)
659
-
to_ : email_address list option; (** To header addresses *)
660
-
cc : email_address list option; (** Cc header addresses *)
661
-
bcc : email_address list option; (** Bcc header addresses *)
662
-
reply_to : email_address list option; (** Reply-To header addresses *)
663
-
subject : string option; (** Subject header value *)
664
-
body_values : (string * string) list option; (** Map of part IDs to text content *)
665
-
text_body : email_body_part list option; (** Plain text message body parts *)
666
-
html_body : email_body_part list option; (** HTML message body parts *)
667
-
attachments : email_body_part list option; (** Attachment parts in the message *)
668
-
headers : header list option; (** All headers in the message *)
669
-
}
670
-
671
-
(** Properties for email update as defined in RFC8621 Section 4.8.
672
-
Used to update existing emails.
673
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.8>
674
-
*)
675
-
and email_update = {
676
-
keywords : (keyword * bool) list option; (** New keywords to set on the email *)
677
-
mailbox_ids : (id * bool) list option; (** New mailboxes to set for the email *)
678
-
}
679
-
680
-
(** Email/set response as defined in RFC8621 Section 4.8.
681
-
Reports the results of email changes.
682
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.8>
683
-
*)
684
-
type email_set_response = {
685
-
account_id : id; (** The account that was modified *)
686
-
old_state : string option; (** The state before processing, if changed *)
687
-
new_state : string; (** The current state on the server *)
688
-
created : (id * email) list option; (** Map of creation IDs to created emails *)
689
-
updated : id list option; (** List of IDs that were successfully updated *)
690
-
destroyed : id list option; (** List of IDs that were successfully destroyed *)
691
-
not_created : (id * set_error) list option; (** Map of IDs to errors for failed creates *)
692
-
not_updated : (id * set_error) list option; (** Map of IDs to errors for failed updates *)
693
-
not_destroyed : (id * set_error) list option; (** Map of IDs to errors for failed destroys *)
694
-
}
695
-
696
-
(** Email/copy request arguments as defined in RFC8621 Section 4.9.
697
-
Used to copy emails between accounts.
698
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.9>
699
-
*)
700
-
type email_copy_arguments = {
701
-
from_account_id : id; (** The account to copy emails from *)
702
-
account_id : id; (** The account to copy emails to *)
703
-
create : (id * email_creation) list; (** Map of creation IDs to email creation properties *)
704
-
on_success_destroy_original : bool option; (** Whether to destroy originals after copying *)
705
-
}
706
-
707
-
(** Email/copy response as defined in RFC8621 Section 4.9.
708
-
Reports the results of copying emails.
709
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.9>
710
-
*)
711
-
type email_copy_response = {
712
-
from_account_id : id; (** The account emails were copied from *)
713
-
account_id : id; (** The account emails were copied to *)
714
-
created : (id * email) list option; (** Map of creation IDs to created emails *)
715
-
not_created : (id * set_error) list option; (** Map of IDs to errors for failed copies *)
716
-
}
717
-
718
-
(** Email/import request arguments as defined in RFC8621 Section 4.10.
719
-
Used to import raw emails from blobs.
720
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.10>
721
-
*)
722
-
type email_import_arguments = {
723
-
account_id : id; (** The account to import emails into *)
724
-
emails : (id * email_import) list; (** Map of creation IDs to import properties *)
725
-
}
726
-
727
-
(** Properties for email import as defined in RFC8621 Section 4.10.
728
-
Used to import raw emails from blobs.
729
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.10>
730
-
*)
731
-
and email_import = {
732
-
blob_id : id; (** ID of the blob containing the raw message *)
733
-
mailbox_ids : (id * bool) list; (** Map of mailbox IDs to boolean (whether message belongs to mailbox) *)
734
-
keywords : (keyword * bool) list option; (** Map of keywords to boolean (whether message has keyword) *)
735
-
received_at : utc_date option; (** When the message was received, defaults to now *)
736
-
}
737
-
738
-
(** Email/import response as defined in RFC8621 Section 4.10.
739
-
Reports the results of importing emails.
740
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.10>
741
-
*)
742
-
type email_import_response = {
743
-
account_id : id; (** The account emails were imported into *)
744
-
created : (id * email) list option; (** Map of creation IDs to created emails *)
745
-
not_created : (id * set_error) list option; (** Map of IDs to errors for failed imports *)
746
-
}
747
-
748
-
(** {1:search_snippet Search snippets}
749
-
Search snippet types as defined in RFC8621 Section 4.11
750
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.11>
751
-
*)
752
-
753
-
(** SearchSnippet/get request arguments as defined in RFC8621 Section 4.11.
754
-
Used to get highlighted snippets from emails matching a search.
755
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.11>
756
-
*)
757
-
type search_snippet_get_arguments = {
758
-
account_id : id; (** The account to search in *)
759
-
email_ids : id list; (** The IDs of emails to get snippets for *)
760
-
filter : email_filter_condition; (** Filter containing the text to find and highlight *)
761
-
}
762
-
763
-
(** SearchSnippet/get response as defined in RFC8621 Section 4.11.
764
-
Contains search result snippets with highlighted text.
765
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.11>
766
-
*)
767
-
type search_snippet_get_response = {
768
-
account_id : id; (** The account that was searched *)
769
-
list : (id * search_snippet) list; (** Map of email IDs to their search snippets *)
770
-
not_found : id list; (** IDs for which no snippet could be generated *)
771
-
}
772
-
773
-
(** Search snippet for an email as defined in RFC8621 Section 4.11.
774
-
Contains highlighted parts of emails matching a search.
775
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-4.11>
776
-
*)
777
-
and search_snippet = {
778
-
subject : string option; (** Subject with search terms highlighted *)
779
-
preview : string option; (** Email body preview with search terms highlighted *)
780
-
}
781
-
782
-
(** {1:submission EmailSubmission objects}
783
-
Email submission types as defined in RFC8621 Section 5
784
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-5>
785
-
*)
786
-
787
-
(** EmailSubmission address as defined in RFC8621 Section 5.1.
788
-
Represents an email address for mail submission.
789
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-5.1>
790
-
*)
791
-
type submission_address = {
792
-
email : string; (** The email address (e.g., "john@example.com") *)
793
-
parameters : (string * string) list option; (** SMTP extension parameters *)
794
-
}
795
-
796
-
(** Email submission object as defined in RFC8621 Section 5.1.
797
-
Represents an email that has been or will be sent.
798
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-5.1>
799
-
*)
800
-
type email_submission = {
801
-
id : id; (** Server-assigned ID for the submission *)
802
-
identity_id : id; (** ID of the identity used to send the email *)
803
-
email_id : id; (** ID of the email to send *)
804
-
thread_id : id; (** ID of the thread containing the message *)
805
-
envelope : envelope option; (** SMTP envelope for the message *)
806
-
send_at : utc_date option; (** When to send the email, null for immediate *)
807
-
undo_status : [
808
-
| `pending (** Submission can still be canceled *)
809
-
| `final (** Submission can no longer be canceled *)
810
-
| `canceled (** Submission was canceled *)
811
-
] option; (** Current undo status of the submission *)
812
-
delivery_status : (string * submission_status) list option; (** Map of recipient to delivery status *)
813
-
dsn_blob_ids : (string * id) list option; (** Map of recipient to DSN blob ID *)
814
-
mdn_blob_ids : (string * id) list option; (** Map of recipient to MDN blob ID *)
815
-
}
816
-
817
-
(** Envelope for mail submission as defined in RFC8621 Section 5.1.
818
-
Represents the SMTP envelope for a message.
819
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-5.1>
820
-
*)
821
-
and envelope = {
822
-
mail_from : submission_address; (** Return path for the message *)
823
-
rcpt_to : submission_address list; (** Recipients for the message *)
824
-
}
825
-
826
-
(** Delivery status for submitted email as defined in RFC8621 Section 5.1.
827
-
Represents the SMTP status of a delivery attempt.
828
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-5.1>
829
-
*)
830
-
and submission_status = {
831
-
smtp_reply : string; (** SMTP response from the server *)
832
-
delivered : string option; (** Timestamp when message was delivered, if successful *)
833
-
}
834
-
835
-
(** EmailSubmission/get request arguments as defined in RFC8621 Section 5.3.
836
-
Used to fetch email submissions by ID.
837
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-5.3>
838
-
*)
839
-
type email_submission_get_arguments = {
840
-
account_id : id; (** The account to fetch submissions from *)
841
-
ids : id list option; (** The IDs of submissions to fetch, null means all *)
842
-
properties : string list option; (** Properties to return, null means all *)
843
-
}
844
-
845
-
(** EmailSubmission/get response as defined in RFC8621 Section 5.3.
846
-
Contains requested email submissions.
847
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-5.3>
848
-
*)
849
-
type email_submission_get_response = {
850
-
account_id : id; (** The account from which submissions were fetched *)
851
-
state : string; (** A string representing the state on the server *)
852
-
list : email_submission list; (** The list of submissions requested *)
853
-
not_found : id list; (** IDs requested that could not be found *)
854
-
}
855
-
856
-
(** EmailSubmission/changes request arguments as defined in RFC8621 Section 5.4.
857
-
Used to get submission changes since a previous state.
858
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-5.4>
859
-
*)
860
-
type email_submission_changes_arguments = {
861
-
account_id : id; (** The account to get changes for *)
862
-
since_state : string; (** The previous state to compare to *)
863
-
max_changes : unsigned_int option; (** Maximum number of changes to return *)
864
-
}
865
-
866
-
(** EmailSubmission/changes response as defined in RFC8621 Section 5.4.
867
-
Reports submissions that have changed since a previous state.
868
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-5.4>
869
-
*)
870
-
type email_submission_changes_response = {
871
-
account_id : id; (** The account changes are for *)
872
-
old_state : string; (** The state provided in the request *)
873
-
new_state : string; (** The current state on the server *)
874
-
has_more_changes : bool; (** If true, more changes are available *)
875
-
created : id list; (** IDs of submissions created since old_state *)
876
-
updated : id list; (** IDs of submissions updated since old_state *)
877
-
destroyed : id list; (** IDs of submissions destroyed since old_state *)
878
-
}
879
-
880
-
(** EmailSubmission/query filter condition as defined in RFC8621 Section 5.5.
881
-
Specifies conditions for filtering email submissions in queries.
882
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-5.5>
883
-
*)
884
-
type email_submission_filter_condition = {
885
-
identity_id : id option; (** Only include submissions with this identity *)
886
-
email_id : id option; (** Only include submissions for this email *)
887
-
thread_id : id option; (** Only include submissions for emails in this thread *)
888
-
before : utc_date option; (** Only include submissions created before this date-time *)
889
-
after : utc_date option; (** Only include submissions created after this date-time *)
890
-
subject : string option; (** Only include submissions with matching subjects *)
891
-
}
892
-
893
-
(** Filter for email submission queries as defined in RFC8621 Section 5.5.
894
-
Complex filter for EmailSubmission/query method.
895
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-5.5>
896
-
*)
897
-
type email_submission_query_filter = [
898
-
| `And of email_submission_query_filter list (** Logical AND of filters *)
899
-
| `Or of email_submission_query_filter list (** Logical OR of filters *)
900
-
| `Not of email_submission_query_filter (** Logical NOT of a filter *)
901
-
| `Condition of email_submission_filter_condition (** Simple condition filter *)
902
-
]
903
-
904
-
(** EmailSubmission/query request arguments as defined in RFC8621 Section 5.5.
905
-
Used to query email submissions based on filter criteria.
906
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-5.5>
907
-
*)
908
-
type email_submission_query_arguments = {
909
-
account_id : id; (** The account to query *)
910
-
filter : email_submission_query_filter option; (** Filter to match submissions against *)
911
-
sort : comparator list option; (** Sort criteria *)
912
-
position : unsigned_int option; (** Zero-based index of first result to return *)
913
-
anchor : id option; (** ID of submission to use as reference point *)
914
-
anchor_offset : int_t option; (** Offset from anchor to start returning results *)
915
-
limit : unsigned_int option; (** Maximum number of results to return *)
916
-
calculate_total : bool option; (** Whether to calculate the total number of matching submissions *)
917
-
}
918
-
919
-
(** EmailSubmission/query response as defined in RFC8621 Section 5.5.
920
-
Contains IDs of email submissions matching the query.
921
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-5.5>
922
-
*)
923
-
type email_submission_query_response = {
924
-
account_id : id; (** The account that was queried *)
925
-
query_state : string; (** State string for the query results *)
926
-
can_calculate_changes : bool; (** Whether queryChanges can be used with these results *)
927
-
position : unsigned_int; (** Zero-based index of the first result *)
928
-
ids : id list; (** IDs of email submissions matching the query *)
929
-
total : unsigned_int option; (** Total number of matches if requested *)
930
-
}
931
-
932
-
(** EmailSubmission/set request arguments as defined in RFC8621 Section 5.6.
933
-
Used to create, update, and destroy email submissions.
934
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-5.6>
935
-
*)
936
-
type email_submission_set_arguments = {
937
-
account_id : id; (** The account to make changes in *)
938
-
if_in_state : string option; (** Only apply changes if in this state *)
939
-
create : (id * email_submission_creation) list option; (** Map of creation IDs to submissions to create *)
940
-
update : (id * email_submission_update) list option; (** Map of IDs to update properties *)
941
-
destroy : id list option; (** List of IDs to destroy *)
942
-
on_success_update_email : (id * email_update) list option; (** Emails to update if submissions succeed *)
943
-
}
944
-
945
-
(** Properties for email submission creation as defined in RFC8621 Section 5.6.
946
-
Used to create new email submissions.
947
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-5.6>
948
-
*)
949
-
and email_submission_creation = {
950
-
email_id : id; (** ID of the email to send *)
951
-
identity_id : id; (** ID of the identity to send from *)
952
-
envelope : envelope option; (** Custom envelope, if needed *)
953
-
send_at : utc_date option; (** When to send the email, defaults to now *)
954
-
}
955
-
956
-
(** Properties for email submission update as defined in RFC8621 Section 5.6.
957
-
Used to update existing email submissions.
958
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-5.6>
959
-
*)
960
-
and email_submission_update = {
961
-
email_id : id option; (** New email ID to use for this submission *)
962
-
identity_id : id option; (** New identity ID to use for this submission *)
963
-
envelope : envelope option; (** New envelope to use for this submission *)
964
-
undo_status : [`canceled] option; (** Set to cancel a pending submission *)
965
-
}
966
-
967
-
(** EmailSubmission/set response as defined in RFC8621 Section 5.6.
968
-
Reports the results of email submission changes.
969
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-5.6>
970
-
*)
971
-
type email_submission_set_response = {
972
-
account_id : id; (** The account that was modified *)
973
-
old_state : string option; (** The state before processing, if changed *)
974
-
new_state : string; (** The current state on the server *)
975
-
created : (id * email_submission) list option; (** Map of creation IDs to created submissions *)
976
-
updated : id list option; (** List of IDs that were successfully updated *)
977
-
destroyed : id list option; (** List of IDs that were successfully destroyed *)
978
-
not_created : (id * set_error) list option; (** Map of IDs to errors for failed creates *)
979
-
not_updated : (id * set_error) list option; (** Map of IDs to errors for failed updates *)
980
-
not_destroyed : (id * set_error) list option; (** Map of IDs to errors for failed destroys *)
981
-
}
982
-
983
-
(** {1:identity Identity objects}
984
-
Identity types as defined in RFC8621 Section 6
985
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-6>
986
-
*)
987
-
988
-
(** Identity for sending mail as defined in RFC8621 Section 6.
989
-
Represents an email identity that can be used to send messages.
990
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-6>
991
-
*)
992
-
type identity = {
993
-
id : id; (** Server-assigned ID for the identity *)
994
-
name : string; (** Display name for the identity *)
995
-
email : string; (** Email address for the identity *)
996
-
reply_to : email_address list option; (** Reply-To addresses to use when sending *)
997
-
bcc : email_address list option; (** BCC addresses to automatically include *)
998
-
text_signature : string option; (** Plain text signature for the identity *)
999
-
html_signature : string option; (** HTML signature for the identity *)
1000
-
may_delete : bool; (** Whether this identity can be deleted *)
1001
-
}
1002
-
1003
-
(** Identity/get request arguments as defined in RFC8621 Section 6.1.
1004
-
Used to fetch identities by ID.
1005
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-6.1>
1006
-
*)
1007
-
type identity_get_arguments = {
1008
-
account_id : id; (** The account to fetch identities from *)
1009
-
ids : id list option; (** The IDs of identities to fetch, null means all *)
1010
-
properties : string list option; (** Properties to return, null means all *)
1011
-
}
1012
-
1013
-
(** Identity/get response as defined in RFC8621 Section 6.1.
1014
-
Contains requested identities.
1015
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-6.1>
1016
-
*)
1017
-
type identity_get_response = {
1018
-
account_id : id; (** The account from which identities were fetched *)
1019
-
state : string; (** A string representing the state on the server *)
1020
-
list : identity list; (** The list of identities requested *)
1021
-
not_found : id list; (** IDs requested that could not be found *)
1022
-
}
1023
-
1024
-
(** Identity/changes request arguments as defined in RFC8621 Section 6.2.
1025
-
Used to get identity changes since a previous state.
1026
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-6.2>
1027
-
*)
1028
-
type identity_changes_arguments = {
1029
-
account_id : id; (** The account to get changes for *)
1030
-
since_state : string; (** The previous state to compare to *)
1031
-
max_changes : unsigned_int option; (** Maximum number of changes to return *)
1032
-
}
1033
-
1034
-
(** Identity/changes response as defined in RFC8621 Section 6.2.
1035
-
Reports identities that have changed since a previous state.
1036
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-6.2>
1037
-
*)
1038
-
type identity_changes_response = {
1039
-
account_id : id; (** The account changes are for *)
1040
-
old_state : string; (** The state provided in the request *)
1041
-
new_state : string; (** The current state on the server *)
1042
-
has_more_changes : bool; (** If true, more changes are available *)
1043
-
created : id list; (** IDs of identities created since old_state *)
1044
-
updated : id list; (** IDs of identities updated since old_state *)
1045
-
destroyed : id list; (** IDs of identities destroyed since old_state *)
1046
-
}
1047
-
1048
-
(** Identity/set request arguments as defined in RFC8621 Section 6.3.
1049
-
Used to create, update, and destroy identities.
1050
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-6.3>
1051
-
*)
1052
-
type identity_set_arguments = {
1053
-
account_id : id; (** The account to make changes in *)
1054
-
if_in_state : string option; (** Only apply changes if in this state *)
1055
-
create : (id * identity_creation) list option; (** Map of creation IDs to identities to create *)
1056
-
update : (id * identity_update) list option; (** Map of IDs to update properties *)
1057
-
destroy : id list option; (** List of IDs to destroy *)
1058
-
}
1059
-
1060
-
(** Properties for identity creation as defined in RFC8621 Section 6.3.
1061
-
Used to create new identities.
1062
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-6.3>
1063
-
*)
1064
-
and identity_creation = {
1065
-
name : string; (** Display name for the identity *)
1066
-
email : string; (** Email address for the identity *)
1067
-
reply_to : email_address list option; (** Reply-To addresses to use when sending *)
1068
-
bcc : email_address list option; (** BCC addresses to automatically include *)
1069
-
text_signature : string option; (** Plain text signature for the identity *)
1070
-
html_signature : string option; (** HTML signature for the identity *)
1071
-
}
1072
-
1073
-
(** Properties for identity update as defined in RFC8621 Section 6.3.
1074
-
Used to update existing identities.
1075
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-6.3>
1076
-
*)
1077
-
and identity_update = {
1078
-
name : string option; (** New display name for the identity *)
1079
-
email : string option; (** New email address for the identity *)
1080
-
reply_to : email_address list option; (** New Reply-To addresses to use *)
1081
-
bcc : email_address list option; (** New BCC addresses to automatically include *)
1082
-
text_signature : string option; (** New plain text signature *)
1083
-
html_signature : string option; (** New HTML signature *)
1084
-
}
1085
-
1086
-
(** Identity/set response as defined in RFC8621 Section 6.3.
1087
-
Reports the results of identity changes.
1088
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-6.3>
1089
-
*)
1090
-
type identity_set_response = {
1091
-
account_id : id; (** The account that was modified *)
1092
-
old_state : string option; (** The state before processing, if changed *)
1093
-
new_state : string; (** The current state on the server *)
1094
-
created : (id * identity) list option; (** Map of creation IDs to created identities *)
1095
-
updated : id list option; (** List of IDs that were successfully updated *)
1096
-
destroyed : id list option; (** List of IDs that were successfully destroyed *)
1097
-
not_created : (id * set_error) list option; (** Map of IDs to errors for failed creates *)
1098
-
not_updated : (id * set_error) list option; (** Map of IDs to errors for failed updates *)
1099
-
not_destroyed : (id * set_error) list option; (** Map of IDs to errors for failed destroys *)
1100
-
}
1101
-
1102
-
(** {1:vacation_response VacationResponse objects}
1103
-
Vacation response types as defined in RFC8621 Section 7
1104
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-7>
1105
-
*)
1106
-
1107
-
(** Vacation auto-reply setting as defined in RFC8621 Section 7.
1108
-
Represents an automatic vacation/out-of-office response.
1109
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-7>
1110
-
*)
1111
-
type vacation_response = {
1112
-
id : id; (** Server-assigned ID for the vacation response *)
1113
-
is_enabled : bool; (** Whether the vacation response is active *)
1114
-
from_date : utc_date option; (** Start date-time of the vacation period *)
1115
-
to_date : utc_date option; (** End date-time of the vacation period *)
1116
-
subject : string option; (** Subject line for the vacation response *)
1117
-
text_body : string option; (** Plain text body for the vacation response *)
1118
-
html_body : string option; (** HTML body for the vacation response *)
1119
-
}
1120
-
1121
-
(** VacationResponse/get request arguments as defined in RFC8621 Section 7.2.
1122
-
Used to fetch vacation responses by ID.
1123
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-7.2>
1124
-
*)
1125
-
type vacation_response_get_arguments = {
1126
-
account_id : id; (** The account to fetch vacation responses from *)
1127
-
ids : id list option; (** The IDs of vacation responses to fetch, null means all *)
1128
-
properties : string list option; (** Properties to return, null means all *)
1129
-
}
1130
-
1131
-
(** VacationResponse/get response as defined in RFC8621 Section 7.2.
1132
-
Contains requested vacation responses.
1133
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-7.2>
1134
-
*)
1135
-
type vacation_response_get_response = {
1136
-
account_id : id; (** The account from which vacation responses were fetched *)
1137
-
state : string; (** A string representing the state on the server *)
1138
-
list : vacation_response list; (** The list of vacation responses requested *)
1139
-
not_found : id list; (** IDs requested that could not be found *)
1140
-
}
1141
-
1142
-
(** VacationResponse/set request arguments as defined in RFC8621 Section 7.3.
1143
-
Used to update vacation responses.
1144
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-7.3>
1145
-
*)
1146
-
type vacation_response_set_arguments = {
1147
-
account_id : id; (** The account to make changes in *)
1148
-
if_in_state : string option; (** Only apply changes if in this state *)
1149
-
update : (id * vacation_response_update) list; (** Map of IDs to update properties *)
1150
-
}
1151
-
1152
-
(** Properties for vacation response update as defined in RFC8621 Section 7.3.
1153
-
Used to update existing vacation responses.
1154
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-7.3>
1155
-
*)
1156
-
and vacation_response_update = {
1157
-
is_enabled : bool option; (** Whether the vacation response is active *)
1158
-
from_date : utc_date option; (** Start date-time of the vacation period *)
1159
-
to_date : utc_date option; (** End date-time of the vacation period *)
1160
-
subject : string option; (** Subject line for the vacation response *)
1161
-
text_body : string option; (** Plain text body for the vacation response *)
1162
-
html_body : string option; (** HTML body for the vacation response *)
1163
-
}
1164
-
1165
-
(** VacationResponse/set response as defined in RFC8621 Section 7.3.
1166
-
Reports the results of vacation response changes.
1167
-
@see <https://datatracker.ietf.org/doc/html/rfc8621#section-7.3>
1168
-
*)
1169
-
type vacation_response_set_response = {
1170
-
account_id : id; (** The account that was modified *)
1171
-
old_state : string option; (** The state before processing, if changed *)
1172
-
new_state : string; (** The current state on the server *)
1173
-
updated : id list option; (** List of IDs that were successfully updated *)
1174
-
not_updated : (id * set_error) list option; (** Map of IDs to errors for failed updates *)
1175
-
}
1176
-
1177
-
(** {1:message_flags Message Flags and Mailbox Attributes}
1178
-
Message flag types as defined in draft-ietf-mailmaint-messageflag-mailboxattribute-02
1179
-
@see <https://datatracker.ietf.org/doc/html/draft-ietf-mailmaint-messageflag-mailboxattribute>
1180
-
*)
1181
-
1182
-
(** Flag color defined by the combination of MailFlagBit0, MailFlagBit1, and MailFlagBit2 keywords
1183
-
as defined in draft-ietf-mailmaint-messageflag-mailboxattribute-02 Section 3.
1184
-
@see <https://datatracker.ietf.org/doc/html/draft-ietf-mailmaint-messageflag-mailboxattribute#section-3>
1185
-
*)
1186
-
type flag_color =
1187
-
| Red (** Bit pattern 000 - default color *)
1188
-
| Orange (** Bit pattern 100 - MailFlagBit2 set *)
1189
-
| Yellow (** Bit pattern 010 - MailFlagBit1 set *)
1190
-
| Green (** Bit pattern 111 - all bits set *)
1191
-
| Blue (** Bit pattern 001 - MailFlagBit0 set *)
1192
-
| Purple (** Bit pattern 101 - MailFlagBit2 and MailFlagBit0 set *)
1193
-
| Gray (** Bit pattern 011 - MailFlagBit1 and MailFlagBit0 set *)
1194
-
1195
-
(** Standard message keywords as defined in draft-ietf-mailmaint-messageflag-mailboxattribute-02 Section 4.1.
1196
-
These are standardized keywords that can be applied to email messages.
1197
-
@see <https://datatracker.ietf.org/doc/html/draft-ietf-mailmaint-messageflag-mailboxattribute#section-4.1>
1198
-
*)
1199
-
type message_keyword =
1200
-
| Notify (** Indicate a notification should be shown for this message *)
1201
-
| Muted (** User is not interested in future replies to this thread *)
1202
-
| Followed (** User is particularly interested in future replies to this thread *)
1203
-
| Memo (** Message is a note-to-self about another message in the same thread *)
1204
-
| HasMemo (** Message has an associated memo with the $memo keyword *)
1205
-
| HasAttachment (** Message has an attachment *)
1206
-
| HasNoAttachment (** Message does not have an attachment *)
1207
-
| AutoSent (** Message was sent automatically as a response due to a user rule *)
1208
-
| Unsubscribed (** User has unsubscribed from the thread this message is in *)
1209
-
| CanUnsubscribe (** Message has an RFC8058-compliant List-Unsubscribe header *)
1210
-
| Imported (** Message was imported from another mailbox *)
1211
-
| IsTrusted (** Server has verified authenticity of the from name and email *)
1212
-
| MaskedEmail (** Message was received via an alias created for an individual sender *)
1213
-
| New (** Message should be made more prominent due to a recent action *)
1214
-
| MailFlagBit0 (** Bit 0 of the 3-bit flag color pattern *)
1215
-
| MailFlagBit1 (** Bit 1 of the 3-bit flag color pattern *)
1216
-
| MailFlagBit2 (** Bit 2 of the 3-bit flag color pattern *)
1217
-
| OtherKeyword of string (** Other non-standard keywords *)
1218
-
1219
-
(** Special mailbox attribute names as defined in draft-ietf-mailmaint-messageflag-mailboxattribute-02 Section 4.2.
1220
-
These are standardized attributes for special-purpose mailboxes.
1221
-
@see <https://datatracker.ietf.org/doc/html/draft-ietf-mailmaint-messageflag-mailboxattribute#section-4.2>
1222
-
*)
1223
-
type mailbox_attribute =
1224
-
| Snoozed (** Mailbox containing messages that have been snoozed *)
1225
-
| Scheduled (** Mailbox containing messages scheduled to be sent later *)
1226
-
| Memos (** Mailbox containing messages with the $memo keyword *)
1227
-
| OtherAttribute of string (** Other non-standard mailbox attributes *)
1228
-
1229
-
(** Convert bit values to a flag color
1230
-
@param bit0 Value of bit 0 (least significant bit)
1231
-
@param bit1 Value of bit 1
1232
-
@param bit2 Value of bit 2 (most significant bit)
1233
-
@return The corresponding flag color
1234
-
*)
1235
-
val flag_color_of_bits : bool -> bool -> bool -> flag_color
1236
-
1237
-
(** Get the bit values for a flag color
1238
-
@param color The flag color
1239
-
@return Tuple of (bit2, bit1, bit0) values
1240
-
*)
1241
-
val bits_of_flag_color : flag_color -> bool * bool * bool
1242
-
1243
-
(** Check if a message has a flag color based on its keywords
1244
-
@param keywords The list of keywords for the message
1245
-
@return True if the message has one or more flag color bits set
1246
-
*)
1247
-
val has_flag_color : (keyword * bool) list -> bool
1248
-
1249
-
(** Get the flag color from a message's keywords, if present
1250
-
@param keywords The list of keywords for the message
1251
-
@return The flag color if all required bits are present, None otherwise
1252
-
*)
1253
-
val get_flag_color : (keyword * bool) list -> flag_color option
1254
-
1255
-
(** Convert a message keyword to its string representation
1256
-
@param keyword The message keyword
1257
-
@return String representation with $ prefix (e.g., "$notify")
1258
-
*)
1259
-
val string_of_message_keyword : message_keyword -> string
1260
-
1261
-
(** Parse a string into a message keyword
1262
-
@param s The string to parse (with or without $ prefix)
1263
-
@return The corresponding message keyword
1264
-
*)
1265
-
val message_keyword_of_string : string -> message_keyword
1266
-
1267
-
(** Convert a mailbox attribute to its string representation
1268
-
@param attr The mailbox attribute
1269
-
@return String representation with $ prefix (e.g., "$snoozed")
1270
-
*)
1271
-
val string_of_mailbox_attribute : mailbox_attribute -> string
1272
-
1273
-
(** Parse a string into a mailbox attribute
1274
-
@param s The string to parse (with or without $ prefix)
1275
-
@return The corresponding mailbox attribute
1276
-
*)
1277
-
val mailbox_attribute_of_string : string -> mailbox_attribute
1278
-
1279
-
(** Get a human-readable representation of a flag color
1280
-
@param color The flag color
1281
-
@return Human-readable name of the color
1282
-
*)
1283
-
val human_readable_flag_color : flag_color -> string
1284
-
1285
-
(** Get a human-readable representation of a message keyword
1286
-
@param keyword The message keyword
1287
-
@return Human-readable description of the keyword
1288
-
*)
1289
-
val human_readable_message_keyword : message_keyword -> string
1290
-
1291
-
(** Format email keywords into a human-readable string representation
1292
-
@param keywords The list of keywords and their values
1293
-
@return Human-readable comma-separated list of keywords
1294
-
*)
1295
-
val format_email_keywords : (keyword * bool) list -> string
1296
-
end
1297
-
1298
-
(** {1 JSON serialization}
1299
-
Functions for serializing and deserializing JMAP Mail objects to/from JSON
1300
-
*)
1301
-
1302
-
module Json : sig
1303
-
open Types
1304
-
1305
-
(** {2 Helper functions for serialization}
1306
-
Utility functions for converting between OCaml types and JSON representation
1307
-
*)
1308
-
1309
-
(** Convert a mailbox role to its string representation
1310
-
@param role The mailbox role
1311
-
@return String representation (e.g., "inbox", "drafts", etc.)
1312
-
*)
1313
-
val string_of_mailbox_role : mailbox_role -> string
1314
-
1315
-
(** Parse a string into a mailbox role
1316
-
@param s The string to parse
1317
-
@return The corresponding mailbox role, or Unknown if not recognized
1318
-
*)
1319
-
val mailbox_role_of_string : string -> mailbox_role
1320
-
1321
-
(** Convert an email keyword to its string representation
1322
-
@param keyword The email keyword
1323
-
@return String representation with $ prefix (e.g., "$flagged")
1324
-
*)
1325
-
val string_of_keyword : keyword -> string
1326
-
1327
-
(** Parse a string into an email keyword
1328
-
@param s The string to parse (with or without $ prefix)
1329
-
@return The corresponding email keyword
1330
-
*)
1331
-
val keyword_of_string : string -> keyword
1332
-
1333
-
(** {2 Mailbox serialization}
1334
-
Functions for serializing and deserializing mailbox objects
1335
-
*)
1336
-
1337
-
(** TODO:claude - Need to implement all JSON serialization functions
1338
-
for each type we've defined. This would be a substantial amount of
1339
-
code and likely require additional understanding of the ezjsonm API.
1340
-
1341
-
The interface would include functions like:
1342
-
1343
-
val mailbox_to_json : mailbox -> Ezjsonm.value
1344
-
val mailbox_of_json : Ezjsonm.value -> mailbox result
1345
-
1346
-
And similarly for all other types.
1347
-
*)
1348
-
end
1349
-
1350
-
(** {1 API functions}
1351
-
High-level functions for interacting with JMAP Mail servers
1352
-
*)
1353
-
1354
-
(** Authentication credentials for a JMAP server *)
1355
-
type credentials = {
1356
-
username: string; (** Username for authentication *)
1357
-
password: string; (** Password for authentication *)
1358
-
}
1359
-
1360
-
(** Connection to a JMAP mail server *)
1361
-
type connection = {
1362
-
session: Jmap.Types.session; (** Session information from the server *)
1363
-
config: Jmap.Api.config; (** Configuration for API requests *)
1364
-
}
1365
-
1366
-
(** Login to a JMAP server and establish a connection
1367
-
@param uri The URI of the JMAP server
1368
-
@param credentials Authentication credentials
1369
-
@return A connection object if successful
1370
-
1371
-
Creates a new connection to a JMAP server using username/password authentication.
1372
-
*)
1373
-
val login :
1374
-
uri:string ->
1375
-
credentials:credentials ->
1376
-
(connection, Jmap.Api.error) result Lwt.t
1377
-
1378
-
(** Login to a JMAP server using an API token
1379
-
@param uri The URI of the JMAP server
1380
-
@param api_token The API token for authentication
1381
-
@return A connection object if successful
1382
-
1383
-
Creates a new connection to a JMAP server using Bearer token authentication.
1384
-
*)
1385
-
val login_with_token :
1386
-
uri:string ->
1387
-
api_token:string ->
1388
-
(connection, Jmap.Api.error) result Lwt.t
1389
-
1390
-
(** Get all mailboxes for an account
1391
-
@param conn The JMAP connection
1392
-
@param account_id The account ID to get mailboxes for
1393
-
@return A list of mailboxes if successful
1394
-
1395
-
Retrieves all mailboxes (folders) in the specified account.
1396
-
*)
1397
-
val get_mailboxes :
1398
-
connection ->
1399
-
account_id:Jmap.Types.id ->
1400
-
(Types.mailbox list, Jmap.Api.error) result Lwt.t
1401
-
1402
-
(** Get a specific mailbox by ID
1403
-
@param conn The JMAP connection
1404
-
@param account_id The account ID
1405
-
@param mailbox_id The mailbox ID to retrieve
1406
-
@return The mailbox if found
1407
-
1408
-
Retrieves a single mailbox by its ID.
1409
-
*)
1410
-
val get_mailbox :
1411
-
connection ->
1412
-
account_id:Jmap.Types.id ->
1413
-
mailbox_id:Jmap.Types.id ->
1414
-
(Types.mailbox, Jmap.Api.error) result Lwt.t
1415
-
1416
-
(** Get messages in a mailbox
1417
-
@param conn The JMAP connection
1418
-
@param account_id The account ID
1419
-
@param mailbox_id The mailbox ID to get messages from
1420
-
@param limit Optional limit on number of messages to return
1421
-
@return The list of email messages if successful
1422
-
1423
-
Retrieves email messages in the specified mailbox, with optional limit.
1424
-
*)
1425
-
val get_messages_in_mailbox :
1426
-
connection ->
1427
-
account_id:Jmap.Types.id ->
1428
-
mailbox_id:Jmap.Types.id ->
1429
-
?limit:int ->
1430
-
unit ->
1431
-
(Types.email list, Jmap.Api.error) result Lwt.t
1432
-
1433
-
(** Get a single email message by ID
1434
-
@param conn The JMAP connection
1435
-
@param account_id The account ID
1436
-
@param email_id The email ID to retrieve
1437
-
@return The email message if found
1438
-
1439
-
Retrieves a single email message by its ID.
1440
-
*)
1441
-
val get_email :
1442
-
connection ->
1443
-
account_id:Jmap.Types.id ->
1444
-
email_id:Jmap.Types.id ->
1445
-
(Types.email, Jmap.Api.error) result Lwt.t
1446
-
1447
-
(** Check if an email has a specific message keyword
1448
-
@param email The email to check
1449
-
@param keyword The message keyword to look for
1450
-
@return true if the email has the keyword, false otherwise
1451
-
1452
-
Tests whether an email has a particular keyword (flag) set.
1453
-
*)
1454
-
val has_message_keyword :
1455
-
Types.email ->
1456
-
Types.message_keyword ->
1457
-
bool
1458
-
1459
-
(** Add a message keyword to an email
1460
-
@param conn The JMAP connection
1461
-
@param account_id The account ID
1462
-
@param email_id The email ID
1463
-
@param keyword The message keyword to add
1464
-
@return Success or error
1465
-
1466
-
Adds a keyword (flag) to an email message.
1467
-
*)
1468
-
val add_message_keyword :
1469
-
connection ->
1470
-
account_id:Jmap.Types.id ->
1471
-
email_id:Jmap.Types.id ->
1472
-
keyword:Types.message_keyword ->
1473
-
(unit, Jmap.Api.error) result Lwt.t
1474
-
1475
-
(** Set a flag color for an email
1476
-
@param conn The JMAP connection
1477
-
@param account_id The account ID
1478
-
@param email_id The email ID
1479
-
@param color The flag color to set
1480
-
@return Success or error
1481
-
1482
-
Sets a flag color on an email message by setting the appropriate bit flags.
1483
-
*)
1484
-
val set_flag_color :
1485
-
connection ->
1486
-
account_id:Jmap.Types.id ->
1487
-
email_id:Jmap.Types.id ->
1488
-
color:Types.flag_color ->
1489
-
(unit, Jmap.Api.error) result Lwt.t
1490
-
1491
-
(** Convert an email's keywords to typed message_keyword list
1492
-
@param email The email to analyze
1493
-
@return List of message keywords
1494
-
1495
-
Extracts all message keywords from an email's keyword list.
1496
-
*)
1497
-
val get_message_keywords :
1498
-
Types.email ->
1499
-
Types.message_keyword list
1500
-
1501
-
(** Get emails with a specific message keyword
1502
-
@param conn The JMAP connection
1503
-
@param account_id The account ID
1504
-
@param keyword The message keyword to search for
1505
-
@param limit Optional limit on number of emails to return
1506
-
@return List of emails with the keyword if successful
1507
-
1508
-
Retrieves all emails that have a specific keyword (flag) set.
1509
-
*)
1510
-
val get_emails_with_keyword :
1511
-
connection ->
1512
-
account_id:Jmap.Types.id ->
1513
-
keyword:Types.message_keyword ->
1514
-
?limit:int ->
1515
-
unit ->
1516
-
(Types.email list, Jmap.Api.error) result Lwt.t
1517
-
1518
-
(** {1 Email Submission}
1519
-
Functions for sending emails
1520
-
*)
1521
-
1522
-
(** Create a new email draft
1523
-
@param conn The JMAP connection
1524
-
@param account_id The account ID
1525
-
@param mailbox_id The mailbox ID to store the draft in (usually "drafts")
1526
-
@param from The sender's email address
1527
-
@param to_addresses List of recipient email addresses
1528
-
@param subject The email subject line
1529
-
@param text_body Plain text message body
1530
-
@param html_body Optional HTML message body
1531
-
@return The created email ID if successful
1532
-
1533
-
Creates a new email draft in the specified mailbox with the provided content.
1534
-
*)
1535
-
val create_email_draft :
1536
-
connection ->
1537
-
account_id:Jmap.Types.id ->
1538
-
mailbox_id:Jmap.Types.id ->
1539
-
from:string ->
1540
-
to_addresses:string list ->
1541
-
subject:string ->
1542
-
text_body:string ->
1543
-
?html_body:string ->
1544
-
unit ->
1545
-
(Jmap.Types.id, Jmap.Api.error) result Lwt.t
1546
-
1547
-
(** Get all identities for an account
1548
-
@param conn The JMAP connection
1549
-
@param account_id The account ID
1550
-
@return A list of identities if successful
1551
-
1552
-
Retrieves all identities (email addresses that can be used for sending) for an account.
1553
-
*)
1554
-
val get_identities :
1555
-
connection ->
1556
-
account_id:Jmap.Types.id ->
1557
-
(Types.identity list, Jmap.Api.error) result Lwt.t
1558
-
1559
-
(** Find a suitable identity by email address
1560
-
@param conn The JMAP connection
1561
-
@param account_id The account ID
1562
-
@param email The email address to match
1563
-
@return The identity if found, otherwise Error
1564
-
1565
-
Finds an identity that matches the given email address, either exactly or
1566
-
via a wildcard pattern (e.g., *@domain.com).
1567
-
*)
1568
-
val find_identity_by_email :
1569
-
connection ->
1570
-
account_id:Jmap.Types.id ->
1571
-
email:string ->
1572
-
(Types.identity, Jmap.Api.error) result Lwt.t
1573
-
1574
-
(** Submit an email for delivery
1575
-
@param conn The JMAP connection
1576
-
@param account_id The account ID
1577
-
@param identity_id The identity ID to send from
1578
-
@param email_id The email ID to submit
1579
-
@param envelope Optional custom envelope
1580
-
@return The submission ID if successful
1581
-
1582
-
Submits an existing email (usually a draft) for delivery using the specified identity.
1583
-
*)
1584
-
val submit_email :
1585
-
connection ->
1586
-
account_id:Jmap.Types.id ->
1587
-
identity_id:Jmap.Types.id ->
1588
-
email_id:Jmap.Types.id ->
1589
-
?envelope:Types.envelope ->
1590
-
unit ->
1591
-
(Jmap.Types.id, Jmap.Api.error) result Lwt.t
1592
-
1593
-
(** Create and submit an email in one operation
1594
-
@param conn The JMAP connection
1595
-
@param account_id The account ID
1596
-
@param from The sender's email address
1597
-
@param to_addresses List of recipient email addresses
1598
-
@param subject The email subject line
1599
-
@param text_body Plain text message body
1600
-
@param html_body Optional HTML message body
1601
-
@return The submission ID if successful
1602
-
1603
-
Creates a new email and immediately submits it for delivery.
1604
-
This is a convenience function that combines create_email_draft and submit_email.
1605
-
*)
1606
-
val create_and_submit_email :
1607
-
connection ->
1608
-
account_id:Jmap.Types.id ->
1609
-
from:string ->
1610
-
to_addresses:string list ->
1611
-
subject:string ->
1612
-
text_body:string ->
1613
-
?html_body:string ->
1614
-
unit ->
1615
-
(Jmap.Types.id, Jmap.Api.error) result Lwt.t
1616
-
1617
-
(** Get status of an email submission
1618
-
@param conn The JMAP connection
1619
-
@param account_id The account ID
1620
-
@param submission_id The email submission ID
1621
-
@return The submission status if successful
1622
-
1623
-
Retrieves the current status of an email submission, including delivery status if available.
1624
-
*)
1625
-
val get_submission_status :
1626
-
connection ->
1627
-
account_id:Jmap.Types.id ->
1628
-
submission_id:Jmap.Types.id ->
1629
-
(Types.email_submission, Jmap.Api.error) result Lwt.t
1630
-
1631
-
(** {1 Email Address Utilities}
1632
-
Utilities for working with email addresses
1633
-
*)
1634
-
1635
-
(** Check if an email address matches a filter string
1636
-
@param email The email address to check
1637
-
@param pattern The filter pattern to match against
1638
-
@return True if the email address matches the filter
1639
-
1640
-
The filter supports simple wildcards:
1641
-
- "*" matches any sequence of characters
1642
-
- "?" matches any single character
1643
-
- Case-insensitive matching is used
1644
-
- If no wildcards are present, substring matching is used
1645
-
*)
1646
-
val email_address_matches : string -> string -> bool
1647
-
1648
-
(** Check if an email matches a sender filter
1649
-
@param email The email object to check
1650
-
@param pattern The sender filter pattern
1651
-
@return True if any sender address matches the filter
1652
-
1653
-
Tests whether any of an email's sender addresses match the provided pattern.
1654
-
*)
1655
-
val email_matches_sender : Types.email -> string -> bool