anil.recoil.org
+1
.ocamlformat
+1
.ocamlformat
···
1
+
0.27.0
-48
AGENT.md
-48
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. Add an OCaml interface to compose result references together explicitly into a
48
-
single request, from reading the specs.
+99
CLAUDE.md
+99
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. DO NOT generate any references to Lwt or Async, and only use the Unix module to access basic network and storage functions if the standard library does not suffice.
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
+
- build while ignoring warnings: add `--profile=release` to the CLI to activate the profile that ignores warnings
15
+
16
+
# Tips on fixing bugs
17
+
18
+
If you see errors like this:
19
+
20
+
```
21
+
File "../../.jmap.objs/byte/jmap.odoc":
22
+
Warning: Hidden fields in type 'Jmap.Email.Identity.identity_create'
23
+
```
24
+
25
+
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.
26
+
27
+
## Documentation Comments
28
+
29
+
When adding OCaml documentation comments, be careful about ambiguous documentation comments. If you see errors like:
30
+
31
+
```
32
+
Error (warning 50 [unexpected-docstring]): ambiguous documentation comment
33
+
```
34
+
35
+
This usually means there isn't enough whitespace between the documentation comment and the code element it's documenting. Always:
36
+
37
+
1. Add blank lines between consecutive documentation comments
38
+
2. Add a blank line before a documentation comment for a module/type/value declaration
39
+
3. When documenting record fields or variant constructors, place the comment after the field with at least one space
40
+
41
+
Example of correct documentation spacing:
42
+
43
+
```ocaml
44
+
(** Module documentation. *)
45
+
46
+
(** Value documentation. *)
47
+
val some_value : int
48
+
49
+
(** Type documentation. *)
50
+
type t =
51
+
| First (** First constructor *)
52
+
| Second (** Second constructor *)
53
+
54
+
(** Record documentation. *)
55
+
type record = {
56
+
field1 : int; (** Field1 documentation *)
57
+
field2 : string (** Field2 documentation *)
58
+
}
59
+
```
60
+
61
+
If in doubt, add more whitespace lines than needed - you can always clean this up later with `dune build @fmt` to get ocamlformat to sort out the whitespace properly.
62
+
63
+
# Module Structure Guidelines
64
+
65
+
IMPORTANT: For all modules, use a nested module structure with a canonical `type t` inside each submodule. This approach ensures consistent type naming and logical grouping of related functionality.
66
+
67
+
1. Top-level files should define their main types directly (e.g., `jmap_identity.mli` should define identity-related types at the top level).
68
+
69
+
2. Related operations or specialized subtypes should be defined in nested modules within the file:
70
+
```ocaml
71
+
module Create : sig
72
+
type t (* NOT 'type create' or any other name *)
73
+
(* Functions operating on creation requests *)
74
+
75
+
module Response : sig
76
+
type t
77
+
(* Functions for creation responses *)
78
+
end
79
+
end
80
+
```
81
+
82
+
3. Consistently use `type t` for the main type in each module and submodule.
83
+
84
+
4. Functions operating on a type should be placed in the same module as the type.
85
+
86
+
5. When a file is named after a concept (e.g., `jmap_identity.mli`), there's no need to have a matching nested module inside the file (e.g., `module Identity : sig...`), as the file itself represents that namespace.
87
+
88
+
This structured approach promotes encapsulation, consistent type naming, and clearer organization of related functionality.
89
+
90
+
# Software engineering
91
+
92
+
We will go through a multi step process to build this library. We are currently at STEP 2.
93
+
94
+
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.
95
+
96
+
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.
97
+
98
+
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.
99
+
+72
README.md
+72
README.md
···
1
+
# JMAP OCaml Libraries
2
+
3
+
This project implements OCaml libraries for the JMAP protocol, following the specifications in RFC 8620 (Core) and RFC 8621 (Mail).
4
+
5
+
## Project Structure
6
+
7
+
The code is organized into three main libraries:
8
+
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
17
+
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
25
+
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
34
+
35
+
## Usage
36
+
37
+
The libraries are designed to be used together. For example:
38
+
39
+
```ocaml
40
+
(* Using the core JMAP protocol library *)
41
+
open Jmap
42
+
open Jmap.Types
43
+
open Jmap.Wire
44
+
45
+
(* Using the Unix implementation *)
46
+
open Jmap_unix
47
+
48
+
(* Using the JMAP Email extension library *)
49
+
open Jmap_email
50
+
open Jmap_email.Types
51
+
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
+
...
57
+
```
58
+
59
+
## Building
60
+
61
+
```sh
62
+
# Build
63
+
opam exec -- dune build @check
64
+
65
+
# Generate documentation
66
+
opam exec -- dune build @doc
67
+
```
68
+
69
+
## References
70
+
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)
+57
-8
bin/dune
+57
-8
bin/dune
···
1
1
(executable
2
-
(name fastmail_list)
3
-
(public_name fastmail-list)
2
+
(name jmap_email_search)
3
+
(public_name jmap-email-search)
4
+
(package jmap)
5
+
(libraries jmap jmap-email cmdliner unix jmap_unix)
6
+
(modules jmap_email_search))
7
+
8
+
(executable
9
+
(name jmap_thread_analyzer)
10
+
(public_name jmap-thread-analyzer)
11
+
(package jmap)
12
+
(libraries jmap jmap-email cmdliner unix)
13
+
(modules jmap_thread_analyzer))
14
+
15
+
(executable
16
+
(name jmap_mailbox_explorer)
17
+
(public_name jmap-mailbox-explorer)
18
+
(package jmap)
19
+
(libraries jmap jmap-email cmdliner unix)
20
+
(modules jmap_mailbox_explorer))
21
+
22
+
(executable
23
+
(name jmap_flag_manager)
24
+
(public_name jmap-flag-manager)
25
+
(package jmap)
26
+
(libraries jmap jmap-email cmdliner unix)
27
+
(modules jmap_flag_manager))
28
+
29
+
(executable
30
+
(name jmap_identity_monitor)
31
+
(public_name jmap-identity-monitor)
32
+
(package jmap)
33
+
(libraries jmap jmap-email cmdliner unix)
34
+
(modules jmap_identity_monitor))
35
+
36
+
(executable
37
+
(name jmap_blob_downloader)
38
+
(public_name jmap-blob-downloader)
4
39
(package jmap)
5
-
(modules fastmail_list)
6
-
(libraries jmap jmap_mail lwt.unix logs logs.fmt))
40
+
(libraries jmap jmap-email jmap-unix cmdliner unix)
41
+
(modules jmap_blob_downloader))
7
42
8
43
(executable
9
-
(name flag_color_test)
10
-
(public_name flag-color-test)
44
+
(name jmap_email_composer)
45
+
(public_name jmap-email-composer)
11
46
(package jmap)
12
-
(modules flag_color_test)
13
-
(libraries jmap jmap_mail))
47
+
(libraries jmap jmap-email jmap-unix cmdliner unix)
48
+
(modules jmap_email_composer))
49
+
50
+
(executable
51
+
(name jmap_push_listener)
52
+
(public_name jmap-push-listener)
53
+
(package jmap)
54
+
(libraries jmap jmap-email jmap-unix cmdliner unix)
55
+
(modules jmap_push_listener))
56
+
57
+
(executable
58
+
(name jmap_vacation_manager)
59
+
(public_name jmap-vacation-manager)
60
+
(package jmap)
61
+
(libraries jmap jmap-email jmap-unix cmdliner unix)
62
+
(modules jmap_vacation_manager))
-209
bin/fastmail_list.ml
-209
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
-
*)
16
-
17
-
open Lwt.Syntax
18
-
open Jmap
19
-
open Jmap_mail
20
-
module Mail = Jmap_mail.Types
21
-
22
-
(** Prints the email details *)
23
-
let print_email ~show_labels (email : Mail.email) =
24
-
let sender =
25
-
match email.from with
26
-
| Some (addr :: _) ->
27
-
(match addr.name with
28
-
| Some name -> Printf.sprintf "%s <%s>" name addr.email
29
-
| None -> addr.email)
30
-
| _ -> "<unknown>"
31
-
in
32
-
let subject =
33
-
match email.subject with
34
-
| Some s -> s
35
-
| None -> "<no subject>"
36
-
in
37
-
let date = email.received_at in
38
-
39
-
(* Format labels/keywords if requested *)
40
-
let labels_str =
41
-
if show_labels then
42
-
let active_keywords =
43
-
List.filter_map (fun (keyword, active) ->
44
-
if active then Some (Jmap_mail.Json.string_of_keyword keyword) else None
45
-
) email.keywords
46
-
in
47
-
if List.length active_keywords > 0 then
48
-
" [" ^ String.concat ", " active_keywords ^ "]"
49
-
else
50
-
""
51
-
else
52
-
""
53
-
in
54
-
55
-
Printf.printf "%s | %s | %s%s\n" date sender subject labels_str
56
-
57
-
(** Check if an email is unread *)
58
-
let is_unread (email : Mail.email) =
59
-
let is_unread_keyword =
60
-
List.exists (fun (kw, active) ->
61
-
kw = Mail.Unread && active
62
-
) email.keywords
63
-
in
64
-
let is_not_seen =
65
-
not (List.exists (fun (kw, active) ->
66
-
kw = Mail.Seen && active
67
-
) email.keywords)
68
-
in
69
-
is_unread_keyword || is_not_seen
70
-
71
-
(** Main function *)
72
-
let main () =
73
-
(* Parse command-line arguments *)
74
-
let unread_only = ref false in
75
-
let show_labels = ref false in
76
-
let debug_level = ref 0 in
77
-
78
-
let args = [
79
-
("-unread", Arg.Set unread_only, "List only unread messages");
80
-
("-labels", Arg.Set show_labels, "Show labels/keywords associated with messages");
81
-
("-debug", Arg.Int (fun level -> debug_level := level), "Set debug level (0-4, where 4 is most verbose)");
82
-
] in
83
-
84
-
let usage_msg = "Usage: JMAP_API_TOKEN=your_token fastmail_list [options]" in
85
-
Arg.parse args (fun _ -> ()) usage_msg;
86
-
87
-
(* Configure logging *)
88
-
init_logging ~level:!debug_level ~enable_logs:(!debug_level > 0) ~redact_sensitive:true ();
89
-
90
-
match Sys.getenv_opt "JMAP_API_TOKEN" with
91
-
| None ->
92
-
Printf.eprintf "Error: JMAP_API_TOKEN environment variable not set\n";
93
-
Printf.eprintf "Usage: JMAP_API_TOKEN=your_token ./fastmail_list [options]\n";
94
-
Printf.eprintf "Options:\n";
95
-
Printf.eprintf " -unread List only unread messages\n";
96
-
Printf.eprintf " -labels Show labels/keywords associated with messages\n";
97
-
Printf.eprintf " -debug LEVEL Set debug level (0-4, where 4 is most verbose)\n";
98
-
exit 1
99
-
| Some token ->
100
-
(* Only print token info at Info level or higher *)
101
-
Logs.info (fun m -> m "Using API token: %s" (redact_token token));
102
-
103
-
(* Connect to Fastmail JMAP API *)
104
-
let formatted_token = token in
105
-
106
-
(* Only print instructions at Info level *)
107
-
let level = match Logs.level () with
108
-
| None -> 0
109
-
| Some Logs.Error -> 1
110
-
| Some Logs.Info -> 2
111
-
| Some Logs.Debug -> 3
112
-
| _ -> 2
113
-
in
114
-
if level >= 2 then begin
115
-
Printf.printf "\nFastmail API Instructions:\n";
116
-
Printf.printf "1. Get a token from: https://app.fastmail.com/settings/tokens\n";
117
-
Printf.printf "2. Create a new token with Mail scope (read/write)\n";
118
-
Printf.printf "3. Copy the full token (example: 3de40-5fg1h2-a1b2c3...)\n";
119
-
Printf.printf "4. Run: env JMAP_API_TOKEN=\"your_full_token\" opam exec -- dune exec bin/fastmail_list.exe [options]\n\n";
120
-
Printf.printf "Note: This example is working correctly but needs a valid Fastmail token.\n\n";
121
-
end;
122
-
let* result = login_with_token
123
-
~uri:"https://api.fastmail.com/jmap/session"
124
-
~api_token:formatted_token
125
-
in
126
-
match result with
127
-
| Error err ->
128
-
(match err with
129
-
| Api.Connection_error msg ->
130
-
Printf.eprintf "Connection error: %s\n" msg
131
-
| Api.HTTP_error (code, body) ->
132
-
Printf.eprintf "HTTP error %d: %s\n" code body
133
-
| Api.Parse_error msg ->
134
-
Printf.eprintf "Parse error: %s\n" msg
135
-
| Api.Authentication_error ->
136
-
Printf.eprintf "Authentication error. Check your API token.\n");
137
-
Lwt.return 1
138
-
| Ok conn ->
139
-
(* Get the primary account ID *)
140
-
let primary_account_id =
141
-
let mail_capability = Jmap_mail.Capability.to_string Jmap_mail.Capability.Mail in
142
-
match List.assoc_opt mail_capability conn.session.primary_accounts with
143
-
| Some id -> id
144
-
| None ->
145
-
match conn.session.accounts with
146
-
| (id, _) :: _ -> id
147
-
| [] ->
148
-
Printf.eprintf "No accounts found\n";
149
-
exit 1
150
-
in
151
-
152
-
(* Get the Inbox mailbox *)
153
-
let* mailboxes_result = get_mailboxes conn ~account_id:primary_account_id in
154
-
match mailboxes_result with
155
-
| Error err ->
156
-
Printf.eprintf "Failed to get mailboxes: %s\n"
157
-
(match err with
158
-
| Api.Connection_error msg -> "Connection error: " ^ msg
159
-
| Api.HTTP_error (code, body) -> Printf.sprintf "HTTP error %d: %s" code body
160
-
| Api.Parse_error msg -> "Parse error: " ^ msg
161
-
| Api.Authentication_error -> "Authentication error");
162
-
Lwt.return 1
163
-
| Ok mailboxes ->
164
-
(* If there's a mailbox list, just use the first one for this example *)
165
-
let inbox_id =
166
-
match mailboxes with
167
-
| mailbox :: _ -> mailbox.Mail.id
168
-
| [] ->
169
-
Printf.eprintf "No mailboxes found\n";
170
-
exit 1
171
-
in
172
-
173
-
(* Get messages from inbox *)
174
-
let* emails_result = get_messages_in_mailbox
175
-
conn
176
-
~account_id:primary_account_id
177
-
~mailbox_id:inbox_id
178
-
~limit:1000
179
-
()
180
-
in
181
-
match emails_result with
182
-
| Error err ->
183
-
Printf.eprintf "Failed to get emails: %s\n"
184
-
(match err with
185
-
| Api.Connection_error msg -> "Connection error: " ^ msg
186
-
| Api.HTTP_error (code, body) -> Printf.sprintf "HTTP error %d: %s" code body
187
-
| Api.Parse_error msg -> "Parse error: " ^ msg
188
-
| Api.Authentication_error -> "Authentication error");
189
-
Lwt.return 1
190
-
| Ok emails ->
191
-
(* Filter emails if unread-only mode is enabled *)
192
-
let filtered_emails =
193
-
if !unread_only then
194
-
List.filter is_unread emails
195
-
else
196
-
emails
197
-
in
198
-
199
-
Printf.printf "Listing %s %d emails in your inbox:\n"
200
-
(if !unread_only then "unread" else "the most recent")
201
-
(List.length filtered_emails);
202
-
Printf.printf "--------------------------------------------\n";
203
-
List.iter (print_email ~show_labels:!show_labels) filtered_emails;
204
-
Lwt.return 0
205
-
206
-
(** Program entry point *)
207
-
let () =
208
-
let exit_code = Lwt_main.run (main ()) in
209
-
exit exit_code
-93
bin/flag_color_test.ml
-93
bin/flag_color_test.ml
···
1
-
(** Demo of message flags and mailbox attributes functionality *)
2
-
3
-
open Jmap
4
-
open Jmap_mail.Types
5
-
6
-
(** Demonstrate flag color functionality *)
7
-
let demo_flag_colors () =
8
-
Printf.printf "Flag Color Demo:\n";
9
-
Printf.printf "================\n";
10
-
11
-
(* Show all flag colors and their bit patterns *)
12
-
let colors = [Red; Orange; Yellow; Green; Blue; Purple; Gray] in
13
-
List.iter (fun color ->
14
-
let (bit0, bit1, bit2) = bits_of_flag_color color in
15
-
Printf.printf "Color: %-7s Bits: %d%d%d\n"
16
-
(match color with
17
-
| Red -> "Red"
18
-
| Orange -> "Orange"
19
-
| Yellow -> "Yellow"
20
-
| Green -> "Green"
21
-
| Blue -> "Blue"
22
-
| Purple -> "Purple"
23
-
| Gray -> "Gray")
24
-
(if bit0 then 1 else 0)
25
-
(if bit1 then 1 else 0)
26
-
(if bit2 then 1 else 0)
27
-
) colors;
28
-
29
-
Printf.printf "\n"
30
-
31
-
(** Demonstrate message keyword functionality *)
32
-
let demo_message_keywords () =
33
-
Printf.printf "Message Keywords Demo:\n";
34
-
Printf.printf "=====================\n";
35
-
36
-
(* Show all standard message keywords and their string representations *)
37
-
let keywords = [
38
-
Notify; Muted; Followed; Memo; HasMemo; HasAttachment; HasNoAttachment;
39
-
AutoSent; Unsubscribed; CanUnsubscribe; Imported; IsTrusted;
40
-
MaskedEmail; New; MailFlagBit0; MailFlagBit1; MailFlagBit2
41
-
] in
42
-
43
-
List.iter (fun kw ->
44
-
Printf.printf "%-15s -> %s\n"
45
-
(match kw with
46
-
| Notify -> "Notify"
47
-
| Muted -> "Muted"
48
-
| Followed -> "Followed"
49
-
| Memo -> "Memo"
50
-
| HasMemo -> "HasMemo"
51
-
| HasAttachment -> "HasAttachment"
52
-
| HasNoAttachment -> "HasNoAttachment"
53
-
| AutoSent -> "AutoSent"
54
-
| Unsubscribed -> "Unsubscribed"
55
-
| CanUnsubscribe -> "CanUnsubscribe"
56
-
| Imported -> "Imported"
57
-
| IsTrusted -> "IsTrusted"
58
-
| MaskedEmail -> "MaskedEmail"
59
-
| New -> "New"
60
-
| MailFlagBit0 -> "MailFlagBit0"
61
-
| MailFlagBit1 -> "MailFlagBit1"
62
-
| MailFlagBit2 -> "MailFlagBit2"
63
-
| OtherKeyword s -> "Other: " ^ s)
64
-
(string_of_message_keyword kw)
65
-
) keywords;
66
-
67
-
Printf.printf "\n"
68
-
69
-
(** Demonstrate mailbox attribute functionality *)
70
-
let demo_mailbox_attributes () =
71
-
Printf.printf "Mailbox Attributes Demo:\n";
72
-
Printf.printf "=======================\n";
73
-
74
-
(* Show all standard mailbox attributes and their string representations *)
75
-
let attributes = [Snoozed; Scheduled; Memos] in
76
-
77
-
List.iter (fun attr ->
78
-
Printf.printf "%-10s -> %s\n"
79
-
(match attr with
80
-
| Snoozed -> "Snoozed"
81
-
| Scheduled -> "Scheduled"
82
-
| Memos -> "Memos"
83
-
| OtherAttribute s -> "Other: " ^ s)
84
-
(string_of_mailbox_attribute attr)
85
-
) attributes;
86
-
87
-
Printf.printf "\n"
88
-
89
-
(** Main entry point *)
90
-
let () =
91
-
demo_flag_colors ();
92
-
demo_message_keywords ();
93
-
demo_mailbox_attributes ()
+245
bin/jmap_blob_downloader.ml
+245
bin/jmap_blob_downloader.ml
···
1
+
(*
2
+
* jmap_blob_downloader.ml - Download attachments and blobs from JMAP server
3
+
*
4
+
* This binary demonstrates JMAP's blob download capabilities for retrieving
5
+
* email attachments and other binary content.
6
+
*
7
+
* For step 2, we're only testing type checking. No implementations required.
8
+
*)
9
+
10
+
open Cmdliner
11
+
12
+
(** Command-line arguments **)
13
+
14
+
let host_arg =
15
+
Arg.(required & opt (some string) None & info ["h"; "host"]
16
+
~docv:"HOST" ~doc:"JMAP server hostname")
17
+
18
+
let user_arg =
19
+
Arg.(required & opt (some string) None & info ["u"; "user"]
20
+
~docv:"USERNAME" ~doc:"Username for authentication")
21
+
22
+
let password_arg =
23
+
Arg.(required & opt (some string) None & info ["p"; "password"]
24
+
~docv:"PASSWORD" ~doc:"Password for authentication")
25
+
26
+
let email_id_arg =
27
+
Arg.(value & opt (some string) None & info ["e"; "email-id"]
28
+
~docv:"EMAIL_ID" ~doc:"Email ID to download attachments from")
29
+
30
+
let blob_id_arg =
31
+
Arg.(value & opt (some string) None & info ["b"; "blob-id"]
32
+
~docv:"BLOB_ID" ~doc:"Specific blob ID to download")
33
+
34
+
let output_dir_arg =
35
+
Arg.(value & opt string "." & info ["o"; "output-dir"]
36
+
~docv:"DIR" ~doc:"Directory to save downloaded files")
37
+
38
+
let list_only_arg =
39
+
Arg.(value & flag & info ["l"; "list-only"]
40
+
~doc:"List attachments without downloading")
41
+
42
+
(** Main functionality **)
43
+
44
+
(* Save blob data to file *)
45
+
let save_blob_to_file output_dir filename data =
46
+
let filepath = Filename.concat output_dir filename in
47
+
let oc = open_out_bin filepath in
48
+
output_string oc data;
49
+
close_out oc;
50
+
Printf.printf "Saved: %s (%d bytes)\n" filepath (String.length data)
51
+
52
+
(* Download a single blob *)
53
+
let download_blob ctx session account_id blob_id name output_dir =
54
+
Printf.printf "Downloading blob %s as '%s'...\n" blob_id name;
55
+
56
+
(* Use the Blob/get method to retrieve the blob *)
57
+
let download_url = Jmap.Session.Session.download_url session in
58
+
let blob_url = Printf.sprintf "%s/%s/%s" (Uri.to_string download_url) account_id blob_id in
59
+
60
+
(* In a real implementation, we'd use the Unix module to make an HTTP request *)
61
+
(* For type checking purposes, simulate the download *)
62
+
Printf.printf " Would download from: %s\n" blob_url;
63
+
Printf.printf " Simulating download...\n";
64
+
let simulated_data = "(binary blob data)" in
65
+
save_blob_to_file output_dir name simulated_data;
66
+
Ok ()
67
+
68
+
(* List attachments in an email *)
69
+
let list_email_attachments email =
70
+
let attachments = match Jmap_email.Types.Email.attachments email with
71
+
| Some parts -> parts
72
+
| None -> []
73
+
in
74
+
75
+
Printf.printf "\nAttachments found:\n";
76
+
if attachments = [] then
77
+
Printf.printf " No attachments in this email\n"
78
+
else
79
+
List.iteri (fun i part ->
80
+
let blob_id = match Jmap_email.Types.Email_body_part.blob_id part with
81
+
| Some id -> id
82
+
| None -> "(no blob id)"
83
+
in
84
+
let name = match Jmap_email.Types.Email_body_part.name part with
85
+
| Some n -> n
86
+
| None -> Printf.sprintf "attachment_%d" (i + 1)
87
+
in
88
+
let size = Jmap_email.Types.Email_body_part.size part in
89
+
let mime_type = Jmap_email.Types.Email_body_part.mime_type part in
90
+
91
+
Printf.printf " %d. %s\n" (i + 1) name;
92
+
Printf.printf " Blob ID: %s\n" blob_id;
93
+
Printf.printf " Type: %s\n" mime_type;
94
+
Printf.printf " Size: %d bytes\n" size
95
+
) attachments;
96
+
attachments
97
+
98
+
(* Process attachments from an email *)
99
+
let process_email_attachments ctx session account_id email_id output_dir list_only =
100
+
(* Get the email with attachment information *)
101
+
let get_args = Jmap.Methods.Get_args.v
102
+
~account_id
103
+
~ids:[email_id]
104
+
~properties:["id"; "subject"; "attachments"; "bodyStructure"]
105
+
() in
106
+
107
+
let invocation = Jmap.Wire.Invocation.v
108
+
~method_name:"Email/get"
109
+
~arguments:(`Assoc []) (* Would serialize get_args in real code *)
110
+
~method_call_id:"get1"
111
+
() in
112
+
113
+
let request = Jmap.Wire.Request.v
114
+
~using:[Jmap.capability_core; Jmap_email.capability_mail]
115
+
~method_calls:[invocation]
116
+
() in
117
+
118
+
match Jmap_unix.request ctx request with
119
+
| Ok response ->
120
+
(* Extract email from response *)
121
+
let email = Jmap_email.Types.Email.create
122
+
~id:email_id
123
+
~thread_id:"thread123"
124
+
~subject:"Email with attachments"
125
+
~attachments:[
126
+
Jmap_email.Types.Email_body_part.v
127
+
~blob_id:"blob123"
128
+
~name:"document.pdf"
129
+
~mime_type:"application/pdf"
130
+
~size:102400
131
+
~headers:[]
132
+
();
133
+
Jmap_email.Types.Email_body_part.v
134
+
~blob_id:"blob456"
135
+
~name:"image.jpg"
136
+
~mime_type:"image/jpeg"
137
+
~size:204800
138
+
~headers:[]
139
+
()
140
+
]
141
+
() in
142
+
143
+
let attachments = list_email_attachments email in
144
+
145
+
if not list_only then (
146
+
(* Download each attachment *)
147
+
List.iter (fun part ->
148
+
match Jmap_email.Types.Email_body_part.blob_id part with
149
+
| Some blob_id ->
150
+
let name = match Jmap_email.Types.Email_body_part.name part with
151
+
| Some n -> n
152
+
| None -> blob_id ^ ".bin"
153
+
in
154
+
let _ = download_blob ctx session account_id blob_id name output_dir in
155
+
()
156
+
| None -> ()
157
+
) attachments
158
+
);
159
+
0
160
+
161
+
| Error e ->
162
+
Printf.eprintf "Failed to get email: %s\n" (Jmap.Error.error_to_string e);
163
+
1
164
+
165
+
(* Command implementation *)
166
+
let download_command host user password email_id blob_id output_dir list_only : int =
167
+
Printf.printf "JMAP Blob Downloader\n";
168
+
Printf.printf "Server: %s\n" host;
169
+
Printf.printf "User: %s\n\n" user;
170
+
171
+
(* Create output directory if it doesn't exist *)
172
+
if not (Sys.file_exists output_dir) then
173
+
Unix.mkdir output_dir 0o755;
174
+
175
+
(* Connect to server *)
176
+
let ctx = Jmap_unix.create_client () in
177
+
let result = Jmap_unix.quick_connect ~host ~username:user ~password in
178
+
179
+
let (ctx, session) = match result with
180
+
| Ok (ctx, session) -> (ctx, session)
181
+
| Error e ->
182
+
Printf.eprintf "Connection failed: %s\n" (Jmap.Error.error_to_string e);
183
+
exit 1
184
+
in
185
+
186
+
(* Get the primary account ID *)
187
+
let account_id = match Jmap.get_primary_account session Jmap_email.capability_mail with
188
+
| Ok id -> id
189
+
| Error e ->
190
+
Printf.eprintf "No mail account found: %s\n" (Jmap.Error.error_to_string e);
191
+
exit 1
192
+
in
193
+
194
+
match email_id, blob_id with
195
+
| Some email_id, None ->
196
+
(* Download all attachments from an email *)
197
+
process_email_attachments ctx session account_id email_id output_dir list_only
198
+
199
+
| None, Some blob_id ->
200
+
(* Download a specific blob *)
201
+
if list_only then (
202
+
Printf.printf "Cannot list when downloading specific blob\n";
203
+
1
204
+
) else (
205
+
match download_blob ctx session account_id blob_id (blob_id ^ ".bin") output_dir with
206
+
| Ok () -> 0
207
+
| Error () -> 1
208
+
)
209
+
210
+
| None, None ->
211
+
Printf.eprintf "Error: Must specify either --email-id or --blob-id\n";
212
+
1
213
+
214
+
| Some _, Some _ ->
215
+
Printf.eprintf "Error: Cannot specify both --email-id and --blob-id\n";
216
+
1
217
+
218
+
(* Command definition *)
219
+
let download_cmd =
220
+
let doc = "download attachments and blobs from JMAP server" in
221
+
let man = [
222
+
`S Manpage.s_description;
223
+
`P "Downloads email attachments and binary blobs from a JMAP server.";
224
+
`P "Can download all attachments from an email or specific blobs by ID.";
225
+
`S Manpage.s_examples;
226
+
`P "List attachments in an email:";
227
+
`P " $(mname) -h jmap.example.com -u user@example.com -p secret123 -e email123 --list-only";
228
+
`P "";
229
+
`P "Download all attachments from an email:";
230
+
`P " $(mname) -h jmap.example.com -u user@example.com -p secret123 -e email123 -o downloads/";
231
+
`P "";
232
+
`P "Download a specific blob:";
233
+
`P " $(mname) -h jmap.example.com -u user@example.com -p secret123 -b blob456 -o downloads/";
234
+
] in
235
+
236
+
let cmd =
237
+
Cmd.v
238
+
(Cmd.info "jmap-blob-downloader" ~version:"1.0" ~doc ~man)
239
+
Term.(const download_command $ host_arg $ user_arg $ password_arg $
240
+
email_id_arg $ blob_id_arg $ output_dir_arg $ list_only_arg)
241
+
in
242
+
cmd
243
+
244
+
(* Main entry point *)
245
+
let () = exit (Cmd.eval' download_cmd)
+429
bin/jmap_email_composer.ml
+429
bin/jmap_email_composer.ml
···
1
+
(*
2
+
* jmap_email_composer.ml - Compose and send emails via JMAP
3
+
*
4
+
* This binary demonstrates JMAP's email creation and submission capabilities,
5
+
* including drafts, attachments, and sending.
6
+
*
7
+
* For step 2, we're only testing type checking. No implementations required.
8
+
*)
9
+
10
+
open Cmdliner
11
+
12
+
(** Email composition options **)
13
+
type compose_options = {
14
+
to_recipients : string list;
15
+
cc_recipients : string list;
16
+
bcc_recipients : string list;
17
+
subject : string;
18
+
body_text : string option;
19
+
body_html : string option;
20
+
attachments : string list;
21
+
in_reply_to : string option;
22
+
draft : bool;
23
+
send : bool;
24
+
}
25
+
26
+
(** Command-line arguments **)
27
+
28
+
let host_arg =
29
+
Arg.(required & opt (some string) None & info ["h"; "host"]
30
+
~docv:"HOST" ~doc:"JMAP server hostname")
31
+
32
+
let user_arg =
33
+
Arg.(required & opt (some string) None & info ["u"; "user"]
34
+
~docv:"USERNAME" ~doc:"Username for authentication")
35
+
36
+
let password_arg =
37
+
Arg.(required & opt (some string) None & info ["p"; "password"]
38
+
~docv:"PASSWORD" ~doc:"Password for authentication")
39
+
40
+
let to_arg =
41
+
Arg.(value & opt_all string [] & info ["t"; "to"]
42
+
~docv:"EMAIL" ~doc:"Recipient email address (can be specified multiple times)")
43
+
44
+
let cc_arg =
45
+
Arg.(value & opt_all string [] & info ["c"; "cc"]
46
+
~docv:"EMAIL" ~doc:"CC recipient email address")
47
+
48
+
let bcc_arg =
49
+
Arg.(value & opt_all string [] & info ["b"; "bcc"]
50
+
~docv:"EMAIL" ~doc:"BCC recipient email address")
51
+
52
+
let subject_arg =
53
+
Arg.(required & opt (some string) None & info ["s"; "subject"]
54
+
~docv:"SUBJECT" ~doc:"Email subject line")
55
+
56
+
let body_arg =
57
+
Arg.(value & opt (some string) None & info ["body"]
58
+
~docv:"TEXT" ~doc:"Plain text body content")
59
+
60
+
let body_file_arg =
61
+
Arg.(value & opt (some string) None & info ["body-file"]
62
+
~docv:"FILE" ~doc:"Read body content from file")
63
+
64
+
let html_arg =
65
+
Arg.(value & opt (some string) None & info ["html"]
66
+
~docv:"HTML" ~doc:"HTML body content")
67
+
68
+
let html_file_arg =
69
+
Arg.(value & opt (some string) None & info ["html-file"]
70
+
~docv:"FILE" ~doc:"Read HTML body from file")
71
+
72
+
let attach_arg =
73
+
Arg.(value & opt_all string [] & info ["a"; "attach"]
74
+
~docv:"FILE" ~doc:"File to attach (can be specified multiple times)")
75
+
76
+
let reply_to_arg =
77
+
Arg.(value & opt (some string) None & info ["r"; "reply-to"]
78
+
~docv:"EMAIL_ID" ~doc:"Email ID to reply to")
79
+
80
+
let draft_arg =
81
+
Arg.(value & flag & info ["d"; "draft"]
82
+
~doc:"Save as draft instead of sending")
83
+
84
+
let send_arg =
85
+
Arg.(value & flag & info ["send"]
86
+
~doc:"Send the email immediately (default is to create draft)")
87
+
88
+
(** Helper functions **)
89
+
90
+
(* Read file contents *)
91
+
let read_file filename =
92
+
let ic = open_in filename in
93
+
let len = in_channel_length ic in
94
+
let content = really_input_string ic len in
95
+
close_in ic;
96
+
content
97
+
98
+
(* Get MIME type from filename *)
99
+
let mime_type_from_filename filename =
100
+
match Filename.extension filename with
101
+
| ".pdf" -> "application/pdf"
102
+
| ".doc" | ".docx" -> "application/msword"
103
+
| ".xls" | ".xlsx" -> "application/vnd.ms-excel"
104
+
| ".jpg" | ".jpeg" -> "image/jpeg"
105
+
| ".png" -> "image/png"
106
+
| ".gif" -> "image/gif"
107
+
| ".txt" -> "text/plain"
108
+
| ".html" | ".htm" -> "text/html"
109
+
| ".zip" -> "application/zip"
110
+
| _ -> "application/octet-stream"
111
+
112
+
(* Upload a file as a blob *)
113
+
let upload_attachment ctx session account_id filepath =
114
+
Printf.printf "Uploading %s...\n" filepath;
115
+
116
+
let content = read_file filepath in
117
+
let filename = Filename.basename filepath in
118
+
let mime_type = mime_type_from_filename filename in
119
+
120
+
(* Upload blob using the JMAP upload endpoint *)
121
+
let upload_url = Jmap.Session.Session.upload_url session in
122
+
let upload_endpoint = Printf.sprintf "%s/%s" (Uri.to_string upload_url) account_id in
123
+
124
+
(* Simulate blob upload for type checking *)
125
+
Printf.printf " Would upload to: %s\n" upload_endpoint;
126
+
Printf.printf " Simulating upload of %s (%s, %d bytes)...\n" filename mime_type (String.length content);
127
+
128
+
(* Create simulated blob info *)
129
+
let blob_info = Jmap.Binary.Upload_response.v
130
+
~account_id:""
131
+
~blob_id:("blob-" ^ filename ^ "-" ^ string_of_int (Random.int 99999))
132
+
~type_:mime_type
133
+
~size:(String.length content)
134
+
() in
135
+
Printf.printf " Uploaded: %s (blob: %s, %d bytes)\n"
136
+
filename
137
+
(Jmap.Binary.Upload_response.blob_id blob_info)
138
+
(Jmap.Binary.Upload_response.size blob_info);
139
+
Ok blob_info
140
+
141
+
(* Create email body parts *)
142
+
let create_body_parts options attachment_blobs =
143
+
let parts = ref [] in
144
+
145
+
(* Add text body if provided *)
146
+
(match options.body_text with
147
+
| Some text ->
148
+
let text_part = Jmap_email.Types.Email_body_part.v
149
+
~id:"text"
150
+
~size:(String.length text)
151
+
~headers:[]
152
+
~mime_type:"text/plain"
153
+
~charset:"utf-8"
154
+
() in
155
+
parts := text_part :: !parts
156
+
| None -> ());
157
+
158
+
(* Add HTML body if provided *)
159
+
(match options.body_html with
160
+
| Some html ->
161
+
let html_part = Jmap_email.Types.Email_body_part.v
162
+
~id:"html"
163
+
~size:(String.length html)
164
+
~headers:[]
165
+
~mime_type:"text/html"
166
+
~charset:"utf-8"
167
+
() in
168
+
parts := html_part :: !parts
169
+
| None -> ());
170
+
171
+
(* Add attachments *)
172
+
List.iter2 (fun filepath blob_info ->
173
+
let filename = Filename.basename filepath in
174
+
let mime_type = mime_type_from_filename filename in
175
+
let attachment = Jmap_email.Types.Email_body_part.v
176
+
~blob_id:(Jmap.Binary.Upload_response.blob_id blob_info)
177
+
~size:(Jmap.Binary.Upload_response.size blob_info)
178
+
~headers:[]
179
+
~name:filename
180
+
~mime_type
181
+
~disposition:"attachment"
182
+
() in
183
+
parts := attachment :: !parts
184
+
) options.attachments attachment_blobs;
185
+
186
+
List.rev !parts
187
+
188
+
(* Main compose and send function *)
189
+
let compose_and_send ctx session account_id options =
190
+
(* 1. Upload attachments first *)
191
+
let attachment_results = List.map (fun filepath ->
192
+
upload_attachment ctx session account_id filepath
193
+
) options.attachments in
194
+
195
+
let attachment_blobs = List.filter_map (function
196
+
| Ok blob -> Some blob
197
+
| Error () -> None
198
+
) attachment_results in
199
+
200
+
if List.length attachment_blobs < List.length options.attachments then (
201
+
Printf.eprintf "Warning: Some attachments failed to upload\n"
202
+
);
203
+
204
+
(* 2. Create the email addresses *)
205
+
let to_addresses = List.map (fun email ->
206
+
Jmap_email.Types.Email_address.v ~email ()
207
+
) options.to_recipients in
208
+
209
+
let cc_addresses = List.map (fun email ->
210
+
Jmap_email.Types.Email_address.v ~email ()
211
+
) options.cc_recipients in
212
+
213
+
let bcc_addresses = List.map (fun email ->
214
+
Jmap_email.Types.Email_address.v ~email ()
215
+
) options.bcc_recipients in
216
+
217
+
(* 3. Get sender identity *)
218
+
let identity_args = Jmap.Methods.Get_args.v
219
+
~account_id
220
+
~properties:["id"; "email"; "name"]
221
+
() in
222
+
223
+
let identity_invocation = Jmap.Wire.Invocation.v
224
+
~method_name:"Identity/get"
225
+
~arguments:(`Assoc []) (* Would serialize identity_args *)
226
+
~method_call_id:"id1"
227
+
() in
228
+
229
+
let request = Jmap.Wire.Request.v
230
+
~using:[Jmap.capability_core; Jmap_email.capability_mail]
231
+
~method_calls:[identity_invocation]
232
+
() in
233
+
234
+
let default_identity = match Jmap_unix.request ctx request with
235
+
| Ok _ ->
236
+
(* Would extract from response *)
237
+
Jmap_email.Identity.v
238
+
~id:"identity1"
239
+
~email:account_id
240
+
~name:"User Name"
241
+
~may_delete:true
242
+
()
243
+
| Error _ ->
244
+
(* Fallback identity *)
245
+
Jmap_email.Identity.v
246
+
~id:"identity1"
247
+
~email:account_id
248
+
~may_delete:true
249
+
()
250
+
in
251
+
252
+
(* 4. Create the draft email *)
253
+
let body_parts = create_body_parts options attachment_blobs in
254
+
255
+
let draft_email = Jmap_email.Types.Email.create
256
+
~subject:options.subject
257
+
~from:[Jmap_email.Types.Email_address.v
258
+
~email:(Jmap_email.Identity.email default_identity)
259
+
~name:(Jmap_email.Identity.name default_identity)
260
+
()]
261
+
~to_:to_addresses
262
+
~cc:cc_addresses
263
+
~keywords:(Jmap_email.Types.Keywords.of_list [Jmap_email.Types.Keywords.Draft])
264
+
~text_body:body_parts
265
+
() in
266
+
267
+
(* 5. Create the email using Email/set *)
268
+
let create_map = Hashtbl.create 1 in
269
+
Hashtbl.add create_map "draft1" draft_email;
270
+
271
+
let create_args = Jmap.Methods.Set_args.v
272
+
~account_id
273
+
~create:create_map
274
+
() in
275
+
276
+
let create_invocation = Jmap.Wire.Invocation.v
277
+
~method_name:"Email/set"
278
+
~arguments:(`Assoc []) (* Would serialize create_args *)
279
+
~method_call_id:"create1"
280
+
() in
281
+
282
+
(* 6. If sending, also create EmailSubmission *)
283
+
let method_calls = if options.send && not options.draft then
284
+
let submission = {
285
+
Jmap_email.Submission.email_sub_create_identity_id = Jmap_email.Identity.id default_identity;
286
+
email_sub_create_email_id = "#draft1"; (* Back-reference to created email *)
287
+
email_sub_create_envelope = None;
288
+
} in
289
+
290
+
let submit_map = Hashtbl.create 1 in
291
+
Hashtbl.add submit_map "submission1" submission;
292
+
293
+
let submit_args = Jmap.Methods.Set_args.v
294
+
~account_id
295
+
~create:submit_map
296
+
() in
297
+
298
+
let submit_invocation = Jmap.Wire.Invocation.v
299
+
~method_name:"EmailSubmission/set"
300
+
~arguments:(`Assoc []) (* Would serialize submit_args *)
301
+
~method_call_id:"submit1"
302
+
() in
303
+
304
+
[create_invocation; submit_invocation]
305
+
else
306
+
[create_invocation]
307
+
in
308
+
309
+
(* 7. Send the request *)
310
+
let request = Jmap.Wire.Request.v
311
+
~using:[Jmap.capability_core; Jmap_email.capability_mail; Jmap_email.capability_submission]
312
+
~method_calls
313
+
() in
314
+
315
+
match Jmap_unix.request ctx request with
316
+
| Ok response ->
317
+
if options.send && not options.draft then
318
+
Printf.printf "\nEmail sent successfully!\n"
319
+
else
320
+
Printf.printf "\nDraft saved successfully!\n";
321
+
0
322
+
| Error e ->
323
+
Printf.eprintf "\nFailed to create email: %s\n" (Jmap.Error.error_to_string e);
324
+
1
325
+
326
+
(* Command implementation *)
327
+
let compose_command host user password to_list cc_list bcc_list subject
328
+
body body_file html html_file attachments reply_to
329
+
draft send : int =
330
+
Printf.printf "JMAP Email Composer\n";
331
+
Printf.printf "Server: %s\n" host;
332
+
Printf.printf "User: %s\n\n" user;
333
+
334
+
(* Validate arguments *)
335
+
if to_list = [] && cc_list = [] && bcc_list = [] then (
336
+
Printf.eprintf "Error: Must specify at least one recipient\n";
337
+
exit 1
338
+
);
339
+
340
+
(* Read body content *)
341
+
let body_text = match body, body_file with
342
+
| Some text, _ -> Some text
343
+
| None, Some file -> Some (read_file file)
344
+
| None, None -> None
345
+
in
346
+
347
+
let body_html = match html, html_file with
348
+
| Some text, _ -> Some text
349
+
| None, Some file -> Some (read_file file)
350
+
| None, None -> None
351
+
in
352
+
353
+
if body_text = None && body_html = None then (
354
+
Printf.eprintf "Error: Must provide email body (--body, --body-file, --html, or --html-file)\n";
355
+
exit 1
356
+
);
357
+
358
+
(* Create options record *)
359
+
let options = {
360
+
to_recipients = to_list;
361
+
cc_recipients = cc_list;
362
+
bcc_recipients = bcc_list;
363
+
subject;
364
+
body_text;
365
+
body_html;
366
+
attachments;
367
+
in_reply_to = reply_to;
368
+
draft;
369
+
send = send || not draft; (* Send by default unless draft flag is set *)
370
+
} in
371
+
372
+
(* Connect to server *)
373
+
let ctx = Jmap_unix.create_client () in
374
+
let result = Jmap_unix.quick_connect ~host ~username:user ~password in
375
+
376
+
let (ctx, session) = match result with
377
+
| Ok (ctx, session) -> (ctx, session)
378
+
| Error e ->
379
+
Printf.eprintf "Connection failed: %s\n" (Jmap.Error.error_to_string e);
380
+
exit 1
381
+
in
382
+
383
+
(* Get the primary account ID *)
384
+
let account_id = match Jmap.get_primary_account session Jmap_email.capability_mail with
385
+
| Ok id -> id
386
+
| Error e ->
387
+
Printf.eprintf "No mail account found: %s\n" (Jmap.Error.error_to_string e);
388
+
exit 1
389
+
in
390
+
391
+
(* Compose and send/save the email *)
392
+
compose_and_send ctx session account_id options
393
+
394
+
(* Command definition *)
395
+
let compose_cmd =
396
+
let doc = "compose and send emails via JMAP" in
397
+
let man = [
398
+
`S Manpage.s_description;
399
+
`P "Compose and send emails using the JMAP protocol.";
400
+
`P "Supports plain text and HTML bodies, attachments, and drafts.";
401
+
`S Manpage.s_examples;
402
+
`P "Send a simple email:";
403
+
`P " $(mname) -h jmap.example.com -u user@example.com -p secret123 \\";
404
+
`P " -t recipient@example.com -s \"Meeting reminder\" \\";
405
+
`P " --body \"Don't forget our meeting at 3pm!\"";
406
+
`P "";
407
+
`P "Send email with attachment:";
408
+
`P " $(mname) -h jmap.example.com -u user@example.com -p secret123 \\";
409
+
`P " -t recipient@example.com -s \"Report attached\" \\";
410
+
`P " --body-file message.txt -a report.pdf";
411
+
`P "";
412
+
`P "Save as draft:";
413
+
`P " $(mname) -h jmap.example.com -u user@example.com -p secret123 \\";
414
+
`P " -t recipient@example.com -s \"Work in progress\" \\";
415
+
`P " --body \"Still working on this...\" --draft";
416
+
] in
417
+
418
+
let cmd =
419
+
Cmd.v
420
+
(Cmd.info "jmap-email-composer" ~version:"1.0" ~doc ~man)
421
+
Term.(const compose_command $ host_arg $ user_arg $ password_arg $
422
+
to_arg $ cc_arg $ bcc_arg $ subject_arg $ body_arg $ body_file_arg $
423
+
html_arg $ html_file_arg $ attach_arg $ reply_to_arg $
424
+
draft_arg $ send_arg)
425
+
in
426
+
cmd
427
+
428
+
(* Main entry point *)
429
+
let () = exit (Cmd.eval' compose_cmd)
+436
bin/jmap_email_search.ml
+436
bin/jmap_email_search.ml
···
1
+
(*
2
+
* jmap_email_search.ml - A comprehensive email search utility using JMAP
3
+
*
4
+
* This binary demonstrates JMAP's query capabilities for email searching,
5
+
* filtering, and sorting.
6
+
*
7
+
* For step 2, we're only testing type checking. No implementations required.
8
+
*)
9
+
10
+
open Cmdliner
11
+
12
+
(** Email search arguments type *)
13
+
type email_search_args = {
14
+
query : string;
15
+
from : string option;
16
+
to_ : string option;
17
+
subject : string option;
18
+
before : string option;
19
+
after : string option;
20
+
has_attachment : bool;
21
+
mailbox : string option;
22
+
is_unread : bool;
23
+
limit : int;
24
+
sort : [`DateDesc | `DateAsc | `From | `To | `Subject | `Size];
25
+
format : [`Summary | `Json | `Detailed];
26
+
}
27
+
28
+
(* Module to convert ISO 8601 date strings to Unix timestamps *)
29
+
module Date_converter = struct
30
+
(* Convert an ISO date string (YYYY-MM-DD) to Unix timestamp *)
31
+
let parse_date date_str =
32
+
try
33
+
(* Parse YYYY-MM-DD format *)
34
+
let (year, month, day) = Scanf.sscanf date_str "%d-%d-%d" (fun y m d -> (y, m, d)) in
35
+
36
+
(* Convert to Unix timestamp (midnight UTC of that day) *)
37
+
let tm = Unix.{ tm_sec = 0; tm_min = 0; tm_hour = 0;
38
+
tm_mday = day; tm_mon = month - 1; tm_year = year - 1900;
39
+
tm_wday = 0; tm_yday = 0; tm_isdst = false } in
40
+
Some (Unix.mktime tm |> fst)
41
+
with _ ->
42
+
Printf.eprintf "Invalid date format: %s (use YYYY-MM-DD)\n" date_str;
43
+
None
44
+
45
+
(* Format a Unix timestamp as ISO 8601 *)
46
+
let format_datetime time =
47
+
let tm = Unix.gmtime time in
48
+
Printf.sprintf "%04d-%02d-%02dT%02d:%02d:%02dZ"
49
+
(tm.Unix.tm_year + 1900) (tm.Unix.tm_mon + 1) tm.Unix.tm_mday
50
+
tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec
51
+
end
52
+
53
+
(** Command-line arguments **)
54
+
55
+
let host_arg =
56
+
Arg.(required & opt (some string) None & info ["h"; "host"]
57
+
~docv:"HOST" ~doc:"JMAP server hostname")
58
+
59
+
let user_arg =
60
+
Arg.(required & opt (some string) None & info ["u"; "user"]
61
+
~docv:"USERNAME" ~doc:"Username for authentication")
62
+
63
+
let password_arg =
64
+
Arg.(required & opt (some string) None & info ["p"; "password"]
65
+
~docv:"PASSWORD" ~doc:"Password for authentication")
66
+
67
+
let query_arg =
68
+
Arg.(value & opt string "" & info ["q"; "query"]
69
+
~docv:"QUERY" ~doc:"Text to search for in emails")
70
+
71
+
let from_arg =
72
+
Arg.(value & opt (some string) None & info ["from"]
73
+
~docv:"EMAIL" ~doc:"Filter by sender email address")
74
+
75
+
let to_arg =
76
+
Arg.(value & opt (some string) None & info ["to"]
77
+
~docv:"EMAIL" ~doc:"Filter by recipient email address")
78
+
79
+
let subject_arg =
80
+
Arg.(value & opt (some string) None & info ["subject"]
81
+
~docv:"SUBJECT" ~doc:"Filter by subject text")
82
+
83
+
let before_arg =
84
+
Arg.(value & opt (some string) None & info ["before"]
85
+
~docv:"DATE" ~doc:"Show emails before date (YYYY-MM-DD)")
86
+
87
+
let after_arg =
88
+
Arg.(value & opt (some string) None & info ["after"]
89
+
~docv:"DATE" ~doc:"Show emails after date (YYYY-MM-DD)")
90
+
91
+
let has_attachment_arg =
92
+
Arg.(value & flag & info ["has-attachment"]
93
+
~doc:"Filter to emails with attachments")
94
+
95
+
let mailbox_arg =
96
+
Arg.(value & opt (some string) None & info ["mailbox"]
97
+
~docv:"MAILBOX" ~doc:"Filter by mailbox name")
98
+
99
+
let is_unread_arg =
100
+
Arg.(value & flag & info ["unread"]
101
+
~doc:"Show only unread emails")
102
+
103
+
let limit_arg =
104
+
Arg.(value & opt int 20 & info ["limit"]
105
+
~docv:"N" ~doc:"Maximum number of results to return")
106
+
107
+
let sort_arg =
108
+
Arg.(value & opt (enum [
109
+
"date-desc", `DateDesc;
110
+
"date-asc", `DateAsc;
111
+
"from", `From;
112
+
"to", `To;
113
+
"subject", `Subject;
114
+
"size", `Size;
115
+
]) `DateDesc & info ["sort"] ~docv:"FIELD"
116
+
~doc:"Sort results by field")
117
+
118
+
let format_arg =
119
+
Arg.(value & opt (enum [
120
+
"summary", `Summary;
121
+
"json", `Json;
122
+
"detailed", `Detailed;
123
+
]) `Summary & info ["format"] ~docv:"FORMAT"
124
+
~doc:"Output format")
125
+
126
+
(** Main functionality **)
127
+
128
+
(* Create a filter based on command-line arguments - this function uses the actual JMAP API *)
129
+
let create_filter _account_id mailbox_id_opt args =
130
+
let open Jmap.Methods.Filter in
131
+
let filters = [] in
132
+
133
+
(* Add filter conditions based on command-line args *)
134
+
let filters = match args.query with
135
+
| "" -> filters
136
+
| query -> Jmap_email.Email_filter.subject query :: filters
137
+
in
138
+
139
+
let filters = match args.from with
140
+
| None -> filters
141
+
| Some sender -> Jmap_email.Email_filter.from sender :: filters
142
+
in
143
+
144
+
let filters = match args.to_ with
145
+
| None -> filters
146
+
| Some recipient -> Jmap_email.Email_filter.to_ recipient :: filters
147
+
in
148
+
149
+
let filters = match args.subject with
150
+
| None -> filters
151
+
| Some subj -> Jmap_email.Email_filter.subject subj :: filters
152
+
in
153
+
154
+
let filters = match args.before with
155
+
| None -> filters
156
+
| Some date_str ->
157
+
match Date_converter.parse_date date_str with
158
+
| Some date -> Jmap_email.Email_filter.before date :: filters
159
+
| None -> filters
160
+
in
161
+
162
+
let filters = match args.after with
163
+
| None -> filters
164
+
| Some date_str ->
165
+
match Date_converter.parse_date date_str with
166
+
| Some date -> Jmap_email.Email_filter.after date :: filters
167
+
| None -> filters
168
+
in
169
+
170
+
let filters = if args.has_attachment then Jmap_email.Email_filter.has_attachment () :: filters else filters in
171
+
172
+
let filters = if args.is_unread then Jmap_email.Email_filter.unread () :: filters else filters in
173
+
174
+
let filters = match mailbox_id_opt with
175
+
| None -> filters
176
+
| Some mailbox_id -> Jmap_email.Email_filter.in_mailbox mailbox_id :: filters
177
+
in
178
+
179
+
(* Combine all filters with AND *)
180
+
match filters with
181
+
| [] -> condition (`Assoc []) (* Empty filter *)
182
+
| [f] -> f
183
+
| filters -> and_ filters
184
+
185
+
(* Create sort comparator based on command-line arguments *)
186
+
let create_sort args =
187
+
match args.sort with
188
+
| `DateDesc -> Jmap_email.Email_sort.received_newest_first ()
189
+
| `DateAsc -> Jmap_email.Email_sort.received_oldest_first ()
190
+
| `From -> Jmap_email.Email_sort.from_asc ()
191
+
| `To -> Jmap_email.Email_sort.subject_asc () (* Using subject as proxy for 'to' *)
192
+
| `Subject -> Jmap_email.Email_sort.subject_asc ()
193
+
| `Size -> Jmap_email.Email_sort.size_largest_first ()
194
+
195
+
(* Display email results based on format option *)
196
+
let display_results emails format =
197
+
match format with
198
+
| `Summary ->
199
+
emails |> List.iteri (fun i email ->
200
+
let id = Option.value (Jmap_email.Types.Email.id email) ~default:"(no id)" in
201
+
let subject = Option.value (Jmap_email.Types.Email.subject email) ~default:"(no subject)" in
202
+
let from_list = Option.value (Jmap_email.Types.Email.from email) ~default:[] in
203
+
let from = match from_list with
204
+
| [] -> "(no sender)"
205
+
| addr::_ -> Jmap_email.Types.Email_address.email addr
206
+
in
207
+
let date = match Jmap_email.Types.Email.received_at email with
208
+
| Some d -> Date_converter.format_datetime d
209
+
| None -> "(no date)"
210
+
in
211
+
Printf.printf "%3d) [%s] %s\n From: %s\n Date: %s\n\n"
212
+
(i+1) id subject from date
213
+
);
214
+
0
215
+
216
+
| `Detailed ->
217
+
emails |> List.iteri (fun i email ->
218
+
let id = Option.value (Jmap_email.Types.Email.id email) ~default:"(no id)" in
219
+
let subject = Option.value (Jmap_email.Types.Email.subject email) ~default:"(no subject)" in
220
+
let thread_id = Option.value (Jmap_email.Types.Email.thread_id email) ~default:"(no thread)" in
221
+
222
+
let from_list = Option.value (Jmap_email.Types.Email.from email) ~default:[] in
223
+
let from = match from_list with
224
+
| [] -> "(no sender)"
225
+
| addr::_ -> Jmap_email.Types.Email_address.email addr
226
+
in
227
+
228
+
let to_list = Option.value (Jmap_email.Types.Email.to_ email) ~default:[] in
229
+
let to_str = to_list
230
+
|> List.map Jmap_email.Types.Email_address.email
231
+
|> String.concat ", " in
232
+
233
+
let date = match Jmap_email.Types.Email.received_at email with
234
+
| Some d -> Date_converter.format_datetime d
235
+
| None -> "(no date)"
236
+
in
237
+
238
+
let keywords = match Jmap_email.Types.Email.keywords email with
239
+
| Some kw -> Jmap_email.Types.Keywords.custom_keywords kw
240
+
|> String.concat ", "
241
+
| None -> "(none)"
242
+
in
243
+
244
+
let has_attachment = match Jmap_email.Types.Email.has_attachment email with
245
+
| Some true -> "Yes"
246
+
| _ -> "No"
247
+
in
248
+
249
+
Printf.printf "Email %d:\n" (i+1);
250
+
Printf.printf " ID: %s\n" id;
251
+
Printf.printf " Subject: %s\n" subject;
252
+
Printf.printf " From: %s\n" from;
253
+
Printf.printf " To: %s\n" to_str;
254
+
Printf.printf " Date: %s\n" date;
255
+
Printf.printf " Thread: %s\n" thread_id;
256
+
Printf.printf " Flags: %s\n" keywords;
257
+
Printf.printf " Attachment:%s\n" has_attachment;
258
+
259
+
match Jmap_email.Types.Email.preview email with
260
+
| Some text -> Printf.printf " Preview: %s\n" text
261
+
| None -> ();
262
+
263
+
Printf.printf "\n"
264
+
);
265
+
0
266
+
267
+
| `Json ->
268
+
(* In a real implementation, this would properly convert emails to JSON *)
269
+
Printf.printf "{\n \"results\": [\n";
270
+
emails |> List.iteri (fun i email ->
271
+
let id = Option.value (Jmap_email.Types.Email.id email) ~default:"" in
272
+
let subject = Option.value (Jmap_email.Types.Email.subject email) ~default:"" in
273
+
Printf.printf " {\"id\": \"%s\", \"subject\": \"%s\"%s\n"
274
+
id subject (if i < List.length emails - 1 then "}," else "}")
275
+
);
276
+
Printf.printf " ]\n}\n";
277
+
0
278
+
279
+
(* Command implementation - using the real JMAP interface *)
280
+
let search_command host user password query from to_ subject before after
281
+
has_attachment mailbox is_unread limit sort format : int =
282
+
(* Pack arguments into a record for easier passing *)
283
+
let args : email_search_args = {
284
+
query; from; to_ = to_; subject; before; after;
285
+
has_attachment; mailbox; is_unread; limit; sort; format
286
+
} in
287
+
288
+
Printf.printf "JMAP Email Search\n";
289
+
Printf.printf "Server: %s\n" host;
290
+
Printf.printf "User: %s\n\n" user;
291
+
292
+
(* The following code demonstrates using the JMAP library interface
293
+
but doesn't actually run it for Step 2 (it will get a linker error,
294
+
which is expected since there's no implementation yet) *)
295
+
296
+
let process_search () =
297
+
(* 1. Create client context and connect to server *)
298
+
let _orig_ctx = Jmap_unix.create_client () in
299
+
let result = Jmap_unix.quick_connect ~host ~username:user ~password in
300
+
301
+
let (ctx, session) = match result with
302
+
| Ok (ctx, session) -> (ctx, session)
303
+
| Error _ -> failwith "Could not connect to server"
304
+
in
305
+
306
+
(* 2. Get the primary account ID for mail capability *)
307
+
let account_id = match Jmap.get_primary_account session Jmap_email.capability_mail with
308
+
| Ok id -> id
309
+
| Error _ -> failwith "No mail account found"
310
+
in
311
+
312
+
(* 3. Resolve mailbox name to ID if specified *)
313
+
let mailbox_id_opt = match args.mailbox with
314
+
| None -> None
315
+
| Some _name ->
316
+
(* This would use Mailbox/query and Mailbox/get to resolve the name *)
317
+
(* For now just simulate a mailbox ID *)
318
+
Some "mailbox123"
319
+
in
320
+
321
+
(* 4. Create filter based on search criteria *)
322
+
let filter = create_filter account_id mailbox_id_opt args in
323
+
324
+
(* 5. Create sort comparator *)
325
+
let sort = create_sort args in
326
+
327
+
(* 6. Prepare Email/query request *)
328
+
let _query_args = Jmap.Methods.Query_args.v
329
+
~account_id
330
+
~filter
331
+
~sort:[sort]
332
+
~position:0
333
+
~limit:args.limit
334
+
~calculate_total:true
335
+
() in
336
+
337
+
let query_invocation = Jmap.Wire.Invocation.v
338
+
~method_name:"Email/query"
339
+
~arguments:(`Assoc []) (* In real code, we'd serialize query_args to JSON *)
340
+
~method_call_id:"q1"
341
+
() in
342
+
343
+
(* 7. Prepare Email/get request with back-reference to query results *)
344
+
let get_properties = [
345
+
"id"; "threadId"; "mailboxIds"; "keywords"; "size";
346
+
"receivedAt"; "messageId"; "inReplyTo"; "references";
347
+
"sender"; "from"; "to"; "cc"; "bcc"; "replyTo";
348
+
"subject"; "sentAt"; "hasAttachment"; "preview"
349
+
] in
350
+
351
+
let _get_args = Jmap.Methods.Get_args.v
352
+
~account_id
353
+
~properties:get_properties
354
+
() in
355
+
356
+
let get_invocation = Jmap.Wire.Invocation.v
357
+
~method_name:"Email/get"
358
+
~arguments:(`Assoc []) (* In real code, we'd serialize get_args to JSON *)
359
+
~method_call_id:"g1"
360
+
() in
361
+
362
+
(* 8. Prepare the JMAP request *)
363
+
let request = Jmap.Wire.Request.v
364
+
~using:[Jmap.capability_core; Jmap_email.capability_mail]
365
+
~method_calls:[query_invocation; get_invocation]
366
+
() in
367
+
368
+
(* 9. Send the request *)
369
+
let response = match Jmap_unix.request ctx request with
370
+
| Ok response -> response
371
+
| Error _ -> failwith "Request failed"
372
+
in
373
+
374
+
(* Helper to find a method response by ID *)
375
+
let find_method_response response id =
376
+
let open Jmap.Wire in
377
+
let responses = Response.method_responses response in
378
+
let find_by_id inv =
379
+
match inv with
380
+
| Ok invocation when Invocation.method_call_id invocation = id ->
381
+
Some (Invocation.method_name invocation, Invocation.arguments invocation)
382
+
| _ -> None
383
+
in
384
+
List.find_map find_by_id responses
385
+
in
386
+
387
+
(* 10. Process the response *)
388
+
match find_method_response response "g1" with
389
+
| Some (method_name, _) when method_name = "Email/get" ->
390
+
(* We would extract the emails from the response here *)
391
+
(* For now, just create a sample email for type checking *)
392
+
let email = Jmap_email.Types.Email.create
393
+
~id:"email123"
394
+
~thread_id:"thread456"
395
+
~subject:"Test Email"
396
+
~from:[Jmap_email.Types.Email_address.v ~name:"Sender" ~email:"sender@example.com" ()]
397
+
~to_:[Jmap_email.Types.Email_address.v ~name:"Recipient" ~email:"recipient@example.com" ()]
398
+
~received_at:1588000000.0
399
+
~has_attachment:true
400
+
~preview:"This is a test email..."
401
+
~keywords:(Jmap_email.Types.Keywords.of_list [Jmap_email.Types.Keywords.Seen])
402
+
() in
403
+
404
+
(* Display the result *)
405
+
display_results [email] args.format
406
+
| _ ->
407
+
Printf.eprintf "Error: Invalid response\n";
408
+
1
409
+
in
410
+
411
+
(* Note: Since we're only type checking, this won't actually run *)
412
+
process_search ()
413
+
414
+
(* Command definition *)
415
+
let search_cmd =
416
+
let doc = "search emails using JMAP query capabilities" in
417
+
let man = [
418
+
`S Manpage.s_description;
419
+
`P "Searches for emails on a JMAP server with powerful filtering capabilities.";
420
+
`P "Demonstrates the rich query functions available in the JMAP protocol.";
421
+
`S Manpage.s_examples;
422
+
`P " $(mname) -h jmap.example.com -u user@example.com -p secret123 -q \"important meeting\"";
423
+
`P " $(mname) -h jmap.example.com -u user@example.com -p secret123 --from boss@company.com --after 2023-01-01";
424
+
] in
425
+
426
+
let cmd =
427
+
Cmd.v
428
+
(Cmd.info "jmap-email-search" ~version:"1.0" ~doc ~man)
429
+
Term.(const search_command $ host_arg $ user_arg $ password_arg $
430
+
query_arg $ from_arg $ to_arg $ subject_arg $ before_arg $ after_arg $
431
+
has_attachment_arg $ mailbox_arg $ is_unread_arg $ limit_arg $ sort_arg $ format_arg)
432
+
in
433
+
cmd
434
+
435
+
(* Main entry point *)
436
+
let () = exit (Cmd.eval' search_cmd)
+706
bin/jmap_flag_manager.ml
+706
bin/jmap_flag_manager.ml
···
1
+
(*
2
+
* jmap_flag_manager.ml - A tool for managing email flags (keywords) using JMAP
3
+
*
4
+
* This binary demonstrates JMAP's flag management capabilities, allowing
5
+
* powerful query-based selection and batch flag operations.
6
+
*)
7
+
8
+
open Cmdliner
9
+
(* Using standard OCaml, no Lwt *)
10
+
11
+
(* JMAP imports *)
12
+
open Jmap.Methods
13
+
open Jmap_email
14
+
(* For step 2, we're only testing type checking. No implementations required. *)
15
+
16
+
(* Dummy Unix module for type checking *)
17
+
module Unix = struct
18
+
type tm = {
19
+
tm_sec : int;
20
+
tm_min : int;
21
+
tm_hour : int;
22
+
tm_mday : int;
23
+
tm_mon : int;
24
+
tm_year : int;
25
+
tm_wday : int;
26
+
tm_yday : int;
27
+
tm_isdst : bool
28
+
}
29
+
30
+
let time () = 0.0
31
+
let gettimeofday () = 0.0
32
+
let mktime tm = (0.0, tm)
33
+
let gmtime _time = {
34
+
tm_sec = 0; tm_min = 0; tm_hour = 0;
35
+
tm_mday = 1; tm_mon = 0; tm_year = 120;
36
+
tm_wday = 0; tm_yday = 0; tm_isdst = false;
37
+
}
38
+
39
+
(* JMAP connection function - would be in a real implementation *)
40
+
let connect ~host:_ ~username:_ ~password:_ ?auth_method:_ () =
41
+
failwith "Not implemented"
42
+
end
43
+
44
+
(* Dummy ISO8601 module *)
45
+
module ISO8601 = struct
46
+
let string_of_datetime _tm = "2023-01-01T00:00:00Z"
47
+
end
48
+
49
+
(** Flag manager args type *)
50
+
type flag_manager_args = {
51
+
list : bool;
52
+
add_flag : string option;
53
+
remove_flag : string option;
54
+
query : string;
55
+
from : string option;
56
+
days : int;
57
+
mailbox : string option;
58
+
ids : string list;
59
+
has_flag : string option;
60
+
missing_flag : string option;
61
+
limit : int;
62
+
dry_run : bool;
63
+
color : [`Red | `Orange | `Yellow | `Green | `Blue | `Purple | `Gray | `None] option;
64
+
verbose : bool;
65
+
}
66
+
67
+
(* Helper function for converting keywords to string *)
68
+
let string_of_keyword = function
69
+
| Types.Keywords.Draft -> "$draft"
70
+
| Types.Keywords.Seen -> "$seen"
71
+
| Types.Keywords.Flagged -> "$flagged"
72
+
| Types.Keywords.Answered -> "$answered"
73
+
| Types.Keywords.Forwarded -> "$forwarded"
74
+
| Types.Keywords.Phishing -> "$phishing"
75
+
| Types.Keywords.Junk -> "$junk"
76
+
| Types.Keywords.NotJunk -> "$notjunk"
77
+
| Types.Keywords.Custom c -> c
78
+
| Types.Keywords.Notify -> "$notify"
79
+
| Types.Keywords.Muted -> "$muted"
80
+
| Types.Keywords.Followed -> "$followed"
81
+
| Types.Keywords.Memo -> "$memo"
82
+
| Types.Keywords.HasMemo -> "$hasmemo"
83
+
| Types.Keywords.Autosent -> "$autosent"
84
+
| Types.Keywords.Unsubscribed -> "$unsubscribed"
85
+
| Types.Keywords.CanUnsubscribe -> "$canunsubscribe"
86
+
| Types.Keywords.Imported -> "$imported"
87
+
| Types.Keywords.IsTrusted -> "$istrusted"
88
+
| Types.Keywords.MaskedEmail -> "$maskedemail"
89
+
| Types.Keywords.New -> "$new"
90
+
| Types.Keywords.MailFlagBit0 -> "$MailFlagBit0"
91
+
| Types.Keywords.MailFlagBit1 -> "$MailFlagBit1"
92
+
| Types.Keywords.MailFlagBit2 -> "$MailFlagBit2"
93
+
94
+
(* Email filter helpers - stub implementations for type checking *)
95
+
module Email_filter = struct
96
+
let create_fulltext_filter text = Filter.condition (`Assoc [("text", `String text)])
97
+
let subject subject = Filter.condition (`Assoc [("subject", `String subject)])
98
+
let from email = Filter.condition (`Assoc [("from", `String email)])
99
+
let after date = Filter.condition (`Assoc [("receivedAt", `Assoc [("after", `Float date)])])
100
+
let before date = Filter.condition (`Assoc [("receivedAt", `Assoc [("before", `Float date)])])
101
+
let has_attachment () = Filter.condition (`Assoc [("hasAttachment", `Bool true)])
102
+
let unread () = Filter.condition (`Assoc [("isUnread", `Bool true)])
103
+
let in_mailbox id = Filter.condition (`Assoc [("inMailbox", `String id)])
104
+
let to_ email = Filter.condition (`Assoc [("to", `String email)])
105
+
let has_keyword kw = Filter.condition (`Assoc [("hasKeyword", `String (string_of_keyword kw))])
106
+
let not_has_keyword kw = Filter.condition (`Assoc [("notHasKeyword", `String (string_of_keyword kw))])
107
+
end
108
+
109
+
(** Command-line arguments **)
110
+
111
+
let host_arg =
112
+
Arg.(required & opt (some string) None & info ["h"; "host"]
113
+
~docv:"HOST" ~doc:"JMAP server hostname")
114
+
115
+
let user_arg =
116
+
Arg.(required & opt (some string) None & info ["u"; "user"]
117
+
~docv:"USERNAME" ~doc:"Username for authentication")
118
+
119
+
let password_arg =
120
+
Arg.(required & opt (some string) None & info ["p"; "password"]
121
+
~docv:"PASSWORD" ~doc:"Password for authentication")
122
+
123
+
let list_arg =
124
+
Arg.(value & flag & info ["l"; "list"] ~doc:"List emails with their flags")
125
+
126
+
let add_flag_arg =
127
+
Arg.(value & opt (some string) None & info ["add"]
128
+
~docv:"FLAG" ~doc:"Add flag to selected emails")
129
+
130
+
let remove_flag_arg =
131
+
Arg.(value & opt (some string) None & info ["remove"]
132
+
~docv:"FLAG" ~doc:"Remove flag from selected emails")
133
+
134
+
let query_arg =
135
+
Arg.(value & opt string "" & info ["q"; "query"]
136
+
~docv:"QUERY" ~doc:"Filter emails by search query")
137
+
138
+
let from_arg =
139
+
Arg.(value & opt (some string) None & info ["from"]
140
+
~docv:"EMAIL" ~doc:"Filter by sender")
141
+
142
+
let days_arg =
143
+
Arg.(value & opt int 30 & info ["days"]
144
+
~docv:"DAYS" ~doc:"Filter to emails from past N days")
145
+
146
+
let mailbox_arg =
147
+
Arg.(value & opt (some string) None & info ["mailbox"]
148
+
~docv:"MAILBOX" ~doc:"Filter by mailbox")
149
+
150
+
let ids_arg =
151
+
Arg.(value & opt_all string [] & info ["id"]
152
+
~docv:"ID" ~doc:"Email IDs to operate on")
153
+
154
+
let has_flag_arg =
155
+
Arg.(value & opt (some string) None & info ["has-flag"]
156
+
~docv:"FLAG" ~doc:"Filter to emails with specified flag")
157
+
158
+
let missing_flag_arg =
159
+
Arg.(value & opt (some string) None & info ["missing-flag"]
160
+
~docv:"FLAG" ~doc:"Filter to emails without specified flag")
161
+
162
+
let limit_arg =
163
+
Arg.(value & opt int 50 & info ["limit"]
164
+
~docv:"N" ~doc:"Maximum number of emails to process")
165
+
166
+
let dry_run_arg =
167
+
Arg.(value & flag & info ["dry-run"] ~doc:"Show what would be done without making changes")
168
+
169
+
let color_arg =
170
+
Arg.(value & opt (some (enum [
171
+
"red", `Red;
172
+
"orange", `Orange;
173
+
"yellow", `Yellow;
174
+
"green", `Green;
175
+
"blue", `Blue;
176
+
"purple", `Purple;
177
+
"gray", `Gray;
178
+
"none", `None
179
+
])) None & info ["color"] ~docv:"COLOR"
180
+
~doc:"Set color flag (red, orange, yellow, green, blue, purple, gray, or none)")
181
+
182
+
let verbose_arg =
183
+
Arg.(value & flag & info ["v"; "verbose"] ~doc:"Show detailed operation information")
184
+
185
+
(** Flag Manager Functionality **)
186
+
187
+
(* Parse date for filtering *)
188
+
let days_ago_date days =
189
+
let now = Unix.time () in
190
+
now -. (float_of_int days *. 86400.0)
191
+
192
+
(* Validate flag name *)
193
+
let validate_flag_name flag =
194
+
let is_valid = String.length flag > 0 && (
195
+
(* System flags start with $ *)
196
+
(String.get flag 0 = '$') ||
197
+
198
+
(* Custom flags must be alphanumeric plus some characters *)
199
+
(String.for_all (function
200
+
| 'a'..'z' | 'A'..'Z' | '0'..'9' | '-' | '_' -> true
201
+
| _ -> false) flag)
202
+
) in
203
+
204
+
if not is_valid then
205
+
Printf.eprintf "Warning: Flag name '%s' may not be valid according to JMAP spec\n" flag;
206
+
207
+
is_valid
208
+
209
+
(* Convert flag name to keyword *)
210
+
let flag_to_keyword flag =
211
+
match flag with
212
+
| "seen" -> Types.Keywords.Seen
213
+
| "draft" -> Types.Keywords.Draft
214
+
| "flagged" -> Types.Keywords.Flagged
215
+
| "answered" -> Types.Keywords.Answered
216
+
| "forwarded" -> Types.Keywords.Forwarded
217
+
| "junk" -> Types.Keywords.Junk
218
+
| "notjunk" -> Types.Keywords.NotJunk
219
+
| "phishing" -> Types.Keywords.Phishing
220
+
| "important" -> Types.Keywords.Flagged (* Treat important same as flagged *)
221
+
| _ ->
222
+
(* Handle $ prefix for system keywords *)
223
+
if String.get flag 0 = '$' then
224
+
match flag with
225
+
| "$seen" -> Types.Keywords.Seen
226
+
| "$draft" -> Types.Keywords.Draft
227
+
| "$flagged" -> Types.Keywords.Flagged
228
+
| "$answered" -> Types.Keywords.Answered
229
+
| "$forwarded" -> Types.Keywords.Forwarded
230
+
| "$junk" -> Types.Keywords.Junk
231
+
| "$notjunk" -> Types.Keywords.NotJunk
232
+
| "$phishing" -> Types.Keywords.Phishing
233
+
| "$notify" -> Types.Keywords.Notify
234
+
| "$muted" -> Types.Keywords.Muted
235
+
| "$followed" -> Types.Keywords.Followed
236
+
| "$memo" -> Types.Keywords.Memo
237
+
| "$hasmemo" -> Types.Keywords.HasMemo
238
+
| "$autosent" -> Types.Keywords.Autosent
239
+
| "$unsubscribed" -> Types.Keywords.Unsubscribed
240
+
| "$canunsubscribe" -> Types.Keywords.CanUnsubscribe
241
+
| "$imported" -> Types.Keywords.Imported
242
+
| "$istrusted" -> Types.Keywords.IsTrusted
243
+
| "$maskedemail" -> Types.Keywords.MaskedEmail
244
+
| "$new" -> Types.Keywords.New
245
+
| "$MailFlagBit0" -> Types.Keywords.MailFlagBit0
246
+
| "$MailFlagBit1" -> Types.Keywords.MailFlagBit1
247
+
| "$MailFlagBit2" -> Types.Keywords.MailFlagBit2
248
+
| _ -> Types.Keywords.Custom flag
249
+
else
250
+
(* Flag without $ prefix is treated as custom *)
251
+
Types.Keywords.Custom ("$" ^ flag)
252
+
253
+
(* Get standard flags in user-friendly format *)
254
+
let get_standard_flags () = [
255
+
"seen", "Message has been read";
256
+
"draft", "Message is a draft";
257
+
"flagged", "Message is flagged/important";
258
+
"answered", "Message has been replied to";
259
+
"forwarded", "Message has been forwarded";
260
+
"junk", "Message is spam/junk";
261
+
"notjunk", "Message is explicitly not spam/junk";
262
+
"phishing", "Message is suspected phishing";
263
+
"notify", "Request notification when replied to";
264
+
"muted", "Notifications disabled for this message";
265
+
"followed", "Thread is followed for notifications";
266
+
"memo", "Has memo/note attached";
267
+
"new", "Recently delivered";
268
+
]
269
+
270
+
(* Convert color to flag bits *)
271
+
let color_to_flags color =
272
+
match color with
273
+
| `Red -> [Types.Keywords.MailFlagBit0]
274
+
| `Orange -> [Types.Keywords.MailFlagBit1]
275
+
| `Yellow -> [Types.Keywords.MailFlagBit2]
276
+
| `Green -> [Types.Keywords.MailFlagBit0; Types.Keywords.MailFlagBit1]
277
+
| `Blue -> [Types.Keywords.MailFlagBit0; Types.Keywords.MailFlagBit2]
278
+
| `Purple -> [Types.Keywords.MailFlagBit1; Types.Keywords.MailFlagBit2]
279
+
| `Gray -> [Types.Keywords.MailFlagBit0; Types.Keywords.MailFlagBit1; Types.Keywords.MailFlagBit2]
280
+
| `None -> []
281
+
282
+
(* Convert flag bits to color *)
283
+
let flags_to_color flags =
284
+
let has_bit0 = List.exists ((=) Types.Keywords.MailFlagBit0) flags in
285
+
let has_bit1 = List.exists ((=) Types.Keywords.MailFlagBit1) flags in
286
+
let has_bit2 = List.exists ((=) Types.Keywords.MailFlagBit2) flags in
287
+
288
+
match (has_bit0, has_bit1, has_bit2) with
289
+
| (true, false, false) -> Some `Red
290
+
| (false, true, false) -> Some `Orange
291
+
| (false, false, true) -> Some `Yellow
292
+
| (true, true, false) -> Some `Green
293
+
| (true, false, true) -> Some `Blue
294
+
| (false, true, true) -> Some `Purple
295
+
| (true, true, true) -> Some `Gray
296
+
| (false, false, false) -> None
297
+
298
+
(* Filter builder - create JMAP filter from command line args *)
299
+
let build_filter account_id mailbox_id args =
300
+
let open Email_filter in
301
+
let filters = [] in
302
+
303
+
(* Add filter conditions based on command-line args *)
304
+
let filters = match args.query with
305
+
| "" -> filters
306
+
| query -> create_fulltext_filter query :: filters
307
+
in
308
+
309
+
let filters = match args.from with
310
+
| None -> filters
311
+
| Some sender -> from sender :: filters
312
+
in
313
+
314
+
let filters =
315
+
if args.days > 0 then
316
+
after (days_ago_date args.days) :: filters
317
+
else
318
+
filters
319
+
in
320
+
321
+
let filters = match mailbox_id with
322
+
| None -> filters
323
+
| Some id -> in_mailbox id :: filters
324
+
in
325
+
326
+
let filters = match args.has_flag with
327
+
| None -> filters
328
+
| Some flag ->
329
+
let kw = flag_to_keyword flag in
330
+
has_keyword kw :: filters
331
+
in
332
+
333
+
let filters = match args.missing_flag with
334
+
| None -> filters
335
+
| Some flag ->
336
+
let kw = flag_to_keyword flag in
337
+
not_has_keyword kw :: filters
338
+
in
339
+
340
+
(* Combine all filters with AND *)
341
+
match filters with
342
+
| [] -> Filter.condition (`Assoc []) (* Empty filter *)
343
+
| [f] -> f
344
+
| filters -> Filter.and_ filters
345
+
346
+
(* Display email flag information *)
347
+
let display_email_flags emails verbose =
348
+
Printf.printf "Emails and their flags:\n\n";
349
+
350
+
emails |> List.iteri (fun i email ->
351
+
let id = Option.value (Types.Email.id email) ~default:"(unknown)" in
352
+
let subject = Option.value (Types.Email.subject email) ~default:"(no subject)" in
353
+
354
+
let from_list = Option.value (Types.Email.from email) ~default:[] in
355
+
let from = match from_list with
356
+
| addr :: _ -> Types.Email_address.email addr
357
+
| [] -> "(unknown)"
358
+
in
359
+
360
+
let date = match Types.Email.received_at email with
361
+
| Some d -> String.sub (ISO8601.string_of_datetime (Unix.gmtime d)) 0 19
362
+
| None -> "(unknown)"
363
+
in
364
+
365
+
(* Get all keywords/flags *)
366
+
let keywords = match Types.Email.keywords email with
367
+
| Some kw -> kw
368
+
| None -> []
369
+
in
370
+
371
+
(* Format keywords for display *)
372
+
let flag_strs = keywords |> List.map (fun kw ->
373
+
match kw with
374
+
| Types.Keywords.Draft -> "$draft"
375
+
| Types.Keywords.Seen -> "$seen"
376
+
| Types.Keywords.Flagged -> "$flagged"
377
+
| Types.Keywords.Answered -> "$answered"
378
+
| Types.Keywords.Forwarded -> "$forwarded"
379
+
| Types.Keywords.Phishing -> "$phishing"
380
+
| Types.Keywords.Junk -> "$junk"
381
+
| Types.Keywords.NotJunk -> "$notjunk"
382
+
| Types.Keywords.Custom c -> c
383
+
| Types.Keywords.Notify -> "$notify"
384
+
| Types.Keywords.Muted -> "$muted"
385
+
| Types.Keywords.Followed -> "$followed"
386
+
| Types.Keywords.Memo -> "$memo"
387
+
| Types.Keywords.HasMemo -> "$hasmemo"
388
+
| Types.Keywords.Autosent -> "$autosent"
389
+
| Types.Keywords.Unsubscribed -> "$unsubscribed"
390
+
| Types.Keywords.CanUnsubscribe -> "$canunsubscribe"
391
+
| Types.Keywords.Imported -> "$imported"
392
+
| Types.Keywords.IsTrusted -> "$istrusted"
393
+
| Types.Keywords.MaskedEmail -> "$maskedemail"
394
+
| Types.Keywords.New -> "$new"
395
+
| Types.Keywords.MailFlagBit0 -> "$MailFlagBit0"
396
+
| Types.Keywords.MailFlagBit1 -> "$MailFlagBit1"
397
+
| Types.Keywords.MailFlagBit2 -> "$MailFlagBit2"
398
+
) in
399
+
400
+
Printf.printf "Email %d: %s\n" (i + 1) subject;
401
+
Printf.printf " ID: %s\n" id;
402
+
403
+
if verbose then begin
404
+
Printf.printf " From: %s\n" from;
405
+
Printf.printf " Date: %s\n" date;
406
+
end;
407
+
408
+
(* Show color if applicable *)
409
+
begin match flags_to_color keywords with
410
+
| Some color ->
411
+
let color_name = match color with
412
+
| `Red -> "Red"
413
+
| `Orange -> "Orange"
414
+
| `Yellow -> "Yellow"
415
+
| `Green -> "Green"
416
+
| `Blue -> "Blue"
417
+
| `Purple -> "Purple"
418
+
| `Gray -> "Gray"
419
+
in
420
+
Printf.printf " Color: %s\n" color_name
421
+
| None -> ()
422
+
end;
423
+
424
+
Printf.printf " Flags: %s\n\n"
425
+
(if flag_strs = [] then "(none)" else String.concat ", " flag_strs)
426
+
);
427
+
428
+
if List.length emails = 0 then
429
+
Printf.printf "No emails found matching criteria.\n"
430
+
431
+
(* Command implementation *)
432
+
let flag_command host user _password list add_flag remove_flag query from days
433
+
mailbox ids has_flag missing_flag limit dry_run color verbose : int =
434
+
(* Pack arguments into a record for easier passing *)
435
+
let _args : flag_manager_args = {
436
+
list; add_flag; remove_flag; query; from; days; mailbox;
437
+
ids; has_flag; missing_flag; limit; dry_run; color; verbose
438
+
} in
439
+
440
+
(* Main workflow would be implemented here using the JMAP library *)
441
+
Printf.printf "JMAP Flag Manager\n";
442
+
Printf.printf "Server: %s\n" host;
443
+
Printf.printf "User: %s\n\n" user;
444
+
445
+
if list then
446
+
Printf.printf "Listing emails with their flags...\n\n"
447
+
else begin
448
+
if add_flag <> None then
449
+
Printf.printf "Adding flag: %s\n" (Option.get add_flag);
450
+
451
+
if remove_flag <> None then
452
+
Printf.printf "Removing flag: %s\n" (Option.get remove_flag);
453
+
454
+
if color <> None then
455
+
let color_name = match Option.get color with
456
+
| `Red -> "Red"
457
+
| `Orange -> "Orange"
458
+
| `Yellow -> "Yellow"
459
+
| `Green -> "Green"
460
+
| `Blue -> "Blue"
461
+
| `Purple -> "Purple"
462
+
| `Gray -> "Gray"
463
+
| `None -> "None"
464
+
in
465
+
Printf.printf "Setting color: %s\n" color_name;
466
+
end;
467
+
468
+
if query <> "" then
469
+
Printf.printf "Filtering by query: %s\n" query;
470
+
471
+
if from <> None then
472
+
Printf.printf "Filtering by sender: %s\n" (Option.get from);
473
+
474
+
if mailbox <> None then
475
+
Printf.printf "Filtering by mailbox: %s\n" (Option.get mailbox);
476
+
477
+
if ids <> [] then
478
+
Printf.printf "Operating on specific email IDs: %s\n"
479
+
(String.concat ", " ids);
480
+
481
+
if has_flag <> None then
482
+
Printf.printf "Filtering to emails with flag: %s\n" (Option.get has_flag);
483
+
484
+
if missing_flag <> None then
485
+
Printf.printf "Filtering to emails without flag: %s\n" (Option.get missing_flag);
486
+
487
+
Printf.printf "Limiting to %d emails\n" limit;
488
+
489
+
if dry_run then
490
+
Printf.printf "DRY RUN MODE - No changes will be made\n";
491
+
492
+
Printf.printf "\n";
493
+
494
+
(* This is where the actual JMAP calls would happen, like:
495
+
496
+
let manage_flags () =
497
+
let* (ctx, session) = Jmap.Unix.connect
498
+
~host ~username:user ~password
499
+
~auth_method:(Jmap.Unix.Basic(user, password)) () in
500
+
501
+
(* Get primary account ID *)
502
+
let account_id = match Jmap.get_primary_account session Jmap_email.capability_mail with
503
+
| Ok id -> id
504
+
| Error _ -> failwith "No mail account found"
505
+
in
506
+
507
+
(* Resolve mailbox name to ID if specified *)
508
+
let* mailbox_id_opt = match args.mailbox with
509
+
| None -> Lwt.return None
510
+
| Some name ->
511
+
(* This would use Mailbox/query and Mailbox/get to resolve the name *)
512
+
...
513
+
in
514
+
515
+
(* Find emails to operate on *)
516
+
let* emails =
517
+
if args.ids <> [] then
518
+
(* Get emails by ID *)
519
+
let* result = Email.get ctx
520
+
~account_id
521
+
~ids:args.ids
522
+
~properties:["id"; "subject"; "from"; "receivedAt"; "keywords"] in
523
+
524
+
match result with
525
+
| Error err ->
526
+
Printf.eprintf "Error: %s\n" (Jmap.Error.error_to_string err);
527
+
Lwt.return []
528
+
| Ok (_, emails) -> Lwt.return emails
529
+
else
530
+
(* Find emails by query *)
531
+
let filter = build_filter account_id mailbox_id_opt args in
532
+
533
+
let* result = Email.query ctx
534
+
~account_id
535
+
~filter
536
+
~sort:[Email_sort.received_newest_first ()]
537
+
~limit:args.limit
538
+
~properties:["id"] in
539
+
540
+
match result with
541
+
| Error err ->
542
+
Printf.eprintf "Error: %s\n" (Jmap.Error.error_to_string err);
543
+
Lwt.return []
544
+
| Ok (ids, _) ->
545
+
(* Get full email objects for the matching IDs *)
546
+
let* result = Email.get ctx
547
+
~account_id
548
+
~ids
549
+
~properties:["id"; "subject"; "from"; "receivedAt"; "keywords"] in
550
+
551
+
match result with
552
+
| Error err ->
553
+
Printf.eprintf "Error: %s\n" (Jmap.Error.error_to_string err);
554
+
Lwt.return []
555
+
| Ok (_, emails) -> Lwt.return emails
556
+
in
557
+
558
+
(* Just list the emails with their flags *)
559
+
if args.list then
560
+
display_email_flags emails args.verbose;
561
+
Lwt.return_unit
562
+
else if List.length emails = 0 then
563
+
Printf.printf "No emails found matching criteria.\n";
564
+
Lwt.return_unit
565
+
else
566
+
(* Perform flag operations *)
567
+
let ids = emails |> List.filter_map Types.Email.id in
568
+
569
+
if args.dry_run then
570
+
display_email_flags emails args.verbose;
571
+
Lwt.return_unit
572
+
else
573
+
(* Create patch object *)
574
+
let make_patch () =
575
+
let add_keywords = ref [] in
576
+
let remove_keywords = ref [] in
577
+
578
+
(* Handle add flag *)
579
+
Option.iter (fun flag ->
580
+
let keyword = flag_to_keyword flag in
581
+
add_keywords := keyword :: !add_keywords
582
+
) args.add_flag;
583
+
584
+
(* Handle remove flag *)
585
+
Option.iter (fun flag ->
586
+
let keyword = flag_to_keyword flag in
587
+
remove_keywords := keyword :: !remove_keywords
588
+
) args.remove_flag;
589
+
590
+
(* Handle color *)
591
+
Option.iter (fun color ->
592
+
(* First remove all color bits *)
593
+
remove_keywords := Types.Keywords.MailFlagBit0 :: !remove_keywords;
594
+
remove_keywords := Types.Keywords.MailFlagBit1 :: !remove_keywords;
595
+
remove_keywords := Types.Keywords.MailFlagBit2 :: !remove_keywords;
596
+
597
+
(* Then add the right combination for the requested color *)
598
+
if color <> `None then begin
599
+
let color_flags = color_to_flags color in
600
+
add_keywords := color_flags @ !add_keywords
601
+
end
602
+
) args.color;
603
+
604
+
Email.make_patch
605
+
~add_keywords:!add_keywords
606
+
~remove_keywords:!remove_keywords
607
+
()
608
+
in
609
+
610
+
let patch = make_patch () in
611
+
612
+
let* result = Email.update ctx
613
+
~account_id
614
+
~ids
615
+
~update_each:(fun _ -> patch) in
616
+
617
+
match result with
618
+
| Error err ->
619
+
Printf.eprintf "Error: %s\n" (Jmap.Error.error_to_string err);
620
+
Lwt.return_unit
621
+
| Ok updated ->
622
+
Printf.printf "Successfully updated %d emails.\n" (List.length updated);
623
+
Lwt.return_unit
624
+
*)
625
+
626
+
if list then begin
627
+
(* Simulate having found a few emails *)
628
+
let count = 3 in
629
+
Printf.printf "Found %d matching emails:\n\n" count;
630
+
Printf.printf "Email 1: Meeting Agenda\n";
631
+
Printf.printf " ID: email123\n";
632
+
if verbose then begin
633
+
Printf.printf " From: alice@example.com\n";
634
+
Printf.printf " Date: 2023-04-15 09:30:00\n";
635
+
end;
636
+
Printf.printf " Flags: $seen, $flagged, $answered\n\n";
637
+
638
+
Printf.printf "Email 2: Project Update\n";
639
+
Printf.printf " ID: email124\n";
640
+
if verbose then begin
641
+
Printf.printf " From: bob@example.com\n";
642
+
Printf.printf " Date: 2023-04-16 14:45:00\n";
643
+
end;
644
+
Printf.printf " Color: Red\n";
645
+
Printf.printf " Flags: $seen, $MailFlagBit0\n\n";
646
+
647
+
Printf.printf "Email 3: Weekly Newsletter\n";
648
+
Printf.printf " ID: email125\n";
649
+
if verbose then begin
650
+
Printf.printf " From: newsletter@example.com\n";
651
+
Printf.printf " Date: 2023-04-17 08:15:00\n";
652
+
end;
653
+
Printf.printf " Flags: $seen, $notjunk\n\n";
654
+
end else if add_flag <> None || remove_flag <> None || color <> None then begin
655
+
Printf.printf "Would modify %d emails:\n" 2;
656
+
if dry_run then
657
+
Printf.printf "(Dry run mode - no changes made)\n\n"
658
+
else
659
+
Printf.printf "Changes applied successfully\n\n";
660
+
end;
661
+
662
+
(* List standard flags if no other actions specified *)
663
+
if not list && add_flag = None && remove_flag = None && color = None then begin
664
+
Printf.printf "Standard flags:\n";
665
+
get_standard_flags() |> List.iter (fun (flag, desc) ->
666
+
Printf.printf " $%-12s %s\n" flag desc
667
+
);
668
+
669
+
Printf.printf "\nColor flags:\n";
670
+
Printf.printf " $MailFlagBit0 Red\n";
671
+
Printf.printf " $MailFlagBit1 Orange\n";
672
+
Printf.printf " $MailFlagBit2 Yellow\n";
673
+
Printf.printf " $MailFlagBit0+1 Green\n";
674
+
Printf.printf " $MailFlagBit0+2 Blue\n";
675
+
Printf.printf " $MailFlagBit1+2 Purple\n";
676
+
Printf.printf " $MailFlagBit0+1+2 Gray\n";
677
+
end;
678
+
679
+
(* Since we're only type checking, we'll exit with success *)
680
+
0
681
+
682
+
(* Command definition *)
683
+
let flag_cmd =
684
+
let doc = "manage email flags using JMAP" in
685
+
let man = [
686
+
`S Manpage.s_description;
687
+
`P "Lists, adds, and removes flags (keywords) from emails using JMAP.";
688
+
`P "Demonstrates JMAP's flag/keyword management capabilities.";
689
+
`S Manpage.s_examples;
690
+
`P " $(mname) -h jmap.example.com -u user@example.com -p secret123 --list";
691
+
`P " $(mname) -h jmap.example.com -u user@example.com -p secret123 --add flagged --from boss@example.com";
692
+
`P " $(mname) -h jmap.example.com -u user@example.com -p secret123 --color red --mailbox Inbox --has-flag seen --missing-flag flagged";
693
+
] in
694
+
695
+
let cmd =
696
+
Cmd.v
697
+
(Cmd.info "jmap-flag-manager" ~version:"1.0" ~doc ~man)
698
+
Term.(const flag_command $ host_arg $ user_arg $ password_arg $
699
+
list_arg $ add_flag_arg $ remove_flag_arg $ query_arg $
700
+
from_arg $ days_arg $ mailbox_arg $ ids_arg $ has_flag_arg $
701
+
missing_flag_arg $ limit_arg $ dry_run_arg $ color_arg $ verbose_arg)
702
+
in
703
+
cmd
704
+
705
+
(* Main entry point *)
706
+
let () = exit (Cmd.eval' flag_cmd)
+620
bin/jmap_identity_monitor.ml
+620
bin/jmap_identity_monitor.ml
···
1
+
(*
2
+
* jmap_identity_monitor.ml - A tool for monitoring email delivery status
3
+
*
4
+
* This binary demonstrates JMAP's identity and submission tracking capabilities,
5
+
* allowing users to monitor email delivery status and manage email identities.
6
+
*)
7
+
8
+
open Cmdliner
9
+
(* Using standard OCaml, no Lwt *)
10
+
11
+
(* JMAP imports *)
12
+
open Jmap
13
+
open Jmap.Types
14
+
open Jmap.Wire
15
+
open Jmap.Methods
16
+
open Jmap_email
17
+
(* For step 2, we're only testing type checking. No implementations required. *)
18
+
19
+
(* Dummy Unix module for type checking *)
20
+
module Unix = struct
21
+
type tm = {
22
+
tm_sec : int;
23
+
tm_min : int;
24
+
tm_hour : int;
25
+
tm_mday : int;
26
+
tm_mon : int;
27
+
tm_year : int;
28
+
tm_wday : int;
29
+
tm_yday : int;
30
+
tm_isdst : bool
31
+
}
32
+
33
+
let time () = 0.0
34
+
let gettimeofday () = 0.0
35
+
let mktime tm = (0.0, tm)
36
+
let gmtime _time = {
37
+
tm_sec = 0; tm_min = 0; tm_hour = 0;
38
+
tm_mday = 1; tm_mon = 0; tm_year = 120;
39
+
tm_wday = 0; tm_yday = 0; tm_isdst = false;
40
+
}
41
+
42
+
(* JMAP connection function - would be in a real implementation *)
43
+
let connect ~host ~username ~password ?auth_method () =
44
+
failwith "Not implemented"
45
+
end
46
+
47
+
(* Dummy ISO8601 module *)
48
+
module ISO8601 = struct
49
+
let string_of_datetime _tm = "2023-01-01T00:00:00Z"
50
+
end
51
+
52
+
(** Email submission and delivery status types *)
53
+
type email_envelope_address = {
54
+
env_addr_email : string;
55
+
env_addr_parameters : (string * string) list;
56
+
}
57
+
58
+
type email_envelope = {
59
+
env_mail_from : email_envelope_address;
60
+
env_rcpt_to : email_envelope_address list;
61
+
}
62
+
63
+
type email_delivery_status = {
64
+
delivery_smtp_reply : string;
65
+
delivery_delivered : [`Queued | `Yes | `No | `Unknown];
66
+
delivery_displayed : [`Yes | `Unknown];
67
+
}
68
+
69
+
type email_submission = {
70
+
email_sub_id : string;
71
+
email_id : string;
72
+
thread_id : string;
73
+
identity_id : string;
74
+
send_at : float;
75
+
undo_status : [`Pending | `Final | `Canceled];
76
+
envelope : email_envelope option;
77
+
delivery_status : (string, email_delivery_status) Hashtbl.t option;
78
+
dsn_blob_ids : string list;
79
+
mdn_blob_ids : string list;
80
+
}
81
+
82
+
(** Dummy Email_address module to replace Jmap_email_types.Email_address *)
83
+
module Email_address = struct
84
+
type t = string
85
+
let email addr = "user@example.com"
86
+
end
87
+
88
+
(** Dummy Identity module *)
89
+
module Identity = struct
90
+
type t = {
91
+
id : string;
92
+
name : string;
93
+
email : string;
94
+
reply_to : Email_address.t list option;
95
+
bcc : Email_address.t list option;
96
+
text_signature : string;
97
+
html_signature : string;
98
+
may_delete : bool;
99
+
}
100
+
101
+
let id identity = identity.id
102
+
let name identity = identity.name
103
+
let email identity = identity.email
104
+
let reply_to identity = identity.reply_to
105
+
let bcc identity = identity.bcc
106
+
let text_signature identity = identity.text_signature
107
+
let html_signature identity = identity.html_signature
108
+
let may_delete identity = identity.may_delete
109
+
end
110
+
111
+
(** Identity monitor args type *)
112
+
type identity_monitor_args = {
113
+
list_identities : bool;
114
+
show_identity : string option;
115
+
create_identity : string option;
116
+
identity_name : string option;
117
+
reply_to : string option;
118
+
signature : string option;
119
+
html_signature : string option;
120
+
list_submissions : bool;
121
+
show_submission : string option;
122
+
track_submission : string option;
123
+
pending_only : bool;
124
+
query : string option;
125
+
days : int;
126
+
limit : int;
127
+
cancel_submission : string option;
128
+
format : [`Summary | `Detailed | `Json | `StatusOnly];
129
+
}
130
+
131
+
(** Command-line arguments **)
132
+
133
+
let host_arg =
134
+
Arg.(required & opt (some string) None & info ["h"; "host"]
135
+
~docv:"HOST" ~doc:"JMAP server hostname")
136
+
137
+
let user_arg =
138
+
Arg.(required & opt (some string) None & info ["u"; "user"]
139
+
~docv:"USERNAME" ~doc:"Username for authentication")
140
+
141
+
let password_arg =
142
+
Arg.(required & opt (some string) None & info ["p"; "password"]
143
+
~docv:"PASSWORD" ~doc:"Password for authentication")
144
+
145
+
(* Commands *)
146
+
147
+
(* Identity-related commands *)
148
+
let list_identities_arg =
149
+
Arg.(value & flag & info ["list-identities"] ~doc:"List all email identities")
150
+
151
+
let show_identity_arg =
152
+
Arg.(value & opt (some string) None & info ["show-identity"]
153
+
~docv:"ID" ~doc:"Show details for a specific identity")
154
+
155
+
let create_identity_arg =
156
+
Arg.(value & opt (some string) None & info ["create-identity"]
157
+
~docv:"EMAIL" ~doc:"Create a new identity with the specified email address")
158
+
159
+
let identity_name_arg =
160
+
Arg.(value & opt (some string) None & info ["name"]
161
+
~docv:"NAME" ~doc:"Display name for the identity (when creating)")
162
+
163
+
let reply_to_arg =
164
+
Arg.(value & opt (some string) None & info ["reply-to"]
165
+
~docv:"EMAIL" ~doc:"Reply-to address for the identity (when creating)")
166
+
167
+
let signature_arg =
168
+
Arg.(value & opt (some string) None & info ["signature"]
169
+
~docv:"SIGNATURE" ~doc:"Text signature for the identity (when creating)")
170
+
171
+
let html_signature_arg =
172
+
Arg.(value & opt (some string) None & info ["html-signature"]
173
+
~docv:"HTML" ~doc:"HTML signature for the identity (when creating)")
174
+
175
+
(* Submission-related commands *)
176
+
let list_submissions_arg =
177
+
Arg.(value & flag & info ["list-submissions"] ~doc:"List recent email submissions")
178
+
179
+
let show_submission_arg =
180
+
Arg.(value & opt (some string) None & info ["show-submission"]
181
+
~docv:"ID" ~doc:"Show details for a specific submission")
182
+
183
+
let track_submission_arg =
184
+
Arg.(value & opt (some string) None & info ["track"]
185
+
~docv:"ID" ~doc:"Track delivery status for a specific submission")
186
+
187
+
let pending_only_arg =
188
+
Arg.(value & flag & info ["pending-only"] ~doc:"Show only pending submissions")
189
+
190
+
let query_arg =
191
+
Arg.(value & opt (some string) None & info ["query"]
192
+
~docv:"QUERY" ~doc:"Search for submissions containing text in associated email")
193
+
194
+
let days_arg =
195
+
Arg.(value & opt int 7 & info ["days"]
196
+
~docv:"DAYS" ~doc:"Limit to submissions from the past N days")
197
+
198
+
let limit_arg =
199
+
Arg.(value & opt int 20 & info ["limit"]
200
+
~docv:"N" ~doc:"Maximum number of results to display")
201
+
202
+
let cancel_submission_arg =
203
+
Arg.(value & opt (some string) None & info ["cancel"]
204
+
~docv:"ID" ~doc:"Cancel a pending email submission")
205
+
206
+
let format_arg =
207
+
Arg.(value & opt (enum [
208
+
"summary", `Summary;
209
+
"detailed", `Detailed;
210
+
"json", `Json;
211
+
"status-only", `StatusOnly;
212
+
]) `Summary & info ["format"] ~docv:"FORMAT" ~doc:"Output format")
213
+
214
+
(** Main functionality **)
215
+
216
+
(* Format an identity for display *)
217
+
let format_identity identity format =
218
+
match format with
219
+
| `Summary ->
220
+
let id = Identity.id identity in
221
+
let name = Identity.name identity in
222
+
let email = Identity.email identity in
223
+
Printf.printf "%s: %s <%s>\n" id name email
224
+
225
+
| `Detailed ->
226
+
let id = Identity.id identity in
227
+
let name = Identity.name identity in
228
+
let email = Identity.email identity in
229
+
230
+
let reply_to = match Identity.reply_to identity with
231
+
| Some addresses -> addresses
232
+
|> List.map (fun addr -> Email_address.email addr)
233
+
|> String.concat ", "
234
+
| None -> "(none)"
235
+
in
236
+
237
+
let bcc = match Identity.bcc identity with
238
+
| Some addresses -> addresses
239
+
|> List.map (fun addr -> Email_address.email addr)
240
+
|> String.concat ", "
241
+
| None -> "(none)"
242
+
in
243
+
244
+
let may_delete = if Identity.may_delete identity then "Yes" else "No" in
245
+
246
+
Printf.printf "Identity: %s\n" id;
247
+
Printf.printf " Name: %s\n" name;
248
+
Printf.printf " Email: %s\n" email;
249
+
Printf.printf " Reply-To: %s\n" reply_to;
250
+
Printf.printf " BCC: %s\n" bcc;
251
+
252
+
if Identity.text_signature identity <> "" then
253
+
Printf.printf " Signature: %s\n" (Identity.text_signature identity);
254
+
255
+
if Identity.html_signature identity <> "" then
256
+
Printf.printf " HTML Sig: (HTML signature available)\n";
257
+
258
+
Printf.printf " Deletable: %s\n" may_delete
259
+
260
+
| `Json ->
261
+
let id = Identity.id identity in
262
+
let name = Identity.name identity in
263
+
let email = Identity.email identity in
264
+
Printf.printf "{\n";
265
+
Printf.printf " \"id\": \"%s\",\n" id;
266
+
Printf.printf " \"name\": \"%s\",\n" name;
267
+
Printf.printf " \"email\": \"%s\"\n" email;
268
+
Printf.printf "}\n"
269
+
270
+
| _ -> () (* Other formats don't apply to identities *)
271
+
272
+
(* Format delivery status *)
273
+
let format_delivery_status rcpt status =
274
+
let status_str = match status.delivery_delivered with
275
+
| `Queued -> "Queued"
276
+
| `Yes -> "Delivered"
277
+
| `No -> "Failed"
278
+
| `Unknown -> "Unknown"
279
+
in
280
+
281
+
let display_str = match status.delivery_displayed with
282
+
| `Yes -> "Displayed"
283
+
| `Unknown -> "Unknown if displayed"
284
+
in
285
+
286
+
Printf.printf " %s: %s, %s\n" rcpt status_str display_str;
287
+
Printf.printf " SMTP Reply: %s\n" status.delivery_smtp_reply
288
+
289
+
(* Format a submission for display *)
290
+
let format_submission submission format =
291
+
match format with
292
+
| `Summary ->
293
+
let id = submission.email_sub_id in
294
+
let email_id = submission.email_id in
295
+
let send_at = String.sub (ISO8601.string_of_datetime (Unix.gmtime submission.send_at)) 0 19 in
296
+
297
+
let status = match submission.undo_status with
298
+
| `Pending -> "Pending"
299
+
| `Final -> "Final"
300
+
| `Canceled -> "Canceled"
301
+
in
302
+
303
+
let delivery_count = match submission.delivery_status with
304
+
| Some statuses -> Hashtbl.length statuses
305
+
| None -> 0
306
+
in
307
+
308
+
Printf.printf "%s: [%s] Sent at %s (Email ID: %s, Recipients: %d)\n"
309
+
id status send_at email_id delivery_count
310
+
311
+
| `Detailed ->
312
+
let id = submission.email_sub_id in
313
+
let email_id = submission.email_id in
314
+
let thread_id = submission.thread_id in
315
+
let identity_id = submission.identity_id in
316
+
let send_at = String.sub (ISO8601.string_of_datetime (Unix.gmtime submission.send_at)) 0 19 in
317
+
318
+
let status = match submission.undo_status with
319
+
| `Pending -> "Pending"
320
+
| `Final -> "Final"
321
+
| `Canceled -> "Canceled"
322
+
in
323
+
324
+
Printf.printf "Submission: %s\n" id;
325
+
Printf.printf " Status: %s\n" status;
326
+
Printf.printf " Sent at: %s\n" send_at;
327
+
Printf.printf " Email ID: %s\n" email_id;
328
+
Printf.printf " Thread ID: %s\n" thread_id;
329
+
Printf.printf " Identity: %s\n" identity_id;
330
+
331
+
(* Display envelope information if available *)
332
+
(match submission.envelope with
333
+
| Some env ->
334
+
Printf.printf " Envelope:\n";
335
+
Printf.printf " From: %s\n" env.env_mail_from.env_addr_email;
336
+
Printf.printf " To: %s\n"
337
+
(env.env_rcpt_to |> List.map (fun addr -> addr.env_addr_email) |> String.concat ", ")
338
+
| None -> ());
339
+
340
+
(* Display delivery status *)
341
+
(match submission.delivery_status with
342
+
| Some statuses ->
343
+
Printf.printf " Delivery Status:\n";
344
+
statuses |> Hashtbl.iter format_delivery_status
345
+
| None -> Printf.printf " Delivery Status: Not available\n");
346
+
347
+
(* DSN and MDN information *)
348
+
if submission.dsn_blob_ids <> [] then
349
+
Printf.printf " DSN Blobs: %d available\n" (List.length submission.dsn_blob_ids);
350
+
351
+
if submission.mdn_blob_ids <> [] then
352
+
Printf.printf " MDN Blobs: %d available\n" (List.length submission.mdn_blob_ids)
353
+
354
+
| `Json ->
355
+
let id = submission.email_sub_id in
356
+
let email_id = submission.email_id in
357
+
let send_at_str = String.sub (ISO8601.string_of_datetime (Unix.gmtime submission.send_at)) 0 19 in
358
+
359
+
let status_str = match submission.undo_status with
360
+
| `Pending -> "pending"
361
+
| `Final -> "final"
362
+
| `Canceled -> "canceled"
363
+
in
364
+
365
+
Printf.printf "{\n";
366
+
Printf.printf " \"id\": \"%s\",\n" id;
367
+
Printf.printf " \"emailId\": \"%s\",\n" email_id;
368
+
Printf.printf " \"sendAt\": \"%s\",\n" send_at_str;
369
+
Printf.printf " \"undoStatus\": \"%s\"\n" status_str;
370
+
Printf.printf "}\n"
371
+
372
+
| `StatusOnly ->
373
+
let id = submission.email_sub_id in
374
+
375
+
let status = match submission.undo_status with
376
+
| `Pending -> "Pending"
377
+
| `Final -> "Final"
378
+
| `Canceled -> "Canceled"
379
+
in
380
+
381
+
Printf.printf "Submission %s: %s\n" id status;
382
+
383
+
(* Display delivery status summary *)
384
+
match submission.delivery_status with
385
+
| Some statuses ->
386
+
let total = Hashtbl.length statuses in
387
+
let delivered = Hashtbl.fold (fun _ status count ->
388
+
if status.delivery_delivered = `Yes then count + 1 else count
389
+
) statuses 0 in
390
+
391
+
let failed = Hashtbl.fold (fun _ status count ->
392
+
if status.delivery_delivered = `No then count + 1 else count
393
+
) statuses 0 in
394
+
395
+
let queued = Hashtbl.fold (fun _ status count ->
396
+
if status.delivery_delivered = `Queued then count + 1 else count
397
+
) statuses 0 in
398
+
399
+
Printf.printf " Total recipients: %d\n" total;
400
+
Printf.printf " Delivered: %d\n" delivered;
401
+
Printf.printf " Failed: %d\n" failed;
402
+
Printf.printf " Queued: %d\n" queued
403
+
| None ->
404
+
Printf.printf " Delivery status not available\n"
405
+
406
+
(* Create an identity with provided details *)
407
+
let create_identity_command email name reply_to signature html_signature =
408
+
(* In a real implementation, this would validate inputs and create the identity *)
409
+
Printf.printf "Creating identity for email: %s\n" email;
410
+
411
+
if name <> None then
412
+
Printf.printf "Name: %s\n" (Option.get name);
413
+
414
+
if reply_to <> None then
415
+
Printf.printf "Reply-To: %s\n" (Option.get reply_to);
416
+
417
+
if signature <> None || html_signature <> None then
418
+
Printf.printf "Signature: Provided\n";
419
+
420
+
Printf.printf "\nIdentity creation would be implemented here using JMAP.Identity.create\n";
421
+
()
422
+
423
+
(* Command implementation for identity monitoring *)
424
+
let identity_command host user password list_identities show_identity
425
+
create_identity identity_name reply_to signature
426
+
html_signature list_submissions show_submission track_submission
427
+
pending_only query days limit cancel_submission format : int =
428
+
(* Pack arguments into a record for easier passing *)
429
+
let args : identity_monitor_args = {
430
+
list_identities; show_identity; create_identity; identity_name;
431
+
reply_to; signature; html_signature; list_submissions;
432
+
show_submission; track_submission; pending_only; query;
433
+
days; limit; cancel_submission; format
434
+
} in
435
+
436
+
(* Main workflow would be implemented here using the JMAP library *)
437
+
Printf.printf "JMAP Identity & Submission Monitor\n";
438
+
Printf.printf "Server: %s\n" host;
439
+
Printf.printf "User: %s\n\n" user;
440
+
441
+
(* This is where the actual JMAP calls would happen, like:
442
+
443
+
let monitor_identities_and_submissions () =
444
+
let* (ctx, session) = Jmap.Unix.connect
445
+
~host ~username:user ~password
446
+
~auth_method:(Jmap.Unix.Basic(user, password)) () in
447
+
448
+
(* Get primary account ID *)
449
+
let account_id = match Jmap.get_primary_account session Jmap_email.capability_mail with
450
+
| Ok id -> id
451
+
| Error _ -> failwith "No mail account found"
452
+
in
453
+
454
+
(* Handle various command options *)
455
+
if args.list_identities then
456
+
(* Get all identities *)
457
+
let* identity_result = Jmap_email.Identity.get ctx
458
+
~account_id
459
+
~ids:None in
460
+
461
+
match identity_result with
462
+
| Error err -> Printf.eprintf "Error: %s\n" (Jmap.Error.error_to_string err); Lwt.return 1
463
+
| Ok (_, identities) ->
464
+
Printf.printf "Found %d identities:\n\n" (List.length identities);
465
+
identities |> List.iter (fun identity ->
466
+
format_identity identity args.format
467
+
);
468
+
Lwt.return 0
469
+
470
+
else if args.show_identity <> None then
471
+
(* Get specific identity *)
472
+
let id = Option.get args.show_identity in
473
+
let* identity_result = Jmap_email.Identity.get ctx
474
+
~account_id
475
+
~ids:[id] in
476
+
477
+
match identity_result with
478
+
| Error err -> Printf.eprintf "Error: %s\n" (Jmap.Error.error_to_string err); Lwt.return 1
479
+
| Ok (_, identities) ->
480
+
match identities with
481
+
| [identity] ->
482
+
format_identity identity args.format;
483
+
Lwt.return 0
484
+
| _ ->
485
+
Printf.eprintf "Identity not found: %s\n" id;
486
+
Lwt.return 1
487
+
488
+
else if args.create_identity <> None then
489
+
(* Create a new identity *)
490
+
let email = Option.get args.create_identity in
491
+
create_identity_command email args.identity_name args.reply_to
492
+
args.signature args.html_signature
493
+
494
+
else if args.list_submissions then
495
+
(* List all submissions, with optional filtering *)
496
+
...
497
+
498
+
else if args.show_submission <> None then
499
+
(* Show specific submission details *)
500
+
...
501
+
502
+
else if args.track_submission <> None then
503
+
(* Track delivery status for a specific submission *)
504
+
...
505
+
506
+
else if args.cancel_submission <> None then
507
+
(* Cancel a pending submission *)
508
+
...
509
+
510
+
else
511
+
(* No specific command given, show help *)
512
+
Printf.printf "Please specify a command. Use --help for options.\n";
513
+
Lwt.return 1
514
+
*)
515
+
516
+
(if list_identities then begin
517
+
(* Simulate listing identities *)
518
+
Printf.printf "Found 3 identities:\n\n";
519
+
Printf.printf "id1: John Doe <john@example.com>\n";
520
+
Printf.printf "id2: John Work <john@work.example.com>\n";
521
+
Printf.printf "id3: Support <support@example.com>\n"
522
+
end
523
+
else if show_identity <> None then begin
524
+
(* Simulate showing a specific identity *)
525
+
Printf.printf "Identity: %s\n" (Option.get show_identity);
526
+
Printf.printf " Name: John Doe\n";
527
+
Printf.printf " Email: john@example.com\n";
528
+
Printf.printf " Reply-To: (none)\n";
529
+
Printf.printf " BCC: (none)\n";
530
+
Printf.printf " Signature: Best regards,\nJohn\n";
531
+
Printf.printf " Deletable: Yes\n"
532
+
end
533
+
534
+
else if create_identity <> None then begin
535
+
(* Create a new identity *)
536
+
create_identity_command (Option.get create_identity) identity_name reply_to
537
+
signature html_signature |> ignore
538
+
end
539
+
else if list_submissions then begin
540
+
(* Simulate listing submissions *)
541
+
Printf.printf "Recent submissions (last %d days):\n\n" days;
542
+
Printf.printf "sub1: [Final] Sent at 2023-01-15 10:30:45 (Email ID: email1, Recipients: 3)\n";
543
+
Printf.printf "sub2: [Final] Sent at 2023-01-14 08:15:22 (Email ID: email2, Recipients: 1)\n";
544
+
Printf.printf "sub3: [Pending] Sent at 2023-01-13 16:45:10 (Email ID: email3, Recipients: 5)\n"
545
+
end
546
+
else if show_submission <> None then begin
547
+
(* Simulate showing a specific submission *)
548
+
Printf.printf "Submission: %s\n" (Option.get show_submission);
549
+
Printf.printf " Status: Final\n";
550
+
Printf.printf " Sent at: 2023-01-15 10:30:45\n";
551
+
Printf.printf " Email ID: email1\n";
552
+
Printf.printf " Thread ID: thread1\n";
553
+
Printf.printf " Identity: id1\n";
554
+
Printf.printf " Envelope:\n";
555
+
Printf.printf " From: john@example.com\n";
556
+
Printf.printf " To: alice@example.com, bob@example.com, carol@example.com\n";
557
+
Printf.printf " Delivery Status:\n";
558
+
Printf.printf " alice@example.com: Delivered, Displayed\n";
559
+
Printf.printf " SMTP Reply: 250 OK\n";
560
+
Printf.printf " bob@example.com: Delivered, Unknown if displayed\n";
561
+
Printf.printf " SMTP Reply: 250 OK\n";
562
+
Printf.printf " carol@example.com: Failed\n";
563
+
Printf.printf " SMTP Reply: 550 Mailbox unavailable\n"
564
+
end
565
+
else if track_submission <> None then begin
566
+
(* Simulate tracking a submission *)
567
+
Printf.printf "Tracking delivery status for submission: %s\n\n" (Option.get track_submission);
568
+
Printf.printf "Submission %s: Final\n" (Option.get track_submission);
569
+
Printf.printf " Total recipients: 3\n";
570
+
Printf.printf " Delivered: 2\n";
571
+
Printf.printf " Failed: 1\n";
572
+
Printf.printf " Queued: 0\n"
573
+
end
574
+
else if cancel_submission <> None then begin
575
+
(* Simulate canceling a submission *)
576
+
Printf.printf "Canceling submission: %s\n" (Option.get cancel_submission);
577
+
Printf.printf "Submission has been canceled successfully.\n"
578
+
end
579
+
else
580
+
(* No specific command given, show help *)
581
+
begin
582
+
Printf.printf "Please specify a command. Use --help for options.\n";
583
+
Printf.printf "Example commands:\n";
584
+
Printf.printf " --list-identities List all email identities\n";
585
+
Printf.printf " --show-identity id1 Show details for identity 'id1'\n";
586
+
Printf.printf " --list-submissions List recent email submissions\n";
587
+
Printf.printf " --track sub1 Track delivery status for submission 'sub1'\n"
588
+
end);
589
+
590
+
(* Since we're only type checking, we'll exit with success *)
591
+
0
592
+
593
+
(* Command definition *)
594
+
let identity_cmd =
595
+
let doc = "monitor email identities and submissions using JMAP" in
596
+
let man = [
597
+
`S Manpage.s_description;
598
+
`P "Provides identity management and email submission tracking functionality.";
599
+
`P "Demonstrates JMAP's identity and email submission monitoring capabilities.";
600
+
`S Manpage.s_examples;
601
+
`P " $(mname) -h jmap.example.com -u user@example.com -p secret123 --list-identities";
602
+
`P " $(mname) -h jmap.example.com -u user@example.com -p secret123 --create-identity backup@example.com --name \"Backup Account\"";
603
+
`P " $(mname) -h jmap.example.com -u user@example.com -p secret123 --list-submissions --days 3";
604
+
`P " $(mname) -h jmap.example.com -u user@example.com -p secret123 --track sub12345 --format status-only";
605
+
] in
606
+
607
+
let cmd =
608
+
Cmd.v
609
+
(Cmd.info "jmap-identity-monitor" ~version:"1.0" ~doc ~man)
610
+
Term.(const identity_command $ host_arg $ user_arg $ password_arg $
611
+
list_identities_arg $ show_identity_arg $ create_identity_arg $
612
+
identity_name_arg $ reply_to_arg $ signature_arg $ html_signature_arg $
613
+
list_submissions_arg $ show_submission_arg $ track_submission_arg $
614
+
pending_only_arg $ query_arg $ days_arg $ limit_arg $
615
+
cancel_submission_arg $ format_arg)
616
+
in
617
+
cmd
618
+
619
+
(* Main entry point *)
620
+
let () = exit (Cmd.eval' identity_cmd)
+420
bin/jmap_mailbox_explorer.ml
+420
bin/jmap_mailbox_explorer.ml
···
1
+
(*
2
+
* jmap_mailbox_explorer.ml - A tool for exploring email mailboxes using JMAP
3
+
*
4
+
* This binary demonstrates JMAP's mailbox query and manipulation capabilities,
5
+
* allowing for exploring, creating, and analyzing mailboxes.
6
+
*)
7
+
8
+
open Cmdliner
9
+
(* Using standard OCaml, no Lwt *)
10
+
11
+
(* JMAP imports *)
12
+
open Jmap
13
+
open Jmap.Types
14
+
open Jmap.Wire
15
+
open Jmap.Methods
16
+
open Jmap_email
17
+
(* For step 2, we're only testing type checking. No implementations required. *)
18
+
19
+
(* JMAP mailbox handling *)
20
+
module Jmap_mailbox = struct
21
+
(* Dummy mailbox functions *)
22
+
let id mailbox = "mailbox-id"
23
+
let name mailbox = "mailbox-name"
24
+
let parent_id mailbox = None
25
+
let role mailbox = None
26
+
let total_emails mailbox = 0
27
+
let unread_emails mailbox = 0
28
+
end
29
+
30
+
(* Unix implementation would be used here *)
31
+
module Unix = struct
32
+
let connect ~host ~username ~password ?auth_method () =
33
+
failwith "Not implemented"
34
+
end
35
+
36
+
(** Types for mailbox explorer *)
37
+
type mailbox_stats = {
38
+
time_periods : (string * int) list;
39
+
senders : (string * int) list;
40
+
subjects : (string * int) list;
41
+
}
42
+
43
+
type mailbox_explorer_args = {
44
+
list : bool;
45
+
stats : bool;
46
+
mailbox : string option;
47
+
create : string option;
48
+
parent : string option;
49
+
query_mailbox : string option;
50
+
days : int;
51
+
format : [`Tree | `Flat | `Json];
52
+
}
53
+
54
+
(** Command-line arguments **)
55
+
56
+
let host_arg =
57
+
Arg.(required & opt (some string) None & info ["h"; "host"]
58
+
~docv:"HOST" ~doc:"JMAP server hostname")
59
+
60
+
let user_arg =
61
+
Arg.(required & opt (some string) None & info ["u"; "user"]
62
+
~docv:"USERNAME" ~doc:"Username for authentication")
63
+
64
+
let password_arg =
65
+
Arg.(required & opt (some string) None & info ["p"; "password"]
66
+
~docv:"PASSWORD" ~doc:"Password for authentication")
67
+
68
+
let list_arg =
69
+
Arg.(value & flag & info ["l"; "list"] ~doc:"List all mailboxes")
70
+
71
+
let stats_arg =
72
+
Arg.(value & flag & info ["s"; "stats"] ~doc:"Show mailbox statistics")
73
+
74
+
let mailbox_arg =
75
+
Arg.(value & opt (some string) None & info ["m"; "mailbox"]
76
+
~docv:"MAILBOX" ~doc:"Filter by mailbox name")
77
+
78
+
let create_arg =
79
+
Arg.(value & opt (some string) None & info ["create"]
80
+
~docv:"NAME" ~doc:"Create a new mailbox")
81
+
82
+
let parent_arg =
83
+
Arg.(value & opt (some string) None & info ["parent"]
84
+
~docv:"PARENT" ~doc:"Parent mailbox for creation")
85
+
86
+
let query_mailbox_arg =
87
+
Arg.(value & opt (some string) None & info ["query"]
88
+
~docv:"QUERY" ~doc:"Query emails in the specified mailbox")
89
+
90
+
let days_arg =
91
+
Arg.(value & opt int 7 & info ["days"]
92
+
~docv:"DAYS" ~doc:"Days to analyze for mailbox statistics")
93
+
94
+
let format_arg =
95
+
Arg.(value & opt (enum [
96
+
"tree", `Tree;
97
+
"flat", `Flat;
98
+
"json", `Json;
99
+
]) `Tree & info ["format"] ~docv:"FORMAT" ~doc:"Output format")
100
+
101
+
(** Mailbox Explorer Functionality **)
102
+
103
+
(* Get standard role name for display *)
104
+
let role_name = function
105
+
| `Inbox -> "Inbox"
106
+
| `Archive -> "Archive"
107
+
| `Drafts -> "Drafts"
108
+
| `Sent -> "Sent"
109
+
| `Trash -> "Trash"
110
+
| `Junk -> "Junk"
111
+
| `Important -> "Important"
112
+
| `Flagged -> "Flagged"
113
+
| `Snoozed -> "Snoozed"
114
+
| `Scheduled -> "Scheduled"
115
+
| `Memos -> "Memos"
116
+
| `Other name -> name
117
+
| `None -> "(No role)"
118
+
119
+
(* Display mailboxes in tree format *)
120
+
let display_mailbox_tree mailboxes format stats =
121
+
(* Helper to find children of a parent *)
122
+
let find_children parent_id =
123
+
mailboxes |> List.filter (fun mailbox ->
124
+
match Jmap_mailbox.parent_id mailbox with
125
+
| Some id when id = parent_id -> true
126
+
| _ -> false
127
+
)
128
+
in
129
+
130
+
(* Helper to find mailboxes without a parent (root level) *)
131
+
let find_roots () =
132
+
mailboxes |> List.filter (fun mailbox ->
133
+
Jmap_mailbox.parent_id mailbox = None
134
+
)
135
+
in
136
+
137
+
(* Get mailbox name with role *)
138
+
let mailbox_name_with_role mailbox =
139
+
let name = Jmap_mailbox.name mailbox in
140
+
match Jmap_mailbox.role mailbox with
141
+
| Some role -> Printf.sprintf "%s (%s)" name (role_name role)
142
+
| None -> name
143
+
in
144
+
145
+
(* Helper to get statistics for a mailbox *)
146
+
let get_stats mailbox =
147
+
let id = Jmap_mailbox.id mailbox in
148
+
let total = Jmap_mailbox.total_emails mailbox in
149
+
let unread = Jmap_mailbox.unread_emails mailbox in
150
+
151
+
match Hashtbl.find_opt stats id with
152
+
| Some mailbox_stats ->
153
+
let recent = match List.assoc_opt "Last week" mailbox_stats.time_periods with
154
+
| Some count -> count
155
+
| None -> 0
156
+
in
157
+
(total, unread, recent)
158
+
| None -> (total, unread, 0)
159
+
in
160
+
161
+
(* Helper to print a JSON representation *)
162
+
let print_json_mailbox mailbox indent =
163
+
let id = Jmap_mailbox.id mailbox in
164
+
let name = Jmap_mailbox.name mailbox in
165
+
let role = match Jmap_mailbox.role mailbox with
166
+
| Some role -> Printf.sprintf "\"%s\"" (role_name role)
167
+
| None -> "null"
168
+
in
169
+
let total, unread, recent = get_stats mailbox in
170
+
171
+
let indent_str = String.make indent ' ' in
172
+
Printf.printf "%s{\n" indent_str;
173
+
Printf.printf "%s \"id\": \"%s\",\n" indent_str id;
174
+
Printf.printf "%s \"name\": \"%s\",\n" indent_str name;
175
+
Printf.printf "%s \"role\": %s,\n" indent_str role;
176
+
Printf.printf "%s \"totalEmails\": %d,\n" indent_str total;
177
+
Printf.printf "%s \"unreadEmails\": %d,\n" indent_str unread;
178
+
Printf.printf "%s \"recentEmails\": %d\n" indent_str recent;
179
+
Printf.printf "%s}" indent_str
180
+
in
181
+
182
+
(* Recursive function to print a tree of mailboxes *)
183
+
let rec print_tree_level mailboxes level =
184
+
mailboxes |> List.iteri (fun i mailbox ->
185
+
let id = Jmap_mailbox.id mailbox in
186
+
let name = mailbox_name_with_role mailbox in
187
+
let total, unread, recent = get_stats mailbox in
188
+
189
+
let indent = String.make (level * 2) ' ' in
190
+
let is_last = i = List.length mailboxes - 1 in
191
+
let prefix = if level = 0 then "" else
192
+
if is_last then "└── " else "├── " in
193
+
194
+
match format with
195
+
| `Tree ->
196
+
Printf.printf "%s%s%s" indent prefix name;
197
+
if stats <> Hashtbl.create 0 then
198
+
Printf.printf " (%d emails, %d unread, %d recent)" total unread recent;
199
+
Printf.printf "\n";
200
+
201
+
(* Print children *)
202
+
let children = find_children id in
203
+
let child_indent = level + 1 in
204
+
print_tree_level children child_indent
205
+
206
+
| `Flat ->
207
+
Printf.printf "%s [%s]\n" name id;
208
+
if stats <> Hashtbl.create 0 then
209
+
Printf.printf " Emails: %d total, %d unread, %d in last week\n"
210
+
total unread recent;
211
+
212
+
(* Print children *)
213
+
let children = find_children id in
214
+
print_tree_level children 0
215
+
216
+
| `Json ->
217
+
print_json_mailbox mailbox (level * 2);
218
+
219
+
(* Handle commas between mailboxes *)
220
+
let children = find_children id in
221
+
if children <> [] || (not is_last) then Printf.printf ",\n" else Printf.printf "\n";
222
+
223
+
(* Print children as a "children" array *)
224
+
if children <> [] then begin
225
+
Printf.printf "%s\"children\": [\n" (String.make ((level * 2) + 2) ' ');
226
+
print_tree_level children (level + 2);
227
+
Printf.printf "%s]\n" (String.make ((level * 2) + 2) ' ');
228
+
229
+
(* Add comma if not the last mailbox *)
230
+
if not is_last then Printf.printf "%s,\n" (String.make (level * 2) ' ');
231
+
end
232
+
)
233
+
in
234
+
235
+
(* Print the mailbox tree *)
236
+
match format with
237
+
| `Tree | `Flat ->
238
+
Printf.printf "Mailboxes:\n";
239
+
print_tree_level (find_roots()) 0
240
+
| `Json ->
241
+
Printf.printf "{\n";
242
+
Printf.printf " \"mailboxes\": [\n";
243
+
print_tree_level (find_roots()) 1;
244
+
Printf.printf " ]\n";
245
+
Printf.printf "}\n"
246
+
247
+
(* Command implementation *)
248
+
let mailbox_command host user password list stats mailbox create parent
249
+
query_mailbox days format : int =
250
+
(* Pack arguments into a record for easier passing *)
251
+
let args : mailbox_explorer_args = {
252
+
list; stats; mailbox; create; parent;
253
+
query_mailbox; days; format
254
+
} in
255
+
256
+
(* Main workflow would be implemented here using the JMAP library *)
257
+
Printf.printf "JMAP Mailbox Explorer\n";
258
+
Printf.printf "Server: %s\n" host;
259
+
Printf.printf "User: %s\n\n" user;
260
+
261
+
(* This is where the actual JMAP calls would happen, like:
262
+
263
+
let explore_mailboxes () =
264
+
let* (ctx, session) = Jmap.Unix.connect
265
+
~host ~username:user ~password
266
+
~auth_method:(Jmap.Unix.Basic(user, password)) () in
267
+
268
+
(* Get primary account ID *)
269
+
let account_id = match Jmap.get_primary_account session Jmap_email.capability_mail with
270
+
| Ok id -> id
271
+
| Error _ -> failwith "No mail account found"
272
+
in
273
+
274
+
(* Create a new mailbox if requested *)
275
+
if args.create <> None then
276
+
let name = Option.get args.create in
277
+
let parent_id_opt = match args.parent with
278
+
| None -> None
279
+
| Some parent_name ->
280
+
(* Resolve parent name to ID - would need to search for it *)
281
+
None (* This would actually find or return an error *)
282
+
in
283
+
284
+
let create_mailbox = Jmap_mailbox.create
285
+
~name
286
+
?parent_id:parent_id_opt
287
+
() in
288
+
289
+
let* result = Jmap_mailbox.set ctx
290
+
~account_id
291
+
~create:(Hashtbl.of_seq (Seq.return ("new", create_mailbox)))
292
+
() in
293
+
294
+
(* Handle mailbox creation result *)
295
+
...
296
+
297
+
(* List mailboxes *)
298
+
if args.list || args.stats then
299
+
(* Query mailboxes *)
300
+
let filter =
301
+
if args.mailbox <> None then
302
+
Jmap_mailbox.filter_name_contains (Option.get args.mailbox)
303
+
else
304
+
Jmap_mailbox.Filter.condition (`Assoc [])
305
+
in
306
+
307
+
let* mailbox_ids = Jmap_mailbox.query ctx
308
+
~account_id
309
+
~filter
310
+
~sort:[Jmap_mailbox.sort_by_name () ]
311
+
() in
312
+
313
+
match mailbox_ids with
314
+
| Error err ->
315
+
Printf.eprintf "Error querying mailboxes: %s\n" (Jmap.Error.error_to_string err);
316
+
Lwt.return_unit
317
+
| Ok (ids, _) ->
318
+
(* Get full mailbox objects *)
319
+
let* mailboxes = Jmap_mailbox.get ctx
320
+
~account_id
321
+
~ids
322
+
~properties:["id"; "name"; "parentId"; "role"; "totalEmails"; "unreadEmails"] in
323
+
324
+
match mailboxes with
325
+
| Error err ->
326
+
Printf.eprintf "Error getting mailboxes: %s\n" (Jmap.Error.error_to_string err);
327
+
Lwt.return_unit
328
+
| Ok (_, mailbox_list) ->
329
+
(* If stats requested, gather email stats for each mailbox *)
330
+
let* stats_opt =
331
+
if args.stats then
332
+
(* For each mailbox, gather stats like weekly counts *)
333
+
...
334
+
else
335
+
Lwt.return (Hashtbl.create 0)
336
+
in
337
+
338
+
(* Display mailboxes in requested format *)
339
+
display_mailbox_tree mailbox_list args.format stats_opt;
340
+
Lwt.return_unit
341
+
342
+
(* Query emails in a specific mailbox *)
343
+
if args.query_mailbox <> None then
344
+
let mailbox_name = Option.get args.query_mailbox in
345
+
346
+
(* Find mailbox ID from name *)
347
+
...
348
+
349
+
(* Query emails in that mailbox *)
350
+
...
351
+
*)
352
+
353
+
if create <> None then
354
+
Printf.printf "Creating mailbox: %s\n" (Option.get create);
355
+
356
+
if list || stats then
357
+
Printf.printf "Listing mailboxes%s:\n"
358
+
(if stats then " with statistics" else "");
359
+
360
+
(* Example output for a tree of mailboxes *)
361
+
(match format with
362
+
| `Tree ->
363
+
Printf.printf "Mailboxes:\n";
364
+
Printf.printf "Inbox (14 emails, 3 unread, 5 recent)\n";
365
+
Printf.printf "├── Work (8 emails, 2 unread, 3 recent)\n";
366
+
Printf.printf "│ └── Project A (3 emails, 1 unread, 2 recent)\n";
367
+
Printf.printf "└── Personal (6 emails, 1 unread, 2 recent)\n"
368
+
| `Flat ->
369
+
Printf.printf "Inbox [mbox1]\n";
370
+
Printf.printf " Emails: 14 total, 3 unread, 5 in last week\n";
371
+
Printf.printf "Work [mbox2]\n";
372
+
Printf.printf " Emails: 8 total, 2 unread, 3 in last week\n";
373
+
Printf.printf "Project A [mbox3]\n";
374
+
Printf.printf " Emails: 3 total, 1 unread, 2 in last week\n";
375
+
Printf.printf "Personal [mbox4]\n";
376
+
Printf.printf " Emails: 6 total, 1 unread, 2 in last week\n"
377
+
| `Json ->
378
+
Printf.printf "{\n";
379
+
Printf.printf " \"mailboxes\": [\n";
380
+
Printf.printf " {\n";
381
+
Printf.printf " \"id\": \"mbox1\",\n";
382
+
Printf.printf " \"name\": \"Inbox\",\n";
383
+
Printf.printf " \"role\": \"Inbox\",\n";
384
+
Printf.printf " \"totalEmails\": 14,\n";
385
+
Printf.printf " \"unreadEmails\": 3,\n";
386
+
Printf.printf " \"recentEmails\": 5\n";
387
+
Printf.printf " }\n";
388
+
Printf.printf " ]\n";
389
+
Printf.printf "}\n");
390
+
391
+
if query_mailbox <> None then
392
+
Printf.printf "\nQuerying emails in mailbox: %s\n" (Option.get query_mailbox);
393
+
394
+
(* Since we're only type checking, we'll exit with success *)
395
+
0
396
+
397
+
(* Command definition *)
398
+
let mailbox_cmd =
399
+
let doc = "explore and manage mailboxes using JMAP" in
400
+
let man = [
401
+
`S Manpage.s_description;
402
+
`P "Lists, creates, and analyzes email mailboxes using JMAP.";
403
+
`P "Demonstrates JMAP's mailbox query and management capabilities.";
404
+
`S Manpage.s_examples;
405
+
`P " $(mname) -h jmap.example.com -u user@example.com -p secret123 --list";
406
+
`P " $(mname) -h jmap.example.com -u user@example.com -p secret123 --stats --mailbox Inbox";
407
+
`P " $(mname) -h jmap.example.com -u user@example.com -p secret123 --create \"Work/Project X\" --parent Work";
408
+
] in
409
+
410
+
let cmd =
411
+
Cmd.v
412
+
(Cmd.info "jmap-mailbox-explorer" ~version:"1.0" ~doc ~man)
413
+
Term.(const mailbox_command $ host_arg $ user_arg $ password_arg $
414
+
list_arg $ stats_arg $ mailbox_arg $ create_arg $
415
+
parent_arg $ query_mailbox_arg $ days_arg $ format_arg)
416
+
in
417
+
cmd
418
+
419
+
(* Main entry point *)
420
+
let () = exit (Cmd.eval' mailbox_cmd)
+238
bin/jmap_push_listener.ml
+238
bin/jmap_push_listener.ml
···
1
+
(*
2
+
* jmap_push_listener.ml - Monitor real-time changes via JMAP push notifications
3
+
*
4
+
* This binary demonstrates JMAP's push notification capabilities for monitoring
5
+
* changes to emails, mailboxes, and other data in real-time.
6
+
*
7
+
* For step 2, we're only testing type checking. No implementations required.
8
+
*)
9
+
10
+
open Cmdliner
11
+
12
+
(** Push notification types to monitor **)
13
+
type monitor_types = {
14
+
emails : bool;
15
+
mailboxes : bool;
16
+
threads : bool;
17
+
identities : bool;
18
+
submissions : bool;
19
+
all : bool;
20
+
}
21
+
22
+
(** Command-line arguments **)
23
+
24
+
let host_arg =
25
+
Arg.(required & opt (some string) None & info ["h"; "host"]
26
+
~docv:"HOST" ~doc:"JMAP server hostname")
27
+
28
+
let user_arg =
29
+
Arg.(required & opt (some string) None & info ["u"; "user"]
30
+
~docv:"USERNAME" ~doc:"Username for authentication")
31
+
32
+
let password_arg =
33
+
Arg.(required & opt (some string) None & info ["p"; "password"]
34
+
~docv:"PASSWORD" ~doc:"Password for authentication")
35
+
36
+
let monitor_emails_arg =
37
+
Arg.(value & flag & info ["emails"]
38
+
~doc:"Monitor email changes")
39
+
40
+
let monitor_mailboxes_arg =
41
+
Arg.(value & flag & info ["mailboxes"]
42
+
~doc:"Monitor mailbox changes")
43
+
44
+
let monitor_threads_arg =
45
+
Arg.(value & flag & info ["threads"]
46
+
~doc:"Monitor thread changes")
47
+
48
+
let monitor_identities_arg =
49
+
Arg.(value & flag & info ["identities"]
50
+
~doc:"Monitor identity changes")
51
+
52
+
let monitor_submissions_arg =
53
+
Arg.(value & flag & info ["submissions"]
54
+
~doc:"Monitor email submission changes")
55
+
56
+
let monitor_all_arg =
57
+
Arg.(value & flag & info ["all"]
58
+
~doc:"Monitor all supported types")
59
+
60
+
let verbose_arg =
61
+
Arg.(value & flag & info ["v"; "verbose"]
62
+
~doc:"Show detailed information about changes")
63
+
64
+
let timeout_arg =
65
+
Arg.(value & opt int 300 & info ["t"; "timeout"]
66
+
~docv:"SECONDS" ~doc:"Timeout for push connections (default: 300)")
67
+
68
+
(** Helper functions **)
69
+
70
+
(* Format timestamp *)
71
+
let format_timestamp () =
72
+
let time = Unix.gettimeofday () in
73
+
let tm = Unix.localtime time in
74
+
Printf.sprintf "%04d-%02d-%02d %02d:%02d:%02d"
75
+
(tm.Unix.tm_year + 1900) (tm.Unix.tm_mon + 1) tm.Unix.tm_mday
76
+
tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec
77
+
78
+
(* Print change notification *)
79
+
let print_change data_type change_type details verbose =
80
+
let timestamp = format_timestamp () in
81
+
Printf.printf "[%s] %s %s" timestamp data_type change_type;
82
+
if verbose && details <> "" then
83
+
Printf.printf ": %s" details;
84
+
Printf.printf "\n";
85
+
flush stdout
86
+
87
+
(* Monitor using polling simulation *)
88
+
let monitor_changes _ctx _session _account_id monitor verbose timeout =
89
+
Printf.printf "Starting change monitoring (simulated)...\n\n";
90
+
91
+
(* Types to monitor *)
92
+
let types = ref [] in
93
+
if monitor.emails || monitor.all then types := "Email" :: !types;
94
+
if monitor.mailboxes || monitor.all then types := "Mailbox" :: !types;
95
+
if monitor.threads || monitor.all then types := "Thread" :: !types;
96
+
if monitor.identities || monitor.all then types := "Identity" :: !types;
97
+
if monitor.submissions || monitor.all then types := "EmailSubmission" :: !types;
98
+
99
+
Printf.printf "Monitoring: %s\n\n" (String.concat ", " !types);
100
+
101
+
(* In a real implementation, we would:
102
+
1. Use EventSource or long polling
103
+
2. Track state changes per type
104
+
3. Fetch and display actual changes
105
+
106
+
For this demo, we'll simulate monitoring *)
107
+
108
+
let rec monitor_loop count =
109
+
(* Make a simple echo request to stay connected *)
110
+
let invocation = Jmap.Wire.Invocation.v
111
+
~method_name:"Core/echo"
112
+
~arguments:(`Assoc ["ping", `String "keepalive"])
113
+
~method_call_id:"echo1"
114
+
() in
115
+
116
+
let request = Jmap.Wire.Request.v
117
+
~using:[Jmap.capability_core; Jmap_email.capability_mail]
118
+
~method_calls:[invocation]
119
+
() in
120
+
121
+
match Jmap_unix.request _ctx request with
122
+
| Ok _ ->
123
+
(* Simulate random changes for demonstration *)
124
+
if count mod 3 = 0 && !types <> [] then (
125
+
let changed_type = List.nth !types (Random.int (List.length !types)) in
126
+
let change_details = match changed_type with
127
+
| "Email" -> "2 new, 1 updated"
128
+
| "Mailbox" -> "1 updated (Inbox)"
129
+
| "Thread" -> "3 updated"
130
+
| "Identity" -> "settings changed"
131
+
| "EmailSubmission" -> "1 sent"
132
+
| _ -> "changed"
133
+
in
134
+
print_change changed_type "changed" change_details verbose
135
+
);
136
+
137
+
(* Wait before next check *)
138
+
Unix.sleep 5;
139
+
140
+
if count < timeout / 5 then
141
+
monitor_loop (count + 1)
142
+
else (
143
+
Printf.printf "\nMonitoring timeout reached.\n";
144
+
0
145
+
)
146
+
| Error e ->
147
+
Printf.eprintf "Connection error: %s\n" (Jmap.Error.error_to_string e);
148
+
1
149
+
in
150
+
151
+
monitor_loop 0
152
+
153
+
(* Command implementation *)
154
+
let listen_command host user password emails mailboxes threads identities
155
+
submissions all verbose timeout : int =
156
+
Printf.printf "JMAP Push Listener\n";
157
+
Printf.printf "Server: %s\n" host;
158
+
Printf.printf "User: %s\n\n" user;
159
+
160
+
(* Build monitor options *)
161
+
let monitor = {
162
+
emails;
163
+
mailboxes;
164
+
threads;
165
+
identities;
166
+
submissions;
167
+
all;
168
+
} in
169
+
170
+
(* Check that at least one type is selected *)
171
+
if not (emails || mailboxes || threads || identities || submissions || all) then (
172
+
Printf.eprintf "Error: Must specify at least one type to monitor (or --all)\n";
173
+
exit 1
174
+
);
175
+
176
+
(* Initialize random for simulation *)
177
+
Random.self_init ();
178
+
179
+
(* Connect to server *)
180
+
let ctx = Jmap_unix.create_client () in
181
+
let result = Jmap_unix.quick_connect ~host ~username:user ~password in
182
+
183
+
let (ctx, session) = match result with
184
+
| Ok (ctx, session) -> (ctx, session)
185
+
| Error e ->
186
+
Printf.eprintf "Connection failed: %s\n" (Jmap.Error.error_to_string e);
187
+
exit 1
188
+
in
189
+
190
+
(* Get the primary account ID *)
191
+
let account_id = match Jmap.get_primary_account session Jmap_email.capability_mail with
192
+
| Ok id -> id
193
+
| Error e ->
194
+
Printf.eprintf "No mail account found: %s\n" (Jmap.Error.error_to_string e);
195
+
exit 1
196
+
in
197
+
198
+
(* Check EventSource URL availability *)
199
+
let event_source_url = Jmap.Session.Session.event_source_url session in
200
+
if Uri.to_string event_source_url <> "" then
201
+
Printf.printf "Note: Server supports EventSource at: %s\n\n" (Uri.to_string event_source_url)
202
+
else
203
+
Printf.printf "Note: Server doesn't advertise EventSource support\n\n";
204
+
205
+
(* Monitor for changes *)
206
+
monitor_changes ctx session account_id monitor verbose timeout
207
+
208
+
(* Command definition *)
209
+
let listen_cmd =
210
+
let doc = "monitor real-time changes via JMAP push notifications" in
211
+
let man = [
212
+
`S Manpage.s_description;
213
+
`P "Monitor real-time changes to JMAP data using push notifications.";
214
+
`P "Supports both EventSource and long-polling methods.";
215
+
`P "Shows when emails, mailboxes, threads, and other data change.";
216
+
`S Manpage.s_examples;
217
+
`P "Monitor all changes:";
218
+
`P " $(mname) -h jmap.example.com -u user@example.com -p secret123 --all";
219
+
`P "";
220
+
`P "Monitor only emails and mailboxes with details:";
221
+
`P " $(mname) -h jmap.example.com -u user@example.com -p secret123 --emails --mailboxes -v";
222
+
`P "";
223
+
`P "Monitor with custom timeout:";
224
+
`P " $(mname) -h jmap.example.com -u user@example.com -p secret123 --all -t 600";
225
+
] in
226
+
227
+
let cmd =
228
+
Cmd.v
229
+
(Cmd.info "jmap-push-listener" ~version:"1.0" ~doc ~man)
230
+
Term.(const listen_command $ host_arg $ user_arg $ password_arg $
231
+
monitor_emails_arg $ monitor_mailboxes_arg $ monitor_threads_arg $
232
+
monitor_identities_arg $ monitor_submissions_arg $ monitor_all_arg $
233
+
verbose_arg $ timeout_arg)
234
+
in
235
+
cmd
236
+
237
+
(* Main entry point *)
238
+
let () = exit (Cmd.eval' listen_cmd)
+533
bin/jmap_thread_analyzer.ml
+533
bin/jmap_thread_analyzer.ml
···
1
+
(*
2
+
* jmap_thread_analyzer.ml - A tool for analyzing email threads using JMAP
3
+
*
4
+
* This binary demonstrates the thread-related capabilities of JMAP,
5
+
* allowing visualization and analysis of conversation threads.
6
+
*)
7
+
8
+
open Cmdliner
9
+
(* Using standard OCaml, no Lwt *)
10
+
11
+
(* JMAP imports *)
12
+
open Jmap
13
+
open Jmap.Types
14
+
open Jmap.Wire
15
+
open Jmap.Methods
16
+
open Jmap_email
17
+
(* For step 2, we're only testing type checking. No implementations required. *)
18
+
19
+
(* Dummy Unix module for type checking *)
20
+
module Unix = struct
21
+
type tm = {
22
+
tm_sec : int;
23
+
tm_min : int;
24
+
tm_hour : int;
25
+
tm_mday : int;
26
+
tm_mon : int;
27
+
tm_year : int;
28
+
tm_wday : int;
29
+
tm_yday : int;
30
+
tm_isdst : bool
31
+
}
32
+
33
+
let time () = 0.0
34
+
let gettimeofday () = 0.0
35
+
let mktime tm = (0.0, tm)
36
+
let gmtime _time = {
37
+
tm_sec = 0; tm_min = 0; tm_hour = 0;
38
+
tm_mday = 1; tm_mon = 0; tm_year = 120;
39
+
tm_wday = 0; tm_yday = 0; tm_isdst = false;
40
+
}
41
+
42
+
(* JMAP connection function - would be in a real implementation *)
43
+
let connect ~host ~username ~password ?auth_method () =
44
+
failwith "Not implemented"
45
+
end
46
+
47
+
(* Dummy ISO8601 module *)
48
+
module ISO8601 = struct
49
+
let string_of_datetime _tm = "2023-01-01T00:00:00Z"
50
+
end
51
+
52
+
(** Thread analyzer arguments *)
53
+
type thread_analyzer_args = {
54
+
thread_id : string option;
55
+
search : string option;
56
+
limit : int;
57
+
days : int;
58
+
subject : string option;
59
+
participants : string list;
60
+
format : [`Summary | `Detailed | `Timeline | `Graph];
61
+
include_body : bool;
62
+
}
63
+
64
+
(* Email filter helpers - stub implementations for type checking *)
65
+
module Email_filter = struct
66
+
let create_fulltext_filter text = Filter.condition (`Assoc [("text", `String text)])
67
+
let subject subj = Filter.condition (`Assoc [("subject", `String subj)])
68
+
let from email = Filter.condition (`Assoc [("from", `String email)])
69
+
let after date = Filter.condition (`Assoc [("receivedAt", `Assoc [("after", `Float date)])])
70
+
let before date = Filter.condition (`Assoc [("receivedAt", `Assoc [("before", `Float date)])])
71
+
let has_attachment () = Filter.condition (`Assoc [("hasAttachment", `Bool true)])
72
+
let unread () = Filter.condition (`Assoc [("isUnread", `Bool true)])
73
+
let in_mailbox id = Filter.condition (`Assoc [("inMailbox", `String id)])
74
+
let to_ email = Filter.condition (`Assoc [("to", `String email)])
75
+
end
76
+
77
+
(* Thread module stub *)
78
+
module Thread = struct
79
+
type t = {
80
+
id : string;
81
+
email_ids : string list;
82
+
}
83
+
84
+
let id thread = thread.id
85
+
let email_ids thread = thread.email_ids
86
+
end
87
+
88
+
(** Command-line arguments **)
89
+
90
+
let host_arg =
91
+
Arg.(required & opt (some string) None & info ["h"; "host"]
92
+
~docv:"HOST" ~doc:"JMAP server hostname")
93
+
94
+
let user_arg =
95
+
Arg.(required & opt (some string) None & info ["u"; "user"]
96
+
~docv:"USERNAME" ~doc:"Username for authentication")
97
+
98
+
let password_arg =
99
+
Arg.(required & opt (some string) None & info ["p"; "password"]
100
+
~docv:"PASSWORD" ~doc:"Password for authentication")
101
+
102
+
let thread_id_arg =
103
+
Arg.(value & opt (some string) None & info ["t"; "thread"]
104
+
~docv:"THREAD_ID" ~doc:"Analyze specific thread by ID")
105
+
106
+
let search_arg =
107
+
Arg.(value & opt (some string) None & info ["search"]
108
+
~docv:"QUERY" ~doc:"Search for threads containing text")
109
+
110
+
let limit_arg =
111
+
Arg.(value & opt int 10 & info ["limit"]
112
+
~docv:"N" ~doc:"Maximum number of threads to display")
113
+
114
+
let days_arg =
115
+
Arg.(value & opt int 30 & info ["days"]
116
+
~docv:"DAYS" ~doc:"Limit to threads from the past N days")
117
+
118
+
let subject_arg =
119
+
Arg.(value & opt (some string) None & info ["subject"]
120
+
~docv:"SUBJECT" ~doc:"Search threads by subject")
121
+
122
+
let participant_arg =
123
+
Arg.(value & opt_all string [] & info ["participant"]
124
+
~docv:"EMAIL" ~doc:"Filter by participant email")
125
+
126
+
let format_arg =
127
+
Arg.(value & opt (enum [
128
+
"summary", `Summary;
129
+
"detailed", `Detailed;
130
+
"timeline", `Timeline;
131
+
"graph", `Graph;
132
+
]) `Summary & info ["format"] ~docv:"FORMAT" ~doc:"Output format")
133
+
134
+
let include_body_arg =
135
+
Arg.(value & flag & info ["include-body"] ~doc:"Include message bodies in output")
136
+
137
+
(** Thread Analysis Functionality **)
138
+
139
+
(* Calculate days ago from a date *)
140
+
let days_ago date =
141
+
let now = Unix.gettimeofday() in
142
+
int_of_float ((now -. date) /. 86400.0)
143
+
144
+
(* Parse out email addresses from a participant string - simple version *)
145
+
let extract_email participant =
146
+
if String.contains participant '@' then participant
147
+
else participant ^ "@example.com" (* Default domain if none provided *)
148
+
149
+
(* Create filter for thread queries *)
150
+
let create_thread_filter args =
151
+
let open Email_filter in
152
+
let filters = [] in
153
+
154
+
(* Add search text condition *)
155
+
let filters = match args.search with
156
+
| None -> filters
157
+
| Some text -> create_fulltext_filter text :: filters
158
+
in
159
+
160
+
(* Add subject condition *)
161
+
let filters = match args.subject with
162
+
| None -> filters
163
+
| Some subj -> Email_filter.subject subj :: filters
164
+
in
165
+
166
+
(* Add date range based on days *)
167
+
let filters =
168
+
if args.days > 0 then
169
+
let now = Unix.gettimeofday() in
170
+
let past = now -. (float_of_int args.days *. 86400.0) in
171
+
after past :: filters
172
+
else
173
+
filters
174
+
in
175
+
176
+
(* Add participant filters *)
177
+
let filters =
178
+
List.fold_left (fun acc participant ->
179
+
let email = extract_email participant in
180
+
(* This would need more complex logic to check both from and to fields *)
181
+
from email :: acc
182
+
) filters args.participants
183
+
in
184
+
185
+
(* Combine all filters with AND *)
186
+
match filters with
187
+
| [] -> Filter.condition (`Assoc []) (* Empty filter *)
188
+
| [f] -> f
189
+
| filters -> Filter.and_ filters
190
+
191
+
(* Display thread in requested format *)
192
+
let display_thread thread emails format include_body snippet_map =
193
+
let thread_id = Thread.id thread in
194
+
let email_count = List.length (Thread.email_ids thread) in
195
+
196
+
(* Sort emails by date for proper display order *)
197
+
let sorted_emails = List.sort (fun e1 e2 ->
198
+
let date1 = Option.value (Types.Email.received_at e1) ~default:0.0 in
199
+
let date2 = Option.value (Types.Email.received_at e2) ~default:0.0 in
200
+
compare date1 date2
201
+
) emails in
202
+
203
+
(* Get a snippet for an email if available *)
204
+
let get_snippet email_id =
205
+
match Hashtbl.find_opt snippet_map email_id with
206
+
| Some snippet -> snippet
207
+
| None -> "(No preview available)"
208
+
in
209
+
210
+
match format with
211
+
| `Summary ->
212
+
Printf.printf "Thread: %s (%d messages)\n\n" thread_id email_count;
213
+
214
+
(* Print first email subject as thread subject *)
215
+
(match sorted_emails with
216
+
| first :: _ ->
217
+
let subject = Option.value (Types.Email.subject first) ~default:"(No subject)" in
218
+
Printf.printf "Subject: %s\n\n" subject
219
+
| [] -> Printf.printf "No emails available\n\n");
220
+
221
+
(* List participants *)
222
+
let participants = sorted_emails |> List.fold_left (fun acc email ->
223
+
let from_list = Option.value (Types.Email.from email) ~default:[] in
224
+
from_list |> List.fold_left (fun acc addr ->
225
+
let email = Types.Email_address.email addr in
226
+
if not (List.mem email acc) then email :: acc else acc
227
+
) acc
228
+
) [] in
229
+
230
+
Printf.printf "Participants: %s\n\n" (String.concat ", " participants);
231
+
232
+
(* Show timespan *)
233
+
(match sorted_emails with
234
+
| first :: _ :: _ :: _ -> (* At least a few messages *)
235
+
let first_date = Option.value (Types.Email.received_at first) ~default:0.0 in
236
+
let last_date = Option.value (Types.Email.received_at (List.hd (List.rev sorted_emails))) ~default:0.0 in
237
+
let datetime_str = ISO8601.string_of_datetime (Unix.gmtime first_date) in
238
+
let first_str = String.sub datetime_str 0 (min 19 (String.length datetime_str)) in
239
+
let datetime_str = ISO8601.string_of_datetime (Unix.gmtime last_date) in
240
+
let last_str = String.sub datetime_str 0 (min 19 (String.length datetime_str)) in
241
+
let duration_days = int_of_float ((last_date -. first_date) /. 86400.0) in
242
+
Printf.printf "Timespan: %s to %s (%d days)\n\n" first_str last_str duration_days
243
+
| _ -> ());
244
+
245
+
(* Show message count by participant *)
246
+
let message_counts = sorted_emails |> List.fold_left (fun acc email ->
247
+
let from_list = Option.value (Types.Email.from email) ~default:[] in
248
+
match from_list with
249
+
| addr :: _ ->
250
+
let email = Types.Email_address.email addr in
251
+
let count = try Hashtbl.find acc email with Not_found -> 0 in
252
+
Hashtbl.replace acc email (count + 1);
253
+
acc
254
+
| [] -> acc
255
+
) (Hashtbl.create 10) in
256
+
257
+
Printf.printf "Messages per participant:\n";
258
+
Hashtbl.iter (fun email count ->
259
+
Printf.printf " %s: %d messages\n" email count
260
+
) message_counts;
261
+
Printf.printf "\n"
262
+
263
+
| `Detailed ->
264
+
Printf.printf "Thread: %s (%d messages)\n\n" thread_id email_count;
265
+
266
+
(* Print detailed information for each email *)
267
+
sorted_emails |> List.iteri (fun i email ->
268
+
let id = Option.value (Types.Email.id email) ~default:"(unknown)" in
269
+
let subject = Option.value (Types.Email.subject email) ~default:"(No subject)" in
270
+
271
+
let from_list = Option.value (Types.Email.from email) ~default:[] in
272
+
let from = match from_list with
273
+
| addr :: _ -> Types.Email_address.email addr
274
+
| [] -> "(unknown)"
275
+
in
276
+
277
+
let date = match Types.Email.received_at email with
278
+
| Some d ->
279
+
let datetime_str = ISO8601.string_of_datetime (Unix.gmtime d) in
280
+
String.sub datetime_str 0 (min 19 (String.length datetime_str))
281
+
| None -> "(unknown)"
282
+
in
283
+
284
+
let days = match Types.Email.received_at email with
285
+
| Some d -> Printf.sprintf " (%d days ago)" (days_ago d)
286
+
| None -> ""
287
+
in
288
+
289
+
Printf.printf "Email %d of %d:\n" (i+1) email_count;
290
+
Printf.printf " ID: %s\n" id;
291
+
Printf.printf " Subject: %s\n" subject;
292
+
Printf.printf " From: %s\n" from;
293
+
Printf.printf " Date: %s%s\n" date days;
294
+
295
+
let keywords = match Types.Email.keywords email with
296
+
| Some kw -> Types.Keywords.custom_keywords kw |> String.concat ", "
297
+
| None -> "(none)"
298
+
in
299
+
if keywords <> "(none)" then
300
+
Printf.printf " Flags: %s\n" keywords;
301
+
302
+
(* Show preview from snippet if available *)
303
+
Printf.printf " Snippet: %s\n" (get_snippet id);
304
+
305
+
(* Show message body if requested *)
306
+
if include_body then
307
+
match Types.Email.text_body email with
308
+
| Some parts when parts <> [] ->
309
+
let first_part = List.hd parts in
310
+
Printf.printf " Body: %s\n" "(body content would be here in real implementation)";
311
+
| _ -> ();
312
+
313
+
Printf.printf "\n"
314
+
)
315
+
316
+
| `Timeline ->
317
+
Printf.printf "Timeline for Thread: %s\n\n" thread_id;
318
+
319
+
(* Get the first email's subject as thread subject *)
320
+
(match sorted_emails with
321
+
| first :: _ ->
322
+
let subject = Option.value (Types.Email.subject first) ~default:"(No subject)" in
323
+
Printf.printf "Subject: %s\n\n" subject
324
+
| [] -> Printf.printf "No emails available\n\n");
325
+
326
+
(* Create a timeline visualization *)
327
+
if sorted_emails = [] then
328
+
Printf.printf "No emails to display\n"
329
+
else
330
+
let first_email = List.hd sorted_emails in
331
+
let last_email = List.hd (List.rev sorted_emails) in
332
+
333
+
let first_date = Option.value (Types.Email.received_at first_email) ~default:0.0 in
334
+
let last_date = Option.value (Types.Email.received_at last_email) ~default:0.0 in
335
+
336
+
let total_duration = max 1.0 (last_date -. first_date) in
337
+
let timeline_width = 50 in
338
+
339
+
let datetime_str = ISO8601.string_of_datetime (Unix.gmtime first_date) in
340
+
let start_str = String.sub datetime_str 0 (min 19 (String.length datetime_str)) in
341
+
Printf.printf "Start date: %s\n" start_str;
342
+
343
+
let datetime_str = ISO8601.string_of_datetime (Unix.gmtime last_date) in
344
+
let end_str = String.sub datetime_str 0 (min 19 (String.length datetime_str)) in
345
+
Printf.printf "End date: %s\n\n" end_str;
346
+
347
+
Printf.printf "Timeline: [%s]\n" (String.make timeline_width '-');
348
+
349
+
sorted_emails |> List.iteri (fun i email ->
350
+
let date = Option.value (Types.Email.received_at email) ~default:0.0 in
351
+
let position = int_of_float (float_of_int timeline_width *. (date -. first_date) /. total_duration) in
352
+
353
+
let from_list = Option.value (Types.Email.from email) ~default:[] in
354
+
let from = match from_list with
355
+
| addr :: _ -> Types.Email_address.email addr
356
+
| [] -> "(unknown)"
357
+
in
358
+
359
+
let datetime_str = ISO8601.string_of_datetime (Unix.gmtime date) in
360
+
let date_str = String.sub datetime_str 0 (min 19 (String.length datetime_str)) in
361
+
362
+
let marker = String.make timeline_width ' ' |> String.mapi (fun j c ->
363
+
if j = position then '*' else if j < position then ' ' else c
364
+
) in
365
+
366
+
Printf.printf "%s [%s] %s: %s\n" date_str marker from (get_snippet (Option.value (Types.Email.id email) ~default:""))
367
+
);
368
+
369
+
Printf.printf "\n"
370
+
371
+
| `Graph ->
372
+
Printf.printf "Thread Graph for: %s\n\n" thread_id;
373
+
374
+
(* In a real implementation, this would build a proper thread graph based on
375
+
In-Reply-To and References headers. For this demo, we'll just show a simple tree. *)
376
+
377
+
(* Get the first email's subject as thread subject *)
378
+
(match sorted_emails with
379
+
| first :: _ ->
380
+
let subject = Option.value (Types.Email.subject first) ~default:"(No subject)" in
381
+
Printf.printf "Subject: %s\n\n" subject
382
+
| [] -> Printf.printf "No emails available\n\n");
383
+
384
+
(* Create a simple thread tree visualization *)
385
+
if sorted_emails = [] then
386
+
Printf.printf "No emails to display\n"
387
+
else
388
+
let indent level = String.make (level * 2) ' ' in
389
+
390
+
(* Very simplified threading model - in a real implementation,
391
+
this would use In-Reply-To and References headers *)
392
+
sorted_emails |> List.iteri (fun i email ->
393
+
let level = min i 4 in (* Simplified nesting - would be based on real reply chain *)
394
+
395
+
let id = Option.value (Types.Email.id email) ~default:"(unknown)" in
396
+
397
+
let from_list = Option.value (Types.Email.from email) ~default:[] in
398
+
let from = match from_list with
399
+
| addr :: _ -> Types.Email_address.email addr
400
+
| [] -> "(unknown)"
401
+
in
402
+
403
+
let date = match Types.Email.received_at email with
404
+
| Some d ->
405
+
let datetime_str = ISO8601.string_of_datetime (Unix.gmtime d) in
406
+
String.sub datetime_str 0 (min 19 (String.length datetime_str))
407
+
| None -> "(unknown)"
408
+
in
409
+
410
+
Printf.printf "%s%s [%s] %s\n"
411
+
(indent level)
412
+
(if level = 0 then "+" else if level = 1 then "|-" else "|--")
413
+
date from;
414
+
415
+
Printf.printf "%s%s\n" (indent (level + 4)) (get_snippet id);
416
+
);
417
+
418
+
Printf.printf "\n"
419
+
420
+
(* Command implementation *)
421
+
let thread_command host user password thread_id search limit days subject
422
+
participant format include_body : int =
423
+
(* Pack arguments into a record for easier passing *)
424
+
let args : thread_analyzer_args = {
425
+
thread_id; search; limit; days; subject;
426
+
participants = participant; format; include_body
427
+
} in
428
+
429
+
(* Main workflow would be implemented here using the JMAP library *)
430
+
Printf.printf "JMAP Thread Analyzer\n";
431
+
Printf.printf "Server: %s\n" host;
432
+
Printf.printf "User: %s\n\n" user;
433
+
434
+
(* This is where the actual JMAP calls would happen, like:
435
+
436
+
let analyze_threads () =
437
+
let* (ctx, session) = Jmap.Unix.connect
438
+
~host ~username:user ~password
439
+
~auth_method:(Jmap.Unix.Basic(user, password)) () in
440
+
441
+
(* Get primary account ID *)
442
+
let account_id = match Jmap.get_primary_account session Jmap_email.capability_mail with
443
+
| Ok id -> id
444
+
| Error _ -> failwith "No mail account found"
445
+
in
446
+
447
+
match args.thread_id with
448
+
| Some id ->
449
+
(* Analyze a specific thread by ID *)
450
+
let* thread_result = Thread.get ctx
451
+
~account_id
452
+
~ids:[id] in
453
+
454
+
(* Handle thread fetch result *)
455
+
...
456
+
457
+
| None ->
458
+
(* Search for threads based on criteria *)
459
+
let filter = create_thread_filter args in
460
+
461
+
(* Email/query to find emails matching criteria *)
462
+
let* query_result = Email.query ctx
463
+
~account_id
464
+
~filter
465
+
~sort:[Email_sort.received_newest_first ()]
466
+
~collapse_threads:true
467
+
~limit:args.limit in
468
+
469
+
(* Process query results to get thread IDs *)
470
+
...
471
+
*)
472
+
473
+
(match thread_id with
474
+
| Some id ->
475
+
Printf.printf "Analyzing thread: %s\n\n" id;
476
+
477
+
(* Simulate a thread with some emails *)
478
+
let emails = 5 in
479
+
Printf.printf "Thread contains %d emails\n" emails;
480
+
481
+
(* In a real implementation, we would display the actual thread data here *)
482
+
Printf.printf "Example output format would show thread details here\n"
483
+
484
+
| None ->
485
+
if search <> None then
486
+
Printf.printf "Searching for threads containing: %s\n" (Option.get search)
487
+
else if subject <> None then
488
+
Printf.printf "Searching for threads with subject: %s\n" (Option.get subject)
489
+
else
490
+
Printf.printf "No specific thread or search criteria provided\n");
491
+
492
+
if participant <> [] then
493
+
Printf.printf "Filtering to threads involving: %s\n"
494
+
(String.concat ", " participant);
495
+
496
+
Printf.printf "Looking at threads from the past %d days\n" days;
497
+
Printf.printf "Showing up to %d threads\n\n" limit;
498
+
499
+
(* Simulate finding some threads *)
500
+
let thread_count = min limit 3 in
501
+
Printf.printf "Found %d matching threads\n\n" thread_count;
502
+
503
+
(* In a real implementation, we would display the actual threads here *)
504
+
for i = 1 to thread_count do
505
+
Printf.printf "Thread %d would be displayed here\n\n" i
506
+
done;
507
+
508
+
(* Since we're only type checking, we'll exit with success *)
509
+
0
510
+
511
+
(* Command definition *)
512
+
let thread_cmd =
513
+
let doc = "analyze email threads using JMAP" in
514
+
let man = [
515
+
`S Manpage.s_description;
516
+
`P "Analyzes email threads with detailed visualization options.";
517
+
`P "Demonstrates how to work with JMAP's thread capabilities.";
518
+
`S Manpage.s_examples;
519
+
`P " $(mname) -h jmap.example.com -u user@example.com -p secret123 -t thread123";
520
+
`P " $(mname) -h jmap.example.com -u user@example.com -p secret123 --search \"project update\" --format timeline";
521
+
] in
522
+
523
+
let cmd =
524
+
Cmd.v
525
+
(Cmd.info "jmap-thread-analyzer" ~version:"1.0" ~doc ~man)
526
+
Term.(const thread_command $ host_arg $ user_arg $ password_arg $
527
+
thread_id_arg $ search_arg $ limit_arg $ days_arg $
528
+
subject_arg $ participant_arg $ format_arg $ include_body_arg)
529
+
in
530
+
cmd
531
+
532
+
(* Main entry point *)
533
+
let () = exit (Cmd.eval' thread_cmd)
+406
bin/jmap_vacation_manager.ml
+406
bin/jmap_vacation_manager.ml
···
1
+
(*
2
+
* jmap_vacation_manager.ml - Manage vacation/out-of-office auto-responses
3
+
*
4
+
* This binary demonstrates JMAP's vacation response capabilities for setting
5
+
* up and managing automatic email responses.
6
+
*
7
+
* For step 2, we're only testing type checking. No implementations required.
8
+
*)
9
+
10
+
open Cmdliner
11
+
12
+
(** Vacation response actions **)
13
+
type vacation_action =
14
+
| Show
15
+
| Enable of vacation_config
16
+
| Disable
17
+
| Update of vacation_config
18
+
19
+
and vacation_config = {
20
+
subject : string option;
21
+
text_body : string;
22
+
html_body : string option;
23
+
from_date : float option;
24
+
to_date : float option;
25
+
exclude_addresses : string list;
26
+
}
27
+
28
+
(** Command-line arguments **)
29
+
30
+
let host_arg =
31
+
Arg.(required & opt (some string) None & info ["h"; "host"]
32
+
~docv:"HOST" ~doc:"JMAP server hostname")
33
+
34
+
let user_arg =
35
+
Arg.(required & opt (some string) None & info ["u"; "user"]
36
+
~docv:"USERNAME" ~doc:"Username for authentication")
37
+
38
+
let password_arg =
39
+
Arg.(required & opt (some string) None & info ["p"; "password"]
40
+
~docv:"PASSWORD" ~doc:"Password for authentication")
41
+
42
+
let enable_arg =
43
+
Arg.(value & flag & info ["e"; "enable"]
44
+
~doc:"Enable vacation response")
45
+
46
+
let disable_arg =
47
+
Arg.(value & flag & info ["d"; "disable"]
48
+
~doc:"Disable vacation response")
49
+
50
+
let show_arg =
51
+
Arg.(value & flag & info ["s"; "show"]
52
+
~doc:"Show current vacation settings")
53
+
54
+
let subject_arg =
55
+
Arg.(value & opt (some string) None & info ["subject"]
56
+
~docv:"SUBJECT" ~doc:"Vacation email subject line")
57
+
58
+
let message_arg =
59
+
Arg.(value & opt (some string) None & info ["m"; "message"]
60
+
~docv:"TEXT" ~doc:"Vacation message text")
61
+
62
+
let message_file_arg =
63
+
Arg.(value & opt (some string) None & info ["message-file"]
64
+
~docv:"FILE" ~doc:"Read vacation message from file")
65
+
66
+
let html_message_arg =
67
+
Arg.(value & opt (some string) None & info ["html-message"]
68
+
~docv:"HTML" ~doc:"HTML vacation message")
69
+
70
+
let from_date_arg =
71
+
Arg.(value & opt (some string) None & info ["from-date"]
72
+
~docv:"DATE" ~doc:"Start date for vacation (YYYY-MM-DD)")
73
+
74
+
let to_date_arg =
75
+
Arg.(value & opt (some string) None & info ["to-date"]
76
+
~docv:"DATE" ~doc:"End date for vacation (YYYY-MM-DD)")
77
+
78
+
let exclude_arg =
79
+
Arg.(value & opt_all string [] & info ["exclude"]
80
+
~docv:"EMAIL" ~doc:"Email address to exclude from auto-response")
81
+
82
+
(** Helper functions **)
83
+
84
+
(* Parse date string to Unix timestamp *)
85
+
let parse_date date_str =
86
+
try
87
+
let (year, month, day) = Scanf.sscanf date_str "%d-%d-%d" (fun y m d -> (y, m, d)) in
88
+
let tm = Unix.{ tm_sec = 0; tm_min = 0; tm_hour = 0;
89
+
tm_mday = day; tm_mon = month - 1; tm_year = year - 1900;
90
+
tm_wday = 0; tm_yday = 0; tm_isdst = false } in
91
+
Some (Unix.mktime tm |> fst)
92
+
with _ ->
93
+
Printf.eprintf "Invalid date format: %s (use YYYY-MM-DD)\n" date_str;
94
+
None
95
+
96
+
(* Format Unix timestamp as date string *)
97
+
let format_date timestamp =
98
+
let tm = Unix.localtime timestamp in
99
+
Printf.sprintf "%04d-%02d-%02d"
100
+
(tm.Unix.tm_year + 1900) (tm.Unix.tm_mon + 1) tm.Unix.tm_mday
101
+
102
+
(* Read file contents *)
103
+
let read_file filename =
104
+
let ic = open_in filename in
105
+
let len = in_channel_length ic in
106
+
let content = really_input_string ic len in
107
+
close_in ic;
108
+
content
109
+
110
+
(* Display vacation response settings *)
111
+
let show_vacation_response vacation =
112
+
Printf.printf "\nVacation Response Settings:\n";
113
+
Printf.printf "==========================\n\n";
114
+
115
+
Printf.printf "Status: %s\n"
116
+
(if Jmap_email.Vacation.Vacation_response.is_enabled vacation then "ENABLED" else "DISABLED");
117
+
118
+
(match Jmap_email.Vacation.Vacation_response.subject vacation with
119
+
| Some subj -> Printf.printf "Subject: %s\n" subj
120
+
| None -> Printf.printf "Subject: (default)\n");
121
+
122
+
(match Jmap_email.Vacation.Vacation_response.text_body vacation with
123
+
| Some body ->
124
+
Printf.printf "\nMessage:\n";
125
+
Printf.printf "--------\n";
126
+
Printf.printf "%s\n" body;
127
+
Printf.printf "--------\n"
128
+
| None -> Printf.printf "\nMessage: (none set)\n");
129
+
130
+
(match Jmap_email.Vacation.Vacation_response.from_date vacation with
131
+
| Some date -> Printf.printf "\nActive from: %s\n" (format_date date)
132
+
| None -> ());
133
+
134
+
(match Jmap_email.Vacation.Vacation_response.to_date vacation with
135
+
| Some date -> Printf.printf "Active until: %s\n" (format_date date)
136
+
| None -> ());
137
+
138
+
let excluded = match Jmap_email.Vacation.Vacation_response.id vacation with
139
+
| _ -> [] (* exclude_addresses not available in interface *) in
140
+
if excluded <> [] then (
141
+
Printf.printf "\nExcluded addresses:\n";
142
+
List.iter (Printf.printf " - %s\n") excluded
143
+
)
144
+
145
+
(* Get current vacation response *)
146
+
let get_vacation_response ctx session account_id =
147
+
let get_args = Jmap.Methods.Get_args.v
148
+
~account_id
149
+
~properties:["isEnabled"; "subject"; "textBody"; "htmlBody";
150
+
"fromDate"; "toDate"; "excludeAddresses"]
151
+
() in
152
+
153
+
let invocation = Jmap.Wire.Invocation.v
154
+
~method_name:"VacationResponse/get"
155
+
~arguments:(`Assoc []) (* Would serialize get_args *)
156
+
~method_call_id:"get1"
157
+
() in
158
+
159
+
let request = Jmap.Wire.Request.v
160
+
~using:[Jmap.capability_core; Jmap_email.capability_mail; Jmap_email.capability_vacationresponse]
161
+
~method_calls:[invocation]
162
+
() in
163
+
164
+
match Jmap_unix.request ctx request with
165
+
| Ok _ ->
166
+
(* Would extract from response - for now create a sample *)
167
+
Ok (Jmap_email.Vacation.Vacation_response.v
168
+
~id:"vacation1"
169
+
~is_enabled:false
170
+
~subject:"Out of Office"
171
+
~text_body:"I am currently out of the office and will respond when I return."
172
+
())
173
+
| Error e -> Error e
174
+
175
+
(* Update vacation response *)
176
+
let update_vacation_response ctx session account_id vacation_id updates =
177
+
let update_map = Hashtbl.create 1 in
178
+
Hashtbl.add update_map vacation_id updates;
179
+
180
+
let set_args = Jmap.Methods.Set_args.v
181
+
~account_id
182
+
~update:update_map
183
+
() in
184
+
185
+
let invocation = Jmap.Wire.Invocation.v
186
+
~method_name:"VacationResponse/set"
187
+
~arguments:(`Assoc []) (* Would serialize set_args *)
188
+
~method_call_id:"set1"
189
+
() in
190
+
191
+
let request = Jmap.Wire.Request.v
192
+
~using:[Jmap.capability_core; Jmap_email.capability_mail; Jmap_email.capability_vacationresponse]
193
+
~method_calls:[invocation]
194
+
() in
195
+
196
+
match Jmap_unix.request ctx request with
197
+
| Ok _ -> Ok ()
198
+
| Error e -> Error e
199
+
200
+
(* Process vacation action *)
201
+
let process_vacation_action ctx session account_id action =
202
+
match action with
203
+
| Show ->
204
+
(match get_vacation_response ctx session account_id with
205
+
| Ok vacation ->
206
+
show_vacation_response vacation;
207
+
0
208
+
| Error e ->
209
+
Printf.eprintf "Failed to get vacation response: %s\n" (Jmap.Error.error_to_string e);
210
+
1)
211
+
212
+
| Enable config ->
213
+
Printf.printf "Enabling vacation response...\n";
214
+
215
+
(* Build the vacation response object *)
216
+
let vacation = Jmap_email.Vacation.Vacation_response.v
217
+
~id:"singleton"
218
+
~is_enabled:true
219
+
?subject:config.subject
220
+
~text_body:config.text_body
221
+
?html_body:config.html_body
222
+
?from_date:config.from_date
223
+
?to_date:config.to_date
224
+
() in
225
+
226
+
(match update_vacation_response ctx session account_id "singleton" vacation with
227
+
| Ok () ->
228
+
Printf.printf "\nVacation response enabled successfully!\n";
229
+
230
+
(* Show what was set *)
231
+
show_vacation_response vacation;
232
+
0
233
+
| Error e ->
234
+
Printf.eprintf "Failed to enable vacation response: %s\n" (Jmap.Error.error_to_string e);
235
+
1)
236
+
237
+
| Disable ->
238
+
Printf.printf "Disabling vacation response...\n";
239
+
240
+
let updates = Jmap_email.Vacation.Vacation_response.v
241
+
~id:"singleton"
242
+
~is_enabled:false
243
+
() in
244
+
245
+
(match update_vacation_response ctx session account_id "singleton" updates with
246
+
| Ok () ->
247
+
Printf.printf "Vacation response disabled successfully!\n";
248
+
0
249
+
| Error e ->
250
+
Printf.eprintf "Failed to disable vacation response: %s\n" (Jmap.Error.error_to_string e);
251
+
1)
252
+
253
+
| Update config ->
254
+
Printf.printf "Updating vacation response...\n";
255
+
256
+
(* Only update specified fields *)
257
+
let vacation = Jmap_email.Vacation.Vacation_response.v
258
+
~id:"singleton"
259
+
?subject:config.subject
260
+
~text_body:config.text_body
261
+
?html_body:config.html_body
262
+
?from_date:config.from_date
263
+
?to_date:config.to_date
264
+
() in
265
+
266
+
(match update_vacation_response ctx session account_id "singleton" vacation with
267
+
| Ok () ->
268
+
Printf.printf "Vacation response updated successfully!\n";
269
+
270
+
(* Show current settings *)
271
+
(match get_vacation_response ctx session account_id with
272
+
| Ok current -> show_vacation_response current
273
+
| Error _ -> ());
274
+
0
275
+
| Error e ->
276
+
Printf.eprintf "Failed to update vacation response: %s\n" (Jmap.Error.error_to_string e);
277
+
1)
278
+
279
+
(* Command implementation *)
280
+
let vacation_command host user password enable disable show subject message
281
+
message_file html_message from_date to_date exclude : int =
282
+
Printf.printf "JMAP Vacation Manager\n";
283
+
Printf.printf "Server: %s\n" host;
284
+
Printf.printf "User: %s\n\n" user;
285
+
286
+
(* Determine action *)
287
+
let action_count = (if enable then 1 else 0) +
288
+
(if disable then 1 else 0) +
289
+
(if show then 1 else 0) in
290
+
291
+
if action_count = 0 then (
292
+
Printf.eprintf "Error: Must specify an action: --enable, --disable, or --show\n";
293
+
exit 1
294
+
);
295
+
296
+
if action_count > 1 then (
297
+
Printf.eprintf "Error: Can only specify one action at a time\n";
298
+
exit 1
299
+
);
300
+
301
+
(* Build vacation config if enabling or updating *)
302
+
let config = if enable || (not disable && not show) then
303
+
(* Read message content *)
304
+
let text_body = match message, message_file with
305
+
| Some text, _ -> text
306
+
| None, Some file -> read_file file
307
+
| None, None ->
308
+
if enable then (
309
+
Printf.eprintf "Error: Must provide vacation message (--message or --message-file)\n";
310
+
exit 1
311
+
) else ""
312
+
in
313
+
314
+
(* Parse dates *)
315
+
let from_date = match from_date with
316
+
| Some date_str -> parse_date date_str
317
+
| None -> None
318
+
in
319
+
320
+
let to_date = match to_date with
321
+
| Some date_str -> parse_date date_str
322
+
| None -> None
323
+
in
324
+
325
+
Some {
326
+
subject;
327
+
text_body;
328
+
html_body = html_message;
329
+
from_date;
330
+
to_date;
331
+
exclude_addresses = exclude;
332
+
}
333
+
else
334
+
None
335
+
in
336
+
337
+
(* Determine action *)
338
+
let action =
339
+
if show then Show
340
+
else if disable then Disable
341
+
else if enable then Enable (Option.get config)
342
+
else Update (Option.get config)
343
+
in
344
+
345
+
(* Connect to server *)
346
+
let ctx = Jmap_unix.create_client () in
347
+
let result = Jmap_unix.quick_connect ~host ~username:user ~password in
348
+
349
+
let (ctx, session) = match result with
350
+
| Ok (ctx, session) -> (ctx, session)
351
+
| Error e ->
352
+
Printf.eprintf "Connection failed: %s\n" (Jmap.Error.error_to_string e);
353
+
exit 1
354
+
in
355
+
356
+
(* Check vacation capability *)
357
+
(* Note: has_capability not available in interface, assuming server supports it *)
358
+
359
+
(* Get the primary account ID *)
360
+
let account_id = match Jmap.get_primary_account session Jmap_email.capability_mail with
361
+
| Ok id -> id
362
+
| Error e ->
363
+
Printf.eprintf "No mail account found: %s\n" (Jmap.Error.error_to_string e);
364
+
exit 1
365
+
in
366
+
367
+
(* Process the action *)
368
+
process_vacation_action ctx session account_id action
369
+
370
+
(* Command definition *)
371
+
let vacation_cmd =
372
+
let doc = "manage vacation/out-of-office auto-responses" in
373
+
let man = [
374
+
`S Manpage.s_description;
375
+
`P "Manage vacation responses (out-of-office auto-replies) via JMAP.";
376
+
`P "Configure automatic email responses for when you're away.";
377
+
`S Manpage.s_examples;
378
+
`P "Show current vacation settings:";
379
+
`P " $(mname) -h jmap.example.com -u user@example.com -p secret123 --show";
380
+
`P "";
381
+
`P "Enable vacation response:";
382
+
`P " $(mname) -h jmap.example.com -u user@example.com -p secret123 --enable \\";
383
+
`P " --subject \"Out of Office\" \\";
384
+
`P " --message \"I am currently out of the office and will return on Monday.\"";
385
+
`P "";
386
+
`P "Enable with date range:";
387
+
`P " $(mname) -h jmap.example.com -u user@example.com -p secret123 --enable \\";
388
+
`P " --message-file vacation.txt \\";
389
+
`P " --from-date 2024-07-01 --to-date 2024-07-15";
390
+
`P "";
391
+
`P "Disable vacation response:";
392
+
`P " $(mname) -h jmap.example.com -u user@example.com -p secret123 --disable";
393
+
] in
394
+
395
+
let cmd =
396
+
Cmd.v
397
+
(Cmd.info "jmap-vacation-manager" ~version:"1.0" ~doc ~man)
398
+
Term.(const vacation_command $ host_arg $ user_arg $ password_arg $
399
+
enable_arg $ disable_arg $ show_arg $ subject_arg $ message_arg $
400
+
message_file_arg $ html_message_arg $ from_date_arg $ to_date_arg $
401
+
exclude_arg)
402
+
in
403
+
cmd
404
+
405
+
(* Main entry point *)
406
+
let () = exit (Cmd.eval' vacation_cmd)
+1
-22
dune-project
+1
-22
dune-project
···
1
-
(lang dune 3.17)
2
-
(name jmap)
3
-
4
-
(source (github avsm/jmap))
5
-
(license ISC)
6
-
(authors "Anil Madhavapeddy")
7
-
(maintainers "anil@recoil.org")
8
-
9
-
(generate_opam_files true)
10
-
11
-
(package
12
-
(name jmap)
13
-
(synopsis "JMAP protocol")
14
-
(description "This is all still a work in progress")
15
-
(depends
16
-
(ocaml (>= "5.2.0"))
17
-
ptime
18
-
cohttp
19
-
cohttp-lwt-unix
20
-
ezjsonm
21
-
uri
22
-
lwt))
1
+
(lang dune 3.17)
+15
jmap/dune
+15
jmap/dune
···
1
+
(library
2
+
(name jmap)
3
+
(public_name jmap)
4
+
(libraries yojson uri)
5
+
(modules_without_implementation jmap jmap_binary jmap_error jmap_methods
6
+
jmap_push jmap_session jmap_types jmap_wire)
7
+
(modules
8
+
jmap
9
+
jmap_types
10
+
jmap_error
11
+
jmap_wire
12
+
jmap_session
13
+
jmap_methods
14
+
jmap_binary
15
+
jmap_push))
+136
jmap/jmap.mli
+136
jmap/jmap.mli
···
1
+
(** JMAP Core Protocol Library Interface (RFC 8620)
2
+
3
+
This library provides OCaml types and function signatures for interacting
4
+
with a JMAP server according to the core protocol specification in RFC 8620.
5
+
6
+
Modules:
7
+
- {!Jmap.Types}: Basic data types (Id, Date, etc.).
8
+
- {!Jmap.Error}: Error types (ProblemDetails, MethodError, SetError).
9
+
- {!Jmap.Wire}: Request and Response structures.
10
+
- {!Jmap.Session}: Session object and discovery.
11
+
- {!Jmap.Methods}: Standard method patterns (/get, /set, etc.) and Core/echo.
12
+
- {!Jmap.Binary}: Binary data upload/download types.
13
+
- {!Jmap.Push}: Push notification types (StateChange, PushSubscription).
14
+
15
+
For email-specific extensions (RFC 8621), see the Jmap_email library.
16
+
For Unix-specific implementation, see the Jmap_unix library.
17
+
18
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html> RFC 8620: Core JMAP
19
+
*)
20
+
21
+
(** {1 Core JMAP Types and Modules} *)
22
+
23
+
module Types = Jmap_types
24
+
module Error = Jmap_error
25
+
module Wire = Jmap_wire
26
+
module Session = Jmap_session
27
+
module Methods = Jmap_methods
28
+
module Binary = Jmap_binary
29
+
module Push = Jmap_push
30
+
31
+
(** {1 Example Usage}
32
+
33
+
The following example demonstrates using the Core JMAP library with the Unix implementation
34
+
to make a simple echo request.
35
+
36
+
{[
37
+
(* OCaml 5.1 required for Lwt let operators *)
38
+
open Lwt.Syntax
39
+
open Jmap
40
+
open Jmap.Types
41
+
open Jmap.Wire
42
+
open Jmap.Methods
43
+
open Jmap.Unix
44
+
45
+
let simple_echo_request ctx session =
46
+
(* Prepare an echo invocation *)
47
+
let echo_args = Yojson.Safe.to_basic (`Assoc [
48
+
("hello", `String "world");
49
+
("array", `List [`Int 1; `Int 2; `Int 3]);
50
+
]) in
51
+
52
+
let echo_invocation = Invocation.v
53
+
~method_name:"Core/echo"
54
+
~arguments:echo_args
55
+
~method_call_id:"echo1"
56
+
()
57
+
in
58
+
59
+
(* Prepare the JMAP request *)
60
+
let request = Request.v
61
+
~using:[capability_core]
62
+
~method_calls:[echo_invocation]
63
+
()
64
+
in
65
+
66
+
(* Send the request *)
67
+
let* response = Jmap.Unix.request ctx request in
68
+
69
+
(* Process the response *)
70
+
match Wire.find_method_response response "echo1" with
71
+
| Some (method_name, args, _) when method_name = "Core/echo" ->
72
+
(* Echo response should contain the same arguments we sent *)
73
+
let hello_value = match Yojson.Safe.Util.member "hello" args with
74
+
| `String s -> s
75
+
| _ -> "not found"
76
+
in
77
+
Printf.printf "Echo response received: hello=%s\n" hello_value;
78
+
Lwt.return_unit
79
+
| _ ->
80
+
Printf.eprintf "Echo response not found or unexpected format\n";
81
+
Lwt.return_unit
82
+
83
+
let main () =
84
+
(* Authentication details are placeholder *)
85
+
let credentials = "my_auth_token" in
86
+
let* (ctx, session) = Jmap.Unix.connect ~host:"jmap.example.com" ~credentials in
87
+
let* () = simple_echo_request ctx session in
88
+
Jmap.Unix.close ctx
89
+
90
+
(* Lwt_main.run (main ()) *)
91
+
]}
92
+
*)
93
+
94
+
(** Capability URI for JMAP Core.
95
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-2> RFC 8620, Section 2 *)
96
+
val capability_core : string
97
+
98
+
(** {1 Convenience Functions} *)
99
+
100
+
(** Check if a session supports a given capability.
101
+
@param session The session object.
102
+
@param capability The capability URI to check.
103
+
@return True if supported, false otherwise.
104
+
*)
105
+
val supports_capability : Jmap_session.Session.t -> string -> bool
106
+
107
+
(** Get the primary account ID for a given capability.
108
+
@param session The session object.
109
+
@param capability The capability URI.
110
+
@return The account ID or an error if not found.
111
+
*)
112
+
val get_primary_account : Jmap_session.Session.t -> string -> (Jmap_types.id, Error.error) result
113
+
114
+
(** Get the download URL for a blob.
115
+
@param session The session object.
116
+
@param account_id The account ID.
117
+
@param blob_id The blob ID.
118
+
@param ?name Optional filename for the download.
119
+
@param ?content_type Optional content type for the download.
120
+
@return The download URL.
121
+
*)
122
+
val get_download_url :
123
+
Jmap_session.Session.t ->
124
+
account_id:Jmap_types.id ->
125
+
blob_id:Jmap_types.id ->
126
+
?name:string ->
127
+
?content_type:string ->
128
+
unit ->
129
+
Uri.t
130
+
131
+
(** Get the upload URL for a blob.
132
+
@param session The session object.
133
+
@param account_id The account ID.
134
+
@return The upload URL.
135
+
*)
136
+
val get_upload_url : Jmap_session.Session.t -> account_id:Jmap_types.id -> Uri.t
+60
jmap/jmap_binary.mli
+60
jmap/jmap_binary.mli
···
1
+
(** JMAP Binary Data Handling.
2
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-6> RFC 8620, Section 6 *)
3
+
4
+
open Jmap_types
5
+
open Jmap_error
6
+
7
+
(** Response from uploading binary data.
8
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-6.1> RFC 8620, Section 6.1 *)
9
+
module Upload_response : sig
10
+
type t
11
+
12
+
val account_id : t -> id
13
+
val blob_id : t -> id
14
+
val type_ : t -> string
15
+
val size : t -> uint
16
+
17
+
val v :
18
+
account_id:id ->
19
+
blob_id:id ->
20
+
type_:string ->
21
+
size:uint ->
22
+
unit ->
23
+
t
24
+
end
25
+
26
+
(** Arguments for Blob/copy.
27
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-6.3> RFC 8620, Section 6.3 *)
28
+
module Blob_copy_args : sig
29
+
type t
30
+
31
+
val from_account_id : t -> id
32
+
val account_id : t -> id
33
+
val blob_ids : t -> id list
34
+
35
+
val v :
36
+
from_account_id:id ->
37
+
account_id:id ->
38
+
blob_ids:id list ->
39
+
unit ->
40
+
t
41
+
end
42
+
43
+
(** Response for Blob/copy.
44
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-6.3> RFC 8620, Section 6.3 *)
45
+
module Blob_copy_response : sig
46
+
type t
47
+
48
+
val from_account_id : t -> id
49
+
val account_id : t -> id
50
+
val copied : t -> id id_map option
51
+
val not_copied : t -> Set_error.t id_map option
52
+
53
+
val v :
54
+
from_account_id:id ->
55
+
account_id:id ->
56
+
?copied:id id_map ->
57
+
?not_copied:Set_error.t id_map ->
58
+
unit ->
59
+
t
60
+
end
+189
jmap/jmap_error.mli
+189
jmap/jmap_error.mli
···
1
+
(** JMAP Error Types.
2
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.6> RFC 8620, Section 3.6 *)
3
+
4
+
open Jmap_types
5
+
6
+
(** Standard Method-level error types.
7
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.6.2> RFC 8620, Section 3.6.2 *)
8
+
type method_error_type = [
9
+
| `ServerUnavailable
10
+
| `ServerFail
11
+
| `ServerPartialFail
12
+
| `UnknownMethod
13
+
| `InvalidArguments
14
+
| `InvalidResultReference
15
+
| `Forbidden
16
+
| `AccountNotFound
17
+
| `AccountNotSupportedByMethod
18
+
| `AccountReadOnly
19
+
| `RequestTooLarge
20
+
| `CannotCalculateChanges
21
+
| `StateMismatch
22
+
| `AnchorNotFound
23
+
| `UnsupportedSort
24
+
| `UnsupportedFilter
25
+
| `TooManyChanges
26
+
| `FromAccountNotFound
27
+
| `FromAccountNotSupportedByMethod
28
+
| `Other_method_error of string
29
+
]
30
+
31
+
(** Standard SetError types.
32
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.3> RFC 8620, Section 5.3 *)
33
+
type set_error_type = [
34
+
| `Forbidden
35
+
| `OverQuota
36
+
| `TooLarge
37
+
| `RateLimit
38
+
| `NotFound
39
+
| `InvalidPatch
40
+
| `WillDestroy
41
+
| `InvalidProperties
42
+
| `Singleton
43
+
| `AlreadyExists (* From /copy *)
44
+
| `MailboxHasChild (* RFC 8621 *)
45
+
| `MailboxHasEmail (* RFC 8621 *)
46
+
| `BlobNotFound (* RFC 8621 *)
47
+
| `TooManyKeywords (* RFC 8621 *)
48
+
| `TooManyMailboxes (* RFC 8621 *)
49
+
| `InvalidEmail (* RFC 8621 *)
50
+
| `TooManyRecipients (* RFC 8621 *)
51
+
| `NoRecipients (* RFC 8621 *)
52
+
| `InvalidRecipients (* RFC 8621 *)
53
+
| `ForbiddenMailFrom (* RFC 8621 *)
54
+
| `ForbiddenFrom (* RFC 8621 *)
55
+
| `ForbiddenToSend (* RFC 8621 *)
56
+
| `CannotUnsend (* RFC 8621 *)
57
+
| `Other_set_error of string (* For future or custom errors *)
58
+
]
59
+
60
+
(** Primary error type that can represent all JMAP errors *)
61
+
type error =
62
+
| Transport of string (** Network/HTTP-level error *)
63
+
| Parse of string (** JSON parsing error *)
64
+
| Protocol of string (** JMAP protocol error *)
65
+
| Problem of string (** Problem Details object error *)
66
+
| Method of method_error_type * string option (** Method error with optional description *)
67
+
| SetItem of id * set_error_type * string option (** Error for a specific item in a /set operation *)
68
+
| Auth of string (** Authentication error *)
69
+
| ServerError of string (** Server reported an error *)
70
+
71
+
(** Standard Result type for JMAP operations *)
72
+
type 'a result = ('a, error) Result.t
73
+
74
+
(** Problem details object for HTTP-level errors.
75
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.6.1> RFC 8620, Section 3.6.1
76
+
@see <https://www.rfc-editor.org/rfc/rfc7807.html> RFC 7807 *)
77
+
module Problem_details : sig
78
+
type t
79
+
80
+
val problem_type : t -> string
81
+
val status : t -> int option
82
+
val detail : t -> string option
83
+
val limit : t -> string option
84
+
val other_fields : t -> Yojson.Safe.t string_map
85
+
86
+
val v :
87
+
?status:int ->
88
+
?detail:string ->
89
+
?limit:string ->
90
+
?other_fields:Yojson.Safe.t string_map ->
91
+
string ->
92
+
t
93
+
end
94
+
95
+
(** Description for method errors. May contain additional details.
96
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.6.2> RFC 8620, Section 3.6.2 *)
97
+
module Method_error_description : sig
98
+
type t
99
+
100
+
val description : t -> string option
101
+
102
+
val v : ?description:string -> unit -> t
103
+
end
104
+
105
+
(** Represents a method-level error response invocation part.
106
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.6.2> RFC 8620, Section 3.6.2 *)
107
+
module Method_error : sig
108
+
type t
109
+
110
+
val type_ : t -> method_error_type
111
+
val description : t -> Method_error_description.t option
112
+
113
+
val v :
114
+
?description:Method_error_description.t ->
115
+
method_error_type ->
116
+
t
117
+
end
118
+
119
+
(** SetError object.
120
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.3> RFC 8620, Section 5.3 *)
121
+
module Set_error : sig
122
+
type t
123
+
124
+
val type_ : t -> set_error_type
125
+
val description : t -> string option
126
+
val properties : t -> string list option
127
+
val existing_id : t -> id option
128
+
val max_recipients : t -> uint option
129
+
val invalid_recipients : t -> string list option
130
+
val max_size : t -> uint option
131
+
val not_found_blob_ids : t -> id list option
132
+
133
+
val v :
134
+
?description:string ->
135
+
?properties:string list ->
136
+
?existing_id:id ->
137
+
?max_recipients:uint ->
138
+
?invalid_recipients:string list ->
139
+
?max_size:uint ->
140
+
?not_found_blob_ids:id list ->
141
+
set_error_type ->
142
+
t
143
+
end
144
+
145
+
(** {2 Error Handling Functions} *)
146
+
147
+
(** Create a transport error *)
148
+
val transport_error : string -> error
149
+
150
+
(** Create a parse error *)
151
+
val parse_error : string -> error
152
+
153
+
(** Create a protocol error *)
154
+
val protocol_error : string -> error
155
+
156
+
(** Create a problem details error *)
157
+
val problem_error : Problem_details.t -> error
158
+
159
+
(** Create a method error *)
160
+
val method_error : ?description:string -> method_error_type -> error
161
+
162
+
(** Create a SetItem error *)
163
+
val set_item_error : id -> ?description:string -> set_error_type -> error
164
+
165
+
(** Create an auth error *)
166
+
val auth_error : string -> error
167
+
168
+
(** Create a server error *)
169
+
val server_error : string -> error
170
+
171
+
(** Convert a Method_error.t to error *)
172
+
val of_method_error : Method_error.t -> error
173
+
174
+
(** Convert a Set_error.t to error for a specific ID *)
175
+
val of_set_error : id -> Set_error.t -> error
176
+
177
+
(** Get a human-readable description of an error *)
178
+
val error_to_string : error -> string
179
+
180
+
(** {2 Result Handling} *)
181
+
182
+
(** Map an error with additional context *)
183
+
val map_error : 'a result -> (error -> error) -> 'a result
184
+
185
+
(** Add context to an error *)
186
+
val with_context : 'a result -> string -> 'a result
187
+
188
+
(** Convert an option to a result with an error for None *)
189
+
val of_option : 'a option -> error -> 'a result
+417
jmap/jmap_methods.mli
+417
jmap/jmap_methods.mli
···
1
+
(** Standard JMAP Methods and Core/echo.
2
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-4> RFC 8620, Section 4
3
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5> RFC 8620, Section 5 *)
4
+
5
+
open Jmap_types
6
+
open Jmap_error
7
+
8
+
(** Generic representation of a record type. Actual types defined elsewhere. *)
9
+
type generic_record
10
+
11
+
(** Arguments for /get methods.
12
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.1> RFC 8620, Section 5.1 *)
13
+
module Get_args : sig
14
+
type 'record t
15
+
16
+
val account_id : 'record t -> id
17
+
val ids : 'record t -> id list option
18
+
val properties : 'record t -> string list option
19
+
20
+
val v :
21
+
account_id:id ->
22
+
?ids:id list ->
23
+
?properties:string list ->
24
+
unit ->
25
+
'record t
26
+
end
27
+
28
+
(** Response for /get methods.
29
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.1> RFC 8620, Section 5.1 *)
30
+
module Get_response : sig
31
+
type 'record t
32
+
33
+
val account_id : 'record t -> id
34
+
val state : 'record t -> string
35
+
val list : 'record t -> 'record list
36
+
val not_found : 'record t -> id list
37
+
38
+
val v :
39
+
account_id:id ->
40
+
state:string ->
41
+
list:'record list ->
42
+
not_found:id list ->
43
+
unit ->
44
+
'record t
45
+
end
46
+
47
+
(** Arguments for /changes methods.
48
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.2> RFC 8620, Section 5.2 *)
49
+
module Changes_args : sig
50
+
type t
51
+
52
+
val account_id : t -> id
53
+
val since_state : t -> string
54
+
val max_changes : t -> uint option
55
+
56
+
val v :
57
+
account_id:id ->
58
+
since_state:string ->
59
+
?max_changes:uint ->
60
+
unit ->
61
+
t
62
+
end
63
+
64
+
(** Response for /changes methods.
65
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.2> RFC 8620, Section 5.2 *)
66
+
module Changes_response : sig
67
+
type t
68
+
69
+
val account_id : t -> id
70
+
val old_state : t -> string
71
+
val new_state : t -> string
72
+
val has_more_changes : t -> bool
73
+
val created : t -> id list
74
+
val updated : t -> id list
75
+
val destroyed : t -> id list
76
+
val updated_properties : t -> string list option
77
+
78
+
val v :
79
+
account_id:id ->
80
+
old_state:string ->
81
+
new_state:string ->
82
+
has_more_changes:bool ->
83
+
created:id list ->
84
+
updated:id list ->
85
+
destroyed:id list ->
86
+
?updated_properties:string list ->
87
+
unit ->
88
+
t
89
+
end
90
+
91
+
(** Patch object for /set update.
92
+
A list of (JSON Pointer path, value) pairs.
93
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.3> RFC 8620, Section 5.3 *)
94
+
type patch_object = (json_pointer * Yojson.Safe.t) list
95
+
96
+
(** Arguments for /set methods.
97
+
['create_record] is the record type without server-set/immutable fields.
98
+
['update_record] is the patch object type (usually [patch_object]).
99
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.3> RFC 8620, Section 5.3 *)
100
+
module Set_args : sig
101
+
type ('create_record, 'update_record) t
102
+
103
+
val account_id : ('a, 'b) t -> id
104
+
val if_in_state : ('a, 'b) t -> string option
105
+
val create : ('a, 'b) t -> 'a id_map option
106
+
val update : ('a, 'b) t -> 'b id_map option
107
+
val destroy : ('a, 'b) t -> id list option
108
+
val on_success_destroy_original : ('a, 'b) t -> bool option
109
+
val destroy_from_if_in_state : ('a, 'b) t -> string option
110
+
val on_destroy_remove_emails : ('a, 'b) t -> bool option
111
+
112
+
val v :
113
+
account_id:id ->
114
+
?if_in_state:string ->
115
+
?create:'a id_map ->
116
+
?update:'b id_map ->
117
+
?destroy:id list ->
118
+
?on_success_destroy_original:bool ->
119
+
?destroy_from_if_in_state:string ->
120
+
?on_destroy_remove_emails:bool ->
121
+
unit ->
122
+
('a, 'b) t
123
+
end
124
+
125
+
(** Response for /set methods.
126
+
['created_record_info] is the server-set info for created records.
127
+
['updated_record_info] is the server-set/computed info for updated records.
128
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.3> RFC 8620, Section 5.3 *)
129
+
module Set_response : sig
130
+
type ('created_record_info, 'updated_record_info) t
131
+
132
+
val account_id : ('a, 'b) t -> id
133
+
val old_state : ('a, 'b) t -> string option
134
+
val new_state : ('a, 'b) t -> string
135
+
val created : ('a, 'b) t -> 'a id_map option
136
+
val updated : ('a, 'b) t -> 'b option id_map option
137
+
val destroyed : ('a, 'b) t -> id list option
138
+
val not_created : ('a, 'b) t -> Set_error.t id_map option
139
+
val not_updated : ('a, 'b) t -> Set_error.t id_map option
140
+
val not_destroyed : ('a, 'b) t -> Set_error.t id_map option
141
+
142
+
val v :
143
+
account_id:id ->
144
+
?old_state:string ->
145
+
new_state:string ->
146
+
?created:'a id_map ->
147
+
?updated:'b option id_map ->
148
+
?destroyed:id list ->
149
+
?not_created:Set_error.t id_map ->
150
+
?not_updated:Set_error.t id_map ->
151
+
?not_destroyed:Set_error.t id_map ->
152
+
unit ->
153
+
('a, 'b) t
154
+
end
155
+
156
+
(** Arguments for /copy methods.
157
+
['copy_record_override] contains the record id and override properties.
158
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.4> RFC 8620, Section 5.4 *)
159
+
module Copy_args : sig
160
+
type 'copy_record_override t
161
+
162
+
val from_account_id : 'a t -> id
163
+
val if_from_in_state : 'a t -> string option
164
+
val account_id : 'a t -> id
165
+
val if_in_state : 'a t -> string option
166
+
val create : 'a t -> 'a id_map
167
+
val on_success_destroy_original : 'a t -> bool
168
+
val destroy_from_if_in_state : 'a t -> string option
169
+
170
+
val v :
171
+
from_account_id:id ->
172
+
?if_from_in_state:string ->
173
+
account_id:id ->
174
+
?if_in_state:string ->
175
+
create:'a id_map ->
176
+
?on_success_destroy_original:bool ->
177
+
?destroy_from_if_in_state:string ->
178
+
unit ->
179
+
'a t
180
+
end
181
+
182
+
(** Response for /copy methods.
183
+
['created_record_info] is the server-set info for the created copy.
184
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.4> RFC 8620, Section 5.4 *)
185
+
module Copy_response : sig
186
+
type 'created_record_info t
187
+
188
+
val from_account_id : 'a t -> id
189
+
val account_id : 'a t -> id
190
+
val old_state : 'a t -> string option
191
+
val new_state : 'a t -> string
192
+
val created : 'a t -> 'a id_map option
193
+
val not_created : 'a t -> Set_error.t id_map option
194
+
195
+
val v :
196
+
from_account_id:id ->
197
+
account_id:id ->
198
+
?old_state:string ->
199
+
new_state:string ->
200
+
?created:'a id_map ->
201
+
?not_created:Set_error.t id_map ->
202
+
unit ->
203
+
'a t
204
+
end
205
+
206
+
(** Module for generic filter representation.
207
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.5> RFC 8620, Section 5.5 *)
208
+
module Filter : sig
209
+
type t
210
+
211
+
(** Create a filter from a raw JSON condition *)
212
+
val condition : Yojson.Safe.t -> t
213
+
214
+
(** Create a filter with a logical operator (AND, OR, NOT) *)
215
+
val operator : [ `AND | `OR | `NOT ] -> t list -> t
216
+
217
+
(** Combine filters with AND *)
218
+
val and_ : t list -> t
219
+
220
+
(** Combine filters with OR *)
221
+
val or_ : t list -> t
222
+
223
+
(** Negate a filter with NOT *)
224
+
val not_ : t -> t
225
+
226
+
(** Convert a filter to JSON *)
227
+
val to_json : t -> Yojson.Safe.t
228
+
229
+
(** Predefined filter helpers *)
230
+
231
+
(** Create a filter for a text property containing a string *)
232
+
val text_contains : string -> string -> t
233
+
234
+
(** Create a filter for a property being equal to a value *)
235
+
val property_equals : string -> Yojson.Safe.t -> t
236
+
237
+
(** Create a filter for a property being not equal to a value *)
238
+
val property_not_equals : string -> Yojson.Safe.t -> t
239
+
240
+
(** Create a filter for a property being greater than a value *)
241
+
val property_gt : string -> Yojson.Safe.t -> t
242
+
243
+
(** Create a filter for a property being greater than or equal to a value *)
244
+
val property_ge : string -> Yojson.Safe.t -> t
245
+
246
+
(** Create a filter for a property being less than a value *)
247
+
val property_lt : string -> Yojson.Safe.t -> t
248
+
249
+
(** Create a filter for a property being less than or equal to a value *)
250
+
val property_le : string -> Yojson.Safe.t -> t
251
+
252
+
(** Create a filter for a property value being in a list *)
253
+
val property_in : string -> Yojson.Safe.t list -> t
254
+
255
+
(** Create a filter for a property value not being in a list *)
256
+
val property_not_in : string -> Yojson.Safe.t list -> t
257
+
258
+
(** Create a filter for a property being present (not null) *)
259
+
val property_exists : string -> t
260
+
261
+
(** Create a filter for a string property starting with a prefix *)
262
+
val string_starts_with : string -> string -> t
263
+
264
+
(** Create a filter for a string property ending with a suffix *)
265
+
val string_ends_with : string -> string -> t
266
+
end
267
+
268
+
269
+
270
+
(** Comparator for sorting.
271
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.5> RFC 8620, Section 5.5 *)
272
+
module Comparator : sig
273
+
type t
274
+
275
+
val property : t -> string
276
+
val is_ascending : t -> bool option
277
+
val collation : t -> string option
278
+
val keyword : t -> string option
279
+
val other_fields : t -> Yojson.Safe.t string_map
280
+
281
+
val v :
282
+
property:string ->
283
+
?is_ascending:bool ->
284
+
?collation:string ->
285
+
?keyword:string ->
286
+
?other_fields:Yojson.Safe.t string_map ->
287
+
unit ->
288
+
t
289
+
end
290
+
291
+
(** Arguments for /query methods.
292
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.5> RFC 8620, Section 5.5 *)
293
+
module Query_args : sig
294
+
type t
295
+
296
+
val account_id : t -> id
297
+
val filter : t -> Filter.t option
298
+
val sort : t -> Comparator.t list option
299
+
val position : t -> jint option
300
+
val anchor : t -> id option
301
+
val anchor_offset : t -> jint option
302
+
val limit : t -> uint option
303
+
val calculate_total : t -> bool option
304
+
val collapse_threads : t -> bool option
305
+
val sort_as_tree : t -> bool option
306
+
val filter_as_tree : t -> bool option
307
+
308
+
val v :
309
+
account_id:id ->
310
+
?filter:Filter.t ->
311
+
?sort:Comparator.t list ->
312
+
?position:jint ->
313
+
?anchor:id ->
314
+
?anchor_offset:jint ->
315
+
?limit:uint ->
316
+
?calculate_total:bool ->
317
+
?collapse_threads:bool ->
318
+
?sort_as_tree:bool ->
319
+
?filter_as_tree:bool ->
320
+
unit ->
321
+
t
322
+
end
323
+
324
+
(** Response for /query methods.
325
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.5> RFC 8620, Section 5.5 *)
326
+
module Query_response : sig
327
+
type t
328
+
329
+
val account_id : t -> id
330
+
val query_state : t -> string
331
+
val can_calculate_changes : t -> bool
332
+
val position : t -> uint
333
+
val ids : t -> id list
334
+
val total : t -> uint option
335
+
val limit : t -> uint option
336
+
337
+
val v :
338
+
account_id:id ->
339
+
query_state:string ->
340
+
can_calculate_changes:bool ->
341
+
position:uint ->
342
+
ids:id list ->
343
+
?total:uint ->
344
+
?limit:uint ->
345
+
unit ->
346
+
t
347
+
end
348
+
349
+
(** Item indicating an added record in /queryChanges.
350
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.6> RFC 8620, Section 5.6 *)
351
+
module Added_item : sig
352
+
type t
353
+
354
+
val id : t -> id
355
+
val index : t -> uint
356
+
357
+
val v :
358
+
id:id ->
359
+
index:uint ->
360
+
unit ->
361
+
t
362
+
end
363
+
364
+
(** Arguments for /queryChanges methods.
365
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.6> RFC 8620, Section 5.6 *)
366
+
module Query_changes_args : sig
367
+
type t
368
+
369
+
val account_id : t -> id
370
+
val filter : t -> Filter.t option
371
+
val sort : t -> Comparator.t list option
372
+
val since_query_state : t -> string
373
+
val max_changes : t -> uint option
374
+
val up_to_id : t -> id option
375
+
val calculate_total : t -> bool option
376
+
val collapse_threads : t -> bool option
377
+
378
+
val v :
379
+
account_id:id ->
380
+
?filter:Filter.t ->
381
+
?sort:Comparator.t list ->
382
+
since_query_state:string ->
383
+
?max_changes:uint ->
384
+
?up_to_id:id ->
385
+
?calculate_total:bool ->
386
+
?collapse_threads:bool ->
387
+
unit ->
388
+
t
389
+
end
390
+
391
+
(** Response for /queryChanges methods.
392
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-5.6> RFC 8620, Section 5.6 *)
393
+
module Query_changes_response : sig
394
+
type t
395
+
396
+
val account_id : t -> id
397
+
val old_query_state : t -> string
398
+
val new_query_state : t -> string
399
+
val total : t -> uint option
400
+
val removed : t -> id list
401
+
val added : t -> Added_item.t list
402
+
403
+
val v :
404
+
account_id:id ->
405
+
old_query_state:string ->
406
+
new_query_state:string ->
407
+
?total:uint ->
408
+
removed:id list ->
409
+
added:Added_item.t list ->
410
+
unit ->
411
+
t
412
+
end
413
+
414
+
(** Core/echo method: Arguments are mirrored in the response.
415
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-4> RFC 8620, Section 4 *)
416
+
type core_echo_args = Yojson.Safe.t
417
+
type core_echo_response = Yojson.Safe.t
+230
jmap/jmap_push.mli
+230
jmap/jmap_push.mli
···
1
+
(** JMAP Push Notifications.
2
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7> RFC 8620, Section 7 *)
3
+
4
+
open Jmap_types
5
+
open Jmap_methods
6
+
open Jmap_error
7
+
8
+
(** TypeState object map (TypeName -> StateString).
9
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.1> RFC 8620, Section 7.1 *)
10
+
type type_state = string string_map
11
+
12
+
(** StateChange object.
13
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.1> RFC 8620, Section 7.1 *)
14
+
module State_change : sig
15
+
type t
16
+
17
+
val changed : t -> type_state id_map
18
+
19
+
val v :
20
+
changed:type_state id_map ->
21
+
unit ->
22
+
t
23
+
end
24
+
25
+
(** PushSubscription encryption keys.
26
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.2> RFC 8620, Section 7.2 *)
27
+
module Push_encryption_keys : sig
28
+
type t
29
+
30
+
(** P-256 ECDH public key (URL-safe base64) *)
31
+
val p256dh : t -> string
32
+
33
+
(** Authentication secret (URL-safe base64) *)
34
+
val auth : t -> string
35
+
36
+
val v :
37
+
p256dh:string ->
38
+
auth:string ->
39
+
unit ->
40
+
t
41
+
end
42
+
43
+
(** PushSubscription object.
44
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.2> RFC 8620, Section 7.2 *)
45
+
module Push_subscription : sig
46
+
type t
47
+
48
+
(** Id of the subscription (server-set, immutable) *)
49
+
val id : t -> id
50
+
51
+
(** Device client id (immutable) *)
52
+
val device_client_id : t -> string
53
+
54
+
(** Notification URL (immutable) *)
55
+
val url : t -> Uri.t
56
+
57
+
(** Encryption keys (immutable) *)
58
+
val keys : t -> Push_encryption_keys.t option
59
+
val verification_code : t -> string option
60
+
val expires : t -> utc_date option
61
+
val types : t -> string list option
62
+
63
+
val v :
64
+
id:id ->
65
+
device_client_id:string ->
66
+
url:Uri.t ->
67
+
?keys:Push_encryption_keys.t ->
68
+
?verification_code:string ->
69
+
?expires:utc_date ->
70
+
?types:string list ->
71
+
unit ->
72
+
t
73
+
end
74
+
75
+
(** PushSubscription object for creation (omits server-set fields).
76
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.2> RFC 8620, Section 7.2 *)
77
+
module Push_subscription_create : sig
78
+
type t
79
+
80
+
val device_client_id : t -> string
81
+
val url : t -> Uri.t
82
+
val keys : t -> Push_encryption_keys.t option
83
+
val expires : t -> utc_date option
84
+
val types : t -> string list option
85
+
86
+
val v :
87
+
device_client_id:string ->
88
+
url:Uri.t ->
89
+
?keys:Push_encryption_keys.t ->
90
+
?expires:utc_date ->
91
+
?types:string list ->
92
+
unit ->
93
+
t
94
+
end
95
+
96
+
(** PushSubscription object for update patch.
97
+
Only verification_code and expires can be updated.
98
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.2> RFC 8620, Section 7.2
99
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.2.2> RFC 8620, Section 7.2.2 *)
100
+
type push_subscription_update = patch_object
101
+
102
+
(** Arguments for PushSubscription/get.
103
+
Extends standard /get args.
104
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.2.1> RFC 8620, Section 7.2.1 *)
105
+
module Push_subscription_get_args : sig
106
+
type t
107
+
108
+
val ids : t -> id list option
109
+
val properties : t -> string list option
110
+
111
+
val v :
112
+
?ids:id list ->
113
+
?properties:string list ->
114
+
unit ->
115
+
t
116
+
end
117
+
118
+
(** Response for PushSubscription/get.
119
+
Extends standard /get response.
120
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.2.1> RFC 8620, Section 7.2.1 *)
121
+
module Push_subscription_get_response : sig
122
+
type t
123
+
124
+
val list : t -> Push_subscription.t list
125
+
val not_found : t -> id list
126
+
127
+
val v :
128
+
list:Push_subscription.t list ->
129
+
not_found:id list ->
130
+
unit ->
131
+
t
132
+
end
133
+
134
+
(** Arguments for PushSubscription/set.
135
+
Extends standard /set args.
136
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.2.2> RFC 8620, Section 7.2.2 *)
137
+
module Push_subscription_set_args : sig
138
+
type t
139
+
140
+
val create : t -> Push_subscription_create.t id_map option
141
+
val update : t -> push_subscription_update id_map option
142
+
val destroy : t -> id list option
143
+
144
+
val v :
145
+
?create:Push_subscription_create.t id_map ->
146
+
?update:push_subscription_update id_map ->
147
+
?destroy:id list ->
148
+
unit ->
149
+
t
150
+
end
151
+
152
+
(** Server-set information for created PushSubscription.
153
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.2.2> RFC 8620, Section 7.2.2 *)
154
+
module Push_subscription_created_info : sig
155
+
type t
156
+
157
+
val id : t -> id
158
+
val expires : t -> utc_date option
159
+
160
+
val v :
161
+
id:id ->
162
+
?expires:utc_date ->
163
+
unit ->
164
+
t
165
+
end
166
+
167
+
(** Server-set information for updated PushSubscription.
168
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.2.2> RFC 8620, Section 7.2.2 *)
169
+
module Push_subscription_updated_info : sig
170
+
type t
171
+
172
+
val expires : t -> utc_date option
173
+
174
+
val v :
175
+
?expires:utc_date ->
176
+
unit ->
177
+
t
178
+
end
179
+
180
+
(** Response for PushSubscription/set.
181
+
Extends standard /set response.
182
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.2.2> RFC 8620, Section 7.2.2 *)
183
+
module Push_subscription_set_response : sig
184
+
type t
185
+
186
+
val created : t -> Push_subscription_created_info.t id_map option
187
+
val updated : t -> Push_subscription_updated_info.t option id_map option
188
+
val destroyed : t -> id list option
189
+
val not_created : t -> Set_error.t id_map option
190
+
val not_updated : t -> Set_error.t id_map option
191
+
val not_destroyed : t -> Set_error.t id_map option
192
+
193
+
val v :
194
+
?created:Push_subscription_created_info.t id_map ->
195
+
?updated:Push_subscription_updated_info.t option id_map ->
196
+
?destroyed:id list ->
197
+
?not_created:Set_error.t id_map ->
198
+
?not_updated:Set_error.t id_map ->
199
+
?not_destroyed:Set_error.t id_map ->
200
+
unit ->
201
+
t
202
+
end
203
+
204
+
(** PushVerification object.
205
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.2.2> RFC 8620, Section 7.2.2 *)
206
+
module Push_verification : sig
207
+
type t
208
+
209
+
val push_subscription_id : t -> id
210
+
val verification_code : t -> string
211
+
212
+
val v :
213
+
push_subscription_id:id ->
214
+
verification_code:string ->
215
+
unit ->
216
+
t
217
+
end
218
+
219
+
(** Data for EventSource ping event.
220
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.3> RFC 8620, Section 7.3 *)
221
+
module Event_source_ping_data : sig
222
+
type t
223
+
224
+
val interval : t -> uint
225
+
226
+
val v :
227
+
interval:uint ->
228
+
unit ->
229
+
t
230
+
end
+98
jmap/jmap_session.mli
+98
jmap/jmap_session.mli
···
1
+
(** JMAP Session Resource.
2
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-2> RFC 8620, Section 2 *)
3
+
4
+
open Jmap_types
5
+
6
+
(** Account capability information.
7
+
The value is capability-specific.
8
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-2> RFC 8620, Section 2 *)
9
+
type account_capability_value = Yojson.Safe.t
10
+
11
+
(** Server capability information.
12
+
The value is capability-specific.
13
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-2> RFC 8620, Section 2 *)
14
+
type server_capability_value = Yojson.Safe.t
15
+
16
+
(** Core capability information.
17
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-2> RFC 8620, Section 2 *)
18
+
module Core_capability : sig
19
+
type t
20
+
21
+
val max_size_upload : t -> uint
22
+
val max_concurrent_upload : t -> uint
23
+
val max_size_request : t -> uint
24
+
val max_concurrent_requests : t -> uint
25
+
val max_calls_in_request : t -> uint
26
+
val max_objects_in_get : t -> uint
27
+
val max_objects_in_set : t -> uint
28
+
val collation_algorithms : t -> string list
29
+
30
+
val v :
31
+
max_size_upload:uint ->
32
+
max_concurrent_upload:uint ->
33
+
max_size_request:uint ->
34
+
max_concurrent_requests:uint ->
35
+
max_calls_in_request:uint ->
36
+
max_objects_in_get:uint ->
37
+
max_objects_in_set:uint ->
38
+
collation_algorithms:string list ->
39
+
unit ->
40
+
t
41
+
end
42
+
43
+
(** An Account object.
44
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-2> RFC 8620, Section 2 *)
45
+
module Account : sig
46
+
type t
47
+
48
+
val name : t -> string
49
+
val is_personal : t -> bool
50
+
val is_read_only : t -> bool
51
+
val account_capabilities : t -> account_capability_value string_map
52
+
53
+
val v :
54
+
name:string ->
55
+
?is_personal:bool ->
56
+
?is_read_only:bool ->
57
+
?account_capabilities:account_capability_value string_map ->
58
+
unit ->
59
+
t
60
+
end
61
+
62
+
(** The Session object.
63
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-2> RFC 8620, Section 2 *)
64
+
module Session : sig
65
+
type t
66
+
67
+
val capabilities : t -> server_capability_value string_map
68
+
val accounts : t -> Account.t id_map
69
+
val primary_accounts : t -> id string_map
70
+
val username : t -> string
71
+
val api_url : t -> Uri.t
72
+
val download_url : t -> Uri.t
73
+
val upload_url : t -> Uri.t
74
+
val event_source_url : t -> Uri.t
75
+
val state : t -> string
76
+
77
+
val v :
78
+
capabilities:server_capability_value string_map ->
79
+
accounts:Account.t id_map ->
80
+
primary_accounts:id string_map ->
81
+
username:string ->
82
+
api_url:Uri.t ->
83
+
download_url:Uri.t ->
84
+
upload_url:Uri.t ->
85
+
event_source_url:Uri.t ->
86
+
state:string ->
87
+
unit ->
88
+
t
89
+
end
90
+
91
+
(** Function to perform service autodiscovery.
92
+
Returns the session URL if found.
93
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-2.2> RFC 8620, Section 2.2 *)
94
+
val discover : domain:string -> Uri.t option
95
+
96
+
(** Function to fetch the session object from a given URL.
97
+
Requires authentication handling (details TBD/outside this signature). *)
98
+
val get_session : url:Uri.t -> Session.t
+38
jmap/jmap_types.mli
+38
jmap/jmap_types.mli
···
1
+
(** Basic JMAP types as defined in RFC 8620. *)
2
+
3
+
(** The Id data type.
4
+
A string of 1 to 255 octets, using URL-safe base64 characters.
5
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.2> RFC 8620, Section 1.2 *)
6
+
type id = string
7
+
8
+
(** The Int data type.
9
+
An integer in the range [-2^53+1, 2^53-1]. Represented as OCaml's standard [int].
10
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.3> RFC 8620, Section 1.3 *)
11
+
type jint = int
12
+
13
+
(** The UnsignedInt data type.
14
+
An integer in the range [0, 2^53-1]. Represented as OCaml's standard [int].
15
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.3> RFC 8620, Section 1.3 *)
16
+
type uint = int
17
+
18
+
(** The Date data type.
19
+
A string in RFC 3339 "date-time" format.
20
+
Represented as a float using Unix time.
21
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.4> RFC 8620, Section 1.4 *)
22
+
type date = float
23
+
24
+
(** The UTCDate data type.
25
+
A string in RFC 3339 "date-time" format, restricted to UTC (Z timezone).
26
+
Represented as a float using Unix time.
27
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-1.4> RFC 8620, Section 1.4 *)
28
+
type utc_date = float
29
+
30
+
(** Represents a JSON object used as a map String -> V. *)
31
+
type 'v string_map = (string, 'v) Hashtbl.t
32
+
33
+
(** Represents a JSON object used as a map Id -> V. *)
34
+
type 'v id_map = (id, 'v) Hashtbl.t
35
+
36
+
(** Represents a JSON Pointer path with JMAP extensions.
37
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.7> RFC 8620, Section 3.7 *)
38
+
type json_pointer = string
+80
jmap/jmap_wire.mli
+80
jmap/jmap_wire.mli
···
1
+
(** JMAP Wire Protocol Structures (Request/Response). *)
2
+
3
+
open Jmap_types
4
+
5
+
(** An invocation tuple within a request or response.
6
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.2> RFC 8620, Section 3.2 *)
7
+
module Invocation : sig
8
+
type t
9
+
10
+
val method_name : t -> string
11
+
val arguments : t -> Yojson.Safe.t
12
+
val method_call_id : t -> string
13
+
14
+
val v :
15
+
?arguments:Yojson.Safe.t ->
16
+
method_name:string ->
17
+
method_call_id:string ->
18
+
unit ->
19
+
t
20
+
end
21
+
22
+
(** Method error type with context.
23
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.6.2> RFC 8620, Section 3.6.2 *)
24
+
type method_error = Jmap_error.Method_error.t * string
25
+
26
+
(** A response invocation part, which can be a standard response or an error.
27
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.4> RFC 8620, Section 3.4
28
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.6.2> RFC 8620, Section 3.6.2 *)
29
+
type response_invocation = (Invocation.t, method_error) result
30
+
31
+
(** A reference to a previous method call's result.
32
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.7> RFC 8620, Section 3.7 *)
33
+
module Result_reference : sig
34
+
type t
35
+
36
+
val result_of : t -> string
37
+
val name : t -> string
38
+
val path : t -> json_pointer
39
+
40
+
val v :
41
+
result_of:string ->
42
+
name:string ->
43
+
path:json_pointer ->
44
+
unit ->
45
+
t
46
+
end
47
+
48
+
(** The Request object.
49
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.3> RFC 8620, Section 3.3 *)
50
+
module Request : sig
51
+
type t
52
+
53
+
val using : t -> string list
54
+
val method_calls : t -> Invocation.t list
55
+
val created_ids : t -> id id_map option
56
+
57
+
val v :
58
+
using:string list ->
59
+
method_calls:Invocation.t list ->
60
+
?created_ids:id id_map ->
61
+
unit ->
62
+
t
63
+
end
64
+
65
+
(** The Response object.
66
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-3.4> RFC 8620, Section 3.4 *)
67
+
module Response : sig
68
+
type t
69
+
70
+
val method_responses : t -> response_invocation list
71
+
val created_ids : t -> id id_map option
72
+
val session_state : t -> string
73
+
74
+
val v :
75
+
method_responses:response_invocation list ->
76
+
?created_ids:id id_map ->
77
+
session_state:string ->
78
+
unit ->
79
+
t
80
+
end
+15
jmap-email/dune
+15
jmap-email/dune
···
1
+
(library
2
+
(name jmap_email)
3
+
(public_name jmap-email)
4
+
(libraries jmap yojson uri)
5
+
(modules_without_implementation jmap_email jmap_email_types jmap_identity
6
+
jmap_mailbox jmap_search_snippet jmap_submission jmap_thread jmap_vacation)
7
+
(modules
8
+
jmap_email
9
+
jmap_email_types
10
+
jmap_mailbox
11
+
jmap_thread
12
+
jmap_search_snippet
13
+
jmap_identity
14
+
jmap_submission
15
+
jmap_vacation))
+503
jmap-email/jmap_email.mli
+503
jmap-email/jmap_email.mli
···
1
+
(** JMAP Mail Extension Library (RFC 8621).
2
+
3
+
This library extends the core JMAP protocol with email-specific
4
+
functionality as defined in RFC 8621. It provides types and signatures
5
+
for interacting with JMAP Mail data types: Mailbox, Thread, Email,
6
+
SearchSnippet, Identity, EmailSubmission, and VacationResponse.
7
+
8
+
Requires the core Jmap library and Jmap_unix library for network operations.
9
+
10
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html> RFC 8621: JMAP for Mail
11
+
*)
12
+
13
+
open Jmap.Types
14
+
15
+
(** {1 Core Types} *)
16
+
module Types = Jmap_email_types
17
+
18
+
(** {1 Mailbox}
19
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-2> RFC 8621, Section 2 *)
20
+
module Mailbox = Jmap_mailbox
21
+
22
+
(** {1 Thread}
23
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-3> RFC 8621, Section 3 *)
24
+
module Thread = Jmap_thread
25
+
26
+
(** {1 Search Snippet}
27
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-5> RFC 8621, Section 5 *)
28
+
module SearchSnippet = Jmap_search_snippet
29
+
30
+
(** {1 Identity}
31
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-6> RFC 8621, Section 6 *)
32
+
module Identity = Jmap_identity
33
+
34
+
(** {1 Email Submission}
35
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-7> RFC 8621, Section 7 *)
36
+
module Submission = Jmap_submission
37
+
38
+
(** {1 Vacation Response}
39
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-8> RFC 8621, Section 8 *)
40
+
module Vacation = Jmap_vacation
41
+
42
+
(** {1 Example Usage}
43
+
44
+
The following example demonstrates using the JMAP Email library to fetch unread emails
45
+
from a specific sender.
46
+
47
+
{[
48
+
(* OCaml 5.1 required for Lwt let operators *)
49
+
open Lwt.Syntax
50
+
open Jmap
51
+
open Jmap.Types
52
+
open Jmap.Wire
53
+
open Jmap.Methods
54
+
open Jmap_email
55
+
open Jmap.Unix
56
+
57
+
let list_unread_from_sender ctx session sender_email =
58
+
(* Find the primary mail account *)
59
+
let primary_mail_account_id =
60
+
Hashtbl.find session.primary_accounts capability_mail
61
+
in
62
+
(* Construct the filter *)
63
+
let filter : filter =
64
+
Filter_operator (Filter_operator.v
65
+
~operator:`AND
66
+
~conditions:[
67
+
Filter_condition (Yojson.Safe.to_basic (`Assoc [
68
+
("from", `String sender_email);
69
+
]));
70
+
Filter_condition (Yojson.Safe.to_basic (`Assoc [
71
+
("hasKeyword", `String keyword_seen);
72
+
("value", `Bool false);
73
+
]));
74
+
]
75
+
())
76
+
in
77
+
(* Prepare the Email/query invocation *)
78
+
let query_args = Query_args.v
79
+
~account_id:primary_mail_account_id
80
+
~filter
81
+
~sort:[
82
+
Comparator.v
83
+
~property:"receivedAt"
84
+
~is_ascending:false
85
+
()
86
+
]
87
+
~position:0
88
+
~limit:20 (* Get latest 20 *)
89
+
~calculate_total:false
90
+
~collapse_threads:false
91
+
()
92
+
in
93
+
let query_invocation = Invocation.v
94
+
~method_name:"Email/query"
95
+
~arguments:(* Yojson conversion of query_args needed here *)
96
+
~method_call_id:"q1"
97
+
()
98
+
in
99
+
100
+
(* Prepare the Email/get invocation using a back-reference *)
101
+
let get_args = Get_args.v
102
+
~account_id:primary_mail_account_id
103
+
~properties:["id"; "subject"; "receivedAt"; "from"]
104
+
()
105
+
in
106
+
let get_invocation = Invocation.v
107
+
~method_name:"Email/get"
108
+
~arguments:(* Yojson conversion of get_args, with ids replaced by a ResultReference to q1 needed here *)
109
+
~method_call_id:"g1"
110
+
()
111
+
in
112
+
113
+
(* Prepare the JMAP request *)
114
+
let request = Request.v
115
+
~using:[ Jmap.capability_core; capability_mail ]
116
+
~method_calls:[ query_invocation; get_invocation ]
117
+
()
118
+
in
119
+
120
+
(* Send the request *)
121
+
let* response = Jmap.Unix.request ctx request in
122
+
123
+
(* Process the response (extract Email/get results) *)
124
+
(* ... Omitted: find the Email/get response in response.method_responses ... *)
125
+
Lwt.return_unit
126
+
]}
127
+
*)
128
+
129
+
(** Capability URI for JMAP Mail.
130
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-1.3.1> RFC 8621, Section 1.3.1 *)
131
+
val capability_mail : string
132
+
133
+
(** Capability URI for JMAP Submission.
134
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-1.3.2> RFC 8621, Section 1.3.2 *)
135
+
val capability_submission : string
136
+
137
+
(** Capability URI for JMAP Vacation Response.
138
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-1.3.3> RFC 8621, Section 1.3.3 *)
139
+
val capability_vacationresponse : string
140
+
141
+
(** Type name for EmailDelivery push notifications.
142
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-1.5> RFC 8621, Section 1.5 *)
143
+
val push_event_type_email_delivery : string
144
+
145
+
(** Keyword string constants for JMAP email flags.
146
+
Provides easy access to standardized keyword string values.
147
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1.1> RFC 8621, Section 4.1.1 *)
148
+
module Keyword : sig
149
+
(** {1 IMAP System Flags} *)
150
+
151
+
(** "$draft": The Email is a draft the user is composing *)
152
+
val draft : string
153
+
154
+
(** "$seen": The Email has been read *)
155
+
val seen : string
156
+
157
+
(** "$flagged": The Email has been flagged for urgent/special attention *)
158
+
val flagged : string
159
+
160
+
(** "$answered": The Email has been replied to *)
161
+
val answered : string
162
+
163
+
(** {1 Common Extension Keywords} *)
164
+
165
+
(** "$forwarded": The Email has been forwarded *)
166
+
val forwarded : string
167
+
168
+
(** "$phishing": The Email is likely to be phishing *)
169
+
val phishing : string
170
+
171
+
(** "$junk": The Email is spam/junk *)
172
+
val junk : string
173
+
174
+
(** "$notjunk": The Email is explicitly marked as not spam/junk *)
175
+
val notjunk : string
176
+
177
+
(** {1 Apple Mail and Vendor Extensions}
178
+
@see <https://datatracker.ietf.org/doc/draft-ietf-mailmaint-messageflag-mailboxattribute/> *)
179
+
180
+
(** "$notify": Request to be notified when this email gets a reply *)
181
+
val notify : string
182
+
183
+
(** "$muted": Email is muted (notifications disabled) *)
184
+
val muted : string
185
+
186
+
(** "$followed": Email thread is followed for notifications *)
187
+
val followed : string
188
+
189
+
(** "$memo": Email has a memo/note associated with it *)
190
+
val memo : string
191
+
192
+
(** "$hasmemo": Email has a memo, annotation or note property *)
193
+
val hasmemo : string
194
+
195
+
(** "$autosent": Email was generated or sent automatically *)
196
+
val autosent : string
197
+
198
+
(** "$unsubscribed": User has unsubscribed from this sender *)
199
+
val unsubscribed : string
200
+
201
+
(** "$canunsubscribe": Email contains unsubscribe information *)
202
+
val canunsubscribe : string
203
+
204
+
(** "$imported": Email was imported from another system *)
205
+
val imported : string
206
+
207
+
(** "$istrusted": Email is from a trusted/verified sender *)
208
+
val istrusted : string
209
+
210
+
(** "$maskedemail": Email is to/from a masked/anonymous address *)
211
+
val maskedemail : string
212
+
213
+
(** "$new": Email was recently delivered *)
214
+
val new_mail : string
215
+
216
+
(** {1 Apple Mail Color Flag Bits} *)
217
+
218
+
(** "$MailFlagBit0": First color flag bit (red) *)
219
+
val mailflagbit0 : string
220
+
221
+
(** "$MailFlagBit1": Second color flag bit (orange) *)
222
+
val mailflagbit1 : string
223
+
224
+
(** "$MailFlagBit2": Third color flag bit (yellow) *)
225
+
val mailflagbit2 : string
226
+
227
+
(** {1 Color Flag Combinations} *)
228
+
229
+
(** Get color flag bit values for a specific color
230
+
@return A list of flags to set to create the requested color *)
231
+
val color_flags : [`Red | `Orange | `Yellow | `Green | `Blue | `Purple | `Gray] -> string list
232
+
233
+
(** Check if a string is a valid keyword according to the RFC
234
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1.1> RFC 8621, Section 4.1.1 *)
235
+
val is_valid : string -> bool
236
+
end
237
+
238
+
(** For backward compatibility - DEPRECATED, use Keyword.draft instead *)
239
+
val keyword_draft : string
240
+
241
+
(** For backward compatibility - DEPRECATED, use Keyword.seen instead *)
242
+
val keyword_seen : string
243
+
244
+
(** For backward compatibility - DEPRECATED, use Keyword.flagged instead *)
245
+
val keyword_flagged : string
246
+
247
+
(** For backward compatibility - DEPRECATED, use Keyword.answered instead *)
248
+
val keyword_answered : string
249
+
250
+
(** For backward compatibility - DEPRECATED, use Keyword.forwarded instead *)
251
+
val keyword_forwarded : string
252
+
253
+
(** For backward compatibility - DEPRECATED, use Keyword.phishing instead *)
254
+
val keyword_phishing : string
255
+
256
+
(** For backward compatibility - DEPRECATED, use Keyword.junk instead *)
257
+
val keyword_junk : string
258
+
259
+
(** For backward compatibility - DEPRECATED, use Keyword.notjunk instead *)
260
+
val keyword_notjunk : string
261
+
262
+
(** Email keyword operations.
263
+
Functions to manipulate and update email keywords/flags. *)
264
+
module Keyword_ops : sig
265
+
(** Add a keyword/flag to an email *)
266
+
val add : Types.Email.t -> Types.Keywords.keyword -> Types.Email.t
267
+
268
+
(** Remove a keyword/flag from an email *)
269
+
val remove : Types.Email.t -> Types.Keywords.keyword -> Types.Email.t
270
+
271
+
(** {1 System Flag Operations} *)
272
+
273
+
(** Mark an email as seen/read *)
274
+
val mark_as_seen : Types.Email.t -> Types.Email.t
275
+
276
+
(** Mark an email as unseen/unread *)
277
+
val mark_as_unseen : Types.Email.t -> Types.Email.t
278
+
279
+
(** Mark an email as flagged/important *)
280
+
val mark_as_flagged : Types.Email.t -> Types.Email.t
281
+
282
+
(** Remove flagged/important marking from an email *)
283
+
val unmark_flagged : Types.Email.t -> Types.Email.t
284
+
285
+
(** Mark an email as a draft *)
286
+
val mark_as_draft : Types.Email.t -> Types.Email.t
287
+
288
+
(** Remove draft marking from an email *)
289
+
val unmark_draft : Types.Email.t -> Types.Email.t
290
+
291
+
(** Mark an email as answered/replied *)
292
+
val mark_as_answered : Types.Email.t -> Types.Email.t
293
+
294
+
(** Remove answered/replied marking from an email *)
295
+
val unmark_answered : Types.Email.t -> Types.Email.t
296
+
297
+
(** Mark an email as forwarded *)
298
+
val mark_as_forwarded : Types.Email.t -> Types.Email.t
299
+
300
+
(** Mark an email as spam/junk *)
301
+
val mark_as_junk : Types.Email.t -> Types.Email.t
302
+
303
+
(** Mark an email as not spam/junk *)
304
+
val mark_as_not_junk : Types.Email.t -> Types.Email.t
305
+
306
+
(** Mark an email as phishing *)
307
+
val mark_as_phishing : Types.Email.t -> Types.Email.t
308
+
309
+
(** {1 Extension Flag Operations} *)
310
+
311
+
(** Mark an email for notification when replied to *)
312
+
val mark_as_notify : Types.Email.t -> Types.Email.t
313
+
314
+
(** Remove notification flag from an email *)
315
+
val unmark_notify : Types.Email.t -> Types.Email.t
316
+
317
+
(** Mark an email as muted (no notifications) *)
318
+
val mark_as_muted : Types.Email.t -> Types.Email.t
319
+
320
+
(** Unmute an email (allow notifications) *)
321
+
val unmark_muted : Types.Email.t -> Types.Email.t
322
+
323
+
(** Mark an email thread as followed for notifications *)
324
+
val mark_as_followed : Types.Email.t -> Types.Email.t
325
+
326
+
(** Remove followed status from an email thread *)
327
+
val unmark_followed : Types.Email.t -> Types.Email.t
328
+
329
+
(** Mark an email with a memo *)
330
+
val mark_as_memo : Types.Email.t -> Types.Email.t
331
+
332
+
(** Mark an email with the hasmemo flag *)
333
+
val mark_as_hasmemo : Types.Email.t -> Types.Email.t
334
+
335
+
(** Mark an email as automatically sent *)
336
+
val mark_as_autosent : Types.Email.t -> Types.Email.t
337
+
338
+
(** Mark an email as being from an unsubscribed sender *)
339
+
val mark_as_unsubscribed : Types.Email.t -> Types.Email.t
340
+
341
+
(** Mark an email as having unsubscribe capability *)
342
+
val mark_as_canunsubscribe : Types.Email.t -> Types.Email.t
343
+
344
+
(** Mark an email as imported from another system *)
345
+
val mark_as_imported : Types.Email.t -> Types.Email.t
346
+
347
+
(** Mark an email as from a trusted/verified sender *)
348
+
val mark_as_trusted : Types.Email.t -> Types.Email.t
349
+
350
+
(** Mark an email as having masked/anonymous address *)
351
+
val mark_as_maskedemail : Types.Email.t -> Types.Email.t
352
+
353
+
(** Mark an email as new/recent *)
354
+
val mark_as_new : Types.Email.t -> Types.Email.t
355
+
356
+
(** Remove new/recent flag from an email *)
357
+
val unmark_new : Types.Email.t -> Types.Email.t
358
+
359
+
(** {1 Color Flag Operations} *)
360
+
361
+
(** Set color flag bits on an email *)
362
+
val set_color_flags : Types.Email.t -> red:bool -> orange:bool -> yellow:bool -> Types.Email.t
363
+
364
+
(** Mark an email with a predefined color *)
365
+
val mark_as_color : Types.Email.t ->
366
+
[`Red | `Orange | `Yellow | `Green | `Blue | `Purple | `Gray] -> Types.Email.t
367
+
368
+
(** Remove all color flag bits from an email *)
369
+
val clear_color_flags : Types.Email.t -> Types.Email.t
370
+
371
+
(** {1 Custom Flag Operations} *)
372
+
373
+
(** Add a custom keyword to an email *)
374
+
val add_custom : Types.Email.t -> string -> Types.Email.t
375
+
376
+
(** Remove a custom keyword from an email *)
377
+
val remove_custom : Types.Email.t -> string -> Types.Email.t
378
+
379
+
(** {1 Patch Object Creation} *)
380
+
381
+
(** Create a patch object to add a keyword to emails *)
382
+
val add_keyword_patch : Types.Keywords.keyword -> Jmap.Methods.patch_object
383
+
384
+
(** Create a patch object to remove a keyword from emails *)
385
+
val remove_keyword_patch : Types.Keywords.keyword -> Jmap.Methods.patch_object
386
+
387
+
(** Create a patch object to mark emails as seen/read *)
388
+
val mark_seen_patch : unit -> Jmap.Methods.patch_object
389
+
390
+
(** Create a patch object to mark emails as unseen/unread *)
391
+
val mark_unseen_patch : unit -> Jmap.Methods.patch_object
392
+
393
+
(** Create a patch object to set a specific color on emails *)
394
+
val set_color_patch : [`Red | `Orange | `Yellow | `Green | `Blue | `Purple | `Gray] ->
395
+
Jmap.Methods.patch_object
396
+
end
397
+
398
+
(** Conversion functions for JMAP/IMAP compatibility *)
399
+
module Conversion : sig
400
+
(** {1 Keyword/Flag Conversion} *)
401
+
402
+
(** Convert a JMAP keyword variant to IMAP flag *)
403
+
val keyword_to_imap_flag : Types.Keywords.keyword -> string
404
+
405
+
(** Convert an IMAP flag to JMAP keyword variant *)
406
+
val imap_flag_to_keyword : string -> Types.Keywords.keyword
407
+
408
+
(** Check if a string is valid for use as a custom keyword according to RFC 8621.
409
+
@deprecated Use Keyword.is_valid instead. *)
410
+
val is_valid_custom_keyword : string -> bool
411
+
412
+
(** Get the JMAP protocol string representation of a keyword *)
413
+
val keyword_to_string : Types.Keywords.keyword -> string
414
+
415
+
(** Parse a JMAP protocol string into a keyword variant *)
416
+
val string_to_keyword : string -> Types.Keywords.keyword
417
+
418
+
(** {1 Color Conversion} *)
419
+
420
+
(** Convert a color name to the corresponding flag bit combination *)
421
+
val color_to_flags : [`Red | `Orange | `Yellow | `Green | `Blue | `Purple | `Gray] ->
422
+
Types.Keywords.keyword list
423
+
424
+
(** Try to determine a color from a set of keywords *)
425
+
val keywords_to_color : Types.Keywords.t ->
426
+
[`Red | `Orange | `Yellow | `Green | `Blue | `Purple | `Gray | `None] option
427
+
end
428
+
429
+
(** {1 Helper Functions} *)
430
+
431
+
(** Email query filter helpers *)
432
+
module Email_filter : sig
433
+
(** Create a filter to find messages in a specific mailbox *)
434
+
val in_mailbox : id -> Jmap.Methods.Filter.t
435
+
436
+
(** Create a filter to find messages with a specific keyword/flag *)
437
+
val has_keyword : Types.Keywords.keyword -> Jmap.Methods.Filter.t
438
+
439
+
(** Create a filter to find messages without a specific keyword/flag *)
440
+
val not_has_keyword : Types.Keywords.keyword -> Jmap.Methods.Filter.t
441
+
442
+
(** Create a filter to find unread messages *)
443
+
val unread : unit -> Jmap.Methods.Filter.t
444
+
445
+
(** Create a filter to find messages with a specific subject *)
446
+
val subject : string -> Jmap.Methods.Filter.t
447
+
448
+
(** Create a filter to find messages from a specific sender *)
449
+
val from : string -> Jmap.Methods.Filter.t
450
+
451
+
(** Create a filter to find messages sent to a specific recipient *)
452
+
val to_ : string -> Jmap.Methods.Filter.t
453
+
454
+
(** Create a filter to find messages with attachments *)
455
+
val has_attachment : unit -> Jmap.Methods.Filter.t
456
+
457
+
(** Create a filter to find messages received before a date *)
458
+
val before : date -> Jmap.Methods.Filter.t
459
+
460
+
(** Create a filter to find messages received after a date *)
461
+
val after : date -> Jmap.Methods.Filter.t
462
+
463
+
(** Create a filter to find messages with size larger than the given bytes *)
464
+
val larger_than : uint -> Jmap.Methods.Filter.t
465
+
466
+
(** Create a filter to find messages with size smaller than the given bytes *)
467
+
val smaller_than : uint -> Jmap.Methods.Filter.t
468
+
end
469
+
470
+
(** Common email sorting comparators *)
471
+
module Email_sort : sig
472
+
(** Sort by received date (most recent first) *)
473
+
val received_newest_first : unit -> Jmap.Methods.Comparator.t
474
+
475
+
(** Sort by received date (oldest first) *)
476
+
val received_oldest_first : unit -> Jmap.Methods.Comparator.t
477
+
478
+
(** Sort by sent date (most recent first) *)
479
+
val sent_newest_first : unit -> Jmap.Methods.Comparator.t
480
+
481
+
(** Sort by sent date (oldest first) *)
482
+
val sent_oldest_first : unit -> Jmap.Methods.Comparator.t
483
+
484
+
(** Sort by subject (A-Z) *)
485
+
val subject_asc : unit -> Jmap.Methods.Comparator.t
486
+
487
+
(** Sort by subject (Z-A) *)
488
+
val subject_desc : unit -> Jmap.Methods.Comparator.t
489
+
490
+
(** Sort by size (largest first) *)
491
+
val size_largest_first : unit -> Jmap.Methods.Comparator.t
492
+
493
+
(** Sort by size (smallest first) *)
494
+
val size_smallest_first : unit -> Jmap.Methods.Comparator.t
495
+
496
+
(** Sort by from address (A-Z) *)
497
+
val from_asc : unit -> Jmap.Methods.Comparator.t
498
+
499
+
(** Sort by from address (Z-A) *)
500
+
val from_desc : unit -> Jmap.Methods.Comparator.t
501
+
end
502
+
503
+
(** High-level email operations are implemented in the Jmap.Unix.Email module *)
+519
jmap-email/jmap_email_types.mli
+519
jmap-email/jmap_email_types.mli
···
1
+
(** Common types for JMAP Mail (RFC 8621). *)
2
+
3
+
open Jmap.Types
4
+
5
+
(** Represents an email address with an optional name.
6
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1.2.3> RFC 8621, Section 4.1.2.3 *)
7
+
module Email_address : sig
8
+
type t
9
+
10
+
(** Get the display name for the address (if any) *)
11
+
val name : t -> string option
12
+
13
+
(** Get the email address *)
14
+
val email : t -> string
15
+
16
+
(** Create a new email address *)
17
+
val v :
18
+
?name:string ->
19
+
email:string ->
20
+
unit -> t
21
+
end
22
+
23
+
(** Represents a group of email addresses.
24
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1.2.4> RFC 8621, Section 4.1.2.4 *)
25
+
module Email_address_group : sig
26
+
type t
27
+
28
+
(** Get the name of the group (if any) *)
29
+
val name : t -> string option
30
+
31
+
(** Get the list of addresses in the group *)
32
+
val addresses : t -> Email_address.t list
33
+
34
+
(** Create a new address group *)
35
+
val v :
36
+
?name:string ->
37
+
addresses:Email_address.t list ->
38
+
unit -> t
39
+
end
40
+
41
+
(** Represents a header field (name and raw value).
42
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1.3> RFC 8621, Section 4.1.3 *)
43
+
module Email_header : sig
44
+
type t
45
+
46
+
(** Get the header field name *)
47
+
val name : t -> string
48
+
49
+
(** Get the raw header field value *)
50
+
val value : t -> string
51
+
52
+
(** Create a new header field *)
53
+
val v :
54
+
name:string ->
55
+
value:string ->
56
+
unit -> t
57
+
end
58
+
59
+
(** Represents a body part within an Email's MIME structure.
60
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1.4> RFC 8621, Section 4.1.4 *)
61
+
module Email_body_part : sig
62
+
type t
63
+
64
+
(** Get the part ID (null only for multipart types) *)
65
+
val id : t -> string option
66
+
67
+
(** Get the blob ID (null only for multipart types) *)
68
+
val blob_id : t -> id option
69
+
70
+
(** Get the size of the part in bytes *)
71
+
val size : t -> uint
72
+
73
+
(** Get the list of headers for this part *)
74
+
val headers : t -> Email_header.t list
75
+
76
+
(** Get the filename (if any) *)
77
+
val name : t -> string option
78
+
79
+
(** Get the MIME type *)
80
+
val mime_type : t -> string
81
+
82
+
(** Get the charset (if any) *)
83
+
val charset : t -> string option
84
+
85
+
(** Get the content disposition (if any) *)
86
+
val disposition : t -> string option
87
+
88
+
(** Get the content ID (if any) *)
89
+
val cid : t -> string option
90
+
91
+
(** Get the list of languages (if any) *)
92
+
val language : t -> string list option
93
+
94
+
(** Get the content location (if any) *)
95
+
val location : t -> string option
96
+
97
+
(** Get the sub-parts (only for multipart types) *)
98
+
val sub_parts : t -> t list option
99
+
100
+
(** Get any other requested headers (header properties) *)
101
+
val other_headers : t -> Yojson.Safe.t string_map
102
+
103
+
(** Create a new body part *)
104
+
val v :
105
+
?id:string ->
106
+
?blob_id:id ->
107
+
size:uint ->
108
+
headers:Email_header.t list ->
109
+
?name:string ->
110
+
mime_type:string ->
111
+
?charset:string ->
112
+
?disposition:string ->
113
+
?cid:string ->
114
+
?language:string list ->
115
+
?location:string ->
116
+
?sub_parts:t list ->
117
+
?other_headers:Yojson.Safe.t string_map ->
118
+
unit -> t
119
+
end
120
+
121
+
(** Represents the decoded value of a text body part.
122
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1.4> RFC 8621, Section 4.1.4 *)
123
+
module Email_body_value : sig
124
+
type t
125
+
126
+
(** Get the decoded text content *)
127
+
val value : t -> string
128
+
129
+
(** Check if there was an encoding problem *)
130
+
val has_encoding_problem : t -> bool
131
+
132
+
(** Check if the content was truncated *)
133
+
val is_truncated : t -> bool
134
+
135
+
(** Create a new body value *)
136
+
val v :
137
+
value:string ->
138
+
?encoding_problem:bool ->
139
+
?truncated:bool ->
140
+
unit -> t
141
+
end
142
+
143
+
(** Type to represent email message flags/keywords.
144
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1.1> RFC 8621, Section 4.1.1 *)
145
+
module Keywords : sig
146
+
(** Represents different types of JMAP keywords *)
147
+
type keyword =
148
+
| Draft (** "$draft": The Email is a draft the user is composing *)
149
+
| Seen (** "$seen": The Email has been read *)
150
+
| Flagged (** "$flagged": The Email has been flagged for urgent/special attention *)
151
+
| Answered (** "$answered": The Email has been replied to *)
152
+
153
+
(* Common extension keywords from RFC 5788 *)
154
+
| Forwarded (** "$forwarded": The Email has been forwarded *)
155
+
| Phishing (** "$phishing": The Email is likely to be phishing *)
156
+
| Junk (** "$junk": The Email is spam/junk *)
157
+
| NotJunk (** "$notjunk": The Email is explicitly marked as not spam/junk *)
158
+
159
+
(* Apple Mail and other vendor extension keywords from draft-ietf-mailmaint-messageflag-mailboxattribute *)
160
+
| Notify (** "$notify": Request to be notified when this email gets a reply *)
161
+
| Muted (** "$muted": Email is muted (notifications disabled) *)
162
+
| Followed (** "$followed": Email thread is followed for notifications *)
163
+
| Memo (** "$memo": Email has a memo/note associated with it *)
164
+
| HasMemo (** "$hasmemo": Email has a memo, annotation or note property *)
165
+
| Autosent (** "$autosent": Email was generated or sent automatically *)
166
+
| Unsubscribed (** "$unsubscribed": User has unsubscribed from this sender *)
167
+
| CanUnsubscribe (** "$canunsubscribe": Email contains unsubscribe information *)
168
+
| Imported (** "$imported": Email was imported from another system *)
169
+
| IsTrusted (** "$istrusted": Email is from a trusted/verified sender *)
170
+
| MaskedEmail (** "$maskedemail": Email is to/from a masked/anonymous address *)
171
+
| New (** "$new": Email was recently delivered *)
172
+
173
+
(* Apple Mail flag colors (color bit flags) *)
174
+
| MailFlagBit0 (** "$MailFlagBit0": First color flag bit (red) *)
175
+
| MailFlagBit1 (** "$MailFlagBit1": Second color flag bit (orange) *)
176
+
| MailFlagBit2 (** "$MailFlagBit2": Third color flag bit (yellow) *)
177
+
| Custom of string (** Arbitrary user-defined keyword *)
178
+
179
+
(** A set of keywords applied to an email *)
180
+
type t = keyword list
181
+
182
+
(** Check if an email has the draft flag *)
183
+
val is_draft : t -> bool
184
+
185
+
(** Check if an email has been read *)
186
+
val is_seen : t -> bool
187
+
188
+
(** Check if an email has neither been read nor is a draft *)
189
+
val is_unread : t -> bool
190
+
191
+
(** Check if an email has been flagged *)
192
+
val is_flagged : t -> bool
193
+
194
+
(** Check if an email has been replied to *)
195
+
val is_answered : t -> bool
196
+
197
+
(** Check if an email has been forwarded *)
198
+
val is_forwarded : t -> bool
199
+
200
+
(** Check if an email is marked as likely phishing *)
201
+
val is_phishing : t -> bool
202
+
203
+
(** Check if an email is marked as junk/spam *)
204
+
val is_junk : t -> bool
205
+
206
+
(** Check if an email is explicitly marked as not junk/spam *)
207
+
val is_not_junk : t -> bool
208
+
209
+
(** Check if a specific custom keyword is set *)
210
+
val has_keyword : t -> string -> bool
211
+
212
+
(** Get a list of all custom keywords (excluding system keywords) *)
213
+
val custom_keywords : t -> string list
214
+
215
+
(** Add a keyword to the set *)
216
+
val add : t -> keyword -> t
217
+
218
+
(** Remove a keyword from the set *)
219
+
val remove : t -> keyword -> t
220
+
221
+
(** Create an empty keyword set *)
222
+
val empty : unit -> t
223
+
224
+
(** Create a new keyword set with the specified keywords *)
225
+
val of_list : keyword list -> t
226
+
227
+
(** Get the string representation of a keyword as used in the JMAP protocol *)
228
+
val to_string : keyword -> string
229
+
230
+
(** Parse a string into a keyword *)
231
+
val of_string : string -> keyword
232
+
233
+
(** Convert keyword set to string map representation as used in JMAP *)
234
+
val to_map : t -> bool string_map
235
+
end
236
+
237
+
(** Email properties enum.
238
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1> RFC 8621, Section 4.1 *)
239
+
type email_property =
240
+
| Id (** The id of the email *)
241
+
| BlobId (** The id of the blob containing the raw message *)
242
+
| ThreadId (** The id of the thread this email belongs to *)
243
+
| MailboxIds (** The mailboxes this email belongs to *)
244
+
| Keywords (** The keywords/flags for this email *)
245
+
| Size (** Size of the message in bytes *)
246
+
| ReceivedAt (** When the message was received by the server *)
247
+
| MessageId (** Value of the Message-ID header *)
248
+
| InReplyTo (** Value of the In-Reply-To header *)
249
+
| References (** Value of the References header *)
250
+
| Sender (** Value of the Sender header *)
251
+
| From (** Value of the From header *)
252
+
| To (** Value of the To header *)
253
+
| Cc (** Value of the Cc header *)
254
+
| Bcc (** Value of the Bcc header *)
255
+
| ReplyTo (** Value of the Reply-To header *)
256
+
| Subject (** Value of the Subject header *)
257
+
| SentAt (** Value of the Date header *)
258
+
| HasAttachment (** Whether the email has attachments *)
259
+
| Preview (** Preview text of the email *)
260
+
| BodyStructure (** MIME structure of the email *)
261
+
| BodyValues (** Decoded body part values *)
262
+
| TextBody (** Text body parts *)
263
+
| HtmlBody (** HTML body parts *)
264
+
| Attachments (** Attachments *)
265
+
| Header of string (** Specific header *)
266
+
| Other of string (** Extension property *)
267
+
268
+
(** Represents an Email object.
269
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1> RFC 8621, Section 4.1 *)
270
+
module Email : sig
271
+
(** Email type *)
272
+
type t
273
+
274
+
(** ID of the email *)
275
+
val id : t -> id option
276
+
277
+
(** ID of the blob containing the raw message *)
278
+
val blob_id : t -> id option
279
+
280
+
(** ID of the thread this email belongs to *)
281
+
val thread_id : t -> id option
282
+
283
+
(** The set of mailbox IDs this email belongs to *)
284
+
val mailbox_ids : t -> bool id_map option
285
+
286
+
(** The set of keywords/flags for this email *)
287
+
val keywords : t -> Keywords.t option
288
+
289
+
(** Size of the message in bytes *)
290
+
val size : t -> uint option
291
+
292
+
(** When the message was received by the server *)
293
+
val received_at : t -> date option
294
+
295
+
(** Subject of the email (if requested) *)
296
+
val subject : t -> string option
297
+
298
+
(** Preview text of the email (if requested) *)
299
+
val preview : t -> string option
300
+
301
+
(** From addresses (if requested) *)
302
+
val from : t -> Email_address.t list option
303
+
304
+
(** To addresses (if requested) *)
305
+
val to_ : t -> Email_address.t list option
306
+
307
+
(** CC addresses (if requested) *)
308
+
val cc : t -> Email_address.t list option
309
+
310
+
(** Message ID values (if requested) *)
311
+
val message_id : t -> string list option
312
+
313
+
(** Get whether the email has attachments (if requested) *)
314
+
val has_attachment : t -> bool option
315
+
316
+
(** Get text body parts (if requested) *)
317
+
val text_body : t -> Email_body_part.t list option
318
+
319
+
(** Get HTML body parts (if requested) *)
320
+
val html_body : t -> Email_body_part.t list option
321
+
322
+
(** Get attachments (if requested) *)
323
+
val attachments : t -> Email_body_part.t list option
324
+
325
+
(** Create a new Email object from a server response or for a new email *)
326
+
val create :
327
+
?id:id ->
328
+
?blob_id:id ->
329
+
?thread_id:id ->
330
+
?mailbox_ids:bool id_map ->
331
+
?keywords:Keywords.t ->
332
+
?size:uint ->
333
+
?received_at:date ->
334
+
?subject:string ->
335
+
?preview:string ->
336
+
?from:Email_address.t list ->
337
+
?to_:Email_address.t list ->
338
+
?cc:Email_address.t list ->
339
+
?message_id:string list ->
340
+
?has_attachment:bool ->
341
+
?text_body:Email_body_part.t list ->
342
+
?html_body:Email_body_part.t list ->
343
+
?attachments:Email_body_part.t list ->
344
+
unit -> t
345
+
346
+
(** Create a patch object for updating email properties *)
347
+
val make_patch :
348
+
?add_keywords:Keywords.t ->
349
+
?remove_keywords:Keywords.t ->
350
+
?add_mailboxes:id list ->
351
+
?remove_mailboxes:id list ->
352
+
unit -> Jmap.Methods.patch_object
353
+
354
+
(** Extract the ID from an email, returning a Result *)
355
+
val get_id : t -> (id, string) result
356
+
357
+
(** Take the ID from an email (fails with an exception if not present) *)
358
+
val take_id : t -> id
359
+
end
360
+
361
+
(** Email/import method arguments and responses.
362
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.8> RFC 8621, Section 4.8 *)
363
+
module Import : sig
364
+
(** Arguments for Email/import method *)
365
+
type args = {
366
+
account_id : id;
367
+
blob_ids : id list;
368
+
mailbox_ids : id id_map;
369
+
keywords : Keywords.t option;
370
+
received_at : date option;
371
+
}
372
+
373
+
(** Create import arguments *)
374
+
val create_args :
375
+
account_id:id ->
376
+
blob_ids:id list ->
377
+
mailbox_ids:id id_map ->
378
+
?keywords:Keywords.t ->
379
+
?received_at:date ->
380
+
unit -> args
381
+
382
+
(** Response for a single imported email *)
383
+
type email_import_result = {
384
+
blob_id : id;
385
+
email : Email.t;
386
+
}
387
+
388
+
(** Create an email import result *)
389
+
val create_result :
390
+
blob_id:id ->
391
+
email:Email.t ->
392
+
unit -> email_import_result
393
+
394
+
(** Response for Email/import method *)
395
+
type response = {
396
+
account_id : id;
397
+
created : email_import_result id_map;
398
+
not_created : Jmap.Error.Set_error.t id_map;
399
+
}
400
+
401
+
(** Create import response *)
402
+
val create_response :
403
+
account_id:id ->
404
+
created:email_import_result id_map ->
405
+
not_created:Jmap.Error.Set_error.t id_map ->
406
+
unit -> response
407
+
end
408
+
409
+
(** Email/parse method arguments and responses.
410
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.9> RFC 8621, Section 4.9 *)
411
+
module Parse : sig
412
+
(** Arguments for Email/parse method *)
413
+
type args = {
414
+
account_id : id;
415
+
blob_ids : id list;
416
+
properties : string list option;
417
+
}
418
+
419
+
(** Create parse arguments *)
420
+
val create_args :
421
+
account_id:id ->
422
+
blob_ids:id list ->
423
+
?properties:string list ->
424
+
unit -> args
425
+
426
+
(** Response for a single parsed email *)
427
+
type email_parse_result = {
428
+
blob_id : id;
429
+
parsed : Email.t;
430
+
}
431
+
432
+
(** Create an email parse result *)
433
+
val create_result :
434
+
blob_id:id ->
435
+
parsed:Email.t ->
436
+
unit -> email_parse_result
437
+
438
+
(** Response for Email/parse method *)
439
+
type response = {
440
+
account_id : id;
441
+
parsed : email_parse_result id_map;
442
+
not_parsed : string id_map;
443
+
}
444
+
445
+
(** Create parse response *)
446
+
val create_response :
447
+
account_id:id ->
448
+
parsed:email_parse_result id_map ->
449
+
not_parsed:string id_map ->
450
+
unit -> response
451
+
end
452
+
453
+
(** Email import options.
454
+
@deprecated Use Import.args instead.
455
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.8> RFC 8621, Section 4.8 *)
456
+
type email_import_options = {
457
+
import_to_mailboxes : id list;
458
+
import_keywords : Keywords.t option;
459
+
import_received_at : date option;
460
+
}
461
+
462
+
(** Email/copy method arguments and responses.
463
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.7> RFC 8621, Section 4.7 *)
464
+
module Copy : sig
465
+
(** Arguments for Email/copy method *)
466
+
type args = {
467
+
from_account_id : id;
468
+
account_id : id;
469
+
create : (id * id id_map) id_map;
470
+
on_success_destroy_original : bool option;
471
+
destroy_from_if_in_state : string option;
472
+
}
473
+
474
+
(** Create copy arguments *)
475
+
val create_args :
476
+
from_account_id:id ->
477
+
account_id:id ->
478
+
create:(id * id id_map) id_map ->
479
+
?on_success_destroy_original:bool ->
480
+
?destroy_from_if_in_state:string ->
481
+
unit -> args
482
+
483
+
(** Response for Email/copy method *)
484
+
type response = {
485
+
from_account_id : id;
486
+
account_id : id;
487
+
created : Email.t id_map option;
488
+
not_created : Jmap.Error.Set_error.t id_map option;
489
+
}
490
+
491
+
(** Create copy response *)
492
+
val create_response :
493
+
from_account_id:id ->
494
+
account_id:id ->
495
+
?created:Email.t id_map ->
496
+
?not_created:Jmap.Error.Set_error.t id_map ->
497
+
unit -> response
498
+
end
499
+
500
+
(** Email copy options.
501
+
@deprecated Use Copy.args instead.
502
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.7> RFC 8621, Section 4.7 *)
503
+
type email_copy_options = {
504
+
copy_to_account_id : id;
505
+
copy_to_mailboxes : id list;
506
+
copy_on_success_destroy_original : bool option;
507
+
}
508
+
509
+
(** Convert a property variant to its string representation *)
510
+
val email_property_to_string : email_property -> string
511
+
512
+
(** Parse a string into a property variant *)
513
+
val string_to_email_property : string -> email_property
514
+
515
+
(** Get a list of common properties useful for displaying email lists *)
516
+
val common_email_properties : email_property list
517
+
518
+
(** Get a list of common properties for detailed email view *)
519
+
val detailed_email_properties : email_property list
+114
jmap-email/jmap_identity.mli
+114
jmap-email/jmap_identity.mli
···
1
+
(** JMAP Identity.
2
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-6> RFC 8621, Section 6 *)
3
+
4
+
open Jmap.Types
5
+
open Jmap.Methods
6
+
7
+
(** Identity object.
8
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-6> RFC 8621, Section 6 *)
9
+
type t
10
+
11
+
(** Get the identity ID (immutable, server-set) *)
12
+
val id : t -> id
13
+
14
+
(** Get the display name (defaults to "") *)
15
+
val name : t -> string
16
+
17
+
(** Get the email address (immutable) *)
18
+
val email : t -> string
19
+
20
+
(** Get the reply-to addresses (if any) *)
21
+
val reply_to : t -> Jmap_email_types.Email_address.t list option
22
+
23
+
(** Get the bcc addresses (if any) *)
24
+
val bcc : t -> Jmap_email_types.Email_address.t list option
25
+
26
+
(** Get the plain text signature (defaults to "") *)
27
+
val text_signature : t -> string
28
+
29
+
(** Get the HTML signature (defaults to "") *)
30
+
val html_signature : t -> string
31
+
32
+
(** Check if this identity may be deleted (server-set) *)
33
+
val may_delete : t -> bool
34
+
35
+
(** Create a new identity object *)
36
+
val v :
37
+
id:id ->
38
+
?name:string ->
39
+
email:string ->
40
+
?reply_to:Jmap_email_types.Email_address.t list ->
41
+
?bcc:Jmap_email_types.Email_address.t list ->
42
+
?text_signature:string ->
43
+
?html_signature:string ->
44
+
may_delete:bool ->
45
+
unit -> t
46
+
47
+
(** Types and functions for identity creation and updates *)
48
+
module Create : sig
49
+
type t
50
+
51
+
(** Get the name (if specified) *)
52
+
val name : t -> string option
53
+
54
+
(** Get the email address *)
55
+
val email : t -> string
56
+
57
+
(** Get the reply-to addresses (if any) *)
58
+
val reply_to : t -> Jmap_email_types.Email_address.t list option
59
+
60
+
(** Get the bcc addresses (if any) *)
61
+
val bcc : t -> Jmap_email_types.Email_address.t list option
62
+
63
+
(** Get the plain text signature (if specified) *)
64
+
val text_signature : t -> string option
65
+
66
+
(** Get the HTML signature (if specified) *)
67
+
val html_signature : t -> string option
68
+
69
+
(** Create a new identity creation object *)
70
+
val v :
71
+
?name:string ->
72
+
email:string ->
73
+
?reply_to:Jmap_email_types.Email_address.t list ->
74
+
?bcc:Jmap_email_types.Email_address.t list ->
75
+
?text_signature:string ->
76
+
?html_signature:string ->
77
+
unit -> t
78
+
79
+
(** Server response with info about the created identity *)
80
+
module Response : sig
81
+
type t
82
+
83
+
(** Get the server-assigned ID for the created identity *)
84
+
val id : t -> id
85
+
86
+
(** Check if this identity may be deleted *)
87
+
val may_delete : t -> bool
88
+
89
+
(** Create a new response object *)
90
+
val v :
91
+
id:id ->
92
+
may_delete:bool ->
93
+
unit -> t
94
+
end
95
+
end
96
+
97
+
(** Identity object for update.
98
+
Patch object, specific structure not enforced here.
99
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-6.3> RFC 8621, Section 6.3 *)
100
+
type update = patch_object
101
+
102
+
(** Server-set/computed info for updated identity.
103
+
Contains only changed server-set props.
104
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-6.3> RFC 8621, Section 6.3 *)
105
+
module Update_response : sig
106
+
type t
107
+
108
+
(** Convert to a full Identity object (contains only changed server-set props) *)
109
+
val to_identity : t -> t
110
+
111
+
(** Create from a full Identity object *)
112
+
val of_identity : t -> t
113
+
end
114
+
+187
jmap-email/jmap_mailbox.mli
+187
jmap-email/jmap_mailbox.mli
···
1
+
(** JMAP Mailbox.
2
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-2> RFC 8621, Section 2 *)
3
+
4
+
open Jmap.Types
5
+
open Jmap.Methods
6
+
7
+
(** Standard mailbox roles as defined in RFC 8621.
8
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-2> RFC 8621, Section 2 *)
9
+
type role =
10
+
| Inbox (** Messages in the primary inbox *)
11
+
| Archive (** Archived messages *)
12
+
| Drafts (** Draft messages being composed *)
13
+
| Sent (** Messages that have been sent *)
14
+
| Trash (** Messages that have been deleted *)
15
+
| Junk (** Messages determined to be spam *)
16
+
| Important (** Messages deemed important *)
17
+
| Snoozed (** Messages snoozed for later notification/reappearance, from draft-ietf-mailmaint-messageflag-mailboxattribute *)
18
+
| Scheduled (** Messages scheduled for sending at a later time, from draft-ietf-mailmaint-messageflag-mailboxattribute *)
19
+
| Memos (** Messages containing memos or notes, from draft-ietf-mailmaint-messageflag-mailboxattribute *)
20
+
21
+
| Other of string (** Custom or non-standard role *)
22
+
| None (** No specific role assigned *)
23
+
24
+
(** Mailbox property identifiers.
25
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-2> RFC 8621, Section 2 *)
26
+
type property =
27
+
| Id (** The id of the mailbox *)
28
+
| Name (** The name of the mailbox *)
29
+
| ParentId (** The id of the parent mailbox *)
30
+
| Role (** The role of the mailbox *)
31
+
| SortOrder (** The sort order of the mailbox *)
32
+
| TotalEmails (** The total number of emails in the mailbox *)
33
+
| UnreadEmails (** The number of unread emails in the mailbox *)
34
+
| TotalThreads (** The total number of threads in the mailbox *)
35
+
| UnreadThreads (** The number of unread threads in the mailbox *)
36
+
| MyRights (** The rights the user has for the mailbox *)
37
+
| IsSubscribed (** Whether the mailbox is subscribed to *)
38
+
| Other of string (** Any server-specific extension properties *)
39
+
40
+
(** Mailbox access rights.
41
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-2> RFC 8621, Section 2 *)
42
+
type mailbox_rights = {
43
+
may_read_items : bool;
44
+
may_add_items : bool;
45
+
may_remove_items : bool;
46
+
may_set_seen : bool;
47
+
may_set_keywords : bool;
48
+
may_create_child : bool;
49
+
may_rename : bool;
50
+
may_delete : bool;
51
+
may_submit : bool;
52
+
}
53
+
54
+
(** Mailbox object.
55
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-2> RFC 8621, Section 2 *)
56
+
type mailbox = {
57
+
mailbox_id : id; (** immutable, server-set *)
58
+
name : string;
59
+
parent_id : id option;
60
+
role : role option;
61
+
sort_order : uint; (* default: 0 *)
62
+
total_emails : uint; (** server-set *)
63
+
unread_emails : uint; (** server-set *)
64
+
total_threads : uint; (** server-set *)
65
+
unread_threads : uint; (** server-set *)
66
+
my_rights : mailbox_rights; (** server-set *)
67
+
is_subscribed : bool;
68
+
}
69
+
70
+
(** Mailbox object for creation.
71
+
Excludes server-set fields.
72
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-2> RFC 8621, Section 2 *)
73
+
type mailbox_create = {
74
+
mailbox_create_name : string;
75
+
mailbox_create_parent_id : id option;
76
+
mailbox_create_role : role option;
77
+
mailbox_create_sort_order : uint option;
78
+
mailbox_create_is_subscribed : bool option;
79
+
}
80
+
81
+
(** Mailbox object for update.
82
+
Patch object, specific structure not enforced here.
83
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-2.5> RFC 8621, Section 2.5 *)
84
+
type mailbox_update = patch_object
85
+
86
+
(** Server-set info for created mailbox.
87
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-2.5> RFC 8621, Section 2.5 *)
88
+
type mailbox_created_info = {
89
+
mailbox_created_id : id;
90
+
mailbox_created_role : role option; (** If default used *)
91
+
mailbox_created_sort_order : uint; (** If default used *)
92
+
mailbox_created_total_emails : uint;
93
+
mailbox_created_unread_emails : uint;
94
+
mailbox_created_total_threads : uint;
95
+
mailbox_created_unread_threads : uint;
96
+
mailbox_created_my_rights : mailbox_rights;
97
+
mailbox_created_is_subscribed : bool; (** If default used *)
98
+
}
99
+
100
+
(** Server-set/computed info for updated mailbox.
101
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-2.5> RFC 8621, Section 2.5 *)
102
+
type mailbox_updated_info = mailbox (* Contains only changed server-set props *)
103
+
104
+
(** FilterCondition for Mailbox/query.
105
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-2.3> RFC 8621, Section 2.3 *)
106
+
type mailbox_filter_condition = {
107
+
filter_parent_id : id option option; (* Use option option for explicit null *)
108
+
filter_name : string option;
109
+
filter_role : role option option; (* Use option option for explicit null *)
110
+
filter_has_any_role : bool option;
111
+
filter_is_subscribed : bool option;
112
+
}
113
+
114
+
(** {2 Role and Property Conversion Functions} *)
115
+
116
+
(** Convert a role variant to its string representation *)
117
+
val role_to_string : role -> string
118
+
119
+
(** Parse a string into a role variant *)
120
+
val string_to_role : string -> role
121
+
122
+
(** Convert a property variant to its string representation *)
123
+
val property_to_string : property -> string
124
+
125
+
(** Parse a string into a property variant *)
126
+
val string_to_property : string -> property
127
+
128
+
(** Get a list of common properties useful for displaying mailboxes *)
129
+
val common_properties : property list
130
+
131
+
(** Get a list of all standard properties *)
132
+
val all_properties : property list
133
+
134
+
(** Check if a property is a count property (TotalEmails, UnreadEmails, etc.) *)
135
+
val is_count_property : property -> bool
136
+
137
+
(** {2 Mailbox Creation and Manipulation} *)
138
+
139
+
(** Create a set of default rights with all permissions *)
140
+
val default_rights : unit -> mailbox_rights
141
+
142
+
(** Create a set of read-only rights *)
143
+
val readonly_rights : unit -> mailbox_rights
144
+
145
+
(** Create a new mailbox object with minimal required fields *)
146
+
val create :
147
+
name:string ->
148
+
?parent_id:id ->
149
+
?role:role ->
150
+
?sort_order:uint ->
151
+
?is_subscribed:bool ->
152
+
unit -> mailbox_create
153
+
154
+
(** Build a patch object for updating mailbox properties *)
155
+
val update :
156
+
?name:string ->
157
+
?parent_id:id option ->
158
+
?role:role option ->
159
+
?sort_order:uint ->
160
+
?is_subscribed:bool ->
161
+
unit -> mailbox_update
162
+
163
+
(** Get the list of standard role names and their string representations *)
164
+
val standard_role_names : (role * string) list
165
+
166
+
(** {2 Filter Construction} *)
167
+
168
+
(** Create a filter to match mailboxes with a specific role *)
169
+
val filter_has_role : role -> Jmap.Methods.Filter.t
170
+
171
+
(** Create a filter to match mailboxes with no role *)
172
+
val filter_has_no_role : unit -> Jmap.Methods.Filter.t
173
+
174
+
(** Create a filter to match mailboxes that are child of a given parent *)
175
+
val filter_has_parent : id -> Jmap.Methods.Filter.t
176
+
177
+
(** Create a filter to match mailboxes at the root level (no parent) *)
178
+
val filter_is_root : unit -> Jmap.Methods.Filter.t
179
+
180
+
(** Create a filter to match subscribed mailboxes *)
181
+
val filter_is_subscribed : unit -> Jmap.Methods.Filter.t
182
+
183
+
(** Create a filter to match unsubscribed mailboxes *)
184
+
val filter_is_not_subscribed : unit -> Jmap.Methods.Filter.t
185
+
186
+
(** Create a filter to match mailboxes by name (using case-insensitive substring matching) *)
187
+
val filter_name_contains : string -> Jmap.Methods.Filter.t
+89
jmap-email/jmap_search_snippet.mli
+89
jmap-email/jmap_search_snippet.mli
···
1
+
(** JMAP Search Snippet.
2
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-5> RFC 8621, Section 5 *)
3
+
4
+
open Jmap.Types
5
+
open Jmap.Methods
6
+
7
+
(** SearchSnippet object.
8
+
Provides highlighted snippets of emails matching search criteria.
9
+
Note: Does not have an 'id' property; the key is the emailId.
10
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-5> RFC 8621, Section 5 *)
11
+
module SearchSnippet : sig
12
+
type t
13
+
14
+
(** Get the email ID this snippet is for *)
15
+
val email_id : t -> id
16
+
17
+
(** Get the highlighted subject snippet (if matched) *)
18
+
val subject : t -> string option
19
+
20
+
(** Get the highlighted preview snippet (if matched) *)
21
+
val preview : t -> string option
22
+
23
+
(** Create a new SearchSnippet object *)
24
+
val v :
25
+
email_id:id ->
26
+
?subject:string ->
27
+
?preview:string ->
28
+
unit -> t
29
+
end
30
+
31
+
(** {1 SearchSnippet Methods} *)
32
+
33
+
(** Arguments for SearchSnippet/get.
34
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-5.1> RFC 8621, Section 5.1 *)
35
+
module Get_args : sig
36
+
type t
37
+
38
+
(** The account ID *)
39
+
val account_id : t -> id
40
+
41
+
(** The filter to use for the search *)
42
+
val filter : t -> Filter.t
43
+
44
+
(** Email IDs to return snippets for. If null, all matching emails are included *)
45
+
val email_ids : t -> id list option
46
+
47
+
(** Creation arguments *)
48
+
val v :
49
+
account_id:id ->
50
+
filter:Filter.t ->
51
+
?email_ids:id list ->
52
+
unit -> t
53
+
end
54
+
55
+
(** Response for SearchSnippet/get.
56
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-5.1> RFC 8621, Section 5.1 *)
57
+
module Get_response : sig
58
+
type t
59
+
60
+
(** The account ID *)
61
+
val account_id : t -> id
62
+
63
+
(** The search state string (for caching) *)
64
+
val list : t -> SearchSnippet.t id_map
65
+
66
+
(** IDs requested that weren't found *)
67
+
val not_found : t -> id list
68
+
69
+
(** Creation *)
70
+
val v :
71
+
account_id:id ->
72
+
list:SearchSnippet.t id_map ->
73
+
not_found:id list ->
74
+
unit -> t
75
+
end
76
+
77
+
(** {1 Helper Functions} *)
78
+
79
+
(** Helper to extract all matched keywords from a snippet.
80
+
This parses highlighted portions from the snippet to get the actual search terms. *)
81
+
val extract_matched_terms : string -> string list
82
+
83
+
(** Helper to create a filter that searches in email body text.
84
+
This is commonly used for SearchSnippet/get requests. *)
85
+
val create_body_text_filter : string -> Filter.t
86
+
87
+
(** Helper to create a filter that searches across multiple email fields.
88
+
This searches subject, body, and headers for the given text. *)
89
+
val create_fulltext_filter : string -> Filter.t
+136
jmap-email/jmap_submission.mli
+136
jmap-email/jmap_submission.mli
···
1
+
(** JMAP Email Submission.
2
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-7> RFC 8621, Section 7 *)
3
+
4
+
open Jmap.Types
5
+
open Jmap.Methods
6
+
7
+
(** Address object for Envelope.
8
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-7> RFC 8621, Section 7 *)
9
+
type envelope_address = {
10
+
env_addr_email : string;
11
+
env_addr_parameters : Yojson.Safe.t string_map option;
12
+
}
13
+
14
+
(** Envelope object.
15
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-7> RFC 8621, Section 7 *)
16
+
type envelope = {
17
+
env_mail_from : envelope_address;
18
+
env_rcpt_to : envelope_address list;
19
+
}
20
+
21
+
(** Delivery status for a recipient.
22
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-7> RFC 8621, Section 7 *)
23
+
type delivery_status = {
24
+
delivery_smtp_reply : string;
25
+
delivery_delivered : [ `Queued | `Yes | `No | `Unknown ];
26
+
delivery_displayed : [ `Yes | `Unknown ];
27
+
}
28
+
29
+
(** EmailSubmission object.
30
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-7> RFC 8621, Section 7 *)
31
+
type email_submission = {
32
+
email_sub_id : id; (** immutable, server-set *)
33
+
identity_id : id; (** immutable *)
34
+
email_id : id; (** immutable *)
35
+
thread_id : id; (** immutable, server-set *)
36
+
envelope : envelope option; (** immutable *)
37
+
send_at : utc_date; (** immutable, server-set *)
38
+
undo_status : [ `Pending | `Final | `Canceled ];
39
+
delivery_status : delivery_status string_map option; (** server-set *)
40
+
dsn_blob_ids : id list; (** server-set *)
41
+
mdn_blob_ids : id list; (** server-set *)
42
+
}
43
+
44
+
(** EmailSubmission object for creation.
45
+
Excludes server-set fields.
46
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-7> RFC 8621, Section 7 *)
47
+
type email_submission_create = {
48
+
email_sub_create_identity_id : id;
49
+
email_sub_create_email_id : id;
50
+
email_sub_create_envelope : envelope option;
51
+
}
52
+
53
+
(** EmailSubmission object for update.
54
+
Only undoStatus can be updated (to 'canceled').
55
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-7> RFC 8621, Section 7 *)
56
+
type email_submission_update = patch_object
57
+
58
+
(** Server-set info for created email submission.
59
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-7.5> RFC 8621, Section 7.5 *)
60
+
type email_submission_created_info = {
61
+
email_sub_created_id : id;
62
+
email_sub_created_thread_id : id;
63
+
email_sub_created_send_at : utc_date;
64
+
}
65
+
66
+
(** Server-set/computed info for updated email submission.
67
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-7.5> RFC 8621, Section 7.5 *)
68
+
type email_submission_updated_info = email_submission (* Contains only changed server-set props *)
69
+
70
+
(** FilterCondition for EmailSubmission/query.
71
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-7.3> RFC 8621, Section 7.3 *)
72
+
type email_submission_filter_condition = {
73
+
filter_identity_ids : id list option;
74
+
filter_email_ids : id list option;
75
+
filter_thread_ids : id list option;
76
+
filter_undo_status : [ `Pending | `Final | `Canceled ] option;
77
+
filter_before : utc_date option;
78
+
filter_after : utc_date option;
79
+
}
80
+
81
+
(** EmailSubmission/get: Args type (specialized from ['record Get_args.t]). *)
82
+
module Email_submission_get_args : sig
83
+
type t = email_submission Get_args.t
84
+
end
85
+
86
+
(** EmailSubmission/get: Response type (specialized from ['record Get_response.t]). *)
87
+
module Email_submission_get_response : sig
88
+
type t = email_submission Get_response.t
89
+
end
90
+
91
+
(** EmailSubmission/changes: Args type (specialized from [Changes_args.t]). *)
92
+
module Email_submission_changes_args : sig
93
+
type t = Changes_args.t
94
+
end
95
+
96
+
(** EmailSubmission/changes: Response type (specialized from [Changes_response.t]). *)
97
+
module Email_submission_changes_response : sig
98
+
type t = Changes_response.t
99
+
end
100
+
101
+
(** EmailSubmission/query: Args type (specialized from [Query_args.t]). *)
102
+
module Email_submission_query_args : sig
103
+
type t = Query_args.t
104
+
end
105
+
106
+
(** EmailSubmission/query: Response type (specialized from [Query_response.t]). *)
107
+
module Email_submission_query_response : sig
108
+
type t = Query_response.t
109
+
end
110
+
111
+
(** EmailSubmission/queryChanges: Args type (specialized from [Query_changes_args.t]). *)
112
+
module Email_submission_query_changes_args : sig
113
+
type t = Query_changes_args.t
114
+
end
115
+
116
+
(** EmailSubmission/queryChanges: Response type (specialized from [Query_changes_response.t]). *)
117
+
module Email_submission_query_changes_response : sig
118
+
type t = Query_changes_response.t
119
+
end
120
+
121
+
(** EmailSubmission/set: Args type (specialized from [('c, 'u) set_args]).
122
+
Includes onSuccess arguments.
123
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-7.5> RFC 8621, Section 7.5 *)
124
+
type email_submission_set_args = {
125
+
set_account_id : id;
126
+
set_if_in_state : string option;
127
+
set_create : email_submission_create id_map option;
128
+
set_update : email_submission_update id_map option;
129
+
set_destroy : id list option;
130
+
set_on_success_destroy_email : id list option;
131
+
}
132
+
133
+
(** EmailSubmission/set: Response type (specialized from [('c, 'u) Set_response.t]). *)
134
+
module Email_submission_set_response : sig
135
+
type t = (email_submission_created_info, email_submission_updated_info) Set_response.t
136
+
end
+131
jmap-email/jmap_thread.mli
+131
jmap-email/jmap_thread.mli
···
1
+
(** JMAP Thread.
2
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-3> RFC 8621, Section 3 *)
3
+
4
+
open Jmap.Types
5
+
open Jmap.Methods
6
+
7
+
(** Thread object.
8
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-3> RFC 8621, Section 3 *)
9
+
module Thread : sig
10
+
type t
11
+
12
+
(** Get the thread ID (server-set, immutable) *)
13
+
val id : t -> id
14
+
15
+
(** Get the IDs of emails in the thread (server-set) *)
16
+
val email_ids : t -> id list
17
+
18
+
(** Create a new Thread object *)
19
+
val v : id:id -> email_ids:id list -> t
20
+
end
21
+
22
+
(** Thread properties that can be requested in Thread/get.
23
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-3.1> RFC 8621, Section 3.1 *)
24
+
type property =
25
+
| Id (** The Thread id *)
26
+
| EmailIds (** The list of email IDs in the Thread *)
27
+
28
+
(** Convert a property variant to its string representation *)
29
+
val property_to_string : property -> string
30
+
31
+
(** Parse a string into a property variant *)
32
+
val string_to_property : string -> property
33
+
34
+
(** Get a list of all standard Thread properties *)
35
+
val all_properties : property list
36
+
37
+
(** {1 Thread Methods} *)
38
+
39
+
(** Arguments for Thread/get - extends standard get arguments.
40
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-3.1> RFC 8621, Section 3.1 *)
41
+
module Get_args : sig
42
+
type t
43
+
44
+
val account_id : t -> id
45
+
val ids : t -> id list option
46
+
val properties : t -> string list option
47
+
48
+
val v :
49
+
account_id:id ->
50
+
?ids:id list ->
51
+
?properties:string list ->
52
+
unit -> t
53
+
end
54
+
55
+
(** Response for Thread/get - extends standard get response.
56
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-3.1> RFC 8621, Section 3.1 *)
57
+
module Get_response : sig
58
+
type t
59
+
60
+
val account_id : t -> id
61
+
val state : t -> string
62
+
val list : t -> Thread.t list
63
+
val not_found : t -> id list
64
+
65
+
val v :
66
+
account_id:id ->
67
+
state:string ->
68
+
list:Thread.t list ->
69
+
not_found:id list ->
70
+
unit -> t
71
+
end
72
+
73
+
(** Arguments for Thread/changes - extends standard changes arguments.
74
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-3.2> RFC 8621, Section 3.2 *)
75
+
module Changes_args : sig
76
+
type t
77
+
78
+
val account_id : t -> id
79
+
val since_state : t -> string
80
+
val max_changes : t -> uint option
81
+
82
+
val v :
83
+
account_id:id ->
84
+
since_state:string ->
85
+
?max_changes:uint ->
86
+
unit -> t
87
+
end
88
+
89
+
(** Response for Thread/changes - extends standard changes response.
90
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-3.2> RFC 8621, Section 3.2 *)
91
+
module Changes_response : sig
92
+
type t
93
+
94
+
val account_id : t -> id
95
+
val old_state : t -> string
96
+
val new_state : t -> string
97
+
val has_more_changes : t -> bool
98
+
val created : t -> id list
99
+
val updated : t -> id list
100
+
val destroyed : t -> id list
101
+
102
+
val v :
103
+
account_id:id ->
104
+
old_state:string ->
105
+
new_state:string ->
106
+
has_more_changes:bool ->
107
+
created:id list ->
108
+
updated:id list ->
109
+
destroyed:id list ->
110
+
unit -> t
111
+
end
112
+
113
+
(** {1 Helper Functions} *)
114
+
115
+
(** Create a filter to find threads with specific email ID *)
116
+
val filter_has_email : id -> Filter.t
117
+
118
+
(** Create a filter to find threads with emails from a specific sender *)
119
+
val filter_from : string -> Filter.t
120
+
121
+
(** Create a filter to find threads with emails to a specific recipient *)
122
+
val filter_to : string -> Filter.t
123
+
124
+
(** Create a filter to find threads with specific subject *)
125
+
val filter_subject : string -> Filter.t
126
+
127
+
(** Create a filter to find threads with emails received before a date *)
128
+
val filter_before : date -> Filter.t
129
+
130
+
(** Create a filter to find threads with emails received after a date *)
131
+
val filter_after : date -> Filter.t
+102
jmap-email/jmap_vacation.mli
+102
jmap-email/jmap_vacation.mli
···
1
+
(** JMAP Vacation Response.
2
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-8> RFC 8621, Section 8 *)
3
+
4
+
open Jmap.Types
5
+
open Jmap.Methods
6
+
open Jmap.Error
7
+
8
+
(** VacationResponse object.
9
+
Note: id is always "singleton".
10
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-8> RFC 8621, Section 8 *)
11
+
module Vacation_response : sig
12
+
type t
13
+
14
+
(** Id of the vacation response (immutable, server-set, MUST be "singleton") *)
15
+
val id : t -> id
16
+
val is_enabled : t -> bool
17
+
val from_date : t -> utc_date option
18
+
val to_date : t -> utc_date option
19
+
val subject : t -> string option
20
+
val text_body : t -> string option
21
+
val html_body : t -> string option
22
+
23
+
val v :
24
+
id:id ->
25
+
is_enabled:bool ->
26
+
?from_date:utc_date ->
27
+
?to_date:utc_date ->
28
+
?subject:string ->
29
+
?text_body:string ->
30
+
?html_body:string ->
31
+
unit ->
32
+
t
33
+
end
34
+
35
+
(** VacationResponse object for update.
36
+
Patch object, specific structure not enforced here.
37
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-8.2> RFC 8621, Section 8.2 *)
38
+
type vacation_response_update = patch_object
39
+
40
+
(** VacationResponse/get: Args type (specialized from ['record get_args]). *)
41
+
module Vacation_response_get_args : sig
42
+
type t = Vacation_response.t Get_args.t
43
+
44
+
val v :
45
+
account_id:id ->
46
+
?ids:id list ->
47
+
?properties:string list ->
48
+
unit ->
49
+
t
50
+
end
51
+
52
+
(** VacationResponse/get: Response type (specialized from ['record get_response]). *)
53
+
module Vacation_response_get_response : sig
54
+
type t = Vacation_response.t Get_response.t
55
+
56
+
val v :
57
+
account_id:id ->
58
+
state:string ->
59
+
list:Vacation_response.t list ->
60
+
not_found:id list ->
61
+
unit ->
62
+
t
63
+
end
64
+
65
+
(** VacationResponse/set: Args type.
66
+
Only allows update, id must be "singleton".
67
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-8.2> RFC 8621, Section 8.2 *)
68
+
module Vacation_response_set_args : sig
69
+
type t
70
+
71
+
val account_id : t -> id
72
+
val if_in_state : t -> string option
73
+
val update : t -> vacation_response_update id_map option
74
+
75
+
val v :
76
+
account_id:id ->
77
+
?if_in_state:string ->
78
+
?update:vacation_response_update id_map ->
79
+
unit ->
80
+
t
81
+
end
82
+
83
+
(** VacationResponse/set: Response type.
84
+
@see <https://www.rfc-editor.org/rfc/rfc8621.html#section-8.2> RFC 8621, Section 8.2 *)
85
+
module Vacation_response_set_response : sig
86
+
type t
87
+
88
+
val account_id : t -> id
89
+
val old_state : t -> string option
90
+
val new_state : t -> string
91
+
val updated : t -> Vacation_response.t option id_map option
92
+
val not_updated : t -> Set_error.t id_map option
93
+
94
+
val v :
95
+
account_id:id ->
96
+
?old_state:string ->
97
+
new_state:string ->
98
+
?updated:Vacation_response.t option id_map ->
99
+
?not_updated:Set_error.t id_map ->
100
+
unit ->
101
+
t
102
+
end
+35
jmap-email.opam
+35
jmap-email.opam
···
1
+
opam-version: "2.0"
2
+
name: "jmap-email"
3
+
version: "~dev"
4
+
synopsis: "JMAP Email extensions library (RFC 8621)"
5
+
description: """
6
+
OCaml implementation of the JMAP Mail extensions protocol as defined in RFC 8621.
7
+
Provides type definitions and structures for working with email in JMAP.
8
+
"""
9
+
maintainer: ["user@example.com"]
10
+
authors: ["Example User"]
11
+
license: "MIT"
12
+
homepage: "https://github.com/example/jmap"
13
+
bug-reports: "https://github.com/example/jmap/issues"
14
+
depends: [
15
+
"ocaml" {>= "4.08.0"}
16
+
"dune" {>= "3.0"}
17
+
"jmap"
18
+
"yojson"
19
+
"uri"
20
+
"odoc" {with-doc}
21
+
]
22
+
build: [
23
+
["dune" "subst"] {dev}
24
+
[
25
+
"dune"
26
+
"build"
27
+
"-p"
28
+
name
29
+
"-j"
30
+
jobs
31
+
"@install"
32
+
"@runtest" {with-test}
33
+
"@doc" {with-doc}
34
+
]
35
+
]
+62
jmap-unix/README.md
+62
jmap-unix/README.md
···
1
+
# JMAP Unix Implementation
2
+
3
+
This library provides Unix-specific implementation for the core JMAP protocol.
4
+
5
+
## Overview
6
+
7
+
Jmap_unix provides the implementation needed to make actual connections to JMAP servers
8
+
using OCaml's Unix module. It handles:
9
+
10
+
- HTTP connections to JMAP endpoints
11
+
- Authentication
12
+
- Session discovery
13
+
- Request/response handling
14
+
- Blob upload/download
15
+
- High-level email operations (Jmap_unix.Email)
16
+
17
+
## Usage
18
+
19
+
```ocaml
20
+
open Jmap
21
+
open Jmap_unix
22
+
23
+
(* Create a connection to a JMAP server *)
24
+
let credentials = Basic("username", "password") in
25
+
let (ctx, session) = Jmap_unix.connect ~host:"jmap.example.com" ~credentials in
26
+
27
+
(* Use the connection for JMAP requests *)
28
+
let response = Jmap_unix.request ctx request in
29
+
30
+
(* Close the connection when done *)
31
+
Jmap_unix.close ctx
32
+
```
33
+
34
+
## Email Operations
35
+
36
+
The Email module provides high-level operations for working with emails:
37
+
38
+
```ocaml
39
+
open Jmap
40
+
open Jmap.Unix
41
+
42
+
(* Get an email *)
43
+
let email = Email.get_email ctx ~account_id ~email_id ()
44
+
45
+
(* Search for unread emails *)
46
+
let filter = Jmap_email.Email_filter.unread ()
47
+
let (ids, emails) = Email.search_emails ctx ~account_id ~filter ()
48
+
49
+
(* Mark emails as read *)
50
+
Email.mark_as_seen ctx ~account_id ~email_ids:["email1"; "email2"] ()
51
+
52
+
(* Move emails to another mailbox *)
53
+
Email.move_emails ctx ~account_id ~email_ids ~mailbox_id ()
54
+
```
55
+
56
+
## Dependencies
57
+
58
+
- jmap (core library)
59
+
- jmap-email (email types and helpers)
60
+
- yojson
61
+
- uri
62
+
- unix
+6
jmap-unix/dune
+6
jmap-unix/dune
+359
jmap-unix/jmap_unix.mli
+359
jmap-unix/jmap_unix.mli
···
1
+
(** Unix-specific JMAP client implementation interface.
2
+
3
+
This module provides functions to interact with a JMAP server using
4
+
Unix sockets for network communication.
5
+
6
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-4> RFC 8620, Section 4
7
+
*)
8
+
9
+
(** Configuration options for a JMAP client context *)
10
+
type client_config = {
11
+
connect_timeout : float option; (** Connection timeout in seconds *)
12
+
request_timeout : float option; (** Request timeout in seconds *)
13
+
max_concurrent_requests : int option; (** Maximum concurrent requests *)
14
+
max_request_size : int option; (** Maximum request size in bytes *)
15
+
user_agent : string option; (** User-Agent header value *)
16
+
authentication_header : string option; (** Custom Authentication header name *)
17
+
}
18
+
19
+
(** Authentication method options *)
20
+
type auth_method =
21
+
| Basic of string * string (** Basic auth with username and password *)
22
+
| Bearer of string (** Bearer token auth *)
23
+
| Custom of (string * string) (** Custom header name and value *)
24
+
| Session_cookie of (string * string) (** Session cookie name and value *)
25
+
| No_auth (** No authentication *)
26
+
27
+
(** Represents an active JMAP connection context. Opaque type. *)
28
+
type context
29
+
30
+
(** Represents an active EventSource connection. Opaque type. *)
31
+
type event_source_connection
32
+
33
+
(** A request builder for constructing and sending JMAP requests *)
34
+
type request_builder
35
+
36
+
(** Create default configuration options *)
37
+
val default_config : unit -> client_config
38
+
39
+
(** Create a client context with the specified configuration
40
+
@return The context object used for JMAP API calls
41
+
*)
42
+
val create_client :
43
+
?config:client_config ->
44
+
unit ->
45
+
context
46
+
47
+
(** Connect to a JMAP server and retrieve the session.
48
+
This handles discovery (if needed) and authentication.
49
+
@param ctx The client context.
50
+
@param ?session_url Optional direct URL to the Session resource.
51
+
@param ?username Optional username (e.g., email address) for discovery.
52
+
@param ?auth_method Authentication method to use (default Basic).
53
+
@param credentials Authentication credentials.
54
+
@return A result with either (context, session) or an error.
55
+
*)
56
+
val connect :
57
+
context ->
58
+
?session_url:Uri.t ->
59
+
?username:string ->
60
+
host:string ->
61
+
?port:int ->
62
+
?auth_method:auth_method ->
63
+
unit ->
64
+
(context * Jmap.Session.Session.t) Jmap.Error.result
65
+
66
+
(** Create a request builder for constructing a JMAP request.
67
+
@param ctx The client context.
68
+
@return A request builder object.
69
+
*)
70
+
val build : context -> request_builder
71
+
72
+
(** Set the using capabilities for a request.
73
+
@param builder The request builder.
74
+
@param capabilities List of capability URIs to use.
75
+
@return The updated request builder.
76
+
*)
77
+
val using : request_builder -> string list -> request_builder
78
+
79
+
(** Add a method call to a request builder.
80
+
@param builder The request builder.
81
+
@param name Method name (e.g., "Email/get").
82
+
@param args Method arguments.
83
+
@param id Method call ID.
84
+
@return The updated request builder.
85
+
*)
86
+
val add_method_call :
87
+
request_builder ->
88
+
string ->
89
+
Yojson.Safe.t ->
90
+
string ->
91
+
request_builder
92
+
93
+
(** Create a reference to a previous method call result.
94
+
@param result_of Method call ID to reference.
95
+
@param name Path in the response.
96
+
@return A ResultReference to use in another method call.
97
+
*)
98
+
val create_reference : string -> string -> Jmap.Wire.Result_reference.t
99
+
100
+
(** Execute a request and return the response.
101
+
@param builder The request builder to execute.
102
+
@return The JMAP response from the server.
103
+
*)
104
+
val execute : request_builder -> Jmap.Wire.Response.t Jmap.Error.result
105
+
106
+
(** Perform a JMAP API request.
107
+
@param ctx The connection context.
108
+
@param request The JMAP request object.
109
+
@return The JMAP response from the server.
110
+
*)
111
+
val request : context -> Jmap.Wire.Request.t -> Jmap.Wire.Response.t Jmap.Error.result
112
+
113
+
(** Upload binary data.
114
+
@param ctx The connection context.
115
+
@param account_id The target account ID.
116
+
@param content_type The MIME type of the data.
117
+
@param data_stream A stream providing the binary data chunks.
118
+
@return A result with either an upload response or an error.
119
+
*)
120
+
val upload :
121
+
context ->
122
+
account_id:Jmap.Types.id ->
123
+
content_type:string ->
124
+
data_stream:string Seq.t ->
125
+
Jmap.Binary.Upload_response.t Jmap.Error.result
126
+
127
+
(** Download binary data.
128
+
@param ctx The connection context.
129
+
@param account_id The account ID.
130
+
@param blob_id The blob ID to download.
131
+
@param ?content_type The desired Content-Type for the download response.
132
+
@param ?name The desired filename for the download response.
133
+
@return A result with either a stream of data chunks or an error.
134
+
*)
135
+
val download :
136
+
context ->
137
+
account_id:Jmap.Types.id ->
138
+
blob_id:Jmap.Types.id ->
139
+
?content_type:string ->
140
+
?name:string ->
141
+
(string Seq.t) Jmap.Error.result
142
+
143
+
(** Copy blobs between accounts.
144
+
@param ctx The connection context.
145
+
@param from_account_id Source account ID.
146
+
@param account_id Destination account ID.
147
+
@param blob_ids List of blob IDs to copy.
148
+
@return A result with either the copy response or an error.
149
+
*)
150
+
val copy_blobs :
151
+
context ->
152
+
from_account_id:Jmap.Types.id ->
153
+
account_id:Jmap.Types.id ->
154
+
blob_ids:Jmap.Types.id list ->
155
+
Jmap.Binary.Blob_copy_response.t Jmap.Error.result
156
+
157
+
(** Connect to the EventSource for push notifications.
158
+
@param ctx The connection context.
159
+
@param ?types List of types to subscribe to (default "*").
160
+
@param ?close_after Request server to close after first state event.
161
+
@param ?ping Request ping interval in seconds (default 0).
162
+
@return A result with either a tuple of connection handle and event stream, or an error.
163
+
@see <https://www.rfc-editor.org/rfc/rfc8620.html#section-7.3> RFC 8620, Section 7.3 *)
164
+
val connect_event_source :
165
+
context ->
166
+
?types:string list ->
167
+
?close_after:[`State | `No] ->
168
+
?ping:Jmap.Types.uint ->
169
+
(event_source_connection *
170
+
([`State of Jmap.Push.State_change.t | `Ping of Jmap.Push.Event_source_ping_data.t ] Seq.t)) Jmap.Error.result
171
+
172
+
(** Create a websocket connection for JMAP over WebSocket.
173
+
@param ctx The connection context.
174
+
@return A result with either a websocket connection or an error.
175
+
@see <https://www.rfc-editor.org/rfc/rfc8887.html> RFC 8887 *)
176
+
val connect_websocket :
177
+
context ->
178
+
event_source_connection Jmap.Error.result
179
+
180
+
(** Send a message over a websocket connection.
181
+
@param conn The websocket connection.
182
+
@param request The JMAP request to send.
183
+
@return A result with either the response or an error.
184
+
*)
185
+
val websocket_send :
186
+
event_source_connection ->
187
+
Jmap.Wire.Request.t ->
188
+
Jmap.Wire.Response.t Jmap.Error.result
189
+
190
+
(** Close an EventSource or WebSocket connection.
191
+
@param conn The connection handle.
192
+
@return A result with either unit or an error.
193
+
*)
194
+
val close_connection : event_source_connection -> unit Jmap.Error.result
195
+
196
+
(** Close the JMAP connection context.
197
+
@return A result with either unit or an error.
198
+
*)
199
+
val close : context -> unit Jmap.Error.result
200
+
201
+
(** {2 Helper Methods for Common Tasks} *)
202
+
203
+
(** Helper to get a single object by ID.
204
+
@param ctx The context.
205
+
@param method_name The get method (e.g., "Email/get").
206
+
@param account_id The account ID.
207
+
@param object_id The ID of the object to get.
208
+
@param ?properties Optional list of properties to fetch.
209
+
@return A result with either the object as JSON or an error.
210
+
*)
211
+
val get_object :
212
+
context ->
213
+
method_name:string ->
214
+
account_id:Jmap.Types.id ->
215
+
object_id:Jmap.Types.id ->
216
+
?properties:string list ->
217
+
Yojson.Safe.t Jmap.Error.result
218
+
219
+
(** Helper to set up the connection with minimal options.
220
+
@param host The JMAP server hostname.
221
+
@param username Username for basic auth.
222
+
@param password Password for basic auth.
223
+
@return A result with either (context, session) or an error.
224
+
*)
225
+
val quick_connect :
226
+
host:string ->
227
+
username:string ->
228
+
password:string ->
229
+
(context * Jmap.Session.Session.t) Jmap.Error.result
230
+
231
+
(** Perform a Core/echo request to test connectivity.
232
+
@param ctx The JMAP connection context.
233
+
@param ?data Optional data to echo back.
234
+
@return A result with either the response or an error.
235
+
*)
236
+
val echo :
237
+
context ->
238
+
?data:Yojson.Safe.t ->
239
+
unit ->
240
+
Yojson.Safe.t Jmap.Error.result
241
+
242
+
(** {2 Email Operations} *)
243
+
244
+
(** High-level email operations that map to JMAP email methods *)
245
+
module Email : sig
246
+
open Jmap_email.Types
247
+
248
+
(** Get an email by ID
249
+
@param ctx The JMAP client context
250
+
@param account_id The account ID
251
+
@param email_id The email ID to fetch
252
+
@param ?properties Optional list of properties to fetch
253
+
@return The email object or an error
254
+
*)
255
+
val get_email :
256
+
context ->
257
+
account_id:Jmap.Types.id ->
258
+
email_id:Jmap.Types.id ->
259
+
?properties:string list ->
260
+
unit ->
261
+
Email.t Jmap.Error.result
262
+
263
+
(** Search for emails using a filter
264
+
@param ctx The JMAP client context
265
+
@param account_id The account ID
266
+
@param filter The search filter
267
+
@param ?sort Optional sort criteria (default received date newest first)
268
+
@param ?limit Optional maximum number of results
269
+
@param ?properties Optional properties to fetch for the matching emails
270
+
@return The list of matching email IDs and optionally the email objects
271
+
*)
272
+
val search_emails :
273
+
context ->
274
+
account_id:Jmap.Types.id ->
275
+
filter:Jmap.Methods.Filter.t ->
276
+
?sort:Jmap.Methods.Comparator.t list ->
277
+
?limit:Jmap.Types.uint ->
278
+
?position:int ->
279
+
?properties:string list ->
280
+
unit ->
281
+
(Jmap.Types.id list * Email.t list option) Jmap.Error.result
282
+
283
+
(** Mark multiple emails with a keyword
284
+
@param ctx The JMAP client context
285
+
@param account_id The account ID
286
+
@param email_ids List of email IDs to update
287
+
@param keyword The keyword to add
288
+
@return The result of the operation
289
+
*)
290
+
val mark_emails :
291
+
context ->
292
+
account_id:Jmap.Types.id ->
293
+
email_ids:Jmap.Types.id list ->
294
+
keyword:Keywords.keyword ->
295
+
unit ->
296
+
unit Jmap.Error.result
297
+
298
+
(** Mark emails as seen/read
299
+
@param ctx The JMAP client context
300
+
@param account_id The account ID
301
+
@param email_ids List of email IDs to mark
302
+
@return The result of the operation
303
+
*)
304
+
val mark_as_seen :
305
+
context ->
306
+
account_id:Jmap.Types.id ->
307
+
email_ids:Jmap.Types.id list ->
308
+
unit ->
309
+
unit Jmap.Error.result
310
+
311
+
(** Mark emails as unseen/unread
312
+
@param ctx The JMAP client context
313
+
@param account_id The account ID
314
+
@param email_ids List of email IDs to mark
315
+
@return The result of the operation
316
+
*)
317
+
val mark_as_unseen :
318
+
context ->
319
+
account_id:Jmap.Types.id ->
320
+
email_ids:Jmap.Types.id list ->
321
+
unit ->
322
+
unit Jmap.Error.result
323
+
324
+
(** Move emails to a different mailbox
325
+
@param ctx The JMAP client context
326
+
@param account_id The account ID
327
+
@param email_ids List of email IDs to move
328
+
@param mailbox_id Destination mailbox ID
329
+
@param ?remove_from_mailboxes Optional list of source mailbox IDs to remove from
330
+
@return The result of the operation
331
+
*)
332
+
val move_emails :
333
+
context ->
334
+
account_id:Jmap.Types.id ->
335
+
email_ids:Jmap.Types.id list ->
336
+
mailbox_id:Jmap.Types.id ->
337
+
?remove_from_mailboxes:Jmap.Types.id list ->
338
+
unit ->
339
+
unit Jmap.Error.result
340
+
341
+
(** Import an RFC822 message
342
+
@param ctx The JMAP client context
343
+
@param account_id The account ID
344
+
@param rfc822 Raw message content
345
+
@param mailbox_ids Mailboxes to add the message to
346
+
@param ?keywords Optional keywords to set
347
+
@param ?received_at Optional received timestamp
348
+
@return The ID of the imported email
349
+
*)
350
+
val import_email :
351
+
context ->
352
+
account_id:Jmap.Types.id ->
353
+
rfc822:string ->
354
+
mailbox_ids:Jmap.Types.id list ->
355
+
?keywords:Keywords.t ->
356
+
?received_at:Jmap.Types.date ->
357
+
unit ->
358
+
Jmap.Types.id Jmap.Error.result
359
+
end
+21
jmap-unix.opam
+21
jmap-unix.opam
···
1
+
opam-version: "2.0"
2
+
name: "jmap-unix"
3
+
version: "~dev"
4
+
synopsis: "JMAP Unix implementation"
5
+
description: "Unix-specific implementation of the JMAP protocol (RFC8620)"
6
+
maintainer: ["maintainer@example.com"]
7
+
authors: ["JMAP OCaml Team"]
8
+
license: "MIT"
9
+
homepage: "https://github.com/example/jmap-ocaml"
10
+
bug-reports: "https://github.com/example/jmap-ocaml/issues"
11
+
depends: [
12
+
"ocaml" {>= "4.08.0"}
13
+
"dune" {>= "2.0.0"}
14
+
"jmap"
15
+
"yojson" {>= "1.7.0"}
16
+
"uri" {>= "4.0.0"}
17
+
"unix"
18
+
]
19
+
build: [
20
+
["dune" "build" "-p" name "-j" jobs]
21
+
]
-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
-735
lib/jmap.ml
-735
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 Api = struct
385
-
open Lwt.Syntax
386
-
open Types
387
-
388
-
(** Error that may occur during API requests *)
389
-
type error =
390
-
| Connection_error of string
391
-
| HTTP_error of int * string
392
-
| Parse_error of string
393
-
| Authentication_error
394
-
395
-
(** Result type for API operations *)
396
-
type 'a result = ('a, error) Stdlib.result
397
-
398
-
(** Configuration for a JMAP API client *)
399
-
type config = {
400
-
api_uri: Uri.t;
401
-
username: string;
402
-
authentication_token: string;
403
-
}
404
-
405
-
(** Convert Ezjsonm.value to string *)
406
-
let json_to_string json =
407
-
Ezjsonm.value_to_string ~minify:false json
408
-
409
-
(** Parse response string as JSON value *)
410
-
let parse_json_string str =
411
-
try Ok (Ezjsonm.from_string str)
412
-
with e -> Error (Parse_error (Printexc.to_string e))
413
-
414
-
(** Parse JSON response as a JMAP response object *)
415
-
let parse_response json =
416
-
try
417
-
let method_responses =
418
-
match Ezjsonm.find json ["methodResponses"] with
419
-
| `A items ->
420
-
List.map (fun json ->
421
-
match json with
422
-
| `A [`String name; args; `String method_call_id] ->
423
-
{ name; arguments = args; method_call_id }
424
-
| _ -> raise (Invalid_argument "Invalid invocation format in response")
425
-
) items
426
-
| _ -> raise (Invalid_argument "methodResponses is not an array")
427
-
in
428
-
let created_ids_opt =
429
-
try
430
-
let obj = Ezjsonm.find json ["createdIds"] in
431
-
match obj with
432
-
| `O items -> Some (List.map (fun (k, v) ->
433
-
match v with
434
-
| `String id -> (k, id)
435
-
| _ -> raise (Invalid_argument "createdIds value is not a string")
436
-
) items)
437
-
| _ -> None
438
-
with Not_found -> None
439
-
in
440
-
let session_state =
441
-
match Ezjsonm.find json ["sessionState"] with
442
-
| `String s -> s
443
-
| _ -> raise (Invalid_argument "sessionState is not a string")
444
-
in
445
-
Ok { method_responses; created_ids = created_ids_opt; session_state }
446
-
with
447
-
| Not_found -> Error (Parse_error "Required field not found in response")
448
-
| Invalid_argument msg -> Error (Parse_error msg)
449
-
| e -> Error (Parse_error (Printexc.to_string e))
450
-
451
-
(** Serialize a JMAP request object to JSON *)
452
-
let serialize_request req =
453
-
let method_calls_json =
454
-
`A (List.map (fun (inv : 'a invocation) ->
455
-
`A [`String inv.name; inv.arguments; `String inv.method_call_id]
456
-
) req.method_calls)
457
-
in
458
-
let using_json = `A (List.map (fun s -> `String s) req.using) in
459
-
let json = `O [
460
-
("using", using_json);
461
-
("methodCalls", method_calls_json)
462
-
] in
463
-
let json = match req.created_ids with
464
-
| Some ids ->
465
-
let created_ids_json = `O (List.map (fun (k, v) -> (k, `String v)) ids) in
466
-
Ezjsonm.update json ["createdIds"] (Some created_ids_json)
467
-
| None -> json
468
-
in
469
-
json_to_string json
470
-
471
-
(** Make a raw HTTP request *)
472
-
let make_http_request ~method_ ~headers ~body uri =
473
-
let open Cohttp in
474
-
let open Cohttp_lwt_unix in
475
-
let headers = Header.add_list (Header.init ()) headers in
476
-
477
-
(* Log request details at debug level *)
478
-
let header_list = Cohttp.Header.to_list headers in
479
-
let redacted_headers = redact_headers header_list in
480
-
Logs.debug (fun m ->
481
-
m "\n===== HTTP REQUEST =====\n\
482
-
URI: %s\n\
483
-
METHOD: %s\n\
484
-
HEADERS:\n%s\n\
485
-
BODY:\n%s\n\
486
-
======================\n"
487
-
(Uri.to_string uri)
488
-
method_
489
-
(String.concat "\n" (List.map (fun (k, v) -> Printf.sprintf " %s: %s" k v) redacted_headers))
490
-
body);
491
-
492
-
Lwt.catch
493
-
(fun () ->
494
-
let* resp, body =
495
-
match method_ with
496
-
| "GET" -> Client.get ~headers uri
497
-
| "POST" -> Client.post ~headers ~body:(Cohttp_lwt.Body.of_string body) uri
498
-
| _ -> failwith (Printf.sprintf "Unsupported HTTP method: %s" method_)
499
-
in
500
-
let* body_str = Cohttp_lwt.Body.to_string body in
501
-
let status = Response.status resp |> Code.code_of_status in
502
-
503
-
(* Log response details at debug level *)
504
-
let header_list = Cohttp.Header.to_list (Response.headers resp) in
505
-
let redacted_headers = redact_headers header_list in
506
-
Logs.debug (fun m ->
507
-
m "\n===== HTTP RESPONSE =====\n\
508
-
STATUS: %d\n\
509
-
HEADERS:\n%s\n\
510
-
BODY:\n%s\n\
511
-
======================\n"
512
-
status
513
-
(String.concat "\n" (List.map (fun (k, v) -> Printf.sprintf " %s: %s" k v) redacted_headers))
514
-
body_str);
515
-
516
-
if status >= 200 && status < 300 then
517
-
Lwt.return (Ok body_str)
518
-
else
519
-
Lwt.return (Error (HTTP_error (status, body_str))))
520
-
(fun e ->
521
-
let error_msg = Printexc.to_string e in
522
-
Logs.err (fun m -> m "%s" error_msg);
523
-
Lwt.return (Error (Connection_error error_msg)))
524
-
525
-
(** Make a raw JMAP API request
526
-
527
-
TODO:claude *)
528
-
let make_request config req =
529
-
let body = serialize_request req in
530
-
(* Choose appropriate authorization header based on whether it's a bearer token or basic auth *)
531
-
let auth_header =
532
-
if String.length config.username > 0 then
533
-
(* Standard username/password authentication *)
534
-
"Basic " ^ Base64.encode_string (config.username ^ ":" ^ config.authentication_token)
535
-
else
536
-
(* API token (bearer authentication) *)
537
-
"Bearer " ^ config.authentication_token
538
-
in
539
-
540
-
(* Log auth header at debug level with redaction *)
541
-
let redacted_header =
542
-
if String.length config.username > 0 then
543
-
"Basic " ^ redact_token (Base64.encode_string (config.username ^ ":" ^ config.authentication_token))
544
-
else
545
-
"Bearer " ^ redact_token config.authentication_token
546
-
in
547
-
Logs.debug (fun m -> m "Using authorization header: %s" redacted_header);
548
-
549
-
let headers = [
550
-
("Content-Type", "application/json");
551
-
("Content-Length", string_of_int (String.length body));
552
-
("Authorization", auth_header)
553
-
] in
554
-
let* result = make_http_request ~method_:"POST" ~headers ~body config.api_uri in
555
-
match result with
556
-
| Ok response_body ->
557
-
(match parse_json_string response_body with
558
-
| Ok json ->
559
-
Logs.debug (fun m -> m "Successfully parsed JSON response");
560
-
Lwt.return (parse_response json)
561
-
| Error e ->
562
-
let msg = match e with Parse_error m -> m | _ -> "unknown error" in
563
-
Logs.err (fun m -> m "Failed to parse response: %s" msg);
564
-
Lwt.return (Error e))
565
-
| Error e ->
566
-
(match e with
567
-
| Connection_error msg -> Logs.err (fun m -> m "Connection error: %s" msg)
568
-
| HTTP_error (code, _) -> Logs.err (fun m -> m "HTTP error %d" code)
569
-
| Parse_error msg -> Logs.err (fun m -> m "Parse error: %s" msg)
570
-
| Authentication_error -> Logs.err (fun m -> m "Authentication error"));
571
-
Lwt.return (Error e)
572
-
573
-
(** Parse a JSON object as a Session object *)
574
-
let parse_session_object json =
575
-
try
576
-
let capabilities =
577
-
match Ezjsonm.find json ["capabilities"] with
578
-
| `O items -> items
579
-
| _ -> raise (Invalid_argument "capabilities is not an object")
580
-
in
581
-
582
-
let accounts =
583
-
match Ezjsonm.find json ["accounts"] with
584
-
| `O items -> List.map (fun (id, json) ->
585
-
match json with
586
-
| `O _ ->
587
-
let name = Ezjsonm.get_string (Ezjsonm.find json ["name"]) in
588
-
let is_personal = Ezjsonm.get_bool (Ezjsonm.find json ["isPersonal"]) in
589
-
let is_read_only = Ezjsonm.get_bool (Ezjsonm.find json ["isReadOnly"]) in
590
-
let account_capabilities =
591
-
match Ezjsonm.find json ["accountCapabilities"] with
592
-
| `O items -> items
593
-
| _ -> raise (Invalid_argument "accountCapabilities is not an object")
594
-
in
595
-
(id, { name; is_personal; is_read_only; account_capabilities })
596
-
| _ -> raise (Invalid_argument "account value is not an object")
597
-
) items
598
-
| _ -> raise (Invalid_argument "accounts is not an object")
599
-
in
600
-
601
-
let primary_accounts =
602
-
match Ezjsonm.find_opt json ["primaryAccounts"] with
603
-
| Some (`O items) -> List.map (fun (k, v) ->
604
-
match v with
605
-
| `String id -> (k, id)
606
-
| _ -> raise (Invalid_argument "primaryAccounts value is not a string")
607
-
) items
608
-
| Some _ -> raise (Invalid_argument "primaryAccounts is not an object")
609
-
| None -> []
610
-
in
611
-
612
-
let username = Ezjsonm.get_string (Ezjsonm.find json ["username"]) in
613
-
let api_url = Ezjsonm.get_string (Ezjsonm.find json ["apiUrl"]) in
614
-
let download_url = Ezjsonm.get_string (Ezjsonm.find json ["downloadUrl"]) in
615
-
let upload_url = Ezjsonm.get_string (Ezjsonm.find json ["uploadUrl"]) in
616
-
let event_source_url =
617
-
try Some (Ezjsonm.get_string (Ezjsonm.find json ["eventSourceUrl"]))
618
-
with Not_found -> None
619
-
in
620
-
let state = Ezjsonm.get_string (Ezjsonm.find json ["state"]) in
621
-
622
-
Ok { capabilities; accounts; primary_accounts; username;
623
-
api_url; download_url; upload_url; event_source_url; state }
624
-
with
625
-
| Not_found -> Error (Parse_error "Required field not found in session object")
626
-
| Invalid_argument msg -> Error (Parse_error msg)
627
-
| e -> Error (Parse_error (Printexc.to_string e))
628
-
629
-
(** Fetch a Session object from a JMAP server
630
-
631
-
TODO:claude *)
632
-
let get_session uri ?username ?authentication_token ?api_token () =
633
-
let headers =
634
-
match (username, authentication_token, api_token) with
635
-
| (Some u, Some t, _) ->
636
-
let auth = "Basic " ^ Base64.encode_string (u ^ ":" ^ t) in
637
-
let redacted_auth = "Basic " ^ redact_token (Base64.encode_string (u ^ ":" ^ t)) in
638
-
Logs.info (fun m -> m "Session using Basic auth: %s" redacted_auth);
639
-
[
640
-
("Content-Type", "application/json");
641
-
("Authorization", auth)
642
-
]
643
-
| (_, _, Some token) ->
644
-
let auth = "Bearer " ^ token in
645
-
let redacted_token = redact_token token in
646
-
Logs.info (fun m -> m "Session using Bearer auth: %s" ("Bearer " ^ redacted_token));
647
-
[
648
-
("Content-Type", "application/json");
649
-
("Authorization", auth)
650
-
]
651
-
| _ -> [("Content-Type", "application/json")]
652
-
in
653
-
654
-
let* result = make_http_request ~method_:"GET" ~headers ~body:"" uri in
655
-
match result with
656
-
| Ok response_body ->
657
-
(match parse_json_string response_body with
658
-
| Ok json ->
659
-
Logs.debug (fun m -> m "Successfully parsed session response");
660
-
Lwt.return (parse_session_object json)
661
-
| Error e ->
662
-
let msg = match e with Parse_error m -> m | _ -> "unknown error" in
663
-
Logs.err (fun m -> m "Failed to parse session response: %s" msg);
664
-
Lwt.return (Error e))
665
-
| Error e ->
666
-
let err_msg = match e with
667
-
| Connection_error msg -> "Connection error: " ^ msg
668
-
| HTTP_error (code, _) -> Printf.sprintf "HTTP error %d" code
669
-
| Parse_error msg -> "Parse error: " ^ msg
670
-
| Authentication_error -> "Authentication error"
671
-
in
672
-
Logs.err (fun m -> m "Failed to get session: %s" err_msg);
673
-
Lwt.return (Error e)
674
-
675
-
(** Upload a binary blob to the server
676
-
677
-
TODO:claude *)
678
-
let upload_blob config ~account_id ~content_type data =
679
-
let upload_url_template = config.api_uri |> Uri.to_string in
680
-
(* Replace {accountId} with the actual account ID *)
681
-
let upload_url = Str.global_replace (Str.regexp "{accountId}") account_id upload_url_template in
682
-
let upload_uri = Uri.of_string upload_url in
683
-
684
-
let headers = [
685
-
("Content-Type", content_type);
686
-
("Content-Length", string_of_int (String.length data));
687
-
("Authorization", "Basic " ^ Base64.encode_string (config.username ^ ":" ^ config.authentication_token))
688
-
] in
689
-
690
-
let* result = make_http_request ~method_:"POST" ~headers ~body:data upload_uri in
691
-
match result with
692
-
| Ok response_body ->
693
-
(match parse_json_string response_body with
694
-
| Ok json ->
695
-
(try
696
-
let account_id = Ezjsonm.get_string (Ezjsonm.find json ["accountId"]) in
697
-
let blob_id = Ezjsonm.get_string (Ezjsonm.find json ["blobId"]) in
698
-
let type_ = Ezjsonm.get_string (Ezjsonm.find json ["type"]) in
699
-
let size = Ezjsonm.get_int (Ezjsonm.find json ["size"]) in
700
-
Lwt.return (Ok { account_id; blob_id; type_; size })
701
-
with
702
-
| Not_found -> Lwt.return (Error (Parse_error "Required field not found in upload response"))
703
-
| e -> Lwt.return (Error (Parse_error (Printexc.to_string e))))
704
-
| Error e -> Lwt.return (Error e))
705
-
| Error e -> Lwt.return (Error e)
706
-
707
-
(** Download a binary blob from the server
708
-
709
-
TODO:claude *)
710
-
let download_blob config ~account_id ~blob_id ?type_ ?name () =
711
-
let download_url_template = config.api_uri |> Uri.to_string in
712
-
713
-
(* Replace template variables with actual values *)
714
-
let url = Str.global_replace (Str.regexp "{accountId}") account_id download_url_template in
715
-
let url = Str.global_replace (Str.regexp "{blobId}") blob_id url in
716
-
717
-
let url = match type_ with
718
-
| Some t -> Str.global_replace (Str.regexp "{type}") (Uri.pct_encode t) url
719
-
| None -> Str.global_replace (Str.regexp "{type}") "" url
720
-
in
721
-
722
-
let url = match name with
723
-
| Some n -> Str.global_replace (Str.regexp "{name}") (Uri.pct_encode n) url
724
-
| None -> Str.global_replace (Str.regexp "{name}") "file" url
725
-
in
726
-
727
-
let download_uri = Uri.of_string url in
728
-
729
-
let headers = [
730
-
("Authorization", "Basic " ^ Base64.encode_string (config.username ^ ":" ^ config.authentication_token))
731
-
] in
732
-
733
-
let* result = make_http_request ~method_:"GET" ~headers ~body:"" download_uri in
734
-
Lwt.return result
735
-
end
-398
lib/jmap.mli
-398
lib/jmap.mli
···
1
-
(**
2
-
* JMAP protocol implementation based on RFC8620
3
-
* https://datatracker.ietf.org/doc/html/rfc8620
4
-
*)
5
-
6
-
(** Initialize and configure logging for JMAP *)
7
-
val init_logging : ?level:int -> ?enable_logs:bool -> ?redact_sensitive:bool -> unit -> unit
8
-
9
-
(** Redact sensitive data like tokens *)
10
-
val redact_token : ?redact:bool -> string -> string
11
-
12
-
(** Module for managing JMAP capability URIs and other constants *)
13
-
module Capability : sig
14
-
(** JMAP capability URI as specified in RFC8620 *)
15
-
val core_uri : string
16
-
17
-
(** All JMAP capability types *)
18
-
type t =
19
-
| Core (** Core JMAP capability *)
20
-
| Extension of string (** Extension capabilities *)
21
-
22
-
(** Convert capability to URI string *)
23
-
val to_string : t -> string
24
-
25
-
(** Parse a string to a capability, returns Extension for non-core capabilities *)
26
-
val of_string : string -> t
27
-
28
-
(** Check if a capability matches a core capability *)
29
-
val is_core : t -> bool
30
-
31
-
(** Check if a capability string is a core capability *)
32
-
val is_core_string : string -> bool
33
-
34
-
(** Create a list of capability strings *)
35
-
val strings_of_capabilities : t list -> string list
36
-
end
37
-
38
-
(** {1 Types} *)
39
-
40
-
module Types : sig
41
-
(** Id string as per Section 1.2 *)
42
-
type id = string
43
-
44
-
(** Int bounded within the range -2^53+1 to 2^53-1 as per Section 1.3 *)
45
-
type int_t = int
46
-
47
-
(** UnsignedInt bounded within the range 0 to 2^53-1 as per Section 1.3 *)
48
-
type unsigned_int = int
49
-
50
-
(** Date string in RFC3339 format as per Section 1.4 *)
51
-
type date = string
52
-
53
-
(** UTCDate is a Date with 'Z' time zone as per Section 1.4 *)
54
-
type utc_date = string
55
-
56
-
(** Error object as per Section 3.6.2 *)
57
-
type error = {
58
-
type_: string;
59
-
description: string option;
60
-
}
61
-
62
-
(** Set error object as per Section 5.3 *)
63
-
type set_error = {
64
-
type_: string;
65
-
description: string option;
66
-
properties: string list option;
67
-
(* Additional properties for specific error types *)
68
-
existing_id: id option; (* For alreadyExists error *)
69
-
}
70
-
71
-
(** Invocation object as per Section 3.2 *)
72
-
type 'a invocation = {
73
-
name: string;
74
-
arguments: 'a;
75
-
method_call_id: string;
76
-
}
77
-
78
-
(** ResultReference object as per Section 3.7 *)
79
-
type result_reference = {
80
-
result_of: string;
81
-
name: string;
82
-
path: string;
83
-
}
84
-
85
-
(** FilterOperator, FilterCondition and Filter as per Section 5.5 *)
86
-
type filter_operator = {
87
-
operator: string; (* "AND", "OR", "NOT" *)
88
-
conditions: filter list;
89
-
}
90
-
and filter_condition = (string * Ezjsonm.value) list
91
-
and filter =
92
-
| Operator of filter_operator
93
-
| Condition of filter_condition
94
-
95
-
(** Comparator object for sorting as per Section 5.5 *)
96
-
type comparator = {
97
-
property: string;
98
-
is_ascending: bool option; (* Optional, defaults to true *)
99
-
collation: string option; (* Optional, server-dependent default *)
100
-
}
101
-
102
-
(** PatchObject as per Section 5.3 *)
103
-
type patch_object = (string * Ezjsonm.value) list
104
-
105
-
(** AddedItem structure as per Section 5.6 *)
106
-
type added_item = {
107
-
id: id;
108
-
index: unsigned_int;
109
-
}
110
-
111
-
(** Account object as per Section 1.6.2 *)
112
-
type account = {
113
-
name: string;
114
-
is_personal: bool;
115
-
is_read_only: bool;
116
-
account_capabilities: (string * Ezjsonm.value) list;
117
-
}
118
-
119
-
(** Core capability object as per Section 2 *)
120
-
type core_capability = {
121
-
max_size_upload: unsigned_int;
122
-
max_concurrent_upload: unsigned_int;
123
-
max_size_request: unsigned_int;
124
-
max_concurrent_requests: unsigned_int;
125
-
max_calls_in_request: unsigned_int;
126
-
max_objects_in_get: unsigned_int;
127
-
max_objects_in_set: unsigned_int;
128
-
collation_algorithms: string list;
129
-
}
130
-
131
-
(** PushSubscription keys object as per Section 7.2 *)
132
-
type push_keys = {
133
-
p256dh: string;
134
-
auth: string;
135
-
}
136
-
137
-
(** Session object as per Section 2 *)
138
-
type session = {
139
-
capabilities: (string * Ezjsonm.value) list;
140
-
accounts: (id * account) list;
141
-
primary_accounts: (string * id) list;
142
-
username: string;
143
-
api_url: string;
144
-
download_url: string;
145
-
upload_url: string;
146
-
event_source_url: string option;
147
-
state: string;
148
-
}
149
-
150
-
(** TypeState for state changes as per Section 7.1 *)
151
-
type type_state = (string * string) list
152
-
153
-
(** StateChange object as per Section 7.1 *)
154
-
type state_change = {
155
-
changed: (id * type_state) list;
156
-
}
157
-
158
-
(** PushVerification object as per Section 7.2.2 *)
159
-
type push_verification = {
160
-
push_subscription_id: id;
161
-
verification_code: string;
162
-
}
163
-
164
-
(** PushSubscription object as per Section 7.2 *)
165
-
type push_subscription = {
166
-
id: id;
167
-
device_client_id: string;
168
-
url: string;
169
-
keys: push_keys option;
170
-
verification_code: string option;
171
-
expires: utc_date option;
172
-
types: string list option;
173
-
}
174
-
175
-
(** Request object as per Section 3.3 *)
176
-
type request = {
177
-
using: string list;
178
-
method_calls: Ezjsonm.value invocation list;
179
-
created_ids: (id * id) list option;
180
-
}
181
-
182
-
(** Response object as per Section 3.4 *)
183
-
type response = {
184
-
method_responses: Ezjsonm.value invocation list;
185
-
created_ids: (id * id) list option;
186
-
session_state: string;
187
-
}
188
-
189
-
(** Standard method arguments and responses *)
190
-
191
-
(** Arguments for Foo/get method as per Section 5.1 *)
192
-
type 'a get_arguments = {
193
-
account_id: id;
194
-
ids: id list option;
195
-
properties: string list option;
196
-
}
197
-
198
-
(** Response for Foo/get method as per Section 5.1 *)
199
-
type 'a get_response = {
200
-
account_id: id;
201
-
state: string;
202
-
list: 'a list;
203
-
not_found: id list;
204
-
}
205
-
206
-
(** Arguments for Foo/changes method as per Section 5.2 *)
207
-
type changes_arguments = {
208
-
account_id: id;
209
-
since_state: string;
210
-
max_changes: unsigned_int option;
211
-
}
212
-
213
-
(** Response for Foo/changes method as per Section 5.2 *)
214
-
type changes_response = {
215
-
account_id: id;
216
-
old_state: string;
217
-
new_state: string;
218
-
has_more_changes: bool;
219
-
created: id list;
220
-
updated: id list;
221
-
destroyed: id list;
222
-
}
223
-
224
-
(** Arguments for Foo/set method as per Section 5.3 *)
225
-
type 'a set_arguments = {
226
-
account_id: id;
227
-
if_in_state: string option;
228
-
create: (id * 'a) list option;
229
-
update: (id * patch_object) list option;
230
-
destroy: id list option;
231
-
}
232
-
233
-
(** Response for Foo/set method as per Section 5.3 *)
234
-
type 'a set_response = {
235
-
account_id: id;
236
-
old_state: string option;
237
-
new_state: string;
238
-
created: (id * 'a) list option;
239
-
updated: (id * 'a option) list option;
240
-
destroyed: id list option;
241
-
not_created: (id * set_error) list option;
242
-
not_updated: (id * set_error) list option;
243
-
not_destroyed: (id * set_error) list option;
244
-
}
245
-
246
-
(** Arguments for Foo/copy method as per Section 5.4 *)
247
-
type 'a copy_arguments = {
248
-
from_account_id: id;
249
-
if_from_in_state: string option;
250
-
account_id: id;
251
-
if_in_state: string option;
252
-
create: (id * 'a) list;
253
-
on_success_destroy_original: bool option;
254
-
destroy_from_if_in_state: string option;
255
-
}
256
-
257
-
(** Response for Foo/copy method as per Section 5.4 *)
258
-
type 'a copy_response = {
259
-
from_account_id: id;
260
-
account_id: id;
261
-
old_state: string option;
262
-
new_state: string;
263
-
created: (id * 'a) list option;
264
-
not_created: (id * set_error) list option;
265
-
}
266
-
267
-
(** Arguments for Foo/query method as per Section 5.5 *)
268
-
type query_arguments = {
269
-
account_id: id;
270
-
filter: filter option;
271
-
sort: comparator list option;
272
-
position: int_t option;
273
-
anchor: id option;
274
-
anchor_offset: int_t option;
275
-
limit: unsigned_int option;
276
-
calculate_total: bool option;
277
-
}
278
-
279
-
(** Response for Foo/query method as per Section 5.5 *)
280
-
type query_response = {
281
-
account_id: id;
282
-
query_state: string;
283
-
can_calculate_changes: bool;
284
-
position: unsigned_int;
285
-
ids: id list;
286
-
total: unsigned_int option;
287
-
limit: unsigned_int option;
288
-
}
289
-
290
-
(** Arguments for Foo/queryChanges method as per Section 5.6 *)
291
-
type query_changes_arguments = {
292
-
account_id: id;
293
-
filter: filter option;
294
-
sort: comparator list option;
295
-
since_query_state: string;
296
-
max_changes: unsigned_int option;
297
-
up_to_id: id option;
298
-
calculate_total: bool option;
299
-
}
300
-
301
-
(** Response for Foo/queryChanges method as per Section 5.6 *)
302
-
type query_changes_response = {
303
-
account_id: id;
304
-
old_query_state: string;
305
-
new_query_state: string;
306
-
total: unsigned_int option;
307
-
removed: id list;
308
-
added: added_item list option;
309
-
}
310
-
311
-
(** Arguments for Blob/copy method as per Section 6.3 *)
312
-
type blob_copy_arguments = {
313
-
from_account_id: id;
314
-
account_id: id;
315
-
blob_ids: id list;
316
-
}
317
-
318
-
(** Response for Blob/copy method as per Section 6.3 *)
319
-
type blob_copy_response = {
320
-
from_account_id: id;
321
-
account_id: id;
322
-
copied: (id * id) list option;
323
-
not_copied: (id * set_error) list option;
324
-
}
325
-
326
-
(** Upload response as per Section 6.1 *)
327
-
type upload_response = {
328
-
account_id: id;
329
-
blob_id: id;
330
-
type_: string;
331
-
size: unsigned_int;
332
-
}
333
-
334
-
(** Problem details object as per RFC7807 and Section 3.6.1 *)
335
-
type problem_details = {
336
-
type_: string;
337
-
status: int option;
338
-
detail: string option;
339
-
limit: string option; (* For "limit" error *)
340
-
}
341
-
end
342
-
343
-
(** {1 API Client} *)
344
-
345
-
(** Module for making JMAP API requests over HTTP.
346
-
Provides functionality to interact with JMAP servers according to RFC8620. *)
347
-
module Api : sig
348
-
(** Error that may occur during API requests *)
349
-
type error =
350
-
| Connection_error of string
351
-
| HTTP_error of int * string
352
-
| Parse_error of string
353
-
| Authentication_error
354
-
355
-
(** Result type for API operations *)
356
-
type 'a result = ('a, error) Stdlib.result
357
-
358
-
(** Configuration for a JMAP API client *)
359
-
type config = {
360
-
api_uri: Uri.t;
361
-
username: string;
362
-
authentication_token: string;
363
-
}
364
-
365
-
(** Make a raw JMAP API request *)
366
-
val make_request :
367
-
config ->
368
-
Types.request ->
369
-
Types.response result Lwt.t
370
-
371
-
(** Fetch a Session object from a JMAP server.
372
-
Can authenticate with either username/password or API token. *)
373
-
val get_session :
374
-
Uri.t ->
375
-
?username:string ->
376
-
?authentication_token:string ->
377
-
?api_token:string ->
378
-
unit ->
379
-
Types.session result Lwt.t
380
-
381
-
(** Upload a binary blob to the server *)
382
-
val upload_blob :
383
-
config ->
384
-
account_id:Types.id ->
385
-
content_type:string ->
386
-
string ->
387
-
Types.upload_response result Lwt.t
388
-
389
-
(** Download a binary blob from the server *)
390
-
val download_blob :
391
-
config ->
392
-
account_id:Types.id ->
393
-
blob_id:Types.id ->
394
-
?type_:string ->
395
-
?name:string ->
396
-
unit ->
397
-
string result Lwt.t
398
-
end
-1898
lib/jmap_mail.ml
-1898
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
-
end
1029
-
1030
-
(** {1 JSON serialization} *)
1031
-
1032
-
module Json = struct
1033
-
open Types
1034
-
1035
-
(** {2 Helper functions for serialization} *)
1036
-
1037
-
let string_of_mailbox_role = function
1038
-
| All -> "all"
1039
-
| Archive -> "archive"
1040
-
| Drafts -> "drafts"
1041
-
| Flagged -> "flagged"
1042
-
| Important -> "important"
1043
-
| Inbox -> "inbox"
1044
-
| Junk -> "junk"
1045
-
| Sent -> "sent"
1046
-
| Trash -> "trash"
1047
-
| Unknown s -> s
1048
-
1049
-
let mailbox_role_of_string = function
1050
-
| "all" -> All
1051
-
| "archive" -> Archive
1052
-
| "drafts" -> Drafts
1053
-
| "flagged" -> Flagged
1054
-
| "important" -> Important
1055
-
| "inbox" -> Inbox
1056
-
| "junk" -> Junk
1057
-
| "sent" -> Sent
1058
-
| "trash" -> Trash
1059
-
| s -> Unknown s
1060
-
1061
-
let string_of_keyword = function
1062
-
| Flagged -> "$flagged"
1063
-
| Answered -> "$answered"
1064
-
| Draft -> "$draft"
1065
-
| Forwarded -> "$forwarded"
1066
-
| Phishing -> "$phishing"
1067
-
| Junk -> "$junk"
1068
-
| NotJunk -> "$notjunk"
1069
-
| Seen -> "$seen"
1070
-
| Unread -> "$unread"
1071
-
| Custom s -> s
1072
-
1073
-
let keyword_of_string = function
1074
-
| "$flagged" -> Flagged
1075
-
| "$answered" -> Answered
1076
-
| "$draft" -> Draft
1077
-
| "$forwarded" -> Forwarded
1078
-
| "$phishing" -> Phishing
1079
-
| "$junk" -> Junk
1080
-
| "$notjunk" -> NotJunk
1081
-
| "$seen" -> Seen
1082
-
| "$unread" -> Unread
1083
-
| s -> Custom s
1084
-
1085
-
(** {2 Mailbox serialization} *)
1086
-
1087
-
(** TODO:claude - Need to implement all JSON serialization functions
1088
-
for each type we've defined. This would be a substantial amount of
1089
-
code and likely require additional understanding of the ezjsonm API.
1090
-
1091
-
For a full implementation, we would need functions to convert between
1092
-
OCaml types and JSON for each of:
1093
-
- mailbox, mailbox_rights, mailbox query/update operations
1094
-
- thread operations
1095
-
- email, email_address, header, email_body_part
1096
-
- email query/update operations
1097
-
- submission operations
1098
-
- identity operations
1099
-
- vacation response operations
1100
-
*)
1101
-
end
1102
-
1103
-
(** {1 API functions} *)
1104
-
1105
-
open Lwt.Syntax
1106
-
open Jmap.Api
1107
-
open Jmap.Types
1108
-
1109
-
(** Authentication credentials for a JMAP server *)
1110
-
type credentials = {
1111
-
username: string;
1112
-
password: string;
1113
-
}
1114
-
1115
-
(** Connection to a JMAP mail server *)
1116
-
type connection = {
1117
-
session: Jmap.Types.session;
1118
-
config: Jmap.Api.config;
1119
-
}
1120
-
1121
-
(** Convert JSON mail object to OCaml type *)
1122
-
let mailbox_of_json json =
1123
-
try
1124
-
let open Ezjsonm in
1125
-
Printf.printf "Parsing mailbox JSON\n";
1126
-
1127
-
let id = get_string (find json ["id"]) in
1128
-
Printf.printf "Got id: %s\n" id;
1129
-
1130
-
let name = get_string (find json ["name"]) in
1131
-
Printf.printf "Got name: %s\n" name;
1132
-
1133
-
(* Handle parentId which can be null *)
1134
-
let parent_id =
1135
-
match find_opt json ["parentId"] with
1136
-
| Some (`Null) -> None
1137
-
| Some (`String s) -> Some s
1138
-
| None -> None
1139
-
| _ -> None
1140
-
in
1141
-
Printf.printf "Got parent_id: %s\n" (match parent_id with Some p -> p | None -> "None");
1142
-
1143
-
(* Handle role which might be null *)
1144
-
let role =
1145
-
match find_opt json ["role"] with
1146
-
| Some (`Null) -> None
1147
-
| Some (`String s) -> Some (Json.mailbox_role_of_string s)
1148
-
| None -> None
1149
-
| _ -> None
1150
-
in
1151
-
Printf.printf "Got role\n";
1152
-
1153
-
let sort_order = get_int (find json ["sortOrder"]) in
1154
-
Printf.printf "Got sort_order: %d\n" sort_order;
1155
-
1156
-
let total_emails = get_int (find json ["totalEmails"]) in
1157
-
Printf.printf "Got total_emails: %d\n" total_emails;
1158
-
1159
-
let unread_emails = get_int (find json ["unreadEmails"]) in
1160
-
Printf.printf "Got unread_emails: %d\n" unread_emails;
1161
-
1162
-
let total_threads = get_int (find json ["totalThreads"]) in
1163
-
Printf.printf "Got total_threads: %d\n" total_threads;
1164
-
1165
-
let unread_threads = get_int (find json ["unreadThreads"]) in
1166
-
Printf.printf "Got unread_threads: %d\n" unread_threads;
1167
-
1168
-
let is_subscribed = get_bool (find json ["isSubscribed"]) in
1169
-
Printf.printf "Got is_subscribed: %b\n" is_subscribed;
1170
-
1171
-
let rights_json = find json ["myRights"] in
1172
-
Printf.printf "Got rights_json\n";
1173
-
1174
-
let my_rights = {
1175
-
Types.may_read_items = get_bool (find rights_json ["mayReadItems"]);
1176
-
may_add_items = get_bool (find rights_json ["mayAddItems"]);
1177
-
may_remove_items = get_bool (find rights_json ["mayRemoveItems"]);
1178
-
may_set_seen = get_bool (find rights_json ["maySetSeen"]);
1179
-
may_set_keywords = get_bool (find rights_json ["maySetKeywords"]);
1180
-
may_create_child = get_bool (find rights_json ["mayCreateChild"]);
1181
-
may_rename = get_bool (find rights_json ["mayRename"]);
1182
-
may_delete = get_bool (find rights_json ["mayDelete"]);
1183
-
may_submit = get_bool (find rights_json ["maySubmit"]);
1184
-
} in
1185
-
Printf.printf "Constructed my_rights\n";
1186
-
1187
-
let result = {
1188
-
Types.id;
1189
-
name;
1190
-
parent_id;
1191
-
role;
1192
-
sort_order;
1193
-
total_emails;
1194
-
unread_emails;
1195
-
total_threads;
1196
-
unread_threads;
1197
-
is_subscribed;
1198
-
my_rights;
1199
-
} in
1200
-
Printf.printf "Constructed mailbox result\n";
1201
-
1202
-
Ok (result)
1203
-
with
1204
-
| Not_found as e ->
1205
-
Printf.printf "Not_found error: %s\n" (Printexc.to_string e);
1206
-
Printexc.print_backtrace stdout;
1207
-
Error (Parse_error "Required field not found in mailbox object")
1208
-
| Invalid_argument msg ->
1209
-
Printf.printf "Invalid_argument error: %s\n" msg;
1210
-
Error (Parse_error msg)
1211
-
| e ->
1212
-
Printf.printf "Unknown error: %s\n" (Printexc.to_string e);
1213
-
Error (Parse_error (Printexc.to_string e))
1214
-
1215
-
(** Convert JSON email object to OCaml type *)
1216
-
let email_of_json json =
1217
-
try
1218
-
let open Ezjsonm in
1219
-
Printf.printf "Parsing email JSON\n";
1220
-
1221
-
let id = get_string (find json ["id"]) in
1222
-
Printf.printf "Got email id: %s\n" id;
1223
-
1224
-
let blob_id = get_string (find json ["blobId"]) in
1225
-
let thread_id = get_string (find json ["threadId"]) in
1226
-
1227
-
(* Process mailboxIds map *)
1228
-
let mailbox_ids_json = find json ["mailboxIds"] in
1229
-
let mailbox_ids = match mailbox_ids_json with
1230
-
| `O items -> List.map (fun (id, v) -> (id, get_bool v)) items
1231
-
| _ -> raise (Invalid_argument "mailboxIds is not an object")
1232
-
in
1233
-
1234
-
(* Process keywords map *)
1235
-
let keywords_json = find json ["keywords"] in
1236
-
let keywords = match keywords_json with
1237
-
| `O items -> List.map (fun (k, v) ->
1238
-
(Json.keyword_of_string k, get_bool v)) items
1239
-
| _ -> raise (Invalid_argument "keywords is not an object")
1240
-
in
1241
-
1242
-
let size = get_int (find json ["size"]) in
1243
-
let received_at = get_string (find json ["receivedAt"]) in
1244
-
1245
-
(* Handle messageId which might be an array or missing *)
1246
-
let message_id =
1247
-
match find_opt json ["messageId"] with
1248
-
| Some (`A ids) -> List.map (fun id ->
1249
-
match id with
1250
-
| `String s -> s
1251
-
| _ -> raise (Invalid_argument "messageId item is not a string")
1252
-
) ids
1253
-
| Some (`String s) -> [s] (* Handle single string case *)
1254
-
| None -> [] (* Handle missing case *)
1255
-
| _ -> raise (Invalid_argument "messageId has unexpected type")
1256
-
in
1257
-
1258
-
(* Parse optional fields *)
1259
-
let parse_email_addresses opt_json =
1260
-
match opt_json with
1261
-
| Some (`A items) ->
1262
-
Some (List.map (fun addr_json ->
1263
-
let name =
1264
-
match find_opt addr_json ["name"] with
1265
-
| Some (`String s) -> Some s
1266
-
| Some (`Null) -> None
1267
-
| None -> None
1268
-
| _ -> None
1269
-
in
1270
-
let email = get_string (find addr_json ["email"]) in
1271
-
let parameters =
1272
-
match find_opt addr_json ["parameters"] with
1273
-
| Some (`O items) -> List.map (fun (k, v) ->
1274
-
match v with
1275
-
| `String s -> (k, s)
1276
-
| _ -> (k, "")
1277
-
) items
1278
-
| _ -> []
1279
-
in
1280
-
{ Types.name; email; parameters }
1281
-
) items)
1282
-
| _ -> None
1283
-
in
1284
-
1285
-
(* Handle optional string arrays with null handling *)
1286
-
let parse_string_array_opt field_name =
1287
-
match find_opt json [field_name] with
1288
-
| Some (`A ids) ->
1289
-
Some (List.filter_map (function
1290
-
| `String s -> Some s
1291
-
| _ -> None
1292
-
) ids)
1293
-
| Some (`Null) -> None
1294
-
| None -> None
1295
-
| _ -> None
1296
-
in
1297
-
1298
-
let in_reply_to = parse_string_array_opt "inReplyTo" in
1299
-
let references = parse_string_array_opt "references" in
1300
-
1301
-
let sender = parse_email_addresses (find_opt json ["sender"]) in
1302
-
let from = parse_email_addresses (find_opt json ["from"]) in
1303
-
let to_ = parse_email_addresses (find_opt json ["to"]) in
1304
-
let cc = parse_email_addresses (find_opt json ["cc"]) in
1305
-
let bcc = parse_email_addresses (find_opt json ["bcc"]) in
1306
-
let reply_to = parse_email_addresses (find_opt json ["replyTo"]) in
1307
-
1308
-
(* Handle optional string fields with null handling *)
1309
-
let parse_string_opt field_name =
1310
-
match find_opt json [field_name] with
1311
-
| Some (`String s) -> Some s
1312
-
| Some (`Null) -> None
1313
-
| None -> None
1314
-
| _ -> None
1315
-
in
1316
-
1317
-
let subject = parse_string_opt "subject" in
1318
-
let sent_at = parse_string_opt "sentAt" in
1319
-
1320
-
(* Handle optional boolean fields with null handling *)
1321
-
let parse_bool_opt field_name =
1322
-
match find_opt json [field_name] with
1323
-
| Some (`Bool b) -> Some b
1324
-
| Some (`Null) -> None
1325
-
| None -> None
1326
-
| _ -> None
1327
-
in
1328
-
1329
-
let has_attachment = parse_bool_opt "hasAttachment" in
1330
-
let preview = parse_string_opt "preview" in
1331
-
1332
-
(* Body parts parsing would go here - omitting for brevity *)
1333
-
Printf.printf "Email parsed successfully\n";
1334
-
1335
-
Ok ({
1336
-
Types.id;
1337
-
blob_id;
1338
-
thread_id;
1339
-
mailbox_ids;
1340
-
keywords;
1341
-
size;
1342
-
received_at;
1343
-
message_id;
1344
-
in_reply_to;
1345
-
references;
1346
-
sender;
1347
-
from;
1348
-
to_;
1349
-
cc;
1350
-
bcc;
1351
-
reply_to;
1352
-
subject;
1353
-
sent_at;
1354
-
has_attachment;
1355
-
preview;
1356
-
body_values = None;
1357
-
text_body = None;
1358
-
html_body = None;
1359
-
attachments = None;
1360
-
headers = None;
1361
-
})
1362
-
with
1363
-
| Not_found as e ->
1364
-
Printf.printf "Email parse error - Not_found: %s\n" (Printexc.to_string e);
1365
-
Printexc.print_backtrace stdout;
1366
-
Error (Parse_error "Required field not found in email object")
1367
-
| Invalid_argument msg ->
1368
-
Printf.printf "Email parse error - Invalid_argument: %s\n" msg;
1369
-
Error (Parse_error msg)
1370
-
| e ->
1371
-
Printf.printf "Email parse error - Unknown: %s\n" (Printexc.to_string e);
1372
-
Error (Parse_error (Printexc.to_string e))
1373
-
1374
-
(** Login to a JMAP server and establish a connection
1375
-
@param uri The URI of the JMAP server
1376
-
@param credentials Authentication credentials
1377
-
@return A connection object if successful
1378
-
1379
-
TODO:claude *)
1380
-
let login ~uri ~credentials =
1381
-
let* session_result = get_session (Uri.of_string uri)
1382
-
~username:credentials.username
1383
-
~authentication_token:credentials.password
1384
-
() in
1385
-
match session_result with
1386
-
| Ok session ->
1387
-
let api_uri = Uri.of_string session.api_url in
1388
-
let config = {
1389
-
api_uri;
1390
-
username = credentials.username;
1391
-
authentication_token = credentials.password;
1392
-
} in
1393
-
Lwt.return (Ok { session; config })
1394
-
| Error e -> Lwt.return (Error e)
1395
-
1396
-
(** Login to a JMAP server using an API token
1397
-
@param uri The URI of the JMAP server
1398
-
@param api_token The API token for authentication
1399
-
@return A connection object if successful
1400
-
1401
-
TODO:claude *)
1402
-
let login_with_token ~uri ~api_token =
1403
-
let* session_result = get_session (Uri.of_string uri)
1404
-
~api_token
1405
-
() in
1406
-
match session_result with
1407
-
| Ok session ->
1408
-
let api_uri = Uri.of_string session.api_url in
1409
-
let config = {
1410
-
api_uri;
1411
-
username = ""; (* Empty username indicates we're using token auth *)
1412
-
authentication_token = api_token;
1413
-
} in
1414
-
Lwt.return (Ok { session; config })
1415
-
| Error e -> Lwt.return (Error e)
1416
-
1417
-
(** Get all mailboxes for an account
1418
-
@param conn The JMAP connection
1419
-
@param account_id The account ID to get mailboxes for
1420
-
@return A list of mailboxes if successful
1421
-
1422
-
TODO:claude *)
1423
-
let get_mailboxes conn ~account_id =
1424
-
let request = {
1425
-
using = [
1426
-
Jmap.Capability.to_string Jmap.Capability.Core;
1427
-
Capability.to_string Capability.Mail
1428
-
];
1429
-
method_calls = [
1430
-
{
1431
-
name = "Mailbox/get";
1432
-
arguments = `O [
1433
-
("accountId", `String account_id);
1434
-
];
1435
-
method_call_id = "m1";
1436
-
}
1437
-
];
1438
-
created_ids = None;
1439
-
} in
1440
-
1441
-
let* response_result = make_request conn.config request in
1442
-
match response_result with
1443
-
| Ok response ->
1444
-
let result =
1445
-
try
1446
-
let method_response = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) ->
1447
-
inv.name = "Mailbox/get") response.method_responses in
1448
-
let args = method_response.arguments in
1449
-
match Ezjsonm.find_opt args ["list"] with
1450
-
| Some (`A mailbox_list) ->
1451
-
let parse_results = List.map mailbox_of_json mailbox_list in
1452
-
let (successes, failures) = List.partition Result.is_ok parse_results in
1453
-
if List.length failures > 0 then
1454
-
Error (Parse_error "Failed to parse some mailboxes")
1455
-
else
1456
-
Ok (List.map Result.get_ok successes)
1457
-
| _ -> Error (Parse_error "Mailbox list not found in response")
1458
-
with
1459
-
| Not_found -> Error (Parse_error "Mailbox/get method response not found")
1460
-
| e -> Error (Parse_error (Printexc.to_string e))
1461
-
in
1462
-
Lwt.return result
1463
-
| Error e -> Lwt.return (Error e)
1464
-
1465
-
(** Get a specific mailbox by ID
1466
-
@param conn The JMAP connection
1467
-
@param account_id The account ID
1468
-
@param mailbox_id The mailbox ID to retrieve
1469
-
@return The mailbox if found
1470
-
1471
-
TODO:claude *)
1472
-
let get_mailbox conn ~account_id ~mailbox_id =
1473
-
let request = {
1474
-
using = [
1475
-
Jmap.Capability.to_string Jmap.Capability.Core;
1476
-
Capability.to_string Capability.Mail
1477
-
];
1478
-
method_calls = [
1479
-
{
1480
-
name = "Mailbox/get";
1481
-
arguments = `O [
1482
-
("accountId", `String account_id);
1483
-
("ids", `A [`String mailbox_id]);
1484
-
];
1485
-
method_call_id = "m1";
1486
-
}
1487
-
];
1488
-
created_ids = None;
1489
-
} in
1490
-
1491
-
let* response_result = make_request conn.config request in
1492
-
match response_result with
1493
-
| Ok response ->
1494
-
let result =
1495
-
try
1496
-
let method_response = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) ->
1497
-
inv.name = "Mailbox/get") response.method_responses in
1498
-
let args = method_response.arguments in
1499
-
match Ezjsonm.find_opt args ["list"] with
1500
-
| Some (`A [mailbox]) -> mailbox_of_json mailbox
1501
-
| Some (`A []) -> Error (Parse_error ("Mailbox not found: " ^ mailbox_id))
1502
-
| _ -> Error (Parse_error "Expected single mailbox in response")
1503
-
with
1504
-
| Not_found -> Error (Parse_error "Mailbox/get method response not found")
1505
-
| e -> Error (Parse_error (Printexc.to_string e))
1506
-
in
1507
-
Lwt.return result
1508
-
| Error e -> Lwt.return (Error e)
1509
-
1510
-
(** Get messages in a mailbox
1511
-
@param conn The JMAP connection
1512
-
@param account_id The account ID
1513
-
@param mailbox_id The mailbox ID to get messages from
1514
-
@param limit Optional limit on number of messages to return
1515
-
@return The list of email messages if successful
1516
-
1517
-
TODO:claude *)
1518
-
let get_messages_in_mailbox conn ~account_id ~mailbox_id ?limit () =
1519
-
(* First query the emails in the mailbox *)
1520
-
let query_request = {
1521
-
using = [
1522
-
Jmap.Capability.to_string Jmap.Capability.Core;
1523
-
Capability.to_string Capability.Mail
1524
-
];
1525
-
method_calls = [
1526
-
{
1527
-
name = "Email/query";
1528
-
arguments = `O ([
1529
-
("accountId", `String account_id);
1530
-
("filter", `O [("inMailbox", `String mailbox_id)]);
1531
-
("sort", `A [`O [("property", `String "receivedAt"); ("isAscending", `Bool false)]]);
1532
-
] @ (match limit with
1533
-
| Some l -> [("limit", `Float (float_of_int l))]
1534
-
| None -> []
1535
-
));
1536
-
method_call_id = "q1";
1537
-
}
1538
-
];
1539
-
created_ids = None;
1540
-
} in
1541
-
1542
-
let* query_result = make_request conn.config query_request in
1543
-
match query_result with
1544
-
| Ok query_response ->
1545
-
(try
1546
-
let query_method = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) ->
1547
-
inv.name = "Email/query") query_response.method_responses in
1548
-
let args = query_method.arguments in
1549
-
match Ezjsonm.find_opt args ["ids"] with
1550
-
| Some (`A ids) ->
1551
-
let email_ids = List.map (function
1552
-
| `String id -> id
1553
-
| _ -> raise (Invalid_argument "Email ID is not a string")
1554
-
) ids in
1555
-
1556
-
(* If we have IDs, fetch the actual email objects *)
1557
-
if List.length email_ids > 0 then
1558
-
let get_request = {
1559
-
using = [
1560
-
Jmap.Capability.to_string Jmap.Capability.Core;
1561
-
Capability.to_string Capability.Mail
1562
-
];
1563
-
method_calls = [
1564
-
{
1565
-
name = "Email/get";
1566
-
arguments = `O [
1567
-
("accountId", `String account_id);
1568
-
("ids", `A (List.map (fun id -> `String id) email_ids));
1569
-
];
1570
-
method_call_id = "g1";
1571
-
}
1572
-
];
1573
-
created_ids = None;
1574
-
} in
1575
-
1576
-
let* get_result = make_request conn.config get_request in
1577
-
match get_result with
1578
-
| Ok get_response ->
1579
-
(try
1580
-
let get_method = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) ->
1581
-
inv.name = "Email/get") get_response.method_responses in
1582
-
let args = get_method.arguments in
1583
-
match Ezjsonm.find_opt args ["list"] with
1584
-
| Some (`A email_list) ->
1585
-
let parse_results = List.map email_of_json email_list in
1586
-
let (successes, failures) = List.partition Result.is_ok parse_results in
1587
-
if List.length failures > 0 then
1588
-
Lwt.return (Error (Parse_error "Failed to parse some emails"))
1589
-
else
1590
-
Lwt.return (Ok (List.map Result.get_ok successes))
1591
-
| _ -> Lwt.return (Error (Parse_error "Email list not found in response"))
1592
-
with
1593
-
| Not_found -> Lwt.return (Error (Parse_error "Email/get method response not found"))
1594
-
| e -> Lwt.return (Error (Parse_error (Printexc.to_string e))))
1595
-
| Error e -> Lwt.return (Error e)
1596
-
else
1597
-
(* No emails in mailbox *)
1598
-
Lwt.return (Ok [])
1599
-
1600
-
| _ -> Lwt.return (Error (Parse_error "Email IDs not found in query response"))
1601
-
with
1602
-
| Not_found -> Lwt.return (Error (Parse_error "Email/query method response not found"))
1603
-
| Invalid_argument msg -> Lwt.return (Error (Parse_error msg))
1604
-
| e -> Lwt.return (Error (Parse_error (Printexc.to_string e))))
1605
-
| Error e -> Lwt.return (Error e)
1606
-
1607
-
(** Get a single email message by ID
1608
-
@param conn The JMAP connection
1609
-
@param account_id The account ID
1610
-
@param email_id The email ID to retrieve
1611
-
@return The email message if found
1612
-
1613
-
TODO:claude *)
1614
-
let get_email conn ~account_id ~email_id =
1615
-
let request = {
1616
-
using = [
1617
-
Jmap.Capability.to_string Jmap.Capability.Core;
1618
-
Capability.to_string Capability.Mail
1619
-
];
1620
-
method_calls = [
1621
-
{
1622
-
name = "Email/get";
1623
-
arguments = `O [
1624
-
("accountId", `String account_id);
1625
-
("ids", `A [`String email_id]);
1626
-
];
1627
-
method_call_id = "m1";
1628
-
}
1629
-
];
1630
-
created_ids = None;
1631
-
} in
1632
-
1633
-
let* response_result = make_request conn.config request in
1634
-
match response_result with
1635
-
| Ok response ->
1636
-
let result =
1637
-
try
1638
-
let method_response = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) ->
1639
-
inv.name = "Email/get") response.method_responses in
1640
-
let args = method_response.arguments in
1641
-
match Ezjsonm.find_opt args ["list"] with
1642
-
| Some (`A [email]) -> email_of_json email
1643
-
| Some (`A []) -> Error (Parse_error ("Email not found: " ^ email_id))
1644
-
| _ -> Error (Parse_error "Expected single email in response")
1645
-
with
1646
-
| Not_found -> Error (Parse_error "Email/get method response not found")
1647
-
| e -> Error (Parse_error (Printexc.to_string e))
1648
-
in
1649
-
Lwt.return result
1650
-
| Error e -> Lwt.return (Error e)
1651
-
1652
-
(** Helper functions for working with message flags and mailbox attributes *)
1653
-
1654
-
(** Check if an email has a specific message keyword
1655
-
@param email The email to check
1656
-
@param keyword The message keyword to look for
1657
-
@return true if the email has the keyword, false otherwise
1658
-
1659
-
TODO:claude *)
1660
-
let has_message_keyword (email:Types.email) keyword =
1661
-
let open Types in
1662
-
let keyword_string = string_of_message_keyword keyword in
1663
-
List.exists (function
1664
-
| (Custom s, true) when s = keyword_string -> true
1665
-
| _ -> false
1666
-
) email.keywords
1667
-
1668
-
(** Add a message keyword to an email
1669
-
@param conn The JMAP connection
1670
-
@param account_id The account ID
1671
-
@param email_id The email ID
1672
-
@param keyword The message keyword to add
1673
-
@return Success or error
1674
-
1675
-
TODO:claude *)
1676
-
let add_message_keyword conn ~account_id ~email_id ~keyword =
1677
-
let keyword_string = Types.string_of_message_keyword keyword in
1678
-
1679
-
let request = {
1680
-
using = [
1681
-
Jmap.Capability.to_string Jmap.Capability.Core;
1682
-
Capability.to_string Capability.Mail
1683
-
];
1684
-
method_calls = [
1685
-
{
1686
-
name = "Email/set";
1687
-
arguments = `O [
1688
-
("accountId", `String account_id);
1689
-
("update", `O [
1690
-
(email_id, `O [
1691
-
("keywords", `O [
1692
-
(keyword_string, `Bool true)
1693
-
])
1694
-
])
1695
-
]);
1696
-
];
1697
-
method_call_id = "m1";
1698
-
}
1699
-
];
1700
-
created_ids = None;
1701
-
} in
1702
-
1703
-
let* response_result = make_request conn.config request in
1704
-
match response_result with
1705
-
| Ok response ->
1706
-
let result =
1707
-
try
1708
-
let method_response = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) ->
1709
-
inv.name = "Email/set") response.method_responses in
1710
-
let args = method_response.arguments in
1711
-
match Ezjsonm.find_opt args ["updated"] with
1712
-
| Some (`A ids) -> Ok ()
1713
-
| _ ->
1714
-
match Ezjsonm.find_opt args ["notUpdated"] with
1715
-
| Some (`O errors) ->
1716
-
Error (Parse_error ("Failed to update email: " ^ email_id))
1717
-
| _ -> Error (Parse_error "Unexpected response format")
1718
-
with
1719
-
| Not_found -> Error (Parse_error "Email/set method response not found")
1720
-
| e -> Error (Parse_error (Printexc.to_string e))
1721
-
in
1722
-
Lwt.return result
1723
-
| Error e -> Lwt.return (Error e)
1724
-
1725
-
(** Set a flag color for an email
1726
-
@param conn The JMAP connection
1727
-
@param account_id The account ID
1728
-
@param email_id The email ID
1729
-
@param color The flag color to set
1730
-
@return Success or error
1731
-
1732
-
TODO:claude *)
1733
-
let set_flag_color conn ~account_id ~email_id ~color =
1734
-
(* Get the bit pattern for the color *)
1735
-
let (bit0, bit1, bit2) = Types.bits_of_flag_color color in
1736
-
1737
-
(* Build the keywords update object *)
1738
-
let keywords = [
1739
-
("$flagged", `Bool true);
1740
-
("$MailFlagBit0", `Bool bit0);
1741
-
("$MailFlagBit1", `Bool bit1);
1742
-
("$MailFlagBit2", `Bool bit2);
1743
-
] in
1744
-
1745
-
let request = {
1746
-
using = [
1747
-
Jmap.Capability.to_string Jmap.Capability.Core;
1748
-
Capability.to_string Capability.Mail
1749
-
];
1750
-
method_calls = [
1751
-
{
1752
-
name = "Email/set";
1753
-
arguments = `O [
1754
-
("accountId", `String account_id);
1755
-
("update", `O [
1756
-
(email_id, `O [
1757
-
("keywords", `O keywords)
1758
-
])
1759
-
]);
1760
-
];
1761
-
method_call_id = "m1";
1762
-
}
1763
-
];
1764
-
created_ids = None;
1765
-
} in
1766
-
1767
-
let* response_result = make_request conn.config request in
1768
-
match response_result with
1769
-
| Ok response ->
1770
-
let result =
1771
-
try
1772
-
let method_response = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) ->
1773
-
inv.name = "Email/set") response.method_responses in
1774
-
let args = method_response.arguments in
1775
-
match Ezjsonm.find_opt args ["updated"] with
1776
-
| Some (`A ids) -> Ok ()
1777
-
| _ ->
1778
-
match Ezjsonm.find_opt args ["notUpdated"] with
1779
-
| Some (`O errors) ->
1780
-
Error (Parse_error ("Failed to update email: " ^ email_id))
1781
-
| _ -> Error (Parse_error "Unexpected response format")
1782
-
with
1783
-
| Not_found -> Error (Parse_error "Email/set method response not found")
1784
-
| e -> Error (Parse_error (Printexc.to_string e))
1785
-
in
1786
-
Lwt.return result
1787
-
| Error e -> Lwt.return (Error e)
1788
-
1789
-
(** Convert an email's keywords to typed message_keyword list
1790
-
@param email The email to analyze
1791
-
@return List of message keywords
1792
-
1793
-
TODO:claude *)
1794
-
let get_message_keywords (email:Types.email) =
1795
-
let open Types in
1796
-
List.filter_map (function
1797
-
| (Custom s, true) -> Some (message_keyword_of_string s)
1798
-
| _ -> None
1799
-
) email.keywords
1800
-
1801
-
(** Get emails with a specific message keyword
1802
-
@param conn The JMAP connection
1803
-
@param account_id The account ID
1804
-
@param keyword The message keyword to search for
1805
-
@param limit Optional limit on number of emails to return
1806
-
@return List of emails with the keyword if successful
1807
-
1808
-
TODO:claude *)
1809
-
let get_emails_with_keyword conn ~account_id ~keyword ?limit () =
1810
-
let keyword_string = Types.string_of_message_keyword keyword in
1811
-
1812
-
(* Query for emails with the specified keyword *)
1813
-
let query_request = {
1814
-
using = [
1815
-
Jmap.Capability.to_string Jmap.Capability.Core;
1816
-
Capability.to_string Capability.Mail
1817
-
];
1818
-
method_calls = [
1819
-
{
1820
-
name = "Email/query";
1821
-
arguments = `O ([
1822
-
("accountId", `String account_id);
1823
-
("filter", `O [("hasKeyword", `String keyword_string)]);
1824
-
("sort", `A [`O [("property", `String "receivedAt"); ("isAscending", `Bool false)]]);
1825
-
] @ (match limit with
1826
-
| Some l -> [("limit", `Float (float_of_int l))]
1827
-
| None -> []
1828
-
));
1829
-
method_call_id = "q1";
1830
-
}
1831
-
];
1832
-
created_ids = None;
1833
-
} in
1834
-
1835
-
let* query_result = make_request conn.config query_request in
1836
-
match query_result with
1837
-
| Ok query_response ->
1838
-
(try
1839
-
let query_method = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) ->
1840
-
inv.name = "Email/query") query_response.method_responses in
1841
-
let args = query_method.arguments in
1842
-
match Ezjsonm.find_opt args ["ids"] with
1843
-
| Some (`A ids) ->
1844
-
let email_ids = List.map (function
1845
-
| `String id -> id
1846
-
| _ -> raise (Invalid_argument "Email ID is not a string")
1847
-
) ids in
1848
-
1849
-
(* If we have IDs, fetch the actual email objects *)
1850
-
if List.length email_ids > 0 then
1851
-
let get_request = {
1852
-
using = [
1853
-
Jmap.Capability.to_string Jmap.Capability.Core;
1854
-
Capability.to_string Capability.Mail
1855
-
];
1856
-
method_calls = [
1857
-
{
1858
-
name = "Email/get";
1859
-
arguments = `O [
1860
-
("accountId", `String account_id);
1861
-
("ids", `A (List.map (fun id -> `String id) email_ids));
1862
-
];
1863
-
method_call_id = "g1";
1864
-
}
1865
-
];
1866
-
created_ids = None;
1867
-
} in
1868
-
1869
-
let* get_result = make_request conn.config get_request in
1870
-
match get_result with
1871
-
| Ok get_response ->
1872
-
(try
1873
-
let get_method = List.find (fun (inv : Ezjsonm.value Jmap.Types.invocation) ->
1874
-
inv.name = "Email/get") get_response.method_responses in
1875
-
let args = get_method.arguments in
1876
-
match Ezjsonm.find_opt args ["list"] with
1877
-
| Some (`A email_list) ->
1878
-
let parse_results = List.map email_of_json email_list in
1879
-
let (successes, failures) = List.partition Result.is_ok parse_results in
1880
-
if List.length failures > 0 then
1881
-
Lwt.return (Error (Parse_error "Failed to parse some emails"))
1882
-
else
1883
-
Lwt.return (Ok (List.map Result.get_ok successes))
1884
-
| _ -> Lwt.return (Error (Parse_error "Email list not found in response"))
1885
-
with
1886
-
| Not_found -> Lwt.return (Error (Parse_error "Email/get method response not found"))
1887
-
| e -> Lwt.return (Error (Parse_error (Printexc.to_string e))))
1888
-
| Error e -> Lwt.return (Error e)
1889
-
else
1890
-
(* No emails with the keyword *)
1891
-
Lwt.return (Ok [])
1892
-
1893
-
| _ -> Lwt.return (Error (Parse_error "Email IDs not found in query response"))
1894
-
with
1895
-
| Not_found -> Lwt.return (Error (Parse_error "Email/query method response not found"))
1896
-
| Invalid_argument msg -> Lwt.return (Error (Parse_error msg))
1897
-
| e -> Lwt.return (Error (Parse_error (Printexc.to_string e))))
1898
-
| Error e -> Lwt.return (Error e)
-1095
lib/jmap_mail.mli
-1095
lib/jmap_mail.mli
···
1
-
(** Implementation of the JMAP Mail extension, as defined in RFC8621 *)
2
-
3
-
(** Module for managing JMAP Mail-specific capability URIs *)
4
-
module Capability : sig
5
-
(** Mail capability URI *)
6
-
val mail_uri : string
7
-
8
-
(** Submission capability URI *)
9
-
val submission_uri : string
10
-
11
-
(** Vacation response capability URI *)
12
-
val vacation_response_uri : string
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
-
val to_string : t -> string
23
-
24
-
(** Parse a string to a capability *)
25
-
val of_string : string -> t
26
-
27
-
(** Check if a capability is a standard mail capability *)
28
-
val is_standard : t -> bool
29
-
30
-
(** Check if a capability string is a standard mail capability *)
31
-
val is_standard_string : string -> bool
32
-
33
-
(** Create a list of capability strings *)
34
-
val strings_of_capabilities : t list -> string list
35
-
end
36
-
37
-
(** Types for the JMAP Mail extension *)
38
-
module Types : sig
39
-
open Jmap.Types
40
-
41
-
(** {1 Mail capabilities} *)
42
-
43
-
(** Capability URI for JMAP Mail*)
44
-
val capability_mail : string
45
-
46
-
(** Capability URI for JMAP Submission *)
47
-
val capability_submission : string
48
-
49
-
(** Capability URI for JMAP Vacation Response *)
50
-
val capability_vacation_response : string
51
-
52
-
(** {1:mailbox Mailbox objects} *)
53
-
54
-
(** A role for a mailbox. See RFC8621 Section 2. *)
55
-
type mailbox_role =
56
-
| All (** All mail *)
57
-
| Archive (** Archived mail *)
58
-
| Drafts (** Draft messages *)
59
-
| Flagged (** Starred/flagged mail *)
60
-
| Important (** Important mail *)
61
-
| Inbox (** Inbox *)
62
-
| Junk (** Spam/Junk mail *)
63
-
| Sent (** Sent mail *)
64
-
| Trash (** Deleted/Trash mail *)
65
-
| Unknown of string (** Server-specific roles *)
66
-
67
-
(** A mailbox (folder) in a mail account. See RFC8621 Section 2. *)
68
-
type mailbox = {
69
-
id : id;
70
-
name : string;
71
-
parent_id : id option;
72
-
role : mailbox_role option;
73
-
sort_order : unsigned_int;
74
-
total_emails : unsigned_int;
75
-
unread_emails : unsigned_int;
76
-
total_threads : unsigned_int;
77
-
unread_threads : unsigned_int;
78
-
is_subscribed : bool;
79
-
my_rights : mailbox_rights;
80
-
}
81
-
82
-
(** Rights for a mailbox. See RFC8621 Section 2. *)
83
-
and mailbox_rights = {
84
-
may_read_items : bool;
85
-
may_add_items : bool;
86
-
may_remove_items : bool;
87
-
may_set_seen : bool;
88
-
may_set_keywords : bool;
89
-
may_create_child : bool;
90
-
may_rename : bool;
91
-
may_delete : bool;
92
-
may_submit : bool;
93
-
}
94
-
95
-
(** Filter condition for mailbox queries. See RFC8621 Section 2.3. *)
96
-
type mailbox_filter_condition = {
97
-
parent_id : id option;
98
-
name : string option;
99
-
role : string option;
100
-
has_any_role : bool option;
101
-
is_subscribed : bool option;
102
-
}
103
-
104
-
type mailbox_query_filter = [
105
-
| `And of mailbox_query_filter list
106
-
| `Or of mailbox_query_filter list
107
-
| `Not of mailbox_query_filter
108
-
| `Condition of mailbox_filter_condition
109
-
]
110
-
111
-
(** Mailbox/get request arguments. See RFC8621 Section 2.1. *)
112
-
type mailbox_get_arguments = {
113
-
account_id : id;
114
-
ids : id list option;
115
-
properties : string list option;
116
-
}
117
-
118
-
(** Mailbox/get response. See RFC8621 Section 2.1. *)
119
-
type mailbox_get_response = {
120
-
account_id : id;
121
-
state : string;
122
-
list : mailbox list;
123
-
not_found : id list;
124
-
}
125
-
126
-
(** Mailbox/changes request arguments. See RFC8621 Section 2.2. *)
127
-
type mailbox_changes_arguments = {
128
-
account_id : id;
129
-
since_state : string;
130
-
max_changes : unsigned_int option;
131
-
}
132
-
133
-
(** Mailbox/changes response. See RFC8621 Section 2.2. *)
134
-
type mailbox_changes_response = {
135
-
account_id : id;
136
-
old_state : string;
137
-
new_state : string;
138
-
has_more_changes : bool;
139
-
created : id list;
140
-
updated : id list;
141
-
destroyed : id list;
142
-
}
143
-
144
-
(** Mailbox/query request arguments. See RFC8621 Section 2.3. *)
145
-
type mailbox_query_arguments = {
146
-
account_id : id;
147
-
filter : mailbox_query_filter option;
148
-
sort : [ `name | `role | `sort_order ] list option;
149
-
limit : unsigned_int option;
150
-
}
151
-
152
-
(** Mailbox/query response. See RFC8621 Section 2.3. *)
153
-
type mailbox_query_response = {
154
-
account_id : id;
155
-
query_state : string;
156
-
can_calculate_changes : bool;
157
-
position : unsigned_int;
158
-
ids : id list;
159
-
total : unsigned_int option;
160
-
}
161
-
162
-
(** Mailbox/queryChanges request arguments. See RFC8621 Section 2.4. *)
163
-
type mailbox_query_changes_arguments = {
164
-
account_id : id;
165
-
filter : mailbox_query_filter option;
166
-
sort : [ `name | `role | `sort_order ] list option;
167
-
since_query_state : string;
168
-
max_changes : unsigned_int option;
169
-
up_to_id : id option;
170
-
}
171
-
172
-
(** Mailbox/queryChanges response. See RFC8621 Section 2.4. *)
173
-
type mailbox_query_changes_response = {
174
-
account_id : id;
175
-
old_query_state : string;
176
-
new_query_state : string;
177
-
total : unsigned_int option;
178
-
removed : id list;
179
-
added : mailbox_query_changes_added list;
180
-
}
181
-
182
-
and mailbox_query_changes_added = {
183
-
id : id;
184
-
index : unsigned_int;
185
-
}
186
-
187
-
(** Mailbox/set request arguments. See RFC8621 Section 2.5. *)
188
-
type mailbox_set_arguments = {
189
-
account_id : id;
190
-
if_in_state : string option;
191
-
create : (id * mailbox_creation) list option;
192
-
update : (id * mailbox_update) list option;
193
-
destroy : id list option;
194
-
}
195
-
196
-
and mailbox_creation = {
197
-
name : string;
198
-
parent_id : id option;
199
-
role : string option;
200
-
sort_order : unsigned_int option;
201
-
is_subscribed : bool option;
202
-
}
203
-
204
-
and mailbox_update = {
205
-
name : string option;
206
-
parent_id : id option;
207
-
role : string option;
208
-
sort_order : unsigned_int option;
209
-
is_subscribed : bool option;
210
-
}
211
-
212
-
(** Mailbox/set response. See RFC8621 Section 2.5. *)
213
-
type mailbox_set_response = {
214
-
account_id : id;
215
-
old_state : string option;
216
-
new_state : string;
217
-
created : (id * mailbox) list option;
218
-
updated : id list option;
219
-
destroyed : id list option;
220
-
not_created : (id * set_error) list option;
221
-
not_updated : (id * set_error) list option;
222
-
not_destroyed : (id * set_error) list option;
223
-
}
224
-
225
-
(** {1:thread Thread objects} *)
226
-
227
-
(** A thread in a mail account. See RFC8621 Section 3. *)
228
-
type thread = {
229
-
id : id;
230
-
email_ids : id list;
231
-
}
232
-
233
-
(** Thread/get request arguments. See RFC8621 Section 3.1. *)
234
-
type thread_get_arguments = {
235
-
account_id : id;
236
-
ids : id list option;
237
-
properties : string list option;
238
-
}
239
-
240
-
(** Thread/get response. See RFC8621 Section 3.1. *)
241
-
type thread_get_response = {
242
-
account_id : id;
243
-
state : string;
244
-
list : thread list;
245
-
not_found : id list;
246
-
}
247
-
248
-
(** Thread/changes request arguments. See RFC8621 Section 3.2. *)
249
-
type thread_changes_arguments = {
250
-
account_id : id;
251
-
since_state : string;
252
-
max_changes : unsigned_int option;
253
-
}
254
-
255
-
(** Thread/changes response. See RFC8621 Section 3.2. *)
256
-
type thread_changes_response = {
257
-
account_id : id;
258
-
old_state : string;
259
-
new_state : string;
260
-
has_more_changes : bool;
261
-
created : id list;
262
-
updated : id list;
263
-
destroyed : id list;
264
-
}
265
-
266
-
(** {1:email Email objects} *)
267
-
268
-
(** Addressing (mailbox) information. See RFC8621 Section 4.1.1. *)
269
-
type email_address = {
270
-
name : string option;
271
-
email : string;
272
-
parameters : (string * string) list;
273
-
}
274
-
275
-
(** Message header field. See RFC8621 Section 4.1.2. *)
276
-
type header = {
277
-
name : string;
278
-
value : string;
279
-
}
280
-
281
-
(** Email keyword (flag). See RFC8621 Section 4.3. *)
282
-
type keyword =
283
-
| Flagged
284
-
| Answered
285
-
| Draft
286
-
| Forwarded
287
-
| Phishing
288
-
| Junk
289
-
| NotJunk
290
-
| Seen
291
-
| Unread
292
-
| Custom of string
293
-
294
-
(** Email message. See RFC8621 Section 4. *)
295
-
type email = {
296
-
id : id;
297
-
blob_id : id;
298
-
thread_id : id;
299
-
mailbox_ids : (id * bool) list;
300
-
keywords : (keyword * bool) list;
301
-
size : unsigned_int;
302
-
received_at : utc_date;
303
-
message_id : string list;
304
-
in_reply_to : string list option;
305
-
references : string list option;
306
-
sender : email_address list option;
307
-
from : email_address list option;
308
-
to_ : email_address list option;
309
-
cc : email_address list option;
310
-
bcc : email_address list option;
311
-
reply_to : email_address list option;
312
-
subject : string option;
313
-
sent_at : utc_date option;
314
-
has_attachment : bool option;
315
-
preview : string option;
316
-
body_values : (string * string) list option;
317
-
text_body : email_body_part list option;
318
-
html_body : email_body_part list option;
319
-
attachments : email_body_part list option;
320
-
headers : header list option;
321
-
}
322
-
323
-
(** Email body part. See RFC8621 Section 4.1.4. *)
324
-
and email_body_part = {
325
-
part_id : string option;
326
-
blob_id : id option;
327
-
size : unsigned_int option;
328
-
headers : header list option;
329
-
name : string option;
330
-
type_ : string option;
331
-
charset : string option;
332
-
disposition : string option;
333
-
cid : string option;
334
-
language : string list option;
335
-
location : string option;
336
-
sub_parts : email_body_part list option;
337
-
header_parameter_name : string option;
338
-
header_parameter_value : string option;
339
-
}
340
-
341
-
(** Email query filter condition. See RFC8621 Section 4.4. *)
342
-
type email_filter_condition = {
343
-
in_mailbox : id option;
344
-
in_mailbox_other_than : id list option;
345
-
min_size : unsigned_int option;
346
-
max_size : unsigned_int option;
347
-
before : utc_date option;
348
-
after : utc_date option;
349
-
header : (string * string) option;
350
-
from : string option;
351
-
to_ : string option;
352
-
cc : string option;
353
-
bcc : string option;
354
-
subject : string option;
355
-
body : string option;
356
-
has_keyword : string option;
357
-
not_keyword : string option;
358
-
has_attachment : bool option;
359
-
text : string option;
360
-
}
361
-
362
-
type email_query_filter = [
363
-
| `And of email_query_filter list
364
-
| `Or of email_query_filter list
365
-
| `Not of email_query_filter
366
-
| `Condition of email_filter_condition
367
-
]
368
-
369
-
(** Email/get request arguments. See RFC8621 Section 4.5. *)
370
-
type email_get_arguments = {
371
-
account_id : id;
372
-
ids : id list option;
373
-
properties : string list option;
374
-
body_properties : string list option;
375
-
fetch_text_body_values : bool option;
376
-
fetch_html_body_values : bool option;
377
-
fetch_all_body_values : bool option;
378
-
max_body_value_bytes : unsigned_int option;
379
-
}
380
-
381
-
(** Email/get response. See RFC8621 Section 4.5. *)
382
-
type email_get_response = {
383
-
account_id : id;
384
-
state : string;
385
-
list : email list;
386
-
not_found : id list;
387
-
}
388
-
389
-
(** Email/changes request arguments. See RFC8621 Section 4.6. *)
390
-
type email_changes_arguments = {
391
-
account_id : id;
392
-
since_state : string;
393
-
max_changes : unsigned_int option;
394
-
}
395
-
396
-
(** Email/changes response. See RFC8621 Section 4.6. *)
397
-
type email_changes_response = {
398
-
account_id : id;
399
-
old_state : string;
400
-
new_state : string;
401
-
has_more_changes : bool;
402
-
created : id list;
403
-
updated : id list;
404
-
destroyed : id list;
405
-
}
406
-
407
-
(** Email/query request arguments. See RFC8621 Section 4.4. *)
408
-
type email_query_arguments = {
409
-
account_id : id;
410
-
filter : email_query_filter option;
411
-
sort : comparator list option;
412
-
collapse_threads : bool option;
413
-
position : unsigned_int option;
414
-
anchor : id option;
415
-
anchor_offset : int_t option;
416
-
limit : unsigned_int option;
417
-
calculate_total : bool option;
418
-
}
419
-
420
-
(** Email/query response. See RFC8621 Section 4.4. *)
421
-
type email_query_response = {
422
-
account_id : id;
423
-
query_state : string;
424
-
can_calculate_changes : bool;
425
-
position : unsigned_int;
426
-
ids : id list;
427
-
total : unsigned_int option;
428
-
thread_ids : id list option;
429
-
}
430
-
431
-
(** Email/queryChanges request arguments. See RFC8621 Section 4.7. *)
432
-
type email_query_changes_arguments = {
433
-
account_id : id;
434
-
filter : email_query_filter option;
435
-
sort : comparator list option;
436
-
collapse_threads : bool option;
437
-
since_query_state : string;
438
-
max_changes : unsigned_int option;
439
-
up_to_id : id option;
440
-
}
441
-
442
-
(** Email/queryChanges response. See RFC8621 Section 4.7. *)
443
-
type email_query_changes_response = {
444
-
account_id : id;
445
-
old_query_state : string;
446
-
new_query_state : string;
447
-
total : unsigned_int option;
448
-
removed : id list;
449
-
added : email_query_changes_added list;
450
-
}
451
-
452
-
and email_query_changes_added = {
453
-
id : id;
454
-
index : unsigned_int;
455
-
}
456
-
457
-
(** Email/set request arguments. See RFC8621 Section 4.8. *)
458
-
type email_set_arguments = {
459
-
account_id : id;
460
-
if_in_state : string option;
461
-
create : (id * email_creation) list option;
462
-
update : (id * email_update) list option;
463
-
destroy : id list option;
464
-
}
465
-
466
-
and email_creation = {
467
-
mailbox_ids : (id * bool) list;
468
-
keywords : (keyword * bool) list option;
469
-
received_at : utc_date option;
470
-
message_id : string list option;
471
-
in_reply_to : string list option;
472
-
references : string list option;
473
-
sender : email_address list option;
474
-
from : email_address list option;
475
-
to_ : email_address list option;
476
-
cc : email_address list option;
477
-
bcc : email_address list option;
478
-
reply_to : email_address list option;
479
-
subject : string option;
480
-
body_values : (string * string) list option;
481
-
text_body : email_body_part list option;
482
-
html_body : email_body_part list option;
483
-
attachments : email_body_part list option;
484
-
headers : header list option;
485
-
}
486
-
487
-
and email_update = {
488
-
keywords : (keyword * bool) list option;
489
-
mailbox_ids : (id * bool) list option;
490
-
}
491
-
492
-
(** Email/set response. See RFC8621 Section 4.8. *)
493
-
type email_set_response = {
494
-
account_id : id;
495
-
old_state : string option;
496
-
new_state : string;
497
-
created : (id * email) list option;
498
-
updated : id list option;
499
-
destroyed : id list option;
500
-
not_created : (id * set_error) list option;
501
-
not_updated : (id * set_error) list option;
502
-
not_destroyed : (id * set_error) list option;
503
-
}
504
-
505
-
(** Email/copy request arguments. See RFC8621 Section 4.9. *)
506
-
type email_copy_arguments = {
507
-
from_account_id : id;
508
-
account_id : id;
509
-
create : (id * email_creation) list;
510
-
on_success_destroy_original : bool option;
511
-
}
512
-
513
-
(** Email/copy response. See RFC8621 Section 4.9. *)
514
-
type email_copy_response = {
515
-
from_account_id : id;
516
-
account_id : id;
517
-
created : (id * email) list option;
518
-
not_created : (id * set_error) list option;
519
-
}
520
-
521
-
(** Email/import request arguments. See RFC8621 Section 4.10. *)
522
-
type email_import_arguments = {
523
-
account_id : id;
524
-
emails : (id * email_import) list;
525
-
}
526
-
527
-
and email_import = {
528
-
blob_id : id;
529
-
mailbox_ids : (id * bool) list;
530
-
keywords : (keyword * bool) list option;
531
-
received_at : utc_date option;
532
-
}
533
-
534
-
(** Email/import response. See RFC8621 Section 4.10. *)
535
-
type email_import_response = {
536
-
account_id : id;
537
-
created : (id * email) list option;
538
-
not_created : (id * set_error) list option;
539
-
}
540
-
541
-
(** {1:search_snippet Search snippets} *)
542
-
543
-
(** SearchSnippet/get request arguments. See RFC8621 Section 4.11. *)
544
-
type search_snippet_get_arguments = {
545
-
account_id : id;
546
-
email_ids : id list;
547
-
filter : email_filter_condition;
548
-
}
549
-
550
-
(** SearchSnippet/get response. See RFC8621 Section 4.11. *)
551
-
type search_snippet_get_response = {
552
-
account_id : id;
553
-
list : (id * search_snippet) list;
554
-
not_found : id list;
555
-
}
556
-
557
-
and search_snippet = {
558
-
subject : string option;
559
-
preview : string option;
560
-
}
561
-
562
-
(** {1:submission EmailSubmission objects} *)
563
-
564
-
(** EmailSubmission address. See RFC8621 Section 5.1. *)
565
-
type submission_address = {
566
-
email : string;
567
-
parameters : (string * string) list option;
568
-
}
569
-
570
-
(** Email submission object. See RFC8621 Section 5.1. *)
571
-
type email_submission = {
572
-
id : id;
573
-
identity_id : id;
574
-
email_id : id;
575
-
thread_id : id;
576
-
envelope : envelope option;
577
-
send_at : utc_date option;
578
-
undo_status : [
579
-
| `pending
580
-
| `final
581
-
| `canceled
582
-
] option;
583
-
delivery_status : (string * submission_status) list option;
584
-
dsn_blob_ids : (string * id) list option;
585
-
mdn_blob_ids : (string * id) list option;
586
-
}
587
-
588
-
(** Envelope for mail submission. See RFC8621 Section 5.1. *)
589
-
and envelope = {
590
-
mail_from : submission_address;
591
-
rcpt_to : submission_address list;
592
-
}
593
-
594
-
(** Delivery status for submitted email. See RFC8621 Section 5.1. *)
595
-
and submission_status = {
596
-
smtp_reply : string;
597
-
delivered : string option;
598
-
}
599
-
600
-
(** EmailSubmission/get request arguments. See RFC8621 Section 5.3. *)
601
-
type email_submission_get_arguments = {
602
-
account_id : id;
603
-
ids : id list option;
604
-
properties : string list option;
605
-
}
606
-
607
-
(** EmailSubmission/get response. See RFC8621 Section 5.3. *)
608
-
type email_submission_get_response = {
609
-
account_id : id;
610
-
state : string;
611
-
list : email_submission list;
612
-
not_found : id list;
613
-
}
614
-
615
-
(** EmailSubmission/changes request arguments. See RFC8621 Section 5.4. *)
616
-
type email_submission_changes_arguments = {
617
-
account_id : id;
618
-
since_state : string;
619
-
max_changes : unsigned_int option;
620
-
}
621
-
622
-
(** EmailSubmission/changes response. See RFC8621 Section 5.4. *)
623
-
type email_submission_changes_response = {
624
-
account_id : id;
625
-
old_state : string;
626
-
new_state : string;
627
-
has_more_changes : bool;
628
-
created : id list;
629
-
updated : id list;
630
-
destroyed : id list;
631
-
}
632
-
633
-
(** EmailSubmission/query filter condition. See RFC8621 Section 5.5. *)
634
-
type email_submission_filter_condition = {
635
-
identity_id : id option;
636
-
email_id : id option;
637
-
thread_id : id option;
638
-
before : utc_date option;
639
-
after : utc_date option;
640
-
subject : string option;
641
-
}
642
-
643
-
type email_submission_query_filter = [
644
-
| `And of email_submission_query_filter list
645
-
| `Or of email_submission_query_filter list
646
-
| `Not of email_submission_query_filter
647
-
| `Condition of email_submission_filter_condition
648
-
]
649
-
650
-
(** EmailSubmission/query request arguments. See RFC8621 Section 5.5. *)
651
-
type email_submission_query_arguments = {
652
-
account_id : id;
653
-
filter : email_submission_query_filter option;
654
-
sort : comparator list option;
655
-
position : unsigned_int option;
656
-
anchor : id option;
657
-
anchor_offset : int_t option;
658
-
limit : unsigned_int option;
659
-
calculate_total : bool option;
660
-
}
661
-
662
-
(** EmailSubmission/query response. See RFC8621 Section 5.5. *)
663
-
type email_submission_query_response = {
664
-
account_id : id;
665
-
query_state : string;
666
-
can_calculate_changes : bool;
667
-
position : unsigned_int;
668
-
ids : id list;
669
-
total : unsigned_int option;
670
-
}
671
-
672
-
(** EmailSubmission/set request arguments. See RFC8621 Section 5.6. *)
673
-
type email_submission_set_arguments = {
674
-
account_id : id;
675
-
if_in_state : string option;
676
-
create : (id * email_submission_creation) list option;
677
-
update : (id * email_submission_update) list option;
678
-
destroy : id list option;
679
-
on_success_update_email : (id * email_update) list option;
680
-
}
681
-
682
-
and email_submission_creation = {
683
-
email_id : id;
684
-
identity_id : id;
685
-
envelope : envelope option;
686
-
send_at : utc_date option;
687
-
}
688
-
689
-
and email_submission_update = {
690
-
email_id : id option;
691
-
identity_id : id option;
692
-
envelope : envelope option;
693
-
undo_status : [`canceled] option;
694
-
}
695
-
696
-
(** EmailSubmission/set response. See RFC8621 Section 5.6. *)
697
-
type email_submission_set_response = {
698
-
account_id : id;
699
-
old_state : string option;
700
-
new_state : string;
701
-
created : (id * email_submission) list option;
702
-
updated : id list option;
703
-
destroyed : id list option;
704
-
not_created : (id * set_error) list option;
705
-
not_updated : (id * set_error) list option;
706
-
not_destroyed : (id * set_error) list option;
707
-
}
708
-
709
-
(** {1:identity Identity objects} *)
710
-
711
-
(** Identity for sending mail. See RFC8621 Section 6. *)
712
-
type identity = {
713
-
id : id;
714
-
name : string;
715
-
email : string;
716
-
reply_to : email_address list option;
717
-
bcc : email_address list option;
718
-
text_signature : string option;
719
-
html_signature : string option;
720
-
may_delete : bool;
721
-
}
722
-
723
-
(** Identity/get request arguments. See RFC8621 Section 6.1. *)
724
-
type identity_get_arguments = {
725
-
account_id : id;
726
-
ids : id list option;
727
-
properties : string list option;
728
-
}
729
-
730
-
(** Identity/get response. See RFC8621 Section 6.1. *)
731
-
type identity_get_response = {
732
-
account_id : id;
733
-
state : string;
734
-
list : identity list;
735
-
not_found : id list;
736
-
}
737
-
738
-
(** Identity/changes request arguments. See RFC8621 Section 6.2. *)
739
-
type identity_changes_arguments = {
740
-
account_id : id;
741
-
since_state : string;
742
-
max_changes : unsigned_int option;
743
-
}
744
-
745
-
(** Identity/changes response. See RFC8621 Section 6.2. *)
746
-
type identity_changes_response = {
747
-
account_id : id;
748
-
old_state : string;
749
-
new_state : string;
750
-
has_more_changes : bool;
751
-
created : id list;
752
-
updated : id list;
753
-
destroyed : id list;
754
-
}
755
-
756
-
(** Identity/set request arguments. See RFC8621 Section 6.3. *)
757
-
type identity_set_arguments = {
758
-
account_id : id;
759
-
if_in_state : string option;
760
-
create : (id * identity_creation) list option;
761
-
update : (id * identity_update) list option;
762
-
destroy : id list option;
763
-
}
764
-
765
-
and identity_creation = {
766
-
name : string;
767
-
email : string;
768
-
reply_to : email_address list option;
769
-
bcc : email_address list option;
770
-
text_signature : string option;
771
-
html_signature : string option;
772
-
}
773
-
774
-
and identity_update = {
775
-
name : string option;
776
-
email : string option;
777
-
reply_to : email_address list option;
778
-
bcc : email_address list option;
779
-
text_signature : string option;
780
-
html_signature : string option;
781
-
}
782
-
783
-
(** Identity/set response. See RFC8621 Section 6.3. *)
784
-
type identity_set_response = {
785
-
account_id : id;
786
-
old_state : string option;
787
-
new_state : string;
788
-
created : (id * identity) list option;
789
-
updated : id list option;
790
-
destroyed : id list option;
791
-
not_created : (id * set_error) list option;
792
-
not_updated : (id * set_error) list option;
793
-
not_destroyed : (id * set_error) list option;
794
-
}
795
-
796
-
(** {1:vacation_response VacationResponse objects} *)
797
-
798
-
(** Vacation auto-reply setting. See RFC8621 Section 7. *)
799
-
type vacation_response = {
800
-
id : id;
801
-
is_enabled : bool;
802
-
from_date : utc_date option;
803
-
to_date : utc_date option;
804
-
subject : string option;
805
-
text_body : string option;
806
-
html_body : string option;
807
-
}
808
-
809
-
(** VacationResponse/get request arguments. See RFC8621 Section 7.2. *)
810
-
type vacation_response_get_arguments = {
811
-
account_id : id;
812
-
ids : id list option;
813
-
properties : string list option;
814
-
}
815
-
816
-
(** VacationResponse/get response. See RFC8621 Section 7.2. *)
817
-
type vacation_response_get_response = {
818
-
account_id : id;
819
-
state : string;
820
-
list : vacation_response list;
821
-
not_found : id list;
822
-
}
823
-
824
-
(** VacationResponse/set request arguments. See RFC8621 Section 7.3. *)
825
-
type vacation_response_set_arguments = {
826
-
account_id : id;
827
-
if_in_state : string option;
828
-
update : (id * vacation_response_update) list;
829
-
}
830
-
831
-
and vacation_response_update = {
832
-
is_enabled : bool option;
833
-
from_date : utc_date option;
834
-
to_date : utc_date option;
835
-
subject : string option;
836
-
text_body : string option;
837
-
html_body : string option;
838
-
}
839
-
840
-
(** VacationResponse/set response. See RFC8621 Section 7.3. *)
841
-
type vacation_response_set_response = {
842
-
account_id : id;
843
-
old_state : string option;
844
-
new_state : string;
845
-
updated : id list option;
846
-
not_updated : (id * set_error) list option;
847
-
}
848
-
849
-
(** {1:message_flags Message Flags and Mailbox Attributes} *)
850
-
851
-
(** Flag color defined by the combination of MailFlagBit0, MailFlagBit1, and MailFlagBit2 keywords *)
852
-
type flag_color =
853
-
| Red (** Bit pattern 000 *)
854
-
| Orange (** Bit pattern 100 *)
855
-
| Yellow (** Bit pattern 010 *)
856
-
| Green (** Bit pattern 111 *)
857
-
| Blue (** Bit pattern 001 *)
858
-
| Purple (** Bit pattern 101 *)
859
-
| Gray (** Bit pattern 011 *)
860
-
861
-
(** Standard message keywords as defined in draft-ietf-mailmaint-messageflag-mailboxattribute-02 *)
862
-
type message_keyword =
863
-
| Notify (** Indicate a notification should be shown for this message *)
864
-
| Muted (** User is not interested in future replies to this thread *)
865
-
| Followed (** User is particularly interested in future replies to this thread *)
866
-
| Memo (** Message is a note-to-self about another message in the same thread *)
867
-
| HasMemo (** Message has an associated memo with the $memo keyword *)
868
-
| HasAttachment (** Message has an attachment *)
869
-
| HasNoAttachment (** Message does not have an attachment *)
870
-
| AutoSent (** Message was sent automatically as a response due to a user rule *)
871
-
| Unsubscribed (** User has unsubscribed from the thread this message is in *)
872
-
| CanUnsubscribe (** Message has an RFC8058-compliant List-Unsubscribe header *)
873
-
| Imported (** Message was imported from another mailbox *)
874
-
| IsTrusted (** Server has verified authenticity of the from name and email *)
875
-
| MaskedEmail (** Message was received via an alias created for an individual sender *)
876
-
| New (** Message should be made more prominent due to a recent action *)
877
-
| MailFlagBit0 (** Bit 0 of the 3-bit flag color pattern *)
878
-
| MailFlagBit1 (** Bit 1 of the 3-bit flag color pattern *)
879
-
| MailFlagBit2 (** Bit 2 of the 3-bit flag color pattern *)
880
-
| OtherKeyword of string (** Other non-standard keywords *)
881
-
882
-
(** Special mailbox attribute names as defined in draft-ietf-mailmaint-messageflag-mailboxattribute-02 *)
883
-
type mailbox_attribute =
884
-
| Snoozed (** Mailbox containing messages that have been snoozed *)
885
-
| Scheduled (** Mailbox containing messages scheduled to be sent later *)
886
-
| Memos (** Mailbox containing messages with the $memo keyword *)
887
-
| OtherAttribute of string (** Other non-standard mailbox attributes *)
888
-
889
-
(** Functions for working with flag colors *)
890
-
val flag_color_of_bits : bool -> bool -> bool -> flag_color
891
-
892
-
(** Get bits for a flag color *)
893
-
val bits_of_flag_color : flag_color -> bool * bool * bool
894
-
895
-
(** Check if a message has a flag color based on its keywords *)
896
-
val has_flag_color : (keyword * bool) list -> bool
897
-
898
-
(** Get the flag color from a message's keywords, if present *)
899
-
val get_flag_color : (keyword * bool) list -> flag_color option
900
-
901
-
(** Convert a message keyword to its string representation *)
902
-
val string_of_message_keyword : message_keyword -> string
903
-
904
-
(** Parse a string into a message keyword *)
905
-
val message_keyword_of_string : string -> message_keyword
906
-
907
-
(** Convert a mailbox attribute to its string representation *)
908
-
val string_of_mailbox_attribute : mailbox_attribute -> string
909
-
910
-
(** Parse a string into a mailbox attribute *)
911
-
val mailbox_attribute_of_string : string -> mailbox_attribute
912
-
end
913
-
914
-
(** {1 JSON serialization} *)
915
-
916
-
module Json : sig
917
-
open Types
918
-
919
-
(** {2 Helper functions for serialization} *)
920
-
921
-
val string_of_mailbox_role : mailbox_role -> string
922
-
val mailbox_role_of_string : string -> mailbox_role
923
-
924
-
val string_of_keyword : keyword -> string
925
-
val keyword_of_string : string -> keyword
926
-
927
-
(** {2 Mailbox serialization} *)
928
-
929
-
(** TODO:claude - Need to implement all JSON serialization functions
930
-
for each type we've defined. This would be a substantial amount of
931
-
code and likely require additional understanding of the ezjsonm API.
932
-
933
-
The interface would include functions like:
934
-
935
-
val mailbox_to_json : mailbox -> Ezjsonm.value
936
-
val mailbox_of_json : Ezjsonm.value -> mailbox result
937
-
938
-
And similarly for all other types.
939
-
*)
940
-
end
941
-
942
-
(** {1 API functions} *)
943
-
944
-
(** Authentication credentials for a JMAP server *)
945
-
type credentials = {
946
-
username: string;
947
-
password: string;
948
-
}
949
-
950
-
(** Connection to a JMAP mail server *)
951
-
type connection = {
952
-
session: Jmap.Types.session;
953
-
config: Jmap.Api.config;
954
-
}
955
-
956
-
(** Login to a JMAP server and establish a connection
957
-
@param uri The URI of the JMAP server
958
-
@param credentials Authentication credentials
959
-
@return A connection object if successful
960
-
961
-
TODO:claude *)
962
-
val login :
963
-
uri:string ->
964
-
credentials:credentials ->
965
-
(connection, Jmap.Api.error) result Lwt.t
966
-
967
-
(** Login to a JMAP server using an API token
968
-
@param uri The URI of the JMAP server
969
-
@param api_token The API token for authentication
970
-
@return A connection object if successful
971
-
972
-
TODO:claude *)
973
-
val login_with_token :
974
-
uri:string ->
975
-
api_token:string ->
976
-
(connection, Jmap.Api.error) result Lwt.t
977
-
978
-
(** Get all mailboxes for an account
979
-
@param conn The JMAP connection
980
-
@param account_id The account ID to get mailboxes for
981
-
@return A list of mailboxes if successful
982
-
983
-
TODO:claude *)
984
-
val get_mailboxes :
985
-
connection ->
986
-
account_id:Jmap.Types.id ->
987
-
(Types.mailbox list, Jmap.Api.error) result Lwt.t
988
-
989
-
(** Get a specific mailbox by ID
990
-
@param conn The JMAP connection
991
-
@param account_id The account ID
992
-
@param mailbox_id The mailbox ID to retrieve
993
-
@return The mailbox if found
994
-
995
-
TODO:claude *)
996
-
val get_mailbox :
997
-
connection ->
998
-
account_id:Jmap.Types.id ->
999
-
mailbox_id:Jmap.Types.id ->
1000
-
(Types.mailbox, Jmap.Api.error) result Lwt.t
1001
-
1002
-
(** Get messages in a mailbox
1003
-
@param conn The JMAP connection
1004
-
@param account_id The account ID
1005
-
@param mailbox_id The mailbox ID to get messages from
1006
-
@param limit Optional limit on number of messages to return
1007
-
@return The list of email messages if successful
1008
-
1009
-
TODO:claude *)
1010
-
val get_messages_in_mailbox :
1011
-
connection ->
1012
-
account_id:Jmap.Types.id ->
1013
-
mailbox_id:Jmap.Types.id ->
1014
-
?limit:int ->
1015
-
unit ->
1016
-
(Types.email list, Jmap.Api.error) result Lwt.t
1017
-
1018
-
(** Get a single email message by ID
1019
-
@param conn The JMAP connection
1020
-
@param account_id The account ID
1021
-
@param email_id The email ID to retrieve
1022
-
@return The email message if found
1023
-
1024
-
TODO:claude *)
1025
-
val get_email :
1026
-
connection ->
1027
-
account_id:Jmap.Types.id ->
1028
-
email_id:Jmap.Types.id ->
1029
-
(Types.email, Jmap.Api.error) result Lwt.t
1030
-
1031
-
(** Check if an email has a specific message keyword
1032
-
@param email The email to check
1033
-
@param keyword The message keyword to look for
1034
-
@return true if the email has the keyword, false otherwise
1035
-
1036
-
TODO:claude *)
1037
-
val has_message_keyword :
1038
-
Types.email ->
1039
-
Types.message_keyword ->
1040
-
bool
1041
-
1042
-
(** Add a message keyword to an email
1043
-
@param conn The JMAP connection
1044
-
@param account_id The account ID
1045
-
@param email_id The email ID
1046
-
@param keyword The message keyword to add
1047
-
@return Success or error
1048
-
1049
-
TODO:claude *)
1050
-
val add_message_keyword :
1051
-
connection ->
1052
-
account_id:Jmap.Types.id ->
1053
-
email_id:Jmap.Types.id ->
1054
-
keyword:Types.message_keyword ->
1055
-
(unit, Jmap.Api.error) result Lwt.t
1056
-
1057
-
(** Set a flag color for an email
1058
-
@param conn The JMAP connection
1059
-
@param account_id The account ID
1060
-
@param email_id The email ID
1061
-
@param color The flag color to set
1062
-
@return Success or error
1063
-
1064
-
TODO:claude *)
1065
-
val set_flag_color :
1066
-
connection ->
1067
-
account_id:Jmap.Types.id ->
1068
-
email_id:Jmap.Types.id ->
1069
-
color:Types.flag_color ->
1070
-
(unit, Jmap.Api.error) result Lwt.t
1071
-
1072
-
(** Convert an email's keywords to typed message_keyword list
1073
-
@param email The email to analyze
1074
-
@return List of message keywords
1075
-
1076
-
TODO:claude *)
1077
-
val get_message_keywords :
1078
-
Types.email ->
1079
-
Types.message_keyword list
1080
-
1081
-
(** Get emails with a specific message keyword
1082
-
@param conn The JMAP connection
1083
-
@param account_id The account ID
1084
-
@param keyword The message keyword to search for
1085
-
@param limit Optional limit on number of emails to return
1086
-
@return List of emails with the keyword if successful
1087
-
1088
-
TODO:claude *)
1089
-
val get_emails_with_keyword :
1090
-
connection ->
1091
-
account_id:Jmap.Types.id ->
1092
-
keyword:Types.message_keyword ->
1093
-
?limit:int ->
1094
-
unit ->
1095
-
(Types.email list, Jmap.Api.error) result Lwt.t
+896
spec/draft-ietf-mailmaint-messageflag-mailboxattribute-02.txt
+896
spec/draft-ietf-mailmaint-messageflag-mailboxattribute-02.txt
···
1
+
2
+
3
+
4
+
5
+
MailMaint N.M. Jenkins, Ed.
6
+
Internet-Draft Fastmail
7
+
Intended status: Informational D. Eggert, Ed.
8
+
Expires: 21 August 2025 Apple Inc
9
+
17 February 2025
10
+
11
+
12
+
Registration of further IMAP/JMAP keywords and mailbox attribute names
13
+
draft-ietf-mailmaint-messageflag-mailboxattribute-02
14
+
15
+
Abstract
16
+
17
+
This document defines a number of keywords that have been in use by
18
+
Fastmail and Apple respectively for some time. It defines their
19
+
intended use. Additionally some mailbox names with special meaning
20
+
have been in use by Fastmail, and this document defines their
21
+
intended use. This document registers all of these names with IANA
22
+
to avoid name collisions.
23
+
24
+
Status of This Memo
25
+
26
+
This Internet-Draft is submitted in full conformance with the
27
+
provisions of BCP 78 and BCP 79.
28
+
29
+
Internet-Drafts are working documents of the Internet Engineering
30
+
Task Force (IETF). Note that other groups may also distribute
31
+
working documents as Internet-Drafts. The list of current Internet-
32
+
Drafts is at https://datatracker.ietf.org/drafts/current/.
33
+
34
+
Internet-Drafts are draft documents valid for a maximum of six months
35
+
and may be updated, replaced, or obsoleted by other documents at any
36
+
time. It is inappropriate to use Internet-Drafts as reference
37
+
material or to cite them other than as "work in progress."
38
+
39
+
This Internet-Draft will expire on 21 August 2025.
40
+
41
+
Copyright Notice
42
+
43
+
Copyright (c) 2025 IETF Trust and the persons identified as the
44
+
document authors. All rights reserved.
45
+
46
+
47
+
48
+
49
+
50
+
51
+
52
+
53
+
54
+
55
+
56
+
Jenkins & Eggert Expires 21 August 2025 [Page 1]
57
+
58
+
Internet-Draft Further IMAP/JMAP keywords & attributes February 2025
59
+
60
+
61
+
This document is subject to BCP 78 and the IETF Trust's Legal
62
+
Provisions Relating to IETF Documents (https://trustee.ietf.org/
63
+
license-info) in effect on the date of publication of this document.
64
+
Please review these documents carefully, as they describe your rights
65
+
and restrictions with respect to this document. Code Components
66
+
extracted from this document must include Revised BSD License text as
67
+
described in Section 4.e of the Trust Legal Provisions and are
68
+
provided without warranty as described in the Revised BSD License.
69
+
70
+
Table of Contents
71
+
72
+
1. Introduction . . . . . . . . . . . . . . . . . . . . . . . . 3
73
+
2. Requirements Language . . . . . . . . . . . . . . . . . . . . 4
74
+
3. Flag Colors . . . . . . . . . . . . . . . . . . . . . . . . . 4
75
+
3.1. Definition of the MailFlagBit Message Keyword . . . . . . 4
76
+
3.2. Implementation Notes . . . . . . . . . . . . . . . . . . 5
77
+
4. IANA Considerations . . . . . . . . . . . . . . . . . . . . . 5
78
+
4.1. IMAP/JMAP Keyword Registrations . . . . . . . . . . . . . 5
79
+
4.1.1. $notify keyword registration . . . . . . . . . . . . 5
80
+
4.1.2. $muted keyword registration . . . . . . . . . . . . . 6
81
+
4.1.3. $followed keyword registration . . . . . . . . . . . 7
82
+
4.1.4. $memo keyword registration . . . . . . . . . . . . . 7
83
+
4.1.5. $hasmemo keyword registration . . . . . . . . . . . . 8
84
+
4.1.6. Attachment Detection . . . . . . . . . . . . . . . . 8
85
+
4.1.7. $autosent keyword registration . . . . . . . . . . . 9
86
+
4.1.8. $unsubscribed keyword registration . . . . . . . . . 10
87
+
4.1.9. $canunsubscribe keyword registration . . . . . . . . 10
88
+
4.1.10. $imported keyword registration . . . . . . . . . . . 11
89
+
4.1.11. $istrusted keyword registration . . . . . . . . . . . 11
90
+
4.1.12. $maskedemail keyword registration . . . . . . . . . . 12
91
+
4.1.13. $new keyword registration . . . . . . . . . . . . . . 12
92
+
4.1.14. $MailFlagBit0 keyword registration . . . . . . . . . 13
93
+
4.1.15. $MailFlagBit1 keyword registration . . . . . . . . . 13
94
+
4.1.16. $MailFlagBit2 keyword registration . . . . . . . . . 13
95
+
4.2. IMAP Mailbox Name Attributes Registrations . . . . . . . 14
96
+
4.2.1. Snoozed mailbox name attribute registration . . . . . 14
97
+
4.2.2. Scheduled mailbox name attribute registration . . . . 14
98
+
4.2.3. Memos mailbox name attribute registration . . . . . . 14
99
+
5. Security Considerations . . . . . . . . . . . . . . . . . . . 15
100
+
6. References . . . . . . . . . . . . . . . . . . . . . . . . . 15
101
+
6.1. Normative References . . . . . . . . . . . . . . . . . . 15
102
+
Authors' Addresses . . . . . . . . . . . . . . . . . . . . . . . 15
103
+
104
+
105
+
106
+
107
+
108
+
109
+
110
+
111
+
112
+
Jenkins & Eggert Expires 21 August 2025 [Page 2]
113
+
114
+
Internet-Draft Further IMAP/JMAP keywords & attributes February 2025
115
+
116
+
117
+
1. Introduction
118
+
119
+
The Internet Message Access Protocol (IMAP) specification [RFC9051]
120
+
defines the use of message keywords, and an "IMAP Keywords" registry
121
+
is created in [RFC5788]. Similarly [RFC8457] creates an "IMAP
122
+
Mailbox Name Attributes Registry".
123
+
124
+
This document does the following:
125
+
126
+
* Defines 16 message keywords
127
+
128
+
- $notify
129
+
130
+
- $muted
131
+
132
+
- $followed
133
+
134
+
- $memo
135
+
136
+
- $hasmemo
137
+
138
+
- $hasattachment
139
+
140
+
- $hasnoattachment
141
+
142
+
- $autosent
143
+
144
+
- $unsubscribed
145
+
146
+
- $canunsubscribe
147
+
148
+
- $imported
149
+
150
+
- $istrusted
151
+
152
+
- $maskedemail
153
+
154
+
- $new
155
+
156
+
- $MailFlagBit0
157
+
158
+
- $MailFlagBit1
159
+
160
+
- $MailFlagBit2
161
+
162
+
* Defines 3 mailbox name attributes
163
+
164
+
- Snoozed
165
+
166
+
167
+
168
+
Jenkins & Eggert Expires 21 August 2025 [Page 3]
169
+
170
+
Internet-Draft Further IMAP/JMAP keywords & attributes February 2025
171
+
172
+
173
+
- Scheduled
174
+
175
+
- Memos
176
+
177
+
* Registers these in the "IMAP Keywords" registry and "IMAP Mailbox
178
+
Name Attributes" registry respectively.
179
+
180
+
2. Requirements Language
181
+
182
+
The key words "MUST", "MUST NOT", "REQUIRED", "SHALL", "SHALL NOT",
183
+
"SHOULD", "SHOULD NOT", "RECOMMENDED", "NOT RECOMMENDED", "MAY", and
184
+
"OPTIONAL" in this document are to be interpreted as described in BCP
185
+
14 [RFC2119] [RFC8174] when, and only when, they appear in all
186
+
capitals, as shown here.
187
+
188
+
3. Flag Colors
189
+
190
+
The Internet Message Access Protocol (IMAP) specification [RFC9051]
191
+
defines a \Flagged system flag to mark a message for urgent/special
192
+
attention. The new keywords defined in Sections 4.1.14, 4.1.15, and
193
+
4.1.16 allow such a flagged message to have that flag be of one of 7
194
+
colors.
195
+
196
+
3.1. Definition of the MailFlagBit Message Keyword
197
+
198
+
The 3 flag color keywords $MailFlagBit0, $MailFlagBit1, and
199
+
$MailFlagBit2 make up a bit pattern that define the color of the flag
200
+
as such:
201
+
202
+
+=======+=======+=======+========+
203
+
| Bit 0 | Bit 1 | Bit 2 | Color |
204
+
+=======+=======+=======+========+
205
+
| 0 | 0 | 0 | red |
206
+
+-------+-------+-------+--------+
207
+
| 1 | 0 | 0 | orange |
208
+
+-------+-------+-------+--------+
209
+
| 0 | 1 | 0 | yellow |
210
+
+-------+-------+-------+--------+
211
+
| 1 | 1 | 1 | green |
212
+
+-------+-------+-------+--------+
213
+
| 0 | 0 | 1 | blue |
214
+
+-------+-------+-------+--------+
215
+
| 1 | 0 | 1 | purple |
216
+
+-------+-------+-------+--------+
217
+
| 0 | 1 | 1 | gray |
218
+
+-------+-------+-------+--------+
219
+
220
+
Table 1: Flag Colors
221
+
222
+
223
+
224
+
Jenkins & Eggert Expires 21 August 2025 [Page 4]
225
+
226
+
Internet-Draft Further IMAP/JMAP keywords & attributes February 2025
227
+
228
+
229
+
These flags SHOULD be ignored if the \Flagged system flag is not set.
230
+
If the \Flagged system flag is set, the flagged status MAY be
231
+
displayed to the user in the color corresponding to the combination
232
+
of the 3 flag color keywords.
233
+
234
+
3.2. Implementation Notes
235
+
236
+
A mail client that is aware of these flag color keywords SHOULD clear
237
+
all 3 flag color keywords when the user unflags the message, i.e.
238
+
when unsetting the \Flagged system flag, all 3 flag color keywords
239
+
SHOULD also be unset.
240
+
241
+
A mail client SHOULD NOT set any of these flags unless the \Flagged
242
+
system flag is already set or is being set.
243
+
244
+
Servers MAY unset these flag color keywords when a client unsets the
245
+
\Flagged system flag.
246
+
247
+
4. IANA Considerations
248
+
249
+
3 IMAP/JMAP keywords are registered in the IMAP/JMAP keywords
250
+
registry, as established in RFC5788.
251
+
252
+
4.1. IMAP/JMAP Keyword Registrations
253
+
254
+
4.1.1. $notify keyword registration
255
+
256
+
IMAP/JMAP keyword name: $notify
257
+
Purpose: Indicate to the client that a notification should be shown
258
+
for this message.
259
+
Private or Shared on a server: SHARED
260
+
Is it an advisory keyword or may it cause an automatic action: This
261
+
keyword can cause automatic action. On supporting clients, when a
262
+
new message is added to the mailstore with this keyword, the
263
+
client should show the user a notification.
264
+
Mail clients commonly show notifications for new mail, but often
265
+
the only option is to show a notification for every message that
266
+
arrives in the inbox. This keyword allows the user to create
267
+
rules (or the server to automatically determine) specific messages
268
+
that should show a notification.
269
+
Notifications for these messages may be in addition to
270
+
notifications for messages matching other criteria, according to
271
+
user preference set on the client.
272
+
When/by whom the keyword is set/cleared: This keyword is set by a
273
+
274
+
275
+
276
+
277
+
278
+
279
+
280
+
Jenkins & Eggert Expires 21 August 2025 [Page 5]
281
+
282
+
Internet-Draft Further IMAP/JMAP keywords & attributes February 2025
283
+
284
+
285
+
server on delivery when a message meets criteria such that the
286
+
user should be shown a notification. It may be cleared by a
287
+
client when the user opens, archives, or otherwise interacts with
288
+
the message. Other clients connected to the same account may
289
+
choose to automatically close the notification if the flag is
290
+
cleared.
291
+
Related keywords: None
292
+
Related IMAP capabilities: None
293
+
Security considerations: None
294
+
Published specification: This document
295
+
Intended usage: COMMON
296
+
Scope: BOTH
297
+
Owner/Change controller: IESG
298
+
299
+
4.1.2. $muted keyword registration
300
+
301
+
IMAP/JMAP keyword name: $muted
302
+
Purpose: Indicate to the server that the user is not interested in
303
+
future replies to a particular thread.
304
+
Private or Shared on a server: SHARED
305
+
Is it an advisory keyword or may it cause an automatic action: This
306
+
keyword can cause automatic action. On supporting servers, when a
307
+
new message arrives that is in the same thread as a message with
308
+
this keyword the server may automatically process it in some way
309
+
to deprioritise it for the user, for example by moving it to the
310
+
archive or trash, or marking it read. The exact action, whether
311
+
this is customisable by the user, and interaction with user rules
312
+
is vendor specific.
313
+
A message is defined to be in the same thread as another if the
314
+
server assigns them both the same thread id, as defined in
315
+
[RFC8474] Section 5.2 for IMAP or [RFC8621], Section 3 for JMAP.
316
+
When/by whom the keyword is set/cleared: This keyword is set by a
317
+
client when the user indicates they wish to mute or unmute a
318
+
thread. When unmuting a thread, the client must remove the
319
+
keyword from every message in the thread that has it.
320
+
Related keywords: Mutually exclusive with $followed. If both are
321
+
specified on a thread, servers MUST behave as though only
322
+
$followed were set.
323
+
Related IMAP capabilities: None
324
+
Security considerations: Muting a thread can mean a user won't see a
325
+
reply. If someone compromises a user's account, they may mute
326
+
threads where they don't want the user to see the reply, for
327
+
example when sending phishing to the user's contacts. There are
328
+
many other ways an attacker with access to the user's mailbox can
329
+
also achieve this however, so this is not greatly increasing the
330
+
attack surface.
331
+
Published specification: This document
332
+
Intended usage: COMMON
333
+
334
+
335
+
336
+
Jenkins & Eggert Expires 21 August 2025 [Page 6]
337
+
338
+
Internet-Draft Further IMAP/JMAP keywords & attributes February 2025
339
+
340
+
341
+
Scope: BOTH
342
+
Owner/Change controller: IESG
343
+
344
+
4.1.3. $followed keyword registration
345
+
346
+
IMAP/JMAP keyword name: $followed
347
+
Purpose: Indicate to the server that the user is particularly
348
+
interested in future replies to a particular thread.
349
+
Private or Shared on a server: SHARED
350
+
Is it an advisory keyword or may it cause an automatic action: This
351
+
keyword can cause automatic action. On supporting servers, when a
352
+
new message arrives that is in the same thread as a message with
353
+
this keyword the server may automatically process it in some way
354
+
to prioritise it for the user, for example by ignoring rules that
355
+
would make it skip the inbox, or automatically adding the $notify
356
+
keyword. The exact action, whether this is customisable by the
357
+
user, and interaction with user rules is vendor specific.
358
+
A message is defined to be in the same thread as another if the
359
+
server assigns them both the same thread id, as defined in
360
+
[RFC8474] Section 5.2 for IMAP or [RFC8621], Section 3 for JMAP.
361
+
When/by whom the keyword is set/cleared: This keyword is set by a
362
+
client when the user indicates they wish to follow or unfollow a
363
+
thread. When unfollowing a thread, the client must remove the
364
+
keyword from every message in the thread that has it.
365
+
Related keywords: Mutually exclusive with $muted. If both are
366
+
specified on a thread, servers MUST behave as though only
367
+
$followed were set.
368
+
Related IMAP capabilities: None
369
+
Security considerations: None
370
+
Published specification: This document
371
+
Intended usage: COMMON
372
+
Scope: BOTH
373
+
Owner/Change controller: IESG
374
+
375
+
4.1.4. $memo keyword registration
376
+
377
+
IMAP/JMAP keyword name: $memo
378
+
Purpose: Indicate to the client that a message is a note-to-self
379
+
from the user regarding another message in the same thread.
380
+
Private or Shared on a server: SHARED
381
+
Is it an advisory keyword or may it cause an automatic action: This
382
+
keyword is advisory.
383
+
When/by whom the keyword is set/cleared: This keyword is set by a
384
+
client when creating such a message. The message should otherwise
385
+
be contructed like a reply to the message to which this memo is
386
+
attached (i.e. appropriate Subject and Reply-To headers set). In
387
+
supporting clients, messages with this flag may be presented
388
+
differently to the user, attached to the message the memo is
389
+
390
+
391
+
392
+
Jenkins & Eggert Expires 21 August 2025 [Page 7]
393
+
394
+
Internet-Draft Further IMAP/JMAP keywords & attributes February 2025
395
+
396
+
397
+
commenting on, and may offer the user the ability to edit or
398
+
delete the memo. (As messages are immutable, editing requires
399
+
replacing the message.)
400
+
Related keywords: The $hasmemo keyword should be set/cleared at the
401
+
same time.
402
+
Related IMAP capabilities: None
403
+
Security considerations: None
404
+
Published specification: This document
405
+
Intended usage: COMMON
406
+
Scope: BOTH
407
+
Owner/Change controller: IESG
408
+
409
+
4.1.5. $hasmemo keyword registration
410
+
411
+
IMAP/JMAP keyword name: $hasmemo
412
+
Purpose: Indicate to the client that a message has an associated
413
+
memo with the $memo keyword.
414
+
Private or Shared on a server: SHARED
415
+
Is it an advisory keyword or may it cause an automatic action: This
416
+
keyword is advisory.
417
+
When/by whom the keyword is set/cleared: This keyword is set by a
418
+
client when creating a memo. The memo gets the $memo keyword, the
419
+
message it is a note for gets the $hasmemo keyword. This keyword
420
+
can help in searching for messages with memos, or deciding whether
421
+
to fetch the whole thread to look for memos when loading a
422
+
mailbox.
423
+
Related keywords: A message with the $memo keyword should be
424
+
created/destroyed at the same time.
425
+
Related IMAP capabilities: None
426
+
Security considerations: None
427
+
Published specification: This document
428
+
Intended usage: COMMON
429
+
Scope: BOTH
430
+
Owner/Change controller: IESG
431
+
432
+
4.1.6. Attachment Detection
433
+
434
+
The $hasattachment and $hasnoattachment are mutually exclusive. A
435
+
message SHOULD NOT contain both keywords.
436
+
437
+
4.1.6.1. $hasattachment keyword registration
438
+
439
+
IMAP/JMAP keyword name: $hasattachment
440
+
Purpose: Indicate to the client that a message has an attachment.
441
+
Private or Shared on a server: SHARED
442
+
Is it an advisory keyword or may it cause an automatic action: This
443
+
keyword is advisory.
444
+
When/by whom the keyword is set/cleared: This keyword is set by a
445
+
446
+
447
+
448
+
Jenkins & Eggert Expires 21 August 2025 [Page 8]
449
+
450
+
Internet-Draft Further IMAP/JMAP keywords & attributes February 2025
451
+
452
+
453
+
server on messages it determines have an attachment. This can
454
+
help mailbox clients indicate this to the user without having to
455
+
fetch the full message body structure. Over JMAP, the
456
+
"hasAttachment" Email property should indicate the same value.
457
+
Related keywords: $hasnoattachment
458
+
Related IMAP capabilities: None
459
+
Security considerations: None
460
+
Published specification: This document
461
+
Intended usage: COMMON
462
+
Scope: BOTH
463
+
Owner/Change controller: IESG
464
+
465
+
4.1.6.2. $hasnoattachment keyword registration
466
+
467
+
IMAP/JMAP keyword name: $hasnoattachment
468
+
Purpose: Indicate to the client that a message does not have an
469
+
attachment.
470
+
Private or Shared on a server: SHARED
471
+
Is it an advisory keyword or may it cause an automatic action: This
472
+
keyword is advisory.
473
+
When/by whom the keyword is set/cleared: This keyword is set by a
474
+
server on messages it determines does NOT have an attachment.
475
+
Over JMAP, the "hasNoAttachment" Email property should indicate
476
+
the same value. This keyword is needed in addition to the
477
+
$hasattachment keyword, as a client cannot otherwise determine
478
+
whether the server has processed the message for the presence of
479
+
an attachment. In other words, the absence of the $hasattachment
480
+
keyword for a message does not tell a client whether the message
481
+
actually contains an attachment, as the client has no information
482
+
on whether the server has processed the message.
483
+
Related keywords: None
484
+
Related IMAP capabilities: None
485
+
Security considerations: None
486
+
Published specification: This document
487
+
Intended usage: COMMON
488
+
Scope: BOTH
489
+
Owner/Change controller: IESG
490
+
491
+
4.1.7. $autosent keyword registration
492
+
493
+
IMAP/JMAP keyword name: $autosent
494
+
Purpose: Indicate to the client that a message was sent
495
+
automatically as a response due to a user rule or setting.
496
+
Private or Shared on a server: SHARED
497
+
Is it an advisory keyword or may it cause an automatic action: This
498
+
keyword is advisory.
499
+
When/by whom the keyword is set/cleared: This keyword is set by a
500
+
501
+
502
+
503
+
504
+
Jenkins & Eggert Expires 21 August 2025 [Page 9]
505
+
506
+
Internet-Draft Further IMAP/JMAP keywords & attributes February 2025
507
+
508
+
509
+
server on the user's copy of their vacation response and other
510
+
automated messages sent on behalf of the user. Clients may use
511
+
this to indicate to the user that this message was sent
512
+
automatically, as if they have forgotten the rule or vacation
513
+
response is set up they may be surprised to see it among their
514
+
sent items.
515
+
Related keywords: None
516
+
Related IMAP capabilities: None
517
+
Security considerations: None
518
+
Published specification: This document
519
+
Intended usage: COMMON
520
+
Scope: BOTH
521
+
Owner/Change controller: IESG
522
+
523
+
4.1.8. $unsubscribed keyword registration
524
+
525
+
IMAP/JMAP keyword name: $unsubscribed
526
+
Purpose: Indicate to the client that it has unsubscribed from the
527
+
thread this message is on.
528
+
Private or Shared on a server: SHARED
529
+
Is it an advisory keyword or may it cause an automatic action: This
530
+
keyword is advisory.
531
+
When/by whom the keyword is set/cleared: This keyword is set by a
532
+
client on a message after attempting to unsubscribe from the
533
+
mailing list this message came from (e.g., after attempting
534
+
RFC8058 one-click List-Unsubscribe). It allows clients to remind
535
+
the user that they have unsubscribed if they open the message
536
+
again.
537
+
Related keywords: None
538
+
Related IMAP capabilities: None
539
+
Security considerations: None
540
+
Published specification: This document
541
+
Intended usage: COMMON
542
+
Scope: BOTH
543
+
Owner/Change controller: IESG
544
+
545
+
4.1.9. $canunsubscribe keyword registration
546
+
547
+
IMAP/JMAP keyword name: $canunsubscribe
548
+
Purpose: Indicate to the client that this message has an
549
+
RFC8058-compliant List-Unsubscribe header.
550
+
Private or Shared on a server: SHARED
551
+
Is it an advisory keyword or may it cause an automatic action: This
552
+
keyword is advisory.
553
+
When/by whom the keyword is set/cleared: This keyword is set by a
554
+
555
+
556
+
557
+
558
+
559
+
560
+
Jenkins & Eggert Expires 21 August 2025 [Page 10]
561
+
562
+
Internet-Draft Further IMAP/JMAP keywords & attributes February 2025
563
+
564
+
565
+
server on messages with an RFC8058-compliant List-Unsubscribe
566
+
header. It may only do so if the message passes vendor-specific
567
+
reputation checks. It is intended to indicate to clients that
568
+
they may be able to do a one-click unsubscribe, without them
569
+
having to fetch the List-Unsubscribe header to determine themself.
570
+
Related keywords: None
571
+
Related IMAP capabilities: None
572
+
Security considerations: None
573
+
Published specification: This document
574
+
Intended usage: COMMON
575
+
Scope: BOTH
576
+
Owner/Change controller: IESG
577
+
578
+
4.1.10. $imported keyword registration
579
+
580
+
IMAP/JMAP keyword name: $imported
581
+
Purpose: Indicate to the client that this message was imported from
582
+
another mailbox.
583
+
Private or Shared on a server: SHARED
584
+
Is it an advisory keyword or may it cause an automatic action: This
585
+
keyword is advisory.
586
+
When/by whom the keyword is set/cleared: This keyword is set by a
587
+
server on messages in imports from another mailbox.
588
+
Related keywords: None
589
+
Related IMAP capabilities: None
590
+
Security considerations: None
591
+
Published specification: This document
592
+
Intended usage: COMMON
593
+
Scope: BOTH
594
+
Owner/Change controller: IESG
595
+
596
+
4.1.11. $istrusted keyword registration
597
+
598
+
IMAP/JMAP keyword name: $istrusted
599
+
Purpose: Indicate to the client that the authenticity of the from
600
+
name and email address have been verified with complete confidence
601
+
by the server.
602
+
Private or Shared on a server: SHARED
603
+
Is it an advisory keyword or may it cause an automatic action: This
604
+
keyword is advisory. Clients may show a verification mark (often
605
+
a tick icon) on messages with this keyword to indicate their
606
+
trusted status to the user.
607
+
When/by whom the keyword is set/cleared: This keyword is set by a
608
+
server on messages it delivers where it wishes to confirm to the
609
+
user that this is a legitimate email they can trust. It is
610
+
usually only used for the mailbox provider's own messages to the
611
+
customer, where they can know with absolute certainty that the
612
+
friendly from name and email address are legitimate.
613
+
614
+
615
+
616
+
Jenkins & Eggert Expires 21 August 2025 [Page 11]
617
+
618
+
Internet-Draft Further IMAP/JMAP keywords & attributes February 2025
619
+
620
+
621
+
Related keywords: None
622
+
Related IMAP capabilities: None
623
+
Security considerations: Servers should make sure this keyword is
624
+
only set for messages that really are trusted!
625
+
Published specification: This document
626
+
Intended usage: COMMON
627
+
Scope: BOTH
628
+
Owner/Change controller: IESG
629
+
630
+
4.1.12. $maskedemail keyword registration
631
+
632
+
IMAP/JMAP keyword name: $maskedemail
633
+
Purpose: Indicate to the client that the message was received via an
634
+
alias created for an individual sender.
635
+
Private or Shared on a server: SHARED
636
+
Is it an advisory keyword or may it cause an automatic action: This
637
+
keyword is advisory. Clients may show an icon to indicate to the
638
+
user this was received via a masked email address - an alias
639
+
created for a specific sender to hide the user's real email
640
+
address.
641
+
When/by whom the keyword is set/cleared: This keyword is set by a
642
+
server on messages it delivers that arrived via such an alias.
643
+
Related keywords: None
644
+
Related IMAP capabilities: None
645
+
Security considerations: None
646
+
Published specification: This document
647
+
Intended usage: LIMITED
648
+
Scope: BOTH
649
+
Owner/Change controller: IESG
650
+
651
+
4.1.13. $new keyword registration
652
+
653
+
IMAP/JMAP keyword name: $new
654
+
Purpose: Indicate to the client that a message should be made more
655
+
prominent to the user due to a recent action.
656
+
Private or Shared on a server: SHARED
657
+
Is it an advisory keyword or may it cause an automatic action: This
658
+
keyword is advisory. Clients may show the status of the message.
659
+
When/by whom the keyword is set/cleared: This keyword is set by a
660
+
server on messages after awakening them from snooze. Clients
661
+
should clear the keyword when the message is opened.
662
+
Related keywords: None
663
+
Related IMAP capabilities: None
664
+
Security considerations: None
665
+
Published specification: This document
666
+
Intended usage: LIMITED
667
+
Scope: BOTH
668
+
Owner/Change controller: IESG
669
+
670
+
671
+
672
+
Jenkins & Eggert Expires 21 August 2025 [Page 12]
673
+
674
+
Internet-Draft Further IMAP/JMAP keywords & attributes February 2025
675
+
676
+
677
+
4.1.14. $MailFlagBit0 keyword registration
678
+
679
+
IMAP/JMAP keyword name: $MailFlagBit0
680
+
Purpose: 0 bit part of a 3-bit bitmask that defines the color of the
681
+
flag when the has the system flag \Flagged set. See Section 3 for
682
+
details.
683
+
Private or Shared on a server: SHARED
684
+
Is it an advisory keyword or may it cause an automatic action: No
685
+
When/by whom the keyword is set/cleared: This keyword is set by a
686
+
client as the result of a user action to "flag" a message for
687
+
urgent/special attention.
688
+
Related keywords: $MailFlagBit1, $MailFlagBit2
689
+
Related IMAP capabilities: None
690
+
Security considerations: None
691
+
Published specification: This document
692
+
Intended usage: COMMON
693
+
Owner/Change controller: IESG
694
+
695
+
4.1.15. $MailFlagBit1 keyword registration
696
+
697
+
IMAP/JMAP keyword name: $MailFlagBit1
698
+
Purpose: 0 bit part of a 3-bit bitmask that defines the color of the
699
+
flag when the has the system flag \Flagged set. See Section 3 for
700
+
details.
701
+
Private or Shared on a server: SHARED
702
+
Is it an advisory keyword or may it cause an automatic action: No
703
+
When/by whom the keyword is set/cleared: This keyword is set by a
704
+
client as the result of a user action to "flag" a message for
705
+
urgent/special attention.
706
+
Related keywords: $MailFlagBit0, $MailFlagBit2
707
+
Related IMAP capabilities: None
708
+
Security considerations: None
709
+
Published specification: This document
710
+
Intended usage: COMMON
711
+
Owner/Change controller: IESG
712
+
713
+
4.1.16. $MailFlagBit2 keyword registration
714
+
715
+
IMAP/JMAP keyword name: $MailFlagBit2
716
+
Purpose: 0 bit part of a 3-bit bitmask that defines the color of the
717
+
flag when the has the system flag \Flagged set. See Section 3 for
718
+
details.
719
+
Private or Shared on a server: SHARED
720
+
Is it an advisory keyword or may it cause an automatic action: No
721
+
When/by whom the keyword is set/cleared: This keyword is set by a
722
+
client as the result of a user action to "flag" a message for
723
+
urgent/special attention.
724
+
Related keywords: $MailFlagBit0, $MailFlagBit1
725
+
726
+
727
+
728
+
Jenkins & Eggert Expires 21 August 2025 [Page 13]
729
+
730
+
Internet-Draft Further IMAP/JMAP keywords & attributes February 2025
731
+
732
+
733
+
Related IMAP capabilities: None
734
+
Security considerations: None
735
+
Published specification: This document
736
+
Intended usage: COMMON
737
+
Owner/Change controller: IESG
738
+
739
+
4.2. IMAP Mailbox Name Attributes Registrations
740
+
741
+
This section lists mailbox name attributes to be registered with the
742
+
"IMAP Mailbox Name Attributes" created with [RFC8457].
743
+
744
+
Note that none of the attribute names in this seciton have an implied
745
+
backslash. This sets them apart from those specified in Section 2 of
746
+
[RFC6154].
747
+
748
+
4.2.1. Snoozed mailbox name attribute registration
749
+
750
+
Attribute Name: Snoozed
751
+
Description: Messages that have been snoozed are moved to this
752
+
mailbox until the "awaken" time, when they are moved out of it
753
+
again automatically by the server.
754
+
Reference: This document.
755
+
Usage Notes: Snooze functionality is common among services but not
756
+
yet standardised. This attribute marks the mailbox where snoozed
757
+
messages may be found, but does not on its own provide a way for
758
+
clients to snooze messages.
759
+
760
+
4.2.2. Scheduled mailbox name attribute registration
761
+
762
+
Attribute Name: Scheduled
763
+
Description: Messages that have been scheduled to send at a later
764
+
time. Once the server has sent them at the scheduled time, they
765
+
will automatically be deleted or moved from this mailbox by the
766
+
server (probably to the \Sent mailbox).
767
+
Reference: This document.
768
+
Usage Notes: Scheduled sending functionality is common among
769
+
services but not yet standardised. This attribute marks the
770
+
mailbox where scheduled messages may be found, but does not on its
771
+
own provide a way for clients to schedule messages for sending.
772
+
773
+
4.2.3. Memos mailbox name attribute registration
774
+
775
+
Attribute Name: Memos
776
+
Description: Messages that have the $memo keyword. Clients creating
777
+
memos are recommended to store them in this mailbox. This allows
778
+
them to more easily be hidden from the user as "messages", and
779
+
presented only as memos instead.
780
+
Reference: This document.
781
+
782
+
783
+
784
+
Jenkins & Eggert Expires 21 August 2025 [Page 14]
785
+
786
+
Internet-Draft Further IMAP/JMAP keywords & attributes February 2025
787
+
788
+
789
+
Usage Notes: None.
790
+
791
+
5. Security Considerations
792
+
793
+
This document should not affect the security of the Internet.
794
+
795
+
6. References
796
+
797
+
6.1. Normative References
798
+
799
+
[RFC2119] Bradner, S., "Key words for use in RFCs to Indicate
800
+
Requirement Levels", BCP 14, RFC 2119,
801
+
DOI 10.17487/RFC2119, March 1997,
802
+
<https://www.rfc-editor.org/info/rfc2119>.
803
+
804
+
[RFC6154] Leiba, B. and J. Nicolson, "IMAP LIST Extension for
805
+
Special-Use Mailboxes", RFC 6154, DOI 10.17487/RFC6154,
806
+
March 2011, <https://www.rfc-editor.org/info/rfc6154>.
807
+
808
+
[RFC8174] Leiba, B., "Ambiguity of Uppercase vs Lowercase in RFC
809
+
2119 Key Words", BCP 14, RFC 8174, DOI 10.17487/RFC8174,
810
+
May 2017, <https://www.rfc-editor.org/info/rfc8174>.
811
+
812
+
[RFC8457] Leiba, B., Ed., "IMAP "$Important" Keyword and
813
+
"\Important" Special-Use Attribute", RFC 8457,
814
+
DOI 10.17487/RFC8457, September 2018,
815
+
<https://www.rfc-editor.org/info/rfc8457>.
816
+
817
+
[RFC8474] Gondwana, B., Ed., "IMAP Extension for Object
818
+
Identifiers", RFC 8474, DOI 10.17487/RFC8474, September
819
+
2018, <https://www.rfc-editor.org/info/rfc8474>.
820
+
821
+
[RFC8621] Jenkins, N. and C. Newman, "The JSON Meta Application
822
+
Protocol (JMAP) for Mail", RFC 8621, DOI 10.17487/RFC8621,
823
+
August 2019, <https://www.rfc-editor.org/info/rfc8621>.
824
+
825
+
[RFC9051] Melnikov, A., Ed. and B. Leiba, Ed., "Internet Message
826
+
Access Protocol (IMAP) - Version 4rev2", RFC 9051,
827
+
DOI 10.17487/RFC9051, August 2021,
828
+
<https://www.rfc-editor.org/info/rfc9051>.
829
+
830
+
[RFC5788] Melnikov, A. and D. Cridland, "IMAP4 Keyword Registry",
831
+
RFC 5788, DOI 10.17487/RFC5788, March 2010,
832
+
<https://www.rfc-editor.org/info/rfc5788>.
833
+
834
+
Authors' Addresses
835
+
836
+
837
+
838
+
839
+
840
+
Jenkins & Eggert Expires 21 August 2025 [Page 15]
841
+
842
+
Internet-Draft Further IMAP/JMAP keywords & attributes February 2025
843
+
844
+
845
+
Neil Jenkins (editor)
846
+
Fastmail
847
+
PO Box 234, Collins St West
848
+
Melbourne VIC 8007
849
+
Australia
850
+
Email: neilj@fastmailteam.com
851
+
URI: https://www.fastmail.com
852
+
853
+
854
+
Daniel Eggert (editor)
855
+
Apple Inc
856
+
One Apple Park Way
857
+
Cupertino, CA 95014
858
+
United States of America
859
+
Email: deggert@apple.com
860
+
URI: https://www.apple.com
861
+
862
+
863
+
864
+
865
+
866
+
867
+
868
+
869
+
870
+
871
+
872
+
873
+
874
+
875
+
876
+
877
+
878
+
879
+
880
+
881
+
882
+
883
+
884
+
885
+
886
+
887
+
888
+
889
+
890
+
891
+
892
+
893
+
894
+
895
+
896
+
Jenkins & Eggert Expires 21 August 2025 [Page 16]