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