comparing a4cebe0a5fb6bde63e45910a31a88d9fbec967f1 and if-only on anil.recoil.org/ocaml-jmap

.ocamlformat

···

       0

-68

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. Potential future work:

65
-
- Add helper functions for more complex filtering of emails

66
-
- Implement support for Email/copy and Email/import methods

67
-
- Add functions for managing identities and vacation responses

68
-
- Add proper testing framework with mocked JMAP server responses

+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

···

       1
       -
       # JMAP OCaml Client

     

       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)).

     

       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.

     

       6
        
       

     

       7
       -
       ## Overview

     

       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:

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       10
        
       

     

       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

     

       0
        
       
     

       0
        
       
     

       16
        
       

     

       17
       -
       ## Installation

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       18
        
       

     

       19
       -
       Add to your project with opam:

     

       20
        
       

     

       21
       -
       ```

     

       22
       -
       opam install .

     

       23
       -
       ```

     

       24
        
       

     

       25
       -
       ## Features

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       26
        
       

     

       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

     

       32
        
       

     

       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

     

       46
        
       

     

       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

     

       53
        
       ```

     

       54
        
       

     

       55
       -
       ## Example Tools

     

       56
        
       

     

       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

     

       63
        
       

     

       64
       -
       [MIT License](LICENSE)

     

       0
        
       
     

       0
        
       
     

       65
        
       

     

       66
        
       ## References

     

       67
        
       

     

       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/)

···

       1
       +
       # JMAP OCaml Libraries

     

       2
        
       

     

       3
       +
       This project implements OCaml libraries for the JMAP protocol, following the specifications in RFC 8620 (Core) and RFC 8621 (Mail).

     

       4
        
       

     

       5
       +
       ## Project Structure

     

       6
        
       

     

       7
       +
       The code is organized into three main libraries:

     

       8
        
       

     

       9
       +
       1. `jmap` - Core JMAP protocol (RFC 8620)

     

       10
       +
          - Basic data types

     

       11
       +
          - Error handling

     

       12
       +
          - Wire protocol

     

       13
       +
          - Session handling

     

       14
       +
          - Standard methods (get, set, changes, query)

     

       15
       +
          - Binary data handling

     

       16
       +
          - Push notifications

     

       17
        
       

     

       18
       +
       2. `jmap-unix` - Unix-specific implementation of JMAP

     

       19
       +
          - HTTP connections to JMAP endpoints

     

       20
       +
          - Authentication

     

       21
       +
          - Session discovery

     

       22
       +
          - Request/response handling

     

       23
       +
          - Blob upload/download

     

       24
       +
          - Unix-specific I/O

     

       25
        
       

     

       26
       +
       3. `jmap-email` - JMAP Mail extension (RFC 8621)

     

       27
       +
          - Email specific types

     

       28
       +
          - Mailbox handling

     

       29
       +
          - Thread management

     

       30
       +
          - Search snippet functionality

     

       31
       +
          - Identity management

     

       32
       +
          - Email submission

     

       33
       +
          - Vacation response

     

       34
        
       

     

       35
       +
       ## Usage

     

       36
        
       

     

       37
       +
       The libraries are designed to be used together. For example:

     

       0
        
       
     

       0
        
       
     

       38
        
       

     

       39
       +
       ```ocaml

     

       40
       +
       (* Using the core JMAP protocol library *)

     

       41
       +
       open Jmap

     

       42
       +
       open Jmap.Types

     

       43
       +
       open Jmap.Wire

     

       44
        
       

     

       45
       +
       (* Using the Unix implementation *)

     

       46
       +
       open Jmap_unix

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       47
        
       

     

       48
       +
       (* Using the JMAP Email extension library *)

     

       49
       +
       open Jmap_email

     

       50
       +
       open Jmap_email.Types

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       51
        
       

     

       52
       +
       (* Example: Connecting to a JMAP server *)

     

       53
       +
       let connect_to_server () =

     

       54
       +
         let credentials = Jmap_unix.Basic("username", "password") in

     

       55
       +
         let (ctx, session) = Jmap_unix.quick_connect ~host:"jmap.example.com" ~username:"user" ~password:"pass" in

     

       56
       +
         ...

     

       0
        
       
     

       57
        
       ```

     

       58
        
       

     

       59
       +
       ## Building

     

       60
        
       

     

       61
       +
       ```sh

     

       62
       +
       # Build

     

       63
       +
       opam exec -- dune build @check

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       64
        
       

     

       65
       +
       # Generate documentation

     

       66
       +
       opam exec -- dune build @doc

     

       67
       +
       ```

     

       68
        
       

     

       69
        
       ## References

     

       70
        
       

     

       71
       +
       - [RFC 8620: The JSON Meta Application Protocol (JMAP)](https://www.rfc-editor.org/rfc/rfc8620.html)

     

       72
       +
       - [RFC 8621: The JSON Meta Application Protocol (JMAP) for Mail](https://www.rfc-editor.org/rfc/rfc8621.html)
     

       0
        
       
     

       0

+54 -12

bin/dune

···

       1
        
       (executable

     

       2
       -
        (name fastmail_list)

     

       3
       -
        (public_name fastmail-list)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       4
        
        (package jmap)

     

       5
       -
        (modules fastmail_list)

     

       6
       -
        (libraries jmap jmap_mail lwt.unix logs logs.fmt))

     

       7
        
       

     

       8
        
       (executable

     

       9
       -
        (name flag_color_test)

     

       10
       -
        (public_name flag-color-test)

     

       11
        
        (package jmap)

     

       12
       -
        (modules flag_color_test)

     

       13
       -
        (libraries jmap jmap_mail))

     

       14
        
       

     

       15
        
       (executable

     

       16
       -
        (name tutorial_examples)

     

       17
       -
        (public_name jmap-tutorial-examples)

     

       18
        
        (package jmap)

     

       19
       -
        (modules tutorial_examples)

     

       20
       -
        (libraries jmap jmap_mail))

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0

···

       1
        
       (executable

     

       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)

     

       39
       +
        (package jmap)

     

       40
       +
        (libraries jmap jmap-email jmap-unix cmdliner unix)

     

       41
       +
        (modules jmap_blob_downloader))

     

       42
       +
       

     

       43
       +
       (executable

     

       44
       +
        (name jmap_email_composer)

     

       45
       +
        (public_name jmap-email-composer)

     

       46
       +
        (package jmap)

     

       47
       +
        (libraries jmap jmap-email jmap-unix cmdliner unix)

     

       48
       +
        (modules jmap_email_composer))

     

       49
       +
       

     

       50
       +
       (executable

     

       51
       +
        (name jmap_push_listener)

     

       52
       +
        (public_name jmap-push-listener)

     

       53
       +
        (package jmap)

     

       54
       +
        (libraries jmap jmap-email jmap-unix cmdliner unix)

     

       55
       +
        (modules jmap_push_listener))

     

       56
       +
       

     

       57
       +
       (executable

     

       58
       +
        (name jmap_vacation_manager)

     

       59
       +
        (public_name jmap-vacation-manager)

     

       60
       +
        (package jmap)

     

       61
       +
        (libraries jmap jmap-email jmap-unix cmdliner unix)

     

       62
       +
        (modules jmap_vacation_manager))

-299

bin/fastmail_list.ml

···

       1
       -
       (** 

     

       2
       -
        * fastmail_list - Lists emails from a Fastmail account using JMAP API

     

       3
       -
        *

     

       4
       -
        * This binary connects to the Fastmail JMAP API using an authentication token

     

       5
       -
        * from the JMAP_API_TOKEN environment variable and lists the most recent 100

     

       6
       -
        * emails with their subjects, sender details, and labels.

     

       7
       -
        *

     

       8
       -
        * Usage: 

     

       9
       -
        *   JMAP_API_TOKEN=your_api_token ./fastmail_list [options]

     

       10
       -
        *

     

       11
       -
        * Options:

     

       12
       -
        *   -unread       List only unread messages

     

       13
       -
        *   -labels       Show labels/keywords associated with messages

     

       14
       -
        *   -debug LEVEL  Set debug level (0-4, where 4 is most verbose)

     

       15
       -
        *)

     

       16
       -
       

     

       17
       -
       open Lwt.Syntax

     

       18
       -
       open Jmap

     

       19
       -
       open Jmap_mail

     

       20
       -
       module Mail = Jmap_mail.Types

     

       21
       -
       

     

       22
       -
       (** Prints the email details *)

     

       23
       -
       let print_email ~show_labels (email : Mail.email) =

     

       24
       -
         let sender = 

     

       25
       -
           match email.from with

     

       26
       -
           | Some (addr :: _) -> 

     

       27
       -
               (match addr.name with

     

       28
       -
               | Some name -> Printf.sprintf "%s <%s>" name addr.email

     

       29
       -
               | None -> addr.email)

     

       30
       -
           | _ -> "<unknown>"

     

       31
       -
         in

     

       32
       -
         let subject = 

     

       33
       -
           match email.subject with

     

       34
       -
           | Some s -> s

     

       35
       -
           | None -> "<no subject>"

     

       36
       -
         in

     

       37
       -
         let date = email.received_at in

     

       38
       -
         

     

       39
       -
         (* Format labels/keywords if requested *)

     

       40
       -
         let labels_str = 

     

       41
       -
           if show_labels then

     

       42
       -
             let formatted = Jmap_mail.Types.format_email_keywords email.keywords in

     

       43
       -
             if formatted <> "" then

     

       44
       -
               " [" ^ formatted ^ "]"

     

       45
       -
             else

     

       46
       -
               ""

     

       47
       -
           else

     

       48
       -
             ""

     

       49
       -
         in

     

       50
       -
         

     

       51
       -
         Printf.printf "%s | %s | %s%s\n" date sender subject labels_str

     

       52
       -
       

     

       53
       -
       (** Check if an email is unread *)

     

       54
       -
       let is_unread (email : Mail.email) =

     

       55
       -
         let is_unread_keyword = 

     

       56
       -
           List.exists (fun (kw, active) -> 

     

       57
       -
             kw = Mail.Unread && active

     

       58
       -
           ) email.keywords

     

       59
       -
         in

     

       60
       -
         let is_not_seen = 

     

       61
       -
           not (List.exists (fun (kw, active) -> 

     

       62
       -
             kw = Mail.Seen && active

     

       63
       -
           ) email.keywords)

     

       64
       -
         in

     

       65
       -
         is_unread_keyword || is_not_seen

     

       66
       -
       

     

       67
       -
       (** Example function demonstrating how to use higher-level library functions for JMAP requests *)

     

       68
       -
       let demo_result_references conn account_id =

     

       69
       -
         Printf.printf "\nResult Reference Demo:\n";

     

       70
       -
         Printf.printf "=====================\n";

     

       71
       -
         

     

       72
       -
         (* Step 1: Get all mailboxes *)

     

       73
       -
         let* mailboxes_result = Jmap_mail.get_mailboxes conn ~account_id in

     

       74
       -
         match mailboxes_result with

     

       75
       -
         | Error err ->

     

       76
       -
             Printf.printf "Error getting mailboxes: %s\n" 

     

       77
       -
               (match err with

     

       78
       -
               | Jmap.Api.Connection_error msg -> "Connection error: " ^ msg

     

       79
       -
               | Jmap.Api.HTTP_error (code, body) -> Printf.sprintf "HTTP error %d: %s" code body

     

       80
       -
               | Jmap.Api.Parse_error msg -> "Parse error: " ^ msg

     

       81
       -
               | Jmap.Api.Authentication_error -> "Authentication error");

     

       82
       -
             Lwt.return_unit

     

       83
       -
             

     

       84
       -
         | Ok mailboxes ->

     

       85
       -
             (* Step 2: Get the first mailbox for this demonstration *)

     

       86
       -
             match mailboxes with

     

       87
       -
             | [] ->

     

       88
       -
                 Printf.printf "No mailboxes found.\n";

     

       89
       -
                 Lwt.return_unit

     

       90
       -
                 

     

       91
       -
             | first_mailbox :: _ ->

     

       92
       -
                 Printf.printf "Using mailbox: %s\n" first_mailbox.Mail.name;

     

       93
       -
                 

     

       94
       -
                 (* Step 3: Get emails from the selected mailbox *)

     

       95
       -
                 let* emails_result = Jmap_mail.get_messages_in_mailbox

     

       96
       -
                   conn

     

       97
       -
                   ~account_id

     

       98
       -
                   ~mailbox_id:first_mailbox.Mail.id

     

       99
       -
                   ~limit:10

     

       100
       -
                   ()

     

       101
       -
                 in

     

       102
       -
                 

     

       103
       -
                 match emails_result with

     

       104
       -
                 | Error err ->

     

       105
       -
                     Printf.printf "Error getting emails: %s\n" 

     

       106
       -
                       (match err with

     

       107
       -
                       | Jmap.Api.Connection_error msg -> "Connection error: " ^ msg

     

       108
       -
                       | Jmap.Api.HTTP_error (code, body) -> Printf.sprintf "HTTP error %d: %s" code body

     

       109
       -
                       | Jmap.Api.Parse_error msg -> "Parse error: " ^ msg

     

       110
       -
                       | Jmap.Api.Authentication_error -> "Authentication error");

     

       111
       -
                     Lwt.return_unit

     

       112
       -
                     

     

       113
       -
                 | Ok emails ->

     

       114
       -
                     Printf.printf "Successfully retrieved %d emails using the high-level library API!\n" 

     

       115
       -
                       (List.length emails);

     

       116
       -
                       

     

       117
       -
                     (* Display some basic information about the emails *)

     

       118
       -
                     List.iteri (fun i (email:Jmap_mail.Types.email) ->

     

       119
       -
                       let subject = Option.value ~default:"<no subject>" email.Mail.subject in

     

       120
       -
                       Printf.printf "  %d. %s\n" (i + 1) subject

     

       121
       -
                     ) emails;

     

       122
       -
                     

     

       123
       -
                     Lwt.return_unit

     

       124
       -
       

     

       125
       -
       (** Main function *)

     

       126
       -
       let main () =

     

       127
       -
         (* Parse command-line arguments *)

     

       128
       -
         let unread_only = ref false in

     

       129
       -
         let show_labels = ref false in

     

       130
       -
         let debug_level = ref 0 in

     

       131
       -
         let demo_refs = ref false in

     

       132
       -
         let sender_filter = ref "" in

     

       133
       -
         

     

       134
       -
         let args = [

     

       135
       -
           ("-unread", Arg.Set unread_only, "List only unread messages");

     

       136
       -
           ("-labels", Arg.Set show_labels, "Show labels/keywords associated with messages");

     

       137
       -
           ("-debug", Arg.Int (fun level -> debug_level := level), "Set debug level (0-4, where 4 is most verbose)");

     

       138
       -
           ("-demo-refs", Arg.Set demo_refs, "Demonstrate result references");

     

       139
       -
           ("-from", Arg.Set_string sender_filter, "Filter messages by sender email address (supports wildcards: * and ?)");

     

       140
       -
         ] in

     

       141
       -
         

     

       142
       -
         let usage_msg = "Usage: JMAP_API_TOKEN=your_token fastmail_list [options]" in

     

       143
       -
         Arg.parse args (fun _ -> ()) usage_msg;

     

       144
       -
         

     

       145
       -
         (* Configure logging *)

     

       146
       -
         init_logging ~level:!debug_level ~enable_logs:(!debug_level > 0) ~redact_sensitive:true ();

     

       147
       -
         

     

       148
       -
         match Sys.getenv_opt "JMAP_API_TOKEN" with

     

       149
       -
         | None -> 

     

       150
       -
             Printf.eprintf "Error: JMAP_API_TOKEN environment variable not set\n";

     

       151
       -
             Printf.eprintf "Usage: JMAP_API_TOKEN=your_token ./fastmail_list [options]\n";

     

       152
       -
             Printf.eprintf "Options:\n";

     

       153
       -
             Printf.eprintf "  -unread       List only unread messages\n";

     

       154
       -
             Printf.eprintf "  -labels       Show labels/keywords associated with messages\n";

     

       155
       -
             Printf.eprintf "  -debug LEVEL  Set debug level (0-4, where 4 is most verbose)\n";

     

       156
       -
             Printf.eprintf "  -demo-refs    Demonstrate result references\n";

     

       157
       -
             Printf.eprintf "  -from PATTERN Filter messages by sender email address (supports wildcards: * and ?)\n";

     

       158
       -
             exit 1

     

       159
       -
         | Some token ->

     

       160
       -
             (* Only print token info at Info level or higher *)

     

       161
       -
             Logs.info (fun m -> m "Using API token: %s" (redact_token token));

     

       162
       -
             

     

       163
       -
             (* Connect to Fastmail JMAP API *)

     

       164
       -
             let formatted_token = token in

     

       165
       -
             

     

       166
       -
             (* Only print instructions at Info level *)

     

       167
       -
             let level = match Logs.level () with

     

       168
       -
               | None -> 0

     

       169
       -
               | Some Logs.Error -> 1

     

       170
       -
               | Some Logs.Info -> 2 

     

       171
       -
               | Some Logs.Debug -> 3

     

       172
       -
               | _ -> 2

     

       173
       -
             in

     

       174
       -
             if level >= 2 then begin

     

       175
       -
               Printf.printf "\nFastmail API Instructions:\n";

     

       176
       -
               Printf.printf "1. Get a token from: https://app.fastmail.com/settings/tokens\n";

     

       177
       -
               Printf.printf "2. Create a new token with Mail scope (read/write)\n";

     

       178
       -
               Printf.printf "3. Copy the full token (example: 3de40-5fg1h2-a1b2c3...)\n";

     

       179
       -
               Printf.printf "4. Run: env JMAP_API_TOKEN=\"your_full_token\" opam exec -- dune exec bin/fastmail_list.exe [options]\n\n";

     

       180
       -
               Printf.printf "Note: This example is working correctly but needs a valid Fastmail token.\n\n";

     

       181
       -
             end;

     

       182
       -
             let* result = login_with_token 

     

       183
       -
               ~uri:"https://api.fastmail.com/jmap/session" 

     

       184
       -
               ~api_token:formatted_token

     

       185
       -
             in

     

       186
       -
             match result with

     

       187
       -
             | Error err -> 

     

       188
       -
                 (match err with

     

       189
       -
                 | Api.Connection_error msg -> 

     

       190
       -
                     Printf.eprintf "Connection error: %s\n" msg

     

       191
       -
                 | Api.HTTP_error (code, body) -> 

     

       192
       -
                     Printf.eprintf "HTTP error %d: %s\n" code body

     

       193
       -
                 | Api.Parse_error msg -> 

     

       194
       -
                     Printf.eprintf "Parse error: %s\n" msg

     

       195
       -
                 | Api.Authentication_error -> 

     

       196
       -
                     Printf.eprintf "Authentication error. Check your API token.\n");

     

       197
       -
                 Lwt.return 1

     

       198
       -
             | Ok conn ->

     

       199
       -
                 (* Get the primary account ID *)

     

       200
       -
                 let primary_account_id = 

     

       201
       -
                   let mail_capability = Jmap_mail.Capability.to_string Jmap_mail.Capability.Mail in

     

       202
       -
                   match List.assoc_opt mail_capability conn.session.primary_accounts with

     

       203
       -
                   | Some id -> id

     

       204
       -
                   | None -> 

     

       205
       -
                       match conn.session.accounts with

     

       206
       -
                       | (id, _) :: _ -> id

     

       207
       -
                       | [] -> 

     

       208
       -
                           Printf.eprintf "No accounts found\n";

     

       209
       -
                           exit 1

     

       210
       -
                 in

     

       211
       -
                 

     

       212
       -
                 (* Run result references demo if requested *)

     

       213
       -
                 let* () = 

     

       214
       -
                   if !demo_refs then

     

       215
       -
                     demo_result_references conn primary_account_id

     

       216
       -
                   else

     

       217
       -
                     Lwt.return_unit

     

       218
       -
                 in

     

       219
       -
                 

     

       220
       -
                 (* Get the Inbox mailbox *)

     

       221
       -
                 let* mailboxes_result = get_mailboxes conn ~account_id:primary_account_id in

     

       222
       -
                 match mailboxes_result with

     

       223
       -
                 | Error err -> 

     

       224
       -
                     Printf.eprintf "Failed to get mailboxes: %s\n" 

     

       225
       -
                       (match err with

     

       226
       -
                       | Api.Connection_error msg -> "Connection error: " ^ msg

     

       227
       -
                       | Api.HTTP_error (code, body) -> Printf.sprintf "HTTP error %d: %s" code body

     

       228
       -
                       | Api.Parse_error msg -> "Parse error: " ^ msg

     

       229
       -
                       | Api.Authentication_error -> "Authentication error");

     

       230
       -
                     Lwt.return 1

     

       231
       -
                 | Ok mailboxes ->

     

       232
       -
                     (* If there's a mailbox list, just use the first one for this example *)

     

       233
       -
                     let inbox_id = 

     

       234
       -
                       match mailboxes with

     

       235
       -
                       | mailbox :: _ -> mailbox.Mail.id

     

       236
       -
                       | [] -> 

     

       237
       -
                           Printf.eprintf "No mailboxes found\n";

     

       238
       -
                           exit 1

     

       239
       -
                     in

     

       240
       -
                     

     

       241
       -
                     (* Get messages from inbox *)

     

       242
       -
                     let* emails_result = get_messages_in_mailbox 

     

       243
       -
                       conn 

     

       244
       -
                       ~account_id:primary_account_id 

     

       245
       -
                       ~mailbox_id:inbox_id

     

       246
       -
                       ~limit:1000

     

       247
       -
                       ()

     

       248
       -
                     in

     

       249
       -
                     match emails_result with

     

       250
       -
                     | Error err -> 

     

       251
       -
                         Printf.eprintf "Failed to get emails: %s\n" 

     

       252
       -
                           (match err with

     

       253
       -
                           | Api.Connection_error msg -> "Connection error: " ^ msg

     

       254
       -
                           | Api.HTTP_error (code, body) -> Printf.sprintf "HTTP error %d: %s" code body

     

       255
       -
                           | Api.Parse_error msg -> "Parse error: " ^ msg

     

       256
       -
                           | Api.Authentication_error -> "Authentication error");

     

       257
       -
                         Lwt.return 1

     

       258
       -
                     | Ok emails ->

     

       259
       -
                         (* Apply filters based on command line arguments *)

     

       260
       -
                         let filtered_by_unread = 

     

       261
       -
                           if !unread_only then

     

       262
       -
                             List.filter is_unread emails

     

       263
       -
                           else 

     

       264
       -
                             emails

     

       265
       -
                         in

     

       266
       -
                         

     

       267
       -
                         (* Apply sender filter if specified *)

     

       268
       -
                         let filtered_emails =

     

       269
       -
                           if !sender_filter <> "" then begin

     

       270
       -
                             Printf.printf "Filtering by sender: %s\n" !sender_filter;

     

       271
       -
                             List.filter (fun email -> 

     

       272
       -
                               Jmap_mail.email_matches_sender email !sender_filter

     

       273
       -
                             ) filtered_by_unread

     

       274
       -
                           end else

     

       275
       -
                             filtered_by_unread

     

       276
       -
                         in

     

       277
       -
                         

     

       278
       -
                         (* Create description of applied filters *)

     

       279
       -
                         let filter_description = 

     

       280
       -
                           let parts = [] in

     

       281
       -
                           let parts = if !unread_only then "unread" :: parts else parts in

     

       282
       -
                           let parts = if !sender_filter <> "" then ("from \"" ^ !sender_filter ^ "\"") :: parts else parts in

     

       283
       -
                           match parts with

     

       284
       -
                           | [] -> "the most recent"

     

       285
       -
                           | [p] -> p

     

       286
       -
                           | _ -> String.concat " and " parts

     

       287
       -
                         in

     

       288
       -
                         

     

       289
       -
                         Printf.printf "Listing %s %d emails in your inbox:\n" 

     

       290
       -
                           filter_description

     

       291
       -
                           (List.length filtered_emails);

     

       292
       -
                         Printf.printf "--------------------------------------------\n";

     

       293
       -
                         List.iter (print_email ~show_labels:!show_labels) filtered_emails;

     

       294
       -
                         Lwt.return 0

     

       295
       -
       

     

       296
       -
       (** Program entry point *)

     

       297
       -
       let () =

     

       298
       -
         let exit_code = Lwt_main.run (main ()) in

     

       299
       -
         exit exit_code

-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

···

       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

···

       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

···

       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

···

       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

···

       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

···

       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

···

       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

···

       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

···

       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

···

       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

-3

dune

···

       1
       -
       (documentation

     

       2
       -
        (package jmap)

     

       3
       -
         (mld_files index))

+1 -22

dune-project

···

       1
       -
       (lang dune 3.17)

     

       2
       -
       (name jmap)

     

       3
       -
       

     

       4
       -
       (source (github avsm/jmap))

     

       5
       -
       (license ISC)

     

       6
       -
       (authors "Anil Madhavapeddy")

     

       7
       -
       (maintainers "anil@recoil.org")

     

       8
       -
       

     

       9
       -
       (generate_opam_files true)

     

       10
       -
       

     

       11
       -
       (package

     

       12
       -
        (name jmap)

     

       13
       -
        (synopsis "JMAP protocol")

     

       14
       -
        (description "This is all still a work in progress")

     

       15
       -
        (depends

     

       16
       -
         (ocaml (>= "5.2.0"))

     

       17
       -
         ptime

     

       18
       -
         cohttp

     

       19
       -
         cohttp-lwt-unix

     

       20
       -
         ezjsonm

     

       21
       -
         uri

     

       22
       -
         lwt))

···

       1
       +
       (lang dune 3.17)
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0

-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

···

       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

···

       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

···

       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

···

       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

···

       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

···

       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

···

       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

···

       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

···

       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

···

       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

···

       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

···

       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

···

       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

···

       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

···

       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

···

       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

···

       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

···

       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

···

       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

···

       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

jmap-unix/dune

···

       1
       +
       (library

     

       2
       +
        (name jmap_unix)

     

       3
       +
        (public_name jmap-unix)

     

       4
       +
        (libraries jmap jmap-email yojson uri unix)

     

       5
       +
        (modules_without_implementation jmap_unix)

     

       6
       +
        (modules jmap_unix))

+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

···

       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

···

       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

···

       1
       -
       (library

     

       2
       -
        (name jmap)

     

       3
       -
        (public_name jmap)

     

       4
       -
        (modules jmap)

     

       5
       -
        (libraries str ezjsonm ptime cohttp cohttp-lwt-unix uri lwt logs logs.fmt))

     

       6
       -
       

     

       7
       -
       (library

     

       8
       -
        (name jmap_mail)

     

       9
       -
        (public_name jmap.mail)

     

       10
       -
        (modules jmap_mail)

     

       11
       -
        (libraries jmap))

-783

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
       -
         (** Configuration for a JMAP API client *)

     

       447
       -
         type config = {

     

       448
       -
           api_uri: Uri.t;

     

       449
       -
           username: string;

     

       450
       -
           authentication_token: string;

     

       451
       -
         }

     

       452
       -
       

     

       453
       -
         (** Convert Ezjsonm.value to string *)

     

       454
       -
         let json_to_string json =

     

       455
       -
           Ezjsonm.value_to_string ~minify:false json

     

       456
       -
       

     

       457
       -
         (** Parse response string as JSON value *)

     

       458
       -
         let parse_json_string str =

     

       459
       -
           try Ok (Ezjsonm.from_string str)

     

       460
       -
           with e -> Error (Parse_error (Printexc.to_string e))

     

       461
       -
       

     

       462
       -
         (** Parse JSON response as a JMAP response object *)

     

       463
       -
         let parse_response json =

     

       464
       -
           try

     

       465
       -
             let method_responses =

     

       466
       -
               match Ezjsonm.find json ["methodResponses"] with

     

       467
       -
               | `A items ->

     

       468
       -
                   List.map (fun json ->

     

       469
       -
                     match json with

     

       470
       -
                     | `A [`String name; args; `String method_call_id] ->

     

       471
       -
                         { name; arguments = args; method_call_id }

     

       472
       -
                     | _ -> raise (Invalid_argument "Invalid invocation format in response")

     

       473
       -
                   ) items

     

       474
       -
               | _ -> raise (Invalid_argument "methodResponses is not an array")

     

       475
       -
             in

     

       476
       -
             let created_ids_opt =

     

       477
       -
               try

     

       478
       -
                 let obj = Ezjsonm.find json ["createdIds"] in

     

       479
       -
                 match obj with

     

       480
       -
                 | `O items -> Some (List.map (fun (k, v) ->

     

       481
       -
                     match v with

     

       482
       -
                     | `String id -> (k, id)

     

       483
       -
                     | _ -> raise (Invalid_argument "createdIds value is not a string")

     

       484
       -
                   ) items)

     

       485
       -
                 | _ -> None

     

       486
       -
               with Not_found -> None

     

       487
       -
             in

     

       488
       -
             let session_state =

     

       489
       -
               match Ezjsonm.find json ["sessionState"] with

     

       490
       -
               | `String s -> s

     

       491
       -
               | _ -> raise (Invalid_argument "sessionState is not a string")

     

       492
       -
             in

     

       493
       -
             Ok { method_responses; created_ids = created_ids_opt; session_state }

     

       494
       -
           with

     

       495
       -
           | Not_found -> Error (Parse_error "Required field not found in response")

     

       496
       -
           | Invalid_argument msg -> Error (Parse_error msg)

     

       497
       -
           | e -> Error (Parse_error (Printexc.to_string e))

     

       498
       -
       

     

       499
       -
         (** Serialize a JMAP request object to JSON *)

     

       500
       -
         let serialize_request req =

     

       501
       -
           let method_calls_json =

     

       502
       -
             `A (List.map (fun (inv : 'a invocation) ->

     

       503
       -
               `A [`String inv.name; inv.arguments; `String inv.method_call_id]

     

       504
       -
             ) req.method_calls)

     

       505
       -
           in

     

       506
       -
           let using_json = `A (List.map (fun s -> `String s) req.using) in

     

       507
       -
           let json = `O [

     

       508
       -
             ("using", using_json);

     

       509
       -
             ("methodCalls", method_calls_json)

     

       510
       -
           ] in

     

       511
       -
           let json = match req.created_ids with

     

       512
       -
             | Some ids ->

     

       513
       -
                 let created_ids_json = `O (List.map (fun (k, v) -> (k, `String v)) ids) in

     

       514
       -
                 Ezjsonm.update json ["createdIds"] (Some created_ids_json)

     

       515
       -
             | None -> json

     

       516
       -
           in

     

       517
       -
           json_to_string json

     

       518
       -
       

     

       519
       -
         (** Make a raw HTTP request *)

     

       520
       -
         let make_http_request ~method_ ~headers ~body uri =

     

       521
       -
           let open Cohttp in

     

       522
       -
           let open Cohttp_lwt_unix in

     

       523
       -
           let headers = Header.add_list (Header.init ()) headers in

     

       524
       -
           

     

       525
       -
           (* Log request details at debug level *)

     

       526
       -
           let header_list = Cohttp.Header.to_list headers in

     

       527
       -
           let redacted_headers = redact_headers header_list in

     

       528
       -
           Logs.debug (fun m -> 

     

       529
       -
             m "\n===== HTTP REQUEST =====\n\

     

       530
       -
                URI: %s\n\

     

       531
       -
                METHOD: %s\n\

     

       532
       -
                HEADERS:\n%s\n\

     

       533
       -
                BODY:\n%s\n\

     

       534
       -
                ======================\n"

     

       535
       -
               (Uri.to_string uri)

     

       536
       -
               method_

     

       537
       -
               (String.concat "\n" (List.map (fun (k, v) -> Printf.sprintf "  %s: %s" k v) redacted_headers))

     

       538
       -
               body);

     

       539
       -
           

     

       540
       -
           Lwt.catch

     

       541
       -
             (fun () ->

     

       542
       -
               let* resp, body = 

     

       543
       -
                 match method_ with

     

       544
       -
                 | "GET" -> Client.get ~headers uri

     

       545
       -
                 | "POST" -> Client.post ~headers ~body:(Cohttp_lwt.Body.of_string body) uri

     

       546
       -
                 | _ -> failwith (Printf.sprintf "Unsupported HTTP method: %s" method_)

     

       547
       -
               in

     

       548
       -
               let* body_str = Cohttp_lwt.Body.to_string body in

     

       549
       -
               let status = Response.status resp |> Code.code_of_status in

     

       550
       -
               

     

       551
       -
               (* Log response details at debug level *)

     

       552
       -
               let header_list = Cohttp.Header.to_list (Response.headers resp) in

     

       553
       -
               let redacted_headers = redact_headers header_list in

     

       554
       -
               Logs.debug (fun m -> 

     

       555
       -
                 m "\n===== HTTP RESPONSE =====\n\

     

       556
       -
                    STATUS: %d\n\

     

       557
       -
                    HEADERS:\n%s\n\

     

       558
       -
                    BODY:\n%s\n\

     

       559
       -
                    ======================\n"

     

       560
       -
                   status

     

       561
       -
                   (String.concat "\n" (List.map (fun (k, v) -> Printf.sprintf "  %s: %s" k v) redacted_headers))

     

       562
       -
                   body_str);

     

       563
       -
               

     

       564
       -
               if status >= 200 && status < 300 then

     

       565
       -
                 Lwt.return (Ok body_str)

     

       566
       -
               else

     

       567
       -
                 Lwt.return (Error (HTTP_error (status, body_str))))

     

       568
       -
             (fun e -> 

     

       569
       -
               let error_msg = Printexc.to_string e in

     

       570
       -
               Logs.err (fun m -> m "%s" error_msg);

     

       571
       -
               Lwt.return (Error (Connection_error error_msg)))

     

       572
       -
       

     

       573
       -
         (** Make a raw JMAP API request 

     

       574
       -
             

     

       575
       -
             TODO:claude *)

     

       576
       -
         let make_request config req =

     

       577
       -
           let body = serialize_request req in

     

       578
       -
           (* Choose appropriate authorization header based on whether it's a bearer token or basic auth *)

     

       579
       -
           let auth_header = 

     

       580
       -
             if String.length config.username > 0 then

     

       581
       -
               (* Standard username/password authentication *)

     

       582
       -
               "Basic " ^ Base64.encode_string (config.username ^ ":" ^ config.authentication_token)

     

       583
       -
             else

     

       584
       -
               (* API token (bearer authentication) *)

     

       585
       -
               "Bearer " ^ config.authentication_token

     

       586
       -
           in

     

       587
       -
           

     

       588
       -
           (* Log auth header at debug level with redaction *)

     

       589
       -
           let redacted_header =

     

       590
       -
             if String.length config.username > 0 then

     

       591
       -
               "Basic " ^ redact_token (Base64.encode_string (config.username ^ ":" ^ config.authentication_token))

     

       592
       -
             else

     

       593
       -
               "Bearer " ^ redact_token config.authentication_token

     

       594
       -
           in

     

       595
       -
           Logs.debug (fun m -> m "Using authorization header: %s" redacted_header);

     

       596
       -
           

     

       597
       -
           let headers = [

     

       598
       -
             ("Content-Type", "application/json");

     

       599
       -
             ("Content-Length", string_of_int (String.length body));

     

       600
       -
             ("Authorization", auth_header)

     

       601
       -
           ] in

     

       602
       -
           let* result = make_http_request ~method_:"POST" ~headers ~body config.api_uri in

     

       603
       -
           match result with

     

       604
       -
           | Ok response_body ->

     

       605
       -
               (match parse_json_string response_body with

     

       606
       -
                | Ok json -> 

     

       607
       -
                    Logs.debug (fun m -> m "Successfully parsed JSON response");

     

       608
       -
                    Lwt.return (parse_response json)

     

       609
       -
                | Error e -> 

     

       610
       -
                    let msg = match e with Parse_error m -> m | _ -> "unknown error" in

     

       611
       -
                    Logs.err (fun m -> m "Failed to parse response: %s" msg);

     

       612
       -
                    Lwt.return (Error e))

     

       613
       -
           | Error e -> 

     

       614
       -
               (match e with

     

       615
       -
                | Connection_error msg -> Logs.err (fun m -> m "Connection error: %s" msg)

     

       616
       -
                | HTTP_error (code, _) -> Logs.err (fun m -> m "HTTP error %d" code)

     

       617
       -
                | Parse_error msg -> Logs.err (fun m -> m "Parse error: %s" msg)

     

       618
       -
                | Authentication_error -> Logs.err (fun m -> m "Authentication error"));

     

       619
       -
               Lwt.return (Error e)

     

       620
       -
       

     

       621
       -
         (** Parse a JSON object as a Session object *)

     

       622
       -
         let parse_session_object json =

     

       623
       -
           try

     

       624
       -
             let capabilities =

     

       625
       -
               match Ezjsonm.find json ["capabilities"] with

     

       626
       -
               | `O items -> items

     

       627
       -
               | _ -> raise (Invalid_argument "capabilities is not an object")

     

       628
       -
             in

     

       629
       -
             

     

       630
       -
             let accounts =

     

       631
       -
               match Ezjsonm.find json ["accounts"] with

     

       632
       -
               | `O items -> List.map (fun (id, json) ->

     

       633
       -
                   match json with

     

       634
       -
                   | `O _ -> 

     

       635
       -
                       let name = Ezjsonm.get_string (Ezjsonm.find json ["name"]) in

     

       636
       -
                       let is_personal = Ezjsonm.get_bool (Ezjsonm.find json ["isPersonal"]) in

     

       637
       -
                       let is_read_only = Ezjsonm.get_bool (Ezjsonm.find json ["isReadOnly"]) in

     

       638
       -
                       let account_capabilities =

     

       639
       -
                         match Ezjsonm.find json ["accountCapabilities"] with

     

       640
       -
                         | `O items -> items

     

       641
       -
                         | _ -> raise (Invalid_argument "accountCapabilities is not an object")

     

       642
       -
                       in

     

       643
       -
                       (id, { name; is_personal; is_read_only; account_capabilities })

     

       644
       -
                   | _ -> raise (Invalid_argument "account value is not an object")

     

       645
       -
                 ) items

     

       646
       -
               | _ -> raise (Invalid_argument "accounts is not an object")

     

       647
       -
             in

     

       648
       -
             

     

       649
       -
             let primary_accounts =

     

       650
       -
               match Ezjsonm.find_opt json ["primaryAccounts"] with

     

       651
       -
               | Some (`O items) -> List.map (fun (k, v) ->

     

       652
       -
                   match v with

     

       653
       -
                   | `String id -> (k, id)

     

       654
       -
                   | _ -> raise (Invalid_argument "primaryAccounts value is not a string")

     

       655
       -
                 ) items

     

       656
       -
               | Some _ -> raise (Invalid_argument "primaryAccounts is not an object")

     

       657
       -
               | None -> []

     

       658
       -
             in

     

       659
       -
             

     

       660
       -
             let username = Ezjsonm.get_string (Ezjsonm.find json ["username"]) in

     

       661
       -
             let api_url = Ezjsonm.get_string (Ezjsonm.find json ["apiUrl"]) in

     

       662
       -
             let download_url = Ezjsonm.get_string (Ezjsonm.find json ["downloadUrl"]) in

     

       663
       -
             let upload_url = Ezjsonm.get_string (Ezjsonm.find json ["uploadUrl"]) in

     

       664
       -
             let event_source_url = 

     

       665
       -
               try Some (Ezjsonm.get_string (Ezjsonm.find json ["eventSourceUrl"]))

     

       666
       -
               with Not_found -> None

     

       667
       -
             in

     

       668
       -
             let state = Ezjsonm.get_string (Ezjsonm.find json ["state"]) in

     

       669
       -
             

     

       670
       -
             Ok { capabilities; accounts; primary_accounts; username; 

     

       671
       -
                  api_url; download_url; upload_url; event_source_url; state }

     

       672
       -
           with

     

       673
       -
           | Not_found -> Error (Parse_error "Required field not found in session object")

     

       674
       -
           | Invalid_argument msg -> Error (Parse_error msg)

     

       675
       -
           | e -> Error (Parse_error (Printexc.to_string e))

     

       676
       -
       

     

       677
       -
         (** Fetch a Session object from a JMAP server

     

       678
       -
             

     

       679
       -
             TODO:claude *)

     

       680
       -
         let get_session uri ?username ?authentication_token ?api_token () =

     

       681
       -
           let headers = 

     

       682
       -
             match (username, authentication_token, api_token) with

     

       683
       -
             | (Some u, Some t, _) -> 

     

       684
       -
                 let auth = "Basic " ^ Base64.encode_string (u ^ ":" ^ t) in

     

       685
       -
                 let redacted_auth = "Basic " ^ redact_token (Base64.encode_string (u ^ ":" ^ t)) in

     

       686
       -
                 Logs.info (fun m -> m "Session using Basic auth: %s" redacted_auth);

     

       687
       -
                 [

     

       688
       -
                   ("Content-Type", "application/json");

     

       689
       -
                   ("Authorization", auth)

     

       690
       -
                 ]

     

       691
       -
             | (_, _, Some token) -> 

     

       692
       -
                 let auth = "Bearer " ^ token in

     

       693
       -
                 let redacted_token = redact_token token in

     

       694
       -
                 Logs.info (fun m -> m "Session using Bearer auth: %s" ("Bearer " ^ redacted_token));

     

       695
       -
                 [

     

       696
       -
                   ("Content-Type", "application/json");

     

       697
       -
                   ("Authorization", auth)

     

       698
       -
                 ]

     

       699
       -
             | _ -> [("Content-Type", "application/json")]

     

       700
       -
           in

     

       701
       -
           

     

       702
       -
           let* result = make_http_request ~method_:"GET" ~headers ~body:"" uri in

     

       703
       -
           match result with

     

       704
       -
           | Ok response_body ->

     

       705
       -
               (match parse_json_string response_body with

     

       706
       -
                | Ok json -> 

     

       707
       -
                    Logs.debug (fun m -> m "Successfully parsed session response");

     

       708
       -
                    Lwt.return (parse_session_object json)

     

       709
       -
                | Error e -> 

     

       710
       -
                    let msg = match e with Parse_error m -> m | _ -> "unknown error" in

     

       711
       -
                    Logs.err (fun m -> m "Failed to parse session response: %s" msg);

     

       712
       -
                    Lwt.return (Error e))

     

       713
       -
           | Error e -> 

     

       714
       -
               let err_msg = match e with

     

       715
       -
                | Connection_error msg -> "Connection error: " ^ msg

     

       716
       -
                | HTTP_error (code, _) -> Printf.sprintf "HTTP error %d" code

     

       717
       -
                | Parse_error msg -> "Parse error: " ^ msg

     

       718
       -
                | Authentication_error -> "Authentication error"

     

       719
       -
               in

     

       720
       -
               Logs.err (fun m -> m "Failed to get session: %s" err_msg);

     

       721
       -
               Lwt.return (Error e)

     

       722
       -
       

     

       723
       -
         (** Upload a binary blob to the server

     

       724
       -
             

     

       725
       -
             TODO:claude *)

     

       726
       -
         let upload_blob config ~account_id ~content_type data =

     

       727
       -
           let upload_url_template = config.api_uri |> Uri.to_string in

     

       728
       -
           (* Replace {accountId} with the actual account ID *)

     

       729
       -
           let upload_url = Str.global_replace (Str.regexp "{accountId}") account_id upload_url_template in

     

       730
       -
           let upload_uri = Uri.of_string upload_url in

     

       731
       -
           

     

       732
       -
           let headers = [

     

       733
       -
             ("Content-Type", content_type);

     

       734
       -
             ("Content-Length", string_of_int (String.length data));

     

       735
       -
             ("Authorization", "Basic " ^ Base64.encode_string (config.username ^ ":" ^ config.authentication_token))

     

       736
       -
           ] in

     

       737
       -
           

     

       738
       -
           let* result = make_http_request ~method_:"POST" ~headers ~body:data upload_uri in

     

       739
       -
           match result with

     

       740
       -
           | Ok response_body ->

     

       741
       -
               (match parse_json_string response_body with

     

       742
       -
                | Ok json ->

     

       743
       -
                    (try

     

       744
       -
                       let account_id = Ezjsonm.get_string (Ezjsonm.find json ["accountId"]) in

     

       745
       -
                       let blob_id = Ezjsonm.get_string (Ezjsonm.find json ["blobId"]) in

     

       746
       -
                       let type_ = Ezjsonm.get_string (Ezjsonm.find json ["type"]) in

     

       747
       -
                       let size = Ezjsonm.get_int (Ezjsonm.find json ["size"]) in

     

       748
       -
                       Lwt.return (Ok { account_id; blob_id; type_; size })

     

       749
       -
                     with

     

       750
       -
                     | Not_found -> Lwt.return (Error (Parse_error "Required field not found in upload response"))

     

       751
       -
                     | e -> Lwt.return (Error (Parse_error (Printexc.to_string e))))

     

       752
       -
                | Error e -> Lwt.return (Error e))

     

       753
       -
           | Error e -> Lwt.return (Error e)

     

       754
       -
       

     

       755
       -
         (** Download a binary blob from the server

     

       756
       -
             

     

       757
       -
             TODO:claude *)

     

       758
       -
         let download_blob config ~account_id ~blob_id ?type_ ?name () =

     

       759
       -
           let download_url_template = config.api_uri |> Uri.to_string in

     

       760
       -
           

     

       761
       -
           (* Replace template variables with actual values *)

     

       762
       -
           let url = Str.global_replace (Str.regexp "{accountId}") account_id download_url_template in

     

       763
       -
           let url = Str.global_replace (Str.regexp "{blobId}") blob_id url in

     

       764
       -
           

     

       765
       -
           let url = match type_ with

     

       766
       -
             | Some t -> Str.global_replace (Str.regexp "{type}") (Uri.pct_encode t) url

     

       767
       -
             | None -> Str.global_replace (Str.regexp "{type}") "" url

     

       768
       -
           in

     

       769
       -
           

     

       770
       -
           let url = match name with

     

       771
       -
             | Some n -> Str.global_replace (Str.regexp "{name}") (Uri.pct_encode n) url

     

       772
       -
             | None -> Str.global_replace (Str.regexp "{name}") "file" url

     

       773
       -
           in

     

       774
       -
           

     

       775
       -
           let download_uri = Uri.of_string url in

     

       776
       -
           

     

       777
       -
           let headers = [

     

       778
       -
             ("Authorization", "Basic " ^ Base64.encode_string (config.username ^ ":" ^ config.authentication_token))

     

       779
       -
           ] in

     

       780
       -
           

     

       781
       -
           let* result = make_http_request ~method_:"GET" ~headers ~body:"" download_uri in

     

       782
       -
           Lwt.return result

     

       783
       -
       end

-651

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
       -
         (** Configuration for a JMAP API client as defined in RFC8620 Section 3.1

     

       583
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8620#section-3.1>

     

       584
       -
         *)

     

       585
       -
         type config = {

     

       586
       -
           api_uri: Uri.t;                (** The JMAP API endpoint URI *)

     

       587
       -
           username: string;              (** The username for authentication *)

     

       588
       -
           authentication_token: string;  (** The token for authentication *)

     

       589
       -
         }

     

       590
       -
         

     

       591
       -
         (** Make a raw JMAP API request as defined in RFC8620 Section 3.3

     

       592
       -
             @param config The API client configuration

     

       593
       -
             @param request The JMAP request to send

     

       594
       -
             @return A result containing the JMAP response or an error

     

       595
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8620#section-3.3>

     

       596
       -
         *)

     

       597
       -
         val make_request : 

     

       598
       -
           config -> 

     

       599
       -
           Types.request ->

     

       600
       -
           Types.response result Lwt.t

     

       601
       -
         

     

       602
       -
         (** Fetch a Session object from a JMAP server as defined in RFC8620 Section 2

     

       603
       -
             Can authenticate with either username/password or API token.

     

       604
       -
             @param uri The URI of the JMAP session resource

     

       605
       -
             @param username Optional username for authentication

     

       606
       -
             @param authentication_token Optional password or token for authentication

     

       607
       -
             @param api_token Optional API token for Bearer authentication

     

       608
       -
             @return A result containing the session object or an error

     

       609
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8620#section-2>

     

       610
       -
         *)

     

       611
       -
         val get_session :

     

       612
       -
           Uri.t ->

     

       613
       -
           ?username:string ->

     

       614
       -
           ?authentication_token:string ->

     

       615
       -
           ?api_token:string ->

     

       616
       -
           unit ->

     

       617
       -
           Types.session result Lwt.t

     

       618
       -
         

     

       619
       -
         (** Upload a binary blob to the server as defined in RFC8620 Section 6.1

     

       620
       -
             @param config The API client configuration

     

       621
       -
             @param account_id The account ID to upload to

     

       622
       -
             @param content_type The MIME type of the blob

     

       623
       -
             @param data The blob data as a string

     

       624
       -
             @return A result containing the upload response or an error

     

       625
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8620#section-6.1>

     

       626
       -
         *)

     

       627
       -
         val upload_blob :

     

       628
       -
           config ->

     

       629
       -
           account_id:Types.id ->

     

       630
       -
           content_type:string ->

     

       631
       -
           string ->

     

       632
       -
           Types.upload_response result Lwt.t

     

       633
       -
         

     

       634
       -
         (** Download a binary blob from the server as defined in RFC8620 Section 6.2

     

       635
       -
             @param config The API client configuration

     

       636
       -
             @param account_id The account ID that contains the blob

     

       637
       -
             @param blob_id The ID of the blob to download

     

       638
       -
             @param type_ Optional MIME type to require for the blob

     

       639
       -
             @param name Optional name for the downloaded blob

     

       640
       -
             @return A result containing the blob data as a string or an error

     

       641
       -
             @see <https://datatracker.ietf.org/doc/html/rfc8620#section-6.2>

     

       642
       -
         *)

     

       643
       -
         val download_blob :

     

       644
       -
           config ->

     

       645
       -
           account_id:Types.id ->

     

       646
       -
           blob_id:Types.id ->

     

       647
       -
           ?type_:string ->

     

       648
       -
           ?name:string ->

     

       649
       -
           unit ->

     

       650
       -
           string result Lwt.t

     

       651
       -
       end

-2014

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 Address Utilities} *)

     

       1937
       -
       

     

       1938
       -
       (** Custom implementation of substring matching *)

     

       1939
       -
       let contains_substring str sub =

     

       1940
       -
         try 

     

       1941
       -
           let _ = Str.search_forward (Str.regexp_string sub) str 0 in

     

       1942
       -
           true

     

       1943
       -
         with Not_found -> false

     

       1944
       -
       

     

       1945
       -
       (** Checks if a pattern with wildcards matches a string

     

       1946
       -
           @param pattern Pattern string with * and ? wildcards 

     

       1947
       -
           @param str String to match against

     

       1948
       -
           Based on simple recursive wildcard matching algorithm

     

       1949
       -
       *)

     

       1950
       -
       let matches_wildcard pattern str =

     

       1951
       -
         let pattern_len = String.length pattern in

     

       1952
       -
         let str_len = String.length str in

     

       1953
       -
         

     

       1954
       -
         (* Convert both to lowercase for case-insensitive matching *)

     

       1955
       -
         let pattern = String.lowercase_ascii pattern in

     

       1956
       -
         let str = String.lowercase_ascii str in

     

       1957
       -
         

     

       1958
       -
         (* If there are no wildcards, do a simple substring check *)

     

       1959
       -
         if not (String.contains pattern '*' || String.contains pattern '?') then

     

       1960
       -
           contains_substring str pattern

     

       1961
       -
         else

     

       1962
       -
           (* Classic recursive matching algorithm *)

     

       1963
       -
           let rec match_from p_pos s_pos =

     

       1964
       -
             (* Pattern matched to the end *)

     

       1965
       -
             if p_pos = pattern_len then

     

       1966
       -
               s_pos = str_len

     

       1967
       -
             (* Star matches zero or more chars *)

     

       1968
       -
             else if pattern.[p_pos] = '*' then

     

       1969
       -
               match_from (p_pos + 1) s_pos ||  (* Match empty string *)

     

       1970
       -
               (s_pos < str_len && match_from p_pos (s_pos + 1))  (* Match one more char *)

     

       1971
       -
             (* If both have more chars and they match or ? wildcard *)

     

       1972
       -
             else if s_pos < str_len && 

     

       1973
       -
                     (pattern.[p_pos] = '?' || pattern.[p_pos] = str.[s_pos]) then

     

       1974
       -
               match_from (p_pos + 1) (s_pos + 1)

     

       1975
       -
             else

     

       1976
       -
               false

     

       1977
       -
           in

     

       1978
       -
           

     

       1979
       -
           match_from 0 0

     

       1980
       -
       

     

       1981
       -
       (** Check if an email address matches a filter string

     

       1982
       -
           @param email The email address to check

     

       1983
       -
           @param pattern The filter pattern to match against

     

       1984
       -
           @return True if the email address matches the filter

     

       1985
       -
       *)

     

       1986
       -
       let email_address_matches email pattern =

     

       1987
       -
         matches_wildcard pattern email

     

       1988
       -
       

     

       1989
       -
       (** Check if an email matches a sender filter

     

       1990
       -
           @param email The email object to check

     

       1991
       -
           @param pattern The sender filter pattern

     

       1992
       -
           @return True if any sender address matches the filter

     

       1993
       -
       *)

     

       1994
       -
       let email_matches_sender (email : Types.email) pattern =

     

       1995
       -
         (* Helper to extract emails from address list *)

     

       1996
       -
         let addresses_match addrs =

     

       1997
       -
           List.exists (fun (addr : Types.email_address) ->

     

       1998
       -
             email_address_matches addr.email pattern

     

       1999
       -
           ) addrs

     

       2000
       -
         in

     

       2001
       -
         

     

       2002
       -
         (* Check From addresses first *)

     

       2003
       -
         let from_match = 

     

       2004
       -
           match email.Types.from with

     

       2005
       -
           | Some addrs -> addresses_match addrs

     

       2006
       -
           | None -> false

     

       2007
       -
         in

     

       2008
       -
         

     

       2009
       -
         (* If no match in From, check Sender field *)

     

       2010
       -
         if from_match then true

     

       2011
       -
         else

     

       2012
       -
           match email.Types.sender with

     

       2013
       -
           | Some addrs -> addresses_match addrs

     

       2014
       -
           | None -> false

-1542

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 Address Utilities}

     

       1519
       -
           Utilities for working with email addresses

     

       1520
       -
       *)

     

       1521
       -
       

     

       1522
       -
       (** Check if an email address matches a filter string

     

       1523
       -
           @param email The email address to check

     

       1524
       -
           @param pattern The filter pattern to match against

     

       1525
       -
           @return True if the email address matches the filter 

     

       1526
       -
           

     

       1527
       -
           The filter supports simple wildcards:

     

       1528
       -
           - "*" matches any sequence of characters

     

       1529
       -
           - "?" matches any single character

     

       1530
       -
           - Case-insensitive matching is used

     

       1531
       -
           - If no wildcards are present, substring matching is used

     

       1532
       -
       *)

     

       1533
       -
       val email_address_matches : string -> string -> bool

     

       1534
       -
       

     

       1535
       -
       (** Check if an email matches a sender filter

     

       1536
       -
           @param email The email object to check

     

       1537
       -
           @param pattern The sender filter pattern

     

       1538
       -
           @return True if any sender address matches the filter

     

       1539
       -
           

     

       1540
       -
           Tests whether any of an email's sender addresses match the provided pattern.

     

       1541
       -
       *)

     

       1542
       -
       val email_matches_sender : Types.email -> string -> bool

Compare changes